1 {-# LANGUAGE TemplateHaskell #-}
3 {-| Implementation of the Ganeti Ssconf interface.
9 Copyright (C) 2012 Google Inc.
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.
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.
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
39 import Control.Exception
40 import Control.Monad (liftM)
41 import Data.Char (isSpace)
42 import Data.Maybe (fromMaybe)
43 import Prelude hiding (catch)
44 import qualified Network.Socket as Socket
45 import System.FilePath ((</>))
46 import System.IO.Error (isDoesNotExistError)
48 import qualified Ganeti.Constants as C
49 import Ganeti.BasicTypes
50 import Ganeti.HTools.Utils
52 -- | Maximum ssconf file size we support.
56 -- | ssconf file prefix, re-exported from Constants.
57 sSFilePrefix :: FilePath
58 sSFilePrefix = C.ssconfFileprefix
61 [ ("SSClusterName", 'C.ssClusterName)
62 , ("SSClusterTags", 'C.ssClusterTags)
63 , ("SSFileStorageDir", 'C.ssFileStorageDir)
64 , ("SSSharedFileStorageDir", 'C.ssSharedFileStorageDir)
65 , ("SSMasterCandidates", 'C.ssMasterCandidates)
66 , ("SSMasterCandidatesIps", 'C.ssMasterCandidatesIps)
67 , ("SSMasterIp", 'C.ssMasterIp)
68 , ("SSMasterNetdev", 'C.ssMasterNetdev)
69 , ("SSMasterNetmask", 'C.ssMasterNetmask)
70 , ("SSMasterNode", 'C.ssMasterNode)
71 , ("SSNodeList", 'C.ssNodeList)
72 , ("SSNodePrimaryIps", 'C.ssNodePrimaryIps)
73 , ("SSNodeSecondaryIps", 'C.ssNodeSecondaryIps)
74 , ("SSOfflineNodes", 'C.ssOfflineNodes)
75 , ("SSOnlineNodes", 'C.ssOnlineNodes)
76 , ("SSPrimaryIpFamily", 'C.ssPrimaryIpFamily)
77 , ("SSInstanceList", 'C.ssInstanceList)
78 , ("SSReleaseVersion", 'C.ssReleaseVersion)
79 , ("SSHypervisorList", 'C.ssHypervisorList)
80 , ("SSMaintainNodeHealth", 'C.ssMaintainNodeHealth)
81 , ("SSUidPool", 'C.ssUidPool)
82 , ("SSNodegroups", 'C.ssNodegroups)
85 -- | Convert a ssconf key into a (full) file path.
86 keyToFilename :: Maybe FilePath -- ^ Optional config path override
87 -> SSKey -- ^ ssconf key
89 keyToFilename optpath key = fromMaybe C.dataDir optpath </>
90 sSFilePrefix ++ sSKeyToRaw key
92 -- | Runs an IO action while transforming any error into 'Bad'
93 -- values. It also accepts an optional value to use in case the error
94 -- is just does not exist.
95 catchIOErrors :: Maybe a -- ^ Optional default
96 -> IO a -- ^ Action to run
98 catchIOErrors def action =
102 ) (\err -> let bad_result = Bad (show err)
103 in return $ if isDoesNotExistError err
104 then maybe bad_result Ok def
107 -- | Read an ssconf file.
108 readSSConfFile :: Maybe FilePath -- ^ Optional config path override
109 -> Maybe String -- ^ Optional default value
110 -> SSKey -- ^ Desired ssconf key
111 -> IO (Result String)
112 readSSConfFile optpath def key = do
113 result <- catchIOErrors def . readFile . keyToFilename optpath $ key
114 return (liftM (take maxFileSize) result)
116 -- | Strip space characthers (including newline). As this is
117 -- expensive, should only be run on small strings.
118 rstripSpace :: String -> String
119 rstripSpace = reverse . dropWhile isSpace . reverse
121 -- | Parses a string containing an IP family
122 parseIPFamily :: Int -> Result Socket.Family
123 parseIPFamily fam | fam == C.ip4Family = Ok Socket.AF_INET
124 | fam == C.ip6Family = Ok Socket.AF_INET6
125 | otherwise = Bad $ "Unknown af_family value: " ++ show fam
127 -- | Read the primary IP family.
128 getPrimaryIPFamily :: Maybe FilePath -> IO (Result Socket.Family)
129 getPrimaryIPFamily optpath = do
130 result <- readSSConfFile optpath (Just (show C.ip4Family)) SSPrimaryIpFamily
131 return (result >>= return . rstripSpace >>=
132 tryRead "Parsing af_family" >>= parseIPFamily)