diff --git a/htest/Test/Ganeti/HTools/CLI.hs b/htest/Test/Ganeti/HTools/CLI.hs index a9ae7435b39552fe5f8100b35a4b28b11f893518..5b6b369ec0aefdca1cf960a42b6a643495b6c06c 100644 --- a/htest/Test/Ganeti/HTools/CLI.hs +++ b/htest/Test/Ganeti/HTools/CLI.hs @@ -69,7 +69,7 @@ prop_string_arg argument = , (oDynuFile, optDynuFile) , (oSaveCluster, optSaveCluster) , (oPrintCommands, optShowCmds) - , (oLuxiSocket, optLuxi) + , (genOLuxiSocket "", optLuxi) , (oIAllocSrc, optIAllocSrc) ] in conjoin $ map (\(o, opt) -> diff --git a/htools/Ganeti/Confd/Server.hs b/htools/Ganeti/Confd/Server.hs index e6c2929dd72cd7bbaf3c64db1d56b98e81da99a9..53891c34af7acb8134c3bdff45bcc4ea4821fa05 100644 --- a/htools/Ganeti/Confd/Server.hs +++ b/htools/Ganeti/Confd/Server.hs @@ -533,11 +533,12 @@ main _ _ (s, query_data, cref) = do hmac <- getClusterHmac -- Inotify setup inotify <- initINotify - let inotiaction = addNotifier inotify Path.clusterConfFile cref statemvar + conf_file <- Path.clusterConfFile + let inotiaction = addNotifier inotify conf_file cref statemvar -- fork the timeout timer - _ <- forkIO $ onTimeoutTimer inotiaction Path.clusterConfFile cref statemvar + _ <- forkIO $ onTimeoutTimer inotiaction conf_file cref statemvar -- fork the polling timer - _ <- forkIO $ onReloadTimer inotiaction Path.clusterConfFile cref statemvar + _ <- forkIO $ onReloadTimer inotiaction conf_file cref statemvar -- launch the queryd listener _ <- forkIO $ runQueryD query_data (configReader cref) -- and finally enter the responder loop diff --git a/htools/Ganeti/Confd/Utils.hs b/htools/Ganeti/Confd/Utils.hs index f79e6e8b6d871ca0ec66b5ada7b925d2e921e2ab..dc8b8ab7c59a11faf21a1943f7a3b834ab796245 100644 --- a/htools/Ganeti/Confd/Utils.hs +++ b/htools/Ganeti/Confd/Utils.hs @@ -46,7 +46,7 @@ import Ganeti.Utils -- | Returns the HMAC key. getClusterHmac :: IO HashKey -getClusterHmac = fmap B.unpack $ B.readFile Path.confdHmacKey +getClusterHmac = Path.confdHmacKey >>= fmap B.unpack . B.readFile -- | Parses a signed request. parseRequest :: HashKey -> String -> Result (String, String, ConfdRequest) diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs index 2e9e59e9bce355696ae27a1b3927ed37fd06eb3a..33a9f1c6ff52d2b7187b5c215911741d3931fa40 100644 --- a/htools/Ganeti/Daemon.hs +++ b/htools/Ganeti/Daemon.hs @@ -344,6 +344,7 @@ genericMain daemon options check_fn prep_fn exec_fn = do syslogUsageFromRaw C.syslogUsage Just v -> return v + log_file <- daemonLogFile daemon -- run the check function and optionally exit if it returns an exit code check_result <- check_fn opts check_result' <- case check_result of @@ -351,7 +352,7 @@ genericMain daemon options check_fn prep_fn exec_fn = do Right v -> return v let processFn = if optDaemonize opts - then daemonize (daemonLogFile daemon) + then daemonize log_file else \action -> action Nothing processFn $ innerMain daemon opts syslog check_result' prep_fn exec_fn @@ -367,11 +368,11 @@ fullPrep :: GanetiDaemon -- ^ The daemon we're running -> PrepFn a b -- ^ Prepare function -> IO b fullPrep daemon opts syslog check_result prep_fn = do - let logfile = if optDaemonize opts - then Nothing - else Just $ daemonLogFile daemon - pidfile = daemonPidFile daemon - dname = daemonName daemon + logfile <- if optDaemonize opts + then return Nothing + else liftM Just $ daemonLogFile daemon + pidfile <- daemonPidFile daemon + let dname = daemonName daemon setupLogging logfile dname (optDebug opts) True False syslog _ <- describeError "writing PID file; already locked?" Nothing (Just pidfile) $ writePidFile pidfile diff --git a/htools/Ganeti/HTools/CLI.hs b/htools/Ganeti/HTools/CLI.hs index 69e08064b73061d8e6d64cb7c70b132b3eac0f05..e2483a6c260188c58586d31dae9cdcbf37380c32 100644 --- a/htools/Ganeti/HTools/CLI.hs +++ b/htools/Ganeti/HTools/CLI.hs @@ -55,6 +55,7 @@ module Ganeti.HTools.CLI , oGroup , oIAllocSrc , oInstMoves + , genOLuxiSocket , oLuxiSocket , oMachineReadable , oMaxCpu @@ -325,14 +326,18 @@ oIAllocSrc = "Specify an iallocator spec as the cluster data source", OptComplFile) -oLuxiSocket :: OptType -oLuxiSocket = +genOLuxiSocket :: String -> OptType +genOLuxiSocket defSocket = (Option "L" ["luxi"] (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) . - fromMaybe Path.defaultLuxiSocket) "SOCKET") - "collect data via Luxi, optionally using the given SOCKET path", + fromMaybe defSocket) "SOCKET") + ("collect data via Luxi, optionally using the given SOCKET path [" ++ + defSocket ++ "]"), OptComplFile) +oLuxiSocket :: IO OptType +oLuxiSocket = Path.defaultLuxiSocket >>= (return . genOLuxiSocket) + oMachineReadable :: OptType oMachineReadable = (Option "" ["machine-readable"] diff --git a/htools/Ganeti/HTools/Program/Hbal.hs b/htools/Ganeti/HTools/Program/Hbal.hs index aeeb2b48b3bf7ea8ef6e9ed9bab781fe6fec698d..fa0728bb0e1a5d72ec4a910d2281ee8d6a84552c 100644 --- a/htools/Ganeti/HTools/Program/Hbal.hs +++ b/htools/Ganeti/HTools/Program/Hbal.hs @@ -63,7 +63,8 @@ import Ganeti.Jobs -- | Options list and functions. options :: IO [OptType] -options = +options = do + luxi <- oLuxiSocket return [ oPrintNodes , oPrintInsts @@ -71,7 +72,7 @@ options = , oDataFile , oEvacMode , oRapiMaster - , oLuxiSocket + , luxi , oIAllocSrc , oExecJobs , oGroup diff --git a/htools/Ganeti/HTools/Program/Hcheck.hs b/htools/Ganeti/HTools/Program/Hcheck.hs index d8b110092aa00e079157d2fb08a719a1edbdf97a..69dc2381cf15bf21cb3fdfa017ec7ee10bca2e55 100644 --- a/htools/Ganeti/HTools/Program/Hcheck.hs +++ b/htools/Ganeti/HTools/Program/Hcheck.hs @@ -51,7 +51,8 @@ import Ganeti.Utils -- | Options list and functions. options :: IO [OptType] -options = +options = do + luxi <- oLuxiSocket return [ oDataFile , oDiskMoves @@ -61,7 +62,7 @@ options = , oExTags , oIAllocSrc , oInstMoves - , oLuxiSocket + , luxi , oMachineReadable , oMaxCpu , oMaxSolLength diff --git a/htools/Ganeti/HTools/Program/Hinfo.hs b/htools/Ganeti/HTools/Program/Hinfo.hs index d6140171bd511e52858c33afd9f2775a6360598c..f15977c5db6b4bd7b0e3cbf98935f0047a859fd6 100644 --- a/htools/Ganeti/HTools/Program/Hinfo.hs +++ b/htools/Ganeti/HTools/Program/Hinfo.hs @@ -49,13 +49,14 @@ import Ganeti.Utils -- | Options list and functions. options :: IO [OptType] -options = +options = do + luxi <- oLuxiSocket return [ oPrintNodes , oPrintInsts , oDataFile , oRapiMaster - , oLuxiSocket + , luxi , oIAllocSrc , oVerbose , oQuiet diff --git a/htools/Ganeti/HTools/Program/Hscan.hs b/htools/Ganeti/HTools/Program/Hscan.hs index ee6470651e1e0172dc3278d8ac7e48f9532c18c3..854b764d7ae8ec133187d541a41b5139a376c651 100644 --- a/htools/Ganeti/HTools/Program/Hscan.hs +++ b/htools/Ganeti/HTools/Program/Hscan.hs @@ -53,11 +53,12 @@ import Ganeti.HTools.CLI -- | Options list and functions. options :: IO [OptType] -options = +options = do + luxi <- oLuxiSocket return [ oPrintNodes , oOutputDir - , oLuxiSocket + , luxi , oVerbose , oNoHeaders ] @@ -147,7 +148,8 @@ main opts clusters = do "t_disk" "f_disk" "Score" when (null clusters) $ do - let lsock = fromMaybe Path.defaultLuxiSocket (optLuxi opts) + def_socket <- Path.defaultLuxiSocket + let lsock = fromMaybe def_socket (optLuxi opts) let name = local input_data <- Luxi.loadData lsock result <- writeData nlen name opts input_data diff --git a/htools/Ganeti/HTools/Program/Hspace.hs b/htools/Ganeti/HTools/Program/Hspace.hs index a785d5b86b3dbbcc971c2fae2f17d1cce9ae9f98..d1b62c34de3fdd64d9983980e1d9e5c25a50f5ab 100644 --- a/htools/Ganeti/HTools/Program/Hspace.hs +++ b/htools/Ganeti/HTools/Program/Hspace.hs @@ -54,7 +54,8 @@ import Ganeti.Utils -- | Options list and functions. options :: IO [OptType] -options = +options = do + luxi <- oLuxiSocket return [ oPrintNodes , oDataFile @@ -62,7 +63,7 @@ options = , oSpindleUse , oNodeSim , oRapiMaster - , oLuxiSocket + , luxi , oIAllocSrc , oVerbose , oQuiet diff --git a/htools/Ganeti/Path.hs b/htools/Ganeti/Path.hs index fcb759b1a0545f9dd970a9337787b9dcef1a6650..277fe0badc7cd1a160a6e9acfadaa341b3795d48 100644 --- a/htools/Ganeti/Path.hs +++ b/htools/Ganeti/Path.hs @@ -23,53 +23,72 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} -module Ganeti.Path where +module Ganeti.Path + ( dataDir + , runDir + , logDir + , socketDir + , defaultLuxiSocket + , defaultQuerySocket + , confdHmacKey + , clusterConfFile + , nodedCertFile + ) where -import qualified Ganeti.Constants as C import System.FilePath import System.Posix.Env (getEnvDefault) -import System.IO.Unsafe - -{-# NOINLINE getRootDir #-} -getRootDir :: FilePath -getRootDir = unsafePerformIO $ getEnvDefault "GANETI_ROOTDIR" "" --- | Prefixes a path with the current root directory -addNodePrefix :: FilePath -> FilePath -addNodePrefix path = getRootDir ++ path +import qualified Ganeti.Constants as C --- | Directory for data -dataDir :: FilePath +-- | Simple helper to concat two paths. +pjoin :: IO String -> String -> IO String +pjoin a b = do + a' <- a + return $ a' </> b + +-- | Returns the root directory, which can be either the real root or +-- the virtual root. +getRootDir :: IO FilePath +getRootDir = getEnvDefault "GANETI_ROOTDIR" "" + +-- | Prefixes a path with the current root directory. +addNodePrefix :: FilePath -> IO FilePath +addNodePrefix path = do + root <- getRootDir + return $ root ++ path + +-- | Directory for data. +dataDir :: IO FilePath dataDir = addNodePrefix $ C.autoconfLocalstatedir </> "lib" </> "ganeti" --- | Directory for runtime files -runDir :: FilePath +-- | Directory for runtime files. +runDir :: IO FilePath runDir = addNodePrefix $ C.autoconfLocalstatedir </> "run" </> "ganeti" --- | Directory for log files -logDir :: FilePath +-- | Directory for log files. +logDir :: IO FilePath logDir = addNodePrefix $ C.autoconfLocalstatedir </> "log" </> "ganeti" --- | Directory for Unix sockets -socketDir :: FilePath -socketDir = runDir </> "socket" +-- | Directory for Unix sockets. +socketDir :: IO FilePath +socketDir = runDir `pjoin` "socket" -- | The default LUXI socket path. -defaultLuxiSocket :: FilePath -defaultLuxiSocket = socketDir </> "ganeti-master" +defaultLuxiSocket :: IO FilePath +defaultLuxiSocket = socketDir `pjoin` "ganeti-master" -- | The default LUXI socket for queries. -defaultQuerySocket :: FilePath -defaultQuerySocket = socketDir </> "ganeti-query" +defaultQuerySocket :: IO FilePath +defaultQuerySocket = socketDir `pjoin` "ganeti-query" --- | Path to file containing confd's HMAC key -confdHmacKey :: FilePath -confdHmacKey = dataDir </> "hmac.key" +-- | Path to file containing confd's HMAC key. +confdHmacKey :: IO FilePath +confdHmacKey = dataDir `pjoin` "hmac.key" --- | Path to cluster configuration file -clusterConfFile :: FilePath -clusterConfFile = dataDir </> "config.data" +-- | Path to cluster configuration file. +clusterConfFile :: IO FilePath +clusterConfFile = dataDir `pjoin` "config.data" --- | Path -nodedCertFile :: FilePath -nodedCertFile = dataDir </> "server.pem" +-- | Path to the noded certificate. +nodedCertFile :: IO FilePath +nodedCertFile = dataDir `pjoin` "server.pem" diff --git a/htools/Ganeti/Query/Server.hs b/htools/Ganeti/Query/Server.hs index 980fa86859b3426166675d497cc5f2f654184484..8f2bfeb1f6aa9bb31a446bd41fbacc1f50372ee3 100644 --- a/htools/Ganeti/Query/Server.hs +++ b/htools/Ganeti/Query/Server.hs @@ -222,7 +222,8 @@ mainLoop creader socket = do -- | Function that prepares the server socket. prepQueryD :: Maybe FilePath -> IO (FilePath, S.Socket) prepQueryD fpath = do - let socket_path = fromMaybe Path.defaultQuerySocket fpath + def_socket <- Path.defaultQuerySocket + let socket_path = fromMaybe def_socket fpath cleanupSocket socket_path s <- describeError "binding to the Luxi socket" Nothing (Just socket_path) $ getServer socket_path diff --git a/htools/Ganeti/Rpc.hs b/htools/Ganeti/Rpc.hs index 7654a1550925d2bdf462d449539323208817b4c4..547cb2d6075851fc0a78c229dfd1eeee6e942c4a 100644 --- a/htools/Ganeti/Rpc.hs +++ b/htools/Ganeti/Rpc.hs @@ -92,13 +92,10 @@ import Ganeti.JSON -- | The curl options used for RPC. curlOpts :: [CurlOption] curlOpts = [ CurlFollowLocation False - , CurlCAInfo P.nodedCertFile , CurlSSLVerifyHost 0 , CurlSSLVerifyPeer True , CurlSSLCertType "PEM" - , CurlSSLCert P.nodedCertFile , CurlSSLKeyType "PEM" - , CurlSSLKey P.nodedCertFile , CurlConnectTimeout (fromIntegral C.rpcConnectTimeout) ] #endif @@ -171,8 +168,12 @@ executeHttpRequest _ (Left rpc_err) = return $ Left rpc_err executeHttpRequest _ _ = return $ Left CurlDisabledError #else executeHttpRequest node (Right request) = do + cert_file <- P.nodedCertFile let reqOpts = [ CurlTimeout (fromIntegral $ requestTimeout request) , CurlPostFields [requestPostData request] + , CurlSSLCert cert_file + , CurlSSLKey cert_file + , CurlCAInfo cert_file ] url = requestUrl request -- FIXME: This is very similar to getUrl in Htools/Rapi.hs diff --git a/htools/Ganeti/Runtime.hs b/htools/Ganeti/Runtime.hs index 82957369dfd60eedfb68ff8b370476408a903d17..2ebef2e35ded828d0baada77cb1cc0ecc87a7137 100644 --- a/htools/Ganeti/Runtime.hs +++ b/htools/Ganeti/Runtime.hs @@ -92,12 +92,16 @@ daemonGroup (ExtraGroup DaemonsGroup) = C.daemonsGroup daemonGroup (ExtraGroup AdminGroup) = C.adminGroup -- | Returns the log file for a daemon. -daemonLogFile :: GanetiDaemon -> FilePath -daemonLogFile daemon = Path.logDir </> daemonName daemon <.> "log" +daemonLogFile :: GanetiDaemon -> IO FilePath +daemonLogFile daemon = do + logDir <- Path.logDir + return $ logDir </> daemonName daemon <.> "log" -- | Returns the pid file name for a daemon. -daemonPidFile :: GanetiDaemon -> FilePath -daemonPidFile daemon = Path.runDir </> daemonName daemon <.> "pid" +daemonPidFile :: GanetiDaemon -> IO FilePath +daemonPidFile daemon = do + runDir <- Path.runDir + return $ runDir </> daemonName daemon <.> "pid" -- | All groups list. A bit hacking, as we can't enforce it's complete -- at compile time. diff --git a/htools/Ganeti/Ssconf.hs b/htools/Ganeti/Ssconf.hs index 6ffa65ea7c0cc982a492d76b35d94daf73e24750..9d345e3ea74daaf74c9036ada5552d98ad01051e 100644 --- a/htools/Ganeti/Ssconf.hs +++ b/htools/Ganeti/Ssconf.hs @@ -111,8 +111,9 @@ readSSConfFile :: Maybe FilePath -- ^ Optional config path override -> SSKey -- ^ Desired ssconf key -> IO (Result String) readSSConfFile optpath def key = do + dpath <- Path.dataDir result <- catchIOErrors def . readFile . - keyToFilename (fromMaybe Path.dataDir optpath) $ key + keyToFilename (fromMaybe dpath optpath) $ key return (liftM (take maxFileSize) result) -- | Strip space characthers (including newline). As this is