Synnefo » snf-ganeti

{-# LANGUAGE TemplateHaskell #-}

{-| Implementation of the Ganeti Ssconf interface.

-}

{-

Copyright (C) 2012 Google Inc.

This program is free software; you can redistribute it and/or modify

it under the terms of the GNU General Public License as published by

the Free Software Foundation; either version 2 of the License, or

(at your option) any later version.

This program is distributed in the hope that it will be useful, but

WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

General Public License for more details.

You should have received a copy of the GNU General Public License

along with this program; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA

02110-1301, USA.

-}

module Ganeti.Ssconf

  ( SSKey(..)

  , sSKeyToRaw

  , sSKeyFromRaw

  , getPrimaryIPFamily

  , keyToFilename

  , sSFilePrefix

  ) where

import Ganeti.THH

import Control.Exception

import Control.Monad (liftM)

import Data.Char (isSpace)

import Data.Maybe (fromMaybe)

import Prelude hiding (catch)

import qualified Network.Socket as Socket

import System.FilePath ((</>))

import System.IO.Error (isDoesNotExistError)

import qualified Ganeti.Constants as C

import Ganeti.BasicTypes

import Ganeti.HTools.Utils

-- | Maximum ssconf file size we support.

maxFileSize :: Int

maxFileSize = 131072

-- | ssconf file prefix, re-exported from Constants.

sSFilePrefix :: FilePath

sSFilePrefix = C.ssconfFileprefix

$(declareSADT "SSKey"

  [ ("SSClusterName",          'C.ssClusterName)

  , ("SSClusterTags",          'C.ssClusterTags)

  , ("SSFileStorageDir",       'C.ssFileStorageDir)

  , ("SSSharedFileStorageDir", 'C.ssSharedFileStorageDir)

  , ("SSMasterCandidates",     'C.ssMasterCandidates)

  , ("SSMasterCandidatesIps",  'C.ssMasterCandidatesIps)

  , ("SSMasterIp",             'C.ssMasterIp)

  , ("SSMasterNetdev",         'C.ssMasterNetdev)

  , ("SSMasterNetmask",        'C.ssMasterNetmask)

  , ("SSMasterNode",           'C.ssMasterNode)

  , ("SSNodeList",             'C.ssNodeList)

  , ("SSNodePrimaryIps",       'C.ssNodePrimaryIps)

  , ("SSNodeSecondaryIps",     'C.ssNodeSecondaryIps)

  , ("SSOfflineNodes",         'C.ssOfflineNodes)

  , ("SSOnlineNodes",          'C.ssOnlineNodes)

  , ("SSPrimaryIpFamily",      'C.ssPrimaryIpFamily)

  , ("SSInstanceList",         'C.ssInstanceList)

  , ("SSReleaseVersion",       'C.ssReleaseVersion)

  , ("SSHypervisorList",       'C.ssHypervisorList)

  , ("SSMaintainNodeHealth",   'C.ssMaintainNodeHealth)

  , ("SSUidPool",              'C.ssUidPool)

  , ("SSNodegroups",           'C.ssNodegroups)

  ])

-- | Convert a ssconf key into a (full) file path.

keyToFilename :: Maybe FilePath     -- ^ Optional config path override

              -> SSKey              -- ^ ssconf key

              -> FilePath

keyToFilename optpath key = fromMaybe C.dataDir optpath </>

                            sSFilePrefix ++ sSKeyToRaw key

-- | Runs an IO action while transforming any error into 'Bad'

-- values. It also accepts an optional value to use in case the error

-- is just does not exist.

catchIOErrors :: Maybe a         -- ^ Optional default

              -> IO a            -- ^ Action to run

              -> IO (Result a)

catchIOErrors def action =

  catch (do

          result <- action

          return (Ok result)

        ) (\err -> let bad_result = Bad (show err)

                   in return $ if isDoesNotExistError err

                                 then maybe bad_result Ok def

                                 else bad_result)

-- | Read an ssconf file.

readSSConfFile :: Maybe FilePath            -- ^ Optional config path override

               -> Maybe String              -- ^ Optional default value

               -> SSKey                     -- ^ Desired ssconf key

               -> IO (Result String)

readSSConfFile optpath def key = do

  result <- catchIOErrors def . readFile . keyToFilename optpath $ key

  return (liftM (take maxFileSize) result)

-- | Strip space characthers (including newline). As this is

-- expensive, should only be run on small strings.

rstripSpace :: String -> String

rstripSpace = reverse . dropWhile isSpace . reverse

-- | Parses a string containing an IP family

parseIPFamily :: Int -> Result Socket.Family

parseIPFamily fam | fam == C.ip4Family = Ok Socket.AF_INET

                  | fam == C.ip6Family = Ok Socket.AF_INET6

                  | otherwise = Bad $ "Unknown af_family value: " ++ show fam

-- | Read the primary IP family.

getPrimaryIPFamily :: Maybe FilePath -> IO (Result Socket.Family)

getPrimaryIPFamily optpath = do

  result <- readSSConfFile optpath (Just (show C.ip4Family)) SSPrimaryIpFamily

  return (liftM rstripSpace result >>=

          tryRead "Parsing af_family" >>= parseIPFamily)