httpd runs in native factor with no responders

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 [
+    url-decode dup "http://" str-head? dup [
-        nip
+        "/" split1 f "" replace nip nip
     ] [
         drop
     ] ifte ;
 
-: secure-path ( request -- path )
+: secure-path ( path -- path )
-    dup [
+    ".." over str-contains? [ drop f ] when ;
-        "(.*?)( HTTP.*|)" group1 dup [
-            dup #".*\.\.+" re-matches [ drop f ] when
-        ] when
-    ] when ;
-
-: httpd-request ( request -- )
-    dup log
-    secure-path dup [
-        url>path
 
+: handle-request ( arg cmd -- )
     [
-            [ "GET (.+)"  | [ car "get"  serve-responder ] ]
+        [ "GET"  = ] [ drop "get"  serve-responder ]
-            [ "POST (.+)" | [ car "post" serve-responder ] ]
+        [ "POST" = ] [ drop "post" serve-responder ]
-            [ t           | [ drop bad-request           ] ]
+        [ drop t   ] [ 2drop bad-request           ]
-        ] re-cond
+    ] cond ;
+
+: parse-request ( request -- )
+    dup log
+    " " split1 dup [
+        " HTTP" split1 drop url>path secure-path dup [
+            swap handle-request
         ] [
-        drop bad-request
+            2drop bad-request
+        ] ifte
+    ] [
+        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 ( -- ? )

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 ;

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
 

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"

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
 

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