Working on https server support

diff --git a/extra/furnace/asides/asides.factor b/extra/furnace/asides/asides.factor
index 15d1c1df0b8bb23b1a7aef06628dcfcfba6fea45..9f1411188c66f3f557195de015ae38ac818bf644 100644 (file)
--- a/extra/furnace/asides/asides.factor
+++ b/extra/furnace/asides/asides.factor
@@ -4,7 +4,7 @@ USING: accessors namespaces sequences arrays kernel
 assocs assocs.lib hashtables math.parser urls combinators
 html.elements html.templates.chloe.syntax db.types db.tuples
 http http.server http.server.filters 
-furnace furnace.cache furnace.sessions ;
+furnace furnace.cache furnace.sessions furnace.redirection ;
 IN: furnace.asides
 
 TUPLE: aside < server-state session method url post-data ;

diff --git a/extra/furnace/auth/features/recover-password/recover-password.factor b/extra/furnace/auth/features/recover-password/recover-password.factor
index 1e8d163e9905ba1278cf2820222dda59a6a96648..806df024f0cf4a75aa6828c3a574877c2c528176 100644 (file)
--- a/extra/furnace/auth/features/recover-password/recover-password.factor
+++ b/extra/furnace/auth/features/recover-password/recover-password.factor
@@ -3,7 +3,8 @@
 USING: namespaces accessors kernel assocs arrays io.sockets threads
 fry urls smtp validators html.forms
 http http.server.responses http.server.dispatchers
-furnace furnace.actions furnace.auth furnace.auth.providers ;
+furnace furnace.actions furnace.auth furnace.auth.providers
+furnace.redirection ;
 IN: furnace.auth.features.recover-password
 
 SYMBOL: lost-password-from

diff --git a/extra/furnace/auth/features/registration/registration.factor b/extra/furnace/auth/features/registration/registration.factor
index 2bc7688b10f69e00df08e30269f466be702b4a23..5c1851fb64f8458bcdd493918b9b4f54ab9ddab7 100644 (file)
--- a/extra/furnace/auth/features/registration/registration.factor
+++ b/extra/furnace/auth/features/registration/registration.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs kernel namespaces validators html.forms urls
 http.server.dispatchers
-furnace furnace.auth furnace.auth.providers furnace.actions ;
+furnace furnace.auth furnace.auth.providers furnace.actions
+furnace.redirection ;
 IN: furnace.auth.features.registration
 
 : <register-action> ( -- action )

diff --git a/extra/furnace/auth/login/login.factor b/extra/furnace/auth/login/login.factor
index e2b208de3a4c627691b96a248790b0b4108899fc..4c53cb9c89991e8081c4dbaef9cb123efaf1bc7b 100755 (executable)
--- a/extra/furnace/auth/login/login.factor
+++ b/extra/furnace/auth/login/login.factor
@@ -10,6 +10,7 @@ furnace.asides
 furnace.actions\r
 furnace.sessions\r
 furnace.utilities\r
+furnace.redirection\r
 furnace.auth.login.permits ;\r
 IN: furnace.auth.login\r
 \r
@@ -94,7 +95,7 @@ M: login-realm login-required*
     begin-aside\r
     protected get description>> description set\r
     protected get capabilities>> capabilities set\r
-    URL" $realm/login" flashed-variables <flash-redirect> ;\r
+    URL" $realm/login" >secure-url flashed-variables <flash-redirect> ;\r
 \r
 : <login-realm> ( responder name -- auth )\r
     login-realm new-realm\r

diff --git a/extra/furnace/flash/flash.factor b/extra/furnace/flash/flash.factor
index e06cdac09093535da643ca3c84717790403220fe..2149e4fcd773db3c0d4cd39058a028e49296254b 100644 (file)
--- a/extra/furnace/flash/flash.factor
+++ b/extra/furnace/flash/flash.factor
@@ -3,7 +3,7 @@
 USING: namespaces assocs assocs.lib kernel sequences accessors
 urls db.types db.tuples math.parser fry
 http http.server http.server.filters http.server.redirection
