build assistant and watcher on windows (doesn't work yet)

Assistant.hs

@@ -69,6 +69,7 @@ startDaemon assistant foreground startdelay listenhost startbrowser = do
 	pidfile <- fromRepo gitAnnexPidFile
 	logfile <- fromRepo gitAnnexLogFile
 	logfd <- liftIO $ openLog logfile
+#ifndef mingw32_HOST_OS
 	if foreground
 		then do
 			origout <- liftIO $ catchMaybeIO $ 
@@ -86,6 +87,13 @@ startDaemon assistant foreground startdelay listenhost startbrowser = do
 					Just a -> Just $ a origout origerr
 		else
 			start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing
+#else
+	-- Windows is always foreground, and has no log file.
+	start id $
+		case startbrowser of
+			Nothing -> Nothing
+			Just a -> Just $ a Nothing Nothing
+#endif
   where
   	desc
 		| assistant = "assistant"
@@ -99,7 +107,6 @@ startDaemon assistant foreground startdelay listenhost startbrowser = do
 			flip runAssistant (go webappwaiter) 
 				=<< newAssistantData st dstatus
 
-
 #ifdef WITH_WEBAPP
 	go webappwaiter = do
 		d <- getAssistant id

Assistant/Ssh.hs

@@ -12,6 +12,7 @@ import Utility.Tmp
 import Utility.UserInfo
 import Utility.Shell
 import Utility.Rsync
+import Utility.FileMode
 import Git.Remote
 
 import Data.Text (Text)
@@ -233,12 +234,8 @@ setupSshKeyPair sshkeypair sshdata = do
 	sshdir <- sshDir
 	createDirectoryIfMissing True $ parentDir $ sshdir </> sshprivkeyfile
 
-	unlessM (doesFileExist $ sshdir </> sshprivkeyfile) $ do
-		h <- fdToHandle =<<
-			createFile (sshdir </> sshprivkeyfile)
-				(unionFileModes ownerWriteMode ownerReadMode)
-		hPutStr h (sshPrivKey sshkeypair)
-		hClose h
+	unlessM (doesFileExist $ sshdir </> sshprivkeyfile) $
+		writeFileProtected (sshdir </> sshprivkeyfile) (sshPrivKey sshkeypair)
 	unlessM (doesFileExist $ sshdir </> sshpubkeyfile) $
 		writeFile (sshdir </> sshpubkeyfile) (sshPubKey sshkeypair)
 

Assistant/TransferSlots.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Assistant.TransferSlots where
 
 import Assistant.Common
@@ -32,8 +34,10 @@ import qualified Data.Map as M
 import qualified Control.Exception as E
 import Control.Concurrent
 import qualified Control.Concurrent.MSemN as MSemN
-import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL)
+#ifndef mingw32_HOST_OS
 import System.Posix.Process (getProcessGroupIDOf)
+import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL)
+#endif
 
 type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Transferrer -> Assistant ()))
 
@@ -247,13 +251,18 @@ cancelTransfer pause t = do
 	signalthread tid
 		| pause = throwTo tid PauseTransfer
 		| otherwise = killThread tid
-	{- In order to stop helper processes like rsync,
-	 - kill the whole process group of the process running the transfer. -}
 	killproc pid = void $ tryIO $ do
+#ifndef mingw32_HOST_OS
+		{- In order to stop helper processes like rsync,
+		 - kill the whole process group of the process
+		 - running the transfer. -}
 		g <- getProcessGroupIDOf pid
 		void $ tryIO $ signalProcessGroup sigTERM g
 		threadDelay 50000 -- 0.05 second grace period
 		void $ tryIO $ signalProcessGroup sigKILL g
+#else
+		error "TODO: cancelTransfer not implemented on Windows"
+#endif
 
 {- Start or resume a transfer. -}
 startTransfer :: Transfer -> Assistant ()

Assistant/TransferrerPool.hs

@@ -5,12 +5,17 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Assistant.TransferrerPool where
 
 import Assistant.Common
 import Assistant.Types.TransferrerPool
 import Logs.Transfer
+
+#ifndef mingw32_HOST_OS
 import qualified Command.TransferKeys as T
+#endif
 
 import Control.Concurrent.STM
 import System.Process (create_group)
@@ -38,13 +43,18 @@ withTransferrer program pool a = do
  - finish. -}
 performTransfer :: Transferrer -> Transfer -> AssociatedFile -> IO Bool
 performTransfer transferrer t f = catchBoolIO $ do
+#ifndef mingw32_HOST_OS
 	T.sendRequest t f (transferrerWrite transferrer)
 	T.readResponse (transferrerRead transferrer)
+#else
+	error "TODO performTransfer not implemented on Windows"
+#endif
 
 {- Starts a new git-annex transferkeys process, setting up a pipe
  - that will be used to communicate with it. -}
 mkTransferrer :: FilePath -> IO Transferrer
 mkTransferrer program = do
