Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Utils.hs @ e817723c

History | View | Annotate | Download (18.4 kB)

1 525bfb36 Iustin Pop
{-| Utility functions. -}
2 e4f08c46 Iustin Pop
3 e2fa2baf Iustin Pop
{-
4 e2fa2baf Iustin Pop
5 a7f0953a Iustin Pop
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
6 e2fa2baf Iustin Pop
7 e2fa2baf Iustin Pop
This program is free software; you can redistribute it and/or modify
8 e2fa2baf Iustin Pop
it under the terms of the GNU General Public License as published by
9 e2fa2baf Iustin Pop
the Free Software Foundation; either version 2 of the License, or
10 e2fa2baf Iustin Pop
(at your option) any later version.
11 e2fa2baf Iustin Pop
12 e2fa2baf Iustin Pop
This program is distributed in the hope that it will be useful, but
13 e2fa2baf Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
14 e2fa2baf Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15 e2fa2baf Iustin Pop
General Public License for more details.
16 e2fa2baf Iustin Pop
17 e2fa2baf Iustin Pop
You should have received a copy of the GNU General Public License
18 e2fa2baf Iustin Pop
along with this program; if not, write to the Free Software
19 e2fa2baf Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
20 e2fa2baf Iustin Pop
02110-1301, USA.
21 e2fa2baf Iustin Pop
22 e2fa2baf Iustin Pop
-}
23 e2fa2baf Iustin Pop
24 26d62e4c Iustin Pop
module Ganeti.Utils
25 ebf38064 Iustin Pop
  ( debug
26 ebf38064 Iustin Pop
  , debugFn
27 ebf38064 Iustin Pop
  , debugXy
28 ebf38064 Iustin Pop
  , sepSplit
29 ebf38064 Iustin Pop
  , stdDev
30 ebf38064 Iustin Pop
  , if'
31 ebf38064 Iustin Pop
  , select
32 ebf38064 Iustin Pop
  , applyIf
33 ebf38064 Iustin Pop
  , commaJoin
34 79eef90b Agata Murawska
  , ensureQuoted
35 ebf38064 Iustin Pop
  , tryRead
36 ebf38064 Iustin Pop
  , formatTable
37 c3024b7e René Nussbaumer
  , printTable
38 ebf38064 Iustin Pop
  , parseUnit
39 19e310cc René Nussbaumer
  , plural
40 04edfc99 Iustin Pop
  , niceSort
41 04edfc99 Iustin Pop
  , niceSortKey
42 88a10df5 Iustin Pop
  , exitIfBad
43 88a10df5 Iustin Pop
  , exitErr
44 88a10df5 Iustin Pop
  , exitWhen
45 88a10df5 Iustin Pop
  , exitUnless
46 838393d1 Michele Tartara
  , logWarningIfBad
47 256e28c4 Iustin Pop
  , rStripSpace
48 80a0546b Michele Tartara
  , newUUID
49 ace37e24 Michele Tartara
  , getCurrentTime
50 a6e054a8 Iustin Pop
  , getCurrentTimeUSec
51 b6aeda4a Dato Simó
  , clockTimeToString
52 b009f682 Dato Simó
  , chompPrefix
53 7dbe4c72 Klaus Aehlig
  , warn
54 9fb621af Yiannis Tsiouris
  , wrap
55 9fb621af Yiannis Tsiouris
  , trim
56 72747d91 Iustin Pop
  , defaultHead
57 72747d91 Iustin Pop
  , exitIfEmpty
58 da9e2aff Iustin Pop
  , splitEithers
59 da9e2aff Iustin Pop
  , recombineEithers
60 986a8671 Michele Tartara
  , resolveAddr
61 bf7ee7ad Klaus Aehlig
  , monadicThe
62 a39cd547 Michele Tartara
  , setOwnerAndGroupFromNames
63 88b58ed6 Hrvoje Ribicic
  , formatOrdinal
64 710f5ae2 Klaus Aehlig
  , atomicWriteFile
65 5badb3e7 Klaus Aehlig
  , tryAndLogIOError
66 32b07c5f Klaus Aehlig
  , lockFile
67 ebf38064 Iustin Pop
  ) where
