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

Annex/Branch.hs

@@ -24,8 +24,10 @@ module Annex.Branch (
 ) where
 
 import qualified Data.ByteString.Lazy.Char8 as L
-#ifndef mingw32_HOST_OS
+#ifdef __ANDROID__
-import System.Posix.Env
+import System.Posix.Env (getEnv)
+#else
+import System.Environment (getEnvironment)
 #endif
 
 import Common.Annex
@@ -290,12 +292,14 @@ withIndex' bootstrapping a = do
 	f <- fromRepo gitAnnexIndex
 	g <- gitRepo
 #ifdef __ANDROID__
-	{- Work around for weird getEnvironment breakage on Android. See
+	{- This should not be necessary on Android, but there is some
+	 - weird getEnvironment breakage. See
 	 - https://github.com/neurocyte/ghc-android/issues/7
-	 - Instead, use getEnv to get some key environment variables that
+	 - Use getEnv to get some key environment variables that
 	 - git expects to have. -}
 	let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME"
-	let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k
+	let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> 
+		catchMaybeIO (getEnv k)
 	e <- liftIO $ catMaybes <$> forM keyenv getEnvPair
 #else
 	e <- liftIO getEnvironment

Annex/Content.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Annex.Content (
 	inAnnex,
 	inAnnexSafe,
@@ -31,6 +33,7 @@ module Annex.Content (
 ) where
 
 import System.IO.Unsafe (unsafeInterleaveIO)
+import System.PosixCompat.Files
 
 import Common.Annex
 import Logs.Location
@@ -84,14 +87,22 @@ inAnnexSafe = inAnnex' (fromMaybe False) (Just False) go
   where
 	go f = liftIO $ openforlock f >>= check
 	openforlock f = catchMaybeIO $
+#ifndef __WINDOWS__
 		openFd f ReadOnly Nothing defaultFileFlags
+#else
+		return ()
+#endif
 	check Nothing = return is_missing
 	check (Just h) = do
+#ifndef __WINDOWS__
 		v <- getLock h (ReadLock, AbsoluteSeek, 0, 0)
 		closeFd h
 		return $ case v of
 			Just _ -> is_locked
 			Nothing -> is_unlocked
+#else
+		return is_unlocked
+#endif
 	is_locked = Nothing
 	is_unlocked = Just True
 	is_missing = Just False
@@ -100,6 +111,9 @@ inAnnexSafe = inAnnex' (fromMaybe False) (Just False) go
  - it. (If the content is not present, no locking is done.) -}
 lockContent :: Key -> Annex a -> Annex a
 lockContent key a = do
+#ifdef __WINDOWS__
+	a
+#else
 	file <- calcRepo $ gitAnnexLocation key
 	bracketIO (openforlock file >>= lock) unlock a
   where
@@ -121,6 +135,7 @@ lockContent key a = do
 			Right _ -> return $ Just fd
 	unlock Nothing = noop
 	unlock (Just l) = closeFd l
+#endif
 
 {- Runs an action, passing it a temporary filename to get,
  - and if the action succeeds, moves the temp file into 

Annex/Content/Direct.hs

@@ -33,6 +33,8 @@ import Utility.TempFile
 import Logs.Location
 import Utility.InodeCache
 
+import System.PosixCompat.Files
+
 {- Absolute FilePaths of Files in the tree that are associated with a key. -}
 associatedFiles :: Key -> Annex [FilePath]
 associatedFiles key = do

Annex/Direct.hs

@@ -27,6 +27,8 @@ import Utility.InodeCache
 import Utility.CopyFile
 import Annex.Perms
 
+import System.PosixCompat.Files
+
 {- Uses git ls-files to find files that need to be committed, and stages
  - them into the index. Returns True if some changes were staged. -}
 stageDirect :: Annex Bool

Annex/Environment.hs

@@ -10,10 +10,12 @@
 module Annex.Environment where
 
 import Common.Annex
+#ifndef __WINDOWS__
 import Utility.UserInfo
+#endif
 import qualified Git.Config
 
-#ifndef mingw32_HOST_OS
+#ifndef __WINDOWS__
 import System.Posix.Env
 #endif
 import Network.BSD
@@ -28,7 +30,10 @@ checkEnvironment = do
 		liftIO checkEnvironmentIO
 
 checkEnvironmentIO :: IO ()
-checkEnvironmentIO = do
+checkEnvironmentIO =
+#ifdef __WINDOWS__
+	noop
+#else
 	whenM (null <$> myUserGecos) $ do
 		username <- myUserName
 		ensureEnv "GIT_AUTHOR_NAME" username
@@ -42,3 +47,4 @@ checkEnvironmentIO = do
 	-- in runshell instead.
 	ensureEnv _ _ = noop
 #endif
+#endif

Annex/Journal.hs

@@ -9,6 +9,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Annex.Journal where
 
 import System.IO.Binary
@@ -77,13 +79,23 @@ fileJournal = replace "//" "_" . replace "_" "/"
  - contention with other git-annex processes. -}
 lockJournal :: Annex a -> Annex a
 lockJournal a = do
-	file <- fromRepo gitAnnexJournalLock
+	lockfile <- fromRepo gitAnnexJournalLock
-	createAnnexDirectory $ takeDirectory file
+	createAnnexDirectory $ takeDirectory lockfile
 	mode <- annexFileMode
-	bracketIO (lock file mode) unlock a
+	bracketIO (lock lockfile mode) unlock a
   where
-	lock file mode = do
+	lock lockfile mode = do
-		l <- noUmask mode $ createFile file mode
+#ifndef __WINDOWS__
+		l <- noUmask mode $ createFile lockfile mode
 		waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0)
 		return l
