diff --git a/library/httpd/httpd.factor b/library/httpd/httpd.factor index 53166c4b8f..605d60303e 100644 --- a/library/httpd/httpd.factor +++ b/library/httpd/httpd.factor @@ -29,11 +29,11 @@ IN: httpd USE: arithmetic USE: combinators USE: errors +USE: kernel USE: lists USE: logging USE: logic USE: namespaces -USE: regexp USE: stack USE: stdio USE: streams @@ -46,37 +46,38 @@ USE: url-encoding "400 Bad request" httpd-error ; : url>path ( uri -- path ) - url-decode dup "http://.*?(/.*)" group1 dup [ - nip + url-decode dup "http://" str-head? dup [ + "/" split1 f "" replace nip nip ] [ drop ] ifte ; -: secure-path ( request -- path ) - dup [ - "(.*?)( HTTP.*|)" group1 dup [ - dup #".*\.\.+" re-matches [ drop f ] when - ] when - ] when ; +: secure-path ( path -- path ) + ".." over str-contains? [ drop f ] when ; -: httpd-request ( request -- ) +: handle-request ( arg cmd -- ) + [ + [ "GET" = ] [ drop "get" serve-responder ] + [ "POST" = ] [ drop "post" serve-responder ] + [ drop t ] [ 2drop bad-request ] + ] cond ; + +: parse-request ( request -- ) dup log - secure-path dup [ - url>path - - [ - [ "GET (.+)" | [ car "get" serve-responder ] ] - [ "POST (.+)" | [ car "post" serve-responder ] ] - [ t | [ drop bad-request ] ] - ] re-cond + " " split1 dup [ + " HTTP" split1 drop url>path secure-path dup [ + swap handle-request + ] [ + 2drop bad-request + ] ifte ] [ - drop bad-request + 2drop bad-request ] ifte ; : httpd-client ( socket -- ) [ "stdio" get "client" set log-client - read [ httpd-request ] when* + read [ parse-request ] when* ] with-stream ; : quit-flag ( -- ? ) diff --git a/library/httpd/responder.factor b/library/httpd/responder.factor index f2b2c821e9..5dccbccc6c 100644 --- a/library/httpd/responder.factor +++ b/library/httpd/responder.factor @@ -56,7 +56,7 @@ USE: httpd "200 Document follows" "text/plain" response print ; : get-responder ( name -- responder ) - "httpd-responders" get [ get ] bind ; + "httpd-responders" get get* ; : responder-argument ( argument -- argument ) dup f-or-"" [ drop "default-argument" get ] when ; diff --git a/library/platform/jvm/init.factor b/library/platform/jvm/init.factor index c310c97499..be8edf6fdf 100644 --- a/library/platform/jvm/init.factor +++ b/library/platform/jvm/init.factor @@ -29,6 +29,7 @@ IN: init USE: combinators USE: compiler USE: continuations +USE: httpd-responder USE: kernel USE: lists USE: interpreter @@ -68,6 +69,7 @@ USE: strings init-environment init-search-path init-scratchpad + default-responders "args" get parse-command-line run-user-init diff --git a/library/platform/native/boot.factor b/library/platform/native/boot.factor index 2e5fe9ef12..d1a7e829eb 100644 --- a/library/platform/native/boot.factor +++ b/library/platform/native/boot.factor @@ -82,6 +82,7 @@ primitives, "/library/httpd/url-encoding.factor" "/library/httpd/http-common.factor" "/library/httpd/responder.factor" + "/library/httpd/httpd.factor" "/library/math/arc-trig-hyp.factor" "/library/math/arithmetic.factor" "/library/math/list-math.factor" diff --git a/library/platform/native/init.factor b/library/platform/native/init.factor index 31cb124f25..1d8994ce85 100644 --- a/library/platform/native/init.factor +++ b/library/platform/native/init.factor @@ -31,6 +31,7 @@ USE: arithmetic USE: errors USE: combinators USE: hashtables +USE: httpd-responder USE: kernel USE: lists USE: logic @@ -74,6 +75,7 @@ USE: unparser init-scratchpad init-styles init-vocab-styles + ! default-responders run-user-init diff --git a/library/test/httpd/httpd.factor b/library/test/httpd/httpd.factor index 0126256606..5f08d73acb 100644 --- a/library/test/httpd/httpd.factor +++ b/library/test/httpd/httpd.factor @@ -41,6 +41,28 @@ USE: url-encoding ] with-logging ] unit-test +[ "index.html" ] +[ "http://www.jedit.org/index.html" url>path ] unit-test + +[ "foo/bar" ] +[ "http://www.jedit.org/foo/bar" url>path ] unit-test + +[ "" ] +[ "http://www.jedit.org/" url>path ] unit-test + +[ "" ] +[ "http://www.jedit.org" url>path ] unit-test + +[ "foobar" ] +[ "foobar" secure-path ] unit-test + +[ f ] +[ "foobar/../baz" secure-path ] unit-test + +[ ] [ "GET /index.html" parse-request ] unit-test +[ ] [ "GET ../index.html" parse-request ] unit-test +[ ] [ "POO" parse-request ] unit-test + [ ] [ "/" "get" ] [ serve-responder ] test-word [ ] [ "" "get" ] [ serve-responder ] test-word [ ] [ "test" "get" ] [ serve-responder ] test-word