diff options
author | 2013-11-12 14:54:02 -0400 | |
---|---|---|
committer | 2013-11-12 17:22:34 -0400 | |
commit | d03bfb7355d11e271664d4dea51449f8f5059780 (patch) | |
tree | 638b735821c6074f31e8556f71d7f6b1f04eb1dd | |
parent | f869020577d759313494828d1973adcf2916b392 (diff) |
build assistant and watcher on windows (doesn't work yet)
-rw-r--r-- | Assistant.hs | 9 | ||||
-rw-r--r-- | Assistant/Ssh.hs | 9 | ||||
-rw-r--r-- | Assistant/TransferSlots.hs | 15 | ||||
-rw-r--r-- | Assistant/TransferrerPool.hs | 13 | ||||
-rw-r--r-- | Utility/Batch.hs | 2 | ||||
-rw-r--r-- | Utility/Win32Notify.hs | 64 | ||||
-rw-r--r-- | git-annex.cabal | 28 |
7 files changed, 118 insertions, 22 deletions
diff --git a/Assistant.hs b/Assistant.hs index 781089e06..3c434438d 100644 --- a/Assistant.hs +++ b/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 diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index f316aa500..1dc982ba6 100644 --- a/Assistant/Ssh.hs +++ b/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) diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index 36d557c3d..cb66e845a 100644 --- a/Assistant/TransferSlots.hs +++ b/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 () diff --git a/Assistant/TransferrerPool.hs b/Assistant/TransferrerPool.hs index d9104f74d..bb4648731 100644 --- a/Assistant/TransferrerPool.hs +++ b/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 diff --git a/Utility/Batch.hs b/Utility/Batch.hs index 011d30c94..035a2eb04 100644 --- a/Utility/Batch.hs +++ b/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 diff --git a/Utility/Win32Notify.hs b/Utility/Win32Notify.hs new file mode 100644 index 000000000..3493b9e9a --- /dev/null +++ b/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 diff --git a/git-annex.cabal b/git-annex.cabal index 848477c18..69d129341 100644 --- a/git-annex.cabal +++ b/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: |