diff --git a/Annex/Action.hs b/Annex/Action.hs --- a/Annex/Action.hs +++ b/Annex/Action.hs @@ -17,6 +17,10 @@ import Annex.Common import qualified Annex import Annex.Content +import Annex.CatFile +import Annex.CheckAttr +import Annex.HashObject +import Annex.CheckIgnore {- Actions to perform each time ran. -} startup :: Annex () @@ -32,4 +36,13 @@ shutdown nocommit = do saveState nocommit sequence_ =<< M.elems <$> Annex.getState Annex.cleanup + stopCoProcesses liftIO reapZombies -- zombies from long-running git processes + +{- Stops all long-running git query processes. -} +stopCoProcesses :: Annex () +stopCoProcesses = do + catFileStop + checkAttrStop + hashObjectStop + checkIgnoreStop diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -167,7 +167,7 @@ | adjustedBranchPrefix `isPrefixOf` bs = do let (base, as) = separate (== '(') (drop prefixlen bs) adj <- deserialize (takeWhile (/= ')') as) - Just (adj, Git.Ref.underBase "refs/heads" (Ref base)) + Just (adj, Git.Ref.branchRef (Ref base)) | otherwise = Nothing where bs = fromRef b diff --git a/Annex/Concurrent.hs b/Annex/Concurrent.hs --- a/Annex/Concurrent.hs +++ b/Annex/Concurrent.hs @@ -7,12 +7,9 @@ module Annex.Concurrent where -import Annex.Common import Annex -import Annex.CatFile -import Annex.CheckAttr -import Annex.HashObject -import Annex.CheckIgnore +import Annex.Common +import Annex.Action import qualified Annex.Queue import qualified Data.Map as M @@ -61,11 +58,3 @@ uncurry addCleanup Annex.Queue.mergeFrom st' changeState $ \s -> s { errcounter = errcounter s + errcounter st' } - -{- Stops all long-running git query processes. -} -stopCoProcesses :: Annex () -stopCoProcesses = do - catFileStop - checkAttrStop - hashObjectStop - checkIgnoreStop diff --git a/Annex/Init.hs b/Annex/Init.hs --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -146,40 +146,40 @@ probeCrippledFileSystem = do tmp <- fromRepo gitAnnexTmpMiscDir createAnnexDirectory tmp - probeCrippledFileSystem' tmp + (r, warnings) <- liftIO $ probeCrippledFileSystem' tmp + mapM_ warning warnings + return r -probeCrippledFileSystem' :: FilePath -> Annex Bool +probeCrippledFileSystem' :: FilePath -> IO (Bool, [String]) #ifdef mingw32_HOST_OS probeCrippledFileSystem' _ = return True #else probeCrippledFileSystem' tmp = do let f = tmp "gaprobe" - liftIO $ writeFile f "" - uncrippled <- probe f - void $ liftIO $ tryIO $ allowWrite f - liftIO $ removeFile f - return $ not uncrippled + writeFile f "" + r <- probe f + void $ tryIO $ allowWrite f + removeFile f + return r where - probe f = catchBoolIO $ do + probe f = catchDefaultIO (True, []) $ do let f2 = f ++ "2" - liftIO $ nukeFile f2 - liftIO $ createSymbolicLink f f2 - liftIO $ nukeFile f2 - liftIO $ preventWrite f + nukeFile f2 + createSymbolicLink f f2 + nukeFile f2 + preventWrite f -- Should be unable to write to the file, unless -- running as root, but some crippled -- filesystems ignore write bit removals. - ifM ((== 0) <$> liftIO getRealUserID) - ( return True + ifM ((== 0) <$> getRealUserID) + ( return (False, []) , do - r <- liftIO $ catchBoolIO $ - writeFile f "2" >> return True + r <- catchBoolIO $ do + writeFile f "2" + return True if r - then do - warning "Filesystem allows writing to files whose write bit is not set." - return False - else return True - + then return (True, ["Filesystem allows writing to files whose write bit is not set."]) + else return (False, []) ) #endif diff --git a/Annex/MakeRepo.hs b/Annex/MakeRepo.hs --- a/Annex/MakeRepo.hs +++ b/Annex/MakeRepo.hs @@ -16,6 +16,7 @@ import qualified Annex import Annex.UUID import Annex.Direct +import Annex.Action import Types.StandardGroups import Logs.PreferredContent import qualified Annex.Branch @@ -42,7 +43,7 @@ inDir :: FilePath -> Annex a -> IO a inDir dir a = do state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir - Annex.eval state a + Annex.eval state $ a `finally` stopCoProcesses {- Creates a new repository, and returns its UUID. -} initRepo :: Bool -> Bool -> FilePath -> Maybe String -> Maybe StandardGroup -> IO UUID diff --git a/Annex/MetaData.hs b/Annex/MetaData.hs --- a/Annex/MetaData.hs +++ b/Annex/MetaData.hs @@ -39,12 +39,20 @@ -} genMetaData :: Key -> FilePath -> FileStatus -> Annex () genMetaData key file status = do - maybe noop (`copyMetaData` key) =<< catKeyFileHEAD file + v <- catKeyFileHEAD file + case v of + Nothing -> noop + Just oldkey -> + whenM (copyMetaData oldkey key) + warncopied whenM (annexGenMetaData <$> Annex.getGitConfig) $ do curr <- getCurrentMetaData key addMetaData key (dateMetaData mtime curr) where mtime = posixSecondsToUTCTime $ realToFrac $ modificationTime status + warncopied = warning $ + "Copied metadata from old version of " ++ file ++ " to new version. " ++ + "If you don't want this copied metadata, run: git annex metadata --remove-all " ++ file {- Generates metadata for a file's date stamp. - Does not overwrite any existing metadata values. -} diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs --- a/Annex/TaggedPush.hs +++ b/Annex/TaggedPush.hs @@ -30,7 +30,7 @@ - Both UUIDs and Base64 encoded data are always legal to be used in git - refs, per git-check-ref-format. -} -toTaggedBranch :: UUID -> Maybe String -> Git.Branch -> Git.Branch +toTaggedBranch :: UUID -> Maybe String -> Git.Branch -> Git.Ref toTaggedBranch u info b = Git.Ref $ intercalate "/" $ catMaybes [ Just "refs/synced" , Just $ fromUUID u @@ -38,13 +38,17 @@ , Just $ Git.fromRef $ Git.Ref.base b ] -fromTaggedBranch :: Git.Branch -> Maybe (UUID, Maybe String) +fromTaggedBranch :: Git.Ref -> Maybe (UUID, Maybe String) fromTaggedBranch b = case splitc '/' $ Git.fromRef b of ("refs":"synced":u:info:_base) -> Just (toUUID u, fromB64Maybe info) ("refs":"synced":u:_base) -> Just (toUUID u, Nothing) _ -> Nothing + +listTaggedBranches :: Annex [(Git.Sha, Git.Ref)] +listTaggedBranches = filter (isJust . fromTaggedBranch . snd) + <$> inRepo Git.Ref.list taggedPush :: UUID -> Maybe String -> Git.Ref -> Remote -> Git.Repo -> IO Bool taggedPush u info branch remote = Git.Command.runBool diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,26 @@ +git-annex (6.20171003) unstable; urgency=medium + + * webdav: Improve error message for failed request to include the request + method and path. + * metadata: Added --remove-all. + * Warn when metadata is inherited from a previous version of a file, + to avoid the user being surprised in cases where that behavior is not + desired or expected. + * sync: Added --cleanup, which removes local and remote synced/ branches. + * external: When the external special remote program crashed, a newline + could be output, which messed up the expected output for --batch mode. + * external: Avoid checking EXPORTSUPPORTED for special remotes that are + not configured to use exports. + * test: Fix reversion that made it only run inside a git repository. + * copy, move: Behave same with --fast when sending to remotes located + on a local disk as when sending to other remotes. + * Fix process and file descriptor leak that was exposed when + git-annex was built with ghc 8.2.1. Broke git-annex test on OSX + due to running out of FDs, and may have also leaked in other situations. + * info: Improve cleanup of stale transfer info files. + + -- Joey Hess Tue, 03 Oct 2017 13:18:15 -0400 + git-annex (6.20170925) unstable; urgency=medium * git-annex export: New command, can create and efficiently update diff --git a/Command/MetaData.hs b/Command/MetaData.hs --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -64,6 +64,10 @@ ( long "remove" <> short 'r' <> metavar "FIELD" <> help "remove all values of a field" ) + <|> flag' DelAllMeta + ( long "remove-all" + <> help "remove all metadata" + ) seek :: MetaDataOptions -> CommandSeek seek o = case batchOption o of diff --git a/Command/Move.hs b/Command/Move.hs --- a/Command/Move.hs +++ b/Command/Move.hs @@ -109,7 +109,7 @@ toStart' :: Remote -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart toStart' dest move afile key ai = do fast <- Annex.getState Annex.fast - if fast && not move && not (Remote.hasKeyCheap dest) + if fast && not move then ifM (expectedPresent dest key) ( stop , go True (pure $ Right False) diff --git a/Command/Sync.hs b/Command/Sync.hs --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -59,6 +59,7 @@ import Annex.UpdateInstead import Annex.Export import Annex.LockFile +import Annex.TaggedPush import qualified Database.Export as Export import Utility.Bloom import Utility.OptParse @@ -82,6 +83,7 @@ , contentOption :: Bool , noContentOption :: Bool , contentOfOption :: [FilePath] + , cleanupOption :: Bool , keyOptions :: Maybe KeyOptions , resolveMergeOverride :: ResolveMergeOverride } @@ -129,6 +131,10 @@ <> help "transfer file contents of files in a given location" <> metavar paramPath )) + <*> switch + ( long "cleanup" + <> help "remove synced/ branches from previous sync" + ) <*> optional parseAllOption <*> (ResolveMergeOverride <$> invertableSwitch "resolvemerge" True ( help "do not automatically resolve merge conflicts" @@ -147,6 +153,7 @@ <*> pure (contentOption v) <*> pure (noContentOption v) <*> liftIO (mapM absPath (contentOfOption v)) + <*> pure (cleanupOption v) <*> pure (keyOptions v) <*> pure (resolveMergeOverride v) @@ -163,32 +170,39 @@ . filter (\r -> Remote.uuid r /= NoUUID) <$> filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) remotes - -- Syncing involves many actions, any of which can independently - -- fail, without preventing the others from running. - -- These actions cannot be run concurrently. - mapM_ includeCommandAction $ concat - [ [ commit o ] - , [ withbranch (mergeLocal mergeConfig (resolveMergeOverride o)) ] - , map (withbranch . pullRemote o mergeConfig) gitremotes - , [ mergeAnnex ] - ] - whenM shouldsynccontent $ do - syncedcontent <- seekSyncContent o dataremotes - exportedcontent <- seekExportContent exportremotes - -- Transferring content can take a while, - -- and other changes can be pushed to the git-annex - -- branch on the remotes in the meantime, so pull - -- and merge again to avoid our push overwriting - -- those changes. - when (syncedcontent || exportedcontent) $ do + if cleanupOption o + then do + commandAction (withbranch cleanupLocal) + mapM_ (commandAction . withbranch . cleanupRemote) gitremotes + else do + -- Syncing involves many actions, any of which + -- can independently fail, without preventing + -- the others from running. + -- These actions cannot be run concurrently. mapM_ includeCommandAction $ concat - [ map (withbranch . pullRemote o mergeConfig) gitremotes - , [ commitAnnex, mergeAnnex ] + [ [ commit o ] + , [ withbranch (mergeLocal mergeConfig (resolveMergeOverride o)) ] + , map (withbranch . pullRemote o mergeConfig) gitremotes + , [ mergeAnnex ] ] + + whenM shouldsynccontent $ do + syncedcontent <- seekSyncContent o dataremotes + exportedcontent <- seekExportContent exportremotes + -- Transferring content can take a while, + -- and other changes can be pushed to the + -- git-annex branch on the remotes in the + -- meantime, so pull and merge again to + -- avoid our push overwriting those changes. + when (syncedcontent || exportedcontent) $ do + mapM_ includeCommandAction $ concat + [ map (withbranch . pullRemote o mergeConfig) gitremotes + , [ commitAnnex, mergeAnnex ] + ] - void $ includeCommandAction $ withbranch pushLocal - -- Pushes to remotes can run concurrently. - mapM_ (commandAction . withbranch . pushRemote o) gitremotes + void $ includeCommandAction $ withbranch pushLocal + -- Pushes to remotes can run concurrently. + mapM_ (commandAction . withbranch . pushRemote o) gitremotes where shouldsynccontent = pure (contentOption o) <||> pure (not (null (contentOfOption o))) @@ -682,3 +696,32 @@ Remote.name r ++ ". Use git-annex export to resolve this conflict." return False + +cleanupLocal :: CurrBranch -> CommandStart +cleanupLocal (Nothing, _) = stop +cleanupLocal (Just currb, _) = do + showStart "cleanup" "local" + next $ next $ do + delbranch $ syncBranch currb + delbranch $ syncBranch $ Git.Ref.base $ Annex.Branch.name + mapM_ (\(s,r) -> inRepo $ Git.Ref.delete s r) + =<< listTaggedBranches + return True + where + delbranch b = whenM (inRepo $ Git.Ref.exists $ Git.Ref.branchRef b) $ + inRepo $ Git.Branch.delete b + +cleanupRemote :: Remote -> CurrBranch -> CommandStart +cleanupRemote _ (Nothing, _) = stop +cleanupRemote remote (Just b, _) = do + showStart "cleanup" (Remote.name remote) + next $ next $ + inRepo $ Git.Command.runBool + [ Param "push" + , Param "--quiet" + , Param "--delete" + , Param $ Remote.name remote + , Param $ Git.fromRef $ syncBranch b + , Param $ Git.fromRef $ syncBranch $ + Git.Ref.base $ Annex.Branch.name + ] diff --git a/Git/Ref.hs b/Git/Ref.hs --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -45,6 +45,10 @@ underBase :: String -> Ref -> Ref underBase dir r = Ref $ dir ++ "/" ++ fromRef (base r) +{- Convert a branch such as "master" into a fully qualified ref. -} +branchRef :: Branch -> Ref +branchRef = underBase "refs/heads" + {- A Ref that can be used to refer to a file in the repository, as staged - in the index. - @@ -101,7 +105,7 @@ matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)] matchingWithHEAD refs repo = matching' ("--head" : map fromRef refs) repo -{- List of (shas, branches) matching a given ref or refs. -} +{- List of (shas, branches) matching a given ref spec. -} matching' :: [String] -> Repo -> IO [(Sha, Branch)] matching' ps repo = map gen . lines <$> pipeReadStrict (Param "show-ref" : map Param ps) repo @@ -109,12 +113,26 @@ gen l = let (r, b) = separate (== ' ') l in (Ref r, Ref b) -{- List of (shas, branches) matching a given ref spec. +{- List of (shas, branches) matching a given ref. - Duplicate shas are filtered out. -} matchingUniq :: [Ref] -> Repo -> IO [(Sha, Branch)] matchingUniq refs repo = nubBy uniqref <$> matching refs repo where uniqref (a, _) (b, _) = a == b + +{- List of all refs. -} +list :: Repo -> IO [(Sha, Ref)] +list = matching' [] + +{- Deletes a ref. This can delete refs that are not branches, + - which git branch --delete refuses to delete. -} +delete :: Sha -> Ref -> Repo -> IO () +delete oldvalue ref = run + [ Param "update-ref" + , Param "-d" + , Param $ fromRef ref + , Param $ fromRef oldvalue + ] {- Gets the sha of the tree a ref uses. -} tree :: Ref -> Repo -> IO (Maybe Sha) diff --git a/Logs/MetaData.hs b/Logs/MetaData.hs --- a/Logs/MetaData.hs +++ b/Logs/MetaData.hs @@ -55,6 +55,9 @@ config <- Annex.getGitConfig readLog $ metaDataLogFile config key +logToCurrentMetaData :: [LogEntry MetaData] -> MetaData +logToCurrentMetaData = currentMetaData . combineMetaData . map value + {- Go through the log from oldest to newest, and combine it all - into a single MetaData representing the current state. - @@ -64,7 +67,7 @@ getCurrentMetaData :: Key -> Annex MetaData getCurrentMetaData k = do ls <- S.toAscList <$> getMetaDataLog k - let loggedmeta = currentMetaData $ combineMetaData $ map value ls + let loggedmeta = logToCurrentMetaData ls return $ currentMetaData $ unionMetaData loggedmeta (lastchanged ls loggedmeta) where @@ -177,13 +180,18 @@ - repository. - - Any metadata already attached to the new key is not preserved. + - + - Returns True when metadata was copied. -} -copyMetaData :: Key -> Key -> Annex () +copyMetaData :: Key -> Key -> Annex Bool copyMetaData oldkey newkey - | oldkey == newkey = noop + | oldkey == newkey = return False | otherwise = do l <- getMetaDataLog oldkey - unless (S.null l) $ do - config <- Annex.getGitConfig - Annex.Branch.change (metaDataLogFile config newkey) $ - const $ showLog l + if logToCurrentMetaData (S.toAscList l) == emptyMetaData + then return False + else do + config <- Annex.getGitConfig + Annex.Branch.change (metaDataLogFile config newkey) $ + const $ showLog l + return True diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -93,22 +93,23 @@ checkTransfer :: Transfer -> Annex (Maybe TransferInfo) checkTransfer t = do tfile <- fromRepo $ transferFile t + let lck = transferLockFile tfile let cleanstale = do void $ tryIO $ removeFile tfile - void $ tryIO $ removeFile $ transferLockFile tfile + void $ tryIO $ removeFile lck #ifndef mingw32_HOST_OS - let lck = transferLockFile tfile v <- getLockStatus lck case v of StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $ readTransferInfoFile (Just pid) tfile - StatusNoLockFile -> return Nothing - StatusUnLocked -> do + _ -> do -- Take a non-blocking lock while deleting -- the stale lock file. Ignore failure -- due to permissions problems, races, etc. void $ tryIO $ do - r <- tryLockExclusive Nothing lck + mode <- annexFileMode + let lck = transferLockFile tfile + r <- tryLockExclusive (Just mode) lck case r of Just lockhandle -> liftIO $ do cleanstale @@ -116,7 +117,7 @@ _ -> noop return Nothing #else - v <- liftIO $ lockShared $ transferLockFile tfile + v <- liftIO $ lockShared lck liftIO $ case v of Nothing -> catchDefaultIO Nothing $ readTransferInfoFile Nothing tfile diff --git a/Remote/External.hs b/Remote/External.hs --- a/Remote/External.hs +++ b/Remote/External.hs @@ -20,6 +20,7 @@ import Git.Env import Remote.Helper.Special import Remote.Helper.Export +import Annex.Export import Remote.Helper.ReadOnly import Remote.Helper.Messages import Utility.Metered @@ -69,7 +70,9 @@ Annex.addCleanup (RemoteCleanup u) $ stopExternal external cst <- getCost external r gc avail <- getAvailability external r gc - exportsupported <- checkExportSupported' external + exportsupported <- if exportTree c + then checkExportSupported' external + else return False let exportactions = if exportsupported then return $ ExportActions { storeExport = storeExportM external @@ -165,8 +168,9 @@ =<< newExternal externaltype NoUUID c gc checkExportSupported' :: External -> Annex Bool -checkExportSupported' external = safely $ - handleRequest external EXPORTSUPPORTED Nothing $ \resp -> case resp of +checkExportSupported' external = go `catchNonAsync` (const (return False)) + where + go = handleRequest external EXPORTSUPPORTED Nothing $ \resp -> case resp of EXPORTSUPPORTED_SUCCESS -> Just $ return True EXPORTSUPPORTED_FAILURE -> Just $ return False UNSUPPORTED_REQUEST -> Just $ return False @@ -313,7 +317,7 @@ where go (Right r) = return r go (Left e) = do - warning $ show e + toplevelWarning False (show e) return False {- Sends a Request to the external remote, and waits for it to generate diff --git a/Remote/Git.hs b/Remote/Git.hs --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -59,7 +59,7 @@ import Creds import Messages.Progress import Types.NumCopies -import Annex.Concurrent +import Annex.Action import Control.Concurrent import Control.Concurrent.MSampleVar @@ -311,11 +311,12 @@ - it if allowed. However, if that fails, still return the read - git config. -} readlocalannexconfig = do - s <- Annex.new r - Annex.eval s $ do + let check = do Annex.BranchState.disableUpdate void $ tryNonAsync $ ensureInitialized Annex.getState Annex.repo + s <- Annex.new r + Annex.eval s $ check `finally` stopCoProcesses configlistfields = if autoinit then [(Fields.autoInit, "1")] @@ -611,7 +612,7 @@ Annex.eval s $ do Annex.BranchState.disableUpdate ensureInitialized - a + a `finally` stopCoProcesses {- Runs an action from the perspective of a local remote. - @@ -632,7 +633,7 @@ go st = do curro <- Annex.getState Annex.output (ret, st') <- liftIO $ Annex.run (st { Annex.output = curro }) $ - stopCoProcesses `after` a + a `finally` stopCoProcesses cache st' return ret diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -16,6 +16,7 @@ import qualified Data.ByteString.UTF8 as B8 import qualified Data.ByteString.Lazy.UTF8 as L8 import Network.HTTP.Client (HttpException(..), RequestBody) +import qualified Network.HTTP.Client as HTTP import Network.HTTP.Types import System.IO.Error import Control.Monad.Catch @@ -378,17 +379,20 @@ prettifyExceptions :: DAVT IO a -> DAVT IO a prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go where - go (HttpExceptionRequest _ (StatusCodeException response message)) = error $ unwords + go (HttpExceptionRequest req (StatusCodeException response message)) = giveup $ unwords [ "DAV failure:" , show (responseStatus response) , show (message) + , "HTTP request:" + , show (HTTP.method req) + , show (HTTP.path req) ] go e = throwM e #else prettifyExceptions :: DAVT IO a -> DAVT IO a prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go where - go (StatusCodeException status _ _) = error $ unwords + go (StatusCodeException status _ _) = giveup $ unwords [ "DAV failure:" , show (statusCode status) , show (statusMessage status) diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -82,6 +82,7 @@ import qualified Annex.VectorClock import qualified Annex.View import qualified Annex.View.ViewedFile +import qualified Annex.Action import qualified Logs.View import qualified Utility.Path import qualified Utility.FileMode @@ -147,7 +148,7 @@ exitWith exitcode runsubprocesstests opts (Just _) = isolateGitConfig $ do ensuretmpdir - crippledfilesystem <- annexeval $ Annex.Init.probeCrippledFileSystem' tmpdir + crippledfilesystem <- fst <$> Annex.Init.probeCrippledFileSystem' tmpdir case tryIngredients ingredients (tastyOptionSet opts) (tests crippledfilesystem opts) of Nothing -> error "No tests found!?" Just act -> ifM act @@ -1778,7 +1779,7 @@ s <- Annex.new =<< Git.CurrentRepo.get Annex.eval s $ do Annex.setOutput Types.Messages.QuietOutput - a + a `finally` Annex.Action.stopCoProcesses innewrepo :: Assertion -> Assertion innewrepo a = withgitrepo $ \r -> indir r a @@ -1813,7 +1814,8 @@ checkRepo :: Types.Annex a -> FilePath -> IO a checkRepo getval d = do s <- Annex.new =<< Git.Construct.fromPath d - Annex.eval s getval + Annex.eval s $ + getval `finally` Annex.Action.stopCoProcesses isInDirect :: FilePath -> IO Bool isInDirect = checkRepo (not <$> Config.isDirect) diff --git a/Types/MetaData.hs b/Types/MetaData.hs --- a/Types/MetaData.hs +++ b/Types/MetaData.hs @@ -244,12 +244,17 @@ metaDataValues :: MetaField -> MetaData -> S.Set MetaValue metaDataValues f (MetaData m) = fromMaybe S.empty (M.lookup f m) +mapMetaData :: (S.Set MetaValue -> S.Set MetaValue) -> MetaData -> MetaData +mapMetaData f (MetaData m) = MetaData (M.map f m) + {- Ways that existing metadata can be modified -} data ModMeta = AddMeta MetaField MetaValue | DelMeta MetaField (Maybe MetaValue) -- ^ delete value of a field. With Just, only that specific value - -- is deleted; with Nothing, all current values are deleted. + -- is deleted; with Nothing, all current values are deleted.a + | DelAllMeta + -- ^ delete all currently set metadata | SetMeta MetaField (S.Set MetaValue) -- ^ removes any existing values | MaybeSetMeta MetaField MetaValue @@ -265,6 +270,9 @@ updateMetaData f (unsetMetaValue oldv) emptyMetaData modMeta m (DelMeta f Nothing) = MetaData $ M.singleton f $ S.fromList $ map unsetMetaValue $ S.toList $ currentMetaDataValues f m +modMeta m DelAllMeta = mapMetaData + (S.fromList . map unsetMetaValue . S.toList) + (currentMetaData m) modMeta m (SetMeta f s) = updateMetaData' f s $ foldr (updateMetaData f) emptyMetaData $ map unsetMetaValue $ S.toList $ currentMetaDataValues f m diff --git a/doc/git-annex-metadata.mdwn b/doc/git-annex-metadata.mdwn --- a/doc/git-annex-metadata.mdwn +++ b/doc/git-annex-metadata.mdwn @@ -60,6 +60,15 @@ Unset a tag. +* `--remove-all` + + Remove all metadata from the specified files. + + When a file is modified and the new version added, git-annex will copy + over the metadata from the old version of the file. In situations where + you don't want that copied metadata, you can use this option to remove + it. + * `--force` By default, `git annex metadata` refuses to recursively set metadata diff --git a/doc/git-annex-sync.mdwn b/doc/git-annex-sync.mdwn --- a/doc/git-annex-sync.mdwn +++ b/doc/git-annex-sync.mdwn @@ -125,6 +125,19 @@ resolution. It can also be disabled by setting annex.resolvemerge to false. +* `--cleanup` + + Removes the local and remote `synced/` branches, which were created + and pushed by `git-annex sync`. + + This can come in handy when you've synced a change to remotes and now + want to reset your master branch back before that change. So you + run `git reset` and force-push the master branch to remotes, only + to find that the next `git annex merge` or `git annex sync` brings the + changes back. Why? Because the `synced/master` branch is hanging + around and still has the change in it. Cleaning up the `synced/` branches + prevents that problem. + # SEE ALSO [[git-annex]](1) diff --git a/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 6.20170925 +Version: 6.20171003 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess @@ -399,6 +399,7 @@ if flag(S3) Build-Depends: conduit, conduit-extra, aws (>= 0.9.2) CPP-Options: -DWITH_S3 + Other-Modules: Remote.S3 if flag(WebDAV) Build-Depends: DAV (>= 1.0) @@ -919,7 +920,6 @@ Remote.P2P Remote.Rsync Remote.Rsync.RsyncUrl - Remote.S3 Remote.Tahoe Remote.Web Remote.WebDAV