+#else
+		writeFile lockfile ""
+		return lockfile
+#endif
+#ifndef __WINDOWS__
 	unlock = closeFd
+#else
+	unlock = removeFile
+#endif
+

Annex/Link.hs

@@ -19,6 +19,8 @@ import qualified Git.UpdateIndex
 import qualified Annex.Queue
 import Git.Types
 
+import System.PosixCompat.Files
+
 type LinkTarget = String
 
 {- Checks if a file is a link to a key. -}

Annex/LockPool.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Annex.LockPool where
 
 import qualified Data.Map as M
@@ -20,17 +22,24 @@ lockFile file = go =<< fromPool file
   where
 	go (Just _) = noop -- already locked
 	go Nothing = do
+#ifndef __WINDOWS__
 		mode <- annexFileMode
 		fd <- liftIO $ noUmask mode $
 			openFd file ReadOnly (Just mode) defaultFileFlags
 		liftIO $ waitToSetLock fd (ReadLock, AbsoluteSeek, 0, 0)
+#else
+		liftIO $ writeFile file ""
+		let fd = 0
+#endif
 		changePool $ M.insert file fd
 
 unlockFile :: FilePath -> Annex ()
 unlockFile file = maybe noop go =<< fromPool file
   where
 	go fd = do
+#ifndef __WINDOWS__
 		liftIO $ closeFd fd
+#endif
 		changePool $ M.delete file
 
 getPool :: Annex (M.Map FilePath Fd)

Annex/Perms.hs

@@ -22,6 +22,7 @@ import qualified Annex
 import Config
 
 import System.Posix.Types
+import System.PosixCompat.Files
 
 withShared :: (SharedRepository -> Annex a) -> Annex a
 withShared a = maybe startup a =<< Annex.getState Annex.shared

Annex/Ssh.hs

@@ -14,7 +14,7 @@ module Annex.Ssh (
 ) where
 
 import qualified Data.Map as M
-#ifndef mingw32_HOST_OS
+#ifndef __WINDOWS__
 import System.Posix.Env
 #endif
 
@@ -78,7 +78,11 @@ sshCacheDir
 		)
 	| otherwise = return Nothing
   where
+#ifndef __WINDOWS__
 	gettmpdir = liftIO $ getEnv "GIT_ANNEX_TMP_DIR"
+#else
+	gettmpdir = return Nothing
+#endif
 	usetmpdir tmpdir = liftIO $ catchMaybeIO $ do
 		createDirectoryIfMissing True tmpdir
 		return tmpdir
