commit 29a3053378d72e6897799c16fe61d136b28ca1e0
Author: Iustin Pop <iustin@google.com>
Date:   Thu Nov 8 18:52:31 2012 +0100

    Remove unsafePerformIO usage
    
    We need to change a few things, most importantly CLI options defaults,
    but otherwise we already used the path to files from functions which
    were already in the I/O monad, so we don't have to change much of the
    code flow.
    
    Additionally, Path.hs now has an explicit export list, to stop
    accidental leakage of symbols.
    
    Signed-off-by: Iustin Pop <iustin@google.com>
    Reviewed-by: Helga Velroyen <helgav@google.com>

diff --git a/htest/Test/Ganeti/HTools/CLI.hs b/htest/Test/Ganeti/HTools/CLI.hs
index a9ae743..5b6b369 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 e6c2929..53891c3 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 f79e6e8..dc8b8ab 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 2e9e59e..33a9f1c 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 69e0806..e2483a6 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 aeeb2b4..fa0728b 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 d8b1100..69dc238 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 d614017..f15977c 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 ee64706..854b764 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 a785d5b..d1b62c3 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 fcb759b..277fe0b 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 980fa86..8f2bfeb 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 7654a15..547cb2d 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 8295736..2ebef2e 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 6ffa65e..9d345e3 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
