fill in a few windows stubs
This commit is contained in:
parent
813d09678a
commit
959536ef03
2 changed files with 13 additions and 11 deletions
7
Git/Construct.hs
Normal file → Executable file
7
Git/Construct.hs
Normal file → Executable 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
17
Utility/Daemon.hs
Normal file → Executable 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
|
||||||
|
|
Loading…
Add table
Reference in a new issue