68 e4f08c46 Iustin Pop
69 5badb3e7 Klaus Aehlig
import Control.Exception (try)
70 256e28c4 Iustin Pop
import Data.Char (toUpper, isAlphaNum, isDigit, isSpace)
71 04edfc99 Iustin Pop
import Data.Function (on)
72 29ac5975 Iustin Pop
import Data.List
73 a39cd547 Michele Tartara
import qualified Data.Map as M
74 32b07c5f Klaus Aehlig
import Control.Monad (foldM, liftM)
75 710f5ae2 Klaus Aehlig
import System.Directory (renameFile)
76 710f5ae2 Klaus Aehlig
import System.FilePath.Posix (takeDirectory, takeBaseName)
77 e4f08c46 Iustin Pop
78 e4f08c46 Iustin Pop
import Debug.Trace
79 986a8671 Michele Tartara
import Network.Socket
80 e4f08c46 Iustin Pop
81 88a10df5 Iustin Pop
import Ganeti.BasicTypes
82 06fd57e5 Jose A. Lopes
import qualified Ganeti.ConstantUtils as ConstantUtils
83 838393d1 Michele Tartara
import Ganeti.Logging
84 a39cd547 Michele Tartara
import Ganeti.Runtime
85 88a10df5 Iustin Pop
import System.IO
86 88a10df5 Iustin Pop
import System.Exit
87 a39cd547 Michele Tartara
import System.Posix.Files
88 32b07c5f Klaus Aehlig
import System.Posix.IO
89 b6aeda4a Dato Simó
import System.Time
90 88a10df5 Iustin Pop
91 9188aeef Iustin Pop
-- * Debug functions
92 9188aeef Iustin Pop
93 e4f08c46 Iustin Pop
-- | To be used only for debugging, breaks referential integrity.
94 e4f08c46 Iustin Pop
debug :: Show a => a -> a
95 e4f08c46 Iustin Pop
debug x = trace (show x) x
96 e4f08c46 Iustin Pop
97 525bfb36 Iustin Pop
-- | Displays a modified form of the second parameter before returning
98 525bfb36 Iustin Pop
-- it.
99 adc5c176 Iustin Pop
debugFn :: Show b => (a -> b) -> a -> a
100 adc5c176 Iustin Pop
debugFn fn x = debug (fn x) `seq` x
101 adc5c176 Iustin Pop
102 525bfb36 Iustin Pop
-- | Show the first parameter before returning the second one.
103 adc5c176 Iustin Pop
debugXy :: Show a => a -> b -> b
104 05ff7a00 Agata Murawska
debugXy = seq . debug
105 adc5c176 Iustin Pop
106 525bfb36 Iustin Pop
-- * Miscellaneous
107 1b7cf8ca Iustin Pop
108 61bbbed7 Agata Murawska
-- | Apply the function if condition holds, otherwise use default value.
109 61bbbed7 Agata Murawska
applyIf :: Bool -> (a -> a) -> a -> a
110 61bbbed7 Agata Murawska
applyIf b f x = if b then f x else x
111 61bbbed7 Agata Murawska
112 e4f08c46 Iustin Pop
-- | Comma-join a string list.
113 e4f08c46 Iustin Pop
commaJoin :: [String] -> String
114 e4f08c46 Iustin Pop
commaJoin = intercalate ","
115 e4f08c46 Iustin Pop
116 748d5d50 Iustin Pop
-- | Split a list on a separator and return an array.
117 748d5d50 Iustin Pop
sepSplit :: Eq a => a -> [a] -> [[a]]
118 e4f08c46 Iustin Pop
sepSplit sep s
119 ebf38064 Iustin Pop
  | null s    = []
120 ebf38064 Iustin Pop
  | null xs   = [x]
121 ebf38064 Iustin Pop
  | null ys   = [x,[]]
122 ebf38064 Iustin Pop
  | otherwise = x:sepSplit sep ys
123 ebf38064 Iustin Pop
  where (x, xs) = break (== sep) s
124 ebf38064 Iustin Pop
        ys = drop 1 xs
125 e4f08c46 Iustin Pop
126 19e310cc René Nussbaumer
-- | Simple pluralize helper
127 19e310cc René Nussbaumer
plural :: Int -> String -> String -> String
128 19e310cc René Nussbaumer
plural 1 s _ = s
129 19e310cc René Nussbaumer
plural _ _ p = p
130 19e310cc René Nussbaumer
131 79eef90b Agata Murawska
-- | Ensure a value is quoted if needed.
132 79eef90b Agata Murawska
ensureQuoted :: String -> String
133 79eef90b Agata Murawska
ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v)
134 79eef90b Agata Murawska
                 then '\'':v ++ "'"
135 79eef90b Agata Murawska
                 else v
136 79eef90b Agata Murawska
137 9188aeef Iustin Pop
-- * Mathematical functions
138 9188aeef Iustin Pop
139 185297fa Iustin Pop
-- Simple and slow statistical functions, please replace with better
140 185297fa Iustin Pop
-- versions
141 e4f08c46 Iustin Pop
142 525bfb36 Iustin Pop
-- | Standard deviation function.
143 4715711d Iustin Pop
stdDev :: [Double] -> Double
144 4715711d Iustin Pop
stdDev lst =
145 7570569e Iustin Pop
  -- first, calculate the list length and sum lst in a single step,
146 7570569e Iustin Pop
  -- for performance reasons