@@ -97,6 +101,7 @@ sshCleanup = go =<< sshCacheDir
 			liftIO (catchDefaultIO [] $ dirContents dir)
 		forM_ sockets cleanup
 	cleanup socketfile = do
+#ifndef __WINDOWS__
 		-- Drop any shared lock we have, and take an
 		-- exclusive lock, without blocking. If the lock
 		-- succeeds, nothing is using this ssh, and it can
@@ -112,6 +117,9 @@ sshCleanup = go =<< sshCacheDir
 			Left _ -> noop
 			Right _ -> stopssh socketfile
 		liftIO $ closeFd fd
+#else
+		stopssh socketfile
+#endif
 	stopssh socketfile = do
 		let (host, port) = socket2hostport socketfile
 		(_, params) <- sshInfo (host, port)

Annex/Version.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Annex.Version where
 
 import Common.Annex
@@ -23,7 +25,11 @@ supportedVersions :: [Version]
 supportedVersions = [defaultVersion, directModeVersion]
 
 upgradableVersions :: [Version]
+#ifndef __WINDOWS__
 upgradableVersions = ["0", "1", "2"]
+#else
+upgradableVersions = ["2"]
+#endif
 
 versionField :: ConfigKey
 versionField = annexConfig "version"

Backend/SHA.hs

@@ -18,6 +18,7 @@ import qualified Build.SysConfig as SysConfig
 import Data.Digest.Pure.SHA
 import qualified Data.ByteString.Lazy as L
 import Data.Char
+import System.PosixCompat.Files
 
 type SHASize = Int
 

Backend/WORM.hs

@@ -12,6 +12,8 @@ import Types.Backend
 import Types.Key
 import Types.KeySource
 
+import System.PosixCompat.Files
+
 backends :: [Backend]
 backends = [backend]
 

CmdLine.hs

@@ -17,7 +17,7 @@ import qualified Control.Exception as E
 import qualified Data.Map as M
 import Control.Exception (throw)
 import System.Console.GetOpt
-#ifndef mingw32_HOST_OS
+#ifndef __WINDOWS__
 import System.Posix.Signals
 #endif
 
@@ -118,7 +118,9 @@ tryRun' errnum state cmd (a:as) = do
 {- Actions to perform each time ran. -}
 startup :: Annex Bool
 startup = liftIO $ do
+#ifndef __WINDOWS__
 	void $ installHandler sigINT Default Nothing
+#endif
 	return True
 
 {- Cleanup actions. -}

Command/Add.hs

@@ -9,6 +9,8 @@
 
 module Command.Add where
 
+import System.PosixCompat.Files
+
 import Common.Annex
 import Annex.Exception
 import Command

Command/Fix.hs

@@ -7,6 +7,8 @@
 
 module Command.Fix where
 
+import System.PosixCompat.Files
+
 import Common.Annex
 import Command
 import qualified Annex.Queue

Command/FromKey.hs

@@ -7,6 +7,8 @@
 
 module Command.FromKey where
 
+import System.PosixCompat.Files
+
 import Common.Annex
 import Command
 import qualified Annex.Queue

Command/Fsck.hs

@@ -9,6 +9,8 @@
 
 module Command.Fsck where
 
+import System.PosixCompat.Files
+
 import Common.Annex
 import Command
 import qualified Annex
@@ -30,8 +32,10 @@ import qualified Option
 import Types.Key
 import Utility.HumanTime
 
-#ifndef mingw32_HOST_OS
+#ifndef __WINDOWS__
 import System.Posix.Process (getProcessID)
+#else
+import System.Random (getStdRandom, random)
 #endif
 import Data.Time.Clock.POSIX
 import Data.Time
@@ -142,10 +146,14 @@ performRemote key file backend numcopies remote =
 		, checkKeyNumCopies key file numcopies
 		]
 	withtmp a = do
-		pid <- liftIO getProcessID
+#ifndef __WINDOWS__
+		v <- liftIO getProcessID
+#else
+		v <- liftIO (getStdRandom random :: IO Int)
+#endif
 		t <- fromRepo gitAnnexTmpDir
 		createAnnexDirectory t
