diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index e7a208374a..031f4955a6 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,8 +1,7 @@ -- telnetd should use multitasking -- file-responder: Content-Length -- HEAD request for file-responder - - nicer way to combine two paths - - icons for file responder +- TEST telnetd should use multitasking +- quit responder breaks with multithreading +- nicer way to combine two paths +- icons for file responder - -1.1 3 ^ shouldn't give a complex number - don't show listener on certain commands - inferior hangs @@ -19,6 +18,7 @@ - introduce ifte* and ?str-head/?str-tail where appropriate - cwd, cd, pwd, dir., pwd. words - namespace clone drops static var bindings +- f usages. --> don't print all words + bignums: @@ -100,7 +100,6 @@ + httpd: - 'default responder' for when we go to root -- quit responder breaks with multithreading - wiki responder: - port to native - text styles diff --git a/actions.xml b/actions.xml index d60bc249a8..4e729bca10 100644 --- a/actions.xml +++ b/actions.xml @@ -18,19 +18,22 @@ VFSManager.waitForRequests(); FactorPlugin.eval(view, "\"" - + factor.FactorReader.charsToEscapes(buffer.path) + + FactorReader.charsToEscapes(buffer.path) + "\" run-file"); - if(textArea.selectionCount == 0) - textArea.selectWord(); - FactorPlugin.eval(view, - "\"" - + factor.FactorReader.charsToEscapes( - textArea.selectedText) - + "\" apropos."); + word = FactorPlugin.getWordAtCaret(textArea); + if(word == null) + view.toolkit.beep(); + else + { + FactorPlugin.eval(view, + "\"" + + FactorReader.charsToEscapes(word) + + "\" apropos."); + } @@ -55,10 +58,11 @@ - if(textArea.selectionCount == 0) - textArea.selectWord(); - FactorPlugin.insertUseDialog(view, - textArea.selectedText); + word = FactorPlugin.getWordAtCaret(textArea); + if(word == null) + view.toolkit.beep(); + else + FactorPlugin.insertUseDialog(view,word); diff --git a/factor/jedit/FactorPlugin.java b/factor/jedit/FactorPlugin.java index 1d122ee72b..9dd3885d3b 100644 --- a/factor/jedit/FactorPlugin.java +++ b/factor/jedit/FactorPlugin.java @@ -44,6 +44,13 @@ public class FactorPlugin extends EditPlugin private static FactorInterpreter interp; + //{{{ start() method + public void start() + { + BeanShell.eval(null,BeanShell.getNameSpace(), + "import factor.*;\nimport factor.jedit.*;\n"); + } //}}} + //{{{ getInterpreter() method /** * This can be called from the SideKick thread and must be thread safe. diff --git a/library/httpd/default-responders.factor b/library/httpd/default-responders.factor index ad0190c29c..e4f5f442e3 100644 --- a/library/httpd/default-responders.factor +++ b/library/httpd/default-responders.factor @@ -68,6 +68,8 @@ USE: wiki-responder [ "file" "responder" set [ file-responder ] "get" set + [ file-responder ] "post" set + [ file-responder ] "head" set ] extend "file" set ! [ diff --git a/library/httpd/file-responder.factor b/library/httpd/file-responder.factor index 4579d597a0..9673a9d846 100644 --- a/library/httpd/file-responder.factor +++ b/library/httpd/file-responder.factor @@ -33,6 +33,7 @@ USE: html USE: httpd USE: httpd-responder USE: kernel +USE: lists USE: logging USE: namespaces USE: parser @@ -40,18 +41,26 @@ USE: stack USE: stdio USE: streams USE: strings +USE: unparser : serving-path ( filename -- filename ) f>"" "doc-root" get swap cat2 ; -: file-header ( mime-type -- header ) - "200 Document follows" swap response ; - : copy-and-close ( from -- ) [ dupd "stdio" get fcopy ] [ >r fclose r> rethrow ] catch ; +: file-response ( mime-type length -- ) + [, + unparse "Content-Length" swons , + "Content-Type" swons , + ,] "200 OK" response ; + : serve-static ( filename mime-type -- ) - file-header print "stdio" get fcopy ; + over file-length file-response "method" get "head" = [ + drop + ] [ + "stdio" get copy-and-close + ] ifte ; : serve-file ( filename -- ) dup mime-type dup "application/x-factor-server-page" = [ @@ -66,7 +75,12 @@ USE: strings %> redirect ; : list-directory ( directory -- ) - serving-html dup [ directory. ] simple-html-document ; + serving-html + "method" get "head" = [ + drop + ] [ + dup [ directory. ] simple-html-document + ] ifte ; : serve-directory ( filename -- ) "/" ?str-tail [ @@ -82,13 +96,13 @@ USE: strings : serve-object ( filename -- ) dup directory? [ serve-directory ] [ serve-file ] ifte ; -: file-responder ( filename -- ) +: file-responder ( filename method -- ) "doc-root" get [ serving-path dup exists? [ serve-object ] [ - drop "404 not found" httpd-error + 2drop "404 not found" httpd-error ] ifte ] [ - drop "404 doc-root not set" httpd-error + 2drop "404 doc-root not set" httpd-error ] ifte ; diff --git a/library/httpd/http-common.factor b/library/httpd/http-common.factor index 4fdea40574..82aaa5afd2 100644 --- a/library/httpd/http-common.factor +++ b/library/httpd/http-common.factor @@ -42,30 +42,42 @@ USE: unparser USE: url-encoding -: response ( msg content-type -- response ) - swap <% "HTTP/1.0 " % % "\nContent-Type: " % % "\n" % %> ; +: print-header ( alist -- ) + [ unswons write ": " write url-encode print ] each ; -: response-write ( msg content-type -- ) - response print ; +: response ( header msg -- ) + "HTTP/1.0 " write print print-header ; : error-body ( error -- body ) - "\n

