3 files changed, 162 insertions, 2 deletions

diff --git a/www/tclhttpd/Makefile b/www/tclhttpd/Makefile
index f908ef13a6d7..bc75a73a8776 100644
--- a/www/tclhttpd/Makefile
+++ b/www/tclhttpd/Makefile
@@ -7,7 +7,7 @@
 
 PORTNAME=	tclhttpd
 PORTVERSION=	3.5.1
-PORTREVISION=	1
+PORTREVISION=	2
 CATEGORIES=	www tcl83 tcl84
 MASTER_SITES=	${MASTER_SITE_TCLTK}
 MASTER_SITE_SUBDIR=	httpd
@@ -45,7 +45,7 @@ do-build:
 	# file(n) and is finally removed from this port
 	#
 
-pre-install:
+pre-su-install:
 	${MKDIR} ${PREFIX}/tclhttpd/custom
 
 post-install:
diff --git a/www/tclhttpd/files/httpdate.c b/www/tclhttpd/files/httpdate.c
new file mode 100644
index 000000000000..2a34809ff9f4
--- /dev/null
+++ b/www/tclhttpd/files/httpdate.c
@@ -0,0 +1,119 @@
+/*
+ * Produce time-stamp in the format suitable for HTTP's Date headers:
+ *
+ *	Date: Sun, 05 Nov 2006 16:18:01 GMT
+ * and the Set-Cookie headers:
+ *	Set-Cookie: .......; expires=Sun, 17-Jan-2038 19:14:07 GMT
+ *
+ * Although this can, of course, be done from TCL directly ([clock format]),
+ * Tcl's method breaks, when the server is running in non-C locale.
+ * Regardless of the locale, the Date-header must be in English and
+ * this function takes care of that. Plus it is over 4 times faster...
+ * Neither asctime() nor gmtime() would not work, because they
+ * don't put a coma after the name of the weekday...
+ *
+ * Each command takes an optional argument specifying the date (in seconds
+ * since epoch). If not specified, httpdate assumes the current date, and
+ * the cookiedate -- a week from now.
+ *
+ * Written by Mikhail T. <mi+httpdate@aldan.algebra.com> in search of glory
+ * but without ANY AND ALL WARRANTIES OR APPLICABILITIES FOR ANY PURPOSES.
+ * Released into the wild under BSD license.
+ *
+ * Tested on FreeBSD-6.2 against Tcl-8.4. November 2006...
+ */
+
+#include <tcl.h>
+#include <sys/time.h>
+#include <errno.h>
+#include <sys/limits.h>
+
+/*
+ * Using this method of copying short strings as integers instead of
+ * relying on memcpy cuts the execution time from 3.53 microseconds to
+ * 3.26 microseconds (or 8%) on my Opteron 275. Plus it is fun...
+ * It is only safe, because the positions of both the month's name and
+ * the weekday happen to be at 4-byte allignment, so the code is safe
+ * from SIGBUS on all (?) known platforms...
+ */
+typedef union {
+	char	string[4];
+#if !defined(CHAR_BIT) || CHAR_BIT == 8
+	int32_t	intrep;
+#elif CHAR_BIT == 16
+	int64_t	intrep;
+#else
+#	error "Unexpected or unknown value of CHAR_BIT on this system"
+#endif
+} fourcharstring;
+
+static const fourcharstring months[] = {
+	{ "Jan " }, { "Feb " }, { "Mar " }, { "Apr " }, { "May " }, { "Jun " },
+	{ "Jul " }, { "Aug " }, { "Sep " }, { "Oct " }, { "Nov " }, { "Dec " }
+};
+
+static const fourcharstring weekdays[] = {
+	{ "Sun," }, { "Mon," }, { "Tue," }, { "Wed," }, { "Thu," },
+	{ "Fri," }, { "Sat," }
+};
+
+enum {
+	HTTPDATE,
+	COOKIEDATE
+};
+
+static int
+httpdate(ClientData flavour, Tcl_Interp *I, int argc, Tcl_Obj *CONST objv[])
+{
+	union {
+		fourcharstring	fields[7];
+		char	date[30];
+	} date;
+	struct tm tm;
+	time_t	tSec;
+	Tcl_WideInt	wSec;
+
+	switch (argc) {
+	case 1:
+		time(&tSec);
+		if ((intptr_t)flavour == COOKIEDATE)
+			/* Default for cookies is a week from now */
+			tSec += 7*24*60*60;
+		break;
+	case 2:
+		if (Tcl_GetWideIntFromObj(I, objv[1], &wSec) != TCL_OK)
+			return TCL_ERROR;
+		tSec = wSec;
+		break;
+	default:
+		Tcl_WrongNumArgs(I, 1, objv, "?GMT-seconds?");
+		return TCL_ERROR;
+	}
+	gmtime_r(&tSec, &tm);
+
+	sprintf(date.date + 4, " %02d XXX %d %02d:%02d:%02d GMT",
+	    tm.tm_mday, tm.tm_year + 1900, tm.tm_hour,
+	    tm.tm_min, tm.tm_sec);
+	
+	/*
+	 * Now deal with our 4-character strings
+	 */
+	date.fields[0].intrep = weekdays[tm.tm_wday].intrep;
+	date.fields[2].intrep = months[tm.tm_mon].intrep;
+
+	if ((intptr_t)flavour == COOKIEDATE)
+		date.date[7] = date.date[11] = '-';
+
+	Tcl_SetObjResult(I, Tcl_NewStringObj(date.date, 29));
+
+	return TCL_OK;
+}
+
+int
+Httpdate_Init(Tcl_Interp *I)
+{
+	Tcl_CreateObjCommand(I, "HttpdDate", httpdate, (void *)HTTPDATE, NULL);
+	Tcl_CreateObjCommand(I, "cookiedate", httpdate, (void *)COOKIEDATE, NULL);
+
+	return TCL_OK;
+}
diff --git a/www/tclhttpd/files/patch-date b/www/tclhttpd/files/patch-date
new file mode 100644
index 000000000000..31aeb0ae5ddc
--- /dev/null
+++ b/www/tclhttpd/files/patch-date
@@ -0,0 +1,41 @@
+--- contrib/cookies/login.tcl	Wed Feb  6 20:09:11 2002
++++ contrib/cookies/login.tcl	Sun Nov  5 13:46:17 2006
+@@ -15,6 +15,7 @@
+    global env
+ 
+-   set expire [clock format [expr {[clock seconds] + 3600}] \
+-                -format "%A, %d-%b-%Y %H:%M:%S GMT" -gmt 1]
++   # Cookiedate's default is a WEEK from now. We want a shorter expiration
++   # of one hour, so we have to specify the time explicitly:
++   set expire [cookiedate [expr [clock seconds] + 3600]]
+ 
+    Doc_SetCookie -name username -value $username -expires $expire \
+--- lib/httpd.tcl	Wed Apr 28 21:34:16 2004
++++ lib/httpd.tcl	Sun Nov  5 14:08:35 2006
+@@ -1899,6 +1899,8 @@
+ # Side Effects:
+ #	None
+-
+-proc HttpdDate {seconds} {
++proc HttpdDate {{seconds now}} {
++    if {$seconds == "now"} {
++	set seconds [clock seconds]
++    }
+     return [clock format $seconds -format {%a, %d %b %Y %T GMT} -gmt true]
+ }
+--- lib/cookie.tcl	Sat May  1 09:49:21 2004
++++ lib/cookie.tcl	Sun Nov  5 14:35:44 2006
+@@ -128,6 +128,5 @@
+ 	    }
+ 	    default {
+-		set expires [clock format [clock scan $opt(-expires)] \
+-			-format "%A, %d-%b-%Y %H:%M:%S GMT" -gmt 1]
++		set expires [cookiedate [clock scan $opt(-expires)]]
+ 	    }
+ 	}
+@@ -170,4 +169,4 @@
+ proc Cookie_Unset {name args} {
+     Httpd_RemoveCookies [Httpd_CurrentSocket] name
+-    Cookie_Set -name $name -value "" -expires [clock format [clock scan "last year"] -format "%A, %d-%b-%Y %H:%M:%S GMT" -gmt 1]
++    Cookie_Set -name $name -value "" -expires {Thu, 01-Jan-1970 00:00:00 GMT}
+ }