-furnace furnace.cache furnace.sessions ;
+furnace furnace.cache furnace.sessions furnace.redirection ;
 IN: furnace.flash
 
 TUPLE: flash-scope < server-state session namespace ;

diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor
index 521f8a3bc1cb47a857905f7ec38ca758509fb3b6..90b529e385af43dea30747d539fe08f855e7b249 100644 (file)
--- a/extra/furnace/furnace.factor
+++ b/extra/furnace/furnace.factor
@@ -63,13 +63,6 @@ M: url adjust-url
 
 M: string adjust-url ;
 
-: <redirect> ( url -- response )
-    adjust-url request get method>> {
-        { "GET" [ <temporary-redirect> ] }
-        { "HEAD" [ <temporary-redirect> ] }
-        { "POST" [ <permanent-redirect> ] }
-    } case ;
-
 GENERIC: modify-form ( responder -- )
 
 M: object modify-form drop ;

diff --git a/extra/furnace/redirection/redirection.factor b/extra/furnace/redirection/redirection.factor
new file mode 100644 (file)
index 0000000..7f87c67
--- /dev/null
+++ b/extra/furnace/redirection/redirection.factor
@@ -0,0 +1,29 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors combinators namespaces
+io.servers.connection
+http http.server http.server.redirection
+furnace ;
+IN: furnace.redirection
+
+: <redirect> ( url -- response )
+    adjust-url request get method>> {
+        { "GET" [ <temporary-redirect> ] }
+        { "HEAD" [ <temporary-redirect> ] }
+        { "POST" [ <permanent-redirect> ] }
+    } case ;
+
+: >secure-url ( url -- url' )
+    clone
+        "https" >>protocol
+        secure-port >>port ;
+
+: <secure-redirect> ( url -- response )
+    >secure-url <redirect> ;
+
+TUPLE: redirect-responder to ;
+
+: <redirect-responder> ( url -- responder )
+    redirect-responder boa ;
+
+M: redirect-responder call-responder* nip to>> <redirect> ;

diff --git a/extra/furnace/sessions/sessions-tests.factor b/extra/furnace/sessions/sessions-tests.factor
index a97ba091c07d7a1bfda442341e05b8ac5f118679..98d1bbdfc96db96f2e549717bc961aaa26f7dfc4 100755 (executable)
--- a/extra/furnace/sessions/sessions-tests.factor
+++ b/extra/furnace/sessions/sessions-tests.factor
@@ -1,7 +1,7 @@
 IN: furnace.sessions.tests\r
 USING: tools.test http furnace.sessions\r
 furnace.actions http.server http.server.responses\r
-math namespaces kernel accessors io.sockets io.server\r
+math namespaces kernel accessors io.sockets io.servers.connection\r
 prettyprint io.streams.string io.files splitting destructors\r
 sequences db db.tuples db.sqlite continuations urls math.parser\r
 furnace ;\r

diff --git a/extra/furnace/sessions/sessions.factor b/extra/furnace/sessions/sessions.factor
index 863b8f87cbd12daa86adbca71031b8258fdfd156..6e50417ea13e4c3ad86868c3795f281cb156d99f 100755 (executable)
--- a/extra/furnace/sessions/sessions.factor
+++ b/extra/furnace/sessions/sessions.factor
@@ -1,8 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs kernel math.intervals math.parser namespaces
-random accessors quotations hashtables sequences continuations
-fry calendar combinators combinators.lib destructors alarms io.server
+strings random accessors quotations hashtables sequences continuations
+fry calendar combinators combinators.lib destructors alarms
+io.servers.connection
 db db.tuples db.types
 http http.server http.server.dispatchers http.server.filters
 html.elements
@@ -109,7 +110,7 @@ M: session-saver dispose
 
 : request-session ( -- session/f )
     session-id-key
-    client-state dup [ string>number ] when
+    client-state dup string? [ string>number ] when
     get-session verify-session ;
 
 : <session-cookie> ( -- cookie )

diff --git a/extra/http/http-tests.factor b/extra/http/http-tests.factor
index 73d26aa3279341ea051fbbb7311f781d09d9e3cf..b5ed1445792505a74259c1a159881df8d8272074 100755 (executable)
--- a/extra/http/http-tests.factor
+++ b/extra/http/http-tests.factor
@@ -123,7 +123,7 @@ read-response-test-1' 1array [
 ! Live-fire exercise
 USING: http.server http.server.static furnace.sessions furnace.alloy
 furnace.actions furnace.auth furnace.auth.login furnace.db http.client
-io.server io.files io io.encodings.ascii
+io.servers.connection io.files io io.encodings.ascii
 accessors namespaces threads
 http.server.responses http.server.redirection
 http.server.dispatchers db.tuples ;

diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor
index f709939e211a69efeb0b470d384fd1135bf2fc7e..0312e62e8dc89bbef69e60bed852a219095198fc 100755 (executable)
--- a/extra/http/server/server.factor
+++ b/extra/http/server/server.factor
@@ -4,7 +4,6 @@ USING: kernel accessors sequences arrays namespaces splitting
 vocabs.loader destructors assocs debugger continuations
 combinators tools.vocabs tools.time math
 io
-io.server
 io.sockets
 io.sockets.secure
 io.encodings
@@ -12,6 +11,7 @@ io.encodings.utf8
 io.encodings.ascii
 io.encodings.binary
 io.streams.limited
+io.servers.connection
 io.timeouts
 fry logging logging.insomniac calendar urls
 http
@@ -118,10 +118,6 @@ LOG: httpd-header NOTICE
 : ?refresh-all ( -- )
     development? get-global [ global [ refresh-all ] bind ] when ;
 
-: setup-limits ( -- )
-    1 minutes timeouts
-    64 1024 * limit-input ;
-
 LOG: httpd-benchmark DEBUG
 
 : ?benchmark ( quot -- )
@@ -130,25 +126,23 @@ LOG: httpd-benchmark DEBUG
         httpd-benchmark
     ] [ call ] if ; inline
 
