1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
{- 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)
|
