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
153
154
|
{- git-annex command
-
- Copyright 2010-2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Add where
import Command
import Annex.Ingest
import Logs.Location
import Annex.Content
import Annex.Content.Direct
import qualified Annex
import qualified Annex.Queue
import qualified Database.Keys
import Config
import Annex.FileMatcher
import Annex.Link
import Annex.Version
import Git.FilePath
cmd :: Command
cmd = notBareRepo $
withGlobalOptions [jobsOption, jsonOptions, fileMatchingOptions] $
command "add" SectionCommon "add files to annex"
paramPaths (seek <$$> optParser)
data AddOptions = AddOptions
{ addThese :: CmdParams
, includeDotFiles :: Bool
, batchOption :: BatchMode
, updateOnly :: Bool
}
optParser :: CmdParamsDesc -> Parser AddOptions
optParser desc = AddOptions
<$> cmdParams desc
<*> switch
( long "include-dotfiles"
<> help "don't skip dotfiles"
)
<*> parseBatchOption
<*> switch
( long "update"
<> short 'u'
<> help "only update tracked files"
)
seek :: AddOptions -> CommandSeek
seek o = allowConcurrentOutput $ do
matcher <- largeFilesMatcher
let gofile file = ifM (checkFileMatcher matcher file <||> Annex.getState Annex.force)
( start file
, ifM (annexAddSmallFiles <$> Annex.getGitConfig)
( startSmall file
, stop
)
)
case batchOption o of
Batch
| updateOnly o ->
giveup "--update --batch is not supported"
| otherwise -> batchFiles gofile
NoBatch -> do
l <- workTreeItems (addThese o)
let go a = a gofile l
unless (updateOnly o) $
go (withFilesNotInGit (not $ includeDotFiles o))
go withFilesMaybeModified
unlessM (versionSupportsUnlockedPointers <||> isDirect) $
go withFilesOldUnlocked
{- Pass file off to git-add. -}
startSmall :: FilePath -> CommandStart
startSmall file = do
showStart "add" file
next $ next $ addSmall file
addSmall :: FilePath -> Annex Bool
addSmall file = do
showNote "non-large file; adding content to git repository"
addFile file
addFile :: FilePath -> Annex Bool
addFile file = do
ps <- forceParams
Annex.Queue.addCommand "add" (ps++[Param "--"]) [file]
return True
start :: FilePath -> CommandStart
start file = do
ifM versionSupportsUnlockedPointers
( do
mk <- liftIO $ isPointerFile file
maybe go fixuppointer mk
, go
)
where
go = ifAnnexed file addpresent add
add = liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case
Nothing -> stop
Just s
| not (isRegularFile s) && not (isSymbolicLink s) -> stop
| otherwise -> do
showStart "add" file
next $ if isSymbolicLink s
then next $ addFile file
else perform file
addpresent key = ifM versionSupportsUnlockedPointers
( liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case
Just s | isSymbolicLink s -> fixuplink key
_ -> ifM (sameInodeCache file =<< Database.Keys.getInodeCaches key)
( stop, add )
, ifM isDirect
( liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case
Just s | isSymbolicLink s -> fixuplink key
_ -> ifM (goodContent key file)
( stop , add )
, fixuplink key
)
)
fixuplink key = do
-- the annexed symlink is present but not yet added to git
showStart "add" file
liftIO $ removeFile file
addLink file key Nothing
next $ next $
cleanup key =<< inAnnex key
fixuppointer key = do
-- the pointer file is present, but not yet added to git
showStart "add" file
Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file)
next $ next $ addFile file
perform :: FilePath -> CommandPerform
perform file = do
lockingfile <- not <$> addUnlocked
let cfg = LockDownConfig
{ lockingFile = lockingfile
, hardlinkFileTmp = True
}
lockDown cfg file >>= ingestAdd >>= finish
where
finish (Just key) = next $ cleanup key True
finish Nothing = stop
cleanup :: Key -> Bool -> CommandCleanup
cleanup key hascontent = do
maybeShowJSON $ JSONChunk [("key", key2file key)]
when hascontent $
logStatus key InfoPresent
return True
|
