file responder works with native factor

Makefile

@@ -1,5 +1,5 @@
 CC = gcc
-CFLAGS = -g -Os -mpentiumpro -Wall -fomit-frame-pointer
+CFLAGS = -g -Os -mpentiumpro -Wall
 LIBS = -lm
 STRIP = strip
 

library/cross-compiler.factor

@@ -62,7 +62,7 @@ DEFER: port?
 DEFER: open-file
 DEFER: client-socket
 DEFER: server-socket
-DEFER: close-fd
+DEFER: close-port
 DEFER: add-accept-io-task
 DEFER: accept-fd
 DEFER: can-read-line?
@@ -74,6 +74,7 @@ DEFER: read-count-fd-8
 DEFER: can-write?
 DEFER: add-write-io-task
 DEFER: write-fd-8
+DEFER: add-copy-io-task
 DEFER: next-io-task
 
 IN: math
@@ -222,7 +223,7 @@ IN: cross-compiler
         exit*
         client-socket
         server-socket
-        close-fd
+        close-port
         add-accept-io-task
         accept-fd
         can-read-line?
@@ -234,6 +235,7 @@ IN: cross-compiler
         can-write?
         add-write-io-task
         write-fd-8
+        add-copy-io-task
         next-io-task
         room
         os-env

library/files.factor

@@ -45,19 +45,20 @@ USE: strings
     file-extension mime-types assoc [ "text/plain" ] unless* ;
 
 [
-    [ "html"   | "text/html"                ]
-    [ "txt"    | "text/plain"               ]
-                                           
-    [ "gif"    | "image/gif"                ]
-    [ "png"    | "image/png"                ]
-    [ "jpg"    | "image/jpeg"               ]
-    [ "jpeg"   | "image/jpeg"               ]
-               
-    [ "jar"    | "application/octet-stream" ]
-    [ "zip"    | "application/octet-stream" ]
-    [ "tgz"    | "application/octet-stream" ]
-    [ "tar.gz" | "application/octet-stream" ]
-    [ "gz"     | "application/octet-stream" ]
-      
-    [ "factor" | "application/x-factor"     ]
+    [ "html"   | "text/html"                        ]
+    [ "txt"    | "text/plain"                       ]
+                                                    
+    [ "gif"    | "image/gif"                        ]
+    [ "png"    | "image/png"                        ]
+    [ "jpg"    | "image/jpeg"                       ]
+    [ "jpeg"   | "image/jpeg"                       ]
+                                                    
+    [ "jar"    | "application/octet-stream"         ]
+    [ "zip"    | "application/octet-stream"         ]
+    [ "tgz"    | "application/octet-stream"         ]
+    [ "tar.gz" | "application/octet-stream"         ]
+    [ "gz"     | "application/octet-stream"         ]
+                                                    
+    [ "factor" | "application/x-factor"             ]
+    [ "factsp" | "application/x-factor-server-page" ]
 ] set-mime-types

library/httpd/default-responders.factor

@@ -53,12 +53,12 @@ USE: wiki-responder
             "quit" "responder" set
             [ quit-responder ] "get" set
         ] extend "quit" set
