hooked up git-annex-shell transferinfo
Finally done with progressbars!
This commit is contained in:
parent
ee8789e9d7
commit
c048add74d
6 changed files with 86 additions and 58 deletions
|
@ -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"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue