diff --git a/basis/furnace/auth/auth.factor b/basis/furnace/auth/auth.factor index 8e18c18df9..1b5c5f9e73 100755 --- a/basis/furnace/auth/auth.factor +++ b/basis/furnace/auth/auth.factor @@ -3,7 +3,7 @@ USING: accessors assocs namespaces kernel sequences sets destructors combinators fry logging io.encodings.utf8 io.encodings.string io.binary random -checksums checksums.sha2 +checksums checksums.sha2 urls html.forms http.server http.server.filters @@ -60,6 +60,10 @@ TUPLE: realm < dispatcher name users checksum secure ; GENERIC: login-required* ( description capabilities realm -- response ) +GENERIC: user-registered ( user realm -- response ) + +M: object user-registered 2drop URL" $realm" ; + GENERIC: init-realm ( realm -- ) GENERIC: logged-in-username ( realm -- username ) diff --git a/basis/furnace/auth/features/registration/registration.factor b/basis/furnace/auth/features/registration/registration.factor index da58e2b2ed..ef8923c98b 100644 --- a/basis/furnace/auth/features/registration/registration.factor +++ b/basis/furnace/auth/features/registration/registration.factor @@ -33,8 +33,7 @@ IN: furnace.auth.features.registration users new-user [ user-exists ] unless* realm get init-user-profile - - URL" $realm" + realm get user-registered ] >>submit ; diff --git a/basis/furnace/auth/login/login.factor b/basis/furnace/auth/login/login.factor index 232e217305..2c98672490 100755 --- a/basis/furnace/auth/login/login.factor +++ b/basis/furnace/auth/login/login.factor @@ -104,6 +104,9 @@ M: login-realm login-required* ( description capabilities login -- response ) URL" $realm/login" ] if ; +M: login-realm user-registered ( user realm -- ) + drop successful-login ; + : ( responder name -- auth ) login-realm new-realm "login" add-responder diff --git a/basis/furnace/furnace-tests.factor b/basis/furnace/furnace-tests.factor index 223b20455d..00e4f6f152 100644 --- a/basis/furnace/furnace-tests.factor +++ b/basis/furnace/furnace-tests.factor @@ -1,7 +1,7 @@ IN: furnace.tests -USING: http.server.dispatchers http.server.responses +USING: http http.server.dispatchers http.server.responses http.server furnace tools.test kernel namespaces accessors -io.streams.string ; +io.streams.string urls ; TUPLE: funny-dispatcher < dispatcher ; : funny-dispatcher new-dispatcher ; @@ -33,3 +33,9 @@ M: base-path-check-responder call-responder* [ "" ] [ [ "&&&" "foo" hidden-form-field ] with-string-writer ] unit-test + +[ f ] [ request [ referrer ] with-variable ] unit-test + +[ t ] [ URL" http://foo" dup url [ same-host? ] with-variable ] unit-test + +[ f ] [ f URL" http://foo" url [ same-host? ] with-variable ] unit-test diff --git a/basis/furnace/furnace.factor b/basis/furnace/furnace.factor index 4f0189e3f4..376da79ef2 100644 --- a/basis/furnace/furnace.factor +++ b/basis/furnace/furnace.factor @@ -4,7 +4,7 @@ USING: namespaces make assocs sequences kernel classes splitting vocabs.loader accessors strings combinators arrays continuations present fry urls html.elements -http http.server http.server.redirection ; +http http.server http.server.redirection http.server.remapping ; IN: furnace : nested-responders ( -- seq ) @@ -89,16 +89,19 @@ M: object modify-form drop ; ] } } case ; -: referrer ( -- referrer ) +: referrer ( -- referrer/f ) #! Typo is intentional, its in the HTTP spec! - "referer" request get header>> at >url ; + "referer" request get header>> at + dup [ >url ensure-port [ remap-port ] change-port ] when ; : user-agent ( -- user-agent ) "user-agent" request get header>> at "" or ; : same-host? ( url -- ? ) - url get - [ [ protocol>> ] [ host>> ] [ port>> ] tri 3array ] bi@ = ; + dup [ + url get + [ [ protocol>> ] [ host>> ] [ port>> ] tri 3array ] bi@ = + ] when ; : cookie-client-state ( key request -- value/f ) swap get-cookie dup [ value>> ] when ; diff --git a/basis/furnace/redirection/redirection.factor b/basis/furnace/redirection/redirection.factor index 113319d83b..c5a63a795c 100644 --- a/basis/furnace/redirection/redirection.factor +++ b/basis/furnace/redirection/redirection.factor @@ -1,9 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors combinators namespaces fry -io.servers.connection urls http http.server -http.server.redirection http.server.responses -http.server.filters furnace ; +USING: kernel accessors combinators namespaces fry urls http +http.server http.server.redirection http.server.responses +http.server.remapping http.server.filters furnace ; IN: furnace.redirection : ( url -- response ) @@ -16,7 +15,7 @@ IN: furnace.redirection : >secure-url ( url -- url' ) clone "https" >>protocol - secure-port >>port ; + secure-http-port >>port ; : ( url -- response ) >secure-url ; diff --git a/basis/furnace/referrer/referrer.factor b/basis/furnace/referrer/referrer.factor index 4cfd4bb6c6..b7a3df4b53 100644 --- a/basis/furnace/referrer/referrer.factor +++ b/basis/furnace/referrer/referrer.factor @@ -14,4 +14,4 @@ M: referrer-check call-responder* [ 2drop 403 "Bad referrer" ] if ; : ( responder -- responder' ) - [ same-host? post-request? not or ] ; + [ post-request? [ same-host? ] [ drop f ] if ] ; diff --git a/basis/http/server/remapping/remapping.factor b/basis/http/server/remapping/remapping.factor new file mode 100644 index 0000000000..36e769731b --- /dev/null +++ b/basis/http/server/remapping/remapping.factor @@ -0,0 +1,12 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: namespaces assocs kernel io.servers.connection ; +IN: http.server.remapping + +SYMBOL: port-remapping + +: remap-port ( n -- n' ) + [ port-remapping get at ] keep or ; + +: secure-http-port ( -- n ) + secure-port remap-port ; diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index bad1eb4831..3acae8d927 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -18,6 +18,7 @@ fry logging logging.insomniac calendar urls http http.parsers http.server.responses +http.server.remapping html.templates html.elements html.streams ; @@ -198,19 +199,20 @@ LOG: httpd-header NOTICE [ local-address get [ secure? "https" "http" ? >>protocol ] - [ port>> '[ _ or ] change-port ] + [ port>> remap-port '[ _ or ] change-port ] bi ] change-url drop ; : valid-request? ( request -- ? ) - url>> port>> local-address get port>> = ; + url>> port>> remap-port + local-address get port>> remap-port = ; : do-request ( request -- response ) '[ _ { - [ init-request ] [ prepare-request ] + [ init-request ] [ log-request ] [ dup valid-request? [ dispatch-request ] [ drop <400> ] if ] } cleave diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index 7d72659f6d..1b8707fc8c 100755 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -2,10 +2,10 @@ ! See http://factorcode.org/license.txt for BSD license. USING: continuations destructors kernel math math.parser namespaces parser sequences strings prettyprint debugger -quotations combinators logging calendar assocs +quotations combinators logging calendar assocs present fry accessors arrays io io.sockets io.encodings.ascii io.sockets.secure io.files io.streams.duplex io.timeouts -io.encodings threads concurrency.combinators +io.encodings threads make concurrency.combinators concurrency.semaphores concurrency.flags combinators.short-circuit ; IN: io.servers.connection @@ -56,11 +56,17 @@ GENERIC: handle-client* ( threaded-server -- ) [ secure>> >secure ] [ insecure>> >insecure ] bi [ resolve-host ] bi@ append ; -LOG: accepted-connection NOTICE +: accepted-connection ( remote local -- ) + [ + [ "remote: " % present % ", " % ] + [ "local: " % present % ] + bi* + ] "" make + \ accepted-connection NOTICE log-message ; : log-connection ( remote local -- ) + [ accepted-connection ] [ [ remote-address set ] [ local-address set ] bi* ] - [ 2array accepted-connection ] 2bi ; M: threaded-server handle-client* handler>> call ; diff --git a/basis/io/sockets/secure/secure.factor b/basis/io/sockets/secure/secure.factor index 3e516dff8b..42ca727653 100755 --- a/basis/io/sockets/secure/secure.factor +++ b/basis/io/sockets/secure/secure.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel symbols namespaces continuations destructors io.sockets sequences summary calendar delegate -system vocabs.loader combinators ; +system vocabs.loader combinators present ; IN: io.sockets.secure SYMBOL: secure-socket-timeout @@ -43,6 +43,8 @@ TUPLE: secure addrspec ; C: secure +M: secure present addrspec>> present " (secure)" append ; + CONSULT: inet secure addrspec>> ; M: secure resolve-host ( secure -- seq ) diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 8c9f26b1dd..9bfcc7e310 100755 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -5,8 +5,8 @@ USING: generic kernel io.backend namespaces continuations sequences arrays io.encodings io.ports io.streams.duplex io.encodings.ascii alien.strings io.binary accessors destructors classes debugger byte-arrays system combinators parser -alien.c-types math.parser splitting grouping -math assocs summary system vocabs.loader combinators ; +alien.c-types math.parser splitting grouping math assocs summary +system vocabs.loader combinators present ; IN: io.sockets << { @@ -40,7 +40,14 @@ TUPLE: local path ; : ( path -- addrspec ) normalize-path local boa ; -TUPLE: inet4 host port ; +M: local present path>> "Unix domain socket: " prepend ; + +TUPLE: abstract-inet host port ; + +M: abstract-inet present + [ host>> ":" ] [ port>> number>string ] bi 3append ; + +TUPLE: inet4 < abstract-inet ; C: inet4 @@ -81,7 +88,7 @@ M: inet4 parse-sockaddr >r dup sockaddr-in-addr r> inet-ntop swap sockaddr-in-port ntohs ; -TUPLE: inet6 host port ; +TUPLE: inet6 < abstract-inet ; C: inet6 @@ -255,7 +262,7 @@ HOOK: addrinfo-error io-backend ( n -- ) GENERIC: resolve-host ( addrspec -- seq ) -TUPLE: inet host port ; +TUPLE: inet < abstract-inet ; C: inet diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index f4a6a7d792..488e0a121c 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -212,15 +212,13 @@ PRIVATE> [ [ host>> ] [ port>> ] bi ] [ protocol>> ] bi secure-protocol? [ ] when ; -ERROR: no-protocol-found protocol ; - : protocol-port ( protocol -- port ) { { "http" [ 80 ] } { "https" [ 443 ] } { "feed" [ 80 ] } { "ftp" [ 21 ] } - [ no-protocol-found ] + [ drop f ] } case ; : ensure-port ( url -- url' )