+#ifndef mingw32_HOST_OS
 	(myread, twrite) <- createPipe
 	(tread, mywrite) <- createPipe
 	mapM_ (\fd -> setFdOption fd CloseOnExec True) [myread, mywrite]
@@ -68,6 +78,9 @@ mkTransferrer program = do
 		, transferrerWrite = mywriteh
 		, transferrerHandle = pid
 		}
+#else
+	error "TODO mkTransferrer not implemented on Windows"
+#endif
 
 {- Checks if a Transferrer is still running. If not, makes a new one. -}
 checkTransferrer :: FilePath -> Transferrer -> IO Transferrer

Utility/Batch.hs

@@ -10,7 +10,9 @@
 module Utility.Batch where
 
 import Common
+#ifndef mingw32_HOST_OS
 import qualified Build.SysConfig
+#endif
 
 #if defined(linux_HOST_OS) || defined(__ANDROID__)
 import Control.Concurrent.Async

Utility/Win32Notify.hs

@@ -0,0 +1,64 @@
+{- Win32-notify interface
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Win32Notify where
+
+import Common hiding (isDirectory)
+import Utility.DirWatcher.Types
+
+import System.Win32.Notify
+
+watchDir :: FilePath -> (FilePath -> Bool) -> WatchHooks -> IO WatchManager
+watchDir dir ignored hooks = do
+	scan dir
+	wm <- initWatchManager
+	void $ watchDirectory wm dir True [Create, Delete, Modify, Move] handle
+	retufn wm
+  where
+	handle evt
+		| ignoredPath ignored (filePath evt) = noop
+		| otherwise = case eventToVariety evt of
+			Delete
+				| isDirectory evt -> runhook delDirHook Nothing
+				| otherwise -> runhook delHook Nothing
+			Create
+				| isDirectory evt -> noop
+				| otherwise -> runhook addHook Nothing
+			Modify
+				| isDirectory evt -> noop
+				{- Add hooks are run when a file is modified for 
+				 - compatability with INotify, which calls the add
+				 - hook when a file is closed, and so tends to call
+				 - both add and modify for file modifications. -}
+				| otherwise -> do
+					runHook addHook Nothing
+					runHook modifyHook Nothing
+	  where
+		runhook h s = maybe noop (\a -> a (filePath evt) s) (h hooks)
+
+	scan d = unless (ignoredPath ignored d) $
+		mapM_ go =<< dirContentsRecursive d
+	  where		
+		go f
+			| ignoredPath ignored f = noop
+			| otherwise = do
+				ms <- getstatus f
+				case ms of
+					Nothing -> noop
+					Just s
+						| Files.isRegularFile s ->
+							runhook addHook ms
+						| otherwise ->
+							noop
+		  where
+			runhook h s = maybe noop (\a -> a f s) (h hooks)
+		
+	getstatus = catchMaybeIO . getFileStatus
+
+{- Check each component of the path to see if it's ignored. -}
+ignoredPath :: (FilePath -> Bool) -> FilePath -> Bool
+ignoredPath ignored = any ignored . map dropTrailingPathSeparator . splitPath

git-annex.cabal

@@ -124,14 +124,10 @@ Executable git-annex
     Build-Depends: DAV (>= 0.3), http-conduit, xml-conduit, http-types
     CPP-Options: -DWITH_WEBDAV
 
-  if flag(Assistant) && ! os(windows) && ! os(solaris)
+  if flag(Assistant) && ! os(solaris)
     Build-Depends: stm (>= 2.3)
     CPP-Options: -DWITH_ASSISTANT
 
-  if flag(Android)
-    Build-Depends: data-endian
-    CPP-Options: -D__ANDROID__
-
   if flag(Assistant)
     if os(linux) && flag(Inotify)
       Build-Depends: hinotify
@@ -141,17 +137,25 @@ Executable git-annex
         Build-Depends: hfsevents
         CPP-Options: -DWITH_FSEVENTS
       else
-        if (! os(windows) && ! os(solaris) && ! os(linux))
-          if flag(Android)
-            Build-Depends: hinotify
-            CPP-Options: -DWITH_INOTIFY
-          else
-            CPP-Options: -DWITH_KQUEUE
-            C-Sources: Utility/libkqueue.c
+        if os(windows)
+          Build-Depends: Win32-notify
+          CPP-Options: -DWITH_WIN32NOTIFY
+        else
+          if (! os(solaris) && ! os(linux))
+            if flag(Android)
+              Build-Depends: hinotify
+              CPP-Options: -DWITH_INOTIFY
+            else
+              CPP-Options: -DWITH_KQUEUE
+              C-Sources: Utility/libkqueue.c
 
   if os(linux) && flag(Dbus)
     Build-Depends: dbus (>= 0.10.3)
     CPP-Options: -DWITH_DBUS
+  
+  if flag(Android)
+    Build-Depends: data-endian
+    CPP-Options: -D__ANDROID__
 
   if flag(Webapp) && (! os(windows))
     Build-Depends: