Revision 29a30533

b/htest/Test/Ganeti/HTools/CLI.hs
69 69
             , (oDynuFile,      optDynuFile)
70 70
             , (oSaveCluster,   optSaveCluster)
71 71
             , (oPrintCommands, optShowCmds)
72
             , (oLuxiSocket,    optLuxi)
72
             , (genOLuxiSocket "", optLuxi)
73 73
             , (oIAllocSrc,     optIAllocSrc)
74 74
             ]
75 75
  in conjoin $ map (\(o, opt) ->
b/htools/Ganeti/Confd/Server.hs
533 533
  hmac <- getClusterHmac
534 534
  -- Inotify setup
535 535
  inotify <- initINotify
536
  let inotiaction = addNotifier inotify Path.clusterConfFile cref statemvar
536
  conf_file <- Path.clusterConfFile
537
  let inotiaction = addNotifier inotify conf_file cref statemvar
537 538
  -- fork the timeout timer
538
  _ <- forkIO $ onTimeoutTimer inotiaction Path.clusterConfFile cref statemvar
539
  _ <- forkIO $ onTimeoutTimer inotiaction conf_file cref statemvar
539 540
  -- fork the polling timer
540
  _ <- forkIO $ onReloadTimer inotiaction Path.clusterConfFile cref statemvar
541
  _ <- forkIO $ onReloadTimer inotiaction conf_file cref statemvar
541 542
  -- launch the queryd listener
542 543
  _ <- forkIO $ runQueryD query_data (configReader cref)
543 544
  -- and finally enter the responder loop
b/htools/Ganeti/Confd/Utils.hs
46 46

  
47 47
-- | Returns the HMAC key.
48 48
getClusterHmac :: IO HashKey
49
getClusterHmac = fmap B.unpack $ B.readFile Path.confdHmacKey
49
getClusterHmac = Path.confdHmacKey >>= fmap B.unpack . B.readFile
50 50

  
51 51
-- | Parses a signed request.
52 52
parseRequest :: HashKey -> String -> Result (String, String, ConfdRequest)
b/htools/Ganeti/Daemon.hs
344 344
                         syslogUsageFromRaw C.syslogUsage
345 345
              Just v -> return v
346 346

  
347
  log_file <- daemonLogFile daemon
347 348
  -- run the check function and optionally exit if it returns an exit code
348 349
  check_result <- check_fn opts
349 350
  check_result' <- case check_result of
......
351 352
                     Right v -> return v
352 353

  
353 354
  let processFn = if optDaemonize opts
354
                    then daemonize (daemonLogFile daemon)
355
                    then daemonize log_file
355 356
                    else \action -> action Nothing
356 357
  processFn $ innerMain daemon opts syslog check_result' prep_fn exec_fn
357 358

  
......
367 368
         -> PrepFn a b    -- ^ Prepare function
368 369
         -> IO b
369 370
fullPrep daemon opts syslog check_result prep_fn = do
370
  let logfile = if optDaemonize opts
371
                  then Nothing
372
                  else Just $ daemonLogFile daemon
373
      pidfile = daemonPidFile daemon
374
      dname = daemonName daemon
371
  logfile <- if optDaemonize opts
372
               then return Nothing
373
               else liftM Just $ daemonLogFile daemon
374
  pidfile <- daemonPidFile daemon
375
  let dname = daemonName daemon
375 376
  setupLogging logfile dname (optDebug opts) True False syslog
376 377
  _ <- describeError "writing PID file; already locked?"
377 378
         Nothing (Just pidfile) $ writePidFile pidfile
b/htools/Ganeti/HTools/CLI.hs
55 55
  , oGroup
56 56
  , oIAllocSrc
57 57
  , oInstMoves
58
  , genOLuxiSocket
58 59
  , oLuxiSocket
59 60
  , oMachineReadable
60 61
  , oMaxCpu
......
325 326
   "Specify an iallocator spec as the cluster data source",
326 327
   OptComplFile)
