httpd fixes and socket timeout

diff --git a/CHANGES.txt b/CHANGES.txt
index 461f17d18b05515497fd1bc53113125822434bee..e0a3713809309ccf570826469e043e0023321025 100644 (file)
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -34,6 +34,8 @@ Note that GENERIC: foo is the same as
 Sequence API refactoring, as described in
 http://www.jroller.com/page/slava/20050518.
 
+HTTP server now supports virtual hosting.
+
 Factor 0.74:
 ------------
 

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 332b23817dedfe42a1395ff985e2f18d0f063e1e..81da484fec509a59708887d3e8d6f7eee4fd96d6 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -10,7 +10,6 @@
 - investigate if COPYING_GEN needs a fix\r
 - faster layout\r
 - add a socket timeout\r
-- virtual hosts\r
 - keep alive\r
 - sleep word\r
 - redo new compiler backend for PowerPC\r
@@ -24,7 +23,7 @@
 - index and index* are very slow with lists\r
 - code walker & exceptions\r
 - if two tasks write to a unix stream, the buffer can overflow\r
-- rename prettyprint to pprint\r
+- rename prettyprint* to pprint, prettyprint to pp\r
 - reader syntax for arrays, byte arrays, displaced aliens\r
 - dipping seq-2nmap, seq-2each\r
 - array sort\r
@@ -72,7 +71,6 @@
   - merge inc-d's across VOPs that don't touch the stack\r
 - [ EAX 0 ] --> [ EAX ]\r
 - intrinsic char-slot set-char-slot integer-slot set-integer-slot\r
-- optimize the generic word prologue\r
 - [ [ dup call ] dup call ] infer hangs\r
 - more accurate types for various words\r
 - declarations\r
@@ -80,7 +78,6 @@
   displaced, register and other predicates need to inherit from list\r
   not cons, and need stronger branch partial eval\r
 - optimize away arithmetic dispatch\r
-- dataflow optimizer needs eq not =\r
 - the invalid recursion form case needs to be fixed, for inlines too\r
 - #jump-f #jump-f-label\r
 - re-introduce #target-label => #target optimization\r

diff --git a/doc/handbook.tex b/doc/handbook.tex
index cc4f04bdd50a273980923153d87161e979678fa3..86f0040297d6eb1df962bd4bc6ee6fad39c087e5 100644 (file)
--- a/doc/handbook.tex
+++ b/doc/handbook.tex
@@ -1855,7 +1855,7 @@ Class&Mutable&Growable&Lookup&at start&at end&Primary purpose\\
 %\texttt{array}&$\surd$&&$O(1)$&&&Low-level and unsafe\\
 \texttt{list}&&&$O(n)$&$O(1)$&$O(n)$&Functional manipulation\\
 \texttt{vector}&$\surd$&$\surd$&$O(1)$&$O(n)$&$O(1)$&Imperitive aggregation\\
-\texttt{sbuf}&$\surd$&$\surd$&$O(1)$&$O(n)$&$O(1)$&Character accumilation\\
+\texttt{sbuf}&$\surd$&$\surd$&$O(1)$&$O(n)$&$O(1)$&Character accumulation\\
 \texttt{string}&&&$O(1)$&&&Immutable text strings
 \end{tabular}
 

diff --git a/library/bootstrap/boot-stage3.factor b/library/bootstrap/boot-stage3.factor
index 648cc41814d2170b779fbcad7eedf93a0e0d3200..ce2e9bbee28db0559c7d916afc3652b4e36b94b6 100644 (file)
--- a/library/bootstrap/boot-stage3.factor
+++ b/library/bootstrap/boot-stage3.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 USING: alien assembler command-line compiler compiler-backend
-io-internals kernel lists math namespaces parser sequences stdio
-unparser words ;
+compiler-frontend io-internals kernel lists math namespaces
+parser sequences stdio unparser words ;
 
 "Compiling base..." print
 
@@ -37,6 +37,7 @@ compile? [
     \ = compile
     \ unparse compile
     \ scan compile
+    \ optimize compile
     \ (generate) compile
 ] when
 

diff --git a/library/httpd/cont-responder.factor b/library/httpd/cont-responder.factor
index 18848f6e56a6ba055a495068881abba743b9faf8..d9f5bd9d4a060adbb89abc700a0c4ad8802e6d4f 100644 (file)
--- a/library/httpd/cont-responder.factor
+++ b/library/httpd/cont-responder.factor
@@ -307,12 +307,12 @@ SYMBOL: root-continuation
      over "responder" set
      reset-continuation-table 
      permanent register-continuation root-continuation set 
-   ] extend swap "httpd-responders" get set-hash ;
+   ] extend swap responders get set-hash ;
 
 : responder-items ( name -- items )
   #! Return the table of continuation items for a given responder. 
   #! Useful for debugging.
