build assistant and watcher on windows (doesn't work yet)
This commit is contained in:
parent
472d9376b6
commit
b9b5e3370d
7 changed files with 118 additions and 22 deletions
|
@ -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)
|
||||
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue