steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

native factor httpd

cvs
Slava Pestov 2004-08-11 03:48:08 +00:00
parent cda61358bf
commit ac1855bc15
21 changed files with 107 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
TODO.FACTOR.txt
View File

@ -26,7 +26,6 @@
+ tests: + tests:
- finish split
- java factor: equal numbers have non-equal hashcodes! - java factor: equal numbers have non-equal hashcodes!
- sbuf= - sbuf=
- vector-hashcode - vector-hashcode
@ -89,6 +88,9 @@ ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable
+ httpd: + 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 - httpd: don't flush so much
- log with date - log with date
- log user agent - log user agent

2
library/errors.factor
View File

@ -58,7 +58,7 @@ USE: vectors
namestack "error-namestack" set namestack "error-namestack" set
catchstack "error-catchstack" set catchstack "error-catchstack" set
] bind ] bind
] when* ; ] when ;
: catch ( try catch -- ) : catch ( try catch -- )
#! Call the try quotation. If an error occurs restore the #! Call the try quotation. If an error occurs restore the

26
library/httpd/default-responders.factor
View File

@ -53,17 +53,17 @@ USE: wiki-responder
"quit" "responder" set "quit" "responder" set
[ quit-responder ] "get" set [ quit-responder ] "get" set
] extend "quit" set ] extend "quit" set
!
<responder> [ ! <responder> [
"file" "responder" set ! "file" "responder" set
[ file-responder ] "get" set ! [ file-responder ] "get" set
] extend "file" set ! ] extend "file" set
!
<responder> [ ! <responder> [
"wiki" "responder" set ! "wiki" "responder" set
[ wiki-get-responder ] "get" set ! [ wiki-get-responder ] "get" set
[ wiki-post-responder ] "post" set ! [ wiki-post-responder ] "post" set
<namespace> "wiki" set ! <namespace> "wiki" set
"WikiHome" "default-argument" set ! "WikiHome" "default-argument" set
] extend "wiki" set ! ] extend "wiki" set
] extend "httpd-responders" set ; ] extend "httpd-responders" set ;

4
library/httpd/html.factor
View File

@ -122,7 +122,9 @@ USE: url-encoding
] extend ; ] extend ;
: with-html-stream ( quot -- ) : with-html-stream ( quot -- )
"stdio" get <html-stream> swap with-stream ; [
"stdio" get <html-stream> "stdio" set call
] with-scope ;
: html-head ( title -- ) : html-head ( title -- )
"<html><head><title>" write "<html><head><title>" write

1
library/httpd/quit-responder.factor
View File

@ -26,7 +26,6 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: quit-responder IN: quit-responder
USE: combinators
USE: namespaces USE: namespaces
USE: stdio USE: stdio
USE: stack USE: stack

12
library/httpd/test-responder.factor
View File

@ -26,13 +26,13 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: test-responder IN: test-responder
USE: stdio USE: html
USE: prettyprint
USE: httpd USE: httpd
USE: httpd-responder USE: httpd-responder
USE: stack
USE: test
: test-responder ( argument -- ) : test-responder ( argument -- )
serving-text drop
"This is the test responder." print serving-html
"Argument is " write . ; "Factor Test Suite" [ all-tests ] simple-html-document ;

6
library/init.factor
View File

@ -133,7 +133,11 @@ USE: vocabularies
[ "top-level-continuation" set ] callcc0 ; [ "top-level-continuation" set ] callcc0 ;
: (word-of-the-day) ( -- word ) : (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 ( -- ) : word-of-the-day ( -- )
#! Something to entertain the poor hacker. #! Something to entertain the poor hacker.

2
library/inspector.factor
View File

@ -100,5 +100,5 @@ USE: vocabularies
: describe-object-path ( string -- ) : describe-object-path ( string -- )
[ [
dup "object-path" set dup "object-path" set
global-object-path describe "'" split global [ object-path ] bind describe
] with-scope ; ] with-scope ;

4
library/namespaces.factor
View File

@ -121,10 +121,6 @@ USE: vectors
#! Returns f if any of the objects are not set. #! Returns f if any of the objects are not set.
this swap object-path-iter ; 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 ; : on ( var -- ) t put ;
: off ( var -- ) f put ; : off ( var -- ) f put ;
: toggle ( var -- ) dup get not put ; : toggle ( var -- ) dup get not put ;

2
library/platform/jvm/boot-sumo.factor
View File

@ -52,8 +52,8 @@ USE: parser
"/library/platform/jvm/errors.factor" run-resource ! errors "/library/platform/jvm/errors.factor" run-resource ! errors
"/library/platform/jvm/namespaces.factor" run-resource ! namespaces "/library/platform/jvm/namespaces.factor" run-resource ! namespaces
"/library/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/list-namespaces.factor" run-resource ! namespaces
"/library/sbuf.factor" run-resource ! strings
"/library/math/namespace-math.factor" run-resource ! arithmetic "/library/math/namespace-math.factor" run-resource ! arithmetic
"/library/continuations.factor" run-resource ! continuations "/library/continuations.factor" run-resource ! continuations
"/library/errors.factor" run-resource ! errors "/library/errors.factor" run-resource ! errors

4
library/platform/jvm/stack2.factor
View File

@ -69,3 +69,7 @@ USE: vectors
#! this from a word definition will clobber any values left #! this from a word definition will clobber any values left
#! on the data stack by the caller. #! on the data stack by the caller.
datastack* vector-clear ; datastack* vector-clear ;
: depth ( -- n )
#! Push the number of elements on the datastack.
datastack vector-length ;

24
library/platform/jvm/stream.factor
View File

@ -139,19 +139,6 @@ USE: strings
[ <char-stream>/fclose ] "fclose" set [ <char-stream>/fclose ] "fclose" set
] extend ; ] 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 ) : <bwriter> ( writer -- bwriter )
[ "java.io.Writer" ] "java.io.BufferedWriter" jnew ; [ "java.io.Writer" ] "java.io.BufferedWriter" jnew ;
@ -233,6 +220,15 @@ USE: strings
] "fclose" set ] "fclose" set
] extend ; ] 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 ) : <socket-stream> ( socket -- stream )
#! Wraps a socket inside a byte-stream. #! Wraps a socket inside a byte-stream.
dup dup
@ -245,7 +241,7 @@ USE: strings
! We "extend" byte-stream's fclose. ! We "extend" byte-stream's fclose.
( -- ) ( -- )
"fclose" get [ "fclose" get [
"socket" get [ ] "java.net.Socket" "close" jinvoke "socket" get ?close-socket
] append "fclose" set ] append "fclose" set
] extend ; ] extend ;

