+
+
+getGroupID :: [CmdOpt] -> IO GroupID
+getGroupID opts
+ = do let xs = mapMaybe (\ x -> case x of
+ OptGroupName n -> Just n
+ _ -> Nothing) opts
+ name = case xs of
+ [] -> defaultGroupName
+ (x:[]) -> x
+ _ -> error "too many --group options."
+
+ groupEnt <- getGroupEntryForName name
+ return $ groupID groupEnt
+
+
+getLocalStateDir :: [CmdOpt] -> IO FilePath
+getLocalStateDir opts
+ = do let xs = mapMaybe (\ x -> case x of
+ OptLSDir n -> Just n
+ _ -> Nothing) opts
+ path = case xs of
+ [] -> defaultLocalStateDir
+ (x:[]) -> x
+ _ -> error "too many --localstatedir options."
+
+ return path
+
+
+setupLogger :: [CmdOpt] -> IO ()
+setupLogger opts
+ = do let verbose = find (== OptVerbose) opts /= Nothing
+ logHandlers = if verbose then
+ [verboseStreamHandler stderr DEBUG]
+ else
+ [] -- FIXME: enable file log
+ logLevel = fromMaybe defaultLogLevel
+ $ do OptLogLevel l <- find (\ x -> case x of
+ OptLogLevel _ -> True
+ _ -> False) opts
+ return l
+
+ logHandlers' <- sequence logHandlers
+ updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
+
+
+createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
+createLocalStateDir path uid gid
+ = do createDirectoryIfMissing True path
+ setOwnerAndGroup path uid gid
+
+
+rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
+rebuildIndexIfRequested env opts
+ = do let rebuild = isJust $ find (\ x -> case x of
+ OptRebuildIndex -> True
+ _ -> False) opts
+ when rebuild
+ $ rebuildIndex (envStorage env)
+
+withSystemLock :: FilePath -> IO a -> IO a
+withSystemLock lockfile = bracket lock' unlock' . const
+ where
+ lock' :: IO Fd
+ lock' = do fd <- openFd
+ lockfile
+ ReadWrite
+ (Just 420) -- 0644, -rw-r--r--
+ defaultFileFlags
+ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
+ return fd
+
+ unlock' :: Fd -> IO ()
+ unlock' = closeFd
+
+withPidFile :: FilePath -> IO a -> IO a
+withPidFile lockfile = bracket_ mkPid' delPid'
+ where
+ mkPid' :: IO ()
+ mkPid' = withFile lockfile WriteMode $ \ h ->
+ do pid <- getProcessID
+ hPutStrLn h (show pid)
+
+ delPid' :: IO ()
+ delPid' = removeFile lockfile