Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Ssconf.hs @ 37904802

History | View | Annotate | Download (4.7 kB)

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
  , keyToFilename
34
  , sSFilePrefix
35
  ) where
36

    
37
import Ganeti.THH
38

    
39
import Control.Exception
40
import Control.Monad (liftM)
41
import Data.Char (isSpace)
42
import Data.Maybe (fromMaybe)
43
import qualified Network.Socket as Socket
44
import System.FilePath ((</>))
45
import System.IO.Error (isDoesNotExistError)
46

    
47
import qualified Ganeti.Constants as C
48
import qualified Ganeti.Path as Path
49
import Ganeti.BasicTypes
50
import Ganeti.Utils
51

    
52
-- | Maximum ssconf file size we support.
53
maxFileSize :: Int
54
maxFileSize = 131072
55

    
56
-- | ssconf file prefix, re-exported from Constants.
57
sSFilePrefix :: FilePath
58
sSFilePrefix = C.ssconfFileprefix
59

    
60
$(declareSADT "SSKey"
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)
83
  ])
84

    
85
-- | Convert a ssconf key into a (full) file path.
86
keyToFilename :: FilePath     -- ^ Config path root
87
              -> SSKey        -- ^ Ssconf key
88
              -> FilePath     -- ^ Full file name
89
keyToFilename cfgpath key = do
90
  cfgpath </> sSFilePrefix ++ sSKeyToRaw key
91

    
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
97
              -> IO (Result a)
98
catchIOErrors def action =
99
  Control.Exception.catch
100
        (do
101
          result <- action
102
          return (Ok result)
103
        ) (\err -> let bad_result = Bad (show err)
104
                   in return $ if isDoesNotExistError err
105
                                 then maybe bad_result Ok def
106
                                 else bad_result)
107

    
108
-- | Read an ssconf file.
109
readSSConfFile :: Maybe FilePath            -- ^ Optional config path override
110
               -> Maybe String              -- ^ Optional default value
111
               -> SSKey                     -- ^ Desired ssconf key
112
               -> IO (Result String)
113
readSSConfFile optpath def key = do
114
  result <- catchIOErrors def . readFile .
115
            keyToFilename (fromMaybe Path.dataDir optpath) $ key
116
  return (liftM (take maxFileSize) result)
117

    
118
-- | Strip space characthers (including newline). As this is
119
-- expensive, should only be run on small strings.
120
rstripSpace :: String -> String
121
rstripSpace = reverse . dropWhile isSpace . reverse
122

    
123
-- | Parses a string containing an IP family
124
parseIPFamily :: Int -> Result Socket.Family
125
parseIPFamily fam | fam == C.ip4Family = Ok Socket.AF_INET
126
                  | fam == C.ip6Family = Ok Socket.AF_INET6
127
                  | otherwise = Bad $ "Unknown af_family value: " ++ show fam
128

    
129
-- | Read the primary IP family.
130
getPrimaryIPFamily :: Maybe FilePath -> IO (Result Socket.Family)
131
getPrimaryIPFamily optpath = do
132
  result <- readSSConfFile optpath (Just (show C.ip4Family)) SSPrimaryIpFamily
133
  return (liftM rstripSpace result >>=
134
          tryRead "Parsing af_family" >>= parseIPFamily)