diff options
Diffstat (limited to 'Utility')
| -rwxr-xr-x | Utility/Daemon.hs | 19 | ||||
| -rwxr-xr-x | Utility/Env.hs | 39 | ||||
| -rwxr-xr-x | Utility/FileMode.hs | 2 | ||||
| -rwxr-xr-x[-rw-r--r--] | Utility/InodeCache.hs | 3 | ||||
| -rwxr-xr-x | Utility/LogFile.hs | 17 | ||||
| -rwxr-xr-x | Utility/Misc.hs | 4 | ||||
| -rwxr-xr-x[-rw-r--r--] | Utility/Url.hs | 1 | ||||
| -rwxr-xr-x | Utility/UserInfo.hs | 22 |
8 files changed, 82 insertions, 25 deletions
diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index fb8c61f75..a01b078b8 100755 --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -12,9 +12,10 @@ module Utility.Daemon where import Common import Utility.LogFile -#ifndef mingw32_HOST_OS +#ifndef __WINDOWS__ import System.Posix #endif +import System.Posix.Types {- Run an action as a daemon, with all output sent to a file descriptor. - @@ -23,6 +24,7 @@ import System.Posix - - When successful, does not return. -} daemonize :: Fd -> Maybe FilePath -> Bool -> IO () -> IO () +#ifndef __WINDOWS__ daemonize logfd pidfile changedirectory a = do maybe noop checkalreadyrunning pidfile _ <- forkProcess child1 @@ -44,11 +46,15 @@ daemonize logfd pidfile changedirectory a = do a out out = exitImmediately ExitSuccess +#else +daemonize = error "daemonize TODO" +#endif {- Locks the pid file, with an exclusive, non-blocking lock. - Writes the pid to the file, fully atomically. - Fails if the pid file is already locked by another process. -} lockPidFile :: FilePath -> IO () +#ifndef __WINDOWS__ lockPidFile file = do createDirectoryIfMissing True (parentDir file) fd <- openFd file ReadWrite (Just stdFileMode) defaultFileFlags @@ -65,6 +71,9 @@ lockPidFile file = do closeFd fd where newfile = file ++ ".new" +#else +lockPidFile = error "lockPidFile TODO" +#endif alreadyRunning :: IO () alreadyRunning = error "Daemon is already running." @@ -74,6 +83,7 @@ alreadyRunning = error "Daemon is already running." - - If it's running, returns its pid. -} checkDaemon :: FilePath -> IO (Maybe ProcessID) +#ifndef __WINDOWS__ checkDaemon pidfile = do v <- catchMaybeIO $ openFd pidfile ReadOnly (Just stdFileMode) defaultFileFlags @@ -92,10 +102,17 @@ checkDaemon pidfile = do "stale pid in " ++ pidfile ++ " (got " ++ show pid' ++ "; expected " ++ show pid ++ " )" +#else +checkDaemon = error "checkDaemon TODO" +#endif {- Stops the daemon, safely. -} stopDaemon :: FilePath -> IO () +#ifndef __WINDOWS__ stopDaemon pidfile = go =<< checkDaemon pidfile where go Nothing = noop go (Just pid) = signalProcess sigTERM pid +#else +stopDaemon = error "stopDaemon TODO" +#endif diff --git a/Utility/Env.hs b/Utility/Env.hs new file mode 100755 index 000000000..713360154 --- /dev/null +++ b/Utility/Env.hs @@ -0,0 +1,39 @@ +{- portable environment variables + - + - Copyright 2013 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Utility.Env where + +#ifdef __WINDOWS__ +import qualified System.Environment as E +import Utility.Exception +#else +import qualified System.Posix.Environment as E +#endif + +{- Posix getEnv is faster than the one in System.Environment, + - so use when available. -} +getEnv :: String -> IO (Maybe String) +#ifndef __WINDOWS__ +getEnv = E.getEnv +#else +getEnv = catchMaybeIO . E.getEnv +#endif + +{- Returns True if it could successfully set the environment variable. + - + - There is, apparently, no way to do this in Windows. Instead, + - environment varuables must be provided when running a new process. -} +setEnv :: String -> String -> IO Bool +#ifndef __WINDOWS__ +setEnv var val = do + E.setEnv var val + return True +#else +setEnv _ _ = return False +#endif diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index b63575499..e9701d967 100755 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -113,10 +113,10 @@ isSticky = checkMode stickyMode stickyMode :: FileMode stickyMode = 512 -#endif setSticky :: FilePath -> IO () setSticky f = modifyFileMode f $ addModes [stickyMode] +#endif {- Writes a file, ensuring that its modes do not allow it to be read - by anyone other than the current user, before any content is written. diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs index e08abc6ad..ec0f206d3 100644..100755 --- a/Utility/InodeCache.hs +++ b/Utility/InodeCache.hs @@ -8,7 +8,8 @@ module Utility.InodeCache where import Common -import System.Posix.Types +import System.PosixCompat.Types +import System.PosixCompat.Files import Utility.QuickCheck data InodeCachePrim = InodeCachePrim FileID FileOffset EpochTime diff --git a/Utility/LogFile.hs b/Utility/LogFile.hs index c6faee028..ccda429fc 100755 --- a/Utility/LogFile.hs +++ b/Utility/LogFile.hs @@ -11,15 +11,18 @@ module Utility.LogFile where import Common -#ifndef mingw32_HOST_OS -import System.Posix -#endif +import System.Posix.Types +import System.PosixCompat.Files openLog :: FilePath -> IO Fd +#ifndef __WINDOWS__ openLog logfile = do rotateLog logfile openFd logfile WriteOnly (Just stdFileMode) defaultFileFlags { append = True } +#else +openLog = error "openLog TODO" +#endif rotateLog :: FilePath -> IO () rotateLog logfile = go 0 @@ -48,11 +51,19 @@ maxLogs :: Int maxLogs = 9 redirLog :: Fd -> IO () +#ifndef __WINDOWS__ redirLog logfd = do mapM_ (redir logfd) [stdOutput, stdError] closeFd logfd +#else +redirLog _ = error "redirLog TODO" +#endif +#ifndef __WINDOWS__ redir :: Fd -> Fd -> IO () redir newh h = do closeFd h void $ dupTo newh h +#else +redir _ _ = error "redir TODO" +#endif diff --git a/Utility/Misc.hs b/Utility/Misc.hs index da4da0a60..39d0e3de0 100755 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -122,16 +122,18 @@ hGetSomeString h sz = do peekbytes :: Int -> Ptr Word8 -> IO [Word8] peekbytes len buf = mapM (peekElemOff buf) [0..pred len] -#ifndef mingw32_HOST_OS {- Reaps any zombie git processes. - - Warning: Not thread safe. Anything that was expecting to wait - on a process and get back an exit status is going to be confused - if this reap gets there first. -} reapZombies :: IO () +#ifndef mingw32_HOST_OS reapZombies = do -- throws an exception when there are no child processes catchDefaultIO Nothing (getAnyProcessStatus False True) >>= maybe (return ()) (const reapZombies) +#else +reapZombies = return () #endif diff --git a/Utility/Url.hs b/Utility/Url.hs index b831b3f01..97862e370 100644..100755 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -20,6 +20,7 @@ import Network.URI import qualified Network.Browser as Browser import Network.HTTP import Data.Either +import System.PosixCompat.Files import qualified Build.SysConfig diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs index c0925ecb8..9781f584e 100755 --- a/Utility/UserInfo.hs +++ b/Utility/UserInfo.hs @@ -14,45 +14,31 @@ module Utility.UserInfo ( ) where import Control.Applicative -#ifndef mingw32_HOST_OS -import System.Posix.User -import System.Posix.Env -#endif +import System.Posix.Types +import System.PosixCompat + +import Utility.Env {- Current user's home directory. - - getpwent will fail on LDAP or NIS, so use HOME if set. -} myHomeDir :: IO FilePath -#ifndef mingw32_HOST_OS myHomeDir = myVal ["HOME"] homeDirectory -#else -myHomeDir = error "myHomeDir TODO" -#endif {- Current user's user name. -} myUserName :: IO String -#ifndef mingw32_HOST_OS myUserName = myVal ["USER", "LOGNAME"] userName -#else -myUserName = error "myUserName TODO" -#endif myUserGecos :: IO String #ifdef __ANDROID__ myUserGecos = return "" -- userGecos crashes on Android #else -#ifndef mingw32_HOST_OS myUserGecos = myVal [] userGecos -#else -myUserGecos = error "myUserGecos TODO" -#endif #endif -#ifndef mingw32_HOST_OS myVal :: [String] -> (UserEntry -> String) -> IO String myVal envvars extract = maybe (extract <$> getpwent) return =<< check envvars where check [] = return Nothing check (v:vs) = maybe (check vs) (return . Just) =<< getEnv v getpwent = getUserEntryForID =<< getEffectiveUserID -#endif |