Improved cookie support, and better session manager taking advantage of it

extra/calendar/format/format-tests.factor

@@ -43,3 +43,10 @@ IN: calendar.format.tests
 ] unit-test
 
 [ t ] [ now dup timestamp>rfc822 rfc822>timestamp time- 1 seconds before? ] unit-test
+
+[ t ] [ now dup timestamp>cookie-string cookie-string>timestamp time- 1 seconds before? ] unit-test
+
+[ "Sun, 4 May 2008 07:00:00" ] [
+    "Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp
+    timestamp>string
+] unit-test

extra/calendar/format/format.factor

@@ -1,8 +1,50 @@
-USING: math math.parser kernel sequences io calendar
+USING: math math.parser kernel sequences io
 accessors arrays io.streams.string splitting
-combinators accessors debugger ;
+combinators accessors debugger
+calendar calendar.format.macros ;
 IN: calendar.format
 
+: pad-00 number>string 2 CHAR: 0 pad-left ;
+
+: pad-0000 number>string 4 CHAR: 0 pad-left ;
+
+: pad-00000 number>string 5 CHAR: 0 pad-left ;
+
+: write-00 pad-00 write ;
+
+: write-0000 pad-0000 write ;
+
+: write-00000 pad-00000 write ;
+
+: hh hour>> write-00 ;
+
+: mm minute>> write-00 ;
+
+: ss second>> >integer write-00 ;
+
+: D day>> number>string write ;
+
+: DD day>> write-00 ;
+
+: DAY day-of-week day-abbreviations3 nth write ;
+
+: MM month>> write-00 ;
+
+: MONTH month>> month-abbreviations nth write ;
+
+: YYYY year>> write-0000 ;
+
+: YYYYY year>> write-00000 ;
+
+: expect ( str -- )
+    read1 swap member? [ "Parse error" throw ] unless ;
+
+: read-00 2 read string>number ;
+
+: read-000 3 read string>number ;
+
+: read-0000 4 read string>number ;
+
 GENERIC: day. ( obj -- )
 
 M: integer day. ( n -- )
@@ -25,7 +67,7 @@ M: array month. ( pair -- )
     ] with each nl ;
 
 M: timestamp month. ( timestamp -- )
-    { year>> month>> } get-slots 2array month. ;
+    [ year>> ] [ month>> ] bi 2array month. ;
 
 GENERIC: year. ( obj -- )
 
@@ -35,28 +77,14 @@ M: integer year. ( n -- )
 M: timestamp year. ( timestamp -- )
     year>> year. ;
 
-: pad-00 number>string 2 CHAR: 0 pad-left ;
-
-: pad-0000 number>string 4 CHAR: 0 pad-left ;
-
-: write-00 pad-00 write ;
-
-: write-0000 pad-0000 write ;
-
 : (timestamp>string) ( timestamp -- )
-    dup day-of-week day-abbreviations3 nth write ", " write
+    { DAY ", " D " " MONTH " " YYYY " " hh ":" mm ":" ss } formatted ;
-    dup day>> number>string write bl
-    dup month>> month-abbreviations nth write bl
-    dup year>> number>string write bl
-    dup hour>> write-00 ":" write
-    dup minute>> write-00 ":" write
-    second>> >integer write-00 ;
 
 : timestamp>string ( timestamp -- str )
     [ (timestamp>string) ] with-string-writer ;
 
 : (write-gmt-offset) ( duration -- )
-    [ hour>> write-00 ] [ minute>> write-00 ] bi ;
+    [ hh ] [ mm ] bi ;
 
 : write-gmt-offset ( gmt-offset -- )
     dup instant <=> sgn {
@@ -69,9 +97,9 @@ M: timestamp year. ( timestamp -- )
     #! RFC822 timestamp format
     #! Example: Tue, 15 Nov 1994 08:12:31 +0200
     [
-        dup (timestamp>string)
+        [ (timestamp>string) " " write ]
-        " " write
+        [ gmt-offset>> write-gmt-offset ]
-        gmt-offset>> write-gmt-offset
+        bi
     ] with-string-writer ;
 
 : timestamp>http-string ( timestamp -- str )
@@ -79,40 +107,32 @@ M: timestamp year. ( timestamp -- )
     #! Example: Tue, 15 Nov 1994 08:12:31 GMT
     >gmt timestamp>rfc822 ;
 
+: (timestamp>cookie-string) ( timestamp -- )
+    >gmt
+    { DAY ", " DD "-" MONTH "-" YYYY " " hh ":" mm ":" ss " GMT" } formatted ;
+
+: timestamp>cookie-string ( timestamp -- str )
+    [ (timestamp>cookie-string) ] with-string-writer ;
+
 : (write-rfc3339-gmt-offset) ( duration -- )
-    [ hour>> write-00 CHAR: : write1 ]
+    [ hh ":" write ] [ mm ] bi ;
-    [ minute>> write-00 ] bi ;
 
 : write-rfc3339-gmt-offset ( duration -- )
     dup instant <=> sgn {
         {  0 [ drop "Z" write ] }
-        { -1 [ CHAR: - write1 before (write-rfc3339-gmt-offset) ] }
+        { -1 [ "-" write before (write-rfc3339-gmt-offset) ] }
-        {  1 [ CHAR: + write1 (write-rfc3339-gmt-offset) ] }
+        {  1 [ "+" write (write-rfc3339-gmt-offset) ] }
     } case ;
     
 : (timestamp>rfc3339) ( timestamp -- )
     {
-        [ year>> number>string write CHAR: - write1 ]
+        YYYY "-" MM "-" DD "T" hh ":" mm ":" ss
-        [ month>> write-00 CHAR: - write1 ]
-        [ day>> write-00 CHAR: T write1 ]
-        [ hour>> write-00 CHAR: : write1 ]
-        [ minute>> write-00 CHAR: : write1 ]
-        [ second>> >fixnum write-00 ]
         [ gmt-offset>> write-rfc3339-gmt-offset ]
-    } cleave ;
+    } formatted ;
 
 : timestamp>rfc3339 ( timestamp -- str )
     [ (timestamp>rfc3339) ] with-string-writer ;
 
