guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[no subject]


From: Ludovic Courtès
Date: Fri, 26 Jan 2018 17:49:04 -0500 (EST)

branch: master
commit 4558d1c86914e2427fc99afbe00c28cb716dbd3d
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jan 26 22:27:55 2018 +0100

    http: Reject methods other than GET.
    
    * src/cuirass/http.scm (url-handler): Check whether REQUEST's method is
    'GET, and return 405 if not.
---
 src/cuirass/http.scm | 8 +++++++-
 tests/http.scm       | 4 ++++
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 1939c34..6b67379 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -130,7 +130,10 @@
   (log-message "~a ~a" (request-method request)
                (uri-path (request-uri request)))
 
-  (match (request-path-components request)
+  ;; Reject OPTIONS, POST, etc.
+  (match (if (eq? 'GET (request-method request))
+             (request-path-components request)
+             'method-not-allowed)
     (((or "jobsets" "specifications") . rest)
      (respond-json (object->json-string (car (db-get-specifications db)))))
     (("build" build-id)
@@ -182,6 +185,9 @@
                                                    ,@params
                                                    (order submission-time)))))
            (respond-json-with-error 500 "Parameter not defined!"))))
+    ('method-not-allowed
+     ;; 405 "Method Not Allowed"
+     (values (build-response #:code 405) #f db))
     (_
      (respond (build-response #:code 404)
               #:body (string-append "Resource not found: "
diff --git a/tests/http.scm b/tests/http.scm
index 6dd48a3..1e1f754 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -195,6 +195,10 @@
          (object->json-string build-query-result)
        json->scm)))
 
+  (test-equal "POST /build/1"
+    405                                           ;Method Not Allowed
+    (response-code (http-post (test-cuirass-uri "/build/1"))))
+
   (test-equal "/build/1/log/raw"
     `(302 ,(string->uri-reference "/log/fake-1.0"))
     (let ((response (http-get (test-cuirass-uri "/build/1/log/raw"))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]