port transferkeys to windows; make stopping in progress transfers work too (probably)
transferkeys had used special FDs for communication, but that would be quite annoying to do in Windows. Instead, use stdin and stdout. But, to avoid commands like rsync stomping on them and messing up the communications channel, they're duplicated to a different handle; stdin is replaced with a null handle, and stdout is replaced with a copy of stderr. This should all work in windows too. Stopping in progress transfers may work on windows.. if the types unify anyway. ;) May need some more porting.
This commit is contained in:
parent
0fbbe79d8f
commit
2fd63f3cfa
6 changed files with 51 additions and 79 deletions
|
@ -16,39 +16,21 @@ import Logs.Location
|
|||
import Logs.Transfer
|
||||
import qualified Remote
|
||||
import Types.Key
|
||||
import qualified Option
|
||||
|
||||
import GHC.IO.Handle
|
||||
|
||||
data TransferRequest = TransferRequest Direction Remote Key AssociatedFile
|
||||
|
||||
def :: [Command]
|
||||
def = [withOptions options $
|
||||
command "transferkeys" paramNothing seek
|
||||
def = [command "transferkeys" paramNothing seek
|
||||
SectionPlumbing "transfers keys"]
|
||||
|
||||
options :: [Option]
|
||||
options = [readFdOption, writeFdOption]
|
||||
|
||||
readFdOption :: Option
|
||||
readFdOption = Option.field [] "readfd" paramNumber "read from this fd"
|
||||
|
||||
writeFdOption :: Option
|
||||
writeFdOption = Option.field [] "writefd" paramNumber "write to this fd"
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withField readFdOption convertFd $ \readh ->
|
||||
withField writeFdOption convertFd $ \writeh ->
|
||||
withNothing $ start readh writeh]
|
||||
seek = [withNothing start]
|
||||
|
||||
convertFd :: Maybe String -> Annex (Maybe Handle)
|
||||
convertFd Nothing = return Nothing
|
||||
convertFd (Just s) = liftIO $
|
||||
case readish s of
|
||||
Nothing -> error "bad fd"
|
||||
Just fd -> Just <$> fdToHandle fd
|
||||
|
||||
start :: Maybe Handle -> Maybe Handle -> CommandStart
|
||||
start readh writeh = do
|
||||
runRequests (fromMaybe stdin readh) (fromMaybe stdout writeh) runner
|
||||
start :: CommandStart
|
||||
start = withHandles $ \(readh, writeh) -> do
|
||||
runRequests readh writeh runner
|
||||
stop
|
||||
where
|
||||
runner (TransferRequest direction remote key file)
|
||||
|
@ -61,6 +43,21 @@ start readh writeh = do
|
|||
| otherwise = download (Remote.uuid remote) key file forwardRetry $ \p ->
|
||||
getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
|
||||
|
||||
{- stdin and stdout are connected with the caller, to be used for
|
||||
- communication with it. But doing a transfer might involve something
|
||||
- that tries to read from stdin, or write to stdout. To avoid that, close
|
||||
- stdin, and duplicate stderr to stdout. Return two new handles
|
||||
- that are duplicates of the original (stdin, stdout). -}
|
||||
withHandles :: ((Handle, Handle) -> Annex a) -> Annex a
|
||||
withHandles a = do
|
||||
readh <- liftIO $ hDuplicate stdin
|
||||
writeh <- liftIO $ hDuplicate stdout
|
||||
liftIO $ do
|
||||
nullh <- openFile devNull ReadMode
|
||||
nullh `hDuplicateTo` stdin
|
||||
stderr `hDuplicateTo` stdout
|
||||
a (readh, writeh)
|
||||
|
||||
runRequests
|
||||
:: Handle
|
||||
-> Handle
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue