From ac1855bc1550b54fd173a8780b40e2656b34982d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 11 Aug 2004 03:48:08 +0000 Subject: [PATCH] native factor httpd --- TODO.FACTOR.txt | 4 +++- library/errors.factor | 2 +- library/httpd/default-responders.factor | 26 +++++++++++------------ library/httpd/html.factor | 4 +++- library/httpd/quit-responder.factor | 1 - library/httpd/test-responder.factor | 12 +++++------ library/init.factor | 6 +++++- library/inspector.factor | 2 +- library/namespaces.factor | 4 ---- library/platform/jvm/boot-sumo.factor | 2 +- library/platform/jvm/stack2.factor | 4 ++++ library/platform/jvm/stream.factor | 24 +++++++++------------ library/platform/native/boot.factor | 4 ++++ library/platform/native/init.factor | 2 +- library/platform/native/namespaces.factor | 3 ++- library/platform/native/stack.factor | 6 +++++- library/sbuf.factor | 20 +++++++++++++++++ library/stream.factor | 14 ++++++++++++ library/strings.factor | 13 ------------ library/test/httpd/httpd.factor | 2 -- library/test/test.factor | 17 ++++++++++++--- 21 files changed, 107 insertions(+), 65 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 2584b13d1a..a214e380d7 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -26,7 +26,6 @@ + tests: -- finish split - java factor: equal numbers have non-equal hashcodes! - sbuf= - vector-hashcode @@ -89,6 +88,9 @@ ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable + httpd: +- multitasking +- don't die if one client errors +- inspect: always use inspect/ URL prefix, not responder name var - httpd: don't flush so much - log with date - log user agent diff --git a/library/errors.factor b/library/errors.factor index feb664160d..5bd158d655 100644 --- a/library/errors.factor +++ b/library/errors.factor @@ -58,7 +58,7 @@ USE: vectors namestack "error-namestack" set catchstack "error-catchstack" set ] bind - ] when* ; + ] when ; : catch ( try catch -- ) #! Call the try quotation. If an error occurs restore the diff --git a/library/httpd/default-responders.factor b/library/httpd/default-responders.factor index 0e42a876b5..983dc74b07 100644 --- a/library/httpd/default-responders.factor +++ b/library/httpd/default-responders.factor @@ -53,17 +53,17 @@ USE: wiki-responder "quit" "responder" set [ quit-responder ] "get" set ] extend "quit" set - - [ - "file" "responder" set - [ file-responder ] "get" set - ] extend "file" set - - [ - "wiki" "responder" set - [ wiki-get-responder ] "get" set - [ wiki-post-responder ] "post" set - "wiki" set - "WikiHome" "default-argument" set - ] extend "wiki" set +! +! [ +! "file" "responder" set +! [ file-responder ] "get" set +! ] extend "file" set +! +! [ +! "wiki" "responder" set +! [ wiki-get-responder ] "get" set +! [ wiki-post-responder ] "post" set +! "wiki" set +! "WikiHome" "default-argument" set +! ] extend "wiki" set ] extend "httpd-responders" set ; diff --git a/library/httpd/html.factor b/library/httpd/html.factor index ecb4a0860a..0e13b15f75 100644 --- a/library/httpd/html.factor +++ b/library/httpd/html.factor @@ -122,7 +122,9 @@ USE: url-encoding ] extend ; : with-html-stream ( quot -- ) - "stdio" get swap with-stream ; + [ + "stdio" get "stdio" set call + ] with-scope ; : html-head ( title -- ) "" write diff --git a/library/httpd/quit-responder.factor b/library/httpd/quit-responder.factor index cb77914d98..40c0006940 100644 --- a/library/httpd/quit-responder.factor +++ b/library/httpd/quit-responder.factor @@ -26,7 +26,6 @@ ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. IN: quit-responder -USE: combinators USE: namespaces USE: stdio USE: stack diff --git a/library/httpd/test-responder.factor b/library/httpd/test-responder.factor index 879e251701..323723c4d9 100644 --- a/library/httpd/test-responder.factor +++ b/library/httpd/test-responder.factor @@ -26,13 +26,13 @@ ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. IN: test-responder -USE: stdio -USE: prettyprint - +USE: html USE: httpd USE: httpd-responder +USE: stack +USE: test : test-responder ( argument -- ) - serving-text - "This is the test responder." print - "Argument is " write . ; + drop + serving-html + "Factor Test Suite" [ all-tests ] simple-html-document ; diff --git a/library/init.factor b/library/init.factor index 15f388683d..5a76f6bc70 100644 --- a/library/init.factor +++ b/library/init.factor @@ -133,7 +133,11 @@ USE: vocabularies [ "top-level-continuation" set ] callcc0 ; : (word-of-the-day) ( -- word ) - vocabs random-element words random-element ; + vocabs random-element words dup [ + random-element + ] [ + drop (word-of-the-day) ( empty vocab ) + ] ifte ; : word-of-the-day ( -- ) #! Something to entertain the poor hacker. diff --git a/library/inspector.factor b/library/inspector.factor index 80cbb114d0..7f7cd0b98a 100644 --- a/library/inspector.factor +++ b/library/inspector.factor @@ -100,5 +100,5 @@ USE: vocabularies : describe-object-path ( string -- ) [ dup "object-path" set - global-object-path describe + "'" split global [ object-path ] bind describe ] with-scope ; diff --git a/library/namespaces.factor b/library/namespaces.factor index 626e558e42..987e4283ed 100644 --- a/library/namespaces.factor +++ b/library/namespaces.factor @@ -121,10 +121,6 @@ USE: vectors #! Returns f if any of the objects are not set. this swap object-path-iter ; -: global-object-path ( string -- object ) - #! An object path based from the global namespace. - "'" split global [ object-path ] bind ; - : on ( var -- ) t put ; : off ( var -- ) f put ; : toggle ( var -- ) dup get not put ; diff --git a/library/platform/jvm/boot-sumo.factor b/library/platform/jvm/boot-sumo.factor index 8763a375d2..b9dd70b5da 100644 --- a/library/platform/jvm/boot-sumo.factor +++ b/library/platform/jvm/boot-sumo.factor @@ -52,8 +52,8 @@ USE: parser "/library/platform/jvm/errors.factor" run-resource ! errors "/library/platform/jvm/namespaces.factor" run-resource ! namespaces "/library/namespaces.factor" run-resource ! namespaces -"/library/sbuf.factor" run-resource ! strings "/library/list-namespaces.factor" run-resource ! namespaces +"/library/sbuf.factor" run-resource ! strings "/library/math/namespace-math.factor" run-resource ! arithmetic "/library/continuations.factor" run-resource ! continuations "/library/errors.factor" run-resource ! errors diff --git a/library/platform/jvm/stack2.factor b/library/platform/jvm/stack2.factor index 5e9b368582..417dfecef4 100644 --- a/library/platform/jvm/stack2.factor +++ b/library/platform/jvm/stack2.factor @@ -69,3 +69,7 @@ USE: vectors #! this from a word definition will clobber any values left #! on the data stack by the caller. datastack* vector-clear ; + +: depth ( -- n ) + #! Push the number of elements on the datastack. + datastack vector-length ; diff --git a/library/platform/jvm/stream.factor b/library/platform/jvm/stream.factor index 2e60ed8ae8..a86f18f710 100644 --- a/library/platform/jvm/stream.factor +++ b/library/platform/jvm/stream.factor @@ -139,19 +139,6 @@ USE: strings [ <char-stream>/fclose ] "fclose" set ] extend ; -: <string-output-stream> ( size -- stream ) - #! Creates a new stream for writing to a string buffer. - <stream> [ - <sbuf> "buf" set - ( string -- ) - [ "buf" get sbuf-append ] "fwrite" set - ] extend ; - -: stream>str ( stream -- string ) - #! Returns the string written to the given string output - #! stream. - [ "buf" get ] bind >str ; - : <bwriter> ( writer -- bwriter ) [ "java.io.Writer" ] "java.io.BufferedWriter" jnew ; @@ -233,6 +220,15 @@ USE: strings ] "fclose" set ] extend ; +: socket-closed? ( socket -- ? ) + [ ] "java.net.Socket" "isClosed" jinvoke ; + +: close-socket ( socket -- ) + [ ] "java.net.Socket" "close" jinvoke ; + +: ?close-socket ( socket -- ) + dup socket-closed? [ drop ] [ close-socket ] ifte ; + : <socket-stream> ( socket -- stream ) #! Wraps a socket inside a byte-stream. dup @@ -245,7 +241,7 @@ USE: strings ! We "extend" byte-stream's fclose. ( -- ) "fclose" get [ - "socket" get [ ] "java.net.Socket" "close" jinvoke + "socket" get ?close-socket ] append "fclose" set ] extend ; diff --git a/library/platform/native/boot.factor b/library/platform/native/boot.factor index d1a7e829eb..cc80644603 100644 --- a/library/platform/native/boot.factor +++ b/library/platform/native/boot.factor @@ -83,6 +83,10 @@ primitives, "/library/httpd/http-common.factor" "/library/httpd/responder.factor" "/library/httpd/httpd.factor" + "/library/httpd/inspect-responder.factor" + "/library/httpd/test-responder.factor" + "/library/httpd/quit-responder.factor" + "/library/httpd/default-responders.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 1d8994ce85..0c33a94c5f 100644 --- a/library/platform/native/init.factor +++ b/library/platform/native/init.factor @@ -75,7 +75,7 @@ USE: unparser init-scratchpad init-styles init-vocab-styles - ! default-responders + default-responders run-user-init diff --git a/library/platform/native/namespaces.factor b/library/platform/native/namespaces.factor index b66bf9eb38..57d928b224 100644 --- a/library/platform/native/namespaces.factor +++ b/library/platform/native/namespaces.factor @@ -44,7 +44,8 @@ DEFER: >n : set-global ( g -- ) 4 setenv ; : init-namespaces ( -- ) - 64 <vector> set-namestack* global >n ; + 64 <vector> set-namestack* global >n + global "global" set ; : namespace-buckets 23 ; diff --git a/library/platform/native/stack.factor b/library/platform/native/stack.factor index 48d5eac64c..4a7988ecb9 100644 --- a/library/platform/native/stack.factor +++ b/library/platform/native/stack.factor @@ -42,4 +42,8 @@ USE: vectors #! Clear the datastack. For interactive use only; invoking #! this from a word definition will clobber any values left #! on the data stack by the caller. - 0 <vector> set-datastack ; + { } set-datastack ; + +: depth ( -- n ) + #! Push the number of elements on the datastack. + datastack vector-length ; diff --git a/library/sbuf.factor b/library/sbuf.factor index 924aa7a98a..fb7ce2485e 100644 --- a/library/sbuf.factor +++ b/library/sbuf.factor @@ -29,6 +29,7 @@ IN: strings USE: arithmetic USE: combinators USE: kernel +USE: lists USE: namespaces USE: strings USE: stack @@ -59,3 +60,22 @@ USE: stack #! push a new string constructed from return values. #! The quotation must have stack effect ( X -- X ). <% swap [ swap dup >r call % r> ] str-each drop %> ; + +: split-next ( index string split -- next ) + 3dup index-of* dup -1 = [ + >r drop swap str-tail , r> ( end of string ) + ] [ + swap str-length dupd + >r swap substring , r> + ] ifte ; + +: (split) ( index string split -- ) + 2dup >r >r split-next dup -1 = [ + drop r> drop r> drop + ] [ + r> r> (split) + ] ifte ; + +: split ( string split -- list ) + #! Split the string at each occurrence of split, and push a + #! list of the pieces. + [, 0 -rot (split) ,] ; diff --git a/library/stream.factor b/library/stream.factor index 10e8817682..100b55f041 100644 --- a/library/stream.factor +++ b/library/stream.factor @@ -29,6 +29,7 @@ IN: streams USE: errors USE: kernel USE: namespaces +USE: strings ! Generic functions, of sorts... @@ -102,3 +103,16 @@ USE: namespaces ( string -- ) [ "stream" get fprint ] "fprint" set ] extend ; + +: <string-output-stream> ( size -- stream ) + #! Creates a new stream for writing to a string buffer. + <stream> [ + <sbuf> "buf" set + ( string -- ) + [ "buf" get sbuf-append ] "fwrite" set + ] extend ; + +: stream>str ( stream -- string ) + #! Returns the string written to the given string output + #! stream. + [ "buf" get ] bind sbuf>str ; diff --git a/library/strings.factor b/library/strings.factor index 61b5adbe89..3c946c3a78 100644 --- a/library/strings.factor +++ b/library/strings.factor @@ -114,19 +114,6 @@ USE: stack [ = ] dip f ? ] ifte ; -: split ( string split -- list ) - #! Split the string at each occurrence of split, and push a - #! list of the pieces. - 2dup index-of dup -1 = [ - 2drop dup str-length 0 = [ - drop f - ] [ - unit - ] ifte - ] [ - swap [ str// ] dip split cons - ] ifte ; - : split1 ( string split -- before after ) #! The car of the pair is the string up to the first #! occurrence of split; the cdr is the remainder of diff --git a/library/test/httpd/httpd.factor b/library/test/httpd/httpd.factor index 5f08d73acb..42360fd16b 100644 --- a/library/test/httpd/httpd.factor +++ b/library/test/httpd/httpd.factor @@ -65,8 +65,6 @@ USE: url-encoding [ ] [ "/" "get" ] [ serve-responder ] test-word [ ] [ "" "get" ] [ serve-responder ] test-word -[ ] [ "test" "get" ] [ serve-responder ] test-word -[ ] [ "test/" "get" ] [ serve-responder ] test-word [ ] [ "does-not-exist!" "get" ] [ serve-responder ] test-word [ ] [ "does-not-exist!/" "get" ] [ serve-responder ] test-word diff --git a/library/test/test.factor b/library/test/test.factor index 8024a218f5..dfc68a3d86 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -25,9 +25,15 @@ USE: vocabularies : print-test ( input output -- ) "TESTING: " write 2list . ; +: keep-datastack ( quot -- ) + datastack >r call r> set-datastack drop ; + : unit-test ( output input -- ) - 2dup print-test - swap >r >r clear r> call datastack vector>list r> = assert ; + [ + 2dup print-test + swap >r >r clear r> call datastack vector>list r> + = assert + ] keep-datastack 2drop ; : test-word ( output input word -- ) #! Old-style test. @@ -44,8 +50,12 @@ USE: vocabularies : test ( name -- ) ! Run the given test. + depth pred >r "Testing " write dup write "..." print - "/library/test/" swap ".factor" cat3 run-resource ; + "/library/test/" swap ".factor" cat3 run-resource + "Checking before/after depth..." print + depth r> = assert + ; : all-tests ( -- ) "Running Factor test suite..." print @@ -59,6 +69,7 @@ USE: vocabularies "lists/namespaces" "combinators" "continuations" + "errors" "hashtables" "strings" "namespaces/namespaces"