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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
{- 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 qualified Git.LsTree
import Git.Types
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
)
-- An export includes both annexed files and files stored in git.
-- For the latter, a SHA1 key is synthesized.
data ExportKey = AnnexKey Key | GitKey Key
asKey :: ExportKey -> Key
asKey (AnnexKey k) = k
asKey (GitKey k) = k
exportKey :: Git.Sha -> Annex ExportKey
exportKey sha = mk <$> catKey sha
where
mk (Just k) = AnnexKey k
mk Nothing = GitKey $ Key
{ keyName = show sha
, keyVariety = SHA1Key (HasExt False)
, keySize = Nothing
, keyMtime = Nothing
, keyChunkSize = Nothing
, keyChunkNum = Nothing
}
seek :: ExportOptions -> CommandSeek
seek o = do
r <- getParsed (exportRemote o)
let oldtreeish = emptyTree -- XXX temporary
-- First, diff the old and new trees and update all changed
-- files in the export.
(diff, cleanup) <- inRepo $
Git.DiffTree.diffTreeRecursive oldtreeish (exportTreeish o)
seekActions $ pure $ map (startDiff r) diff
void $ liftIO cleanup
-- In case a previous export was incomplete, make a pass
-- over the whole tree and export anything that is not
-- yet exported.
(l, cleanup') <- inRepo $ Git.LsTree.lsTree (exportTreeish o)
seekActions $ pure $ map (start r) l
void $ liftIO cleanup'
startDiff :: Remote -> Git.DiffTree.DiffTreeItem -> CommandStart
startDiff r diff
| Git.DiffTree.dstsha diff == nullSha = do
showStart "unexport" f
oldk <- exportKey (Git.DiffTree.srcsha diff)
next $ performUnexport r oldk loc
| otherwise = do
showStart "export" f
k <- exportKey (Git.DiffTree.dstsha diff)
next $ performExport r k (Git.DiffTree.dstsha diff) loc
where
loc = ExportLocation $ toInternalGitPath $
getTopFilePath $ Git.DiffTree.file diff
f = getTopFilePath $ Git.DiffTree.file diff
start :: Remote -> Git.LsTree.TreeItem -> CommandStart
start r ti = do
ek <- exportKey (Git.LsTree.sha ti)
stopUnless (elem (uuid r) <$> loggedLocations (asKey ek)) $
next $ performExport r ek (Git.LsTree.sha ti) loc
where
loc = ExportLocation $ toInternalGitPath $
getTopFilePath $ Git.LsTree.file ti
performExport :: Remote -> ExportKey -> Sha -> ExportLocation -> CommandPerform
performExport r ek contentsha loc = case storeExport r of
Nothing -> error "remote does not support exporting files"
Just storer -> do
sent <- case ek of
AnnexKey k -> ifM (inAnnex k)
( metered Nothing k $ \m -> do
let rollback = void $ performUnexport r ek loc
sendAnnex k rollback
(\f -> storer f k loc m)
, do
showNote "not available"
return False
)
-- Sending a non-annexed file.
GitKey sha1k -> metered Nothing sha1k $ \m ->
withTmpFile "export" $ \tmp h -> do
b <- catObject contentsha
liftIO $ L.hPut h b
liftIO $ hClose h
storer tmp sha1k loc m
if sent
then next $ cleanupExport r ek
else stop
cleanupExport :: Remote -> ExportKey -> CommandCleanup
cleanupExport r ek = do
logChange (asKey ek) (uuid r) InfoPresent
return True
performUnexport :: Remote -> ExportKey -> ExportLocation -> CommandPerform
performUnexport r ek loc = case removeExport r of
Nothing -> error "remote does not support removing exported files"
Just remover -> do
ok <- remover (asKey ek) loc
if ok
then next $ cleanupUnexport r ek
else stop
cleanupUnexport :: Remote -> ExportKey -> CommandCleanup
cleanupUnexport r ek = do
logChange (asKey ek) (uuid r) InfoMissing
return True
|
