git-annex/Command/RecvKey.hs
Joey Hess c3d40b9ec3
plumb in LiveUpdate (WIP)
Each command that first checks preferred content (and/or required
content) and then does something that can change the sizes of
repositories needs to call prepareLiveUpdate, and plumb it through the
preferred content check and the location log update.

So far, only Command.Drop is done. Many other commands that don't need
to do this have been updated to keep working.

There may be some calls to NoLiveUpdate in places where that should be
done. All will need to be double checked.

Not currently in a compilable state.
2024-08-23 16:35:12 -04:00

42 lines
1.1 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)
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
-- This matches the retrievalSecurityPolicy of Remote.Git
let rsp = RetrievalAllKeysSecure
ifM (getViaTmp rsp DefaultVerify key (AssociatedFile Nothing) Nothing go)
( do
logStatus NoLiveUpdate key InfoPresent
_ <- quiesce True
return True
, return False
)
where
go tmp = unVerified $ do
opts <- filterRsyncSafeOptions . maybe [] words
<$> getField "RsyncOptions"
liftIO $ rsyncServerReceive (map Param opts) (fromRawFilePath tmp)