-: handle-client ( -- )
+TUPLE: http-server < threaded-server ;
+
+M: http-server handle-client*
+    drop
     [
-        setup-limits
-        ascii decode-input
-        ascii encode-output
+        64 1024 * limit-input
         ?refresh-all
         read-request
         [ do-request ] ?benchmark
         [ do-response ] ?benchmark
     ] with-destructors ;
 
-: httpd ( port -- )
-    dup integer? [ internet-server ] when
-    "http.server" binary [ handle-client ] with-server ;
-
-: httpd-main ( -- )
-    8888 httpd ;
-
-: httpd-insomniac ( -- )
-    "http.server" { httpd-hit } schedule-insomniac ;
+: <http-server> ( -- server )
+    http-server new-threaded-server
+        "http.server" >>name
+        "http" protocol-port >>insecure
+        "https" protocol-port >>secure ;
 
-MAIN: httpd-main
+: http-insomniac ( -- )
+    "http.server" { "httpd-hit" } schedule-insomniac ;

diff --git a/extra/webapps/blogs/blogs.factor b/extra/webapps/blogs/blogs.factor
index aa1aa5edc740dc05619f9ad8b82fc831424ab2a3..10e0ab54c01989f0fd4436119b5e14f119f33abc 100644 (file)
--- a/extra/webapps/blogs/blogs.factor
+++ b/extra/webapps/blogs/blogs.factor
@@ -7,6 +7,7 @@ html.components
 http.server.dispatchers
 furnace
 furnace.actions
+furnace.redirection
 furnace.auth
 furnace.auth.login
 furnace.boilerplate

diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor
index 251872d1ac6248a8d1512302a4de92fa3569ffe8..3aeb21420fb7fa218687ddec541a20885989ad27 100644 (file)
--- a/extra/webapps/pastebin/pastebin.factor
+++ b/extra/webapps/pastebin/pastebin.factor
@@ -12,6 +12,7 @@ http.server.dispatchers
 http.server.redirection
 furnace
 furnace.actions
+furnace.redirection
 furnace.auth
 furnace.auth.login
 furnace.boilerplate

diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor
index b472881e73613bab6069c3ec888f73ddbe89c133..ca74b7e6421fe066f89d8549f9c96220efa4565f 100755 (executable)
--- a/extra/webapps/planet/planet.factor
+++ b/extra/webapps/planet/planet.factor
@@ -10,6 +10,7 @@ http.server
 http.server.dispatchers
 furnace
 furnace.actions