4
library/platform/native/boot.factor
View File

@ -83,6 +83,10 @@ primitives,
"/library/httpd/http-common.factor" "/library/httpd/http-common.factor"
"/library/httpd/responder.factor" "/library/httpd/responder.factor"
"/library/httpd/httpd.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/arc-trig-hyp.factor"
"/library/math/arithmetic.factor" "/library/math/arithmetic.factor"
"/library/math/list-math.factor" "/library/math/list-math.factor"

2
library/platform/native/init.factor
View File

@ -75,7 +75,7 @@ USE: unparser
init-scratchpad init-scratchpad
init-styles init-styles
init-vocab-styles init-vocab-styles
! default-responders default-responders
run-user-init run-user-init

3
library/platform/native/namespaces.factor
View File

@ -44,7 +44,8 @@ DEFER: >n
: set-global ( g -- ) 4 setenv ; : set-global ( g -- ) 4 setenv ;
: init-namespaces ( -- ) : init-namespaces ( -- )
64 <vector> set-namestack* global >n ; 64 <vector> set-namestack* global >n
global "global" set ;
: namespace-buckets 23 ; : namespace-buckets 23 ;

6
library/platform/native/stack.factor
View File

@ -42,4 +42,8 @@ USE: vectors
#! Clear the datastack. For interactive use only; invoking #! Clear the datastack. For interactive use only; invoking
#! this from a word definition will clobber any values left #! this from a word definition will clobber any values left
#! on the data stack by the caller. #! 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 ;

20
library/sbuf.factor
View File

@ -29,6 +29,7 @@ IN: strings
USE: arithmetic USE: arithmetic
USE: combinators USE: combinators
USE: kernel USE: kernel
USE: lists
USE: namespaces USE: namespaces
USE: strings USE: strings
USE: stack USE: stack
@ -59,3 +60,22 @@ USE: stack
#! push a new string constructed from return values. #! push a new string constructed from return values.
#! The quotation must have stack effect ( X -- X ). #! The quotation must have stack effect ( X -- X ).
<% swap [ swap dup >r call % r> ] str-each drop %> ; <% 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) ,] ;

14
library/stream.factor
View File

@ -29,6 +29,7 @@ IN: streams
USE: errors USE: errors
USE: kernel USE: kernel
USE: namespaces USE: namespaces
USE: strings
! Generic functions, of sorts... ! Generic functions, of sorts...
@ -102,3 +103,16 @@ USE: namespaces
( string -- ) ( string -- )
[ "stream" get fprint ] "fprint" set [ "stream" get fprint ] "fprint" set
] extend ; ] 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 ;

13
library/strings.factor
View File

@ -114,19 +114,6 @@ USE: stack
[ = ] dip f ? [ = ] dip f ?
] ifte ; ] 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 ) : split1 ( string split -- before after )
#! The car of the pair is the string up to the first #! The car of the pair is the string up to the first
#! occurrence of split; the cdr is the remainder of #! occurrence of split; the cdr is the remainder of

2
library/test/httpd/httpd.factor
View File

@ -65,8 +65,6 @@ USE: url-encoding
[ ] [ "/" "get" ] [ serve-responder ] test-word [ ] [ "/" "get" ] [ serve-responder ] test-word
[ ] [ "" "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
[ ] [ "does-not-exist!/" "get" ] [ serve-responder ] test-word [ ] [ "does-not-exist!/" "get" ] [ serve-responder ] test-word

15
library/test/test.factor
View File

@ -25,9 +25,15 @@ USE: vocabularies
: print-test ( input output -- ) : print-test ( input output -- )
"TESTING: " write 2list . ; "TESTING: " write 2list . ;
: keep-datastack ( quot -- )
datastack >r call r> set-datastack drop ;
: unit-test ( output input -- ) : unit-test ( output input -- )
[
2dup print-test 2dup print-test
swap >r >r clear r> call datastack vector>list r> = assert ; swap >r >r clear r> call datastack vector>list r>
= assert
] keep-datastack 2drop ;
: test-word ( output input word -- ) : test-word ( output input word -- )
#! Old-style test. #! Old-style test.
@ -44,8 +50,12 @@ USE: vocabularies
: test ( name -- ) : test ( name -- )
! Run the given test. ! Run the given test.
depth pred >r
"Testing " write dup write "..." print "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 ( -- ) : all-tests ( -- )
"Running Factor test suite..." print "Running Factor test suite..." print
@ -59,6 +69,7 @@ USE: vocabularies
"lists/namespaces" "lists/namespaces"
"combinators" "combinators"
"continuations" "continuations"
"errors"
"hashtables" "hashtables"
"strings" "strings"
"namespaces/namespaces" "namespaces/namespaces"