-!
-!        <responder> [
-!            "file" "responder" set
-!            [ file-responder ] "get" set
-!        ] extend "file" set
-!
+ 
+         <responder> [
+             "file" "responder" set
+             [ file-responder ] "get" set
+         ] extend "file" set
+ 
 !        <responder> [
 !            "wiki" "responder" set
 !            [ wiki-get-responder ] "get" set

library/httpd/file-responder.factor

@@ -1,4 +1,4 @@
-! :folding=indent:collapseFolds=0:
+! :folding=indent:collapseFolds=1:
 
 ! $Id$
 !
@@ -27,82 +27,45 @@
 
 IN: file-responder
 USE: combinators
-USE: html
+USE: errors
 USE: kernel
-USE: lists
 USE: files
+USE: httpd
+USE: httpd-responder
 USE: namespaces
 USE: parser
-USE: regexp
 USE: stack
 USE: stdio
 USE: streams
 USE: strings
 
-USE: httpd
-USE: httpd-responder
-
-!!! Serving files.
-: file-header ( filename -- header )
-    "200 Document follows" swap mime-type response ;
-
-: serve-file ( filename -- )
-    dup file-header print <filebr> "stdio" get fcopy ;
-
-!!! Serving directories.
-: file>html ( filename -- ... )
-    "<li><a href=\"" swap
-    ! dup directory? [ "/" cat2 ] when
-    chars>entities
-    "\">" over "</a></li>" ;
-
-: directory>html ( directory -- html )
-    directory [ file>html ] map cat ;
-
-: list-directory ( directory -- )
-    serving-html
-    [
-        "<html><head><title>" swap
-        "</title></head><body><h1>" over
-        "</h1><ul>" over
-        directory>html
-        "</ul></body></html>"
-    ] cons expand cat write ;
-
-: serve-directory ( directory -- )
-    dup "/index.html" cat2 dup exists? [
-        nip serve-file
-    ] [
-        drop list-directory
-    ] ifte ;
-
-!!! Serving objects.
-: serve-static ( filename -- )
-    dup directory? [
-        serve-directory
-    ] [
-        serve-file
-    ] ifte ;
+: parse-object-name ( filename -- argument filename )
+    dup [ "?" split1 swap ] [ "/" ] ifte
+    "doc-root" get swap cat2 ;
 
 : serve-script ( argument filename -- )
     [ swap "argument" set run-file ] with-scope ;
 
-: parse-object-name ( filename -- argument filename )
-    dup [
-        dup "(.*?)\\?(.*)" groups dup [ nip call ] when swap
+: file-header ( mime-type -- header )
+    "200 Document follows" swap response ;
+
+: copy-and-close ( from -- )
+    [ dupd "stdio" get fcopy ] [ >r fclose r> rethrow ] catch ;
+
+: serve-static ( argument filename mime-type -- )
+    file-header print <filebr> "stdio" get fcopy drop ;
+
+: serve-file ( argument filename -- )
+    dup mime-type dup "application/x-factor-server-page" = [
+        drop serve-script
     ] [
-        drop f "/"
+        serve-static
     ] ifte ;
 
 : file-responder ( filename -- )
     "doc-root" get [
-        parse-object-name "doc-root" get swap cat2
-        dup exists? [
-            dup file-extension "lhtml" = [
-                serve-script
-            ] [
-                nip serve-static
-            ] ifte
+        parse-object-name dup exists? [
+            serve-file
         ] [
             2drop "404 not found" httpd-error
         ] ifte

library/platform/jvm/stream.factor

@@ -37,7 +37,8 @@ USE: stack
 USE: strings
 
 : fcopy ( from to -- )
-    ! Copy the contents of the byte-stream 'from' to the byte-stream 'to'.
+    #! Copy the contents of the byte-stream 'from' to the
+    #! byte-stream 'to'.
     [ [ "in" get ] bind ] dip
     [ "out" get ] bind
     [ "java.io.InputStream" "java.io.OutputStream" ]

library/platform/native/boot-stage2.factor

@@ -117,6 +117,7 @@ USE: stdio
     "/library/httpd/http-common.factor"
     "/library/httpd/responder.factor"
     "/library/httpd/httpd.factor"
+    "/library/httpd/file-responder.factor"
     "/library/httpd/inspect-responder.factor"
     "/library/httpd/test-responder.factor"
     "/library/httpd/quit-responder.factor"

library/platform/native/io-internals.factor

@@ -36,30 +36,29 @@ USE: threads
 
 : stdin 0 getenv ;
 : stdout 1 getenv ;
-: stderr 2 getenv ;
 
-: flush-fd ( port -- )
-    [ swap add-write-io-task (yield) ] callcc0 drop ;
+: blocking-flush ( port -- )
+    [ add-write-io-task (yield) ] callcc0 drop ;
 
 : wait-to-write ( len port -- )
-    tuck can-write? [ drop ] [ flush-fd ] ifte ;
+    tuck can-write? [ drop ] [ blocking-flush ] ifte ;
 
 : blocking-write ( str port -- )
     over
     dup string? [ str-length ] [ drop 1 ] ifte
     over wait-to-write write-fd-8 ;
 
-: fill-fd ( port -- )
-    [ swap add-read-line-io-task (yield) ] callcc0 drop ;
+: blocking-fill ( port -- )
+    [ add-read-line-io-task (yield) ] callcc0 drop ;
 
 : wait-to-read-line ( port -- )
-    dup can-read-line? [ drop ] [ fill-fd ] ifte ;
+    dup can-read-line? [ drop ] [ blocking-fill ] ifte ;
 
 : blocking-read-line ( port -- line )
     dup wait-to-read-line read-line-fd-8 dup [ sbuf>str ] when ;
 
 : fill-fd# ( count port -- )
-    [ -rot add-read-count-io-task (yield) ] callcc0 2drop ;
+    [ add-read-count-io-task (yield) ] callcc0 2drop ;
 
 : wait-to-read# ( count port -- )
     2dup can-read-count? [ 2drop ] [ fill-fd# ] ifte ;
@@ -68,7 +67,10 @@ USE: threads
     2dup wait-to-read# read-count-fd-8 dup [ sbuf>str ] when ;
 
 : wait-to-accept ( socket -- )
-    [ swap add-accept-io-task (yield) ] callcc0 drop ;
+    [ add-accept-io-task (yield) ] callcc0 drop ;
 
 : blocking-accept ( socket -- host port in out )
     dup wait-to-accept accept-fd ;
+
+: blocking-copy ( in out -- )
+    [ add-copy-io-task (yield) ] callcc0 ;

library/platform/native/network.factor

@@ -46,7 +46,7 @@ USE: unparser
         "socket" set
 
         ( -- )
-        [ "socket" get close-fd ] "fclose" set
+        [ "socket" get close-port ] "fclose" set
     ] extend ;
 
 : <client-stream> ( host port in out -- stream )

library/platform/native/stream.factor

@@ -56,12 +56,12 @@ USE: namespaces
         ] "fread#" set
         
         ( -- )
-        [ "out" get [ flush-fd ] when* ] "fflush" set
+        [ "out" get [ blocking-flush ] when* ] "fflush" set
         
         ( -- )
         [
-            "out" get [ dup flush-fd close-fd ] when*
-            "in" get [ close-fd ] when*
+            "out" get [ dup blocking-flush close-port ] when*
+            "in" get [ close-port ] when*
         ] "fclose" set
     ] extend ;
 
@@ -83,3 +83,8 @@ USE: namespaces
 : exists? ( file -- ? )
     #! This is terrible.
     [ <filebr> fclose t ] [ nip not ] catch ;
+
+: fcopy ( from to -- )
+    #! Copy the contents of the fd-stream 'from' to the
+    #! fd-stream 'to'.
+    "out" swap get* >r "in" swap get* r> blocking-copy ;

library/platform/native/threads.factor

@@ -57,15 +57,15 @@ USE: stack
     #! If there is a quotation in the run queue, call it,
     #! otherwise wait for I/O. The currently executing
     #! continuation is suspended. Use yield instead.
-    next-thread dup [
+    next-thread [
         call
     ] [
-        drop next-io-task dup [
+        next-io-task [
             call
         ] [
-            drop (yield)
-        ] ifte
-    ] ifte ;
+            (yield)
+        ] ifte*
+    ] ifte* ;
 
 : yield ( -- )
     #! Add the current continuation to the run queue, and yield

library/test/httpd/httpd.factor

@@ -1,4 +1,5 @@
 IN: scratchpad
+USE: file-responder
 USE: httpd
 USE: httpd-responder
 USE: logging
@@ -66,3 +67,24 @@ USE: url-encoding
 [ [ [ "Foo" | "Bar" ] ] ] [ "Foo=Bar" post-request>alist ] unit-test
 [ [ [ "Foo" | "Bar" ] [ "Baz" | "Quux" ] ] ]
 [ "Foo=Bar&Baz=Quux" post-request>alist ] unit-test
+
+[ f "/foo/hello.html" ] [
+    [
+        "/foo/" "doc-root" set
+        "hello.html" parse-object-name
+    ] with-scope
+] unit-test
+
+[ "some-arg" "/foo/hello.html" ] [
+    [
+        "/foo/" "doc-root" set
+        "hello.html?some-arg" parse-object-name
+    ] with-scope
+] unit-test
+
+[ f "/foo/" ] [
+    [
+        "/foo" "doc-root" set
+        f parse-object-name
+    ] with-scope
+] unit-test

native/float.c

@@ -45,7 +45,7 @@ void primitive_str_to_float(void)
 void primitive_float_to_str(void)
 {
 	char tmp[33];
-	snprintf(&tmp,32,"%.16g",to_float(dpeek())->n);
+	snprintf(tmp,32,"%.16g",to_float(dpeek())->n);
 	tmp[32] = '\0';
 	drepl(tag_object(from_c_string(tmp)));
 }

native/gc.c

@@ -2,7 +2,7 @@
 
 /* Stop-and-copy garbage collection using Cheney's algorithm. */
 
-/* #define GC_DEBUG /* */
+/* #define GC_DEBUG */
 
 INLINE void gc_debug(char* msg, CELL x) {
 #ifdef GC_DEBUG

native/io.c

@@ -28,18 +28,20 @@ void init_io(void)
 
 IO_TASK* add_io_task(
 	IO_TASK_TYPE type,
-	PORT* port,
+	CELL port,
+	CELL other_port,
 	CELL callback,
 	IO_TASK* io_tasks,
 	int* fd_count)
 {
-	int fd = port->fd;
+	int fd = untag_port(port)->fd;
 
 	if(io_tasks[fd].callbacks != F && type != IO_TASK_WRITE)
-		general_error(ERROR_IO_TASK_TWICE,tag_object(port));
+		general_error(ERROR_IO_TASK_TWICE,port);
 
 	io_tasks[fd].type = type;
-	io_tasks[fd].port = tag_object(port);
+	io_tasks[fd].port = port;
+	io_tasks[fd].other_port = other_port;
 	io_tasks[fd].callbacks = tag_cons(cons(callback,
 		io_tasks[fd].callbacks));
 
@@ -49,14 +51,6 @@ IO_TASK* add_io_task(
 	return &io_tasks[fd];
 }
 
-void primitive_add_accept_io_task(void)
-{
-	PORT* port = untag_port(dpop());
-	CELL callback = dpop();
-	add_io_task(IO_TASK_ACCEPT,port,callback,
-		read_io_tasks,&read_fd_count);
-}
-
 void remove_io_task(
 	IO_TASK_TYPE type,
 	PORT* port,
@@ -66,6 +60,7 @@ void remove_io_task(
 	int fd = port->fd;
 
 	io_tasks[fd].port = F;
+	io_tasks[fd].other_port = F;
 	io_tasks[fd].callbacks = F;
 
 	if(fd == *fd_count - 1)
@@ -80,6 +75,55 @@ void remove_io_tasks(PORT* port)
 		write_io_tasks,&write_fd_count);
 }
 
+bool perform_copy_from_io_task(PORT* port, PORT* other_port)
+{
+	if(port->buf_fill == 0)
+	{
+		if(read_step(port))
+		{
+			/* EOF? */
+			if(port->buf_fill == 0)
+				return true;
+		}
+		else
+			return false;
+	}
+
+	if(can_write(other_port,port->buf_fill))
+	{
+		write_string_raw(other_port,
+			(char*)(port->buffer + 1),
+			port->buf_fill);
+		port->buf_pos = port->buf_fill = 0;
+	}
+
+	return false;
+}
+
+bool perform_copy_to_io_task(PORT* port, PORT* other_port)
+{
+	bool success = perform_write_io_task(port);
+	/* only return 'true' if the COPY_FROM task is done also. */
+	if(read_io_tasks[other_port->fd].port == F)
+		return success;
+	else
+		return false;
+}
+
+void primitive_add_copy_io_task(void)
+{
+	CELL callback = dpop();
+	CELL to = dpop();
+	CELL from = dpop();
+	/* callback for COPY_FROM is F since we only care about
+	when BOTH tasks are done, and this is taken care of by
+	COPY_TO. */
+	add_io_task(IO_TASK_COPY_FROM,from,to,F,
+		read_io_tasks,&read_fd_count);
+	add_io_task(IO_TASK_COPY_TO,to,from,callback,
+		write_io_tasks,&write_fd_count);
+}
+
 bool set_up_fd_set(fd_set* fdset, int fd_count, IO_TASK* io_tasks)
 {
 	bool retval = false;
@@ -134,6 +178,14 @@ CELL perform_io_task(IO_TASK* io_task, IO_TASK* io_tasks, int* fd_count)
 	case IO_TASK_ACCEPT:
 		success = accept_connection(port);
 		break;
+	case IO_TASK_COPY_FROM:
+		success = perform_copy_from_io_task(port,
+			untag_port(io_task->other_port));
+		break;
+	case IO_TASK_COPY_TO:
+		success = perform_copy_to_io_task(port,
+			untag_port(io_task->other_port));
+		break;
 	default:
 		critical_error("Bad I/O task",io_task->type);
 		success = false;

native/io.h

@@ -4,12 +4,16 @@ typedef enum {
 	IO_TASK_READ_LINE,
 	IO_TASK_READ_COUNT,
 	IO_TASK_WRITE,
-	IO_TASK_ACCEPT
+	IO_TASK_ACCEPT,
+	IO_TASK_COPY_FROM,
+	IO_TASK_COPY_TO
 } IO_TASK_TYPE;
 
 typedef struct {
 	IO_TASK_TYPE type;
 	CELL port;
+	/* Used for COPY_FROM and COPY_TO only */
+	CELL other_port;
 	/* TAGGED list of callbacks, or F */
 	/* Multiple callbacks per port are only permitted for IO_TASK_WRITE. */
 	CELL callbacks;
@@ -29,17 +33,20 @@ void init_io_tasks(fd_set* fd_set, IO_TASK* io_tasks);
 void init_io(void);
 IO_TASK* add_io_task(
 	IO_TASK_TYPE type,
-	PORT* port,
+	CELL port,
+	CELL other_port,
 	CELL callback,
 	IO_TASK* io_tasks,
 	int* fd_count);
-void primitive_add_accept_io_task(void);
 void remove_io_task(
 	IO_TASK_TYPE type,
 	PORT* port,
 	IO_TASK* io_tasks,
 	int* fd_count);
 void remove_io_tasks(PORT* port);
+bool perform_copy_from_io_task(PORT* port, PORT* other_port);
+bool perform_copy_to_io_task(PORT* port, PORT* other_port);
+void primitive_add_copy_io_task(void);
 CELL pop_io_task_callback(
 	IO_TASK_TYPE type,
 	PORT* port,

native/primitives.c

@@ -129,6 +129,7 @@ XT primitives[] = {
 	primitive_can_write,
 	primitive_add_write_io_task,
 	primitive_write_8,
+	primitive_add_copy_io_task,
 	primitive_next_io_task,
 	primitive_room,
 	primitive_os_env,

native/primitives.h

@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 140
+#define PRIMITIVE_COUNT 141
 
 CELL primitive_to_xt(CELL primitive);

native/read.c

@@ -107,12 +107,12 @@ void primitive_can_read_line(void)
 
 void primitive_add_read_line_io_task(void)
 {
-	PORT* port = untag_port(dpop());
 	CELL callback = dpop();
-	add_io_task(IO_TASK_READ_LINE,port,callback,
+	CELL port = dpop();
+	add_io_task(IO_TASK_READ_LINE,port,F,callback,
 		read_io_tasks,&read_fd_count);
 
-	init_line_buffer(port,LINE_SIZE);
+	init_line_buffer(untag_port(port),LINE_SIZE);
 }
 
 bool perform_read_line_io_task(PORT* port)
@@ -206,10 +206,11 @@ void primitive_can_read_count(void)
 
 void primitive_add_read_count_io_task(void)
 {
+	CELL callback = dpop();
 	PORT* port = untag_port(dpop());
 	FIXNUM count = to_fixnum(dpop());
-	CELL callback = dpop();
-	add_io_task(IO_TASK_READ_COUNT,port,callback,
+	add_io_task(IO_TASK_READ_COUNT,
+		tag_object(port),F,callback,
 		read_io_tasks,&read_fd_count);
 
 	port->count = count;

native/socket.c

@@ -94,6 +94,14 @@ void primitive_server_socket(void)
 	dpush(tag_object(port(PORT_SPECIAL,make_server_socket(p))));
 }
 
+void primitive_add_accept_io_task(void)
+{
+	CELL callback = dpop();
+	CELL port = dpop();
+	add_io_task(IO_TASK_ACCEPT,port,F,callback,
+		read_io_tasks,&read_fd_count);
+}
+
 CELL accept_connection(PORT* p)
 {
 	struct sockaddr_in clientname;

native/socket.h

@@ -4,5 +4,6 @@ int make_client_socket(const char* hostname, uint16_t port);
 void primitive_client_socket(void);
 int make_server_socket(uint16_t port);
 void primitive_server_socket(void);
+void primitive_add_accept_io_task(void);
 CELL accept_connection(PORT* p);
 void primitive_accept_fd(void);

native/write.c

@@ -56,9 +56,9 @@ void primitive_can_write(void)
 
 void primitive_add_write_io_task(void)
 {
-	PORT* port = untag_port(dpop());
 	CELL callback = dpop();
-	add_io_task(IO_TASK_WRITE,port,callback,
+	CELL port = dpop();
+	add_io_task(IO_TASK_WRITE,port,F,callback,
 		write_io_tasks,&write_fd_count);
 }
 
@@ -89,21 +89,26 @@ void write_char_8(PORT* port, FIXNUM ch)
 	port->buf_fill++;
 }
 
+/* Caller must ensure buffer is of the right size. */
+void write_string_raw(PORT* port, char* str, CELL len)
+{
+	/* Append string to buffer */
+	memcpy((void*)((CELL)port->buffer + sizeof(STRING)
+		+ port->buf_fill),str,len);
+
+	port->buf_fill += len;
+}
+
 void write_string_8(PORT* port, STRING* str)
 {
 	char* c_str;
-
+	
 	/* Note this ensures the buffer is large enough to fit the string */
 	if(!can_write(port,str->capacity))
 		io_error(__FUNCTION__);
 
 	c_str = to_c_string(str);
-
-	/* Append string to buffer */
-	memcpy((void*)((CELL)port->buffer + sizeof(STRING)
-		+ port->buf_fill),c_str,str->capacity);
-
-	port->buf_fill += str->capacity;
+	write_string_raw(port,c_str,str->capacity);
 }
 
 void primitive_write_8(void)
@@ -112,6 +117,7 @@ void primitive_write_8(void)
 
 	CELL text = dpop();
 	CELL type = type_of(text);
+	STRING* str;
 
 	pending_io_error(port);
 
@@ -122,7 +128,8 @@ void primitive_write_8(void)
 		write_char_8(port,to_fixnum(text));
 		break;
 	case STRING_TYPE:
-		write_string_8(port,untag_string(text));
+		str = untag_string(text);
+		write_string_8(port,str);
 		break;
 	default:
 		type_error(STRING_TYPE,text);

native/write.h

@@ -4,5 +4,6 @@ void primitive_can_write(void);
 void primitive_add_write_io_task(void);
 bool perform_write_io_task(PORT* port);
 void write_char_8(PORT* port, FIXNUM ch);
+void write_string_raw(PORT* port, char* str, CELL len);
 void write_string_8(PORT* port, STRING* str);
 void primitive_write_8(void);