handle Annex.Branch.files with read-only unmerged git-annex branches

It would be difficult to make Annex.Branch.files query the unmerged
git-annex branches. Might be possible, similar to what was discussed in
7f6b2ca49c but again I decided to make it
not do anything in that situation to start with before adding such a
complicated thing.

git-annex info uses it when getting info about a repostory. The choices
were to make that fail with an error, or display the info it can, and
change the output slightly for the bits of info it cannot access. While
that is a behavior change, and I want to avoid any behavior changes due
to unmerged git-annex branches in a read-only repo, displaying a message
that is not a number seems unlikely to break anything that was consuming
a number, any worse than throwing an exception would. Probably.

Also git-annex unused --from origin is made to throw an error, but
it would fail later anyway when trying to write to the unused log files.

Sponsored-by: Dartmouth College's Datalad project
This commit is contained in:
Joey Hess 2021-12-27 15:28:31 -04:00
parent 7f6b2ca49c
commit 23a485498f
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 61 additions and 38 deletions

View file

@ -468,16 +468,28 @@ commitIndex' jl branchref message basemessage retrynum parents = do
commitIndex' jl committedref racemessage basemessage retrynum' [committedref] commitIndex' jl committedref racemessage basemessage retrynum' [committedref]
{- Lists all files on the branch. including ones in the journal {- Lists all files on the branch. including ones in the journal
- that have not been committed yet. There may be duplicates in the list. -} - that have not been committed yet.
files :: Annex ([RawFilePath], IO Bool) -
- There may be duplicates in the list, when the journal has files that
- have not been written to the branch yet.
-
- In a read-only repository that has other git-annex branches that have
- not been merged in, returns Nothing, because it's not possible to
- efficiently handle that.
-}
files :: Annex (Maybe ([RawFilePath], IO Bool))
files = do files = do
_ <- update st <- update
(bfs, cleanup) <- branchFiles if not (null (unmergedRefs st))
-- ++ forces the content of the first list to be buffered in then return Nothing
-- memory, so use journalledFiles, which should be much smaller else do
-- most of the time. branchFiles will stream as the list is consumed. (bfs, cleanup) <- branchFiles
l <- (++) <$> journalledFiles <*> pure bfs -- ++ forces the content of the first list to be
return (l, cleanup) -- buffered in memory, so use journalledFiles,
-- which should be much smaller most of the time.
-- branchFiles will stream as the list is consumed.
l <- (++) <$> journalledFiles <*> pure bfs
return (Just (l, cleanup))
{- Lists all files currently in the journal. There may be duplicates in {- Lists all files currently in the journal. There may be duplicates in
- the list when using a private journal. -} - the list when using a private journal. -}

View file

@ -53,14 +53,14 @@ removeRemote uuid = do
- in keys in the current branch. - in keys in the current branch.
-} -}
removableRemote :: UrlRenderer -> UUID -> Assistant () removableRemote :: UrlRenderer -> UUID -> Assistant ()
removableRemote urlrenderer uuid = do removableRemote urlrenderer uuid = getkeys >>= \case
keys <- getkeys Just keys
if null keys | null keys -> finishRemovingRemote urlrenderer uuid
then finishRemovingRemote urlrenderer uuid | otherwise -> do
else do
r <- fromMaybe (error "unknown remote") r <- fromMaybe (error "unknown remote")
<$> liftAnnex (Remote.remoteFromUUID uuid) <$> liftAnnex (Remote.remoteFromUUID uuid)
mapM_ (queueremaining r) keys mapM_ (queueremaining r) keys
Nothing -> noop
where where
queueremaining r k = queueremaining r k =
queueTransferWhenSmall "remaining object in unwanted remote" queueTransferWhenSmall "remaining object in unwanted remote"

View file

