From d40b52f4ef0d88815bd7122aa8ac2f1084c3da7b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Sep 2007 20:31:32 -0400 Subject: [PATCH] Update HTTP server for HTML stream changes --- extra/furnace/furnace.factor | 6 ++-- extra/http/http.factor | 2 +- .../continuation/examples/examples.factor | 10 +++--- extra/http/server/responders/file/file.factor | 33 +++++++++++-------- .../http/server/responders/responders.factor | 9 ++--- extra/webapps/help/help.factor | 15 +++++---- 6 files changed, 42 insertions(+), 33 deletions(-) diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor index 8a475b98db..330c486817 100644 --- a/extra/furnace/furnace.factor +++ b/extra/furnace/furnace.factor @@ -118,18 +118,18 @@ SYMBOL: model : render-page* ( model body-template head-template -- ) [ - [ render-template ] [ f rot render-template ] html-document* + [ render-template ] [ f rot render-template ] html-document ] serve-html ; : render-titled-page* ( model body-template head-template title -- ) [ - [ render-template ] swap [ write f rot render-template ] curry html-document* + [ render-template ] swap [ write f rot render-template ] curry html-document ] serve-html ; : render-page ( model template title -- ) [ - [ render-template ] html-document + [ render-template ] simple-html-document ] serve-html ; : web-app ( name default path -- ) diff --git a/extra/http/http.factor b/extra/http/http.factor index 687fa807f5..a358c449af 100644 --- a/extra/http/http.factor +++ b/extra/http/http.factor @@ -7,7 +7,7 @@ IN: http : header-line ( line -- ) ": " split1 dup [ swap set ] [ 2drop ] if ; -: (read-header) ( hash -- hash ) +: (read-header) ( -- ) readln dup empty? [ drop ] [ header-line (read-header) ] if ; diff --git a/extra/http/server/responders/continuation/examples/examples.factor b/extra/http/server/responders/continuation/examples/examples.factor index 2a2eae72d7..e6abcc7a72 100644 --- a/extra/http/server/responders/continuation/examples/examples.factor +++ b/extra/http/server/responders/continuation/examples/examples.factor @@ -34,7 +34,7 @@ IN: http.server.responders.continuation.examples

over write

swap [ "Next" write - ] html-document + ] simple-html-document ] show 2drop ; : display-get-name-page ( -- name ) @@ -47,7 +47,7 @@ IN: http.server.responders.continuation.examples - ] html-document + ] simple-html-document ] show "name" swap at ; : test-cont-responder ( -- ) @@ -71,7 +71,7 @@ IN: http.server.responders.continuation.examples
  • "Test responder1" [ test-cont-responder ] quot-href
  • "Test responder2" [ test-cont-responder2 ] quot-href
    • - ] html-document + ] simple-html-document ] show-final ; : counter-example ( count -- ) @@ -87,7 +87,7 @@ IN: http.server.responders.continuation.examples "++" over 1quotation [ f ] swap append [ 1 + counter-example ] append quot-href "--" over 1quotation [ f ] swap append [ 1 - counter-example ] append quot-href drop - ] html-document + ] simple-html-document ] show drop ; : counter-example2 ( -- ) @@ -102,7 +102,7 @@ IN: http.server.responders.continuation.examples

    "counter" get unparse write

    "++" [ "counter" get 1 + "counter" set ] quot-href "--" [ "counter" get 1 - "counter" set ] quot-href - ] html-document + ] simple-html-document ] show drop ; diff --git a/extra/http/server/responders/file/file.factor b/extra/http/server/responders/file/file.factor index e6af805462..4f83e8fa98 100644 --- a/extra/http/server/responders/file/file.factor +++ b/extra/http/server/responders/file/file.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2004, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: calendar html io io.files kernel math math.parser http.server.responders -http.server.templating namespaces parser sequences strings assocs hashtables -debugger http.mime sorting ; +USING: calendar html io io.files kernel math math.parser +http.server.responders http.server.templating namespaces parser +sequences strings assocs hashtables debugger http.mime sorting +html.elements ; IN: http.server.responders.file @@ -55,19 +56,25 @@ SYMBOL: page dup mime-type dup "application/x-factor-server-page" = [ drop serving-html run-page ] [ serve-static ] if ; -: file. ( path name dirp -- ) - "[DIR] " " " ? write - dup write-object nl ; +: file. ( name dirp -- ) + [ "/" append ] when + dup write ; -: directory. ( path -- ) - directory sort-keys [ first2 file. ] each ; +: directory. ( path request -- ) + dup [ +

    write

    + + ] simple-html-document ; : list-directory ( directory -- ) serving-html "method" get "head" = [ drop ] [ - "request" get [ directory. ] simple-html-document + "request" get directory. ] if ; : find-index ( filename -- path ) @@ -98,17 +105,17 @@ SYMBOL: page ] if ; global [ - ! Javascript source used by ajax libraries + ! Serve up our own source code "resources" [ [ - "extra/http/server/resources/" resource-path "doc-root" set + "" resource-path "doc-root" set file-responder ] with-scope ] add-simple-responder ! Serves files from a directory stored in the "doc-root" - ! variable. You can set the variable in the global namespace, - ! or inside the responder. + ! variable. You can set the variable in the global + ! namespace, or inside the responder. "file" [ file-responder ] add-simple-responder ! The root directory is served by... diff --git a/extra/http/server/responders/responders.factor b/extra/http/server/responders/responders.factor index 725cb515b0..aadf513aea 100644 --- a/extra/http/server/responders/responders.factor +++ b/extra/http/server/responders/responders.factor @@ -16,16 +16,16 @@ SYMBOL: responders : response ( header msg -- ) "HTTP/1.0 " write print print-header ; -: error-body ( error -- body ) +: error-body ( error -- )

    write

    ; : error-head ( error -- ) dup log-error - H{ { "Content-Type" "text/html" } } over response ; + H{ { "Content-Type" "text/html" } } swap response ; : httpd-error ( error -- ) #! This must be run from handle-request - error-head + dup error-head "head" "method" get = [ drop ] [ nl error-body ] if ; : bad-request ( -- ) @@ -101,7 +101,8 @@ SYMBOL: max-post-request dup "request" set ; : prepare-header ( -- ) - read-header dup "header" set + read-header + dup "header" set dup log-headers read-post-request "response" set "raw-response" set ; diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor index ec0590df34..366baffcb9 100644 --- a/extra/webapps/help/help.factor +++ b/extra/webapps/help/help.factor @@ -10,7 +10,7 @@ IN: webapps.help serving-html dup article-title [ [ help ] with-html-stream - ] html-document ; + ] simple-html-document ; : string>topic ( string -- topic ) " " split dup length 1 = [ first ] when ; @@ -73,9 +73,10 @@ M: vocab-author browser-link-href "help" "show-help" "extra/webapps/help" web-app ! Hard-coding for factorcode.org -M: pathname browser-link-href - pathname-string "resource:" ?head [ - "http://factorcode.org/repos/Factor/" swap append - ] [ - drop f - ] if ; +PREDICATE: pathname resource-pathname + pathname-string "resource:" head? ; + +M: resource-pathname browser-link-href + pathname-string + "resource:" ?head drop + "/responder/resources/" swap append ;