diff --git a/Makefile b/Makefile index fe493bd945..eefe7806aa 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ CC = gcc -CFLAGS = -g -Os -mpentiumpro -Wall -fomit-frame-pointer +CFLAGS = -g -Os -mpentiumpro -Wall LIBS = -lm STRIP = strip diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor index 895f06d55a..2313aff55f 100644 --- a/library/cross-compiler.factor +++ b/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 diff --git a/library/files.factor b/library/files.factor index d5026d5917..73f7f607fb 100644 --- a/library/files.factor +++ b/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 diff --git a/library/httpd/default-responders.factor b/library/httpd/default-responders.factor index 983dc74b07..10ff88b2f4 100644 --- a/library/httpd/default-responders.factor +++ b/library/httpd/default-responders.factor @@ -53,12 +53,12 @@ USE: wiki-responder "quit" "responder" set [ quit-responder ] "get" set ] extend "quit" set -! -! [ -! "file" "responder" set -! [ file-responder ] "get" set -! ] extend "file" set -! + + [ + "file" "responder" set + [ file-responder ] "get" set + ] extend "file" set + ! [ ! "wiki" "responder" set ! [ wiki-get-responder ] "get" set diff --git a/library/httpd/file-responder.factor b/library/httpd/file-responder.factor index 261139be3f..55fa916320 100644 --- a/library/httpd/file-responder.factor +++ b/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 "stdio" get fcopy ; - -!!! Serving directories. -: file>html ( filename -- ... ) - "
  • entities - "\">" over "
    • " ; - -: directory>html ( directory -- html ) - directory [ file>html ] map cat ; - -: list-directory ( directory -- ) - serving-html - [ - "" swap - "

    " over - "

      " over - directory>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 "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 diff --git a/library/platform/jvm/stream.factor b/library/platform/jvm/stream.factor index 5f2821a589..98a3b32e03 100644 --- a/library/platform/jvm/stream.factor +++ b/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" ] diff --git a/library/platform/native/boot-stage2.factor b/library/platform/native/boot-stage2.factor index 89984a5b3e..df0f8f8435 100644 --- a/library/platform/native/boot-stage2.factor +++ b/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" diff --git a/library/platform/native/io-internals.factor b/library/platform/native/io-internals.factor index bfc7ea4987..ffd6a26c56 100644 --- a/library/platform/native/io-internals.factor +++ b/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 ; diff --git a/library/platform/native/network.factor b/library/platform/native/network.factor index 414c0a20f5..59975e50bb 100644 --- a/library/platform/native/network.factor +++ b/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 ; : ( host port in out -- stream ) diff --git a/library/platform/native/stream.factor b/library/platform/native/stream.factor index 7286ac4a4f..074f0fd15f 100644 --- a/library/platform/native/stream.factor +++ b/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. [ 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 ; diff --git a/library/platform/native/threads.factor b/library/platform/native/threads.factor index 3822b73cae..23b8ef35b9 100644 --- a/library/platform/native/threads.factor +++ b/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 diff --git a/library/test/httpd/httpd.factor b/library/test/httpd/httpd.factor index 26ffc33a07..64d12c3776 100644 --- a/library/test/httpd/httpd.factor +++ b/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 diff --git a/native/float.c b/native/float.c index de096fe32f..d7ac05ba5a 100644 --- a/native/float.c +++ b/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))); } diff --git a/native/gc.c b/native/gc.c index ac2f96c2bb..6ff2f93413 100644 --- a/native/gc.c +++ b/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 diff --git a/native/io.c b/native/io.c index 1a57219365..af153e3c83 100644 --- a/native/io.c +++ b/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; diff --git a/native/io.h b/native/io.h index 31a792131d..caea9e16d5 100644 --- a/native/io.h +++ b/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, diff --git a/native/primitives.c b/native/primitives.c index f2fadc14bc..27d558e6e4 100644 --- a/native/primitives.c +++ b/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, diff --git a/native/primitives.h b/native/primitives.h index baeaa8997b..9990a9d11e 100644 --- a/native/primitives.h +++ b/native/primitives.h @@ -1,4 +1,4 @@ extern XT primitives[]; -#define PRIMITIVE_COUNT 140 +#define PRIMITIVE_COUNT 141 CELL primitive_to_xt(CELL primitive); diff --git a/native/read.c b/native/read.c index b4f89fae15..5430798896 100644 --- a/native/read.c +++ b/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; diff --git a/native/socket.c b/native/socket.c index a055eeaf7f..f1ca82e914 100644 --- a/native/socket.c +++ b/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; diff --git a/native/socket.h b/native/socket.h index 33122d26c8..3123c8ae5b 100644 --- a/native/socket.h +++ b/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); diff --git a/native/write.c b/native/write.c index 6821e03f85..655abc8fc0 100644 --- a/native/write.c +++ b/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); diff --git a/native/write.h b/native/write.h index 0efacb086a..f11ddea0ef 100644 --- a/native/write.h +++ b/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);