diff --git a/Annex/CheckIgnore.hs b/Annex/CheckIgnore.hs index 916b8b0d9c..c1cee46670 100644 --- a/Annex/CheckIgnore.hs +++ b/Annex/CheckIgnore.hs @@ -7,6 +7,7 @@ -} module Annex.CheckIgnore ( + CheckGitIgnore(..), checkIgnored, checkIgnoreStop, mkConcurrentCheckIgnoreHandle, @@ -19,9 +20,15 @@ import Utility.ResourcePool import Types.Concurrency import Annex.Concurrent.Utility -checkIgnored :: FilePath -> Annex Bool -checkIgnored file = withCheckIgnoreHandle $ \h -> - liftIO $ Git.checkIgnored h file +newtype CheckGitIgnore = CheckGitIgnore Bool + +checkIgnored :: CheckGitIgnore -> FilePath -> Annex Bool +checkIgnored (CheckGitIgnore False) _ = pure False +checkIgnored (CheckGitIgnore True) file = + ifM (not <$> Annex.getState Annex.force) + ( pure False + , withCheckIgnoreHandle $ \h -> liftIO $ Git.checkIgnored h file + ) withCheckIgnoreHandle :: (Git.CheckIgnoreHandle -> Annex a) -> Annex a withCheckIgnoreHandle a = diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index b9b58068db..16bc7c49b0 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -1,6 +1,6 @@ {- git-annex content ingestion - - - Copyright 2010-2019 Joey Hess + - Copyright 2010-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -18,7 +18,8 @@ module Annex.Ingest ( addLink, makeLink, addUnlocked, - forceParams, + CheckGitIgnore(..), + gitAddParams, addAnnexedFile, ) where @@ -31,6 +32,7 @@ import Annex.Perms import Annex.Link import Annex.MetaData import Annex.CurrentBranch +import Annex.CheckIgnore import Logs.Location import qualified Annex import qualified Annex.Queue @@ -125,19 +127,19 @@ lockDown' cfg file = tryIO $ ifM crippledFileSystem {- Ingests a locked down file into the annex. Updates the work tree and - index. -} -ingestAdd :: MeterUpdate -> Maybe LockedDown -> Annex (Maybe Key) -ingestAdd meterupdate ld = ingestAdd' meterupdate ld Nothing +ingestAdd :: CheckGitIgnore -> MeterUpdate -> Maybe LockedDown -> Annex (Maybe Key) +ingestAdd ci meterupdate ld = ingestAdd' ci meterupdate ld Nothing -ingestAdd' :: MeterUpdate -> Maybe LockedDown -> Maybe Key -> Annex (Maybe Key) -ingestAdd' _ Nothing _ = return Nothing -ingestAdd' meterupdate ld@(Just (LockedDown cfg source)) mk = do +ingestAdd' :: CheckGitIgnore -> MeterUpdate -> Maybe LockedDown -> Maybe Key -> Annex (Maybe Key) +ingestAdd' _ _ Nothing _ = return Nothing +ingestAdd' ci meterupdate ld@(Just (LockedDown cfg source)) mk = do (mk', mic) <- ingest meterupdate ld mk case mk' of Nothing -> return Nothing Just k -> do let f = keyFilename source if lockingFile cfg - then addLink (fromRawFilePath f) k mic + then addLink ci (fromRawFilePath f) k mic else do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (contentLocation source) @@ -292,23 +294,28 @@ makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do - Also, using git add allows it to skip gitignored files, unless forced - to include them. -} -addLink :: FilePath -> Key -> Maybe InodeCache -> Annex () -addLink file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig) +addLink :: CheckGitIgnore -> FilePath -> Key -> Maybe InodeCache -> Annex () +addLink ci file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig) ( do _ <- makeLink file key mcache - ps <- forceParams + ps <- gitAddParams ci Annex.Queue.addCommand "add" (ps++[Param "--"]) [file] , do l <- makeLink file key mcache addAnnexLink l (toRawFilePath file) ) -{- Parameters to pass to git add, forcing addition of ignored files. -} -forceParams :: Annex [CommandParam] -forceParams = ifM (Annex.getState Annex.force) +{- Parameters to pass to git add, forcing addition of ignored files. + - + - Note that, when git add is being run on an ignored file that is already + - checked in, CheckGitIgnore True has no effect. + -} +gitAddParams :: CheckGitIgnore -> Annex [CommandParam] +gitAddParams (CheckGitIgnore True) = ifM (Annex.getState Annex.force) ( return [Param "-f"] , return [] ) +gitAddParams (CheckGitIgnore False) = return [Param "-f"] {- Whether a file should be added unlocked or not. Default is to not, - unless symlinks are not supported. annex.addunlocked can override that. @@ -332,8 +339,8 @@ addUnlocked matcher mi = - - When the content of the key is not accepted into the annex, returns False. -} -addAnnexedFile :: AddUnlockedMatcher -> FilePath -> Key -> Maybe FilePath -> Annex Bool -addAnnexedFile matcher file key mtmp = ifM (addUnlocked matcher mi) +addAnnexedFile :: CheckGitIgnore -> AddUnlockedMatcher -> FilePath -> Key -> Maybe FilePath -> Annex Bool +addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi) ( do mode <- maybe (pure Nothing) @@ -351,7 +358,7 @@ addAnnexedFile matcher file key mtmp = ifM (addUnlocked matcher mi) , writepointer mode >> return True ) , do - addLink file key Nothing + addLink ci file key Nothing case mtmp of Just tmp -> moveAnnex key tmp Nothing -> return True diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 20874d27a7..94adc31803 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -169,7 +169,7 @@ ignored = ig . takeFileName ig _ = False unlessIgnored :: FilePath -> Assistant (Maybe Change) -> Assistant (Maybe Change) -unlessIgnored file a = ifM (liftAnnex $ checkIgnored file) +unlessIgnored file a = ifM (liftAnnex $ checkIgnored (CheckGitIgnore True) file) ( noChange , a ) diff --git a/CHANGELOG b/CHANGELOG index 0a88a5a030..0c31e7fd8b 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -11,6 +11,9 @@ git-annex (8.20200909) UNRELEASED; urgency=medium support for versioned S3 buckets. * Serialize use of C magic library, which is not thread safe. This fixes failures uploading to S3 when using -J. + * add, addurl, importfeed, import: Added --no-check-gitignore option + for finer grained control than using --force. + * addunused: Don't check .gitignores when adding files. -- Joey Hess Mon, 14 Sep 2020 18:34:37 -0400 diff --git a/Command/Add.hs b/Command/Add.hs index 4291f85ad3..d222e4e678 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -24,6 +24,7 @@ import Git.FilePath import Config.GitConfig import qualified Git.UpdateIndex import Utility.FileMode +import Utility.OptParse import qualified Utility.RawFilePath as R cmd :: Command @@ -37,6 +38,7 @@ data AddOptions = AddOptions , batchOption :: BatchMode , updateOnly :: Bool , largeFilesOverride :: Maybe Bool + , checkGitIgnoreOption :: CheckGitIgnore } optParser :: CmdParamsDesc -> Parser AddOptions @@ -49,6 +51,7 @@ optParser desc = AddOptions <> help "only update tracked files" ) <*> (parseforcelarge <|> parseforcesmall) + <*> checkGitIgnoreSwitch where parseforcelarge = flag Nothing (Just True) ( long "force-large" @@ -59,6 +62,11 @@ optParser desc = AddOptions <> help "add all files to git, ignoring other configuration" ) +checkGitIgnoreSwitch :: Parser CheckGitIgnore +checkGitIgnoreSwitch = CheckGitIgnore <$> + invertableSwitch "check-gitignore" True + (help "Do not check .gitignore when adding files") + seek :: AddOptions -> CommandSeek seek o = startConcurrency commandStages $ do largematcher <- largeFilesMatcher @@ -68,14 +76,14 @@ seek o = startConcurrency commandStages $ do Nothing -> let file' = fromRawFilePath file in ifM (pure (annexdotfiles || not (dotfile file')) <&&> (checkFileMatcher largematcher file' <||> Annex.getState Annex.force)) - ( start si file addunlockedmatcher + ( start o si file addunlockedmatcher , ifM (annexAddSmallFiles <$> Annex.getGitConfig) - ( startSmall si file + ( startSmall o si file , stop ) ) - Just True -> start si file addunlockedmatcher - Just False -> startSmallOverridden si file + Just True -> start o si file addunlockedmatcher + Just False -> startSmallOverridden o si file case batchOption o of Batch fmt | updateOnly o -> @@ -95,26 +103,28 @@ seek o = startConcurrency commandStages $ do go withUnmodifiedUnlockedPointers {- Pass file off to git-add. -} -startSmall :: SeekInput -> RawFilePath -> CommandStart -startSmall si file = starting "add" (ActionItemWorkTreeFile file) si $ - next $ addSmall file +startSmall :: AddOptions -> SeekInput -> RawFilePath -> CommandStart +startSmall o si file = + starting "add" (ActionItemWorkTreeFile file) si $ + next $ addSmall (checkGitIgnoreOption o) file -addSmall :: RawFilePath -> Annex Bool -addSmall file = do +addSmall :: CheckGitIgnore -> RawFilePath -> Annex Bool +addSmall ci file = do showNote "non-large file; adding content to git repository" - addFile file + addFile ci file -startSmallOverridden :: SeekInput -> RawFilePath -> CommandStart -startSmallOverridden si file = starting "add" (ActionItemWorkTreeFile file) si $ - next $ addSmallOverridden file +startSmallOverridden :: AddOptions -> SeekInput -> RawFilePath -> CommandStart +startSmallOverridden o si file = + starting "add" (ActionItemWorkTreeFile file) si $ + next $ addSmallOverridden o file -addSmallOverridden :: RawFilePath -> Annex Bool -addSmallOverridden file = do +addSmallOverridden :: AddOptions -> RawFilePath -> Annex Bool +addSmallOverridden o file = do showNote "adding content to git repository" let file' = fromRawFilePath file s <- liftIO $ getSymbolicLinkStatus file' if not (isRegularFile s) - then addFile file + then addFile (checkGitIgnoreOption o) file else do -- Can't use addFile because the clean filter will -- honor annex.largefiles and it has been overridden. @@ -127,14 +137,14 @@ addSmallOverridden file = do inRepo (Git.UpdateIndex.stageFile sha ty file') return True -addFile :: RawFilePath -> Annex Bool -addFile file = do - ps <- forceParams +addFile :: CheckGitIgnore -> RawFilePath -> Annex Bool +addFile ci file = do + ps <- gitAddParams ci Annex.Queue.addCommand "add" (ps++[Param "--"]) [fromRawFilePath file] return True -start :: SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart -start si file addunlockedmatcher = do +start :: AddOptions -> SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart +start o si file addunlockedmatcher = do mk <- liftIO $ isPointerFile file maybe go fixuppointer mk where @@ -146,8 +156,8 @@ start si file addunlockedmatcher = do | otherwise -> starting "add" (ActionItemWorkTreeFile file) si $ if isSymbolicLink s - then next $ addFile file - else perform file addunlockedmatcher + then next $ addFile (checkGitIgnoreOption o) file + else perform o file addunlockedmatcher addpresent key = liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case Just s | isSymbolicLink s -> fixuplink key @@ -155,16 +165,16 @@ start si file addunlockedmatcher = do fixuplink key = starting "add" (ActionItemWorkTreeFile file) si $ do -- the annexed symlink is present but not yet added to git liftIO $ removeFile (fromRawFilePath file) - addLink (fromRawFilePath file) key Nothing + addLink (checkGitIgnoreOption o) (fromRawFilePath file) key Nothing next $ cleanup key =<< inAnnex key fixuppointer key = starting "add" (ActionItemWorkTreeFile file) si $ do -- the pointer file is present, but not yet added to git Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file) - next $ addFile file + next $ addFile (checkGitIgnoreOption o) file -perform :: RawFilePath -> AddUnlockedMatcher -> CommandPerform -perform file addunlockedmatcher = withOtherTmp $ \tmpdir -> do +perform :: AddOptions -> RawFilePath -> AddUnlockedMatcher -> CommandPerform +perform o file addunlockedmatcher = withOtherTmp $ \tmpdir -> do lockingfile <- not <$> addUnlocked addunlockedmatcher (MatchingFile (FileInfo file file)) let cfg = LockDownConfig @@ -174,7 +184,7 @@ perform file addunlockedmatcher = withOtherTmp $ \tmpdir -> do ld <- lockDown cfg (fromRawFilePath file) let sizer = keySource <$> ld v <- metered Nothing sizer $ \_meter meterupdate -> - ingestAdd meterupdate ld + ingestAdd (checkGitIgnoreOption o) meterupdate ld finish v where finish (Just key) = next $ cleanup key True diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs index b14e85bde5..23ff4aed00 100644 --- a/Command/AddUnused.hs +++ b/Command/AddUnused.hs @@ -28,7 +28,9 @@ start = startUnused "addunused" perform perform :: Key -> CommandPerform perform key = next $ do logStatus key InfoPresent - addLink file key Nothing + -- Ignore the usual git ignores because the user has explictly + -- asked to add these files. + addLink (CheckGitIgnore False) file key Nothing return True where file = "unused." ++ fromRawFilePath (keyFile key) diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 00e86f20b2..b77ad06111 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -54,6 +54,7 @@ data DownloadOptions = DownloadOptions , rawOption :: Bool , fileOption :: Maybe FilePath , preserveFilenameOption :: Bool + , checkGitIgnoreOption :: CheckGitIgnore } optParser :: CmdParamsDesc -> Parser AddUrlOptions @@ -100,6 +101,7 @@ parseDownloadOptions withfileoptions = DownloadOptions <> help "use filename provided by server as-is" ) else pure False) + <*> Command.Add.checkGitIgnoreSwitch seek :: AddUrlOptions -> CommandSeek seek o = startConcurrency commandStages $ do @@ -178,12 +180,12 @@ performRemote addunlockedmatcher r o uri file sz = ifAnnexed (toRawFilePath file geturi = next $ isJust <$> downloadRemoteFile addunlockedmatcher r (downloadOptions o) uri file sz downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key) -downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd file $ do +downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ do let urlkey = Backend.URL.fromUrl uri sz createWorkTreeDirectory (parentDir file) ifM (Annex.getState Annex.fast <||> pure (relaxedOption o)) ( do - addWorkTree addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing + addWorkTree o addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing return (Just urlkey) , do -- Set temporary url for the urlkey @@ -192,7 +194,7 @@ downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd file $ do setTempUrl urlkey loguri let downloader = \dest p -> fst <$> Remote.verifiedAction (Remote.retrieveKeyFile r urlkey af dest p) - ret <- downloadWith addunlockedmatcher downloader urlkey (Remote.uuid r) loguri file + ret <- downloadWith o addunlockedmatcher downloader urlkey (Remote.uuid r) loguri file removeTempUrl urlkey return ret ) @@ -309,10 +311,10 @@ downloadWeb addunlockedmatcher o url urlinfo file = ( tryyoutubedl tmp , normalfinish tmp ) - normalfinish tmp = checkCanAdd file $ do + normalfinish tmp = checkCanAdd o file $ do showDestinationFile file createWorkTreeDirectory (parentDir file) - Just <$> finishDownloadWith addunlockedmatcher tmp webUUID url file + Just <$> finishDownloadWith o addunlockedmatcher tmp webUUID url file -- Ask youtube-dl what filename it will download first, -- so it's only used when the file contains embedded media. tryyoutubedl tmp = youtubeDlFileNameHtmlOnly url >>= \case @@ -330,9 +332,9 @@ downloadWeb addunlockedmatcher o url urlinfo file = youtubeDl url workdir >>= \case Right (Just mediafile) -> do cleanuptmp - checkCanAdd dest $ do + checkCanAdd o dest $ do showDestinationFile dest - addWorkTree addunlockedmatcher webUUID mediaurl dest mediakey (Just mediafile) + addWorkTree o addunlockedmatcher webUUID mediaurl dest mediakey (Just mediafile) return $ Just mediakey Right Nothing -> normalfinish tmp Left msg -> do @@ -375,13 +377,13 @@ showDestinationFile file = do - Downloads the url, sets up the worktree file, and returns the - real key. -} -downloadWith :: AddUnlockedMatcher -> (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> FilePath -> Annex (Maybe Key) -downloadWith addunlockedmatcher downloader dummykey u url file = +downloadWith :: DownloadOptions -> AddUnlockedMatcher -> (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> FilePath -> Annex (Maybe Key) +downloadWith o addunlockedmatcher downloader dummykey u url file = go =<< downloadWith' downloader dummykey u url afile where afile = AssociatedFile (Just (toRawFilePath file)) go Nothing = return Nothing - go (Just tmp) = Just <$> finishDownloadWith addunlockedmatcher tmp u url file + go (Just tmp) = Just <$> finishDownloadWith o addunlockedmatcher tmp u url file {- Like downloadWith, but leaves the dummy key content in - the returned location. -} @@ -397,8 +399,8 @@ downloadWith' downloader dummykey u url afile = then return (Just tmp) else return Nothing -finishDownloadWith :: AddUnlockedMatcher -> FilePath -> UUID -> URLString -> FilePath -> Annex Key -finishDownloadWith addunlockedmatcher tmp u url file = do +finishDownloadWith :: DownloadOptions -> AddUnlockedMatcher -> FilePath -> UUID -> URLString -> FilePath -> Annex Key +finishDownloadWith o addunlockedmatcher tmp u url file = do backend <- chooseBackend file let source = KeySource { keyFilename = toRawFilePath file @@ -406,7 +408,7 @@ finishDownloadWith addunlockedmatcher tmp u url file = do , inodeCache = Nothing } key <- fst <$> genKey source nullMeterUpdate backend - addWorkTree addunlockedmatcher u url file key (Just tmp) + addWorkTree o addunlockedmatcher u url file key (Just tmp) return key {- Adds the url size to the Key. -} @@ -416,8 +418,8 @@ addSizeUrlKey urlinfo key = alterKey key $ \d -> d } {- Adds worktree file to the repository. -} -addWorkTree :: AddUnlockedMatcher -> UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex () -addWorkTree addunlockedmatcher u url file key mtmp = case mtmp of +addWorkTree :: DownloadOptions -> AddUnlockedMatcher -> UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex () +addWorkTree o addunlockedmatcher u url file key mtmp = case mtmp of Nothing -> go Just tmp -> do -- Move to final location for large file check. @@ -433,13 +435,15 @@ addWorkTree addunlockedmatcher u url file key mtmp = case mtmp of -- than the work tree file. liftIO $ renameFile file tmp go - else void $ Command.Add.addSmall (toRawFilePath file) + else void $ Command.Add.addSmall + (checkGitIgnoreOption o) + (toRawFilePath file) where go = do maybeShowJSON $ JSONChunk [("key", serializeKey key)] setUrlPresent key url logChange key u InfoPresent - ifM (addAnnexedFile addunlockedmatcher file key mtmp) + ifM (addAnnexedFile (checkGitIgnoreOption o) addunlockedmatcher file key mtmp) ( do when (isJust mtmp) $ logStatus key InfoPresent @@ -458,23 +462,23 @@ nodownloadWeb addunlockedmatcher o url urlinfo file where nomedia = do let key = Backend.URL.fromUrl url (Url.urlSize urlinfo) - nodownloadWeb' addunlockedmatcher url key file + nodownloadWeb' o addunlockedmatcher url key file usemedia mediafile = do let dest = youtubeDlDestFile o file mediafile let mediaurl = setDownloader url YoutubeDownloader let mediakey = Backend.URL.fromUrl mediaurl Nothing - nodownloadWeb' addunlockedmatcher mediaurl mediakey dest + nodownloadWeb' o addunlockedmatcher mediaurl mediakey dest youtubeDlDestFile :: DownloadOptions -> FilePath -> FilePath -> FilePath youtubeDlDestFile o destfile mediafile | isJust (fileOption o) = destfile | otherwise = takeFileName mediafile -nodownloadWeb' :: AddUnlockedMatcher -> URLString -> Key -> FilePath -> Annex (Maybe Key) -nodownloadWeb' addunlockedmatcher url key file = checkCanAdd file $ do +nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> FilePath -> Annex (Maybe Key) +nodownloadWeb' o addunlockedmatcher url key file = checkCanAdd o file $ do showDestinationFile file createWorkTreeDirectory (parentDir file) - addWorkTree addunlockedmatcher webUUID url file key Nothing + addWorkTree o addunlockedmatcher webUUID url file key Nothing return (Just key) url2file :: URI -> Maybe Int -> Int -> FilePath @@ -506,14 +510,14 @@ adjustFile o = addprefix . addsuffix addprefix f = maybe f (++ f) (prefixOption o) addsuffix f = maybe f (f ++) (suffixOption o) -checkCanAdd :: FilePath -> Annex (Maybe a) -> Annex (Maybe a) -checkCanAdd file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ getSymbolicLinkStatus file)) +checkCanAdd :: DownloadOptions -> FilePath -> Annex (Maybe a) -> Annex (Maybe a) +checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ getSymbolicLinkStatus file)) ( do warning $ file ++ " already exists; not overwriting" return Nothing - , ifM ((not <$> Annex.getState Annex.force) <&&> checkIgnored file) + , ifM (checkIgnored (checkGitIgnoreOption o) file) ( do - warning $ "not adding " ++ file ++ " which is .gitignored (use --force to override)" + warning $ "not adding " ++ file ++ " which is .gitignored (use --no-check-gitignore to override)" return Nothing , a ) diff --git a/Command/Import.hs b/Command/Import.hs index c029b01559..2de85ef1de 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -49,6 +49,7 @@ data ImportOptions = LocalImportOptions { importFiles :: CmdParams , duplicateMode :: DuplicateMode + , checkGitIgnoreOption :: CheckGitIgnore } | RemoteImportOptions { importFromRemote :: DeferredParse Remote @@ -65,8 +66,9 @@ optParser desc = do ( help "do not get contents of imported files" ) dupmode <- fromMaybe Default <$> optional duplicateModeParser + ic <- Command.Add.checkGitIgnoreSwitch return $ case mfromremote of - Nothing -> LocalImportOptions ps dupmode + Nothing -> LocalImportOptions ps dupmode ic Just r -> case ps of [bs] -> let (branch, subdir) = separate (== ':') bs @@ -110,7 +112,7 @@ seek o@(LocalImportOptions {}) = startConcurrency commandStages $ do giveup $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords inrepops largematcher <- largeFilesMatcher addunlockedmatcher <- addUnlockedMatcher - (commandAction . startLocal addunlockedmatcher largematcher (duplicateMode o)) + (commandAction . startLocal o addunlockedmatcher largematcher (duplicateMode o)) `withPathContents` importFiles o seek o@(RemoteImportOptions {}) = startConcurrency commandStages $ do r <- getParsed (importFromRemote o) @@ -122,8 +124,8 @@ seek o@(RemoteImportOptions {}) = startConcurrency commandStages $ do (importToSubDir o) seekRemote r (importToBranch o) subdir (importContent o) -startLocal :: AddUnlockedMatcher -> GetFileMatcher -> DuplicateMode -> (FilePath, FilePath) -> CommandStart -startLocal addunlockedmatcher largematcher mode (srcfile, destfile) = +startLocal :: ImportOptions -> AddUnlockedMatcher -> GetFileMatcher -> DuplicateMode -> (FilePath, FilePath) -> CommandStart +startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) = ifM (liftIO $ isRegularFile <$> getSymbolicLinkStatus srcfile) ( starting "import" ai si pickaction , stop @@ -148,10 +150,10 @@ startLocal addunlockedmatcher largematcher mode (srcfile, destfile) = showNote "reinjecting" Command.Reinject.perform srcfile k importfile ld k = checkdestdir $ do - ignored <- not <$> Annex.getState Annex.force <&&> checkIgnored destfile + ignored <- checkIgnored (checkGitIgnoreOption o) destfile if ignored then do - warning $ "not importing " ++ destfile ++ " which is .gitignored (use --force to override)" + warning $ "not importing " ++ destfile ++ " which is .gitignored (use --no-check-gitignore to override)" stop else do existing <- liftIO (catchMaybeIO $ getSymbolicLinkStatus destfile) @@ -210,11 +212,11 @@ startLocal addunlockedmatcher largematcher mode (srcfile, destfile) = } } ifM (checkFileMatcher largematcher destfile) - ( ingestAdd' nullMeterUpdate (Just ld') (Just k) + ( ingestAdd' (checkGitIgnoreOption o) nullMeterUpdate (Just ld') (Just k) >>= maybe stop (\addedk -> next $ Command.Add.cleanup addedk True) - , next $ Command.Add.addSmall destfile' + , next $ Command.Add.addSmall (checkGitIgnoreOption o) destfile' ) notoverwriting why = do warning $ "not overwriting existing " ++ destfile ++ " " ++ why diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 9e786b7b52..16281b4291 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -307,7 +307,7 @@ performDownload addunlockedmatcher opts cache todownload = case location todownl [] -> ".m" s -> s ok <- rundownload linkurl ext $ \f -> do - addWorkTree addunlockedmatcher webUUID mediaurl f mediakey (Just mediafile) + addWorkTree (downloadOptions opts) addunlockedmatcher webUUID mediaurl f mediakey (Just mediafile) return [mediakey] return (Just ok) -- youtude-dl didn't support it, so @@ -326,7 +326,7 @@ performDownload addunlockedmatcher opts cache todownload = case location todownl ifM (pure (not (rawOption (downloadOptions opts))) <&&> youtubeDlSupported linkurl) ( rundownload linkurl ".m" $ \f -> do - addWorkTree addunlockedmatcher webUUID mediaurl f mediakey Nothing + addWorkTree (downloadOptions opts) addunlockedmatcher webUUID mediaurl f mediakey Nothing return [mediakey] , performDownload addunlockedmatcher opts cache todownload { location = Enclosure linkurl } diff --git a/Command/Lock.hs b/Command/Lock.hs index 6b36c03916..04037244f1 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -60,7 +60,7 @@ start si file key = ifM (isJust <$> isAnnexLink file) perform :: RawFilePath -> Key -> CommandPerform perform file key = do lockdown =<< calcRepo (gitAnnexLocation key) - addLink (fromRawFilePath file) key + addLink (CheckGitIgnore False) (fromRawFilePath file) key =<< withTSDelta (liftIO . genInodeCache file) next $ cleanup file key where diff --git a/Command/ReKey.hs b/Command/ReKey.hs index e2a05f2cd8..d39b25ef65 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -124,7 +124,7 @@ cleanup file oldkey newkey = do ( do -- Update symlink to use the new key. liftIO $ removeFile (fromRawFilePath file) - addLink (fromRawFilePath file) newkey Nothing + addLink (CheckGitIgnore False) (fromRawFilePath file) newkey Nothing , do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file liftIO $ whenM (isJust <$> isPointerFile file) $ diff --git a/doc/git-annex-add.mdwn b/doc/git-annex-add.mdwn index ea9d3c1dbe..fadfd59a14 100644 --- a/doc/git-annex-add.mdwn +++ b/doc/git-annex-add.mdwn @@ -38,7 +38,7 @@ annexed content, and other symlinks. # OPTIONS -* `--force` +* `--no-check-gitignore` Add gitignored files. diff --git a/doc/git-annex-addurl.mdwn b/doc/git-annex-addurl.mdwn index 68ff68b2b9..fe5b1627cf 100644 --- a/doc/git-annex-addurl.mdwn +++ b/doc/git-annex-addurl.mdwn @@ -85,6 +85,12 @@ be used to get better filenames. Use to adjust the filenames that are created by addurl. For example, `--suffix=.mp3` can be used to add an extension to the file. +* `--no-check-gitignore` + + By default, gitignores are honored and it will refuse to download an + url to a file that would be ignored. This makes such files be added + despite any ignores. + * `--jobs=N` `-JN` Enables parallel downloads when multiple urls are being added. diff --git a/doc/git-annex-import.mdwn b/doc/git-annex-import.mdwn index 7501b30f8c..7dc4ed8a63 100644 --- a/doc/git-annex-import.mdwn +++ b/doc/git-annex-import.mdwn @@ -185,6 +185,10 @@ and `--reinject-duplicates` documentation below. Also, causes .gitignore to not take effect when adding files. +* `--no-check-gitignore` + + Add gitignored files. + * file matching options Many of the [[git-annex-matching-options]](1) diff --git a/doc/git-annex-importfeed.mdwn b/doc/git-annex-importfeed.mdwn index e1cf6be807..5281c6d48b 100644 --- a/doc/git-annex-importfeed.mdwn +++ b/doc/git-annex-importfeed.mdwn @@ -89,6 +89,12 @@ resulting in the new url being downloaded to such a filename. (These use the UTC time zone, not the local time zone.) +* `--no-check-gitignore` + + By default, gitignores are honored and it will refuse to download an + url to a file that would be ignored. This makes such files be added + despite any ignores. + # SEE ALSO [[git-annex]](1)