-		let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key
+		let tmp = t </> "fsck" ++ show v ++ "." ++ keyFile key
 		let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
 		cleanup
 		cleanup `after` a tmp
@@ -453,7 +461,9 @@ recordFsckTime key = do
 	parent <- parentDir <$> calcRepo (gitAnnexLocation key)
 	liftIO $ void $ tryIO $ do
 		touchFile parent
+#ifndef __WINDOWS__
 		setSticky parent
+#endif
 
 getFsckTime :: Key -> Annex (Maybe EpochTime)
 getFsckTime key = do

Command/Import.hs

@@ -7,6 +7,8 @@
 
 module Command.Import where
 
+import System.PosixCompat.Files
+
 import Common.Annex
 import Command
 import qualified Annex

Command/Indirect.hs

@@ -7,6 +7,8 @@
 
 module Command.Indirect where
 
+import System.PosixCompat.Files
+
 import Common.Annex
 import Command
 import qualified Git

Command/ReKey.hs

@@ -7,6 +7,8 @@
 
 module Command.ReKey where
 
+import System.PosixCompat.Files
+
 import Common.Annex
 import Command
 import qualified Annex

Command/RecvKey.hs

@@ -7,6 +7,8 @@
 
 module Command.RecvKey where
 
+import System.PosixCompat.Files
+
 import Common.Annex
 import Command
 import CmdLine

Command/Status.hs

@@ -13,6 +13,7 @@ import "mtl" Control.Monad.State.Strict
 import qualified Data.Map as M
 import Text.JSON
 import Data.Tuple
+import System.PosixCompat.Files
 
 import Common.Annex
 import qualified Types.Backend as B

Command/TransferKeys.hs

@@ -9,6 +9,8 @@
 
 module Command.TransferKeys where
 
+import System.PosixCompat.Files
+
 import Common.Annex
 import Command
 import Annex.Content

Command/Unannex.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Command.Unannex where
 
 import Common.Annex
@@ -58,6 +60,9 @@ cleanup file key = do
 
 	return True
   where
+#ifdef __WINDOWS__
+	goFast = go
+#else
 	goFast = do
 		-- fast mode: hard link to content in annex
 		src <- calcRepo $ gitAnnexLocation key
@@ -66,6 +71,7 @@ cleanup file key = do
 			( thawContent file
 			, go
 			)
+#endif
 	go = do
 		fromAnnex key file
 		logStatus key InfoMissing

Creds.hs

@@ -109,12 +109,16 @@ getEnvCredPair storage = liftM2 (,)
 
 {- Stores a CredPair in the environment. -}
 setEnvCredPair :: CredPair -> CredPairStorage -> IO ()
+#ifndef __WINDOWS__
 setEnvCredPair (l, p) storage = do
 	set uenv l
 	set penv p
   where
 	(uenv, penv) = credPairEnvironment storage
 	set var val = setEnv var val True
+#else
+setEnvCredPair _ _ = error "setEnvCredPair TODO"
+#endif
 
 writeCacheCredPair :: CredPair -> CredPairStorage -> Annex ()
 writeCacheCredPair credpair storage =

Git.hs

@@ -32,7 +32,7 @@ module Git (
 ) where
 
 import Network.URI (uriPath, uriScheme, unEscapeString)
-#ifndef mingw32_HOST_OS
+#ifndef __WINDOWS__
 import System.Posix.Files
 #endif
 

Git/Construct.hs

@@ -23,7 +23,7 @@ module Git.Construct (
 	checkForRepo,
 ) where
 
-#ifndef mingw32_HOST_OS
+#ifndef __WINDOWS__
 import System.Posix.User
 #endif
 import qualified Data.Map as M hiding (map, split)
@@ -196,6 +196,9 @@ repoAbsPath d = do
 	return $ h </> d'
 
 expandTilde :: FilePath -> IO FilePath
+#ifdef __WINDOWS__
+expandTilde = return
+#else
 expandTilde = expandt True
   where
 	expandt _ [] = return ""
