From cc605060b20d0928c0e9b803b1ab154b6ef33e1b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 17 Jun 2008 00:10:46 -0500 Subject: [PATCH] Working on https server support --- extra/furnace/asides/asides.factor | 2 +- .../recover-password/recover-password.factor | 3 +- .../features/registration/registration.factor | 3 +- extra/furnace/auth/login/login.factor | 3 +- extra/furnace/flash/flash.factor | 2 +- extra/furnace/furnace.factor | 7 -- extra/furnace/redirection/redirection.factor | 29 ++++++ extra/furnace/sessions/sessions-tests.factor | 2 +- extra/furnace/sessions/sessions.factor | 7 +- extra/http/http-tests.factor | 2 +- extra/http/server/server.factor | 32 +++---- extra/webapps/blogs/blogs.factor | 1 + extra/webapps/pastebin/pastebin.factor | 1 + extra/webapps/planet/planet.factor | 1 + extra/webapps/todo/todo.factor | 1 + extra/webapps/user-admin/user-admin.factor | 1 + extra/webapps/wee-url/wee-url.factor | 2 +- extra/webapps/wiki/wiki.factor | 1 + .../concatenative/concatenative.factor | 88 +++++++++++++++++++ extra/websites/concatenative/page.css | 78 ++++++++++++++++ extra/websites/concatenative/page.xml | 28 ++++++ 21 files changed, 257 insertions(+), 37 deletions(-) create mode 100644 extra/furnace/redirection/redirection.factor create mode 100644 extra/websites/concatenative/concatenative.factor create mode 100644 extra/websites/concatenative/page.css create mode 100644 extra/websites/concatenative/page.xml diff --git a/extra/furnace/asides/asides.factor b/extra/furnace/asides/asides.factor index 15d1c1df0b..9f1411188c 100644 --- 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 1e8d163e99..806df024f0 100644 --- 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 2bc7688b10..5c1851fb64 100644 --- 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 : ( -- action ) diff --git a/extra/furnace/auth/login/login.factor b/extra/furnace/auth/login/login.factor index e2b208de3a..4c53cb9c89 100755 --- a/extra/furnace/auth/login/login.factor +++ b/extra/furnace/auth/login/login.factor @@ -10,6 +10,7 @@ furnace.asides furnace.actions furnace.sessions furnace.utilities +furnace.redirection furnace.auth.login.permits ; IN: furnace.auth.login @@ -94,7 +95,7 @@ M: login-realm login-required* begin-aside protected get description>> description set protected get capabilities>> capabilities set - URL" $realm/login" flashed-variables ; + URL" $realm/login" >secure-url flashed-variables ; : ( responder name -- auth ) login-realm new-realm diff --git a/extra/furnace/flash/flash.factor b/extra/furnace/flash/flash.factor index e06cdac090..2149e4fcd7 100644 --- 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 521f8a3bc1..90b529e385 100644 --- a/extra/furnace/furnace.factor +++ b/extra/furnace/furnace.factor @@ -63,13 +63,6 @@ M: url adjust-url M: string adjust-url ; -: ( url -- response ) - adjust-url request get method>> { - { "GET" [ ] } - { "HEAD" [ ] } - { "POST" [ ] } - } 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 index 0000000000..7f87c677b9 --- /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 + +: ( url -- response ) + adjust-url request get method>> { + { "GET" [ ] } + { "HEAD" [ ] } + { "POST" [ ] } + } case ; + +: >secure-url ( url -- url' ) + clone + "https" >>protocol + secure-port >>port ; + +: ( url -- response ) + >secure-url ; + +TUPLE: redirect-responder to ; + +: ( url -- responder ) + redirect-responder boa ; + +M: redirect-responder call-responder* nip to>> ; diff --git a/extra/furnace/sessions/sessions-tests.factor b/extra/furnace/sessions/sessions-tests.factor index a97ba091c0..98d1bbdfc9 100755 --- a/extra/furnace/sessions/sessions-tests.factor +++ b/extra/furnace/sessions/sessions-tests.factor @@ -1,7 +1,7 @@ IN: furnace.sessions.tests USING: tools.test http furnace.sessions furnace.actions http.server http.server.responses -math namespaces kernel accessors io.sockets io.server +math namespaces kernel accessors io.sockets io.servers.connection prettyprint io.streams.string io.files splitting destructors sequences db db.tuples db.sqlite continuations urls math.parser furnace ; diff --git a/extra/furnace/sessions/sessions.factor b/extra/furnace/sessions/sessions.factor index 863b8f87cb..6e50417ea1 100755 --- 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 ; : ( -- cookie ) diff --git a/extra/http/http-tests.factor b/extra/http/http-tests.factor index 73d26aa327..b5ed144579 100755 --- 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 f709939e21..0312e62e8d 100755 --- 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 ; +: ( -- server ) + http-server new-threaded-server + "http.server" >>name + "http" protocol-port >>insecure + "https" protocol-port >>secure ; -: httpd-main ( -- ) - 8888 httpd ; - -: httpd-insomniac ( -- ) - "http.server" { httpd-hit } schedule-insomniac ; - -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 aa1aa5edc7..10e0ab54c0 100644 --- 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 251872d1ac..3aeb21420f 100644 --- 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 b472881e73..ca74b7e642 100755 --- 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 4b1b59e80f..0fb7e7dc89 100755 --- 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 8c7b1b21c9..359730d4b2 100644 --- 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 2396e98b2a..27187c4352 100644 --- 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 13c445b0a8..77ee242668 100644 --- 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 index 0000000000..fcf98b08da --- /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 ; + +: ( -- responder ) + factor-website new-dispatcher + "blogs" add-responder + "todo" add-responder + "pastebin" add-responder + "planet" add-responder + "wiki" add-responder + "wee-url" add-responder + "user-admin" add-responder + URL" /wiki/view/Front Page" "" add-responder + "Factor website" + "Factor website" >>name + allow-registration + allow-password-recovery + allow-edit-profile + + { factor-website "page" } >>template + test-db ; + +: init-factor-website ( -- ) + "factorcode.org" 25 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 + main-responder set-global ; + +: ( -- config ) + + "resource:extra/openssl/test/server.pem" >>key-file + "resource:extra/openssl/test/dh1024.pem" >>dh-file + "password" >>password ; + +: ( -- threaded-server ) + + >>secure-config + 8080 >>insecure + 8431 >>secure ; + +: start-factor-website ( -- ) + test-db start-expiring + test-db start-update-task + http-insomniac + start-server ; diff --git a/extra/websites/concatenative/page.css b/extra/websites/concatenative/page.css new file mode 100644 index 0000000000..49e26883ad --- /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 index 0000000000..464a3d9c5d --- /dev/null +++ b/extra/websites/concatenative/page.xml @@ -0,0 +1,28 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +