.. by returing the appropriate 405 code, listing the HTTP methods that
are allowed.

While currently the actual read/write calls haven't been implemented
yet, this makes debugging easier for both the code and OS scripts.

Package case-insensitive is already a dependency of snap-core, it's just
now made explicit in the cabal template.

Signed-off-by: Petr Pudlak <[email protected]>
---
 cabal/ganeti.template.cabal   |  1 +
 src/Ganeti/Metad/WebServer.hs | 12 ++++++++++++
 2 files changed, 13 insertions(+)

diff --git a/cabal/ganeti.template.cabal b/cabal/ganeti.template.cabal
index 25c03aa..4b231c1 100644
--- a/cabal/ganeti.template.cabal
+++ b/cabal/ganeti.template.cabal
@@ -52,6 +52,7 @@ library
 
     , attoparsec                    >= 0.10.1.1   && < 0.13
     , base64-bytestring             >= 1.0.0.1    && < 1.1
+    , case-insensitive              >= 0.4.0.1    && < 1.3
     , Crypto                        >= 4.2.4      && < 4.3
     , curl                          >= 1.3.7      && < 1.4
     , hinotify                      >= 0.3.2      && < 0.4
diff --git a/src/Ganeti/Metad/WebServer.hs b/src/Ganeti/Metad/WebServer.hs
index 8558911..338d3e4 100644
--- a/src/Ganeti/Metad/WebServer.hs
+++ b/src/Ganeti/Metad/WebServer.hs
@@ -40,6 +40,8 @@ import Control.Concurrent (MVar, readMVar)
 import Control.Monad.Error.Class (MonadError, catchError, throwError)
 import Control.Monad.IO.Class (liftIO)
 import qualified Control.Monad.CatchIO as CatchIO (catch)
+import qualified Data.CaseInsensitive as CI
+import Data.List (intercalate)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import qualified Data.ByteString.Char8 as ByteString (pack, unpack)
@@ -79,6 +81,12 @@ error404 = do
   modifyResponse $ setResponseStatus 404 "Not found"
   writeBS "Resource not found"
 
+-- | The 405 "method not allowed error", including the list of allowed methods.
+error405 :: [Method] -> MetaM
+error405 ms = modifyResponse $
+  addHeader (CI.mk "Allow") (ByteString.pack . intercalate ", " $ map show ms)
+  . setResponseStatus 405 "Method not allowed"
+
 maybeResult :: MonadError String m => Result t -> (t -> m a) -> m a
 maybeResult (Error err) _ = throwError err
 maybeResult (Ok x) f = f x
@@ -174,8 +182,12 @@ handleMetadata params GET  "ganeti" "latest" script | 
isScript script =
                   ])
 handleMetadata _ GET  "ganeti" "latest" "read" =
   liftIO $ Logging.logInfo "ganeti READ"
+handleMetadata _ _  "ganeti" "latest" "read" =
+  error405 [GET]
 handleMetadata _ POST "ganeti" "latest" "write" =
   liftIO $ Logging.logInfo "ganeti WRITE"
+handleMetadata _ _ "ganeti" "latest" "write" =
+  error405 [POST]
 handleMetadata _ _ _ _ _ =
   error404
 
-- 
2.2.0.rc0.207.ga3a616c

Reply via email to