http.server: Implement DELETE, PATCH; handle unknown methods

Handle DELETE and PATCH.  Be lenient and hand URL query parameters to
the user with a DELETE.  There is debate about whether DELETE should
handle query parameters.  Additionally, some implementations even reject
DELETE requests with a body.  So, leave all these additional
"protections" for a later implementation (e.g. in furnace).

Treat unknown methods like requests without parameters.

diff --git a/basis/http/server/server-docs.factor b/basis/http/server/server-docs.factor
index a3a24c462f777b6707235b6e98a4e399ae7c7ce5..9b8d4d7bbbd9f13f4b1ebe7bd901dc2e08e75a33 100644 (file)
--- a/basis/http/server/server-docs.factor
+++ b/basis/http/server/server-docs.factor
@@ -34,7 +34,11 @@ HELP: main-responder
 
 HELP: post-request?
 { $values { "?" boolean } }
-{ $description "Outputs if the current request is a POST request.s" } ;
+{ $description "Outputs if the current request is a POST request." } ;
+
+HELP: method=
+{ $values { "str" "a string" } { "?" boolean } }
+{ $description "Outputs if the current request matches the expected method." } ;
 
 HELP: responder-nesting
 { $description "A sequence of " { $snippet "{ path responder }" } " pairs." } ;

diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor
index 2d5b333714bacf31357e192f97849a78420401d2..2083667940e6bfaa71ef999e3b4aa28e083f4031 100644 (file)
--- a/basis/http/server/server.factor
+++ b/basis/http/server/server.factor
@@ -70,7 +70,9 @@ M: raw-response write-response
 M: raw-response write-full-response
     nip write-response ;
 
-: post-request? ( -- ? ) request get method>> "POST" = ;
+: method= ( str -- ? ) request get method>> = ;
+
+: post-request? ( -- ? ) "POST" method= ;
 
 SYMBOL: responder-nesting
 
@@ -142,8 +144,11 @@ LOG: httpd-header NOTICE
         { "GET" [ url>> query>> ] }
         { "HEAD" [ url>> query>> ] }
         { "OPTIONS" [ url>> query>> ] }
+        { "DELETE" [ url>> query>> ] }
         { "POST" [ post-data>> params>> ] }
+        { "PATCH" [ post-data>> params>> ] }
         { "PUT" [ post-data>> params>> ] }
+        [ 2drop H{ } clone ]
     } case ;
 
 SYMBOL: params