1{- git-annex command
2 -
3 - Copyright 2010 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Command.RecvKey where
9
10import Command
11import Annex.Content
12import Annex.Action
13import Annex
14import Utility.Rsync
15import Types.Transfer
16import Logs.Location
17import Command.SendKey (fieldTransfer)
18import qualified CmdLine.GitAnnexShell.Fields as Fields
19
20cmd :: Command
21cmd = noCommit $ command "recvkey" SectionPlumbing
22	"runs rsync in server mode to receive content"
23	paramKey (withParams seek)
24
25seek :: CmdParams -> CommandSeek
26seek = withKeys (commandAction . start)
27
28start :: (SeekInput, Key) -> CommandStart
29start (_, key) = fieldTransfer Download key $ \_p -> do
30	-- Always verify content when a repo is sending an unlocked file,
31	-- as the file could change while being transferred.
32	fromunlocked <- (isJust <$> Fields.getField Fields.unlocked)
33		<||> (isJust <$> Fields.getField Fields.direct)
34	let verify = if fromunlocked then AlwaysVerify else DefaultVerify
35	-- This matches the retrievalSecurityPolicy of Remote.Git
36	let rsp = RetrievalAllKeysSecure
37	ifM (getViaTmp rsp verify key (AssociatedFile Nothing) go)
38		( do
39			logStatus key InfoPresent
40			-- forcibly quit after receiving one key,
41			-- and shutdown cleanly
42			_ <- shutdown True
43			return True
44		, return False
45		)
46  where
47	go tmp = unVerified $ do
48		opts <- filterRsyncSafeOptions . maybe [] words
49			<$> getField "RsyncOptions"
50		liftIO $ rsyncServerReceive (map Param opts) (fromRawFilePath tmp)
51