blob: 0e0e81609574db4351428f38c57eb64384b61286 (
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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
{- git-annex command
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.TransferInfo where
import Common.Annex
import Command
import Annex.Content
import Logs.Transfer
import Types.Remote
import Types.Key
def :: [Command]
def = [noCommit $ command "transferinfo" paramdesc seek
"updates sender on number of bytes of content received"]
seek :: [CommandSeek]
seek = [withWords start]
paramdesc :: String
paramdesc = paramKey `paramPair` paramUUID `paramPair` paramOptional paramFile
start :: [String] -> CommandStart
start (k:u:f:[]) = start' (file2key k) (toUUID u) (Just f) >> stop
start (k:u:[]) = start' (file2key k) (toUUID u) Nothing >> stop
start _ = error "wrong number of parameters"
{- Security:
-
- The transfer info file contains the user-supplied key, but
- the built-in guards prevent slashes in it from showing up in the filename.
- It also contains the UUID of the remote. But slashes are also filtered
- out of that when generating the filename.
-
- Checks that the key being transferred is inAnnex, to prevent
- malicious spamming of bogus keys. Does not check that a transfer
- of the key is actually in progress, because this could be started
- concurrently with sendkey, and win the race.
-}
start' :: Maybe Key -> UUID -> AssociatedFile -> Annex ()
start' Nothing _ _ = error "bad key"
start' (Just key) u file = whenM (inAnnex key) $ do
let t = Transfer
{ transferDirection = Upload
, transferUUID = u
, transferKey = key
}
info <- liftIO $ startTransferInfo file
(update, tfile) <- mkProgressUpdater t info
liftIO $ mapM_ void
[ tryIO $ forever $ do
bytes <- readish <$> getLine
maybe (error "transferinfo protocol error") update bytes
, tryIO $ removeFile tfile
, exitSuccess
]
|