" swap "

" cat3 ; + "

" swap "

" cat3 print ; + +: error-head ( error -- ) + dup log-error + [ [ "Content-Type" | "text/html" ] ] over response ; : httpd-error ( error -- ) - dup log-error - <% dup "text/html" response % error-body % %> print ; + #! This must be run from handle-request + error-head + "head" "method" get = [ terpri error-body ] unless ; + +: bad-request ( -- ) + [ + ! Make httpd-error print a body + "get" "method" set + "400 Bad request" httpd-error + ] with-scope ; : serving-html ( -- ) - "200 Document follows" "text/html" response print ; + [ [ "Content-Type" | "text/html" ] ] + "200 Document follows" response terpri ; : serving-text ( -- ) - "200 Document follows" "text/plain" response print ; + [ [ "Content-Type" | "text/plain" ] ] + "200 Document follows" response terpri ; : redirect ( to -- ) - "301 Moved Permanently" "text/plain" response write - "Location: " write write - terpri terpri - "The resource has moved." print ; + "Location" swons unit + "301 Moved Permanently" response terpri ; : header-line ( alist line -- alist ) ": " split1 dup [ transp acons ] [ 2drop ] ifte ; @@ -107,7 +119,3 @@ USE: url-encoding read-header dup "header" set dup log-user-agent read-post-request "response" set ; - -: with-request ( url quot -- ) - #! The quotation is called with the URL on the stack. - [ swap prepare-url swap prepare-header call ] with-scope ; diff --git a/library/httpd/httpd.factor b/library/httpd/httpd.factor index 373fa21b27..1b47875fe3 100644 --- a/library/httpd/httpd.factor +++ b/library/httpd/httpd.factor @@ -30,6 +30,7 @@ USE: combinators USE: errors USE: httpd-responder USE: kernel +USE: lists USE: logging USE: logic USE: namespaces @@ -48,9 +49,6 @@ USE: url-encoding drop "stdio" get ] ifte ; -: bad-request ( -- ) - "400 Bad request" httpd-error ; - : url>path ( uri -- path ) url-decode dup "http://" str-head? dup [ "/" split1 f "" replace nip nip @@ -61,22 +59,19 @@ USE: url-encoding : secure-path ( path -- path ) ".." over str-contains? [ drop f ] when ; -: get-request ( url -- ) - [ "get" swap serve-responder ] with-request ; +: request-method ( cmd -- method ) + [ + [ "GET" | "get" ] + [ "POST" | "post" ] + [ "HEAD" | "head" ] + ] assoc [ "bad" ] unless* ; -: post-request ( url -- ) - [ "post" swap serve-responder ] with-request ; - -: head-request ( url -- ) - [ "head" swap serve-responder ] with-request ; +: (handle-request) ( arg cmd -- url method ) + request-method dup "method" set swap + prepare-url prepare-header ; : handle-request ( arg cmd -- ) - [ - [ "GET" = ] [ drop get-request ] - [ "POST" = ] [ drop post-request ] - [ "HEAD" = ] [ drop head-request ] - [ drop t ] [ 2drop bad-request ] - ] cond ; + [ (handle-request) serve-responder ] with-scope ; : parse-request ( request -- ) dup log diff --git a/library/httpd/responder.factor b/library/httpd/responder.factor index eaea0d8e5a..2d182d572f 100644 --- a/library/httpd/responder.factor +++ b/library/httpd/responder.factor @@ -41,6 +41,7 @@ USE: strings ! Responders are called in a new namespace with these ! variables: +! - method -- one of get, post, or head. ! - request -- the entire URL requested, including responder ! name ! - raw-query -- raw query string @@ -64,6 +65,10 @@ USE: strings [ drop "HEAD method not implemented" httpd-error ] "head" set + ( url -- ) + [ + drop bad-request + ] "bad" set ] extend ; : get-responder ( name -- responder ) diff --git a/library/platform/jvm/files.factor b/library/platform/jvm/files.factor index 89f5566865..78a5f6a6bb 100644 --- a/library/platform/jvm/files.factor +++ b/library/platform/jvm/files.factor @@ -57,3 +57,6 @@ USE: strings swap [ "java.io.File" ] "java.io.File" "renameTo" jinvoke ; + +: file-length ( file -- size ) + [ ] "java.io.File" "length" jinvoke ; diff --git a/library/platform/native/files.factor b/library/platform/native/files.factor index 9d8defbec8..82357a3ce0 100644 --- a/library/platform/native/files.factor +++ b/library/platform/native/files.factor @@ -42,3 +42,6 @@ USE: strings : directory ( dir -- list ) #! List a directory. (directory) str-sort ; + +: file-length ( file -- length ) + stat dup [ cdr cdr car ] when ; diff --git a/library/telnetd.factor b/library/telnetd.factor index 06522e113a..abb9d4102b 100644 --- a/library/telnetd.factor +++ b/library/telnetd.factor @@ -27,15 +27,16 @@ IN: telnetd USE: combinators -USE: continuations USE: errors USE: interpreter +USE: kernel USE: logging USE: logic USE: namespaces USE: stack USE: stdio USE: streams +USE: threads : telnet-client ( socket -- ) dup [ @@ -45,6 +46,14 @@ USE: streams interpreter-loop ] with-stream ; +: telnet-connection ( socket -- ) + #! We don't do multitasking in JFactor. + java? [ + telnet-client + ] [ + [ telnet-client ] in-thread drop + ] ifte ; + : quit-flag ( -- ? ) global [ "telnetd-quit-flag" get ] bind ; @@ -55,7 +64,7 @@ USE: streams [ quit-flag not ] [ - dup >r accept telnet-client r> + dup >r accept telnet-connection r> ] while ; : telnetd ( port -- ) diff --git a/library/test/httpd/httpd.factor b/library/test/httpd/httpd.factor index 2eb0afd9f7..5338c4bcc0 100644 --- a/library/test/httpd/httpd.factor +++ b/library/test/httpd/httpd.factor @@ -7,9 +7,14 @@ USE: namespaces USE: stdio USE: test USE: url-encoding +USE: strings +USE: stack +USE: lists -[ "HTTP/1.0 404\nContent-Type: text/html\n" ] -[ "404" "text/html" response ] unit-test +[ "HTTP/1.0 200 OK\nContent-Length: 12\nContent-Type: text/html\n" ] +[ + [ "text/html" 12 file-response ] with-string +] unit-test [ 5430 ] [ f "Content-Length: 5430" header-line content-length ] unit-test