summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Command/TransferInfo.hs53
-rw-r--r--Remote/Git.hs44
-rw-r--r--Utility/Process.hs7
-rw-r--r--doc/bugs/rsync_remote_shows_no_progress.mdwn2
-rw-r--r--doc/design/assistant/progressbars.mdwn30
-rw-r--r--doc/git-annex-shell.mdwn8
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