summaryrefslogtreecommitdiff
path: root/Command/RecvKey.hs
blob: 5bd2d8b592c19fdbef9f250a6d4396625c0601c1 (plain)
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
{- git-annex command
 -
 - Copyright 2010 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Command.RecvKey where

import Command
import Annex.Content
import Annex.Action
import Annex
import Utility.Rsync
import Logs.Transfer
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 start

start :: 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
	ifM (getViaTmp verify key go)
		( do
			-- 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) tmp