|
1 |
{-# LANGUAGE TemplateHaskell #-}
|
|
2 |
|
|
3 |
{-| Implementation of the Ganeti Ssconf interface.
|
|
4 |
|
|
5 |
-}
|
|
6 |
|
|
7 |
{-
|
|
8 |
|
|
9 |
Copyright (C) 2012 Google Inc.
|
|
10 |
|
|
11 |
This program is free software; you can redistribute it and/or modify
|
|
12 |
it under the terms of the GNU General Public License as published by
|
|
13 |
the Free Software Foundation; either version 2 of the License, or
|
|
14 |
(at your option) any later version.
|
|
15 |
|
|
16 |
This program is distributed in the hope that it will be useful, but
|
|
17 |
WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
18 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
19 |
General Public License for more details.
|
|
20 |
|
|
21 |
You should have received a copy of the GNU General Public License
|
|
22 |
along with this program; if not, write to the Free Software
|
|
23 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
|
24 |
02110-1301, USA.
|
|
25 |
|
|
26 |
-}
|
|
27 |
|
|
28 |
module Ganeti.Ssconf
|
|
29 |
( SSKey(..)
|
|
30 |
, sSKeyToRaw
|
|
31 |
, sSKeyFromRaw
|
|
32 |
, getPrimaryIPFamily
|
|
33 |
) where
|
|
34 |
|
|
35 |
import Ganeti.THH
|
|
36 |
|
|
37 |
import Control.Monad (liftM)
|
|
38 |
import Data.Char (isSpace)
|
|
39 |
import Data.Maybe (fromMaybe)
|
|
40 |
import qualified Network.Socket as Socket
|
|
41 |
import System.FilePath ((</>))
|
|
42 |
import System.IO.Error
|
|
43 |
|
|
44 |
import qualified Ganeti.Constants as C
|
|
45 |
import Ganeti.BasicTypes
|
|
46 |
import Ganeti.HTools.Utils
|
|
47 |
|
|
48 |
-- | Maximum ssconf file size we support.
|
|
49 |
maxFileSize :: Int
|
|
50 |
maxFileSize = 131072
|
|
51 |
|
|
52 |
$(declareSADT "SSKey"
|
|
53 |
[ ("SSClusterName", 'C.ssClusterName)
|
|
54 |
, ("SSClusterTags", 'C.ssClusterTags)
|
|
55 |
, ("SSFileStorageDir", 'C.ssFileStorageDir)
|
|
56 |
, ("SSSharedFileStorageDir", 'C.ssSharedFileStorageDir)
|
|
57 |
, ("SSMasterCandidates", 'C.ssMasterCandidates)
|
|
58 |
, ("SSMasterCandidatesIps", 'C.ssMasterCandidatesIps)
|
|
59 |
, ("SSMasterIp", 'C.ssMasterIp)
|
|
60 |
, ("SSMasterNetdev", 'C.ssMasterNetdev)
|
|
61 |
, ("SSMasterNetmask", 'C.ssMasterNetmask)
|
|
62 |
, ("SSMasterNode", 'C.ssMasterNode)
|
|
63 |
, ("SSNodeList", 'C.ssNodeList)
|
|
64 |
, ("SSNodePrimaryIps", 'C.ssNodePrimaryIps)
|
|
65 |
, ("SSNodeSecondaryIps", 'C.ssNodeSecondaryIps)
|
|
66 |
, ("SSOfflineNodes", 'C.ssOfflineNodes)
|
|
67 |
, ("SSOnlineNodes", 'C.ssOnlineNodes)
|
|
68 |
, ("SSPrimaryIpFamily", 'C.ssPrimaryIpFamily)
|
|
69 |
, ("SSInstanceList", 'C.ssInstanceList)
|
|
70 |
, ("SSReleaseVersion", 'C.ssReleaseVersion)
|
|
71 |
, ("SSHypervisorList", 'C.ssHypervisorList)
|
|
72 |
, ("SSMaintainNodeHealth", 'C.ssMaintainNodeHealth)
|
|
73 |
, ("SSUidPool", 'C.ssUidPool)
|
|
74 |
, ("SSNodegroups", 'C.ssNodegroups)
|
|
75 |
])
|
|
76 |
|
|
77 |
-- | Convert a ssconf key into a (full) file path.
|
|
78 |
keyToFilename :: Maybe FilePath -- ^ Optional config path override
|
|
79 |
-> SSKey -- ^ ssconf key
|
|
80 |
-> FilePath
|
|
81 |
keyToFilename optpath key = fromMaybe C.dataDir optpath </> sSKeyToRaw key
|
|
82 |
|
|
83 |
-- | Runs an IO action while transforming any error into 'Bad'
|
|
84 |
-- values. It also accepts an optional value to use in case the error
|
|
85 |
-- is just does not exist.
|
|
86 |
catchIOErrors :: Maybe a -- ^ Optional default
|
|
87 |
-> IO a -- ^ Action to run
|
|
88 |
-> IO (Result a)
|
|
89 |
catchIOErrors def action =
|
|
90 |
catch (do
|
|
91 |
result <- action
|
|
92 |
return (Ok result)
|
|
93 |
) (\err -> let bad_result = Bad (show err)
|
|
94 |
in return $ if isDoesNotExistError err
|
|
95 |
then maybe bad_result Ok def
|
|
96 |
else bad_result)
|
|
97 |
|
|
98 |
-- | Read an ssconf file.
|
|
99 |
readSSConfFile :: Maybe FilePath -- ^ Optional config path override
|
|
100 |
-> Maybe String -- ^ Optional default value
|
|
101 |
-> SSKey -- ^ Desired ssconf key
|
|
102 |
-> IO (Result String)
|
|
103 |
readSSConfFile optpath def key = do
|
|
104 |
result <- catchIOErrors def . readFile . keyToFilename optpath $ key
|
|
105 |
return (liftM (take maxFileSize) result)
|
|
106 |
|
|
107 |
-- | Strip space characthers (including newline). As this is
|
|
108 |
-- expensive, should only be run on small strings.
|
|
109 |
rstripSpace :: String -> String
|
|
110 |
rstripSpace = reverse . dropWhile isSpace . reverse
|
|
111 |
|
|
112 |
-- | Parses a string containing an IP family
|
|
113 |
parseIPFamily :: Int -> Result Socket.Family
|
|
114 |
parseIPFamily fam | fam == C.ip4Family = Ok Socket.AF_INET
|
|
115 |
| fam == C.ip6Family = Ok Socket.AF_INET6
|
|
116 |
| otherwise = Bad $ "Unknown af_family value: " ++ show fam
|
|
117 |
|
|
118 |
-- | Read the primary IP family.
|
|
119 |
getPrimaryIPFamily :: Maybe FilePath -> IO (Result Socket.Family)
|
|
120 |
getPrimaryIPFamily optpath = do
|
|
121 |
result <- readSSConfFile optpath (Just (show C.ip4Family)) SSPrimaryIpFamily
|
|
122 |
return (result >>= return . rstripSpace >>=
|
|
123 |
tryRead "Parsing af_family" >>= parseIPFamily)
|