-  "httpd-responders" get hash [ continuation-table ] bind ;
+  responders get hash [ continuation-table ] bind ;
 
 
 : simple-page ( title quot -- )

diff --git a/library/httpd/default-responders.factor b/library/httpd/default-responders.factor
index 53fe5226ab75e725bff3992779d0758218d4b513..1f579679a982b3fcce822ddb4f54eabdda66fe72 100644 (file)
--- a/library/httpd/default-responders.factor
+++ b/library/httpd/default-responders.factor
@@ -8,7 +8,7 @@ test-responder ;
 #! Remove all existing responders, and create a blank
 #! responder table.
 global [
-    <namespace> "httpd-responders" set
+    <namespace> responders set
 
     ! Runs all unit tests and dumps result to the client. This uses
     ! a lot of server resources, so disable it on a busy server.
@@ -46,7 +46,5 @@ global [
     ! The root directory is served by...
     "file" set-default-responder
 
-    "httpd-vhosts" nest [
-        <namespace> "default" set
-    ] bind
+    vhosts nest [ <namespace> "default" set ] bind
 ] bind

diff --git a/library/httpd/httpd.factor b/library/httpd/httpd.factor
index 98ad48f0ba96e689550dd65300598d9e4fff1d4b..5c7e7d78dac17cdda33656138434a4a2da645fd6 100644 (file)
--- a/library/httpd/httpd.factor
+++ b/library/httpd/httpd.factor
@@ -26,10 +26,13 @@ stdio streams strings threads http sequences ;
         [[ "HEAD" "head" ]]
     ] assoc [ "bad" ] unless* ;
 
+: host ( -- string )
+    #! The host the current responder was called from.
+    "Host" "header" get assoc ":" split1 drop ;
+
 : (handle-request) ( arg cmd -- method path host )
     request-method dup "method" set swap
-    prepare-url prepare-header
-    "Host" "header" get assoc ":" split1 drop ;
+    prepare-url prepare-header host ;
 
 : handle-request ( arg cmd -- )
     [ (handle-request) serve-responder ] with-scope ;
@@ -49,6 +52,7 @@ stdio streams strings threads http sequences ;
 : httpd-client ( socket -- )
     [
         dup log-client [
+            1 stdio get set-timeout
             read-line [ parse-request ] when*
         ] with-stream
     ] try ;

diff --git a/library/httpd/responder.factor b/library/httpd/responder.factor
index aeb2faa61953aa2d2304f055c913f7f8ad97b818..d44c4eb27460d3ca5cc2e9c2bf5033b635fe31ec 100644 (file)
--- a/library/httpd/responder.factor
+++ b/library/httpd/responder.factor
@@ -4,6 +4,10 @@ IN: httpd
 USING: hashtables http kernel lists namespaces parser sequences
 stdio streams strings ;
 
+! Variables
+SYMBOL: vhosts
+SYMBOL: responders
+
 : print-header ( alist -- )
     [ unswons write ": " write url-encode print ] each ;
 
@@ -112,15 +116,13 @@ stdio streams strings ;
     ] extend ;
 
 : vhost ( name -- responder )
-    "httpd-vhosts" get hash [ "default" vhost ] unless* ;
+    vhosts get hash [ "default" vhost ] unless* ;
 
 : responder ( name -- responder )
-    "httpd-responders" get hash [
-        "404" "httpd-responders" get hash
-    ] unless* ;
+    responders get hash [ "404" responder ] unless* ;
 
 : set-default-responder ( name -- )
-    responder "default" "httpd-responders" get set-hash ;
+    responder "default" responders get set-hash ;
 
 : responder-argument ( argument -- argument )
     dup empty? [ drop "default-argument" get ] when ;
@@ -163,4 +165,4 @@ stdio streams strings ;
 
 : add-responder ( responder -- )
     #! Add a responder object to the list.
-    "responder" over hash  "httpd-responders" get set-hash ;
+    "responder" over hash  responders get set-hash ;

diff --git a/library/io/c-streams.factor b/library/io/c-streams.factor
index 7d4faab85a2e547a28f3ea4ad53944d450f33501..773a538c40cc8330e8bb5d59fbca837f5f38b670 100644 (file)
--- a/library/io/c-streams.factor
+++ b/library/io/c-streams.factor
@@ -52,6 +52,7 @@ TUPLE: client-stream host port ;
 : <client> c-stream-error ;
 : <server> c-stream-error ;
 : accept c-stream-error ;
