git-annex/Command/RecvKey.hs
Joey Hess a422a056f2
make getViaTmpFrom no longer update location log
All callers adjusted to update it themselves.

In Command.ReKey, and Command.SetKey, the cleanup action already did,
so it was updating the log twice before.

This fixes a bug when annex.stalldetection is set, as now
Command.Transferrer can skip updating the location log, and let it be
updated by the calling process.
2020-12-11 11:50:13 -04:00

50 lines
1.5 KiB
Haskell

{- git-annex command
-
- Copyright 2010 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.RecvKey where
import Command
import Annex.Content
import Annex.Action
import Annex
import Utility.Rsync
import Types.Transfer
import Logs.Location
import Command.SendKey (fieldTransfer)
import qualified CmdLine.GitAnnexShell.Fields as Fields
cmd :: Command
cmd = noCommit $ command "recvkey" SectionPlumbing
"runs rsync in server mode to receive content"
paramKey (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withKeys (commandAction . start)
start :: (SeekInput, Key) -> CommandStart
start (_, key) = fieldTransfer Download key $ \_p -> do
-- Always verify content when a repo is sending an unlocked file,
-- as the file could change while being transferred.
fromunlocked <- (isJust <$> Fields.getField Fields.unlocked)
<||> (isJust <$> Fields.getField Fields.direct)
let verify = if fromunlocked then AlwaysVerify else DefaultVerify
-- This matches the retrievalSecurityPolicy of Remote.Git
let rsp = RetrievalAllKeysSecure
ifM (getViaTmp rsp verify key (AssociatedFile Nothing) go)
( do
logStatus key InfoPresent
-- forcibly quit after receiving one key,
-- and shutdown cleanly
_ <- shutdown True
return True
, return False
)
where
go tmp = unVerified $ do
opts <- filterRsyncSafeOptions . maybe [] words
<$> getField "RsyncOptions"
liftIO $ rsyncServerReceive (map Param opts) (fromRawFilePath tmp)