-: expect ( str -- )
-    read1 swap member? [ "Parse error" throw ] unless ;
-
-: read-00 2 read string>number ;
-
-: read-000 3 read string>number ;
-
-: read-0000 4 read string>number ;
-
 : signed-gmt-offset ( dt ch -- dt' )
     { { CHAR: + [ 1 ] } { CHAR: - [ -1 ] } } case time* ;
 
@@ -142,17 +162,18 @@ M: timestamp year. ( timestamp -- )
 : rfc3339>timestamp ( str -- timestamp )
     [ (rfc3339>timestamp) ] with-string-reader ;
 
-ERROR: invalid-rfc822-date ;
+ERROR: invalid-timestamp-format ;
 
-: check-rfc822-date ( obj/f -- obj ) [ invalid-rfc822-date ] unless* ;
+: check-timestamp ( obj/f -- obj )
+    [ invalid-timestamp-format ] unless* ;
 
 : read-token ( seps -- token )
-    [ read-until ] keep member? check-rfc822-date drop ;
+    [ read-until ] keep member? check-timestamp drop ;
 
 : read-sp ( -- token ) " " read-token ;
 
 : checked-number ( str -- n )
-    string>number check-rfc822-date ;
+    string>number check-timestamp ;
 
 : parse-rfc822-gmt-offset ( string -- dt )
     dup "GMT" = [ drop instant ] [
@@ -163,10 +184,10 @@ ERROR: invalid-rfc822-date ;
 
 : (rfc822>timestamp) ( -- timestamp )
     timestamp new
-        "," read-token day-abbreviations3 member? check-rfc822-date drop
+        "," read-token day-abbreviations3 member? check-timestamp drop
         read1 CHAR: \s assert=
         read-sp checked-number >>day
-        read-sp month-abbreviations index check-rfc822-date >>month
+        read-sp month-abbreviations index check-timestamp >>month
         read-sp checked-number >>year
         ":" read-token checked-number >>hour
         ":" read-token checked-number >>minute
@@ -176,6 +197,42 @@ ERROR: invalid-rfc822-date ;
 : rfc822>timestamp ( str -- timestamp )
     [ (rfc822>timestamp) ] with-string-reader ;
 
+: (cookie-string>timestamp-1) ( -- timestamp )
+    timestamp new
+        "," read-token day-abbreviations3 member? check-timestamp drop
+        read1 CHAR: \s assert=
+        "-" read-token checked-number >>day
+        "-" read-token month-abbreviations index check-timestamp >>month
+        read-sp checked-number >>year
+        ":" read-token checked-number >>hour
+        ":" read-token checked-number >>minute
+        " " read-token checked-number >>second
+        readln parse-rfc822-gmt-offset >>gmt-offset ;
+
+: cookie-string>timestamp-1 ( str -- timestamp )
+    [ (cookie-string>timestamp-1) ] with-string-reader ;
+
+: (cookie-string>timestamp-2) ( -- timestamp )
+    timestamp new
+        read-sp day-abbreviations3 member? check-timestamp drop
+        read-sp month-abbreviations index check-timestamp >>month
+        read-sp checked-number >>day
+        ":" read-token checked-number >>hour
+        ":" read-token checked-number >>minute
+        " " read-token checked-number >>second
+        read-sp checked-number >>year
+        readln parse-rfc822-gmt-offset >>gmt-offset ;
+
+: cookie-string>timestamp-2 ( str -- timestamp )
+    [ (cookie-string>timestamp-2) ] with-string-reader ;
+
+: cookie-string>timestamp ( str -- timestamp )
+    {
+        [ cookie-string>timestamp-1 ]
+        [ cookie-string>timestamp-2 ]
+        [ rfc822>timestamp ]
+    } attempt-all-quots ;
+
 : (ymdhms>timestamp) ( -- timestamp )
     read-ymd " " expect read-hms instant <timestamp> ;
 
@@ -195,41 +252,30 @@ ERROR: invalid-rfc822-date ;
     [ (ymd>timestamp) ] with-string-reader ;
 
 : (timestamp>ymd) ( timestamp -- )
-    dup timestamp-year write-0000
+    { YYYY "-" MM "-" DD } formatted ;
-    "-" write
-    dup timestamp-month write-00
-    "-" write
-    timestamp-day write-00 ;
 
 : timestamp>ymd ( timestamp -- str )
     [ (timestamp>ymd) ] with-string-writer ;
 
 : (timestamp>hms)
-    dup timestamp-hour write-00
+    { hh ":" mm ":" ss } formatted ;
-    ":" write
-    dup timestamp-minute write-00
-    ":" write
-    timestamp-second >integer write-00 ;
 
 : timestamp>hms ( timestamp -- str )
     [ (timestamp>hms) ] with-string-writer ;
 
 : timestamp>ymdhms ( timestamp -- str )
-    >gmt
     [
-        dup (timestamp>ymd)
+        >gmt
-        " " write
+        { (timestamp>ymd) " " (timestamp>hms) } formatted
-        (timestamp>hms)
     ] with-string-writer ;
 
 : file-time-string ( timestamp -- string )
     [
-        [ month>> month-abbreviations nth write ] keep bl
+        {
-        [ day>> number>string 2 32 pad-left write ] keep bl
+            MONTH " " DD " "
-        dup now [ year>> ] bi@ = [
+            [
-            [ hour>> write-00 ] keep ":" write
+                dup now [ year>> ] bi@ =
-            minute>> write-00
+                [ [ hh ":" write ] [ mm ] bi ] [ YYYYY ] if
-        ] [
+            ]
-            year>> number>string 5 32 pad-left write
+        } formatted
-        ] if
     ] with-string-writer ;

extra/calendar/format/macros/macros-tests.factor

@@ -0,0 +1,14 @@
+USING: tools.test kernel ;
+IN: calendar.format.macros
+
+[ 2 ] [ { [ 2 ] } attempt-all-quots ] unit-test
+
+[ 2 ] [ { [ 1 throw ] [ 2 ] } attempt-all-quots ] unit-test
+
+[ { [ 1 throw ] } attempt-all-quots ] [ 1 = ] must-fail-with
+
+: compiled-test-1 { [ 1 throw ] [ 2 ] } attempt-all-quots ;
+
+\ compiled-test-1 must-infer
+
+[ 2 ] [ compiled-test-1 ] unit-test

extra/calendar/format/macros/macros.factor

@@ -0,0 +1,19 @@
+USING: macros kernel words quotations io sequences combinators
+continuations ;
+IN: calendar.format.macros
+
+MACRO: formatted ( spec -- )
+    [
+        {
+            { [ dup word? ] [ 1quotation ] }
+            { [ dup quotation? ] [ ] }
+            [ [ nip write ] curry [ ] like ]
+        } cond
+    ] map [ cleave ] curry ;
+
+MACRO: attempt-all-quots ( quots -- )
+    dup length 1 = [ first ] [
+        unclip swap
+        [ nip attempt-all-quots ] curry
+        [ recover ] 2curry
+    ] if ;

extra/http/http-tests.factor

@@ -158,7 +158,7 @@ test-db [
                 "extra/http/test" resource-path <static> >>default
             "nested" add-responder
             <action>
-                [ "redirect-loop" f <permanent-redirect> ] >>display
+                [ "redirect-loop" f <standard-redirect> ] >>display
             "redirect-loop" add-responder
         main-responder set
 

extra/http/http.factor

@@ -135,11 +135,12 @@ IN: http
     ] { } assoc>map
     "&" join ;
 
-TUPLE: cookie name value path domain expires http-only ;
+TUPLE: cookie name value path domain expires max-age http-only ;
 
 : <cookie> ( value name -- cookie )
     cookie new
-    swap >>name swap >>value ;
+        swap >>name
+        swap >>value ;
 
 : parse-cookies ( string -- seq )
     [
@@ -147,7 +148,8 @@ TUPLE: cookie name value path domain expires http-only ;
 
         ";" split [
             [ blank? ] trim "=" split1 swap >lower {
-                { "expires" [ >>expires ] }
+                { "expires" [ cookie-string>timestamp >>expires ] }
+                { "max-age" [ string>number seconds ] }
                 { "domain" [ >>domain ] }
                 { "path" [ >>path ] }
                 { "httponly" [ drop t >>http-only ] }
@@ -163,7 +165,14 @@ TUPLE: cookie name value path domain expires http-only ;
     {
         { f [ drop ] }
         { t [ , ] }
-        [ "=" swap 3append , ]
+        [
+            {
+                { [ dup timestamp? ] [ timestamp>cookie-string ] }
+                { [ dup duration? ] [ dt>seconds number>string ] }
+                [ ]
+            } cond
+            "=" swap 3append ,
+        ]
     } case ;
 
 : unparse-cookie ( cookie -- strings )
@@ -172,6 +181,7 @@ TUPLE: cookie name value path domain expires http-only ;
         "path" over path>> (unparse-cookie)
         "domain" over domain>> (unparse-cookie)
         "expires" over expires>> (unparse-cookie)
+        "max-age" over max-age>> (unparse-cookie)
         "httponly" over http-only>> (unparse-cookie)
         drop
     ] { } make ;

extra/http/server/actions/actions-tests.factor

@@ -22,6 +22,7 @@ blah
 ;
 
 [ 25 ] [
+    init-request
     action-request-test-1 lf>crlf
     [ read-request ] with-string-reader
     request set

extra/http/server/actions/actions.factor

@@ -37,16 +37,19 @@ TUPLE: action init display submit get-params post-params ;
 : validation-failed ( -- * )
     action get display>> call exit-with ;
 
-M: action call-responder ( path action -- response )
+M: action call-responder* ( path action -- response )
     '[
         , [ CHAR: / = ] right-trim empty? [
             , action set
-            request-params params set
+            request get
-            request get method>> {
+            [ request-params params set ]
-                { "GET" [ handle-get ] }
+            [
-                { "HEAD" [ handle-get ] }
+                method>> {
-                { "POST" [ handle-post ] }
+                    { "GET" [ handle-get ] }
-            } case
+                    { "HEAD" [ handle-get ] }
+                    { "POST" [ handle-post ] }
+                } case
+            ] bi
         ] [
             <404>
         ] if

extra/http/server/auth/basic/basic.factor

@@ -36,6 +36,6 @@ C: <basic-auth> basic-auth
 : logged-in? ( request responder -- ? )
     provider>> swap "authorization" header authorization-ok? ;
 
-M: basic-auth call-responder ( request path responder -- response )
+M: basic-auth call-responder* ( request path responder -- response )
     pick over logged-in?
     [ call-next-method ] [ 2nip realm>> <401> ] if ;

extra/http/server/auth/login/edit-profile.xml

@@ -4,18 +4,18 @@
 
 	<t:title>Edit Profile</t:title>
 
-	<t:form action="edit-profile">
+	<t:form t:action="edit-profile">
 
 	<table>
 	
 	<tr>
 		<th class="field-label">User name:</th>
-		<td><t:view component="username" /></td>
+		<td><t:view t:component="username" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">Real name:</th>
-		<td><t:edit component="realname" /></td>
+		<td><t:edit t:component="realname" /></td>
 	</tr>
 	
 	<tr>
@@ -25,7 +25,7 @@
 	
 	<tr>
 		<th class="field-label">Current password:</th>
-		<td><t:edit component="password" /></td>
+		<td><t:edit t:component="password" /></td>
 	</tr>
 	
 	<tr>
@@ -35,12 +35,12 @@
 	
 	<tr>
 		<th class="field-label">New password:</th>
-		<td><t:edit component="new-password" /></td>
+		<td><t:edit t:component="new-password" /></td>
 	</tr>
 	
 	<tr>
 		<th class="field-label">Verify:</th>
-		<td><t:edit component="verify-password" /></td>
+		<td><t:edit t:component="verify-password" /></td>
 	</tr>
 	
 	<tr>
@@ -50,7 +50,7 @@
 	
 	<tr>
 		<th class="field-label">E-mail:</th>
-		<td><t:edit component="email" /></td>
+		<td><t:edit t:component="email" /></td>
 	</tr>
 	
 	<tr>
@@ -63,11 +63,11 @@
 	<p>
 		<input type="submit" value="Update" />
 
-		<t:if var="http.server.auth.login:login-failed?">
+		<t:if t:var="http.server.auth.login:login-failed?">
 			<t:error>invalid password</t:error>
 		</t:if>
 		
-		<t:if var="http.server.auth.login:password-mismatch?">
+		<t:if t:var="http.server.auth.login:password-mismatch?">
 			<t:error>passwords do not match</t:error>
 		</t:if>
 	</p>

extra/http/server/auth/login/login.factor

@@ -331,7 +331,7 @@ SYMBOL: lost-password-from
     <action>
         [
             f logged-in-user sset
-            "$login/login" f <permanent-redirect>
+            "$login/login" end-flow
         ] >>submit ;
 
 ! ! ! Authentication logic
@@ -342,19 +342,17 @@ C: <protected> protected
 
 : show-login-page ( -- response )
     begin-flow
-    "$login/login" f <temporary-redirect> ;
+    "$login/login" f <standard-redirect> ;
 
-M: protected call-responder ( path responder -- response )
+M: protected call-responder* ( path responder -- response )
     logged-in-user sget dup [
         save-user-after
         call-next-method
     ] [
-        3drop
+        3drop show-login-page
-        request get method>> { "GET" "HEAD" } member?
-        [ show-login-page ] [ <400> ] if
     ] if ;
 
-M: login call-responder ( path responder -- response )
+M: login call-responder* ( path responder -- response )
     dup login set
     call-next-method ;
 

extra/http/server/auth/login/login.xml

@@ -4,18 +4,18 @@
 
 	<t:title>Login</t:title>
 
-	<t:form action="login">
+	<t:form t:action="login">
 
 		<table>
 
 			<tr>
 				<th class="field-label">User name:</th>
-				<td><t:edit component="username" /></td>
+				<td><t:edit t:component="username" /></td>
 			</tr>
 
 			<tr>
 				<th class="field-label">Password:</th>
-				<td><t:edit component="password" /></td>
+				<td><t:edit t:component="password" /></td>
 			</tr>
 
 		</table>
@@ -24,7 +24,7 @@
 
 			<input type="submit" value="Log in" />
 
-			<t:if var="http.server.auth.login:login-failed?">
+			<t:if t:var="http.server.auth.login:login-failed?">
 				<t:error>invalid username or password</t:error>
 			</t:if>
 		</p>
@@ -33,11 +33,11 @@
 
 	<p>
 		<t:if code="http.server.auth.login:login-failed?">
-			<t:a href="register">Register</t:a>
+			<t:a t:href="register">Register</t:a>
 		</t:if>
 		|
 		<t:if code="http.server.auth.login:allow-password-recovery?">
-			<t:a href="recover-password">Recover Password</t:a>
+			<t:a t:href="recover-password">Recover Password</t:a>
 		</t:if>
 	</p>
 

extra/http/server/auth/login/recover-1.xml

@@ -6,23 +6,23 @@
 
 	<p>Enter the username and e-mail address you used to register for this site, and you will receive a link for activating a new password.</p>
 
-	<t:form action="recover-password">
+	<t:form t:action="recover-password">
 
 		<table>
 
 		<tr>
 		<th class="field-label">User name:</th>
-		<td><t:edit component="username" /></td>
+		<td><t:edit t:component="username" /></td>
 		</tr>
 
 		<tr>
 		<th class="field-label">E-mail:</th>
-		<td><t:edit component="email" /></td>
+		<td><t:edit t:component="email" /></td>
 		</tr>
 
 		<tr>
 		<th class="field-label">Captcha:</th>
-		<td><t:edit component="captcha" /></td>
+		<td><t:edit t:component="captcha" /></td>
 		</tr>
 
 		<tr>

extra/http/server/auth/login/recover-3.xml

@@ -6,21 +6,21 @@
 
 	<p>Choose a new password for your account.</p>
 
-	<t:form action="new-password">
+	<t:form t:action="new-password">
 
 		<table>
 
-			<t:edit component="username" />
+			<t:edit t:component="username" />
-			<t:edit component="ticket" />
+			<t:edit t:component="ticket" />
 
 			<tr>
 			<th class="field-label">Password:</th>
-			<td><t:edit component="new-password" /></td>
+			<td><t:edit t:component="new-password" /></td>
 			</tr>
 
 			<tr>
 			<th class="field-label">Verify password:</th>
-			<td><t:edit component="verify-password" /></td>
+			<td><t:edit t:component="verify-password" /></td>
 			</tr>
 
 			<tr>
@@ -33,7 +33,7 @@
 		<p>
 			<input type="submit" value="Set password" />
 
-			<t:if var="http.server.auth.login:password-mismatch?">
+			<t:if t:var="http.server.auth.login:password-mismatch?">
 				<t:error>passwords do not match</t:error>
 			</t:if>
 		</p>

extra/http/server/auth/login/recover-4.xml

@@ -4,6 +4,6 @@
 
 	<t:title>Recover lost password: step 4 of 4</t:title>
 
-	<p>Your password has been reset. You may now <t:a href="login">log in</t:a>.</p>
+	<p>Your password has been reset. You may now <t:a t:href="login">log in</t:a>.</p>
 
 </t:chloe>

extra/http/server/auth/login/register.xml

@@ -4,18 +4,18 @@
 
 	<t:title>New User Registration</t:title>
 
-	<t:form action="register">
+	<t:form t:action="register">
 
 		<table>
 
 		<tr>
 		<th class="field-label">User name:</th>
-		<td><t:edit component="username" /></td>
+		<td><t:edit t:component="username" /></td>
 		</tr>
 
 		<tr>
 		<th class="field-label">Real name:</th>
-		<td><t:edit component="realname" /></td>
+		<td><t:edit t:component="realname" /></td>
 		</tr>
 
 		<tr>
@@ -25,12 +25,12 @@
 
 		<tr>
 		<th class="field-label">Password:</th>
-		<td><t:edit component="new-password" /></td>
+		<td><t:edit t:component="new-password" /></td>
 		</tr>
 
 		<tr>
 		<th class="field-label">Verify:</th>
-		<td><t:edit component="verify-password" /></td>
+		<td><t:edit t:component="verify-password" /></td>
 		</tr>
 
 		<tr>
@@ -40,7 +40,7 @@
 
 		<tr>
 		<th class="field-label">E-mail:</th>
-		<td><t:edit component="email" /></td>
+		<td><t:edit t:component="email" /></td>
 		</tr>
 
 		<tr>
@@ -50,7 +50,7 @@
 
 		<tr>
 		<th class="field-label">Captcha:</th>
-		<td><t:edit component="captcha" /></td>
+		<td><t:edit t:component="captcha" /></td>
 		</tr>
 
 		<tr>
@@ -64,11 +64,11 @@
 
 			<input type="submit" value="Register" />
 
-			<t:if var="http.server.auth.login:user-exists?">
+			<t:if t:var="http.server.auth.login:user-exists?">
 				<t:error>username taken</t:error>
 			</t:if>
 
-			<t:if var="http.server.auth.login:password-mismatch?">
+			<t:if t:var="http.server.auth.login:password-mismatch?">
 				<t:error>passwords do not match</t:error>
 			</t:if>
 

extra/http/server/boilerplate/boilerplate.factor

@@ -68,7 +68,7 @@ M: f call-template* drop call-next-template ;
         bi*
     ] with-scope ; inline
 
-M: boilerplate call-responder
+M: boilerplate call-responder*
     tuck call-next-method
     dup "content-type" header "text/html" = [
         clone swap template>>

extra/http/server/callbacks/callbacks.factor

@@ -96,7 +96,7 @@ SYMBOL: current-show
 : resuming-callback ( responder request -- id )
     cont-id query-param swap callbacks>> at ;
 
-M: callback-responder call-responder ( path responder -- response )
+M: callback-responder call-responder* ( path responder -- response )
     '[
         , ,
 

extra/http/server/crud/crud.factor

@@ -18,7 +18,7 @@ IN: http.server.crud
         [ form view-form ] >>display ;
 
 : <id-redirect> ( id next -- response )
-    swap number>string "id" associate <permanent-redirect> ;
+    swap number>string "id" associate <standard-redirect> ;
 
 :: <edit-action> ( form ctor next -- action )
     <action>
@@ -53,7 +53,7 @@ IN: http.server.crud
         [
             "id" get ctor call delete-tuple
 
-            next f <permanent-redirect>
+            next f <standard-redirect>
         ] >>submit ;
 
 :: <list-action> ( form ctor -- action )

extra/http/server/db/db.factor

@@ -12,5 +12,5 @@ C: <db-persistence> db-persistence
     [ db>> ] [ params>> ] bi make-db db-open
     [ db set ] [ add-always-destructor ] bi ;
 
-M: db-persistence call-responder
+M: db-persistence call-responder*
     [ connect-db ] [ call-next-method ] bi ;

extra/http/server/flows/flows.factor

@@ -10,12 +10,25 @@ TUPLE: flows < filter-responder ;
 C: <flows> flows
 
 : begin-flow* ( -- id )
-    request get [ path>> ] [ query>> ] bi 2array
+    request get
+    [ path>> ] [ request-params ] [ method>> ] tri 3array
     flows sget set-at-unique
     session-changed ;
 
+: end-flow-post ( path params -- response )
+    request [
+        clone
+            "POST" >>method
+            swap >>post-data
+            swap >>path
+    ] change
+    request get path>> split-path
+    flows get responder>> call-responder ;
+
 : end-flow* ( default id -- response )
-    flows sget at [ first2 ] [ f ] ?if <permanent-redirect> ;
+    flows sget at
+    [ first3 "POST" = [ end-flow-post ] [ <standard-redirect> ] if ]
+    [ f <standard-redirect> ] ?if ;
 
 SYMBOL: flow-id
 
@@ -39,10 +52,11 @@ SYMBOL: flow-id
         input/>
     ] when* ;
 
-M: flows call-responder
+M: flows call-responder*
+    dup flows set
     [ add-flow-id ] add-link-hook
     [ flow-form-field ] add-form-hook
-    flow-id-key request-params at flow-id set
+    flow-id-key request get request-params at flow-id set
     call-next-method ;
 
 M: flows init-session*

extra/http/server/server-tests.factor

@@ -27,7 +27,7 @@ TUPLE: mock-responder path ;
 
 C: <mock-responder> mock-responder
 
-M: mock-responder call-responder
+M: mock-responder call-responder*
     nip
     path>> on
     "text/plain" <content> ;
@@ -81,7 +81,7 @@ TUPLE: path-check-responder ;
 
 C: <path-check-responder> path-check-responder
 
-M: path-check-responder call-responder
+M: path-check-responder call-responder*
     drop
     "text/plain" <content> swap >array >>body ;
 
@@ -121,7 +121,7 @@ TUPLE: base-path-check-responder ;
 
 C: <base-path-check-responder> base-path-check-responder
 
-M: base-path-check-responder call-responder
+M: base-path-check-responder call-responder*
     2drop
     "$funny-dispatcher" resolve-base-path
     "text/plain" <content> swap >>body ;

extra/http/server/server.factor

@@ -9,10 +9,10 @@ IN: http.server
 
 ! path is a sequence of path component strings
 
-GENERIC: call-responder ( path responder -- response )
+GENERIC: call-responder* ( path responder -- response )
 
-: request-params ( -- assoc )
+: request-params ( request -- assoc )
-    request get dup method>> {
+    dup method>> {
         { "GET" [ query>> ] }
         { "HEAD" [ query>> ] }
         { "POST" [ post-data>> ] }
@@ -28,7 +28,7 @@ TUPLE: trivial-responder response ;
 
 C: <trivial-responder> trivial-responder
 
-M: trivial-responder call-responder nip response>> call ;
+M: trivial-responder call-responder* nip response>> call ;
 
 : trivial-response-body ( code message -- )
     <html>
@@ -67,6 +67,9 @@ SYMBOL: base-paths
     [ invert-slice ] [ class word-name ] bi*
     base-paths get set-at ;
 
+: call-responder ( path responder -- response )
+    [ add-base-path ] [ call-responder* ] 2bi ;
+
 SYMBOL: link-hook
 
 : add-link-hook ( quot -- )
@@ -139,6 +142,10 @@ SYMBOL: form-hook
 : <temporary-redirect> ( to query -- response )
     307 "Temporary Redirect" <redirect> ;
 
+: <standard-redirect> ( to query -- response )
+    request get method>> "POST" =
+    [ <permanent-redirect> ] [ <temporary-redirect> ] if ;
+
 TUPLE: dispatcher default responders ;
 
 : new-dispatcher ( class -- dispatcher )
@@ -158,8 +165,8 @@ TUPLE: dispatcher default responders ;
         [ >r drop 1 tail-slice r> ] [ drop default>> ] if
     ] if ;
 
-M: dispatcher call-responder ( path dispatcher -- response )
+M: dispatcher call-responder* ( path dispatcher -- response )
-    [ add-base-path ] [ find-responder call-responder ] 2bi ;
+    find-responder call-responder ;
 
 TUPLE: vhost-dispatcher default responders ;
 
@@ -170,7 +177,7 @@ TUPLE: vhost-dispatcher default responders ;
     request get host>> over responders>> at*
     [ nip ] [ drop default>> ] if ;
 
-M: vhost-dispatcher call-responder ( path dispatcher -- response )
+M: vhost-dispatcher call-responder* ( path dispatcher -- response )
     find-vhost call-responder ;
 
 : add-responder ( dispatcher responder path -- dispatcher )
@@ -183,7 +190,7 @@ M: vhost-dispatcher call-responder ( path dispatcher -- response )
 
 TUPLE: filter-responder responder ;
 
-M: filter-responder call-responder
+M: filter-responder call-responder*
     responder>> call-responder ;
 
 SYMBOL: main-responder
@@ -234,14 +241,16 @@ SYMBOL: exit-continuation
 : split-path ( string -- path )
     "/" split [ empty? not ] subset ;
 
+: init-request ( -- )
+    H{ } clone base-paths set
+    [ ] link-hook set
+    [ ] form-hook set ;
+
 : do-request ( request -- response )
     [
-        H{ } clone base-paths set
+        init-request
-        [ ] link-hook set
-        [ ] form-hook set
-
-        [ log-request ]
         [ request set ]
+        [ log-request ]
         [ path>> split-path main-responder get call-responder ] tri
         [ <404> ] unless*
     ] [

extra/http/server/sessions/sessions-tests.factor

@@ -16,7 +16,7 @@ C: <foo> foo
 
 M: foo init-session* drop 0 "x" sset ;
 
-M: foo call-responder
+M: foo call-responder*
     2drop
     "x" [ 1+ ] schange
     "text/html" <content> [ "x" sget pprint ] >>body ;
@@ -53,8 +53,15 @@ M: foo call-responder
 
 "auth-test.db" temp-file sqlite-db [
 
+    init-request
     init-sessions-table
 
+    [ ] [
+        <foo> <session-manager>
+            sessions-in-db >>sessions
+        session-manager set
+    ] unit-test
+
     [
         empty-session
             123 >>id session set
@@ -70,12 +77,6 @@ M: foo call-responder
         [ t ] [ session get changed?>> ] unit-test
     ] with-scope
 
-    [ ] [
-        <foo> <session-manager>
-            sessions-in-db >>sessions
-        session-manager set
-    ] unit-test
-
     [ t ] [
         session-manager get begin-session id>>
         session-manager get sessions>> get-session session?

extra/http/server/sessions/sessions.factor

@@ -10,7 +10,7 @@ http.server.sessions.storage.null
 html.elements ;
 IN: http.server.sessions
 
-TUPLE: session id expiry namespace changed? ;
+TUPLE: session id expires namespace changed? ;
 
 : <session> ( id -- session )
     session new
@@ -24,10 +24,13 @@ M: dispatcher init-session* default>> init-session* ;
 
 M: filter-responder init-session* responder>> init-session* ;
 
-TUPLE: session-manager < filter-responder sessions ;
+TUPLE: session-manager < filter-responder sessions timeout domain ;
 
 : <session-manager> ( responder -- responder' )
-    null-sessions session-manager boa ;
+    session-manager new
+        swap >>responder
+        null-sessions >>sessions
+        20 minutes >>timeout ;
 
 : (session-changed) ( session -- )
     t >>changed? drop ;
@@ -47,18 +50,14 @@ TUPLE: session-manager < filter-responder sessions ;
     [ namespace>> swap change-at ] keep
     (session-changed) ; inline
 
-: sessions session-manager get sessions>> ;
-
 : init-session ( session managed -- )
     >r session r> '[ , init-session* ] with-variable ;
 
-: timeout 20 minutes ;
-
 : cutoff-time ( -- time )
-    now timeout time+ timestamp>millis ;
+    session-manager get timeout>> from-now timestamp>millis ;
 
 : touch-session ( session -- )
-    cutoff-time >>expiry drop ;
+    cutoff-time >>expires drop ;
 
 : empty-session ( -- session )
     f <session>
@@ -73,21 +72,24 @@ TUPLE: session-manager < filter-responder sessions ;
     2tri ;
 
 ! Destructor
-TUPLE: session-saver session ;
+TUPLE: session-saver manager session ;
 
 C: <session-saver> session-saver
 
 M: session-saver dispose
-    session>> dup changed?>> [
+    [ session>> ] [ manager>> sessions>> ] bi
-        [ touch-session ] [ sessions update-session ] bi
+    over changed?>> [
-    ] [ drop ] if ;
+        [ drop touch-session ] [ update-session ] 2bi
+    ] [ 2drop ] if ;
 
-: save-session-after ( session -- )
+: save-session-after ( manager session -- )
     <session-saver> add-always-destructor ;
 
-: existing-session ( path responder session -- response )
+: existing-session ( path manager session -- response )
-    [ session set ] [ save-session-after ] bi
+    [ nip session set ]
-    [ session-manager set ] [ responder>> call-responder ] bi ;
+    [ save-session-after ]
+    [ drop responder>> ] 2tri
+    call-responder ;
 
 : session-id-key "factorsessid" ;
 
@@ -109,13 +111,13 @@ M: session-saver dispose
     >r request-session-id r> sessions>> get-session ;
 
 : <session-cookie> ( id -- cookie )
-    session-id-key <cookie> ;
+    session-id-key <cookie>
+        "$session-manager" resolve-base-path >>path
+        session-manager get timeout>> from-now >>expires
+        session-manager get domain>> >>domain ;
 
-: new-session ( path responder -- response )
+: put-session-cookie ( response -- response' )
-    dup begin-session
+    session get id>> number>string <session-cookie> put-cookie ;
-    [ existing-session ]
-    [ id>> number>string <session-cookie> ] bi
-    put-cookie ;
 
 : session-form-field ( -- )
     <input
@@ -124,6 +126,8 @@ M: session-saver dispose
         session get id>> number>string =value
     input/> ;
 
-M: session-manager call-responder ( path responder -- response )
+M: session-manager call-responder* ( path responder -- response )
     [ session-form-field ] add-form-hook
-    dup request-session [ existing-session ] [ new-session ] if* ;
+    dup session-manager set
+    dup request-session [ dup begin-session ] unless*
+    existing-session put-session-cookie ;

extra/http/server/sessions/storage/db/db.factor

@@ -11,7 +11,7 @@ session "SESSIONS"
 {
     ! { "id" "ID" +random-id+ system-random-generator }
     { "id" "ID" INTEGER +native-id+ }
-    { "expiry" "EXPIRY" BIG-INTEGER +not-null+ }
+    { "expires" "EXPIRES" BIG-INTEGER +not-null+ }
     { "namespace" "NAMESPACE" FACTOR-BLOB }
 } define-persistent
 
@@ -31,7 +31,7 @@ M: sessions-in-db new-session ( session storage -- )
 
 : expired-sessions ( -- session )
     f <session>
-    USE: math now timestamp>millis [ 60 60 * 1000 * - ] keep [a,b] >>expiry
+    USE: math now timestamp>millis [ 60 60 * 1000 * - ] keep [a,b] >>expires
     select-tuples ;
 
 : start-expiring-sessions ( db seq -- )

extra/http/server/static/static.factor

@@ -77,7 +77,7 @@ TUPLE: file-responder root hook special ;
         find-index [ serve-file ] [ list-directory ] ?if
     ] [
         drop
-        request get path>> "/" append f <permanent-redirect>
+        request get path>> "/" append f <standard-redirect>
     ] if ;
 
 : serve-object ( filename -- response )
@@ -86,7 +86,7 @@ TUPLE: file-responder root hook special ;
     [ drop <404> ]
     if ;
 
-M: file-responder call-responder ( path responder -- response )
+M: file-responder call-responder* ( path responder -- response )
     file-responder set
     ".." over member?
     [ drop <400> ] [ "/" join serve-object ] if ;

extra/http/server/templating/chloe/chloe.factor

@@ -1,5 +1,5 @@
 USING: accessors kernel sequences combinators kernel namespaces
-classes.tuple assocs splitting words arrays
+classes.tuple assocs splitting words arrays memoize
 io io.files io.encodings.utf8 html.elements unicode.case
 tuple-syntax xml xml.data xml.writer xml.utilities
 http.server
@@ -19,23 +19,31 @@ C: <chloe> chloe
 
 DEFER: process-template
 
-: chloe-ns TUPLE{ name url: "http://factorcode.org/chloe/1.0" } ;
+: chloe-ns "http://factorcode.org/chloe/1.0" ; inline
+
+: filter-chloe-attrs ( assoc -- assoc' )
+    [ drop name-url chloe-ns = not ] assoc-subset ;
 
 : chloe-tag? ( tag -- ? )
     {
         { [ dup tag? not ] [ f ] }
-        { [ dup chloe-ns names-match? not ] [ f ] }
+        { [ dup url>> chloe-ns = not ] [ f ] }
         [ t ]
     } cond nip ;
 
 SYMBOL: tags
 
+MEMO: chloe-name ( string -- name )
+    name new
+        swap >>tag
+        chloe-ns >>url ;
+
 : required-attr ( tag name -- value )
-    dup rot at*
+    dup chloe-name rot at*
     [ nip ] [ drop " attribute is required" append throw ] if ;
 
 : optional-attr ( tag name -- value )
-    swap at ;
+    chloe-name swap at ;
 
 : write-title-tag ( tag -- )
     drop
@@ -84,7 +92,7 @@ SYMBOL: tags
     dup empty?
     [ drop f ] [ "," split [ dup value ] H{ } map>assoc ] if ;
 
-: a-flow-attr ( tag -- )
+: flow-attr ( tag -- )
     "flow" optional-attr {
         { "none" [ flow-id off ] }
         { "begin" [ begin-flow ] }
@@ -92,7 +100,7 @@ SYMBOL: tags
         { f [ ] }
     } case ;
 
-: a-session-attr ( tag -- )
+: session-attr ( tag -- )
     "session" optional-attr {
         { "none" [ session off flow-id off ] }
         { "current" [ ] }
@@ -102,8 +110,8 @@ SYMBOL: tags
 : a-start-tag ( tag -- )
     [
         <a
-        dup a-flow-attr
+        dup flow-attr
-        dup a-session-attr
+        dup session-attr
         dup "value" optional-attr [ value f ] [
             [ "href" required-attr ]
             [ "query" optional-attr parse-query-attr ]
@@ -122,12 +130,18 @@ SYMBOL: tags
     tri ;
 
 : form-start-tag ( tag -- )
-    <form
+    [
-    "POST" =method
+        <form
-    [ "action" required-attr resolve-base-path =action ]
+        "POST" =method
-    [ tag-attrs [ drop name-tag "action" = not ] assoc-subset print-attrs ] bi
+        {
-    form>
+            [ flow-attr ]
-    hidden-form-field ;
+            [ session-attr ]
+            [ "action" required-attr resolve-base-path =action ]
+            [ tag-attrs filter-chloe-attrs print-attrs ]
+        } cleave
+        form>
+        hidden-form-field
+    ] with-scope ;
 
 : form-tag ( tag -- )
     [ form-start-tag ]

extra/webapps/factor-website/factor-website.factor

@@ -47,7 +47,7 @@ IN: webapps.factor-website
     <boilerplate>
         "page" factor-template >>template
     <flows>
-    <url-sessions>
+    <session-manager>
         sessions-in-db >>sessions
     test-db <db-persistence> ;
 

extra/webapps/factor-website/page.xml

@@ -10,7 +10,7 @@
 		<head>
 			<t:write-title />
 
-			<t:style include="resource:extra/xmode/code2html/stylesheet.css" />
+			<t:style t:include="resource:extra/xmode/code2html/stylesheet.css" />
 
 			<t:style>
 				body, button {

extra/webapps/pastebin/annotation.xml

@@ -2,21 +2,21 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<h2>Annotation: <t:view component="summary" /></h2>
+	<h2>Annotation: <t:view t:component="summary" /></h2>
 
 	<table>
-		<tr><th class="field-label">Author:  </th><td><t:view component="author"  /></td></tr>
+		<tr><th class="field-label">Author:  </th><td><t:view t:component="author"  /></td></tr>
-		<tr><th class="field-label">Mode:    </th><td><t:view component="mode"    /></td></tr>
+		<tr><th class="field-label">Mode:    </th><td><t:view t:component="mode"    /></td></tr>
-		<tr><th class="field-label">Date:    </th><td><t:view component="date"    /></td></tr>
+		<tr><th class="field-label">Date:    </th><td><t:view t:component="date"    /></td></tr>
 	</table>
 
 	<div class="description">
-		<t:view component="contents" />
+		<t:view t:component="contents" />
 	</div>
 
-	<t:form action="$pastebin/delete-annotation" class="inline">
+	<t:form t:action="$pastebin/delete-annotation" class="inline">
-		<t:edit component="id" />
+		<t:edit t:component="id" />
-		<t:edit component="aid" />
+		<t:edit t:component="aid" />
 		<button class="link-button link">Delete Annotation</button>
 	</t:form>
 

extra/webapps/pastebin/new-annotation.xml

@@ -4,15 +4,15 @@
 
 	<t:title>New Annotation</t:title>
 
-	<t:form action="$pastebin/annotate">
+	<t:form t:action="$pastebin/annotate">
-		<t:edit component="id" />
+		<t:edit t:component="id" />
 
 		<table>
-			<tr><th class="field-label">Summary: </th><td><t:edit component="summary" /></td></tr>
+			<tr><th class="field-label">Summary: </th><td><t:edit t:component="summary" /></td></tr>
-			<tr><th class="field-label">Author: </th><td><t:edit component="author" /></td></tr>
+			<tr><th class="field-label">Author: </th><td><t:edit t:component="author" /></td></tr>
-			<tr><th class="field-label">Mode: </th><td><t:edit component="mode" /></td></tr>
+			<tr><th class="field-label">Mode: </th><td><t:edit t:component="mode" /></td></tr>
-			<tr><th class="field-label big-field-label">Description:</th><td><t:edit component="contents" /></td></tr>
+			<tr><th class="field-label big-field-label">Description:</th><td><t:edit t:component="contents" /></td></tr>
-			<tr><th class="field-label">Captcha: </th><td><t:edit component="captcha" /></td></tr>
+			<tr><th class="field-label">Captcha: </th><td><t:edit t:component="captcha" /></td></tr>
 			<tr>
 			<td></td>
 			<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>

extra/webapps/pastebin/new-paste.xml

@@ -4,14 +4,14 @@
 
 	<t:title>New Paste</t:title>
 
-	<t:form action="$pastebin/new-paste">
+	<t:form t:action="$pastebin/new-paste">
 
 		<table>
-			<tr><th class="field-label">Summary: </th><td><t:edit component="summary" /></td></tr>
+			<tr><th class="field-label">Summary: </th><td><t:edit t:component="summary" /></td></tr>
-			<tr><th class="field-label">Author: </th><td><t:edit component="author" /></td></tr>
+			<tr><th class="field-label">Author: </th><td><t:edit t:component="author" /></td></tr>
-			<tr><th class="field-label">Mode: </th><td><t:edit component="mode" /></td></tr>
+			<tr><th class="field-label">Mode: </th><td><t:edit t:component="mode" /></td></tr>
-			<tr><th class="field-label big-field-label">Description: </th><td><t:edit component="contents" /></td></tr>
+			<tr><th class="field-label big-field-label">Description: </th><td><t:edit t:component="contents" /></td></tr>
-			<tr><th class="field-label">Captcha: </th><td><t:edit component="captcha" /></td></tr>
+			<tr><th class="field-label">Captcha: </th><td><t:edit t:component="captcha" /></td></tr>
 			<tr>
 			<td></td>
 			<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>

extra/webapps/pastebin/paste-list.xml

@@ -9,7 +9,7 @@
 		<th align="left" width="100">Paste by:</th>
 		<th align="left" width="200">Date:</th>
 
-		<t:summary component="pastes" />
+		<t:summary t:component="pastes" />
 	</table>
 
 </t:chloe>

extra/webapps/pastebin/paste-summary.xml

@@ -3,9 +3,9 @@
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
 	<tr>
-		<td><t:a href="view-paste" query="id"><t:view component="summary" /></t:a></td>
+		<td><t:a t:href="view-paste" query="id"><t:view t:component="summary" /></t:a></td>
-		<td><t:view component="author" /></td>
+		<td><t:view t:component="author" /></td>
-		<td><t:view component="date" /></td>
+		<td><t:view t:component="date" /></td>
 	</tr>
 
 </t:chloe>

extra/webapps/pastebin/paste.xml

@@ -4,24 +4,22 @@
 
 	<t:title>Pastebin</t:title>
 
-	<h2>Paste: <t:view component="summary" /></h2>
+	<h2>Paste: <t:view t:component="summary" /></h2>
 
 	<table>
-		<tr><th class="field-label">Author:  </th><td><t:view component="author"  /></td></tr>
+		<tr><th class="field-label">Author:  </th><td><t:view t:component="author"  /></td></tr>
-		<tr><th class="field-label">Mode:    </th><td><t:view component="mode"    /></td></tr>
+		<tr><th class="field-label">Mode:    </th><td><t:view t:component="mode"    /></td></tr>
-		<tr><th class="field-label">Date:    </th><td><t:view component="date"    /></td></tr>
+		<tr><th class="field-label">Date:    </th><td><t:view t:component="date"    /></td></tr>
 	</table>
 
-	<div class="description">
+	<pre class="description"><t:view t:component="contents" /></pre>
-		<t:view component="contents" />
-	</div>
 
-	<t:form action="$pastebin/delete-paste" class="inline">
+	<t:form t:action="$pastebin/delete-paste" class="inline">
-		<t:edit component="id" />
+		<t:edit t:component="id" />
 		<button class="link-button link">Delete Paste</button>
 	</t:form>
 	|
-	<t:a href="$pastebin/annotate" query="id">Annotate</t:a>
+	<t:a t:href="$pastebin/annotate" t:query="id">Annotate</t:a>
 
-	<t:view component="annotations" />
+	<t:view t:component="annotations" />
 </t:chloe>

extra/webapps/pastebin/pastebin.factor

@@ -242,7 +242,7 @@ TUPLE: pastebin < dispatcher ;
         <feed-action> "feed.xml" add-responder
         <paste-form> [ <paste> ] <view-paste-action> "view-paste" add-responder
                    [ <paste> ] "$pastebin/list" <delete-paste-action> <protected> "delete-paste" add-responder
-                   [ <annotation> ] "$pastebin/view-paste" <protected> <delete-annotation-action> "delete-annotation" add-responder
+                   [ <annotation> ] "$pastebin/view-paste" <delete-annotation-action> <protected> "delete-annotation" add-responder
         <paste-form> [ <paste> ]    <view-paste-action>     "$pastebin/view-paste"   add-responder
         <new-paste-form> [ <paste> now >>date ] "$pastebin/view-paste" <new-paste-action>     "new-paste"    add-responder
         <new-annotation-form> [ <annotation> now >>date ] "$pastebin/view-paste" <annotate-action> "annotate" add-responder

extra/webapps/pastebin/pastebin.xml

@@ -2,24 +2,27 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:atom title="Pastebin - Atom" href="$pastebin/feed.xml" />
+	<t:atom t:title="Pastebin - Atom" t:href="$pastebin/feed.xml" />
 
-	<t:style include="resource:extra/webapps/pastebin/pastebin.css" />
+	<t:style t:include="resource:extra/webapps/pastebin/pastebin.css" />
 
 	<div class="navbar">
-		  <t:a href="$pastebin/list">Pastes</t:a>
+		  <t:a t:href="$pastebin/list">Pastes</t:a>
-		| <t:a href="$pastebin/new-paste">New Paste</t:a>
+		| <t:a t:href="$pastebin/new-paste">New Paste</t:a>
-		| <t:a href="$pastebin/feed.xml">Atom Feed</t:a>
+		| <t:a t:href="$pastebin/feed.xml">Atom Feed</t:a>
+
+		<t:if t:svar="http.server.auth:logged-in-user">
+
+			<t:if t:code="http.server.auth.login:allow-edit-profile?">
+				| <t:a t:href="$login/edit-profile" t:flow="begin">Edit Profile</t:a>
+			</t:if>
+
+			<t:form t:action="$login/logout" t:flow="begin" class="inline">
+				| <button type="submit" class="link-button link">Logout</button>
+			</t:form>
 
-		<t:comment>
-		<t:if code="http.server.auth.login:allow-edit-profile?">
-			| <t:a href="$login/edit-profile" flow="begin">Edit Profile</t:a>
 		</t:if>
 
-		<t:form action="$login/logout" class="inline">
-			| <button type="submit" class="link-button link">Logout</button>
-		</t:form>
-		</t:comment>
 	</div>
 
 	<h1><t:write-title /></h1>

extra/webapps/planet/admin.xml

@@ -4,11 +4,11 @@
 
 	<t:title>Planet Factor Administration</t:title>
 
-	<t:summary component="blogroll" />
+	<t:summary t:component="blogroll" />
 
 	<p>
-		<t:a href="$planet-factor/admin/edit-blog">Add Blog</t:a>
+		<t:a t:href="$planet-factor/admin/edit-blog">Add Blog</t:a>
-		| <t:a href="$planet-factor/admin/update">Update</t:a>
+		| <t:a t:href="$planet-factor/admin/update">Update</t:a>
 	</p>
 
 </t:chloe>

extra/webapps/planet/blog-admin-link.xml

@@ -2,6 +2,6 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:a href="$planet-factor/admin/edit-blog" query="id"><t:view component="name" /></t:a>
+	<t:a t:href="$planet-factor/admin/edit-blog" t:query="id"><t:view t:component="name" /></t:a>
 
 </t:chloe>

extra/webapps/planet/edit-blog.xml

@@ -4,25 +4,25 @@
 
 	<t:title>Edit Blog</t:title>
 
-	<t:form action="$planet-factor/admin/edit-blog">
+	<t:form t:action="$planet-factor/admin/edit-blog">
 
-		<t:edit component="id" />
+		<t:edit t:component="id" />
 
 		<table>
 
 			<tr>
 				<th class="field-label">Blog name:</th>
-				<td><t:edit component="name" /></td>
+				<td><t:edit t:component="name" /></td>
 			</tr>
 
 			<tr>
 				<th class="field-label">Home page:</th>
-				<td><t:edit component="www-url" /></td>
+				<td><t:edit t:component="www-url" /></td>
 			</tr>
 
 			<tr>
 				<th class="field-label">Feed:</th>
-				<td><t:edit component="feed-url" /></td>
+				<td><t:edit t:component="feed-url" /></td>
 			</tr>
 
 		</table>
@@ -31,8 +31,8 @@
 
 	</t:form>
 
-	<t:form action="$planet-factor/admin/delete-blog" class="inline">
+	<t:form t:action="$planet-factor/admin/delete-blog" class="inline">
-		<t:edit component="id" />
+		<t:edit t:component="id" />
 		<button type="submit" class="link-button link">Delete</button>
 	</t:form>
 </t:chloe>

extra/webapps/planet/entry-summary.xml

@@ -3,8 +3,8 @@
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
 	<p class="news">
-		<strong><t:view component="title" /></strong> <br/>
+		<strong><t:view t:component="title" /></strong> <br/>
-		<t:a value="link" session="none" class="more">Read More...</t:a>
+		<t:a value="link" t:session="none" class="more">Read More...</t:a>
 	</p>
 
 </t:chloe>

extra/webapps/planet/entry.xml

@@ -3,15 +3,15 @@
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
 	<h2 class="posting-title">
-		<t:a value="link" session="none"><t:view component="title" /></t:a>
+		<t:a t:value="link" t:session="none"><t:view t:component="title" /></t:a>
 	</h2>
 
 	<p class="posting-body">
-		<t:view component="description" />
+		<t:view t:component="description" />
 	</p>
 
 	<p class="posting-date">
-		<t:a value="link" session="none"><t:view component="pub-date" /></t:a>
+		<t:a t:value="link" t:session="none"><t:view t:component="pub-date" /></t:a>
 	</p>
 
 </t:chloe>

extra/webapps/planet/planet.factor

@@ -169,5 +169,8 @@ blog "BLOGS"
 
 : start-update-task ( planet db seq -- )
     '[
-        , , , [ update-cached-postings ] with-db
+        , , , [
+            dup filter-responder? [ responder>> ] when
+            update-cached-postings
+        ] with-db
     ] 10 minutes every drop ;

extra/webapps/planet/planet.xml

@@ -8,19 +8,19 @@
 	<t:style include="resource:extra/webapps/planet/planet.css" />
 
 	<div class="navbar">
-		  <t:a href="$planet-factor/list">Front Page</t:a>
+		  <t:a t:href="$planet-factor/list">Front Page</t:a>
-		| <t:a href="$planet-factor/feed.xml">Atom Feed</t:a>
+		| <t:a t:href="$planet-factor/feed.xml">Atom Feed</t:a>
-		| <t:a href="$planet-factor/admin">Admin</t:a>
+		| <t:a t:href="$planet-factor/admin">Admin</t:a>
 
-		<t:comment>
+		<t:if t:svar="http.server.auth:logged-in-user">
-		<t:if code="http.server.auth.login:allow-edit-profile?">
+			<t:if t:code="http.server.auth.login:allow-edit-profile?">
-			| <t:a href="$login/edit-profile" flow="begin">Edit Profile</t:a>
+				| <t:a t:href="$login/edit-profile" t:flow="begin">Edit Profile</t:a>
+			</t:if>
+	
+			<t:form t:action="$login/logout" t:flow="begin" class="inline">
+				| <button type="submit" class="link-button link">Logout</button>
+			</t:form>
 		</t:if>
-
-		<t:form action="$login/logout" class="inline">
-			| <button type="submit" class="link-button link">Logout</button>
-		</t:form>
-		</t:comment>
 	</div>
 
 	<h1><t:write-title /></h1>

extra/webapps/planet/postings-summary.xml

@@ -2,6 +2,6 @@
 
 <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
 
-	<t:summary component="postings" />
+	<t:summary t:component="postings" />
 
 </t:chloe>

extra/webapps/planet/postings.xml

@@ -6,12 +6,12 @@
 
 	<table width="100%" cellpadding="10">
                 <tr>
-                        <td> <t:view component="postings" /> </td>
+                        <td> <t:view t:component="postings" /> </td>
   
                         <td valign="top" width="25%" class="infobox">
                                 <h2>Blogroll</h2>
   
-                                <t:summary component="blogroll" />
+                                <t:summary t:component="blogroll" />
                         </td>
                 </tr>
         </table>

extra/webapps/todo/todo-list.xml

@@ -6,7 +6,7 @@
 
 	<table class="todo-list">
 		<tr><th>Summary</th><th>Priority</th><th>View</th><th>Edit</th></tr>
-		<t:summary component="list" />
+		<t:summary t:component="list" />
 	</table>
 
 </t:chloe>

extra/webapps/todo/todo-summary.xml

@@ -4,16 +4,16 @@
 
 	<tr>
 		<td>
-			<t:view component="summary" />
+			<t:view t:component="summary" />
 		</td>
 		<td>
-			<t:view component="priority" />
+			<t:view t:component="priority" />
 		</td>
 		<td>
-			<t:a href="$todo-list/view" query="id">View</t:a>
+			<t:a t:href="$todo-list/view" t:query="id">View</t:a>
 		</td>
 		<td>
-			<t:a href="$todo-list/edit" query="id">Edit</t:a>
+			<t:a t:href="$todo-list/edit" t:query="id">Edit</t:a>
 		</td>
 	</tr>
 

extra/webapps/todo/todo.xml

@@ -5,14 +5,14 @@
 	<t:style include="resource:extra/webapps/todo/todo.css" />
 
 	<div class="navbar">
-		  <t:a href="$todo-list/list">List Items</t:a>
+		  <t:a t:href="$todo-list/list">List Items</t:a>
-		| <t:a href="$todo-list/edit">Add Item</t:a>
+		| <t:a t:href="$todo-list/edit">Add Item</t:a>
 
-		<t:if code="http.server.auth.login:allow-edit-profile?">
+		<t:if t:code="http.server.auth.login:allow-edit-profile?">
-			| <t:a href="$login/edit-profile" flow="begin">Edit Profile</t:a>
+			| <t:a t:href="$login/edit-profile" t:flow="begin">Edit Profile</t:a>
 		</t:if>
 
-		<t:form action="$login/logout" class="inline">
+		<t:form t:action="$login/logout" t:flow="begin" class="inline">
 			| <button type="submit" class="link-button link">Logout</button>
 		</t:form>
 	</div>

extra/webapps/todo/view-todo.xml

@@ -10,13 +10,13 @@
 	</table>
 
 	<div class="description">
-		<t:view component="description" />
+		<t:view t:component="description" />
 	</div>
 
-	<t:a href="$todo-list/edit" query="id">Edit</t:a>
+	<t:a t:href="$todo-list/edit" t:query="id">Edit</t:a>
 	|
-	<t:form action="$todo-list/delete" class="inline">
+	<t:form t:action="$todo-list/delete" class="inline">
-		<t:edit component="id" />
+		<t:edit t:component="id" />
 		<button class="link-button link">Delete</button>
 	</t:form>