http: Reject methods other than GET.

* src/cuirass/http.scm (url-handler): Check whether REQUEST's method is
'GET, and return 405 if not.

2 files changed, 11 insertions, 1 deletions

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"))))