147 7570569e Iustin Pop
  let (ll', sx) = foldl' (\(rl, rs) e ->
148 7570569e Iustin Pop
                           let rl' = rl + 1
149 7570569e Iustin Pop
                               rs' = rs + e
150 7570569e Iustin Pop
                           in rl' `seq` rs' `seq` (rl', rs')) (0::Int, 0) lst
151 7570569e Iustin Pop
      ll = fromIntegral ll'::Double
152 7570569e Iustin Pop
      mv = sx / ll
153 7570569e Iustin Pop
      av = foldl' (\accu em -> let d = em - mv in accu + d * d) 0.0 lst
154 4715711d Iustin Pop
  in sqrt (av / ll) -- stddev
155 dd4c56ed Iustin Pop
156 bfe6c954 Guido Trotter
-- *  Logical functions
157 bfe6c954 Guido Trotter
158 bfe6c954 Guido Trotter
-- Avoid syntactic sugar and enhance readability. These functions are proposed
159 bfe6c954 Guido Trotter
-- by some for inclusion in the Prelude, and at the moment they are present
160 bfe6c954 Guido Trotter
-- (with various definitions) in the utility-ht package. Some rationale and
161 bfe6c954 Guido Trotter
-- discussion is available at <http://www.haskell.org/haskellwiki/If-then-else>
162 bfe6c954 Guido Trotter
163 bfe6c954 Guido Trotter
-- | \"if\" as a function, rather than as syntactic sugar.
164 bfe6c954 Guido Trotter
if' :: Bool -- ^ condition
165 bfe6c954 Guido Trotter
    -> a    -- ^ \"then\" result
166 bfe6c954 Guido Trotter
    -> a    -- ^ \"else\" result
167 bfe6c954 Guido Trotter
    -> a    -- ^ \"then\" or "else" result depending on the condition
168 bfe6c954 Guido Trotter
if' True x _ = x
169 bfe6c954 Guido Trotter
if' _    _ y = y
170 bfe6c954 Guido Trotter
171 5b763470 Iustin Pop
-- * Parsing utility functions
172 5b763470 Iustin Pop
173 525bfb36 Iustin Pop
-- | Parse results from readsPrec.
174 5b763470 Iustin Pop
parseChoices :: (Monad m, Read a) => String -> String -> [(a, String)] -> m a
175 5b763470 Iustin Pop
parseChoices _ _ ((v, ""):[]) = return v
176 5b763470 Iustin Pop
parseChoices name s ((_, e):[]) =
177 5b763470 Iustin Pop
    fail $ name ++ ": leftover characters when parsing '"
178 5b763470 Iustin Pop
           ++ s ++ "': '" ++ e ++ "'"
179 5b763470 Iustin Pop
parseChoices name s _ = fail $ name ++ ": cannot parse string '" ++ s ++ "'"
180 5b763470 Iustin Pop
181 5b763470 Iustin Pop
-- | Safe 'read' function returning data encapsulated in a Result.
182 5b763470 Iustin Pop
tryRead :: (Monad m, Read a) => String -> String -> m a
183 5b763470 Iustin Pop
tryRead name s = parseChoices name s $ reads s
184 c5f7412e Iustin Pop
185 525bfb36 Iustin Pop
-- | Format a table of strings to maintain consistent length.
186 c5f7412e Iustin Pop
formatTable :: [[String]] -> [Bool] -> [[String]]
187 c5f7412e Iustin Pop
formatTable vals numpos =
188 c5f7412e Iustin Pop
    let vtrans = transpose vals  -- transpose, so that we work on rows
189 c5f7412e Iustin Pop
                                 -- rather than columns
190 c5f7412e Iustin Pop
        mlens = map (maximum . map length) vtrans
191 c5f7412e Iustin Pop
        expnd = map (\(flds, isnum, ml) ->
192 c5f7412e Iustin Pop
                         map (\val ->
193 c5f7412e Iustin Pop
                                  let delta = ml - length val
194 c5f7412e Iustin Pop
                                      filler = replicate delta ' '
195 c5f7412e Iustin Pop
                                  in if delta > 0
196 c5f7412e Iustin Pop
                                     then if isnum
197 c5f7412e Iustin Pop
                                          then filler ++ val
198 c5f7412e Iustin Pop
                                          else val ++ filler
199 c5f7412e Iustin Pop
                                     else val
200 c5f7412e Iustin Pop
                             ) flds
201 c5f7412e Iustin Pop
                    ) (zip3 vtrans numpos mlens)
202 c5f7412e Iustin Pop
   in transpose expnd
203 9b9da389 Iustin Pop
204 c3024b7e René Nussbaumer
-- | Constructs a printable table from given header and rows
205 c3024b7e René Nussbaumer
printTable :: String -> [String] -> [[String]] -> [Bool] -> String
206 c3024b7e René Nussbaumer
printTable lp header rows isnum =
207 2cdaf225 Iustin Pop
  unlines . map ((++) lp . (:) ' ' . unwords) $
208 c3024b7e René Nussbaumer
  formatTable (header:rows) isnum
209 c3024b7e René Nussbaumer
210 1cdcf8f3 Iustin Pop
-- | Converts a unit (e.g. m or GB) into a scaling factor.
211 1cdcf8f3 Iustin Pop
parseUnitValue :: (Monad m) => String -> m Rational
212 1cdcf8f3 Iustin Pop
parseUnitValue unit
213 1cdcf8f3 Iustin Pop
  -- binary conversions first
214 1cdcf8f3 Iustin Pop
  | null unit                     = return 1
215 1cdcf8f3 Iustin Pop
  | unit == "m" || upper == "MIB" = return 1
216 1cdcf8f3 Iustin Pop
  | unit == "g" || upper == "GIB" = return kbBinary
217 1cdcf8f3 Iustin Pop
  | unit == "t" || upper == "TIB" = return $ kbBinary * kbBinary
218 1cdcf8f3 Iustin Pop
  -- SI conversions
219 1cdcf8f3 Iustin Pop
  | unit == "M" || upper == "MB"  = return mbFactor
220 1cdcf8f3 Iustin Pop
  | unit == "G" || upper == "GB"  = return $ mbFactor * kbDecimal
221 1cdcf8f3 Iustin Pop
  | unit == "T" || upper == "TB"  = return $ mbFactor * kbDecimal * kbDecimal
222 1cdcf8f3 Iustin Pop
  | otherwise = fail $ "Unknown unit '" ++ unit ++ "'"
223 1cdcf8f3 Iustin Pop
  where upper = map toUpper unit
224 5850e990 Iustin Pop
        kbBinary = 1024 :: Rational
225 5850e990 Iustin Pop
        kbDecimal = 1000 :: Rational
226 1cdcf8f3 Iustin Pop
        decToBin = kbDecimal / kbBinary -- factor for 1K conversion
227 1cdcf8f3 Iustin Pop
        mbFactor = decToBin * decToBin -- twice the factor for just 1K
228 1cdcf8f3 Iustin Pop
229 1cb92fac Iustin Pop
-- | Tries to extract number and scale from the given string.
230 1cb92fac Iustin Pop
--
231 1cb92fac Iustin Pop
-- Input must be in the format NUMBER+ SPACE* [UNIT]. If no unit is
232 1cb92fac Iustin Pop
-- specified, it defaults to MiB. Return value is always an integral
233 1cb92fac Iustin Pop
-- value in MiB.
234 1cb92fac Iustin Pop
parseUnit :: (Monad m, Integral a, Read a) => String -> m a
235 1cb92fac Iustin Pop
parseUnit str =
236 ebf38064 Iustin Pop
  -- TODO: enhance this by splitting the unit parsing code out and
237 ebf38064 Iustin Pop
  -- accepting floating-point numbers
238 1cdcf8f3 Iustin Pop
  case (reads str::[(Int, String)]) of
239 ebf38064 Iustin Pop
    [(v, suffix)] ->
240 ebf38064 Iustin Pop
      let unit = dropWhile (== ' ') suffix
241 1cdcf8f3 Iustin Pop
      in do
242 1cdcf8f3 Iustin Pop
        scaling <- parseUnitValue unit
243 1cdcf8f3 Iustin Pop
        return $ truncate (fromIntegral v * scaling)
244 ebf38064 Iustin Pop
    _ -> fail $ "Can't parse string '" ++ str ++ "'"
245 88a10df5 Iustin Pop
246 88a10df5 Iustin Pop
-- | Unwraps a 'Result', exiting the program if it is a 'Bad' value,
247 88a10df5 Iustin Pop
-- otherwise returning the actual contained value.
248 88a10df5 Iustin Pop
exitIfBad :: String -> Result a -> IO a
249 707cd3d7 Helga Velroyen
exitIfBad msg (Bad s) = exitErr (msg ++ ": " ++ s)
250 88a10df5 Iustin Pop
exitIfBad _ (Ok v) = return v
251 88a10df5 Iustin Pop
252 88a10df5 Iustin Pop
-- | Exits immediately with an error message.
253 88a10df5 Iustin Pop
exitErr :: String -> IO a
254 88a10df5 Iustin Pop
exitErr errmsg = do
255 707cd3d7 Helga Velroyen
  hPutStrLn stderr $ "Error: " ++ errmsg
256 88a10df5 Iustin Pop
  exitWith (ExitFailure 1)
257 88a10df5 Iustin Pop
258 88a10df5 Iustin Pop
-- | Exits with an error message if the given boolean condition if true.
259 88a10df5 Iustin Pop
exitWhen :: Bool -> String -> IO ()
260 88a10df5 Iustin Pop
exitWhen True msg = exitErr msg
261 88a10df5 Iustin Pop
exitWhen False _  = return ()
262 88a10df5 Iustin Pop
263 88a10df5 Iustin Pop
-- | Exits with an error message /unless/ the given boolean condition
264 88a10df5 Iustin Pop
-- if true, the opposite of 'exitWhen'.
265 88a10df5 Iustin Pop
exitUnless :: Bool -> String -> IO ()
266 88a10df5 Iustin Pop
exitUnless cond = exitWhen (not cond)
267 04edfc99 Iustin Pop
268 838393d1 Michele Tartara
-- | Unwraps a 'Result', logging a warning message and then returning a default
269 838393d1 Michele Tartara
-- value if it is a 'Bad' value, otherwise returning the actual contained value.
270 838393d1 Michele Tartara
logWarningIfBad :: String -> a -> Result a -> IO a
271 838393d1 Michele Tartara
logWarningIfBad msg defVal (Bad s) = do
272 838393d1 Michele Tartara
  logWarning $ msg ++ ": " ++ s
273 838393d1 Michele Tartara
  return defVal
274 838393d1 Michele Tartara
logWarningIfBad _ _ (Ok v) = return v
275 838393d1 Michele Tartara
276 5badb3e7 Klaus Aehlig
-- | Try an IO interaction, log errors and unfold as a 'Result'.
277 5badb3e7 Klaus Aehlig
tryAndLogIOError :: IO a -> String -> (a -> Result b) -> IO (Result b)
278 5badb3e7 Klaus Aehlig
tryAndLogIOError io msg okfn =
279 5badb3e7 Klaus Aehlig
 try io >>= either
280 5badb3e7 Klaus Aehlig
   (\ e -> do
281 5badb3e7 Klaus Aehlig
       let combinedmsg = msg ++ ": " ++ show (e :: IOError)
282 5badb3e7 Klaus Aehlig
       logError combinedmsg
283 5badb3e7 Klaus Aehlig
       return . Bad $ combinedmsg)
284 5badb3e7 Klaus Aehlig
   (return . okfn)
285 5badb3e7 Klaus Aehlig
286 7dbe4c72 Klaus Aehlig
-- | Print a warning, but do not exit.
287 7dbe4c72 Klaus Aehlig
warn :: String -> IO ()
288 7dbe4c72 Klaus Aehlig
warn = hPutStrLn stderr . (++) "Warning: "
289 7dbe4c72 Klaus Aehlig
290 04edfc99 Iustin Pop
-- | Helper for 'niceSort'. Computes the key element for a given string.
291 04edfc99 Iustin Pop
extractKey :: [Either Integer String]  -- ^ Current (partial) key, reversed
292 04edfc99 Iustin Pop
           -> String                   -- ^ Remaining string
293 04edfc99 Iustin Pop
           -> ([Either Integer String], String)
294 04edfc99 Iustin Pop
extractKey ek [] = (reverse ek, [])
295 04edfc99 Iustin Pop
extractKey ek xs@(x:_) =
296 04edfc99 Iustin Pop
  let (span_fn, conv_fn) = if isDigit x
297 04edfc99 Iustin Pop
                             then (isDigit, Left . read)
298 04edfc99 Iustin Pop
                             else (not . isDigit, Right)
299 04edfc99 Iustin Pop
      (k, rest) = span span_fn xs
300 04edfc99 Iustin Pop
  in extractKey (conv_fn k:ek) rest
301 04edfc99 Iustin Pop
302 04edfc99 Iustin Pop
{-| Sort a list of strings based on digit and non-digit groupings.
303 04edfc99 Iustin Pop
304 04edfc99 Iustin Pop
Given a list of names @['a1', 'a10', 'a11', 'a2']@ this function
305 04edfc99 Iustin Pop
will sort the list in the logical order @['a1', 'a2', 'a10', 'a11']@.
306 04edfc99 Iustin Pop
307 04edfc99 Iustin Pop
The sort algorithm breaks each name in groups of either only-digits or
308 04edfc99 Iustin Pop
no-digits, and sorts based on each group.
309 04edfc99 Iustin Pop
310 04edfc99 Iustin Pop
Internally, this is not implemented via regexes (like the Python
311 04edfc99 Iustin Pop
version), but via actual splitting of the string in sequences of
312 04edfc99 Iustin Pop
either digits or everything else, and converting the digit sequences
313 04edfc99 Iustin Pop
in /Left Integer/ and the non-digit ones in /Right String/, at which
314 04edfc99 Iustin Pop
point sorting becomes trivial due to the built-in 'Either' ordering;
315 04edfc99 Iustin Pop
we only need one extra step of dropping the key at the end.
316 04edfc99 Iustin Pop
317 04edfc99 Iustin Pop
-}
318 04edfc99 Iustin Pop
niceSort :: [String] -> [String]
319 a7f0953a Iustin Pop
niceSort = niceSortKey id
320 04edfc99 Iustin Pop
321 04edfc99 Iustin Pop
-- | Key-version of 'niceSort'. We use 'sortBy' and @compare `on` fst@
322 04edfc99 Iustin Pop
-- since we don't want to add an ordering constraint on the /a/ type,
323 04edfc99 Iustin Pop
-- hence the need to only compare the first element of the /(key, a)/
324 04edfc99 Iustin Pop
-- tuple.
325 04edfc99 Iustin Pop
niceSortKey :: (a -> String) -> [a] -> [a]
326 04edfc99 Iustin Pop
niceSortKey keyfn =
327 04edfc99 Iustin Pop
  map snd . sortBy (compare `on` fst) .
328 04edfc99 Iustin Pop
  map (\s -> (fst . extractKey [] $ keyfn s, s))
329 256e28c4 Iustin Pop
330 256e28c4 Iustin Pop
-- | Strip space characthers (including newline). As this is
331 256e28c4 Iustin Pop
-- expensive, should only be run on small strings.
332 256e28c4 Iustin Pop
rStripSpace :: String -> String
333 256e28c4 Iustin Pop
rStripSpace = reverse . dropWhile isSpace . reverse
334 80a0546b Michele Tartara
335 80a0546b Michele Tartara
-- | Returns a random UUID.
336 80a0546b Michele Tartara
-- This is a Linux-specific method as it uses the /proc filesystem.
337 80a0546b Michele Tartara
newUUID :: IO String
338 80a0546b Michele Tartara
newUUID = do
339 06fd57e5 Jose A. Lopes
  contents <- readFile ConstantUtils.randomUuidFile
340 37dfcacb Iustin Pop
  return $! rStripSpace $ take 128 contents
341 b6aeda4a Dato Simó
342 a6e054a8 Iustin Pop
-- | Returns the current time as an 'Integer' representing the number
343 a6e054a8 Iustin Pop
-- of seconds from the Unix epoch.
344 ace37e24 Michele Tartara
getCurrentTime :: IO Integer
345 ace37e24 Michele Tartara
getCurrentTime = do
346 ace37e24 Michele Tartara
  TOD ctime _ <- getClockTime
347 ace37e24 Michele Tartara
  return ctime
348 ace37e24 Michele Tartara
349 a6e054a8 Iustin Pop
-- | Returns the current time as an 'Integer' representing the number
350 a6e054a8 Iustin Pop
-- of microseconds from the Unix epoch (hence the need for 'Integer').
351 a6e054a8 Iustin Pop
getCurrentTimeUSec :: IO Integer
352 a6e054a8 Iustin Pop
getCurrentTimeUSec = do
353 a6e054a8 Iustin Pop
  TOD ctime pico <- getClockTime
354 a6e054a8 Iustin Pop
  -- pico: 10^-12, micro: 10^-6, so we have to shift seconds left and
355 a6e054a8 Iustin Pop
  -- picoseconds right
356 a6e054a8 Iustin Pop
  return $ ctime * 1000000 + pico `div` 1000000
357 a6e054a8 Iustin Pop
358 b6aeda4a Dato Simó
-- | Convert a ClockTime into a (seconds-only) timestamp.
359 b6aeda4a Dato Simó
clockTimeToString :: ClockTime -> String
360 b6aeda4a Dato Simó
clockTimeToString (TOD t _) = show t
361 b009f682 Dato Simó
362 b009f682 Dato Simó
{-| Strip a prefix from a string, allowing the last character of the prefix
363 b009f682 Dato Simó
(which is assumed to be a separator) to be absent from the string if the string
364 b009f682 Dato Simó
terminates there.
365 b009f682 Dato Simó
366 94042ae4 Michele Tartara
\>>> chompPrefix \"foo:bar:\" \"a:b:c\"
367 b009f682 Dato Simó
Nothing
368 b009f682 Dato Simó
369 94042ae4 Michele Tartara
\>>> chompPrefix \"foo:bar:\" \"foo:bar:baz\"
370 94042ae4 Michele Tartara
Just \"baz\"
371 b009f682 Dato Simó
372 94042ae4 Michele Tartara
\>>> chompPrefix \"foo:bar:\" \"foo:bar:\"
373 94042ae4 Michele Tartara
Just \"\"
374 b009f682 Dato Simó
375 94042ae4 Michele Tartara
\>>> chompPrefix \"foo:bar:\" \"foo:bar\"
376 94042ae4 Michele Tartara
Just \"\"
377 b009f682 Dato Simó
378 94042ae4 Michele Tartara
\>>> chompPrefix \"foo:bar:\" \"foo:barbaz\"
379 b009f682 Dato Simó
Nothing
380 b009f682 Dato Simó
-}
381 b009f682 Dato Simó
chompPrefix :: String -> String -> Maybe String
382 b009f682 Dato Simó
chompPrefix pfx str =
383 b009f682 Dato Simó
  if pfx `isPrefixOf` str || str == init pfx
384 b009f682 Dato Simó
    then Just $ drop (length pfx) str
385 b009f682 Dato Simó
    else Nothing
386 9fb621af Yiannis Tsiouris
387 9fb621af Yiannis Tsiouris
-- | Breaks a string in lines with length \<= maxWidth.
388 9fb621af Yiannis Tsiouris
--
389 9fb621af Yiannis Tsiouris
-- NOTE: The split is OK if:
390 9fb621af Yiannis Tsiouris
--
391 9fb621af Yiannis Tsiouris
-- * It doesn't break a word, i.e. the next line begins with space
392 9fb621af Yiannis Tsiouris
--   (@isSpace . head $ rest@) or the current line ends with space
393 9fb621af Yiannis Tsiouris
--   (@null revExtra@);
394 9fb621af Yiannis Tsiouris
--
395 9fb621af Yiannis Tsiouris
-- * It breaks a very big word that doesn't fit anyway (@null revLine@).
396 9fb621af Yiannis Tsiouris
wrap :: Int      -- ^ maxWidth
397 9fb621af Yiannis Tsiouris
     -> String   -- ^ string that needs wrapping
398 9fb621af Yiannis Tsiouris
     -> [String] -- ^ string \"broken\" in lines
399 9fb621af Yiannis Tsiouris
wrap maxWidth = filter (not . null) . map trim . wrap0
400 9fb621af Yiannis Tsiouris
  where wrap0 :: String -> [String]
401 9fb621af Yiannis Tsiouris
        wrap0 text
402 9fb621af Yiannis Tsiouris
          | length text <= maxWidth = [text]
403 9fb621af Yiannis Tsiouris
          | isSplitOK               = line : wrap0 rest
404 9fb621af Yiannis Tsiouris
          | otherwise               = line' : wrap0 rest'
405 9fb621af Yiannis Tsiouris
          where (line, rest) = splitAt maxWidth text
406 9fb621af Yiannis Tsiouris
                (revExtra, revLine) = break isSpace . reverse $ line
407 9fb621af Yiannis Tsiouris
                (line', rest') = (reverse revLine, reverse revExtra ++ rest)
408 9fb621af Yiannis Tsiouris
                isSplitOK =
409 9fb621af Yiannis Tsiouris
                  null revLine || null revExtra || startsWithSpace rest
410 9fb621af Yiannis Tsiouris
                startsWithSpace (x:_) = isSpace x
411 9fb621af Yiannis Tsiouris
                startsWithSpace _     = False
412 9fb621af Yiannis Tsiouris
413 9fb621af Yiannis Tsiouris
-- | Removes surrounding whitespace. Should only be used in small
414 9fb621af Yiannis Tsiouris
-- strings.
415 9fb621af Yiannis Tsiouris
trim :: String -> String
416 9fb621af Yiannis Tsiouris
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
417 72747d91 Iustin Pop
418 72747d91 Iustin Pop
-- | A safer head version, with a default value.
419 72747d91 Iustin Pop
defaultHead :: a -> [a] -> a
420 72747d91 Iustin Pop
defaultHead def []    = def
421 72747d91 Iustin Pop
defaultHead _   (x:_) = x
422 72747d91 Iustin Pop
423 72747d91 Iustin Pop
-- | A 'head' version in the I/O monad, for validating parameters
424 72747d91 Iustin Pop
-- without which we cannot continue.
425 72747d91 Iustin Pop
exitIfEmpty :: String -> [a] -> IO a
426 72747d91 Iustin Pop
exitIfEmpty _ (x:_) = return x
427 72747d91 Iustin Pop
exitIfEmpty s []    = exitErr s
428 da9e2aff Iustin Pop
429 bf7ee7ad Klaus Aehlig
-- | Obtain the unique element of a list in an arbitrary monad.
430 bf7ee7ad Klaus Aehlig
monadicThe :: (Eq a, Monad m) => String -> [a] -> m a
431 bf7ee7ad Klaus Aehlig
monadicThe s [] = fail s
432 bf7ee7ad Klaus Aehlig
monadicThe s (x:xs)
433 bf7ee7ad Klaus Aehlig
  | all (x ==) xs = return x
434 bf7ee7ad Klaus Aehlig
  | otherwise = fail s
435 bf7ee7ad Klaus Aehlig
436 da9e2aff Iustin Pop
-- | Split an 'Either' list into two separate lists (containing the
437 da9e2aff Iustin Pop
-- 'Left' and 'Right' elements, plus a \"trail\" list that allows
438 da9e2aff Iustin Pop
-- recombination later.
439 da9e2aff Iustin Pop
--
440 da9e2aff Iustin Pop
-- This is splitter; for recombination, look at 'recombineEithers'.
441 da9e2aff Iustin Pop
-- The sum of \"left\" and \"right\" lists should be equal to the
442 da9e2aff Iustin Pop
-- original list length, and the trail list should be the same length
443 da9e2aff Iustin Pop
-- as well. The entries in the resulting lists are reversed in
444 da9e2aff Iustin Pop
-- comparison with the original list.
445 da9e2aff Iustin Pop
splitEithers :: [Either a b] -> ([a], [b], [Bool])
446 da9e2aff Iustin Pop
splitEithers = foldl' splitter ([], [], [])
447 da9e2aff Iustin Pop
  where splitter (l, r, t) e =
448 da9e2aff Iustin Pop
          case e of
449 da9e2aff Iustin Pop
            Left  v -> (v:l, r, False:t)
450 da9e2aff Iustin Pop
            Right v -> (l, v:r, True:t)
451 da9e2aff Iustin Pop
452 da9e2aff Iustin Pop
-- | Recombines two \"left\" and \"right\" lists using a \"trail\"
453 da9e2aff Iustin Pop
-- list into a single 'Either' list.
454 da9e2aff Iustin Pop
--
455 da9e2aff Iustin Pop
-- This is the counterpart to 'splitEithers'. It does the opposite
456 da9e2aff Iustin Pop
-- transformation, and the output list will be the reverse of the
457 da9e2aff Iustin Pop
-- input lists. Since 'splitEithers' also reverses the lists, calling
458 da9e2aff Iustin Pop
-- these together will result in the original list.
459 da9e2aff Iustin Pop
--
460 da9e2aff Iustin Pop
-- Mismatches in the structure of the lists (e.g. inconsistent
461 da9e2aff Iustin Pop
-- lengths) are represented via 'Bad'; normally this function should
462 da9e2aff Iustin Pop
-- not fail, if lists are passed as generated by 'splitEithers'.
463 da9e2aff Iustin Pop
recombineEithers :: (Show a, Show b) =>
464 da9e2aff Iustin Pop
                    [a] -> [b] -> [Bool] -> Result [Either a b]
465 da9e2aff Iustin Pop
recombineEithers lefts rights trail =
466 da9e2aff Iustin Pop
  foldM recombiner ([], lefts, rights) trail >>= checker
467 da9e2aff Iustin Pop
    where checker (eithers, [], []) = Ok eithers
468 da9e2aff Iustin Pop
          checker (_, lefts', rights') =
469 da9e2aff Iustin Pop
            Bad $ "Inconsistent results after recombination, l'=" ++
470 da9e2aff Iustin Pop
                show lefts' ++ ", r'=" ++ show rights'
471 da9e2aff Iustin Pop
          recombiner (es, l:ls, rs) False = Ok (Left l:es,  ls, rs)
472 da9e2aff Iustin Pop
          recombiner (es, ls, r:rs) True  = Ok (Right r:es, ls, rs)
473 da9e2aff Iustin Pop
          recombiner (_,  ls, rs) t = Bad $ "Inconsistent trail log: l=" ++
474 da9e2aff Iustin Pop
                                      show ls ++ ", r=" ++ show rs ++ ",t=" ++
475 da9e2aff Iustin Pop
                                      show t
476 986a8671 Michele Tartara
477 986a8671 Michele Tartara
-- | Default hints for the resolver
478 986a8671 Michele Tartara
resolveAddrHints :: Maybe AddrInfo
479 986a8671 Michele Tartara
resolveAddrHints =
480 986a8671 Michele Tartara
  Just defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV] }
