, exitErr
, exitWhen
, exitUnless
+ , logWarningIfBad
, rStripSpace
, newUUID
, getCurrentTime
, getCurrentTimeUSec
, clockTimeToString
, chompPrefix
+ , warn
, wrap
, trim
+ , defaultHead
+ , exitIfEmpty
+ , splitEithers
+ , recombineEithers
+ , setOwnerAndGroupFromNames
+ , b64StringToBitString
+ , bitStringToB64String
) where
import Data.Char (toUpper, isAlphaNum, isDigit, isSpace)
import Data.Function (on)
import Data.List
+import qualified Data.Map as M
+import Control.Monad (foldM)
import Debug.Trace
import Ganeti.BasicTypes
import qualified Ganeti.Constants as C
+import Ganeti.Logging
+import Ganeti.Runtime
import System.IO
import System.Exit
+import System.Posix.Files
import System.Time
+import qualified Data.ByteString as BS
+import Data.ByteString.Base64 (decodeLenient, encode)
+import qualified Data.ByteString.Char8 as BSC
+import Data.Word (Word8)
+import Data.Char (intToDigit, digitToInt)
+import Numeric (showIntAtBase, readInt)
+
-- * Debug functions
-- | To be used only for debugging, breaks referential integrity.
exitUnless :: Bool -> String -> IO ()
exitUnless cond = exitWhen (not cond)
+-- | Unwraps a 'Result', logging a warning message and then returning a default
+-- value if it is a 'Bad' value, otherwise returning the actual contained value.
+logWarningIfBad :: String -> a -> Result a -> IO a
+logWarningIfBad msg defVal (Bad s) = do
+ logWarning $ msg ++ ": " ++ s
+ return defVal
+logWarningIfBad _ _ (Ok v) = return v
+
+-- | Print a warning, but do not exit.
+warn :: String -> IO ()
+warn = hPutStrLn stderr . (++) "Warning: "
+
-- | Helper for 'niceSort'. Computes the key element for a given string.
extractKey :: [Either Integer String] -- ^ Current (partial) key, reversed
-> String -- ^ Remaining string
(which is assumed to be a separator) to be absent from the string if the string
terminates there.
->>> chompPrefix "foo:bar:" "a:b:c"
+\>>> chompPrefix \"foo:bar:\" \"a:b:c\"
Nothing
->>> chompPrefix "foo:bar:" "foo:bar:baz"
-Just "baz"
+\>>> chompPrefix \"foo:bar:\" \"foo:bar:baz\"
+Just \"baz\"
->>> chompPrefix "foo:bar:" "foo:bar:"
-Just ""
+\>>> chompPrefix \"foo:bar:\" \"foo:bar:\"
+Just \"\"
->>> chompPrefix "foo:bar:" "foo:bar"
-Just ""
+\>>> chompPrefix \"foo:bar:\" \"foo:bar\"
+Just \"\"
->>> chompPrefix "foo:bar:" "foo:barbaz"
+\>>> chompPrefix \"foo:bar:\" \"foo:barbaz\"
Nothing
-}
chompPrefix :: String -> String -> Maybe String
-- strings.
trim :: String -> String
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+
+-- | A safer head version, with a default value.
+defaultHead :: a -> [a] -> a
+defaultHead def [] = def
+defaultHead _ (x:_) = x
+
+-- | A 'head' version in the I/O monad, for validating parameters
+-- without which we cannot continue.
+exitIfEmpty :: String -> [a] -> IO a
+exitIfEmpty _ (x:_) = return x
+exitIfEmpty s [] = exitErr s
+
+-- | Split an 'Either' list into two separate lists (containing the
+-- 'Left' and 'Right' elements, plus a \"trail\" list that allows
+-- recombination later.
+--
+-- This is splitter; for recombination, look at 'recombineEithers'.
+-- The sum of \"left\" and \"right\" lists should be equal to the
+-- original list length, and the trail list should be the same length
+-- as well. The entries in the resulting lists are reversed in
+-- comparison with the original list.
+splitEithers :: [Either a b] -> ([a], [b], [Bool])
+splitEithers = foldl' splitter ([], [], [])
+ where splitter (l, r, t) e =
+ case e of
+ Left v -> (v:l, r, False:t)
+ Right v -> (l, v:r, True:t)
+
+-- | Recombines two \"left\" and \"right\" lists using a \"trail\"
+-- list into a single 'Either' list.
+--
+-- This is the counterpart to 'splitEithers'. It does the opposite
+-- transformation, and the output list will be the reverse of the
+-- input lists. Since 'splitEithers' also reverses the lists, calling
+-- these together will result in the original list.
+--
+-- Mismatches in the structure of the lists (e.g. inconsistent
+-- lengths) are represented via 'Bad'; normally this function should
+-- not fail, if lists are passed as generated by 'splitEithers'.
+recombineEithers :: (Show a, Show b) =>
+ [a] -> [b] -> [Bool] -> Result [Either a b]
+recombineEithers lefts rights trail =
+ foldM recombiner ([], lefts, rights) trail >>= checker
+ where checker (eithers, [], []) = Ok eithers
+ checker (_, lefts', rights') =
+ Bad $ "Inconsistent results after recombination, l'=" ++
+ show lefts' ++ ", r'=" ++ show rights'
+ recombiner (es, l:ls, rs) False = Ok (Left l:es, ls, rs)
+ recombiner (es, ls, r:rs) True = Ok (Right r:es, ls, rs)
+ recombiner (_, ls, rs) t = Bad $ "Inconsistent trail log: l=" ++
+ show ls ++ ", r=" ++ show rs ++ ",t=" ++
+ show t
+
+-- | Set the owner and the group of a file (given as names, not numeric id).
+setOwnerAndGroupFromNames :: FilePath -> GanetiDaemon -> GanetiGroup -> IO ()
+setOwnerAndGroupFromNames filename daemon dGroup = do
+ -- TODO: it would be nice to rework this (or getEnts) so that runtimeEnts
+ -- is read only once per daemon startup, and then cached for further usage.
+ runtimeEnts <- getEnts
+ ents <- exitIfBad "Can't find required user/groups" runtimeEnts
+ -- note: we use directly ! as lookup failures shouldn't happen, due
+ -- to the map construction
+ let uid = fst ents M.! daemon
+ let gid = snd ents M.! dGroup
+ setOwnerAndGroup filename uid gid
+
+type BitString = String
+
+-- | Base 64 encoded String to BitString
+wordsToBitString :: [Word8] -> BitString
+wordsToBitString =
+ concatMap (padBits . wordToBits)
+ where
+ wordToBits = flip (showIntAtBase 2 intToDigit) ""
+ padBits bs = replicate (8 - length bs) '0' ++ bs
+
+decodeB64String :: String -> [Word8]
+decodeB64String = BS.unpack . decodeLenient . BSC.pack
+
+b64StringToBitString :: String -> BitString
+b64StringToBitString = wordsToBitString . decodeB64String
+
+-- | A BitString to Base 64 encoded String
+bitStringToWords :: BitString -> [Word8]
+bitStringToWords [] = []
+bitStringToWords bs =
+ bitStringToWord c : bitStringToWords rest
+ where
+ bitStringToWord = fst . head . readInt 2 (const True) digitToInt
+ (c, rest) = splitAt 8 bs
+
+encodeB64String :: [Word8] -> String
+encodeB64String = BSC.unpack . encode . BS.pack
+
+bitStringToB64String :: BitString -> String
+bitStringToB64String = encodeB64String . bitStringToWords
projects / ganeti-local / blobdiff