git-annex now builds on Windows (doesn't work)

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