@@ -216,6 +219,7 @@ expandTilde = expandt True
 	findname n (c:cs)
 		| c == '/' = (n, cs)
 		| otherwise = findname (n++[c]) cs
+#endif
 
 {- Checks if a git repository exists in a directory. Does not find
  - git repositories in parent directories. -}

Git/CurrentRepo.hs

@@ -9,7 +9,7 @@
 
 module Git.CurrentRepo where
 
-#ifndef mingw32_HOST_OS
+#ifndef __WINDOWS__
 import System.Posix.Directory (changeWorkingDirectory)
 import System.Posix.Env (getEnv, unsetEnv)
 #endif
@@ -39,18 +39,24 @@ get = do
 	case wt of
 		Nothing -> return r
 		Just d -> do
+#ifndef __WINDOWS__
 			cwd <- getCurrentDirectory
 			unless (d `dirContains` cwd) $
 				changeWorkingDirectory d
+#endif
 			return $ addworktree wt r
   where
 	pathenv s = do
+#ifndef __WINDOWS__
 		v <- getEnv s
 		case v of
 			Just d -> do
 				unsetEnv s
 				Just <$> absPath d
 			Nothing -> return Nothing
+#else
+		return Nothing
+#endif
 
 	configure Nothing (Just r) = Git.Config.read r
 	configure (Just d) _ = do

GitAnnex.hs

@@ -23,7 +23,9 @@ import qualified Command.Get
 import qualified Command.FromKey
 import qualified Command.DropKey
 import qualified Command.TransferKey
+#ifndef __WINDOWS__
 import qualified Command.TransferKeys
+#endif
 import qualified Command.ReKey
 import qualified Command.Reinject
 import qualified Command.Fix
@@ -73,8 +75,10 @@ import qualified Command.XMPPGit
 #endif
 #endif
 #ifdef WITH_TESTSUITE
+#ifndef __WINDOWS__
 import qualified Command.Test
 #endif
+#endif
 
 cmds :: [Command]
 cmds = concat
@@ -107,7 +111,9 @@ cmds = concat
 	, Command.FromKey.def
 	, Command.DropKey.def
 	, Command.TransferKey.def
+#ifndef __WINDOWS__
 	, Command.TransferKeys.def
+#endif
 	, Command.ReKey.def
 	, Command.Fix.def
 	, Command.Fsck.def
@@ -137,7 +143,9 @@ cmds = concat
 #endif
 #endif
 #ifdef WITH_TESTSUITE
+#ifndef __WINDOWS__
 	, Command.Test.def
+#endif
 #endif
 	]
 

GitAnnexShell.hs

@@ -5,13 +5,9 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
-
 module GitAnnexShell where
 
-#ifndef mingw32_HOST_OS
+import System.Environment
-import System.Posix.Env
-#endif
 import System.Console.GetOpt
 
 import Common.Annex
@@ -149,7 +145,7 @@ checkNotReadOnly cmd
 
 checkDirectory :: Maybe FilePath -> IO ()
 checkDirectory mdir = do
-	v <- getEnv "GIT_ANNEX_SHELL_DIRECTORY"
+	v <- catchMaybeIO $ getEnv "GIT_ANNEX_SHELL_DIRECTORY"
 	case (v, mdir) of
 		(Nothing, _) -> noop
 		(Just d, Nothing) -> req d Nothing
@@ -179,7 +175,7 @@ checkDirectory mdir = do
 
 checkEnv :: String -> IO ()
 checkEnv var = do
-	v <- getEnv var
+	v <- catchMaybeIO $ getEnv var
 	case v of
 		Nothing -> noop
 		Just "" -> noop