+: set-timeout c-stream-error ;
 
 : (stream-copy) ( in out -- )
     4096 pick stream-read [

diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor
index 02b59e73bc68acc7e9362b28de956ac7040fb253..17ce7c42ac4f1b12c0350c3e0ae9c40c9cc37275 100644 (file)
--- a/library/tools/debugger.factor
+++ b/library/tools/debugger.factor
@@ -20,13 +20,6 @@ vectors words ;
     "Object type: " write class word. terpri
     "Expected type: " write builtin-type word. terpri ;
 
-: range-error. ( list -- )
-    "Range check error" print
-    unswons [ "Object: " write . ] when*
-    unswons "Minimum index: " write .
-    unswons "Requested index: " write .
-    car "Maximum index: " write . ;
-
 : float-format-error. ( list -- )
     "Invalid floating point literal format: " write . ;
 
@@ -55,7 +48,6 @@ M: kernel-error error. ( error -- )
         io-error.
         undefined-word-error.
         type-check-error.
-        range-error.
         float-format-error.
         signal-error.
         negative-array-size-error.

diff --git a/library/unix/sockets.factor b/library/unix/sockets.factor
index 7816984e254b6ed3248f259d5b57b4ec0df65411..6373523f732bded4c24d2bd8ece3a14632737cd0 100644 (file)
--- a/library/unix/sockets.factor
+++ b/library/unix/sockets.factor
@@ -38,7 +38,7 @@ USING: alien generic kernel math unix-internals ;
 : server-sockaddr ( port -- sockaddr )
     init-sockaddr  INADDR_ANY htonl over set-sockaddr-in-addr ;
 
-: sockopt ( fd level opt -- )
+: sockopt ( fd level opt value -- )
     1 <int> "int" c-size setsockopt io-error ;
 
 : server-socket ( port -- fd )
@@ -78,6 +78,9 @@ M: accept-task io-task-events ( task -- events )
 : <socket-stream> ( fd -- stream )
     dup f <fd-stream> ;
 
+: timeout-opt ( fd level opt value -- )
+    "timeval" c-size setsockopt io-error ;
+
 IN: streams
 
 C: client-stream ( fd host port -- stream )
@@ -100,3 +103,10 @@ C: client-stream ( fd host port -- stream )
 : accept ( server -- client )
     #! Wait for a client connection.
     dup wait-to-accept port-handle do-accept <client-stream> ;
+
+: set-timeout ( timeout client -- )
+    swap 0 make-timeval 2dup
+    >r duplex-stream-out port-handle SOL_SOCKET SO_SNDTIMEO r>
+    timeout-opt
+    >r duplex-stream-in port-handle SOL_SOCKET SO_RCVTIMEO r>
+    timeout-opt ;

diff --git a/library/unix/syscalls-freebsd.factor b/library/unix/syscalls-freebsd.factor
index 2e383e3d58a97e6c6eef2952df1a57897aecca6f..6b841d8d66af10ec1de9ef4e7c0540b8d8344fda 100644 (file)
--- a/library/unix/syscalls-freebsd.factor
+++ b/library/unix/syscalls-freebsd.factor
@@ -17,6 +17,8 @@ IN: unix-internals
 : SOL_SOCKET HEX: ffff ;
 : SO_REUSEADDR HEX: 4 ;
 : SO_OOBINLINE HEX: 100 ;
+: SO_SNDTIMEO HEX: 1005 ;
+: SO_RCVTIMEO HEX: 1006 ;
 
 : INADDR_ANY 0 ;
 

diff --git a/library/unix/syscalls-linux.factor b/library/unix/syscalls-linux.factor
index aa19c9e3581141a56b38e94cf6fc28515751cb13..4d143b157a522a8e904955153c6a5e400240be06 100644 (file)
--- a/library/unix/syscalls-linux.factor
+++ b/library/unix/syscalls-linux.factor
@@ -15,8 +15,12 @@ IN: unix-internals
 : POLLOUT    HEX: 0004 ;
 
 : SOL_SOCKET 1 ;
+
 : SO_REUSEADDR 2 ;
 : SO_OOBINLINE 10 ;
+: SO_SNDTIMEO HEX: 15 ;
+: SO_RCVTIMEO HEX: 14 ;
+
 : INADDR_ANY 0 ;
 
 : F_SETFL 4 ;    ! set file status flags

diff --git a/library/unix/syscalls-macosx.factor b/library/unix/syscalls-macosx.factor
index 65d0bdaf6db0e92cd0b5d8389d89a4e63c0ed283..f537e22b0598b2090baf1738fdeaa915d6a71554 100644 (file)
--- a/library/unix/syscalls-macosx.factor
+++ b/library/unix/syscalls-macosx.factor
@@ -17,6 +17,8 @@ IN: unix-internals
 : SOL_SOCKET HEX: ffff ;
 : SO_REUSEADDR HEX: 4 ;
 : SO_OOBINLINE HEX: 100 ;
+: SO_SNDTIMEO HEX: 1005 ;
+: SO_RCVTIMEO HEX: 1006 ;
 
 : INADDR_ANY 0 ;
 

diff --git a/library/unix/syscalls.factor b/library/unix/syscalls.factor
index cc4b08aeeba439752e69cd5aac8dcabc1b704945..d5c4927b00e1b6b034514a72694396a960ceb3c2 100644 (file)
--- a/library/unix/syscalls.factor
+++ b/library/unix/syscalls.factor
@@ -97,3 +97,13 @@ END-STRUCT
 
 : ntohs ( n -- n )
     "ushort" "libc" "ntohs" [ "ushort" ] alien-invoke ;
+
+BEGIN-STRUCT: timeval
+    FIELD: long sec
+    FIELD: long usec
+END-STRUCT
+
+: make-timeval ( sec usec -- timeval )
+    <timeval>
+    [ set-timeval-usec ] keep
+    [ set-timeval-sec ] keep ;

diff --git a/native/bignum.c b/native/bignum.c
index 371f87379e2730ff2525d3a7218ee3b50acc0e4f..187eeb10942406c1ea270ebe75acff8ea3dcb3f7 100644 (file)
--- a/native/bignum.c
+++ b/native/bignum.c
@@ -2,30 +2,12 @@
 
 CELL to_cell(CELL x)
 {
-       F_FIXNUM fixnum;
-       F_ARRAY* bignum;
-
        switch(type_of(x))
        {
        case FIXNUM_TYPE:
-               fixnum = untag_fixnum_fast(x);
-               if(fixnum < 0)
-               {
-                       range_error(F,0,tag_fixnum(fixnum),FIXNUM_MAX);
-                       return -1;
-               }
-               else
-                       return (CELL)fixnum;
-               break;
+               return untag_fixnum_fast(x);
        case BIGNUM_TYPE:
-               bignum = to_bignum(x);
-               if(BIGNUM_NEGATIVE_P(bignum))
-               {
-                       range_error(F,0,tag_bignum(bignum),FIXNUM_MAX);
-                       return -1;
-               }
-               else
-                       return s48_bignum_to_long(untag_bignum_fast(x));
+               return s48_bignum_to_long(untag_bignum_fast(x));
        default:
                type_error(BIGNUM_TYPE,x);
                return 0;

diff --git a/native/error.c b/native/error.c
index a1a58dd7e8f90f82702591bdd2529e90af02e125..f3796b3af645374bc29ddc1afc95eb79c9cc9888 100644 (file)
--- a/native/error.c
+++ b/native/error.c
@@ -80,11 +80,3 @@ void type_error(CELL type, CELL tagged)
        CELL c = cons(tag_fixnum(type),cons(tagged,F));
        general_error(ERROR_TYPE,c);
 }
-
-/* index must be tagged */
-void range_error(CELL tagged, CELL min, CELL index, CELL max)
-{
-       CELL c = cons(tagged,cons(tag_cell(min),
-               cons(index,cons(tag_cell(max),F))));
-       general_error(ERROR_RANGE,c);
-}

diff --git a/native/error.h b/native/error.h
index ac912381324f0c7008bdc87a27ce251dc2a4b473..427681b6ed4e35c841652502bfeb55e14a937b17 100644 (file)
--- a/native/error.h
+++ b/native/error.h
@@ -2,13 +2,12 @@
 #define ERROR_IO (1<<3)
 #define ERROR_UNDEFINED_WORD (2<<3)
 #define ERROR_TYPE (3<<3)
-#define ERROR_RANGE (4<<3)
-#define ERROR_FLOAT_FORMAT (5<<3)
-#define ERROR_SIGNAL (6<<3)
-#define ERROR_NEGATIVE_ARRAY_SIZE (7<<3)
-#define ERROR_C_STRING (8<<3)
-#define ERROR_FFI (9<<3)
-#define ERROR_HEAP_SCAN (10<<3)
+#define ERROR_FLOAT_FORMAT (4<<3)
+#define ERROR_SIGNAL (5<<3)
+#define ERROR_NEGATIVE_ARRAY_SIZE (6<<3)
+#define ERROR_C_STRING (7<<3)
+#define ERROR_FFI (8<<3)
+#define ERROR_HEAP_SCAN (9<<3)
 
 /* When throw_error throws an error, it sets this global and
 longjmps back to the top-level. */
@@ -31,5 +30,3 @@ void signal_error(int signal);
 void type_error(CELL type, CELL tagged);
 void primitive_throw(void);
 void primitive_die(void);
-/* index must be tagged */
-void range_error(CELL tagged, CELL min, CELL index, CELL max);