fill in a few windows stubs

This commit is contained in:
Joey Hess 2013-05-14 16:32:03 -05:00
parent 813d09678a
commit 959536ef03
2 changed files with 13 additions and 11 deletions

7
Git/Construct.hs Normal file → Executable file
View file

@ -34,6 +34,7 @@ import Network.URI
import Common import Common
import Git.Types import Git.Types
import Git import Git
import Git.FilePath
import qualified Git.Url as Url import qualified Git.Url as Url
import Utility.UserInfo import Utility.UserInfo
@ -58,8 +59,7 @@ fromPath dir = fromAbsPath =<< absPath dir
- specified. -} - specified. -}
fromAbsPath :: FilePath -> IO Repo fromAbsPath :: FilePath -> IO Repo
fromAbsPath dir fromAbsPath dir
| isAbsolute dir = | isAbsolute dir = ifM (doesDirectoryExist dir') ( ret dir' , hunt )
ifM (doesDirectoryExist dir') ( ret dir' , hunt )
| otherwise = | otherwise =
error $ "internal error, " ++ dir ++ " is not absolute" error $ "internal error, " ++ dir ++ " is not absolute"
where where
@ -146,7 +146,7 @@ fromRemoteLocation s repo = gen $ calcloc s
where where
gen v gen v
#ifdef __WINDOWS__ #ifdef __WINDOWS__
| dosstyle v = fromRemotePath v repo | dosstyle v = fromRemotePath (dospath v) repo
#endif #endif
| scpstyle v = fromUrl $ scptourl v | scpstyle v = fromUrl $ scptourl v
| urlstyle v = fromUrl v | urlstyle v = fromUrl v
@ -185,6 +185,7 @@ fromRemoteLocation s repo = gen $ calcloc s
-- git on Windows will write a path to .git/config with "drive:", -- git on Windows will write a path to .git/config with "drive:",
-- which is not to be confused with a "host:" -- which is not to be confused with a "host:"
dosstyle = hasDrive dosstyle = hasDrive
dospath = fromInternalGitPath
#endif #endif
{- Constructs a Repo from the path specified in the git remotes of {- Constructs a Repo from the path specified in the git remotes of

17
Utility/Daemon.hs Normal file → Executable file
View file

@ -15,6 +15,7 @@ import Utility.LogFile
#ifndef __WINDOWS__ #ifndef __WINDOWS__
import System.Posix import System.Posix
#else #else
import System.PosixCompat
import System.Posix.Types import System.Posix.Types
#endif #endif
@ -48,16 +49,16 @@ daemonize logfd pidfile changedirectory a = do
out out
out = exitImmediately ExitSuccess out = exitImmediately ExitSuccess
#else #else
daemonize = error "daemonize TODO" daemonize = error "daemonize is not implemented on Windows" -- TODO
#endif #endif
{- Locks the pid file, with an exclusive, non-blocking lock. {- Locks the pid file, with an exclusive, non-blocking lock.
- Writes the pid to the file, fully atomically. - Writes the pid to the file, fully atomically.
- Fails if the pid file is already locked by another process. -} - Fails if the pid file is already locked by another process. -}
lockPidFile :: FilePath -> IO () lockPidFile :: FilePath -> IO ()
#ifndef __WINDOWS__
lockPidFile file = do lockPidFile file = do
createDirectoryIfMissing True (parentDir file) createDirectoryIfMissing True (parentDir file)
#ifndef __WINDOWS__
fd <- openFd file ReadWrite (Just stdFileMode) defaultFileFlags fd <- openFd file ReadWrite (Just stdFileMode) defaultFileFlags
locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0) locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
fd' <- openFd newfile ReadWrite (Just stdFileMode) defaultFileFlags fd' <- openFd newfile ReadWrite (Just stdFileMode) defaultFileFlags
@ -68,13 +69,13 @@ lockPidFile file = do
(_, Nothing) -> alreadyRunning (_, Nothing) -> alreadyRunning
_ -> do _ -> do
_ <- fdWrite fd' =<< show <$> getProcessID _ <- fdWrite fd' =<< show <$> getProcessID
renameFile newfile file
closeFd fd closeFd fd
#else
writeFile newfile "-1"
#endif
renameFile newfile file
where where
newfile = file ++ ".new" newfile = file ++ ".new"
#else
lockPidFile = error "lockPidFile TODO"
#endif
alreadyRunning :: IO () alreadyRunning :: IO ()
alreadyRunning = error "Daemon is already running." alreadyRunning = error "Daemon is already running."
@ -104,7 +105,7 @@ checkDaemon pidfile = do
" (got " ++ show pid' ++ " (got " ++ show pid' ++
"; expected " ++ show pid ++ " )" "; expected " ++ show pid ++ " )"
#else #else
checkDaemon = error "checkDaemon TODO" checkDaemon pidfile = maybe Nothing readish <$> catchMaybeIO (readFile pidfile)
#endif #endif
{- Stops the daemon, safely. -} {- Stops the daemon, safely. -}
@ -115,5 +116,5 @@ stopDaemon pidfile = go =<< checkDaemon pidfile
go Nothing = noop go Nothing = noop
go (Just pid) = signalProcess sigTERM pid go (Just pid) = signalProcess sigTERM pid
#else #else
stopDaemon = error "stopDaemon TODO" stopDaemon = error "stopDaemon is not implemented on Windows" -- TODO
#endif #endif