Init.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Init (
 	ensureInitialized,
 	isInitialized,
@@ -34,11 +36,15 @@ import Backend
 genDescription :: Maybe String -> Annex String
 genDescription (Just d) = return d
 genDescription Nothing = do
+	reldir <- liftIO . relHome =<< fromRepo Git.repoPath
 	hostname <- fromMaybe "" <$> liftIO getHostname
+#ifndef __WINDOWS__
 	let at = if null hostname then "" else "@"
 	username <- liftIO myUserName
-	reldir <- liftIO . relHome =<< fromRepo Git.repoPath
 	return $ concat [username, at, hostname, ":", reldir]
+#else
+	return $ concat [hostname, ":", reldir]
+#endif
 
 initialize :: Maybe String -> Annex ()
 initialize mdescription = do
@@ -113,6 +119,9 @@ preCommitScript = unlines
 
 probeCrippledFileSystem :: Annex Bool
 probeCrippledFileSystem = do
+#ifdef __WINDOWS__
+	return True
+#else
 	tmp <- fromRepo gitAnnexTmpDir
 	let f = tmp </> "gaprobe"
 	liftIO $ do
@@ -132,6 +141,7 @@ probeCrippledFileSystem = do
 		preventWrite f
 		allowWrite f
 		return True
+#endif
 
 checkCrippledFileSystem :: Annex ()
 checkCrippledFileSystem = whenM probeCrippledFileSystem $ do
@@ -149,6 +159,9 @@ checkCrippledFileSystem = whenM probeCrippledFileSystem $ do
 
 probeFifoSupport :: Annex Bool
 probeFifoSupport = do
+#ifdef __WINDOWS__
+	return False
+#else
 	tmp <- fromRepo gitAnnexTmpDir
 	let f = tmp </> "gaprobe"
 	liftIO $ do
@@ -159,6 +172,7 @@ probeFifoSupport = do
 			getFileStatus f
 		nukeFile f
 		return $ either (const False) isNamedPipe ms
+#endif
 
 checkFifoSupport :: Annex ()
 checkFifoSupport = unlessM probeFifoSupport $ do

Limit.hs

@@ -19,6 +19,7 @@ import Text.Regex.TDFA.String
 #else
 import System.Path.WildMatch
 #endif
+import System.PosixCompat.Files
 
 import Common.Annex
 import qualified Annex

Logs/Transfer.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Logs.Transfer where
 
 import Common.Annex
@@ -18,6 +20,7 @@ import Utility.Percentage
 import Utility.QuickCheck
 
 import System.Posix.Types
+import System.PosixCompat.Files
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
 import Data.Time
@@ -122,6 +125,7 @@ runTransfer t file shouldretry a = do
 	return ok
   where
 	prep tfile mode info = do
+#ifndef __WINDOWS__
 		mfd <- catchMaybeIO $
 			openFd (transferLockFile tfile) ReadWrite (Just mode)
 				defaultFileFlags { trunc = True }
@@ -134,11 +138,18 @@ runTransfer t file shouldretry a = do
 					error "transfer already in progress"
 				void $ tryIO $ writeTransferInfoFile info tfile
 				return mfd
+#else
+		catchMaybeIO $ do
+			writeFile (transferLockFile tfile) ""
+			writeTransferInfoFile info tfile
+#endif
 	cleanup _ Nothing = noop
 	cleanup tfile (Just fd) = do
 		void $ tryIO $ removeFile tfile
 		void $ tryIO $ removeFile $ transferLockFile tfile
+#ifndef __WINDOWS__
 		closeFd fd
+#endif
 	retry oldinfo metervar run = do
 		v <- tryAnnex run
 		case v of
@@ -195,8 +206,9 @@ startTransferInfo file = TransferInfo
 {- If a transfer is still running, returns its TransferInfo. -}
 checkTransfer :: Transfer -> Annex (Maybe TransferInfo)
 checkTransfer t = do
-	mode <- annexFileMode
 	tfile <- fromRepo $ transferFile t
+#ifndef __WINDOWS__
+	mode <- annexFileMode
 	mfd <- liftIO $ catchMaybeIO $
 		openFd (transferLockFile tfile) ReadOnly (Just mode) defaultFileFlags
 	case mfd of
@@ -209,6 +221,13 @@ checkTransfer t = do
 				Nothing -> return Nothing
 				Just (pid, _) -> liftIO $ catchDefaultIO Nothing $
 					readTransferInfoFile (Just pid) tfile
+#else
+	ifM (liftIO $ doesFileExist $ transferLockFile tfile)
+		( liftIO $ catchDefaultIO Nothing $
+			readTransferInfoFile Nothing tfile
+		, return Nothing
+		)
+#endif
 
 {- Gets all currently running transfers. -}
 getTransfers :: Annex [(Transfer, TransferInfo)]

Remote/Directory.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Remote.Directory (remote) where
 
 import qualified Data.ByteString.Lazy as L
@@ -217,10 +219,14 @@ retrieveEncrypted d chunksize (cipher, enck) k f p = metered (Just p) k $ \meter
 
 retrieveCheap :: FilePath -> ChunkSize -> Key -> FilePath -> Annex Bool
 retrieveCheap _ (Just _) _ _ = return False -- no cheap retrieval for chunks
+#ifndef __WINDOWS__
 retrieveCheap d _ k f = liftIO $ withStoredFiles Nothing d k go
   where
 	go [file] = catchBoolIO $ createSymbolicLink file f >> return True
 	go _files = return False
+#else
+retrieveCheap _ _ _ _ = return False
+#endif
 
 remove :: FilePath -> Key -> Annex Bool
 remove d k = liftIO $ do

Remote/Git.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Remote.Git (
 	remote,
 	configRead,
@@ -341,6 +343,7 @@ copyFromRemote' r key file dest
 
 copyFromRemoteCheap :: Remote -> Key -> FilePath -> Annex Bool
 copyFromRemoteCheap r key file
+#ifndef __WINDOWS__
 	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do
 		loc <- liftIO $ gitAnnexLocation key (repo r) $
 			fromJust $ remoteGitConfig $ gitconfig r
@@ -350,6 +353,7 @@ copyFromRemoteCheap r key file
 			( copyFromRemote' r key Nothing file
 			, return False
 			)
+#endif
 	| otherwise = return False
 
 {- Tries to copy a key's content to a remote's annex. -}
@@ -396,12 +400,14 @@ rsyncHelper callback params = do
  - filesystem. Then cp could be faster. -}
 rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> MeterUpdate -> Annex Bool
 rsyncOrCopyFile rsyncparams src dest p =
+#ifdef __WINDOWS__
+	dorsync
+  where
+#else
 	ifM (sameDeviceIds src dest) (docopy, dorsync)
   where
 	sameDeviceIds a b = (==) <$> (getDeviceId a) <*> (getDeviceId b)
 	getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f)
