else do
mergedrefs <- getMergedRefs
filterM isnewer (excludeset mergedrefs unignoredrefs)
- journalclean <- if null tomerge
+ journalcleaned <- if null tomerge
{- Even when no refs need to be merged, the index
- may still be updated if the branch has gotten ahead
- of the index, or just if the journal is dirty. -}
else do
lockJournal $ go branchref dirty tomerge
return True
+ journalclean <- if journalcleaned
+ then not <$> privateUUIDsKnown
+ else pure False
return $ UpdateMade
{ refsWereMerged = not (null tomerge)
, journalClean = journalclean
- -- TODO need private index, then this can be
- -- removed
- && not privateUUIDsKnown
}
where
excludeset s = filter (\(r, _) -> S.notMember r s)
{- Only get private information when the RegardingUUID is itself private. -}
getToChange :: RegardingUUID -> RawFilePath -> Annex L.ByteString
-getToChange = getLocal' . GetPrivate . regardingPrivateUUID
+getToChange ru f = flip getLocal' f . GetPrivate =<< regardingPrivateUUID ru
{- Records new content of a file into the journal.
-
{- Lists all files currently in the journal. There may be duplicates in
- the list when using a private journal. -}
journalledFiles :: Annex [RawFilePath]
-journalledFiles
- | privateUUIDsKnown = (++)
+journalledFiles = ifM privateUUIDsKnown
+ ( (++)
<$> getJournalledFilesStale gitAnnexPrivateJournalDir
<*> getJournalledFilesStale gitAnnexJournalDir
- | otherwise = getJournalledFilesStale gitAnnexJournalDir
+ , getJournalledFilesStale gitAnnexJournalDir
+ )
{- Files in the branch, not including any from journalled changes,
- and without updating the branch. -}
module Annex.Journal where
import Annex.Common
+import qualified Annex
import qualified Git
import Annex.Perms
import Annex.Tmp
import Annex.LockFile
import Utility.Directory.Stream
+import qualified Data.Set as S
import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString as S
+import qualified Data.ByteString as B
import qualified System.FilePath.ByteString as P
import Data.ByteString.Builder
import Data.Char
{- When a file in the git-annex branch is changed, this indicates what
- repository UUID (or in some cases, UUIDs) a change is regarding.
-
- - Using this lets changes regarding private UUIDs be written to the
- - private index, rather than to the main branch index, so it does
- - not get exposed to other remotes.
+ - Using this lets changes regarding private UUIDs be stored separately
+ - from the git-annex branch, so its information does not get exposed
+ - outside the repo.
-}
data RegardingUUID = RegardingUUID [UUID]
-regardingPrivateUUID :: RegardingUUID -> Bool
-regardingPrivateUUID (RegardingUUID []) = False
-regardingPrivateUUID (RegardingUUID _) = True -- TODO
+regardingPrivateUUID :: RegardingUUID -> Annex Bool
+regardingPrivateUUID (RegardingUUID []) = pure False
+regardingPrivateUUID (RegardingUUID us) = do
+ s <- annexPrivateRepos <$> Annex.getGitConfig
+ return (any (flip S.member s) us)
--- Are any private UUIDs known to exist? If so, extra work has to be done,
--- to check for information separately recorded for them, outside the usual
--- locations.
-privateUUIDsKnown :: Bool
-privateUUIDsKnown = True -- TODO
+{- Are any private UUIDs known to exist? If so, extra work has to be done,
+ - to check for information separately recorded for them, outside the usual
+ - locations.
+ -}
+privateUUIDsKnown :: Annex Bool
+privateUUIDsKnown = privateUUIDsKnown' <$> Annex.getState id
+
+privateUUIDsKnown' :: Annex.AnnexState -> Bool
+privateUUIDsKnown' = not . S.null . annexPrivateRepos . Annex.gitconfig
{- Records content for a file in the branch to the journal.
-
-}
setJournalFile :: Journalable content => JournalLocked -> RegardingUUID -> RawFilePath -> content -> Annex ()
setJournalFile _jl ru file content = withOtherTmp $ \tmp -> do
- jd <- fromRepo $ if regardingPrivateUUID ru
- then gitAnnexPrivateJournalDir
- else gitAnnexJournalDir
+ jd <- fromRepo =<< ifM (regardingPrivateUUID ru)
+ ( return gitAnnexPrivateJournalDir
+ , return gitAnnexJournalDir
+ )
createAnnexDirectory jd
-- journal file is written atomically
let jfile = journalFile file
- laziness doesn't matter much, as the files are not very large.
-}
getJournalFileStale :: GetPrivate -> RawFilePath -> Annex (Maybe L.ByteString)
-getJournalFileStale (GetPrivate getprivate) file = inRepo $ \g ->
- if getprivate && privateUUIDsKnown
+getJournalFileStale (GetPrivate getprivate) file = do
+ -- Optimisation to avoid a second MVar access.
+ st <- Annex.getState id
+ let g = Annex.repo st
+ liftIO $
+ if getprivate && privateUUIDsKnown' st
then do
x <- getfrom (gitAnnexJournalDir g)
y <- getfrom (gitAnnexPrivateJournalDir g)
where
jfile = journalFile file
getfrom d = catchMaybeIO $
- L.fromStrict <$> S.readFile (fromRawFilePath (d P.</> jfile))
+ L.fromStrict <$> B.readFile (fromRawFilePath (d P.</> jfile))
{- List of existing journal files in a journal directory, but without locking,
- may miss new ones just being added, or may have false positives if the
- in the journal directory.
-}
journalFile :: RawFilePath -> RawFilePath
-journalFile file = S.concatMap mangle file
+journalFile file = B.concatMap mangle file
where
mangle c
- | P.isPathSeparator c = S.singleton underscore
- | c == underscore = S.pack [underscore, underscore]
- | otherwise = S.singleton c
+ | P.isPathSeparator c = B.singleton underscore
+ | c == underscore = B.pack [underscore, underscore]
+ | otherwise = B.singleton c
underscore = fromIntegral (ord '_')
{- Converts a journal file (relative to the journal dir) back to the
fileJournal = go
where
go b =
- let (h, t) = S.break (== underscore) b
- in h <> case S.uncons t of
+ let (h, t) = B.break (== underscore) b
+ in h <> case B.uncons t of
Nothing -> t
- Just (_u, t') -> case S.uncons t' of
+ Just (_u, t') -> case B.uncons t' of
Nothing -> t'
Just (w, t'')
| w == underscore ->
- S.cons underscore (go t'')
+ B.cons underscore (go t'')
| otherwise ->
- S.cons P.pathSeparator (go t')
+ B.cons P.pathSeparator (go t')
underscore = fromIntegral (ord '_')
{- git remote stuff
-
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{- Is a git config key one that specifies the url of a remote? -}
isRemoteUrlKey :: ConfigKey -> Bool
-isRemoteUrlKey (ConfigKey k) = "remote." `S.isPrefixOf` k && ".url" `S.isSuffixOf` k
+isRemoteUrlKey = isRemoteKey "url"
+
+isRemoteKey :: S.ByteString -> ConfigKey -> Bool
+isRemoteKey want (ConfigKey k) =
+ "remote." `S.isPrefixOf` k && ("." <> want) `S.isSuffixOf` k
{- Get a remote's name from the a config key such as remote.name.url
- or any other per-remote config key. -}
import qualified Git.Construct
import Git.Types
import Git.ConfigTypes
+import Git.Remote (isRemoteKey, remoteKeyToRemoteName)
import Git.Branch (CommitMode(..))
import Utility.DataUnits
import Config.Cost
import Control.Concurrent.STM
import qualified Data.Set as S
+import qualified Data.Map as M
import qualified Data.ByteString as B
-- | A configurable value, that may not be fully determined yet because
, gcryptId :: Maybe String
, gpgCmd :: GpgCmd
, mergeDirectoryRenames :: Maybe String
+ , annexPrivateRepos :: S.Set UUID
}
extractGitConfig :: ConfigSource -> Git.Repo -> GitConfig
extractGitConfig configsource r = GitConfig
{ annexVersion = RepoVersion <$> getmayberead (annexConfig "version")
- , annexUUID = maybe NoUUID toUUID $ getmaybe (annexConfig "uuid")
+ , annexUUID = hereuuid
, annexNumCopies = NumCopies <$> getmayberead (annexConfig "numcopies")
, annexDiskReserve = fromMaybe onemegabyte $
readSize dataUnits =<< getmaybe (annexConfig "diskreserve")
, gcryptId = getmaybe "core.gcrypt-id"
, gpgCmd = mkGpgCmd (getmaybe "gpg.program")
, mergeDirectoryRenames = getmaybe "directoryrenames"
+ , annexPrivateRepos = S.fromList $ concat
+ [ if getbool (annexConfig "private") False
+ then [hereuuid]
+ else []
+ , let get (k, v)
+ | Git.Config.isTrueFalse' v /= Just True = Nothing
+ | isRemoteKey (remoteAnnexConfigEnd "private") k = do
+ remotename <- remoteKeyToRemoteName k
+ toUUID <$> Git.Config.getMaybe
+ (remoteAnnexConfig remotename "uuid") r
+ | otherwise = Nothing
+ in mapMaybe get (M.toList (Git.config r))
+ ]
}
where
getbool k d = fromMaybe d $ getmaybebool k
FromGlobalConfig -> HasGlobalConfig v
onemegabyte = 1000000
+
+ hereuuid = maybe NoUUID toUUID $ getmaybe (annexConfig "uuid")
{- Merge a GitConfig that comes from git-config with one containing
- repository-global defaults. -}
{- A per-remote annex setting in git config. -}
remoteAnnexConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey
-remoteAnnexConfig r key = remoteConfig r ("annex-" <> key)
+remoteAnnexConfig r = remoteConfig r . remoteAnnexConfigEnd
+
+remoteAnnexConfigEnd :: UnqualifiedConfigKey -> UnqualifiedConfigKey
+remoteAnnexConfigEnd key = "annex-" <> key
{- A per-remote setting in git config. -}
remoteConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey
> Annex.Branch, also need to be fixed (and may be missing journal files
> already?) Most fixed now. Command.Log behavior needs to be
> investigated still.
->
-> * Need to implement regardingPrivateUUID and privateUUIDsKnown,
-> which need to look at the git config to find the private uuids.
->
-> But that involves a mvar access, so there will be some slow down,
-> although often it will be swamped by the actual branch querying.
-> So far it's been possible to avoid any slow down from this feature
-> when it's not in use.
->
-> Encoding inside the uuid if a repo is private avoids slowdown of
-> regardingPrivateUUID, but not privateUUIDsKnown. (So branch queries
-> still slow down). It also avoids needing to set the config before
-> writing to the branch when setting up a private repo or special remote.
## networks of hidden repos
projects / git-annex.git / commitdiff