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

4 files changed, 36 insertions, 5 deletions

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index d3885e89e..c960bb1b4 100644..100755
--- a/Remote/Directory.hs
+++ b/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
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 752d70d23..0cc4da40c 100644..100755
--- a/Remote/Git.hs
+++ b/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. -}
diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs
index 1aeb6cdcd..dfc543d0a 100644..100755
--- a/Remote/Helper/Hooks.hs
+++ b/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
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 1c4b1d112..768c15777 100755
--- a/Remote/Rsync.hs
+++ b/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