root / src / Ganeti / Metad.hs @ 13d26b66
History | View | Annotate | Download (3.2 kB)
1 |
{-| Metadata daemon |
---|---|
2 |
|
3 |
-} |
4 |
|
5 |
{- |
6 |
|
7 |
Copyright (C) 2014 Google Inc. |
8 |
|
9 |
This program is free software; you can redistribute it and/or modify |
10 |
it under the terms of the GNU General Public License as published by |
11 |
the Free Software Foundation; either version 2 of the License, or |
12 |
(at your option) any later version. |
13 |
|
14 |
This program is distributed in the hope that it will be useful, but |
15 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
16 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 |
General Public License for more details. |
18 |
|
19 |
You should have received a copy of the GNU General Public License |
20 |
along with this program; if not, write to the Free Software |
21 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 |
02110-1301, USA. |
23 |
|
24 |
-} |
25 |
|
26 |
module Ganeti.Metad (start) where |
27 |
|
28 |
import Control.Applicative |
29 |
import Control.Monad.IO.Class (liftIO) |
30 |
import qualified Data.ByteString.Char8 as ByteString (pack, unpack) |
31 |
import Snap.Core |
32 |
import Snap.Http.Server |
33 |
|
34 |
import Ganeti.Daemon |
35 |
import qualified Ganeti.Constants as Constants |
36 |
import qualified Ganeti.Logging as Logging |
37 |
import Ganeti.Runtime (GanetiDaemon(..), ExtraLogReason(..)) |
38 |
import qualified Ganeti.Runtime as Runtime |
39 |
|
40 |
type MetaM = Snap () |
41 |
|
42 |
error404 :: MetaM |
43 |
error404 = do |
44 |
modifyResponse . setResponseStatus 404 $ ByteString.pack "Not found" |
45 |
writeBS $ ByteString.pack "Resource not found" |
46 |
|
47 |
handleMetadata :: Method -> String -> String -> String -> MetaM |
48 |
handleMetadata GET "ganeti" "latest" "meta_data.json" = |
49 |
liftIO $ Logging.logInfo "ganeti metadata" |
50 |
handleMetadata GET "ganeti" "latest" "os/parameters.json" = |
51 |
liftIO $ Logging.logInfo "ganeti OS parameters" |
52 |
handleMetadata GET "ganeti" "latest" "read" = |
53 |
liftIO $ Logging.logInfo "ganeti READ" |
54 |
handleMetadata POST "ganeti" "latest" "write" = |
55 |
liftIO $ Logging.logInfo "ganeti WRITE" |
56 |
handleMetadata _ _ _ _ = error404 |
57 |
|
58 |
routeMetadata :: MetaM |
59 |
routeMetadata = |
60 |
route [ (providerRoute1, dispatchMetadata) |
61 |
, (providerRoute2, dispatchMetadata) |
62 |
] <|> dispatchMetadata |
63 |
where provider = "provider" |
64 |
version = "version" |
65 |
|
66 |
providerRoute1 = ByteString.pack $ ':':provider ++ "/" ++ ':':version |
67 |
providerRoute2 = ByteString.pack $ ':':version |
68 |
|
69 |
getParamString :: String -> Snap String |
70 |
getParamString = |
71 |
fmap (maybe "" ByteString.unpack) . getParam . ByteString.pack |
72 |
|
73 |
dispatchMetadata = |
74 |
do m <- rqMethod <$> getRequest |
75 |
p <- getParamString provider |
76 |
v <- getParamString version |
77 |
r <- ByteString.unpack . rqPathInfo <$> getRequest |
78 |
handleMetadata m p v r |
79 |
|
80 |
defaultHttpConf :: DaemonOptions -> FilePath -> FilePath -> Config Snap () |
81 |
defaultHttpConf opts accessLog errorLog = |
82 |
maybe id (setBind . ByteString.pack) (optBindAddress opts) . |
83 |
setAccessLog (ConfigFileLog accessLog) . |
84 |
setCompression False . |
85 |
setErrorLog (ConfigFileLog errorLog) . |
86 |
setPort (maybe Constants.defaultMetadPort fromIntegral (optPort opts)) . |
87 |
setVerbose False $ |
88 |
emptyConfig |
89 |
|
90 |
start :: DaemonOptions -> IO () |
91 |
start opts = do |
92 |
accessLog <- Runtime.daemonsExtraLogFile GanetiMetad AccessLog |
93 |
errorLog <- Runtime.daemonsExtraLogFile GanetiMetad ErrorLog |
94 |
httpServe (defaultHttpConf opts accessLog errorLog) routeMetadata |