481 986a8671 Michele Tartara
482 986a8671 Michele Tartara
-- | Resolves a numeric address.
483 986a8671 Michele Tartara
resolveAddr :: Int -> String -> IO (Result (Family, SockAddr))
484 986a8671 Michele Tartara
resolveAddr port str = do
485 986a8671 Michele Tartara
  resolved <- getAddrInfo resolveAddrHints (Just str) (Just (show port))
486 986a8671 Michele Tartara
  return $ case resolved of
487 986a8671 Michele Tartara
             [] -> Bad "Invalid results from lookup?"
488 986a8671 Michele Tartara
             best:_ -> Ok (addrFamily best, addrAddress best)
489 858ecf2b Klaus Aehlig
490 a39cd547 Michele Tartara
-- | Set the owner and the group of a file (given as names, not numeric id).
491 a39cd547 Michele Tartara
setOwnerAndGroupFromNames :: FilePath -> GanetiDaemon -> GanetiGroup -> IO ()
492 a39cd547 Michele Tartara
setOwnerAndGroupFromNames filename daemon dGroup = do
493 a39cd547 Michele Tartara
  -- TODO: it would be nice to rework this (or getEnts) so that runtimeEnts
494 a39cd547 Michele Tartara
  -- is read only once per daemon startup, and then cached for further usage.
