mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
git-annex/Command/SendKey.hs

44 lines
1.1 KiB
Haskell
Raw Normal View History

git-annex-shell is complete still not used
2010-12-31 17:39:30 +00:00
{- git-annex command
-
record transfers for git-annex-shell Not yet tested and places git-annex-shell is run need to be modified to pass the new field settings. Note that rsyncServerSend was changed to fork, rather than directly exec rsync, because it needs to keep the transfer lock held, and clean up the transfer log when done.
2012-07-02 05:31:10 +00:00
- Copyright 2010,2012 Joey Hess <joey@kitenet.net>
git-annex-shell is complete still not used
2010-12-31 17:39:30 +00:00
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.SendKey where
rename
2011-10-05 20:02:51 +00:00
import Common.Annex
git-annex-shell is complete still not used
2010-12-31 17:39:30 +00:00
import Command
rename
2011-10-04 04:40:47 +00:00
import Annex.Content
renamed RsyncFile -> Rsync
2012-09-19 18:28:32 +00:00
import Utility.Rsync
record transfers for git-annex-shell Not yet tested and places git-annex-shell is run need to be modified to pass the new field settings. Note that rsyncServerSend was changed to fork, rather than directly exec rsync, because it needs to keep the transfer lock held, and clean up the transfer log when done.
2012-07-02 05:31:10 +00:00
import Logs.Transfer
add a progress callback to storeKey, and threaded it all the way through Transfer info files are updated when the callback is called, updating the number of bytes transferred. Left unused p variables at every place the callback should be used. Which is rather a lot..
2012-09-19 20:08:37 +00:00
import Types.Remote
keep logs of failed transfers, and requeue them when doing a non-full scan of a remote
2012-08-23 19:22:23 +00:00
import qualified Fields
git-annex-shell is complete still not used
2010-12-31 17:39:30 +00:00
clean up check selection code This new approach allows filtering out checks from the default set that are not appropriate for a command, rather than having to list every check that is appropriate. It also reduces some boilerplate. Haskell does not define Eq for functions, so I had to go a long way around with each check having a unique id. Meh.
2011-10-29 19:19:05 +00:00
def :: [Command]
more descriptive name for oneshot
2012-09-16 00:46:38 +00:00
def = [noCommit $ command "sendkey" paramKey seek
git-annex-shell is complete still not used
2010-12-31 17:39:30 +00:00
"runs rsync in server mode to send content"]
seek :: [CommandSeek]
seek = [withKeys start]
remove command type definitions These were a mistake, they make the type signatures harder to read and less flexible. The CommandSeek, CommandStart, CommandPerform, and CommandCleanup types were a good idea, but composing them with the parameters expected is going too far.
2011-09-15 20:50:49 +00:00
start :: Key -> CommandStart
record transfers for git-annex-shell Not yet tested and places git-annex-shell is run need to be modified to pass the new field settings. Note that rsyncServerSend was changed to fork, rather than directly exec rsync, because it needs to keep the transfer lock held, and clean up the transfer log when done.
2012-07-02 05:31:10 +00:00
start key = ifM (inAnnex key)
make the assistant retry failed transfers When a transfer fails, the progress info can be used to intelligently retry it. If the transfer managed to make some progress, but did not fully complete, then there's a good chance that a retry will finish it (or at least make more progress).
2012-09-23 17:27:13 +00:00
( fieldTransfer Upload key $ \_p -> do
record transfers for git-annex-shell Not yet tested and places git-annex-shell is run need to be modified to pass the new field settings. Note that rsyncServerSend was changed to fork, rather than directly exec rsync, because it needs to keep the transfer lock held, and clean up the transfer log when done.
2012-07-02 05:31:10 +00:00
file <- inRepo $ gitAnnexLocation key
keep logs of failed transfers, and requeue them when doing a non-full scan of a remote
2012-08-23 19:22:23 +00:00
liftIO $ rsyncServerSend file
record transfers for git-annex-shell Not yet tested and places git-annex-shell is run need to be modified to pass the new field settings. Note that rsyncServerSend was changed to fork, rather than directly exec rsync, because it needs to keep the transfer lock held, and clean up the transfer log when done.
2012-07-02 05:31:10 +00:00
, do
warning "requested key is not present"
liftIO exitFailure
)
keep logs of failed transfers, and requeue them when doing a non-full scan of a remote
2012-08-23 19:22:23 +00:00
unify types
2012-09-21 18:50:14 +00:00
fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart
keep logs of failed transfers, and requeue them when doing a non-full scan of a remote
2012-08-23 19:22:23 +00:00
fieldTransfer direction key a = do
afile <- Fields.getField Fields.associatedFile
add a progress callback to storeKey, and threaded it all the way through Transfer info files are updated when the callback is called, updating the number of bytes transferred. Left unused p variables at every place the callback should be used. Which is rather a lot..
2012-09-19 20:08:37 +00:00
ok <- maybe (a $ const noop)
make the assistant retry failed transfers When a transfer fails, the progress info can be used to intelligently retry it. If the transfer managed to make some progress, but did not fully complete, then there's a good chance that a retry will finish it (or at least make more progress).
2012-09-23 17:27:13 +00:00
(\u -> runTransfer (Transfer direction (toUUID u) key) afile noRetry a)
keep logs of failed transfers, and requeue them when doing a non-full scan of a remote
2012-08-23 19:22:23 +00:00
=<< Fields.getField Fields.remoteUUID
if ok
then liftIO exitSuccess
else liftIO exitFailure
Reference in a new issue Copy permalink