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
|
{- git-annex command
-
- Copyright 2010, 2013 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 Annex.Link
import qualified Annex
import qualified Annex.Queue
import qualified Database.Keys
import Config
import Utility.InodeCache
import Annex.FileMatcher
import Annex.Version
cmd :: Command
cmd = notBareRepo $ withGlobalOptions (jobsOption : jsonOption : fileMatchingOptions) $
command "add" SectionCommon "add files to annex"
paramPaths (seek <$$> optParser)
data AddOptions = AddOptions
{ addThese :: CmdParams
, includeDotFiles :: Bool
, batchOption :: BatchMode
}
optParser :: CmdParamsDesc -> Parser AddOptions
optParser desc = AddOptions
<$> cmdParams desc
<*> switch
( long "include-dotfiles"
<> help "don't skip dotfiles"
)
<*> parseBatchOption
{- Add acts on both files not checked into git yet, and unlocked files.
-
- In direct mode, it acts on any files that have changed. -}
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 -> batchFiles gofile
NoBatch -> do
let go a = a gofile (addThese o)
go (withFilesNotInGit (not $ includeDotFiles o))
ifM (versionSupportsUnlockedPointers <||> isDirect)
( go withFilesMaybeModified
, 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 = ifAnnexed file addpresent add
where
add = do
ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
case ms of
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
( do
ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
case ms of
Just s | isSymbolicLink s -> fixup key
_ -> ifM (sameInodeCache file =<< Database.Keys.getInodeCaches key)
( stop, add )
, ifM isDirect
( do
ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
case ms of
Just s | isSymbolicLink s -> fixup key
_ -> ifM (goodContent key file)
( stop , add )
, fixup key
)
)
fixup key = do
-- the annexed symlink is present but not yet added to git
showStart "add" file
liftIO $ removeFile file
whenM isDirect $
void $ addAssociatedFile key file
next $ next $ cleanup file key Nothing =<< inAnnex key
perform :: FilePath -> CommandPerform
perform file = do
lockingfile <- not <$> isDirect
let cfg = LockDownConfig
{ lockingFile = lockingfile
, hardlinkFileTmp = True
}
lockDown cfg file >>= ingest >>= go
where
go (Just key, cache) = next $ cleanup file key cache True
go (Nothing, _) = stop
cleanup :: FilePath -> Key -> Maybe InodeCache -> Bool -> CommandCleanup
cleanup file key mcache hascontent = do
maybeShowJSON [("key", key2file key)]
ifM (isDirect <&&> pure hascontent)
( do
l <- calcRepo $ gitAnnexLink file key
stageSymlink file =<< hashSymlink l
, addLink file key mcache
)
when hascontent $
logStatus key InfoPresent
return True
|
