From fa4a10b328962f0eaa791d0f0705a1ee7236ec1f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 3 Aug 2009 14:58:18 -0500 Subject: [PATCH] Move furnace.actions:{param,params} and furnace.utilities:request-params to http.server --- basis/furnace/actions/actions-docs.factor | 18 ++------------ basis/furnace/actions/actions.factor | 12 +++------- basis/furnace/utilities/utilities-docs.factor | 5 ---- basis/furnace/utilities/utilities.factor | 7 ------ basis/http/server/server-docs.factor | 24 ++++++++++++++++++- basis/http/server/server.factor | 22 +++++++++++++++-- 6 files changed, 48 insertions(+), 40 deletions(-) diff --git a/basis/furnace/actions/actions-docs.factor b/basis/furnace/actions/actions-docs.factor index 83ed00ca1b..451effddd8 100644 --- a/basis/furnace/actions/actions-docs.factor +++ b/basis/furnace/actions/actions-docs.factor @@ -33,18 +33,6 @@ HELP: new-action HELP: page-action { $class-description "The class of Chloe page actions. These are actions whose " { $slot "display" } " slot is pre-set to serve the Chloe template stored in the " { $slot "page" } " slot." } ; -HELP: param -{ $values - { "name" string } - { "value" string } -} -{ $description "Outputs the value of a query parameter (if the current request is a GET or HEAD request) or a POST parameter (if the current request is a POST request)." } -{ $notes "Instead of using this word, it is better to use " { $link validate-params } " and then access parameters via " { $link "html.forms.values" } " words." } ; - -HELP: params -{ $var-description "A variable holding an assoc of query parameters (if the current request is a GET or HEAD request) or POST parameters (if the current request is a POST request)." } -{ $notes "Instead of using this word, it is better to use " { $link validate-params } " and then access parameters via " { $link "html.forms.values" } " words." } ; - HELP: validate-integer-id { $description "A utility word which validates an integer parameter named " { $snippet "id" } "." } { $examples @@ -144,10 +132,8 @@ ARTICLE: "furnace.actions.lifecycle" "Furnace action lifecycle" "Any one of the above steps can perform validation; if " { $link validation-failed } " is called during a POST request, the client is sent back to the page containing the form submission, with current form values and validation errors passed in a " { $link "furnace.conversations" } "." ; ARTICLE: "furnace.actions.impl" "Furnace actions implementation" -"The following words are used by the action implementation and there is rarely any reason to call them directly:" -{ $subsection new-action } -{ $subsection param } -{ $subsection params } ; +"The following parametrized constructor should be called from constructors for subclasses of " { $link action } ":" +{ $subsection new-action } ; ARTICLE: "furnace.actions" "Furnace actions" "The " { $vocab-link "furnace.actions" } " vocabulary implements a type of responder, called an " { $emphasis "action" } ", which handles the form validation lifecycle." diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index 06e743e967..aca03b9029 100644 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -17,8 +17,6 @@ html.templates.chloe.syntax html.templates.chloe.compiler ; IN: furnace.actions -SYMBOL: params - SYMBOL: rest TUPLE: action rest init authorize display validate submit ; @@ -60,9 +58,6 @@ TUPLE: action rest init authorize display validate submit ; ] [ drop <400> ] if ] with-exit-continuation ; -: param ( name -- value ) - params get at ; - CONSTANT: revalidate-url-key "__u" : revalidate-url ( -- url/f ) @@ -88,13 +83,12 @@ CONSTANT: revalidate-url-key "__u" ] [ drop <400> ] if ] with-exit-continuation ; -: handle-rest ( path action -- assoc ) - rest>> dup [ [ "/" join ] dip associate ] [ 2drop f ] if ; +: handle-rest ( path action -- ) + rest>> dup [ [ "/" join ] dip set-param ] [ 2drop ] if ; : init-action ( path action -- ) begin-form - handle-rest - request get request-params assoc-union params set ; + handle-rest ; M: action call-responder* ( path action -- response ) [ init-action ] keep diff --git a/basis/furnace/utilities/utilities-docs.factor b/basis/furnace/utilities/utilities-docs.factor index e7fdaf64d6..b00f7fa523 100644 --- a/basis/furnace/utilities/utilities-docs.factor +++ b/basis/furnace/utilities/utilities-docs.factor @@ -63,10 +63,6 @@ HELP: referrer { $values { "referrer/f" { $maybe string } } } { $description "Outputs the current request's referrer URL." } ; -HELP: request-params -{ $values { "request" request } { "assoc" assoc } } -{ $description "Outputs the query parameters (if the current request is a GET or HEAD request) or the POST parameters (if the current request is a POST request)." } ; - HELP: resolve-base-path { $values { "string" string } { "string'" string } } { $description "Resolves a responder-relative URL." } ; @@ -121,6 +117,5 @@ ARTICLE: "furnace.misc" "Miscellaneous Furnace features" { $subsection exit-with } "Other useful words:" { $subsection hidden-form-field } -{ $subsection request-params } { $subsection client-state } { $subsection user-agent } ; diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index a43466489c..dc90ad4e8c 100755 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -91,13 +91,6 @@ M: object modify-form drop f ; CONSTANT: nested-forms-key "__n" -: request-params ( request -- assoc ) - dup method>> { - { "GET" [ url>> query>> ] } - { "HEAD" [ url>> query>> ] } - { "POST" [ post-data>> params>> ] } - } case ; - : referrer ( -- referrer/f ) #! Typo is intentional, it's in the HTTP spec! "referer" request get header>> at diff --git a/basis/http/server/server-docs.factor b/basis/http/server/server-docs.factor index daf0305972..e6d5c63ac1 100644 --- a/basis/http/server/server-docs.factor +++ b/basis/http/server/server-docs.factor @@ -1,4 +1,5 @@ -USING: help.markup help.syntax io.streams.string quotations strings urls http vocabs.refresh math io.servers.connection ; +USING: help.markup help.syntax io.streams.string quotations strings urls +http vocabs.refresh math io.servers.connection assocs ; IN: http.server HELP: trivial-responder @@ -52,12 +53,33 @@ HELP: httpd HELP: http-insomniac { $description "Starts a thread which rotates the logs and e-mails a summary of HTTP requests every 24 hours. See " { $link "logging.insomniac" } "." } ; +HELP: request-params +{ $values { "request" request } { "assoc" assoc } } +{ $description "Outputs the query parameters (if the current request is a GET or HEAD request) or the POST parameters (if the current request is a POST request)." } ; + +HELP: param +{ $values + { "name" string } + { "value" string } +} +{ $description "Outputs the value of a query parameter (if the current request is a GET or HEAD request) or a POST parameter (if the current request is a POST request)." } +{ $notes "Instead of using this word, it is better to use " { $vocab-link "furnace.actions" } " and the associated validation machinery, which allows you to access values using " { $link "html.forms.values" } " words." } ; + +HELP: params +{ $var-description "A variable holding an assoc of query parameters (if the current request is a GET or HEAD request) or POST parameters (if the current request is a POST request)." } +{ $notes "Instead of using this word, it is better to use " { $vocab-link "furnace.actions" } " and the associated validation machinery, which allows you to access values using " { $link "html.forms.values" } " words." } ; + ARTICLE: "http.server.requests" "HTTP request variables" "The following variables are set by the HTTP server at the beginning of a request." { $subsection request } { $subsection url } { $subsection post-request? } { $subsection responder-nesting } +{ $subsection params } +"Utility words:" +{ $subsection param } +{ $subsection set-param } +{ $subsection request-params } "Additional vocabularies may be set by vocabularies such as " { $vocab-link "html.forms" } " and " { $vocab-link "furnace.sessions" } "." ; ARTICLE: "http.server.responders" "HTTP server responders" diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index 8682c97c73..131fe3fe18 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -3,7 +3,8 @@ USING: kernel accessors sequences arrays namespaces splitting vocabs.loader destructors assocs debugger continuations combinators vocabs.refresh tools.time math math.parser present -io vectors +vectors hashtables +io io.sockets io.sockets.secure io.encodings @@ -212,8 +213,25 @@ LOG: httpd-header NOTICE : split-path ( string -- path ) "/" split harvest ; +: request-params ( request -- assoc ) + dup method>> { + { "GET" [ url>> query>> ] } + { "HEAD" [ url>> query>> ] } + { "POST" [ post-data>> params>> ] } + } case ; + +SYMBOL: params + +: param ( name -- value ) + params get at ; + +: set-param ( value name -- ) + params get set-at ; + : init-request ( request -- ) - [ request set ] [ url>> url set ] bi + [ request set ] + [ url>> url set ] + [ request-params >hashtable params set ] tri V{ } clone responder-nesting set ; : dispatch-request ( request -- response )