+furnace.redirection
 furnace.boilerplate
 furnace.auth.login
 furnace.auth

diff --git a/extra/webapps/todo/todo.factor b/extra/webapps/todo/todo.factor
index 4b1b59e80fbbf0d517df3cd5f8fc3d30d38be497..0fb7e7dc89212ecd0e77cba6eb8e270b73718bf1 100755 (executable)
--- a/extra/webapps/todo/todo.factor
+++ b/extra/webapps/todo/todo.factor
@@ -11,6 +11,7 @@ furnace
 furnace.boilerplate
 furnace.auth
 furnace.actions
+furnace.redirection
 furnace.db
 furnace.auth.login ;
 IN: webapps.todo

diff --git a/extra/webapps/user-admin/user-admin.factor b/extra/webapps/user-admin/user-admin.factor
index 8c7b1b21c9104a482d4e9dc42d50e48b5e13b080..359730d4b2dfbc2a64f067efef88ca6bc3996176 100644 (file)
--- a/extra/webapps/user-admin/user-admin.factor
+++ b/extra/webapps/user-admin/user-admin.factor
@@ -12,6 +12,7 @@ furnace.auth.providers.db
 furnace.auth.login
 furnace.auth
 furnace.actions
+furnace.redirection
 furnace.utilities
 http.server
 http.server.dispatchers ;

diff --git a/extra/webapps/wee-url/wee-url.factor b/extra/webapps/wee-url/wee-url.factor
index 2396e98b2ad0952b368e1fbc066179571453145c..27187c4352e30f638866921243d7a7bf1e013fcb 100644 (file)
--- a/extra/webapps/wee-url/wee-url.factor
+++ b/extra/webapps/wee-url/wee-url.factor
@@ -4,7 +4,7 @@
 USING: math.ranges sequences random accessors combinators.lib
 kernel namespaces fry db.types db.tuples urls validators
 html.components html.forms http http.server.dispatchers furnace
-furnace.actions furnace.boilerplate ;
+furnace.actions furnace.boilerplate furnace.redirection ;
 IN: webapps.wee-url
 
 TUPLE: wee-url < dispatcher ;

diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor
index 13c445b0a8e4433fca59dd38210b55bcb5bd4b23..77ee24266884eda5a3ea5b8d552b9ea84f659d18 100644 (file)
--- a/extra/webapps/wiki/wiki.factor
+++ b/extra/webapps/wiki/wiki.factor
@@ -8,6 +8,7 @@ http.server
 http.server.dispatchers
 furnace
 furnace.actions
+furnace.redirection
 furnace.auth
 furnace.auth.login
 furnace.boilerplate

diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor
new file mode 100644 (file)
index 0000000..fcf98b0
--- /dev/null
+++ b/extra/websites/concatenative/concatenative.factor
@@ -0,0 +1,88 @@
+! Copyright (c) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel sequences assocs io.files io.sockets
+io.sockets.secure io.servers.connection
+namespaces db db.tuples db.sqlite smtp urls
+logging.insomniac
+http.server
+http.server.dispatchers
+http.server.redirection
+furnace.alloy
+furnace.auth.login
+furnace.auth.providers.db
+furnace.auth.features.edit-profile
+furnace.auth.features.recover-password
+furnace.auth.features.registration
+furnace.boilerplate
+furnace.redirection
+webapps.blogs
+webapps.pastebin
+webapps.planet
+webapps.todo
+webapps.wiki
+webapps.wee-url
+webapps.user-admin ;
+IN: websites.concatenative
+
+: test-db ( -- db params ) "resource:test.db" sqlite-db ;
+
+: init-factor-db ( -- )
+    test-db [
+        init-furnace-tables
+
+        {
+            post comment
+            paste annotation
+            blog posting
+            todo
+            short-url
+            article revision
+        } ensure-tables
+    ] with-db ;
+
+TUPLE: factor-website < dispatcher ;
+
+: <factor-website> ( -- responder )
+    factor-website new-dispatcher
+        <blogs> "blogs" add-responder
+        <todo-list> "todo" add-responder
+        <pastebin> "pastebin" add-responder
+        <planet-factor> "planet" add-responder
+        <wiki> "wiki" add-responder
+        <wee-url> "wee-url" add-responder
+        <user-admin> "user-admin" add-responder
+        URL" /wiki/view/Front Page" <redirect-responder> "" add-responder
+    "Factor website" <login-realm>
+        "Factor website" >>name
+        allow-registration
+        allow-password-recovery
+        allow-edit-profile
+    <boilerplate>
+        { factor-website "page" } >>template
+    test-db <alloy> ;
+
+: init-factor-website ( -- )
+    "factorcode.org" 25 <inet> smtp-server set-global
+    "todo@factorcode.org" lost-password-from set-global
+    "website@factorcode.org" insomniac-sender set-global
+    "slava@factorcode.org" insomniac-recipients set-global
+    init-factor-db
+    <factor-website> main-responder set-global ;
+
+: <factor-secure-config> ( -- config )
+    <secure-config>
+        "resource:extra/openssl/test/server.pem" >>key-file
+        "resource:extra/openssl/test/dh1024.pem" >>dh-file
+        "password" >>password ;
+
+: <factor-website-server> ( -- threaded-server )
+    <http-server>
+        <factor-secure-config> >>secure-config
+        8080 >>insecure
+        8431 >>secure ;
+
+: start-factor-website ( -- )
+    test-db start-expiring
+    test-db start-update-task
+    http-insomniac
+    <factor-website-server> start-server ;

diff --git a/extra/websites/concatenative/page.css b/extra/websites/concatenative/page.css
new file mode 100644 (file)
index 0000000..49e2688
--- /dev/null
+++ b/extra/websites/concatenative/page.css
@@ -0,0 +1,78 @@
+body, button {
+       font:9pt "Lucida Grande", "Lucida Sans Unicode", verdana, geneva, sans-serif;
+       color:#444;
+}
+
+.link-button {
+       padding: 0px;
+       background: none;
+       border: none;
+}
+
+a, .link {
+       color: #222;
+       border-bottom:1px dotted #666;
+       text-decoration:none;
+}
+
+a:hover, .link:hover {
+       border-bottom:1px solid #66a;
+}
+
+.error { color: #a00; }
+
+.errors li { color: #a00; }
+
+.field-label {
+       text-align: right;
+}
+
+.inline {
+       display: inline;
+}
+
+.navbar {
+       background-color: #eee;
+       padding: 5px;
+       border: 1px solid #ccc;
+}
+
+.big-field-label {
+       vertical-align: top;
+}
+
+.description {
+       padding: 5px;
+       color: #000;
+}
+
+.description pre {
+       border: 1px dashed #ccc;
+       background-color: #f5f5f5;
+}
+
+.description p:first-child {
+       margin-top: 0px;
+}
+
+.description p:last-child {
+       margin-bottom: 0px;
+}
+
+.description table, .description td {
+    border-color: #666;
+    border-style: solid;
+}
+
+.description table {
+    border-width: 0 0 1px 1px;
+    border-spacing: 0;
+    border-collapse: collapse;
+}
+
+.description td {
+    margin: 0;
+    padding: 4px;
+    border-width: 1px 1px 0 0;
+}
+

diff --git a/extra/websites/concatenative/page.xml b/extra/websites/concatenative/page.xml
new file mode 100644 (file)
index 0000000..464a3d9
--- /dev/null
+++ b/extra/websites/concatenative/page.xml
@@ -0,0 +1,28 @@
+<?xml version='1.0' ?>
+
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+       "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+
+<html xmlns="http://www.w3.org/1999/xhtml">
+
+       <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+               <head>
+                       <t:write-title />
+
+                       <t:style t:include="resource:extra/xmode/code2html/stylesheet.css" />
+
+                       <t:style t:include="resource:extra/websites/concatenative/page.css" />
+
+                       <t:write-style />
+
+                       <t:write-atom />
+               </head>
+
+               <body>
+                       <t:call-next-template />
+               </body>
+
+       </t:chloe>
+
+</html>