diff options
| -rw-r--r-- | Command/TransferInfo.hs | 53 | ||||
| -rw-r--r-- | Remote/Git.hs | 44 | ||||
| -rw-r--r-- | Utility/Process.hs | 7 | ||||
| -rw-r--r-- | doc/bugs/rsync_remote_shows_no_progress.mdwn | 2 | ||||
| -rw-r--r-- | doc/design/assistant/progressbars.mdwn | 30 | ||||
| -rw-r--r-- | doc/git-annex-shell.mdwn | 8 |
6 files changed, 86 insertions, 58 deletions
diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs index 0e0e81609..f64ffa765 100644 --- a/Command/TransferInfo.hs +++ b/Command/TransferInfo.hs @@ -11,24 +11,16 @@ import Common.Annex import Command import Annex.Content import Logs.Transfer -import Types.Remote import Types.Key +import qualified Fields def :: [Command] -def = [noCommit $ command "transferinfo" paramdesc seek +def = [noCommit $ command "transferinfo" paramKey seek "updates sender on number of bytes of content received"] seek :: [CommandSeek] seek = [withWords start] -paramdesc :: String -paramdesc = paramKey `paramPair` paramUUID `paramPair` paramOptional paramFile - -start :: [String] -> CommandStart -start (k:u:f:[]) = start' (file2key k) (toUUID u) (Just f) >> stop -start (k:u:[]) = start' (file2key k) (toUUID u) Nothing >> stop -start _ = error "wrong number of parameters" - {- Security: - - The transfer info file contains the user-supplied key, but @@ -41,20 +33,27 @@ start _ = error "wrong number of parameters" - of the key is actually in progress, because this could be started - concurrently with sendkey, and win the race. -} -start' :: Maybe Key -> UUID -> AssociatedFile -> Annex () -start' Nothing _ _ = error "bad key" -start' (Just key) u file = whenM (inAnnex key) $ do - let t = Transfer - { transferDirection = Upload - , transferUUID = u - , transferKey = key - } - info <- liftIO $ startTransferInfo file - (update, tfile) <- mkProgressUpdater t info - liftIO $ mapM_ void - [ tryIO $ forever $ do - bytes <- readish <$> getLine - maybe (error "transferinfo protocol error") update bytes - , tryIO $ removeFile tfile - , exitSuccess - ] +start :: [String] -> CommandStart +start (k:[]) = do + case (file2key k) of + Nothing -> error "bad key" + (Just key) -> whenM (inAnnex key) $ do + file <- Fields.getField Fields.associatedFile + u <- maybe (error "missing remoteuuid") toUUID + <$> Fields.getField Fields.remoteUUID + let t = Transfer + { transferDirection = Upload + , transferUUID = u + , transferKey = key + } + info <- liftIO $ startTransferInfo file + (update, tfile) <- mkProgressUpdater t info + liftIO $ mapM_ void + [ tryIO $ forever $ do + bytes <- readish <$> getLine + maybe (error "transferinfo protocol error") update bytes + , tryIO $ removeFile tfile + , exitSuccess + ] + stop +start _ = error "wrong number of parameters" diff --git a/Remote/Git.hs b/Remote/Git.hs index 330fb3a13..a1c5b24b4 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -27,6 +27,7 @@ import qualified Annex import Logs.Presence import Logs.Transfer import Annex.UUID +import Annex.Exception import qualified Annex.Content import qualified Annex.BranchState import qualified Annex.Branch @@ -38,6 +39,7 @@ import Types.Key import qualified Fields import Control.Concurrent +import System.Process (std_in, std_err) remote :: RemoteType remote = RemoteType { @@ -247,9 +249,49 @@ copyFromRemote r key file dest loc <- inRepo $ gitAnnexLocation key upload u key file $ rsyncOrCopyFile params loc dest - | Git.repoIsSsh r = rsyncHelper Nothing =<< rsyncParamsRemote r True key dest file + | Git.repoIsSsh r = feedprogressback $ \feeder -> + rsyncHelper (Just feeder) + =<< rsyncParamsRemote r True key dest file | Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) dest | otherwise = error "copying from non-ssh, non-http repo not supported" + where + {- Feed local rsync's progress info back to the remote, + - by forking a feeder thread that runs + - git-annex-shell transferinfo at the same time + - git-annex-shell sendkey is running. + - + - Note that it actually waits for rsync to indicate + - progress before starting transferinfo, in order + - to ensure ssh connection caching works and reuses + - the connection set up for the sendkey. + - + - Also note that older git-annex-shell does not support + - transferinfo, so stderr is dropped and failure ignored. + -} + feedprogressback a = do + u <- getUUID + let fields = (Fields.remoteUUID, fromUUID u) + : maybe [] (\f -> [(Fields.associatedFile, f)]) file + Just (cmd, params) <- git_annex_shell r "transferinfo" + [Param $ key2file key] fields + v <- liftIO $ newEmptySampleVar + tid <- liftIO $ forkIO $ void $ tryIO $ do + bytes <- readSampleVar v + p <- createProcess $ + (proc cmd (toCommand params)) + { std_in = CreatePipe + , std_err = CreatePipe + } + hClose $ stderrHandle p + let h = stdinHandle p + let send b = do + hPutStrLn h $ show b + hFlush h + send bytes + forever $ + send =<< readSampleVar v + let feeder = writeSampleVar v + bracketIO noop (const $ tryIO $ killThread tid) (a feeder) copyFromRemoteCheap :: Git.Repo -> Key -> FilePath -> Annex Bool copyFromRemoteCheap r key file diff --git a/Utility/Process.hs b/Utility/Process.hs index 1c99b83ca..1e93569be 100644 --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -17,6 +17,7 @@ module Utility.Process ( writeReadProcessEnv, forceSuccessProcess, checkSuccessProcess, + ignoreFailureProcess, createProcessSuccess, createProcessChecked, createBackgroundProcess, @@ -24,6 +25,9 @@ module Utility.Process ( withBothHandles, createProcess, runInteractiveProcess, + stdinHandle, + stdoutHandle, + stderrHandle, ) where import qualified System.Process @@ -112,6 +116,9 @@ checkSuccessProcess pid = do code <- waitForProcess pid return $ code == ExitSuccess +ignoreFailureProcess :: ProcessHandle -> IO () +ignoreFailureProcess = void . waitForProcess + {- Runs createProcess, then an action on its handles, and then - forceSuccessProcess. -} createProcessSuccess :: CreateProcessRunner diff --git a/doc/bugs/rsync_remote_shows_no_progress.mdwn b/doc/bugs/rsync_remote_shows_no_progress.mdwn index 1b7c89c12..0192291f2 100644 --- a/doc/bugs/rsync_remote_shows_no_progress.mdwn +++ b/doc/bugs/rsync_remote_shows_no_progress.mdwn @@ -11,3 +11,5 @@ Please provide any additional information below. I looked in the source code and found some hints that the rsync progress should actually be evaluated and shown, I'm opening a bug report for this reason. [[!meta title="assistant: No progress bars for file uploads"]] + +> now upload progress bars work! [[done]] --[[Joey]] diff --git a/doc/design/assistant/progressbars.mdwn b/doc/design/assistant/progressbars.mdwn index ead440453..61e19ba1e 100644 --- a/doc/design/assistant/progressbars.mdwn +++ b/doc/design/assistant/progressbars.mdwn @@ -17,36 +17,14 @@ This is one of those potentially hidden but time consuming problems. ## uploads Each individual remote type needs to implement its own support for calling -the ProgressCallback as the upload progresses. - -* git: Done, with one exception: `git-annex-shell sendkey` runs `rsync - --server --sender` and in that mode it does not report progress info. - So downloads initiated by other repos do not show progress in the repo - doing the uploading. - - Maybe I should - write a proxy for the rsync wire protocol that can tell what chunk of the - file is being sent, and shim it in front of the rsync server? Sadly, - the protocol is insane. - - Another idea: Invert things. Make `git-annex-shell sendkey` run - `rsync -e 'cat'`, so it treats the incoming ssh connection as the server. - (cat probably won't really work; bidirectional pipe needed). - Run rsync in `--server` mode on the *client* side, piped to ssh. - Now the `git-annex` side doesn't have a progress bar (but it can poll the - file size and produce its own), `git-annex-shell` side does have a progress - bar. - - Less crazy, but probably harder idea: Multiplex progress info from client - back to server over the ssh connection, and demultiplex at server end. - Or, use a separate ssh connection, and let ssh connection caching handle - the multiplexing. +the MeterUpdate callback as the upload progresses. +* git: **done** * rsync: **done** * directory: **done** * web: Not applicable; does not upload -* S3 -* bup +* S3: TODO +* bup: TODO * hook: Would require the hook interface to somehow do this, which seems too complicated. So skipping. diff --git a/doc/git-annex-shell.mdwn b/doc/git-annex-shell.mdwn index 8256da0e3..e6ebe4287 100644 --- a/doc/git-annex-shell.mdwn +++ b/doc/git-annex-shell.mdwn @@ -46,14 +46,14 @@ first "/~/" or "/~user/" is expanded to the specified home directory. This runs rsync in server mode to transfer out the content of a key. -* transferinfo directory key uuid [file] +* transferinfo directory key This is typically run at the same time as sendkey is sending a key - to the remote with the specified uuid. + to the remote. Using it is optional, but is used to update + progress information for the transfer of the key. It reads lines from standard input, each giving the number of bytes - that have been received so far. This is optional, but is used to update - progress information for the transfer of the key. + that have been received so far. * commit directory |