-	dorsync = rsyncHelper (Just p) $
-		rsyncparams ++ [Param src, Param dest]
 	docopy = liftIO $ bracket
 		(forkIO $ watchfilesize zeroBytesProcessed)
 		(void . tryIO . killThread)
@@ -417,6 +423,9 @@ rsyncOrCopyFile rsyncparams src dest p =
 					p sz
 					watchfilesize sz
 			_ -> watchfilesize oldsz
+#endif
+	dorsync = rsyncHelper (Just p) $
+		rsyncparams ++ [Param src, Param dest]
 
 {- Generates rsync parameters that ssh to the remote and asks it
  - to either receive or send the key's content. -}

Remote/Helper/Hooks.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Remote.Helper.Hooks (addHooks) where
 
 import qualified Data.Map as M
@@ -70,6 +72,7 @@ runHooks r starthook stophook a = do
 
 		Annex.addCleanup (remoteid ++ "-stop-command") $ runstop lck
 	runstop lck = do
+#ifndef __WINDOWS__
 		-- Drop any shared lock we have, and take an
 		-- exclusive lock, without blocking. If the lock
 		-- succeeds, we're the only process using this remote,
@@ -84,3 +87,6 @@ runHooks r starthook stophook a = do
 			Left _ -> noop
 			Right _ -> run stophook
 		liftIO $ closeFd fd
+#else
+		run stophook
+#endif

Remote/Rsync.hs

@@ -11,8 +11,10 @@ module Remote.Rsync (remote) where
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
-#ifndef mingw32_HOST_OS
+#ifndef __WINDOWS__
 import System.Posix.Process (getProcessID)
+#else
+import System.Random (getStdRandom, random)
 #endif
 
 import Common.Annex
@@ -219,10 +221,14 @@ sendParams = ifM crippledFileSystem
  - up trees for rsync. -}
 withRsyncScratchDir :: (FilePath -> Annex Bool) -> Annex Bool
 withRsyncScratchDir a = do
-	pid <- liftIO getProcessID
+#ifndef __WINDOWS__
+	v <- liftIO getProcessID
+#else
+	v <- liftIO (getStdRandom random :: IO Int)
+#endif
 	t <- fromRepo gitAnnexTmpDir
 	createAnnexDirectory t
-	let tmp = t </> "rsynctmp" </> show pid
+	let tmp = t </> "rsynctmp" </> show v
 	nuke tmp
 	liftIO $ createDirectoryIfMissing True tmp
 	nuke tmp `after` a tmp
@@ -273,8 +279,12 @@ rsyncSend o callback k canrename src = withRsyncScratchDir $ \tmp -> do
 		else ifM crippledFileSystem
 			( liftIO $ copyFileExternal src dest
 			, do
+#ifndef __WINDOWS__
 				liftIO $ createLink src dest
 				return True
+#else
+				liftIO $ copyFileExternal src dest
+#endif
 			)
 	ps <- sendParams
 	if ok

Seek.hs

@@ -11,6 +11,8 @@
 
 module Seek where
 
+import System.PosixCompat.Files
+
 import Common.Annex
 import Types.Command
 import Types.Key

Test.hs

@@ -5,19 +5,15 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
-
 module Test where
 
 import Test.HUnit
 import Test.QuickCheck
 import Test.QuickCheck.Test
 
-#ifndef mingw32_HOST_OS
 import System.Posix.Directory (changeWorkingDirectory)
 import System.Posix.Files
 import System.Posix.Env
-#endif
 import Control.Exception.Extensible
 import qualified Data.Map as M
 import System.IO.HVFS (SystemFS(..))

Upgrade.hs

@@ -5,18 +5,27 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Upgrade where
 
 import Common.Annex
 import Annex.Version
+#ifndef __WINDOWS__
 import qualified Upgrade.V0
 import qualified Upgrade.V1
+#endif
 import qualified Upgrade.V2
 
 upgrade :: Annex Bool
 upgrade = go =<< getVersion
   where
+#ifndef __WINDOWS__
 	go (Just "0") = Upgrade.V0.upgrade
 	go (Just "1") = Upgrade.V1.upgrade
+#else
+	go (Just "0") = error "upgrade from v0 on Windows not supported"
+	go (Just "1") = error "upgrade from v1 on Windows not supported"
+#endif
 	go (Just "2") = Upgrade.V2.upgrade
 	go _ = return True

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

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

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.

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

Utility/LogFile.hs

@@ -11,15 +11,18 @@ module Utility.LogFile where
 
 import Common
 
-#ifndef mingw32_HOST_OS
+import System.Posix.Types
-import System.Posix
+import System.PosixCompat.Files
-#endif
 
 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

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

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
 

Utility/UserInfo.hs

@@ -14,45 +14,31 @@ module Utility.UserInfo (
 ) where
 
 import Control.Applicative
-#ifndef mingw32_HOST_OS
+import System.Posix.Types
-import System.Posix.User
+import System.PosixCompat
-import System.Posix.Env
+
-#endif
+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

git-annex.hs

@@ -13,7 +13,10 @@ import System.FilePath
 import qualified GitAnnex
 import qualified GitAnnexShell
 #ifdef WITH_TESTSUITE
+#ifndef __WINDOWS__
 import qualified Test
+#define CHECK_TEST
+#endif
 #endif
 
 main :: IO ()
@@ -25,7 +28,7 @@ main = run =<< getProgName
 	isshell n = takeFileName n == "git-annex-shell"
 	go a = do
 		ps <- getArgs
-#ifdef WITH_TESTSUITE
+#ifdef CHECK_TEST
 		if ps == ["test"]
 			then Test.main
 			else a ps