@ -1,6 +1,6 @@
{- git-annex command {- git-annex command
- -
- Copyright 2011-2020 Joey Hess <id@joeyh.name> - Copyright 2011-2021 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -370,13 +370,17 @@ local_annex_size = simpleStat "local annex size" $
-- "remote" is in the name for JSON backwards-compatibility -- "remote" is in the name for JSON backwards-compatibility
repo_annex_keys :: UUID -> Stat repo_annex_keys :: UUID -> Stat
repo_annex_keys u = stat "remote annex keys" $ json show $ repo_annex_keys u = stat "remote annex keys" $ \d ->
countKeys <$> cachedRemoteData u cachedRemoteData u >>= \case
Right rd -> json show (pure (countKeys rd)) d
Left n-> json id (pure n) d
-- "remote" is in the name for JSON backwards-compatibility -- "remote" is in the name for JSON backwards-compatibility
repo_annex_size :: UUID -> Stat repo_annex_size :: UUID -> Stat
repo_annex_size u = simpleStat "remote annex size" $ repo_annex_size u = simpleStat "remote annex size" $
showSizeKeys =<< cachedRemoteData u cachedRemoteData u >>= \case
Right d -> showSizeKeys d
Left n -> pure n
known_annex_files :: Bool -> Stat known_annex_files :: Bool -> Stat
known_annex_files isworktree = known_annex_files isworktree =
@ -524,20 +528,22 @@ cachedPresentData = do
put s { presentData = Just v } put s { presentData = Just v }
return v return v
cachedRemoteData :: UUID -> StatState KeyInfo cachedRemoteData :: UUID -> StatState (Either String KeyInfo)
cachedRemoteData u = do cachedRemoteData u = do
s <- get s <- get
case M.lookup u (repoData s) of case M.lookup u (repoData s) of
Just v -> return v Just v -> return (Right v)
Nothing -> do Nothing -> do
let combinedata d uk = finishCheck uk >>= \case let combinedata d uk = finishCheck uk >>= \case
Nothing -> return d Nothing -> return d
Just k -> return $ addKey k d Just k -> return $ addKey k d
(ks, cleanup) <- lift $ loggedKeysFor' u lift (loggedKeysFor' u) >>= \case
v <- lift $ foldM combinedata emptyKeyInfo ks Just (ks, cleanup) -> do
liftIO $ void cleanup v <- lift $ foldM combinedata emptyKeyInfo ks
put s { repoData = M.insert u v (repoData s) } liftIO $ void cleanup
return v put s { repoData = M.insert u v (repoData s) }
return (Right v)
Nothing -> return (Left "not available in this read-only repository with unmerged git-annex branches")
cachedReferencedData :: StatState KeyInfo cachedReferencedData :: StatState KeyInfo
cachedReferencedData = do cachedReferencedData = do

View file

@ -101,7 +101,9 @@ checkRemoteUnused remotename refspec = go =<< Remote.nameToUUID remotename
r <- Remote.byUUID u r <- Remote.byUUID u
_ <- check "" (remoteUnusedMsg r remotename) (remoteunused u) 0 _ <- check "" (remoteUnusedMsg r remotename) (remoteunused u) 0
next $ return True next $ return True
remoteunused u = excludeReferenced refspec =<< loggedKeysFor u remoteunused u = loggedKeysFor u >>= \case
Just ks -> excludeReferenced refspec ks
Nothing -> giveup "This repository is read-only."
check :: FilePath -> ([(Int, Key)] -> String) -> Annex [Key] -> Int -> Annex Int check :: FilePath -> ([(Int, Key)] -> String) -> Annex [Key] -> Int -> Annex Int
check file msg a c = do check file msg a c = do

View file

@ -137,15 +137,17 @@ finishCheck (Unchecked a) = a
- -
- Keys that have been marked as dead are not included. - Keys that have been marked as dead are not included.
-} -}
loggedKeys :: Annex ([Unchecked Key], IO Bool) loggedKeys :: Annex (Maybe ([Unchecked Key], IO Bool))
loggedKeys = loggedKeys' (not <$$> checkDead) loggedKeys = loggedKeys' (not <$$> checkDead)
loggedKeys' :: (Key -> Annex Bool) -> Annex ([Unchecked Key], IO Bool) loggedKeys' :: (Key -> Annex Bool) -> Annex (Maybe ([Unchecked Key], IO Bool))
loggedKeys' check = do loggedKeys' check = do
config <- Annex.getGitConfig config <- Annex.getGitConfig
(bfs, cleanup) <- Annex.Branch.files Annex.Branch.files >>= \case
let l = mapMaybe (defercheck <$$> locationLogFileKey config) bfs Nothing -> return Nothing
return (l, cleanup) Just (bfs, cleanup) -> do
let l = mapMaybe (defercheck <$$> locationLogFileKey config) bfs
return (Just (l, cleanup))
where where
defercheck k = Unchecked $ ifM (check k) defercheck k = Unchecked $ ifM (check k)
( return (Just k) ( return (Just k)
@ -157,14 +159,15 @@ loggedKeys' check = do
- -
- This does not stream well; use loggedKeysFor' for lazy streaming. - This does not stream well; use loggedKeysFor' for lazy streaming.
-} -}
loggedKeysFor :: UUID -> Annex [Key] loggedKeysFor :: UUID -> Annex (Maybe [Key])
loggedKeysFor u = do loggedKeysFor u = loggedKeysFor' u >>= \case
(l, cleanup) <- loggedKeysFor' u Nothing -> return Nothing
l' <- catMaybes <$> mapM finishCheck l Just (l, cleanup) -> do
liftIO $ void cleanup l' <- catMaybes <$> mapM finishCheck l
return l' liftIO $ void cleanup
return (Just l')
loggedKeysFor' :: UUID -> Annex ([Unchecked Key], IO Bool) loggedKeysFor' :: UUID -> Annex (Maybe ([Unchecked Key], IO Bool))
loggedKeysFor' u = loggedKeys' isthere loggedKeysFor' u = loggedKeys' isthere
where where
isthere k = do isthere k = do