495 a39cd547 Michele Tartara
  runtimeEnts <- getEnts
496 a39cd547 Michele Tartara
  ents <- exitIfBad "Can't find required user/groups" runtimeEnts
497 a39cd547 Michele Tartara
  -- note: we use directly ! as lookup failures shouldn't happen, due
498 a39cd547 Michele Tartara
  -- to the map construction
499 a39cd547 Michele Tartara
  let uid = fst ents M.! daemon
500 a39cd547 Michele Tartara
  let gid = snd ents M.! dGroup
501 a39cd547 Michele Tartara
  setOwnerAndGroup filename uid gid
502 88b58ed6 Hrvoje Ribicic
503 88b58ed6 Hrvoje Ribicic
-- | Formats an integral number, appending a suffix.
504 88b58ed6 Hrvoje Ribicic
formatOrdinal :: (Integral a, Show a) => a -> String
505 88b58ed6 Hrvoje Ribicic
formatOrdinal num
506 88b58ed6 Hrvoje Ribicic
  | num > 10 && num < 20 = suffix "th"
507 88b58ed6 Hrvoje Ribicic
  | tens == 1            = suffix "st"
508 88b58ed6 Hrvoje Ribicic
  | tens == 2            = suffix "nd"
509 88b58ed6 Hrvoje Ribicic
  | tens == 3            = suffix "rd"
510 88b58ed6 Hrvoje Ribicic
  | otherwise            = suffix "th"
511 88b58ed6 Hrvoje Ribicic
  where tens     = num `mod` 10
512 88b58ed6 Hrvoje Ribicic
        suffix s = show num ++ s
513 710f5ae2 Klaus Aehlig
514 710f5ae2 Klaus Aehlig
-- | Atomically write a file, by first writing the contents into a temporary
515 710f5ae2 Klaus Aehlig
-- file and then renaming it to the old position.
516 710f5ae2 Klaus Aehlig
atomicWriteFile :: FilePath -> String -> IO ()
517 710f5ae2 Klaus Aehlig
atomicWriteFile path contents = do
518 710f5ae2 Klaus Aehlig
  (tmppath, tmphandle) <- openTempFile (takeDirectory path) (takeBaseName path)
519 710f5ae2 Klaus Aehlig
  hPutStr tmphandle contents
520 710f5ae2 Klaus Aehlig
  hClose tmphandle
521 710f5ae2 Klaus Aehlig
  renameFile tmppath path
522 32b07c5f Klaus Aehlig
523 32b07c5f Klaus Aehlig
-- | Attempt, in a non-blocking way, to obtain a lock on a given file; report
524 32b07c5f Klaus Aehlig
-- back success.
525 32b07c5f Klaus Aehlig
lockFile :: FilePath -> IO (Result ())
526 32b07c5f Klaus Aehlig
lockFile path = do
527 32b07c5f Klaus Aehlig
  handle <- openFile path WriteMode
528 32b07c5f Klaus Aehlig
  fd <- handleToFd handle
529 32b07c5f Klaus Aehlig
  Control.Monad.liftM (either (Bad . show) Ok)
530 32b07c5f Klaus Aehlig
    (try (setLock fd (WriteLock, AbsoluteSeek, 0, 0)) :: IO (Either IOError ()))