blob: a2632857a3aeb8d5f0236d9786a0a70ca0fad6f3 (
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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
{- git-annex command
-
- Copyright 2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Export where
import Command
import qualified Git
import qualified Git.DiffTree
import Git.Sha
import Git.FilePath
import Types.Key
import Types.Remote
import Annex.Content
import Annex.CatFile
import Logs.Location
import Messages.Progress
import Utility.Tmp
import qualified Data.ByteString.Lazy as L
cmd :: Command
cmd = command "export" SectionCommon
"export content to a remote"
paramTreeish (seek <$$> optParser)
data ExportOptions = ExportOptions
{ exportTreeish :: Git.Ref
, exportRemote :: DeferredParse Remote
}
optParser :: CmdParamsDesc -> Parser ExportOptions
optParser _ = ExportOptions
<$> (Git.Ref <$> parsetreeish)
<*> (parseRemoteOption <$> parseToOption)
where
parsetreeish = argument str
( metavar paramTreeish
)
seek :: ExportOptions -> CommandSeek
seek o = do
r <- getParsed (exportRemote o)
let oldtreeish = emptyTree -- XXX temporary
(diff, cleanup) <- inRepo $
Git.DiffTree.diffTreeRecursive oldtreeish (exportTreeish o)
seekActions $ pure $ map (start r) diff
void $ liftIO cleanup
start :: Remote -> Git.DiffTree.DiffTreeItem -> CommandStart
start r diff
| Git.DiffTree.dstsha diff == nullSha = do
showStart "unexport" f
oldk <- either id id <$> exportKey (Git.DiffTree.srcsha diff)
next $ performUnexport r oldk loc
| otherwise = do
showStart "export" f
next $ performExport r diff loc
where
loc = ExportLocation $ toInternalGitPath $
getTopFilePath $ Git.DiffTree.file diff
f = getTopFilePath $ Git.DiffTree.file diff
performExport :: Remote -> Git.DiffTree.DiffTreeItem -> ExportLocation -> CommandPerform
performExport r diff loc = case storeExport r of
Nothing -> error "remote does not support exporting files"
Just storer -> next $ do
v <- exportKey (Git.DiffTree.dstsha diff)
case v of
Right k -> ifM (inAnnex k)
( metered Nothing k $ \m ->
sendAnnex k
(void $ performUnexport r k loc)
(\f -> storer f k loc m)
, do
showNote "not available"
return False
)
-- Sending a non-annexed file.
Left sha1k -> metered Nothing sha1k $ \m ->
withTmpFile "export" $ \tmp h -> do
b <- catObject (Git.DiffTree.dstsha diff)
liftIO $ L.hPut h b
liftIO $ hClose h
storer tmp sha1k loc m
performUnexport :: Remote -> Key -> ExportLocation -> CommandPerform
performUnexport r k loc = case removeExport r of
Nothing -> error "remote does not support removing exported files"
Just remover -> next $ remover k loc
-- When the Sha points to an annexed file, get the key as Right.
-- When the Sha points to a non-annexed file, convert to a SHA1 key,
-- as Left.
exportKey :: Git.Sha -> Annex (Either Key Key)
exportKey sha = mk <$> catKey sha
where
mk (Just k) = Right k
mk Nothing = Left $ Key
{ keyName = show sha
, keyVariety = SHA1Key (HasExt False)
, keySize = Nothing
, keyMtime = Nothing
, keyChunkSize = Nothing
, keyChunkNum = Nothing
}
|