327 328

  
328
oLuxiSocket :: OptType
329
oLuxiSocket =
329
genOLuxiSocket :: String -> OptType
330
genOLuxiSocket defSocket =
330 331
  (Option "L" ["luxi"]
331 332
   (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
332
            fromMaybe Path.defaultLuxiSocket) "SOCKET")
333
   "collect data via Luxi, optionally using the given SOCKET path",
333
            fromMaybe defSocket) "SOCKET")
334
   ("collect data via Luxi, optionally using the given SOCKET path [" ++
335
    defSocket ++ "]"),
334 336
   OptComplFile)
335 337

  
338
oLuxiSocket :: IO OptType
339
oLuxiSocket = Path.defaultLuxiSocket >>= (return . genOLuxiSocket)
340

  
336 341
oMachineReadable :: OptType
337 342
oMachineReadable =
338 343
  (Option "" ["machine-readable"]
b/htools/Ganeti/HTools/Program/Hbal.hs
63 63

  
64 64
-- | Options list and functions.
65 65
options :: IO [OptType]
66
options =
66
options = do
67
  luxi <- oLuxiSocket
67 68
  return
68 69
    [ oPrintNodes
69 70
    , oPrintInsts
......
71 72
    , oDataFile
72 73
    , oEvacMode
73 74
    , oRapiMaster
74
    , oLuxiSocket
75
    , luxi
75 76
    , oIAllocSrc
76 77
    , oExecJobs
77 78
    , oGroup
b/htools/Ganeti/HTools/Program/Hcheck.hs
51 51

  
52 52
-- | Options list and functions.
53 53
options :: IO [OptType]
54
options =
54
options = do
55
  luxi <- oLuxiSocket
55 56
  return
56 57
    [ oDataFile
57 58
    , oDiskMoves
......
61 62
    , oExTags
62 63
    , oIAllocSrc
63 64
    , oInstMoves
64
    , oLuxiSocket
65
    , luxi
65 66
    , oMachineReadable
66 67
    , oMaxCpu
67 68
    , oMaxSolLength
b/htools/Ganeti/HTools/Program/Hinfo.hs
49 49

  
50 50
-- | Options list and functions.
51 51
options :: IO [OptType]
52
options =
52
options = do
53
  luxi <- oLuxiSocket
53 54
  return
54 55
    [ oPrintNodes
55 56
    , oPrintInsts
56 57
    , oDataFile
57 58
    , oRapiMaster
58
    , oLuxiSocket
59
    , luxi
59 60
    , oIAllocSrc
60 61
    , oVerbose
61 62
    , oQuiet
b/htools/Ganeti/HTools/Program/Hscan.hs
53 53

  
54 54
-- | Options list and functions.
55 55
options :: IO [OptType]
56
options =
56
options = do
57
  luxi <- oLuxiSocket
57 58
  return
58 59
    [ oPrintNodes
59 60
    , oOutputDir
60
    , oLuxiSocket
61
    , luxi
61 62
    , oVerbose
62 63
    , oNoHeaders
63 64
    ]
......
147 148
                "t_disk" "f_disk" "Score"
148 149

  
149 150
  when (null clusters) $ do
150
         let lsock = fromMaybe Path.defaultLuxiSocket (optLuxi opts)
151
         def_socket <- Path.defaultLuxiSocket
152
         let lsock = fromMaybe def_socket (optLuxi opts)
151 153
         let name = local
152 154
         input_data <- Luxi.loadData lsock
153 155
         result <- writeData nlen name opts input_data
b/htools/Ganeti/HTools/Program/Hspace.hs
54 54

  
55 55
-- | Options list and functions.
56 56
options :: IO [OptType]
57
options =
57
options = do
58
  luxi <- oLuxiSocket
58 59
  return
59 60
    [ oPrintNodes
60 61
    , oDataFile
......
62 63
    , oSpindleUse
63 64
    , oNodeSim
64 65
    , oRapiMaster
65
    , oLuxiSocket
66
    , luxi
66 67
    , oIAllocSrc
67 68
    , oVerbose
68 69
    , oQuiet
b/htools/Ganeti/Path.hs
23 23

  
24 24
-}
25 25

  
26
module Ganeti.Path where
26
module Ganeti.Path
27
  ( dataDir
28
  , runDir
29
  , logDir
30
  , socketDir
31
  , defaultLuxiSocket
32
  , defaultQuerySocket
33
  , confdHmacKey
34
  , clusterConfFile
35
  , nodedCertFile
36
  ) where
27 37

  
28
import qualified Ganeti.Constants as C
29 38
import System.FilePath
30 39
import System.Posix.Env (getEnvDefault)
31
import System.IO.Unsafe
32

  
33
{-# NOINLINE getRootDir #-}
34
getRootDir :: FilePath
35
getRootDir = unsafePerformIO $ getEnvDefault "GANETI_ROOTDIR" ""
36 40

  
37
-- | Prefixes a path with the current root directory
38
addNodePrefix :: FilePath -> FilePath
39
addNodePrefix path = getRootDir ++ path
41
import qualified Ganeti.Constants as C
40 42

  
41
-- | Directory for data
42
dataDir :: FilePath
43
-- | Simple helper to concat two paths.
44
pjoin :: IO String -> String -> IO String
45
pjoin a b = do
46
  a' <- a
47
  return $ a' </> b
48

  
49
-- | Returns the root directory, which can be either the real root or
50
-- the virtual root.
51
getRootDir :: IO FilePath
52
getRootDir = getEnvDefault "GANETI_ROOTDIR" ""
53

  
54
-- | Prefixes a path with the current root directory.
55
addNodePrefix :: FilePath -> IO FilePath
56
addNodePrefix path = do
57
  root <- getRootDir
58
  return $ root ++ path
59

  
60
-- | Directory for data.
61
dataDir :: IO FilePath
43 62
dataDir = addNodePrefix $ C.autoconfLocalstatedir </> "lib" </> "ganeti"
44 63

  
45
-- | Directory for runtime files
46
runDir :: FilePath
64
-- | Directory for runtime files.
65
runDir :: IO FilePath
47 66
runDir = addNodePrefix $ C.autoconfLocalstatedir </> "run" </> "ganeti"
48 67

  
49
-- | Directory for log files
50
logDir :: FilePath
68
-- | Directory for log files.
69
logDir :: IO FilePath
51 70
logDir = addNodePrefix $ C.autoconfLocalstatedir </> "log" </> "ganeti"
52 71

  
53
-- | Directory for Unix sockets
54
socketDir :: FilePath
55
socketDir = runDir </> "socket"
72
-- | Directory for Unix sockets.
73
socketDir :: IO FilePath
74
socketDir = runDir `pjoin` "socket"
56 75

  
57 76
-- | The default LUXI socket path.
58
defaultLuxiSocket :: FilePath
59
defaultLuxiSocket = socketDir </> "ganeti-master"
77
defaultLuxiSocket :: IO FilePath
78
defaultLuxiSocket = socketDir `pjoin` "ganeti-master"
60 79

  
61 80
-- | The default LUXI socket for queries.
62
defaultQuerySocket :: FilePath
63
defaultQuerySocket = socketDir </> "ganeti-query"
81
defaultQuerySocket :: IO FilePath
82
defaultQuerySocket = socketDir `pjoin` "ganeti-query"
64 83

  
65
-- | Path to file containing confd's HMAC key
66
confdHmacKey :: FilePath
67
confdHmacKey = dataDir </> "hmac.key"
84
-- | Path to file containing confd's HMAC key.
85
confdHmacKey :: IO FilePath
86
confdHmacKey = dataDir `pjoin` "hmac.key"
68 87

  
69
-- | Path to cluster configuration file
70
clusterConfFile :: FilePath
71
clusterConfFile  = dataDir </> "config.data"
88
-- | Path to cluster configuration file.
89
clusterConfFile :: IO FilePath
90
clusterConfFile  = dataDir `pjoin` "config.data"
72 91

  
73
-- | Path
74
nodedCertFile  :: FilePath
75
nodedCertFile = dataDir </> "server.pem"
92
-- | Path to the noded certificate.
93
nodedCertFile  :: IO FilePath
94
nodedCertFile = dataDir `pjoin` "server.pem"
b/htools/Ganeti/Query/Server.hs
222 222
-- | Function that prepares the server socket.
223 223
prepQueryD :: Maybe FilePath -> IO (FilePath, S.Socket)
224 224
prepQueryD fpath = do
225
  let socket_path = fromMaybe Path.defaultQuerySocket fpath
225
  def_socket <- Path.defaultQuerySocket
226
  let socket_path = fromMaybe def_socket fpath
226 227
  cleanupSocket socket_path
227 228
  s <- describeError "binding to the Luxi socket"
228 229
         Nothing (Just socket_path) $ getServer socket_path
b/htools/Ganeti/Rpc.hs
92 92
-- | The curl options used for RPC.
93 93
curlOpts :: [CurlOption]
94 94
curlOpts = [ CurlFollowLocation False
95
           , CurlCAInfo P.nodedCertFile
96 95
           , CurlSSLVerifyHost 0
97 96
           , CurlSSLVerifyPeer True
98 97
           , CurlSSLCertType "PEM"
99
           , CurlSSLCert P.nodedCertFile
100 98
           , CurlSSLKeyType "PEM"
101
           , CurlSSLKey P.nodedCertFile
102 99
           , CurlConnectTimeout (fromIntegral C.rpcConnectTimeout)
103 100
           ]
104 101
#endif
......
171 168
executeHttpRequest _ _ = return $ Left CurlDisabledError
172 169
#else
173 170
executeHttpRequest node (Right request) = do
171
  cert_file <- P.nodedCertFile
174 172
  let reqOpts = [ CurlTimeout (fromIntegral $ requestTimeout request)
175 173
                , CurlPostFields [requestPostData request]
174
                , CurlSSLCert cert_file
175
                , CurlSSLKey cert_file
176
                , CurlCAInfo cert_file
176 177
                ]
177 178
      url = requestUrl request
178 179
  -- FIXME: This is very similar to getUrl in Htools/Rapi.hs
b/htools/Ganeti/Runtime.hs
92 92
daemonGroup (ExtraGroup  AdminGroup)    = C.adminGroup
93 93

  
94 94
-- | Returns the log file for a daemon.
95
daemonLogFile :: GanetiDaemon -> FilePath
96
daemonLogFile daemon = Path.logDir </> daemonName daemon <.> "log"
95
daemonLogFile :: GanetiDaemon -> IO FilePath
96
daemonLogFile daemon = do
97
  logDir <- Path.logDir
98
  return $ logDir </> daemonName daemon <.> "log"
97 99

  
98 100
-- | Returns the pid file name for a daemon.
99
daemonPidFile :: GanetiDaemon -> FilePath
100
daemonPidFile daemon = Path.runDir </> daemonName daemon <.> "pid"
101
daemonPidFile :: GanetiDaemon -> IO FilePath
102
daemonPidFile daemon = do
103
  runDir <- Path.runDir
104
  return $ runDir </> daemonName daemon <.> "pid"
101 105

  
102 106
-- | All groups list. A bit hacking, as we can't enforce it's complete
103 107
-- at compile time.
b/htools/Ganeti/Ssconf.hs
111 111
               -> SSKey                     -- ^ Desired ssconf key
112 112
               -> IO (Result String)
113 113
readSSConfFile optpath def key = do
114
  dpath <- Path.dataDir
114 115
  result <- catchIOErrors def . readFile .
115
            keyToFilename (fromMaybe Path.dataDir optpath) $ key
116
            keyToFilename (fromMaybe dpath optpath) $ key
116 117
  return (liftM (take maxFileSize) result)
117 118

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

Also available in: Unified diff