summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-11-12 14:54:02 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-11-12 17:22:34 -0400
commitd03bfb7355d11e271664d4dea51449f8f5059780 (patch)
tree638b735821c6074f31e8556f71d7f6b1f04eb1dd /Assistant
parentf869020577d759313494828d1973adcf2916b392 (diff)
build assistant and watcher on windows (doesn't work yet)
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Ssh.hs9
-rw-r--r--Assistant/TransferSlots.hs15
-rw-r--r--Assistant/TransferrerPool.hs13
3 files changed, 28 insertions, 9 deletions
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