gf -server: better error message for requests with unsupported HTTP methods

src/compiler/GFServer.hs

@@ -90,11 +90,13 @@ handle_fcgi execute1 state0 stateM cache =
 -- | HTTP request handler
 handle state0 cache execute1
        rq@(Request method URI{uriPath=upath,uriQuery=q} hdrs body) state =
-    do let qs = case method of
+    case method of
-                  "GET" -> inputs q
+      "POST" -> normal_request (inputs body)
-                  "POST" -> inputs body
+      "GET"  -> normal_request (inputs q)
-
+      _ -> return (state,resp501 $ "method "++method)
-       logPutStrLn $ method++" "++upath++" "++show qs
+  where
+    normal_request qs =
+      do logPutStrLn $ method++" "++upath++" "++show qs
          case upath of
            "/new" -> new
 --         "/stop" ->
@@ -110,7 +112,7 @@ handle state0 cache execute1
                        return (state,resp)
              where path = translatePath rpath
            _ -> return (state,resp400 upath)
-  where
+
     root = "."
 
     translatePath rpath = root</>rpath -- hmm, check for ".."
@@ -275,6 +277,7 @@ html200      = ok200' htmlUTF8 . encodeString
 resp204      = Response 204 [] "" -- no content
 resp400 msg  = Response 400 [plain] $ "Bad request: "++msg++"\n"
 resp404 path = Response 404 [plain] $ "Not found: "++path++"\n"
+resp501 msg  = Response 501 [plain] $ "Not implemented: "++msg++"\n"
 
 -- * Content types
 plain = ct "text/plain"