git-annex 7.20200309 → 8.20200226
raw patch · 66 files changed
+786/−483 lines, 66 files
Files
- Annex/Import.hs +2/−2
- Annex/Ingest.hs +27/−20
- Annex/Locations.hs +15/−9
- Annex/SpecialRemote.hs +1/−1
- Annex/UUID.hs +1/−1
- Annex/Url.hs +17/−2
- Annex/Version.hs +11/−10
- Annex/WorkTree.hs +1/−2
- Assistant/DaemonStatus.hs +1/−1
- Assistant/MakeRemote.hs +1/−1
- Assistant/Sync.hs +1/−1
- Assistant/Threads/Committer.hs +11/−10
- Assistant/Types/Changes.hs +2/−1
- Assistant/WebApp/Configurators/Edit.hs +1/−1
- Backend/Hash.hs +17/−15
- Backend/WORM.hs +4/−3
- CHANGELOG +34/−4
- CmdLine/Seek.hs +4/−13
- Command/Add.hs +11/−12
- Command/AddUrl.hs +2/−2
- Command/CalcKey.hs +4/−1
- Command/EnableRemote.hs +8/−5
- Command/Export.hs +1/−1
- Command/Import.hs +7/−5
- Command/InitRemote.hs +7/−4
- Command/Migrate.hs +2/−2
- Command/P2P.hs +1/−1
- Command/Reinject.hs +4/−1
- Command/Smudge.hs +11/−3
- Command/Sync.hs +3/−3
- Command/TestRemote.hs +2/−2
- Command/Uninit.hs +1/−1
- Config.hs +10/−6
- Config/Smudge.hs +0/−1
- Database/Benchmark.hs +19/−19
- Database/ContentIdentifier.hs +9/−7
- Database/Export.hs +25/−34
- Database/Fsck.hs +14/−12
- Database/Keys.hs +10/−11
- Database/Keys/SQL.hs +66/−60
- Database/Types.hs +84/−102
- Git/LsFiles.hs +55/−1
- Key.hs +1/−1
- NEWS +24/−0
- Remote.hs +2/−2
- Remote/External.hs +3/−3
- Remote/GCrypt.hs +1/−1
- Remote/Git.hs +3/−3
- Remote/GitLFS.hs +2/−2
- Remote/Helper/Special.hs +2/−2
- Remote/List.hs +2/−2
- Remote/S3.hs +1/−3
- Test.hs +3/−3
- Test/Framework.hs +2/−2
- Types/GitConfig.hs +3/−0
- Types/KeySource.hs +3/−2
- Types/RemoteConfig.hs +2/−3
- Upgrade.hs +2/−0
- Upgrade/V7.hs +132/−0
- Utility/IPAddress.hs +11/−4
- Utility/InodeCache.hs +21/−18
- doc/git-annex-add.mdwn +7/−9
- doc/git-annex-enableremote.mdwn +14/−20
- doc/git-annex-init.mdwn +3/−0
- doc/git-annex.mdwn +33/−9
- git-annex.cabal +2/−1
Annex/Import.hs view
@@ -369,8 +369,8 @@ f <- fromRepo $ fromTopFilePath $ locworktreefilename loc backend <- chooseBackend (fromRawFilePath f) let ks = KeySource- { keyFilename = (fromRawFilePath f)- , contentLocation = tmpfile+ { keyFilename = f+ , contentLocation = toRawFilePath tmpfile , inodeCache = Nothing } fmap fst <$> genKey ks nullMeterUpdate backend
Annex/Ingest.hs view
@@ -49,6 +49,7 @@ import Annex.FileMatcher import Control.Exception (IOException)+import qualified Utility.RawFilePath as R data LockedDown = LockedDown { lockDownConfig :: LockDownConfig@@ -91,13 +92,15 @@ Just tmpdir -> withhardlink tmpdir ) where+ file' = toRawFilePath file+ nohardlink = withTSDelta $ liftIO . nohardlink' nohardlink' delta = do cache <- genInodeCache (toRawFilePath file) delta return $ LockedDown cfg $ KeySource- { keyFilename = file- , contentLocation = file+ { keyFilename = file'+ , contentLocation = file' , inodeCache = cache } @@ -116,8 +119,8 @@ createLink file tmpfile cache <- genInodeCache (toRawFilePath tmpfile) delta return $ LockedDown cfg $ KeySource- { keyFilename = file- , contentLocation = tmpfile+ { keyFilename = file'+ , contentLocation = toRawFilePath tmpfile , inodeCache = cache } @@ -135,10 +138,11 @@ Just k -> do let f = keyFilename source if lockingFile cfg- then addLink f k mic+ then addLink (fromRawFilePath f) k mic else do- mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus (contentLocation source)- stagePointerFile (toRawFilePath f) mode =<< hashPointerFile k+ mode <- liftIO $ catchMaybeIO $+ fileMode <$> R.getFileStatus (contentLocation source)+ stagePointerFile f mode =<< hashPointerFile k return (Just k) {- Ingests a locked down file into the annex. Does not update the working@@ -151,12 +155,15 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage = withTSDelta $ \delta -> do k <- case mk of Nothing -> do- backend <- maybe (chooseBackend $ keyFilename source) (return . Just) preferredbackend+ backend <- maybe+ (chooseBackend $ fromRawFilePath $ keyFilename source)+ (return . Just)+ preferredbackend fmap fst <$> genKey source meterupdate backend Just k -> return (Just k) let src = contentLocation source- ms <- liftIO $ catchMaybeIO $ getFileStatus src- mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta src) ms+ ms <- liftIO $ catchMaybeIO $ R.getFileStatus src+ mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta (fromRawFilePath src)) ms case (mcache, inodeCache source) of (_, Nothing) -> go k mcache ms (Just newc, Just c) | compareStrong c newc -> go k mcache ms@@ -168,12 +175,12 @@ go _ _ _ = failure "failed to generate a key" golocked key mcache s =- tryNonAsync (moveAnnex key $ contentLocation source) >>= \case+ tryNonAsync (moveAnnex key $ fromRawFilePath $ contentLocation source) >>= \case Right True -> do populateAssociatedFiles key source restage success key mcache s Right False -> giveup "failed to add content to annex"- Left e -> restoreFile (keyFilename source) key e+ Left e -> restoreFile (fromRawFilePath $ keyFilename source) key e gounlocked key (Just cache) s = do -- Remove temp directory hard link first because@@ -181,7 +188,7 @@ -- already has a hard link. cleanCruft source cleanOldKeys (keyFilename source) key- linkToAnnex key (keyFilename source) (Just cache) >>= \case+ linkToAnnex key (fromRawFilePath $ keyFilename source) (Just cache) >>= \case LinkAnnexFailed -> failure "failed to link to annex" _ -> do finishIngestUnlocked' key source restage@@ -189,11 +196,11 @@ gounlocked _ _ _ = failure "failed statting file" success k mcache s = do- genMetaData k (toRawFilePath (keyFilename source)) s+ genMetaData k (keyFilename source) s return (Just k, mcache) failure msg = do- warning $ keyFilename source ++ " " ++ msg+ warning $ fromRawFilePath (keyFilename source) ++ " " ++ msg cleanCruft source return (Nothing, Nothing) @@ -205,7 +212,7 @@ finishIngestUnlocked' :: Key -> KeySource -> Restage -> Annex () finishIngestUnlocked' key source restage = do Database.Keys.addAssociatedFile key- =<< inRepo (toTopFilePath (toRawFilePath (keyFilename source)))+ =<< inRepo (toTopFilePath (keyFilename source)) populateAssociatedFiles key source restage {- Copy to any other locations using the same key. -}@@ -214,22 +221,22 @@ obj <- calcRepo (gitAnnexLocation key) g <- Annex.gitRepo ingestedf <- flip fromTopFilePath g- <$> inRepo (toTopFilePath (toRawFilePath (keyFilename source)))+ <$> inRepo (toTopFilePath (keyFilename source)) afs <- map (`fromTopFilePath` g) <$> Database.Keys.getAssociatedFiles key forM_ (filter (/= ingestedf) afs) $ populatePointerFile restage key obj cleanCruft :: KeySource -> Annex () cleanCruft source = when (contentLocation source /= keyFilename source) $- liftIO $ nukeFile $ contentLocation source+ liftIO $ nukeFile $ fromRawFilePath $ contentLocation source -- If a worktree file was was hard linked to an annex object before, -- modifying the file would have caused the object to have the wrong -- content. Clean up from that.-cleanOldKeys :: FilePath -> Key -> Annex ()+cleanOldKeys :: RawFilePath -> Key -> Annex () cleanOldKeys file newkey = do g <- Annex.gitRepo- topf <- inRepo (toTopFilePath (toRawFilePath file))+ topf <- inRepo (toTopFilePath file) ingestedf <- fromRepo $ fromTopFilePath topf oldkeys <- filter (/= newkey) <$> Database.Keys.getAssociatedKey topf
Annex/Locations.hs view
@@ -42,10 +42,12 @@ gitAnnexKeysDbIndexCache, gitAnnexFsckState, gitAnnexFsckDbDir,+ gitAnnexFsckDbDirOld, gitAnnexFsckDbLock, gitAnnexFsckResultsLog, gitAnnexSmudgeLog, gitAnnexSmudgeLock,+ gitAnnexExportDir, gitAnnexExportDbDir, gitAnnexExportLock, gitAnnexExportUpdateLock,@@ -328,16 +330,16 @@ gitAnnexUnusedLog prefix r = fromRawFilePath (gitAnnexDir r) </> (prefix ++ "unused") -{- .git/annex/keys/ contains a database of information about keys. -}+{- .git/annex/keysdb/ contains a database of information about keys. -} gitAnnexKeysDb :: Git.Repo -> FilePath-gitAnnexKeysDb r = fromRawFilePath $ gitAnnexDir r P.</> "keys"+gitAnnexKeysDb r = fromRawFilePath $ gitAnnexDir r P.</> "keysdb" {- Lock file for the keys database. -} gitAnnexKeysDbLock :: Git.Repo -> FilePath gitAnnexKeysDbLock r = gitAnnexKeysDb r ++ ".lck" {- Contains the stat of the last index file that was- - reconciled with rhe keys database. -}+ - reconciled with the keys database. -} gitAnnexKeysDbIndexCache :: Git.Repo -> FilePath gitAnnexKeysDbIndexCache r = gitAnnexKeysDb r ++ ".cache" @@ -353,8 +355,12 @@ {- Directory containing database used to record fsck info. -} gitAnnexFsckDbDir :: UUID -> Git.Repo -> FilePath-gitAnnexFsckDbDir u r = gitAnnexFsckDir u r </> "db"+gitAnnexFsckDbDir u r = gitAnnexFsckDir u r </> "fsckdb" +{- Directory containing old database used to record fsck info. -}+gitAnnexFsckDbDirOld :: UUID -> Git.Repo -> FilePath+gitAnnexFsckDbDirOld u r = gitAnnexFsckDir u r </> "db"+ {- Lock file for the fsck database. -} gitAnnexFsckDbLock :: UUID -> Git.Repo -> FilePath gitAnnexFsckDbLock u r = gitAnnexFsckDir u r </> "fsck.lck"@@ -372,14 +378,14 @@ gitAnnexSmudgeLock :: Git.Repo -> FilePath gitAnnexSmudgeLock r = fromRawFilePath $ gitAnnexDir r P.</> "smudge.lck" -{- .git/annex/export/uuid/ is used to store information about+{- .git/annex/export/ is used to store information about - exports to special remotes. -}-gitAnnexExportDir :: UUID -> Git.Repo -> FilePath-gitAnnexExportDir u r = fromRawFilePath (gitAnnexDir r) </> "export" </> fromUUID u+gitAnnexExportDir :: Git.Repo -> FilePath+gitAnnexExportDir r = fromRawFilePath $ gitAnnexDir r P.</> "export" {- Directory containing database used to record export info. -} gitAnnexExportDbDir :: UUID -> Git.Repo -> FilePath-gitAnnexExportDbDir u r = gitAnnexExportDir u r </> "db"+gitAnnexExportDbDir u r = gitAnnexExportDir r </> fromUUID u </> "exportdb" {- Lock file for export state for a special remote. -} gitAnnexExportLock :: UUID -> Git.Repo -> FilePath@@ -401,7 +407,7 @@ - need to be rebuilt with a new name.) -} gitAnnexContentIdentifierDbDir :: Git.Repo -> FilePath-gitAnnexContentIdentifierDbDir r = fromRawFilePath $ gitAnnexDir r P.</> "cids"+gitAnnexContentIdentifierDbDir r = fromRawFilePath $ gitAnnexDir r P.</> "cidsdb" {- Lock file for writing to the content id database. -} gitAnnexContentIdentifierLock :: Git.Repo -> FilePath
Annex/SpecialRemote.hs view
@@ -95,7 +95,7 @@ Left e -> warning (show e) Right (_c, _u) -> when (cu /= u) $- setConfig (remoteConfig c "config-uuid") (fromUUID cu)+ setConfig (remoteAnnexConfig c "config-uuid") (fromUUID cu) _ -> return () where configured rc = fromMaybe False $
Annex/UUID.hs view
@@ -81,7 +81,7 @@ updatecache u = do g <- gitRepo when (g /= r) $ storeUUIDIn cachekey u- cachekey = remoteConfig r "uuid"+ cachekey = remoteAnnexConfig r "uuid" removeRepoUUID :: Annex () removeRepoUUID = do
Annex/Url.hs view
@@ -41,6 +41,7 @@ import Network.Socket import Network.HTTP.Client import Network.HTTP.Client.TLS+import Text.Read defaultUserAgent :: U.UserAgent defaultUserAgent = "git-annex/" ++ BuildInfo.packageversion@@ -85,10 +86,11 @@ manager <- liftIO $ U.newManager $ avoidtimeout $ tlsManagerSettings return (urldownloader, manager)- allowedaddrs -> do+ allowedaddrsports -> do addrmatcher <- liftIO $ (\l v -> any (\f -> f v) l) . catMaybes- <$> mapM makeAddressMatcher allowedaddrs+ <$> mapM (uncurry makeAddressMatcher) + (mapMaybe splitAddrPort allowedaddrsports) -- Default to not allowing access to loopback -- and private IP addresses to avoid data -- leakage.@@ -119,6 +121,19 @@ -- or so, but some web servers are slower and git-annex has its own -- separate timeout controls, so disable that. avoidtimeout s = s { managerResponseTimeout = responseTimeoutNone }++splitAddrPort :: String -> Maybe (String, Maybe PortNumber)+splitAddrPort s+ -- "[addr]:port" (also allow "[addr]")+ | "[" `isPrefixOf` s = case splitc ']' (drop 1 s) of+ [a,cp] -> case splitc ':' cp of+ ["",p] -> do+ pn <- readMaybe p+ return (a, Just pn)+ [""] -> Just (a, Nothing)+ _ -> Nothing+ _ -> Nothing+ | otherwise = Just (s, Nothing) ipAddressesUnlimited :: Annex Bool ipAddressesUnlimited =
Annex/Version.hs view
@@ -1,6 +1,6 @@ {- git-annex repository versioning -- - Copyright 2010-2018 Joey Hess <id@joeyh.name>+ - Copyright 2010-2019 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -19,27 +19,28 @@ import qualified Data.Map as M defaultVersion :: RepoVersion-defaultVersion = RepoVersion 7+defaultVersion = RepoVersion 8 latestVersion :: RepoVersion-latestVersion = RepoVersion 7+latestVersion = RepoVersion 8 supportedVersions :: [RepoVersion]-supportedVersions = map RepoVersion [7]+supportedVersions = map RepoVersion [8] upgradableVersions :: [RepoVersion] #ifndef mingw32_HOST_OS-upgradableVersions = map RepoVersion [0..6]+upgradableVersions = map RepoVersion [0..7] #else-upgradableVersions = map RepoVersion [2..6]+upgradableVersions = map RepoVersion [2..7] #endif autoUpgradeableVersions :: M.Map RepoVersion RepoVersion autoUpgradeableVersions = M.fromList- [ (RepoVersion 3, RepoVersion 5)- , (RepoVersion 4, RepoVersion 5)- , (RepoVersion 5, RepoVersion 6)- , (RepoVersion 6, RepoVersion 7)+ [ (RepoVersion 3, latestVersion)+ , (RepoVersion 4, latestVersion)+ , (RepoVersion 5, latestVersion)+ , (RepoVersion 6, latestVersion)+ , (RepoVersion 7, latestVersion) ] versionField :: ConfigKey
Annex/WorkTree.hs view
@@ -19,7 +19,6 @@ import qualified Git.Ref import qualified Git.LsTree import qualified Git.Types-import Database.Types import qualified Database.Keys import qualified Database.Keys.SQL import Config@@ -94,7 +93,7 @@ add i k = do let tf = Git.LsTree.file i Database.Keys.runWriter $- liftIO . Database.Keys.SQL.addAssociatedFileFast (toIKey k) tf+ liftIO . Database.Keys.SQL.addAssociatedFileFast k tf whenM (inAnnex k) $ do f <- fromRepo $ fromTopFilePath tf liftIO (isPointerFile f) >>= \case
Assistant/DaemonStatus.hs view
@@ -60,7 +60,7 @@ return $ \dstatus -> dstatus { syncRemotes = syncable- , syncGitRemotes = filter Remote.gitSyncableRemote syncable+ , syncGitRemotes = filter (Remote.gitSyncableRemoteType . Remote.remotetype) syncable , syncDataRemotes = dataremotes , exportRemotes = exportremotes , downloadRemotes = contentremotes
Assistant/MakeRemote.hs view
@@ -113,7 +113,7 @@ Nothing -> configSet u c' Just (Annex.SpecialRemote.ConfigFrom cu) -> do- setConfig (remoteConfig c' "config-uuid") (fromUUID cu)+ setConfig (remoteAnnexConfig c' "config-uuid") (fromUUID cu) configSet cu c' when setdesc $ whenM (isNothing . M.lookup u <$> uuidDescMap) $
Assistant/Sync.hs view
@@ -265,7 +265,7 @@ changeSyncFlag :: Remote -> Bool -> Annex () changeSyncFlag r enabled = do repo <- Remote.getRepo r- let key = Config.remoteConfig repo "sync"+ let key = Config.remoteAnnexConfig repo "sync" Config.setConfig key (boolConfig enabled) void Remote.remoteListRefresh
Assistant/Threads/Committer.hs view
@@ -286,9 +286,9 @@ ks = keySource ld doadd = sanitycheck ks $ do (mkey, _mcache) <- liftAnnex $ do- showStart "add" $ toRawFilePath $ keyFilename ks+ showStart "add" $ keyFilename ks ingest nullMeterUpdate (Just $ LockedDown lockdownconfig ks) Nothing- maybe (failedingest change) (done change $ keyFilename ks) mkey+ maybe (failedingest change) (done change $ fromRawFilePath $ keyFilename ks) mkey add _ _ = return Nothing {- Avoid overhead of re-injesting a renamed unlocked file, by@@ -320,7 +320,7 @@ fastadd change key = do let source = keySource $ lockedDown change liftAnnex $ finishIngestUnlocked key source- done change (keyFilename source) key+ done change (fromRawFilePath $ keyFilename source) key removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key) removedKeysMap ct l = do@@ -347,14 +347,14 @@ - and is still a hard link to its contentLocation, - before ingesting it. -} sanitycheck keysource a = do- fs <- liftIO $ getSymbolicLinkStatus $ keyFilename keysource- ks <- liftIO $ getSymbolicLinkStatus $ contentLocation keysource+ fs <- liftIO $ getSymbolicLinkStatus $ fromRawFilePath $ keyFilename keysource+ ks <- liftIO $ getSymbolicLinkStatus $ fromRawFilePath $ contentLocation keysource if deviceID ks == deviceID fs && fileID ks == fileID fs then a else do -- remove the hard link when (contentLocation keysource /= keyFilename keysource) $- void $ liftIO $ tryIO $ removeFile $ contentLocation keysource+ void $ liftIO $ tryIO $ removeFile $ fromRawFilePath $ contentLocation keysource return Nothing {- Shown an alert while performing an action to add a file or@@ -400,7 +400,7 @@ else return checked where check openfiles change@(InProcessAddChange { lockedDown = ld })- | S.member (contentLocation (keySource ld)) openfiles = Left change+ | S.member (fromRawFilePath (contentLocation (keySource ld))) openfiles = Left change check _ change = Right change mkinprocess (c, Just ld) = Just InProcessAddChange@@ -411,11 +411,11 @@ canceladd (InProcessAddChange { lockedDown = ld }) = do let ks = keySource ld- warning $ keyFilename ks+ warning $ fromRawFilePath (keyFilename ks) ++ " still has writers, not adding" -- remove the hard link when (contentLocation ks /= keyFilename ks) $- void $ liftIO $ tryIO $ removeFile $ contentLocation ks+ void $ liftIO $ tryIO $ removeFile $ fromRawFilePath $ contentLocation ks canceladd _ = noop openwrite (_file, mode, _pid)@@ -434,7 +434,8 @@ -} findopenfiles keysources = ifM crippledFileSystem ( liftIO $ do- let segments = segmentXargsUnordered $ map keyFilename keysources+ let segments = segmentXargsUnordered $+ map (fromRawFilePath . keyFilename) keysources concat <$> forM segments (\fs -> Lsof.query $ "--" : fs) , liftIO $ Lsof.queryDir lockdowndir )
Assistant/Types/Changes.hs view
@@ -12,6 +12,7 @@ import Types.KeySource import Types.Key import Utility.TList+import Utility.FileSystemEncoding import Annex.Ingest import Control.Concurrent.STM@@ -57,7 +58,7 @@ changeFile :: Change -> FilePath changeFile (Change _ f _) = f changeFile (PendingAddChange _ f) = f-changeFile (InProcessAddChange _ ld) = keyFilename $ keySource ld+changeFile (InProcessAddChange _ ld) = fromRawFilePath $ keyFilename $ keySource ld isPendingAddChange :: Change -> Bool isPendingAddChange (PendingAddChange {}) = True
Assistant/WebApp/Configurators/Edit.hs view
@@ -306,7 +306,7 @@ liftAnnex $ do repo <- Remote.getRepo rmt setConfig- (remoteConfig repo "ignore")+ (remoteAnnexConfig repo "ignore") (Git.Config.boolConfig False) liftAnnex $ void Remote.remoteListRefresh liftAssistant updateSyncRemotes
Backend/Hash.hs view
@@ -1,6 +1,6 @@ {- git-annex hashing backends -- - Copyright 2011-2019 Joey Hess <id@joeyh.name>+ - Copyright 2011-2020 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -24,7 +24,9 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L+import qualified System.FilePath.ByteString as P import Data.Char+import Data.Word import Control.DeepSeq import Control.Exception (evaluate) @@ -88,7 +90,7 @@ {- A key is a hash of its contents. -} keyValue :: Hash -> KeySource -> MeterUpdate -> Annex (Maybe Key) keyValue hash source meterupdate = do- let file = contentLocation source+ let file = fromRawFilePath (contentLocation source) filesize <- liftIO $ getFileSize file s <- hashFile hash file meterupdate return $ Just $ mkKey $ \k -> k@@ -106,20 +108,20 @@ maxlen <- annexMaxExtensionLength <$> Annex.getGitConfig let ext = selectExtension maxlen (keyFilename source) return $ Just $ alterKey k $ \d -> d- { keyName = keyName d <> encodeBS ext+ { keyName = keyName d <> ext , keyVariety = hashKeyVariety hash (HasExt True) } -selectExtension :: Maybe Int -> FilePath -> String+selectExtension :: Maybe Int -> RawFilePath -> S.ByteString selectExtension maxlen f | null es = ""- | otherwise = intercalate "." ("":es)+ | otherwise = S.intercalate "." ("":es) where- es = filter (not . null) $ reverse $- take 2 $ filter (all validInExtension) $+ es = filter (not . S.null) $ reverse $+ take 2 $ filter (S.all validInExtension) $ takeWhile shortenough $- reverse $ splitc '.' $ takeExtensions f- shortenough e = length e <= fromMaybe maxExtensionLen maxlen+ reverse $ S.split (fromIntegral (ord '.')) (P.takeExtensions f)+ shortenough e = S.length e <= fromMaybe maxExtensionLen maxlen maxExtensionLen :: Int maxExtensionLen = 4 -- long enough for "jpeg"@@ -152,11 +154,11 @@ keyHash :: Key -> S.ByteString keyHash = fst . splitKeyNameExtension -validInExtension :: Char -> Bool+validInExtension :: Word8 -> Bool validInExtension c- | isAlphaNum c = True- | c == '.' = True- | otherwise = False+ | isAlphaNum (chr (fromIntegral c)) = True+ | c <= 127 = False -- other ascii, spaces, punctuation, control chars+ | otherwise = True -- utf8 is allowed, also other encodings {- Upgrade keys that have the \ prefix on their hash due to a bug, or - that contain non-alphanumeric characters in their extension.@@ -168,7 +170,7 @@ needsUpgrade :: Key -> Bool needsUpgrade key = or [ "\\" `S8.isPrefixOf` keyHash key- , any (not . validInExtension) (decodeBS $ snd $ splitKeyNameExtension key)+ , S.any (not . validInExtension) (snd $ splitKeyNameExtension key) , not (hasExt (fromKey keyVariety key)) && keyHash key /= fromKey keyName key ] @@ -188,7 +190,7 @@ AssociatedFile Nothing -> Nothing AssociatedFile (Just file) -> Just $ alterKey oldkey $ \d -> d { keyName = keyHash oldkey - <> encodeBS' (selectExtension maxextlen (fromRawFilePath file))+ <> selectExtension maxextlen file , keyVariety = newvariety } {- Upgrade to fix bad previous migration that created a
Backend/WORM.hs view
@@ -16,6 +16,7 @@ import Utility.Metered import qualified Data.ByteString.Char8 as S8+import qualified Utility.RawFilePath as R backends :: [Backend] backends = [backend]@@ -36,10 +37,10 @@ keyValue :: KeySource -> MeterUpdate -> Annex (Maybe Key) keyValue source _ = do let f = contentLocation source- stat <- liftIO $ getFileStatus f- sz <- liftIO $ getFileSize' f stat+ stat <- liftIO $ R.getFileStatus f+ sz <- liftIO $ getFileSize' (fromRawFilePath f) stat relf <- fromRawFilePath . getTopFilePath- <$> inRepo (toTopFilePath $ toRawFilePath $ keyFilename source)+ <$> inRepo (toTopFilePath $ keyFilename source) return $ Just $ mkKey $ \k -> k { keyName = genKeyName relf , keyVariety = WORMKey
CHANGELOG view
@@ -1,9 +1,39 @@-git-annex (7.20200309) upstream; urgency=medium+git-annex (8.20200226) upstream; urgency=medium - * Fix regression that prevented external special remotes from using- GETCONFIG to query values like "name". (Introduced in version 7.20200202.7.)+ * New v8 repository version.+ * v7 upgrades automatically to v8. The upgrade deletes old sqlite+ databases, which may cause git-annex to need to do extra work to+ regenerate the databases or due to not having the information from the+ old databases available. Two notable cases are interrupted incremental+ fscks and interrupted exports, both of which will restart from the+ beginning.+ * Improved serialization of filenames and keys to the sqlite databases,+ avoiding encoding problems and speeding up operations on them.+ * Add some missing indexes to sqlite databases. This will speed up+ some things involving export and import remotes, and git-annex smudge.+ Microbenchmarks show around 10-25% speedup of sqlite database operations.+ * add: When adding a whole directory, any dotfiles found in it will+ not be skipped, but will be added to git by default. This behavior+ can be configured with annex.dotfiles.+ * add: Removed special case for explicitly passing dotfiles,+ that no longer adds them to the annex, but to git. This behavior+ can be configured with annex.dotfiles.+ * add: Removed the --include-dotfiles option.+ * initremote, enableremote: Set remote.name.skipFetchAll when+ the remote cannot be fetched from by git, so git fetch --all+ will not try to use it.+ * Fix some cases where handling of keys with extensions varied depending+ on the locale.+ * annex.maxextensionlength used to be the number of characters, not+ bytes, when in a utf-8 locale. It's now always the number of bytes.+ * Extended annex.security.allowed-ip-addresses to let specific ports+ of an IP address to be used, while denying use of other ports.+ * init --version: When the version given is one that automatically+ upgrades to a newer version, use the newer version instead.+ * Auto upgrades from older repo versions, like v5, now jump right to v8.+ * Makefile: Support newer versions of cabal that use the new-build system. - -- Joey Hess <id@joeyh.name> Mon, 09 Mar 2020 12:40:28 -0400+ -- Joey Hess <id@joeyh.name> Wed, 26 Feb 2020 18:49:58 -0400 git-annex (7.20200226) upstream; urgency=high
CmdLine/Seek.hs view
@@ -59,23 +59,14 @@ getfiles c ps _ -> giveup needforce -withFilesNotInGit :: Bool -> (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek-withFilesNotInGit skipdotfiles a l- | skipdotfiles = do- {- dotfiles are not acted on unless explicitly listed -}- files <- filter (not . dotfile . fromRawFilePath) <$>- seekunless (null ps && not (null l)) ps- dotfiles <- seekunless (null dotps) dotps- go (files++dotfiles)- | otherwise = go =<< seekunless False l+withFilesNotInGit :: (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek+withFilesNotInGit a l = go =<< seek where- (dotps, ps) = partition (\(WorkTreeItem f) -> dotfile f) l- seekunless True _ = return []- seekunless _ l' = do+ seek = do force <- Annex.getState Annex.force g <- gitRepo liftIO $ Git.Command.leaveZombie- <$> LsFiles.notInRepo force (map (\(WorkTreeItem f) -> toRawFilePath f) l') g+ <$> LsFiles.notInRepo force (map (\(WorkTreeItem f) -> toRawFilePath f) l) g go fs = seekActions $ prepFiltered a $ return $ concat $ segmentPaths (map (\(WorkTreeItem f) -> toRawFilePath f) l) fs
Command/Add.hs view
@@ -21,6 +21,7 @@ import Messages.Progress import Git.Types import Git.FilePath+import Config.GitConfig import qualified Git.UpdateIndex import Utility.FileMode import qualified Utility.RawFilePath as R@@ -33,7 +34,6 @@ data AddOptions = AddOptions { addThese :: CmdParams- , includeDotFiles :: Bool , batchOption :: BatchMode , updateOnly :: Bool , largeFilesOverride :: Maybe Bool@@ -42,10 +42,6 @@ optParser :: CmdParamsDesc -> Parser AddOptions optParser desc = AddOptions <$> cmdParams desc- <*> switch- ( long "include-dotfiles"- <> help "don't skip dotfiles"- ) <*> parseBatchOption <*> switch ( long "update"@@ -67,14 +63,17 @@ seek o = startConcurrency commandStages $ do largematcher <- largeFilesMatcher addunlockedmatcher <- addUnlockedMatcher+ annexdotfiles <- getGitConfigVal annexDotFiles let gofile file = case largeFilesOverride o of- Nothing -> ifM (checkFileMatcher largematcher (fromRawFilePath file) <||> Annex.getState Annex.force)- ( start file addunlockedmatcher- , ifM (annexAddSmallFiles <$> Annex.getGitConfig)- ( startSmall file- , stop+ Nothing -> + let file' = fromRawFilePath file+ in ifM (pure (annexdotfiles || not (dotfile file')) <&&> (checkFileMatcher largematcher file' <||> Annex.getState Annex.force))+ ( start file addunlockedmatcher+ , ifM (annexAddSmallFiles <$> Annex.getGitConfig)+ ( startSmall file+ , stop+ ) )- ) Just True -> start file addunlockedmatcher Just False -> startSmallOverridden file case batchOption o of@@ -86,7 +85,7 @@ l <- workTreeItems (addThese o) let go a = a (commandAction . gofile) l unless (updateOnly o) $- go (withFilesNotInGit (not $ includeDotFiles o))+ go withFilesNotInGit go withFilesMaybeModified go withUnmodifiedUnlockedPointers
Command/AddUrl.hs view
@@ -367,8 +367,8 @@ finishDownloadWith addunlockedmatcher tmp u url file = do backend <- chooseBackend file let source = KeySource- { keyFilename = file- , contentLocation = tmp+ { keyFilename = toRawFilePath file+ , contentLocation = toRawFilePath tmp , inodeCache = Nothing } genKey source nullMeterUpdate backend >>= \case
Command/CalcKey.hs view
@@ -20,8 +20,11 @@ (batchable run (pure ())) run :: () -> String -> Annex Bool-run _ file = genKey (KeySource file file Nothing) nullMeterUpdate Nothing >>= \case+run _ file = genKey ks nullMeterUpdate Nothing >>= \case Just (k, _) -> do liftIO $ putStrLn $ serializeKey k return True Nothing -> return False+ where+ ks = KeySource file' file' Nothing+ file' = toRawFilePath file
Command/EnableRemote.hs view
@@ -1,6 +1,6 @@ {- git-annex command -- - Copyright 2013-2019 Joey Hess <id@joeyh.name>+ - Copyright 2013-2020 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -25,6 +25,7 @@ import Config.DynamicConfig import Types.GitConfig import Types.ProposedAccepted+import Git.Config import qualified Data.Map as M @@ -86,21 +87,23 @@ performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> R.RemoteConfig -> RemoteGitConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandPerform performSpecialRemote t u oldc c gc mcu = do (c', u') <- R.setup t (R.Enable oldc) (Just u) Nothing c gc- next $ cleanupSpecialRemote u' c' mcu+ next $ cleanupSpecialRemote t u' c' mcu -cleanupSpecialRemote :: UUID -> R.RemoteConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandCleanup-cleanupSpecialRemote u c mcu = do+cleanupSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandCleanup+cleanupSpecialRemote t u c mcu = do case mcu of Nothing -> Logs.Remote.configSet u c Just (SpecialRemote.ConfigFrom cu) -> do- setConfig (remoteConfig c "config-uuid") (fromUUID cu)+ setConfig (remoteAnnexConfig c "config-uuid") (fromUUID cu) Logs.Remote.configSet cu c Remote.byUUID u >>= \case Nothing -> noop Just r -> do repo <- R.getRepo r setRemoteIgnore repo False+ unless (Remote.gitSyncableRemoteType t) $+ setConfig (remoteConfig c "skipFetchAll") (boolConfig True) return True unknownNameError :: String -> Annex a
Command/Export.hs view
@@ -81,7 +81,7 @@ -- handle deprecated option when (exportTracking o) $- setConfig (remoteConfig r "tracking-branch")+ setConfig (remoteAnnexConfig r "tracking-branch") (fromRef $ exportTreeish o) tree <- filterPreferredContent r =<<
Command/Import.hs view
@@ -118,11 +118,13 @@ startLocal :: AddUnlockedMatcher -> GetFileMatcher -> DuplicateMode -> (FilePath, FilePath) -> CommandStart startLocal addunlockedmatcher largematcher mode (srcfile, destfile) = ifM (liftIO $ isRegularFile <$> getSymbolicLinkStatus srcfile)- ( starting "import" (ActionItemWorkTreeFile (toRawFilePath destfile))+ ( starting "import" (ActionItemWorkTreeFile destfile') pickaction , stop ) where+ destfile' = toRawFilePath destfile+ deletedup k = do showNote $ "duplicate of " ++ serializeKey k verifyExisting k destfile@@ -182,7 +184,7 @@ -- weakly the same as the origianlly locked down file's -- inode cache. (Since the file may have been copied, -- its inodes may not be the same.)- newcache <- withTSDelta $ liftIO . genInodeCache (toRawFilePath destfile)+ newcache <- withTSDelta $ liftIO . genInodeCache destfile' let unchanged = case (newcache, inodeCache (keySource ld)) of (_, Nothing) -> True (Just newc, Just c) | compareWeak c newc -> True@@ -193,8 +195,8 @@ -- is what will be ingested. let ld' = ld { keySource = KeySource- { keyFilename = destfile- , contentLocation = destfile+ { keyFilename = destfile'+ , contentLocation = destfile' , inodeCache = newcache } }@@ -203,7 +205,7 @@ >>= maybe stop (\addedk -> next $ Command.Add.cleanup addedk True)- , next $ Command.Add.addSmall $ toRawFilePath destfile + , next $ Command.Add.addSmall destfile' ) notoverwriting why = do warning $ "not overwriting existing " ++ destfile ++ " " ++ why
Command/InitRemote.hs view
@@ -23,6 +23,7 @@ import Types.GitConfig import Types.ProposedAccepted import Config+import Git.Config cmd :: Command cmd = command "initremote" SectionSetup@@ -87,7 +88,7 @@ dummycfg <- liftIO dummyRemoteGitConfig let c' = M.delete uuidField c (c'', u) <- R.setup t R.Init (sameasu <|> uuidfromuser) Nothing c' dummycfg- next $ cleanup u name c'' o+ next $ cleanup t u name c'' o where uuidfromuser = case fromProposedAccepted <$> M.lookup uuidField c of Just s@@ -99,16 +100,18 @@ uuidField :: R.RemoteConfigField uuidField = Accepted "uuid" -cleanup :: UUID -> String -> R.RemoteConfig -> InitRemoteOptions -> CommandCleanup-cleanup u name c o = do+cleanup :: RemoteType -> UUID -> String -> R.RemoteConfig -> InitRemoteOptions -> CommandCleanup+cleanup t u name c o = do case sameas o of Nothing -> do describeUUID u (toUUIDDesc name) Logs.Remote.configSet u c Just _ -> do cu <- liftIO genUUID- setConfig (remoteConfig c "config-uuid") (fromUUID cu)+ setConfig (remoteAnnexConfig c "config-uuid") (fromUUID cu) Logs.Remote.configSet cu c+ unless (Remote.gitSyncableRemoteType t) $+ setConfig (remoteConfig c "skipFetchAll") (boolConfig True) return True describeOtherParamsFor :: RemoteConfig -> RemoteType -> CommandPerform
Command/Migrate.hs view
@@ -85,8 +85,8 @@ genkey Nothing = do content <- calcRepo $ gitAnnexLocation oldkey let source = KeySource- { keyFilename = fromRawFilePath file- , contentLocation = fromRawFilePath content+ { keyFilename = file+ , contentLocation = content , inodeCache = Nothing } v <- genKey source nullMeterUpdate (Just newbackend)
Command/P2P.hs view
@@ -320,7 +320,7 @@ , Param (formatP2PAddress addr) ] when ok $ do- storeUUIDIn (remoteConfig remotename "uuid") theiruuid+ storeUUIDIn (remoteAnnexConfig remotename "uuid") theiruuid storeP2PRemoteAuthToken addr authtoken return LinkSuccess go (Right Nothing) = return $ AuthenticationError "Unable to authenticate with peer. Please check the address and try again."
Command/Reinject.hs view
@@ -55,7 +55,7 @@ startKnown :: FilePath -> CommandStart startKnown src = notAnnexed src $ starting "reinject" (ActionItemOther (Just src)) $ do- mkb <- genKey (KeySource src src Nothing) nullMeterUpdate Nothing+ mkb <- genKey ks nullMeterUpdate Nothing case mkb of Nothing -> error "Failed to generate key" Just (key, _) -> ifM (isKnownKey key)@@ -64,6 +64,9 @@ warning "Not known content; skipping" next $ return True )+ where+ ks = KeySource src' src' Nothing+ src' = toRawFilePath src notAnnexed :: FilePath -> CommandStart -> CommandStart notAnnexed src a =
Command/Smudge.hs view
@@ -27,6 +27,7 @@ import Utility.Metered import Annex.InodeSentinal import Utility.InodeCache+import Config.GitConfig import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L@@ -172,9 +173,16 @@ , checkunchangedgitfile checkheuristics ) where- checkmatcher d = do- matcher <- largeFilesMatcher- checkFileMatcher' matcher file d+ checkmatcher d+ | dotfile file = ifM (getGitConfigVal annexDotFiles)+ ( go+ , return False+ )+ | otherwise = go+ where+ go = do+ matcher <- largeFilesMatcher+ checkFileMatcher' matcher file d checkheuristics = case moldkey of Just _ -> return True
Command/Sync.hs view
@@ -199,7 +199,7 @@ let withbranch a = a =<< getCurrentBranch remotes <- syncRemotes (syncWith o)- let gitremotes = filter Remote.gitSyncableRemote remotes+ let gitremotes = filter (Remote.gitSyncableRemoteType . Remote.remotetype) remotes dataremotes <- filter (\r -> Remote.uuid r /= NoUUID) <$> filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) remotes let (exportremotes, keyvalueremotes) = partition (exportTree . Remote.config) dataremotes@@ -300,7 +300,7 @@ listed = concat <$> mapM Remote.byNameOrGroup ps good r- | Remote.gitSyncableRemote r =+ | Remote.gitSyncableRemoteType (Remote.remotetype r) = Remote.Git.repoAvail =<< Remote.getRepo r | otherwise = return True @@ -788,7 +788,7 @@ ] _ -> noop where- gitconfig = show (remoteConfig r "tracking-branch")+ gitconfig = show (remoteAnnexConfig r "tracking-branch") fillexport _ _ [] _ = return False fillexport r db (tree:[]) mtbcommitsha = do
Command/TestRemote.hs view
@@ -323,8 +323,8 @@ Right (rand, _) -> liftIO $ B.hPut h rand liftIO $ hClose h let ks = KeySource- { keyFilename = f- , contentLocation = f+ { keyFilename = toRawFilePath f+ , contentLocation = toRawFilePath f , inodeCache = Nothing } k <- fromMaybe (error "failed to generate random key")
Command/Uninit.hs view
@@ -42,7 +42,7 @@ seek :: CmdParams -> CommandSeek seek ps = do l <- workTreeItems ps- withFilesNotInGit False (commandAction . whenAnnexed (startCheckIncomplete . fromRawFilePath)) l+ withFilesNotInGit (commandAction . whenAnnexed (startCheckIncomplete . fromRawFilePath)) l Annex.changeState $ \s -> s { Annex.fast = True } withFilesInGit (commandAction . whenAnnexed Command.Unannex.start) l finish
Config.hs view
@@ -1,6 +1,6 @@ {- Git configuration -- - Copyright 2011-2019 Joey Hess <id@joeyh.name>+ - Copyright 2011-2020 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -65,8 +65,12 @@ {- A per-remote config setting in git config. -} remoteConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey remoteConfig r key = ConfigKey $- "remote." <> encodeBS' (getRemoteName r) <> ".annex-" <> key+ "remote." <> encodeBS' (getRemoteName r) <> "." <> key +{- A per-remote config annex setting in git config. -}+remoteAnnexConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey+remoteAnnexConfig r key = remoteConfig r ("annex-" <> key)+ {- A global annex setting in git config. -} annexConfig :: UnqualifiedConfigKey -> ConfigKey annexConfig key = ConfigKey ("annex." <> key)@@ -81,16 +85,16 @@ remoteCost' = liftIO . getDynamicConfig . remoteAnnexCost setRemoteCost :: Git.Repo -> Cost -> Annex ()-setRemoteCost r c = setConfig (remoteConfig r "cost") (show c)+setRemoteCost r c = setConfig (remoteAnnexConfig r "cost") (show c) setRemoteAvailability :: Git.Repo -> Availability -> Annex ()-setRemoteAvailability r c = setConfig (remoteConfig r "availability") (show c)+setRemoteAvailability r c = setConfig (remoteAnnexConfig r "availability") (show c) setRemoteIgnore :: Git.Repo -> Bool -> Annex ()-setRemoteIgnore r b = setConfig (remoteConfig r "ignore") (Git.Config.boolConfig b)+setRemoteIgnore r b = setConfig (remoteAnnexConfig r "ignore") (Git.Config.boolConfig b) setRemoteBare :: Git.Repo -> Bool -> Annex ()-setRemoteBare r b = setConfig (remoteConfig r "bare") (Git.Config.boolConfig b)+setRemoteBare r b = setConfig (remoteAnnexConfig r "bare") (Git.Config.boolConfig b) isBareRepo :: Annex Bool isBareRepo = fromRepo Git.repoIsLocalBare
Config/Smudge.hs view
@@ -42,7 +42,6 @@ stdattr :: [String] stdattr = [ "* filter=annex"- , ".* !filter" ] -- Note that this removes the local git attributes for filtering,
Database/Benchmark.hs view
@@ -16,7 +16,6 @@ import qualified Database.Keys.SQL as SQL import qualified Database.Queue as H import Database.Init-import Database.Types import Utility.Tmp.Dir import Git.FilePath import Types.Key@@ -26,6 +25,7 @@ import Control.Monad.IO.Class (liftIO) import qualified Data.ByteString.Char8 as B8 import System.Random+import Control.Concurrent #endif benchmarkDbs :: CriterionMode -> Integer -> Annex ()@@ -49,41 +49,40 @@ #ifdef WITH_BENCHMARK getAssociatedFilesHitBench :: BenchDb -> Benchmark-getAssociatedFilesHitBench (BenchDb h num) = bench ("getAssociatedFiles (hit)") $ nfIO $ do+getAssociatedFilesHitBench (BenchDb h num _) = bench ("getAssociatedFiles (hit)") $ nfIO $ do n <- getStdRandom (randomR (1,num))- SQL.getAssociatedFiles (toIKey (keyN n)) (SQL.ReadHandle h)+ SQL.getAssociatedFiles (keyN n) (SQL.ReadHandle h) getAssociatedFilesMissBench :: BenchDb -> Benchmark-getAssociatedFilesMissBench (BenchDb h _num) = bench ("getAssociatedFiles (miss)") $ nfIO $- SQL.getAssociatedFiles (toIKey keyMiss) (SQL.ReadHandle h)+getAssociatedFilesMissBench (BenchDb h _ _) = bench ("getAssociatedFiles (miss)") $ nfIO $+ SQL.getAssociatedFiles keyMiss (SQL.ReadHandle h) getAssociatedKeyHitBench :: BenchDb -> Benchmark-getAssociatedKeyHitBench (BenchDb h num) = bench ("getAssociatedKey (hit)") $ nfIO $ do+getAssociatedKeyHitBench (BenchDb h num _) = bench ("getAssociatedKey (hit)") $ nfIO $ do n <- getStdRandom (randomR (1,num))- -- fromIKey because this ends up being used to get a Key- map fromIKey <$> SQL.getAssociatedKey (fileN n) (SQL.ReadHandle h)+ SQL.getAssociatedKey (fileN n) (SQL.ReadHandle h) getAssociatedKeyMissBench :: BenchDb -> Benchmark-getAssociatedKeyMissBench (BenchDb h _num) = bench ("getAssociatedKey from (miss)") $ nfIO $- -- fromIKey because this ends up being used to get a Key- map fromIKey <$> SQL.getAssociatedKey fileMiss (SQL.ReadHandle h)+getAssociatedKeyMissBench (BenchDb h _ _) = bench ("getAssociatedKey (miss)") $ nfIO $+ SQL.getAssociatedKey fileMiss (SQL.ReadHandle h) addAssociatedFileOldBench :: BenchDb -> Benchmark-addAssociatedFileOldBench (BenchDb h num) = bench ("addAssociatedFile to (old)") $ nfIO $ do+addAssociatedFileOldBench (BenchDb h num _) = bench ("addAssociatedFile to (old)") $ nfIO $ do n <- getStdRandom (randomR (1,num))- SQL.addAssociatedFile (toIKey (keyN n)) (fileN n) (SQL.WriteHandle h)+ SQL.addAssociatedFile (keyN n) (fileN n) (SQL.WriteHandle h) H.flushDbQueue h addAssociatedFileNewBench :: BenchDb -> Benchmark-addAssociatedFileNewBench (BenchDb h num) = bench ("addAssociatedFile to (new)") $ nfIO $ do- n <- getStdRandom (randomR (1,num))- SQL.addAssociatedFile (toIKey (keyN n)) (fileN (num+n)) (SQL.WriteHandle h)+addAssociatedFileNewBench (BenchDb h num mv) = bench ("addAssociatedFile to (new)") $ nfIO $ do+ n <- takeMVar mv+ putMVar mv (n+1)+ SQL.addAssociatedFile (keyN n) (fileN (num+n)) (SQL.WriteHandle h) H.flushDbQueue h populateAssociatedFiles :: H.DbQueue -> Integer -> IO () populateAssociatedFiles h num = do forM_ [1..num] $ \n ->- SQL.addAssociatedFile (toIKey (keyN n)) (fileN n) (SQL.WriteHandle h)+ SQL.addAssociatedFile (keyN n) (fileN n) (SQL.WriteHandle h) H.flushDbQueue h keyN :: Integer -> Key@@ -101,7 +100,7 @@ fileMiss :: TopFilePath fileMiss = fileN 0 -- 0 is never stored -data BenchDb = BenchDb H.DbQueue Integer+data BenchDb = BenchDb H.DbQueue Integer (MVar Integer) benchDb :: FilePath -> Integer -> Annex BenchDb benchDb tmpdir num = do@@ -112,7 +111,8 @@ sz <- liftIO $ getFileSize db liftIO $ putStrLn $ "size of database on disk: " ++ roughSize storageUnits False sz- return (BenchDb h num)+ mv <- liftIO $ newMVar 1+ return (BenchDb h num mv) where db = tmpdir </> show num </> "db"
Database/ContentIdentifier.hs view
@@ -57,11 +57,13 @@ ContentIdentifiers remote UUID cid ContentIdentifier- key IKey+ key Key+ ContentIndentifiersKeyRemoteCidIndex key remote cid+ ContentIndentifiersCidRemoteIndex cid remote -- The last git-annex branch tree sha that was used to update -- ContentIdentifiers AnnexBranch- tree SRef+ tree SSha UniqueTree tree |] @@ -97,13 +99,13 @@ -- Be sure to also update the git-annex branch when using this. recordContentIdentifier :: ContentIdentifierHandle -> RemoteStateHandle -> ContentIdentifier -> Key -> IO () recordContentIdentifier h (RemoteStateHandle u) cid k = queueDb h $ do- void $ insert_ $ ContentIdentifiers u cid (toIKey k)+ void $ insertUnique $ ContentIdentifiers u cid k getContentIdentifiers :: ContentIdentifierHandle -> RemoteStateHandle -> Key -> IO [ContentIdentifier] getContentIdentifiers (ContentIdentifierHandle h) (RemoteStateHandle u) k = H.queryDbQueue h $ do l <- selectList- [ ContentIdentifiersKey ==. toIKey k+ [ ContentIdentifiersKey ==. k , ContentIdentifiersRemote ==. u ] [] return $ map (contentIdentifiersCid . entityVal) l@@ -115,18 +117,18 @@ [ ContentIdentifiersCid ==. cid , ContentIdentifiersRemote ==. u ] []- return $ map (fromIKey . contentIdentifiersKey . entityVal) l+ return $ map (contentIdentifiersKey . entityVal) l recordAnnexBranchTree :: ContentIdentifierHandle -> Sha -> IO () recordAnnexBranchTree h s = queueDb h $ do deleteWhere ([] :: [Filter AnnexBranch])- void $ insertUnique $ AnnexBranch $ toSRef s+ void $ insertUnique $ AnnexBranch $ toSSha s getAnnexBranchTree :: ContentIdentifierHandle -> IO Sha getAnnexBranchTree (ContentIdentifierHandle h) = H.queryDbQueue h $ do l <- selectList ([] :: [Filter AnnexBranch]) [] case l of- (s:[]) -> return $ fromSRef $ annexBranchTree $ entityVal s+ (s:[]) -> return $ fromSSha $ annexBranchTree $ entityVal s _ -> return emptyTree {- Check if the git-annex branch has been updated and the database needs
Database/Export.hs view
@@ -68,7 +68,7 @@ share [mkPersist sqlSettings, mkMigrate "migrateExport"] [persistLowerCase| -- Files that have been exported to the remote and are present on it. Exported- key IKey+ key Key file SFilePath ExportedIndex key file -- Directories that exist on the remote, and the files that are in them.@@ -79,12 +79,13 @@ -- The content of the tree that has been exported to the remote. -- Not all of these files are necessarily present on the remote yet. ExportTree- key IKey+ key Key file SFilePath- ExportTreeIndex key file+ ExportTreeKeyFileIndex key file+ ExportTreeFileKeyIndex file key -- The tree stored in ExportTree ExportTreeCurrent- tree SRef+ tree SSha UniqueTree tree |] @@ -120,43 +121,40 @@ recordExportTreeCurrent :: ExportHandle -> Sha -> IO () recordExportTreeCurrent h s = queueDb h $ do deleteWhere ([] :: [Filter ExportTreeCurrent])- void $ insertUnique $ ExportTreeCurrent $ toSRef s+ void $ insertUnique $ ExportTreeCurrent $ toSSha s getExportTreeCurrent :: ExportHandle -> IO (Maybe Sha) getExportTreeCurrent (ExportHandle h _) = H.queryDbQueue h $ do l <- selectList ([] :: [Filter ExportTreeCurrent]) [] case l of- (s:[]) -> return $ Just $ fromSRef $ exportTreeCurrentTree $ entityVal s+ (s:[]) -> return $ Just $ fromSSha $+ exportTreeCurrentTree $ entityVal s _ -> return Nothing addExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO () addExportedLocation h k el = queueDb h $ do- void $ insertUnique $ Exported ik ef+ void $ insertUnique $ Exported k ef let edirs = map- (\ed -> ExportedDirectory (toSFilePath (fromRawFilePath (fromExportDirectory ed))) ef)+ (\ed -> ExportedDirectory (SFilePath (fromExportDirectory ed)) ef) (exportDirectories el) putMany edirs where- ik = toIKey k- ef = toSFilePath $ fromRawFilePath $ fromExportLocation el+ ef = SFilePath (fromExportLocation el) removeExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO () removeExportedLocation h k el = queueDb h $ do- deleteWhere [ExportedKey ==. ik, ExportedFile ==. ef]- let subdirs = map (toSFilePath . fromRawFilePath . fromExportDirectory)+ deleteWhere [ExportedKey ==. k, ExportedFile ==. ef]+ let subdirs = map (SFilePath . fromExportDirectory) (exportDirectories el) deleteWhere [ExportedDirectoryFile ==. ef, ExportedDirectorySubdir <-. subdirs] where- ik = toIKey k- ef = toSFilePath $ fromRawFilePath $ fromExportLocation el+ ef = SFilePath (fromExportLocation el) {- Note that this does not see recently queued changes. -} getExportedLocation :: ExportHandle -> Key -> IO [ExportLocation] getExportedLocation (ExportHandle h _) k = H.queryDbQueue h $ do- l <- selectList [ExportedKey ==. ik] []- return $ map (mkExportLocation . toRawFilePath . fromSFilePath . exportedFile . entityVal) l- where- ik = toIKey k+ l <- selectList [ExportedKey ==. k] []+ return $ map (mkExportLocation . (\(SFilePath f) -> f) . exportedFile . entityVal) l {- Note that this does not see recently queued changes. -} isExportDirectoryEmpty :: ExportHandle -> ExportDirectory -> IO Bool@@ -164,43 +162,36 @@ l <- selectList [ExportedDirectorySubdir ==. ed] [] return $ null l where- ed = toSFilePath $ fromRawFilePath $ fromExportDirectory d+ ed = SFilePath $ fromExportDirectory d {- Get locations in the export that might contain a key. -} getExportTree :: ExportHandle -> Key -> IO [ExportLocation] getExportTree (ExportHandle h _) k = H.queryDbQueue h $ do- l <- selectList [ExportTreeKey ==. ik] []- return $ map (mkExportLocation . toRawFilePath . fromSFilePath . exportTreeFile . entityVal) l- where- ik = toIKey k+ l <- selectList [ExportTreeKey ==. k] []+ return $ map (mkExportLocation . (\(SFilePath f) -> f) . exportTreeFile . entityVal) l {- Get keys that might be currently exported to a location. -- - Note that the database does not currently have an index to make this- - fast.- - - Note that this does not see recently queued changes. -} getExportTreeKey :: ExportHandle -> ExportLocation -> IO [Key] getExportTreeKey (ExportHandle h _) el = H.queryDbQueue h $ do- map (fromIKey . exportTreeKey . entityVal) + map (exportTreeKey . entityVal) <$> selectList [ExportTreeFile ==. ef] [] where- ef = toSFilePath (fromRawFilePath $ fromExportLocation el)+ ef = SFilePath (fromExportLocation el) addExportTree :: ExportHandle -> Key -> ExportLocation -> IO () addExportTree h k loc = queueDb h $- void $ insertUnique $ ExportTree ik ef+ void $ insertUnique $ ExportTree k ef where- ik = toIKey k- ef = toSFilePath (fromRawFilePath $ fromExportLocation loc)+ ef = SFilePath (fromExportLocation loc) removeExportTree :: ExportHandle -> Key -> ExportLocation -> IO () removeExportTree h k loc = queueDb h $- deleteWhere [ExportTreeKey ==. ik, ExportTreeFile ==. ef]+ deleteWhere [ExportTreeKey ==. k, ExportTreeFile ==. ef] where- ik = toIKey k- ef = toSFilePath (fromRawFilePath $ fromExportLocation loc)+ ef = SFilePath (fromExportLocation loc) -- An action that is passed the old and new values that were exported, -- and updates state.
Database/Fsck.hs view
@@ -1,6 +1,6 @@ {- Sqlite database used for incremental fsck. -- - Copyright 2015 Joey Hess <id@joeyh.name>+ - Copyright 2015-2019 Joey Hess <id@joeyh.name> -: - Licensed under the GNU AGPL version 3 or higher. -}@@ -44,12 +44,14 @@ - of the latest incremental fsck pass. -} share [mkPersist sqlSettings, mkMigrate "migrateFsck"] [persistLowerCase| Fscked- key SKey- UniqueKey key+ key Key+ FsckedKeyIndex key |] {- The database is removed when starting a new incremental fsck pass. -+ - (The old fsck database used before v8 is also removed here.)+ - - This may fail, if other fsck processes are currently running using the - database. Removing the database in that situation would lead to crashes - or unknown behavior.@@ -57,8 +59,10 @@ newPass :: UUID -> Annex Bool newPass u = isJust <$> tryExclusiveLock (gitAnnexFsckDbLock u) go where- go = liftIO . void . tryIO . removeDirectoryRecursive- =<< fromRepo (gitAnnexFsckDbDir u)+ go = do+ removedb =<< fromRepo (gitAnnexFsckDbDir u)+ removedb =<< fromRepo (gitAnnexFsckDbDirOld u)+ removedb = liftIO . void . tryIO . removeDirectoryRecursive {- Opens the database, creating it if it doesn't exist yet. -} openDb :: UUID -> Annex FsckHandle@@ -79,10 +83,8 @@ addDb :: FsckHandle -> Key -> IO () addDb (FsckHandle h _) k = H.queueDb h checkcommit $- void $ insertUnique $ Fscked sk+ void $ insertUnique $ Fscked k where- sk = toSKey k- -- commit queue after 1000 files or 5 minutes, whichever comes first checkcommit sz lastcommittime | sz > 1000 = return True@@ -92,9 +94,9 @@ {- Doesn't know about keys that were just added with addDb. -} inDb :: FsckHandle -> Key -> IO Bool-inDb (FsckHandle h _) = H.queryDbQueue h . inDb' . toSKey+inDb (FsckHandle h _) = H.queryDbQueue h . inDb' -inDb' :: SKey -> SqlPersistM Bool-inDb' sk = do- r <- selectList [FsckedKey ==. sk] []+inDb' :: Key -> SqlPersistM Bool+inDb' k = do+ r <- selectList [FsckedKey ==. k] [] return $ not $ null r
Database/Keys.hs view
@@ -156,20 +156,20 @@ Just h -> liftIO (closeDbHandle h) addAssociatedFile :: Key -> TopFilePath -> Annex ()-addAssociatedFile k f = runWriterIO $ SQL.addAssociatedFile (toIKey k) f+addAssociatedFile k f = runWriterIO $ SQL.addAssociatedFile k f {- Note that the files returned were once associated with the key, but - some of them may not be any longer. -} getAssociatedFiles :: Key -> Annex [TopFilePath]-getAssociatedFiles = runReaderIO . SQL.getAssociatedFiles . toIKey+getAssociatedFiles = runReaderIO . SQL.getAssociatedFiles {- Gets any keys that are on record as having a particular associated file. - (Should be one or none but the database doesn't enforce that.) -} getAssociatedKey :: TopFilePath -> Annex [Key]-getAssociatedKey = map fromIKey <$$> runReaderIO . SQL.getAssociatedKey+getAssociatedKey = runReaderIO . SQL.getAssociatedKey removeAssociatedFile :: Key -> TopFilePath -> Annex ()-removeAssociatedFile k = runWriterIO . SQL.removeAssociatedFile (toIKey k)+removeAssociatedFile k = runWriterIO . SQL.removeAssociatedFile k {- Stats the files, and stores their InodeCaches. -} storeInodeCaches :: Key -> [RawFilePath] -> Annex ()@@ -181,15 +181,15 @@ =<< liftIO (mapM (\f -> genInodeCache f d) fs) addInodeCaches :: Key -> [InodeCache] -> Annex ()-addInodeCaches k is = runWriterIO $ SQL.addInodeCaches (toIKey k) is+addInodeCaches k is = runWriterIO $ SQL.addInodeCaches k is {- A key may have multiple InodeCaches; one for the annex object, and one - for each pointer file that is a copy of it. -} getInodeCaches :: Key -> Annex [InodeCache]-getInodeCaches = runReaderIO . SQL.getInodeCaches . toIKey+getInodeCaches = runReaderIO . SQL.getInodeCaches removeInodeCaches :: Key -> Annex ()-removeInodeCaches = runWriterIO . SQL.removeInodeCaches . toIKey+removeInodeCaches = runWriterIO . SQL.removeInodeCaches isInodeKnown :: InodeCache -> SentinalStatus -> Annex Bool isInodeKnown i s = or <$> runReaderIO ((:[]) <$$> SQL.isInodeKnown i s)@@ -292,9 +292,8 @@ -- Note that database writes done in here will not necessarily -- be visible to database reads also done in here. reconcile file key = do- let ikey = toIKey key- liftIO $ SQL.addAssociatedFileFast ikey file (SQL.WriteHandle qh)- caches <- liftIO $ SQL.getInodeCaches ikey (SQL.ReadHandle qh)+ liftIO $ SQL.addAssociatedFileFast key file (SQL.WriteHandle qh)+ caches <- liftIO $ SQL.getInodeCaches key (SQL.ReadHandle qh) keyloc <- calcRepo (gitAnnexLocation key) keypopulated <- sameInodeCache keyloc caches p <- fromRepo $ fromTopFilePath file@@ -304,6 +303,6 @@ populatePointerFile (Restage True) key keyloc p >>= \case Nothing -> return () Just ic -> liftIO $- SQL.addInodeCaches ikey [ic] (SQL.WriteHandle qh)+ SQL.addInodeCaches key [ic] (SQL.WriteHandle qh) (False, True) -> depopulatePointerFile key p _ -> return ()
Database/Keys/SQL.hs view
@@ -22,27 +22,42 @@ import Database.Handle import qualified Database.Queue as H import Utility.InodeCache-import Utility.FileSystemEncoding import Git.FilePath -import Database.Persist.Sql+import Database.Persist.Sql hiding (Key) import Database.Persist.TH import Data.Time.Clock import Control.Monad import Data.Maybe-import qualified Data.Text as T-import qualified Data.Conduit.List as CL +-- Note on indexes: KeyFileIndex etc are really uniqueness constraints,+-- which cause sqlite to automatically add indexes. So when adding indexes,+-- have to take care to only add ones that work as uniqueness constraints.+-- (Unfortunatly persistent does not support indexes that are not+-- uniqueness constraints; https://github.com/yesodweb/persistent/issues/109)+--+-- KeyFileIndex contains both the key and the file because the combined+-- pair is unique, whereas the same key can appear in the table multiple+-- times with different files.+--+-- The other benefit to including the file in the index is that it makes+-- queries that include the file faster, since it's a covering index.+--+-- The KeyFileIndex only speeds up selects for a key, since it comes first.+-- To also speed up selects for a file, there's a separate FileKeyIndex. share [mkPersist sqlSettings, mkMigrate "migrateKeysDb"] [persistLowerCase| Associated- key IKey+ key Key file SFilePath KeyFileIndex key file FileKeyIndex file key Content- key IKey- cache SInodeCache- KeyCacheIndex key cache+ key Key+ inodecache InodeCache+ filesize FileSize+ mtime EpochTime+ KeyInodeCacheIndex key inodecache+ InodeCacheKeyIndex inodecache key |] containedTable :: TableName@@ -68,22 +83,22 @@ now <- getCurrentTime return $ diffUTCTime now lastcommittime > 300 -addAssociatedFile :: IKey -> TopFilePath -> WriteHandle -> IO ()-addAssociatedFile ik f = queueDb $ do+addAssociatedFile :: Key -> TopFilePath -> WriteHandle -> IO ()+addAssociatedFile k f = queueDb $ do -- If the same file was associated with a different key before, -- remove that.- deleteWhere [AssociatedFile ==. af, AssociatedKey !=. ik]- void $ insertUnique $ Associated ik af+ deleteWhere [AssociatedFile ==. af, AssociatedKey !=. k]+ void $ insertUnique $ Associated k af where- af = toSFilePath (fromRawFilePath (getTopFilePath f))+ af = SFilePath (getTopFilePath f) -- Does not remove any old association for a file, but less expensive -- than addAssociatedFile. Calling dropAllAssociatedFiles first and then -- this is an efficient way to update all associated files.-addAssociatedFileFast :: IKey -> TopFilePath -> WriteHandle -> IO ()-addAssociatedFileFast ik f = queueDb $ void $ insertUnique $ Associated ik af+addAssociatedFileFast :: Key -> TopFilePath -> WriteHandle -> IO ()+addAssociatedFileFast k f = queueDb $ void $ insertUnique $ Associated k af where- af = toSFilePath (fromRawFilePath (getTopFilePath f))+ af = SFilePath (getTopFilePath f) dropAllAssociatedFiles :: WriteHandle -> IO () dropAllAssociatedFiles = queueDb $@@ -91,65 +106,56 @@ {- Note that the files returned were once associated with the key, but - some of them may not be any longer. -}-getAssociatedFiles :: IKey -> ReadHandle -> IO [TopFilePath]-getAssociatedFiles ik = readDb $ do- l <- selectList [AssociatedKey ==. ik] []- return $ map (asTopFilePath . toRawFilePath . fromSFilePath . associatedFile . entityVal) l+getAssociatedFiles :: Key -> ReadHandle -> IO [TopFilePath]+getAssociatedFiles k = readDb $ do+ l <- selectList [AssociatedKey ==. k] []+ return $ map (asTopFilePath . (\(SFilePath f) -> f) . associatedFile . entityVal) l {- Gets any keys that are on record as having a particular associated file. - (Should be one or none but the database doesn't enforce that.) -}-getAssociatedKey :: TopFilePath -> ReadHandle -> IO [IKey]+getAssociatedKey :: TopFilePath -> ReadHandle -> IO [Key] getAssociatedKey f = readDb $ do l <- selectList [AssociatedFile ==. af] [] return $ map (associatedKey . entityVal) l where- af = toSFilePath (fromRawFilePath (getTopFilePath f))+ af = SFilePath (getTopFilePath f) -removeAssociatedFile :: IKey -> TopFilePath -> WriteHandle -> IO ()-removeAssociatedFile ik f = queueDb $- deleteWhere [AssociatedKey ==. ik, AssociatedFile ==. af]+removeAssociatedFile :: Key -> TopFilePath -> WriteHandle -> IO ()+removeAssociatedFile k f = queueDb $+ deleteWhere [AssociatedKey ==. k, AssociatedFile ==. af] where- af = toSFilePath (fromRawFilePath (getTopFilePath f))+ af = SFilePath (getTopFilePath f) -addInodeCaches :: IKey -> [InodeCache] -> WriteHandle -> IO ()-addInodeCaches ik is = queueDb $- forM_ is $ \i -> insertUnique $ Content ik (toSInodeCache i)+addInodeCaches :: Key -> [InodeCache] -> WriteHandle -> IO ()+addInodeCaches k is = queueDb $+ forM_ is $ \i -> insertUnique $ Content k i + (inodeCacheToFileSize i)+ (inodeCacheToEpochTime i) {- A key may have multiple InodeCaches; one for the annex object, and one - for each pointer file that is a copy of it. -}-getInodeCaches :: IKey -> ReadHandle -> IO [InodeCache]-getInodeCaches ik = readDb $ do- l <- selectList [ContentKey ==. ik] []- return $ map (fromSInodeCache . contentCache . entityVal) l+getInodeCaches :: Key -> ReadHandle -> IO [InodeCache]+getInodeCaches k = readDb $ do+ l <- selectList [ContentKey ==. k] []+ return $ map (contentInodecache . entityVal) l -removeInodeCaches :: IKey -> WriteHandle -> IO ()-removeInodeCaches ik = queueDb $- deleteWhere [ContentKey ==. ik]+removeInodeCaches :: Key -> WriteHandle -> IO ()+removeInodeCaches k = queueDb $+ deleteWhere [ContentKey ==. k] -{- Check if the inode is known to be used for an annexed file.- -- - This is currently slow due to the lack of indexes.- -}+{- Check if the inode is known to be used for an annexed file. -} isInodeKnown :: InodeCache -> SentinalStatus -> ReadHandle -> IO Bool-isInodeKnown i s = readDb query+isInodeKnown i s = readDb (isJust <$> selectFirst q []) where- query + q | sentinalInodesChanged s =- withRawQuery likesql [] $ isJust <$> CL.head- | otherwise =- isJust <$> selectFirst [ContentCache ==. si] []- - si = toSInodeCache i- - likesql = T.concat- [ "SELECT key FROM content WHERE "- , T.intercalate " OR " $ map mklike (likeInodeCacheWeak i)- , " LIMIT 1"- ]-- mklike p = T.concat- [ "cache LIKE "- , "'I \"" -- SInodeCache serializes as I "..."- , T.pack p- , "\"'"- ]+ -- Note that this select is intentionally not+ -- indexed. Normally, the inodes have not changed,+ -- and it would be unncessary work to maintain+ -- indexes for the unusual case.+ [ ContentFilesize ==. inodeCacheToFileSize i+ , ContentMtime >=. tmin+ , ContentMtime <=. tmax+ ]+ | otherwise = [ContentInodecache ==. i]+ (tmin, tmax) = inodeCacheEpochTimeRange i
Database/Types.hs view
@@ -5,124 +5,55 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE TypeSynonymInstances #-} -module Database.Types where+module Database.Types (+ module Database.Types,+ Key,+ EpochTime,+ FileSize,+) where -import Database.Persist.TH import Database.Persist.Class hiding (Key) import Database.Persist.Sql hiding (Key)-import Data.Maybe-import Data.Char import qualified Data.ByteString as S import qualified Data.Text as T-import Control.DeepSeq+import qualified Data.Attoparsec.ByteString as A+import System.PosixCompat.Types+import Data.Int+import Data.Text.Read+import Foreign.C.Types -import Utility.PartialPrelude import Key import Utility.InodeCache-import Git.Types (Ref(..))+import Utility.FileSize+import Git.Types import Types.UUID import Types.Import --- A serialized Key-newtype SKey = SKey String- deriving (Show, Read)--toSKey :: Key -> SKey-toSKey = SKey . serializeKey--fromSKey :: SKey -> Key-fromSKey (SKey s) = fromMaybe (error $ "bad serialized Key " ++ s) (deserializeKey s)--derivePersistField "SKey"---- A Key index. More efficient than SKey, but its Read instance does not--- work when it's used in any kind of complex data structure.-newtype IKey = IKey String--instance NFData IKey where- rnf (IKey s) = rnf s--instance Read IKey where- readsPrec _ s = [(IKey s, "")]--instance Show IKey where- show (IKey s) = s--toIKey :: Key -> IKey-toIKey = IKey . serializeKey--fromIKey :: IKey -> Key-fromIKey (IKey s) = fromMaybe (error $ "bad serialized Key " ++ s) (deserializeKey s)--derivePersistField "IKey"---- A serialized InodeCache-newtype SInodeCache = I String- deriving (Show, Read)--toSInodeCache :: InodeCache -> SInodeCache-toSInodeCache = I . showInodeCache--fromSInodeCache :: SInodeCache -> InodeCache-fromSInodeCache (I s) = fromMaybe (error $ "bad serialized InodeCache " ++ s) (readInodeCache s)--derivePersistField "SInodeCache"---- A serialized FilePath.------ Not all unicode characters round-trip through sqlite. In particular,--- surrigate code points do not. So, escape the FilePath. But, only when--- it contains such characters.-newtype SFilePath = SFilePath String---- Note that Read instance does not work when used in any kind of complex--- data structure.-instance Read SFilePath where- readsPrec _ s = [(SFilePath s, "")]--instance Show SFilePath where- show (SFilePath s) = s--toSFilePath :: FilePath -> SFilePath-toSFilePath s@('"':_) = SFilePath (show s)-toSFilePath s- | any needsescape s = SFilePath (show s)- | otherwise = SFilePath s- where- needsescape c = case generalCategory c of- Surrogate -> True- PrivateUse -> True- NotAssigned -> True- _ -> False--fromSFilePath :: SFilePath -> FilePath-fromSFilePath (SFilePath s@('"':_)) =- fromMaybe (error "bad serialized SFilePath " ++ s) (readish s)-fromSFilePath (SFilePath s) = s--derivePersistField "SFilePath"---- A serialized Ref-newtype SRef = SRef Ref---- Note that Read instance does not work when used in any kind of complex--- data structure.-instance Read SRef where- readsPrec _ s = [(SRef (Ref s), "")]--instance Show SRef where- show (SRef (Ref s)) = s+instance PersistField Key where+ toPersistValue = toPersistValue . serializeKey'+ fromPersistValue b = fromPersistValue b >>= parse+ where+ parse = either (Left . T.pack) Right . A.parseOnly keyParser -derivePersistField "SRef"+-- A key can contain arbitrarily encoded characters, so store in sqlite as a+-- blob to avoid encoding problems.+instance PersistFieldSql Key where+ sqlType _ = SqlBlob -toSRef :: Ref -> SRef-toSRef = SRef+instance PersistField InodeCache where+ toPersistValue = toPersistValue . showInodeCache + fromPersistValue b = fromPersistValue b >>= parse+ where+ parse s = maybe+ (Left $ T.pack $ "bad serialized InodeCache "++ s)+ Right+ (readInodeCache s) -fromSRef :: SRef -> Ref-fromSRef (SRef r) = r+instance PersistFieldSql InodeCache where+ sqlType _ = SqlString instance PersistField UUID where toPersistValue u = toPersistValue b@@ -146,3 +77,54 @@ instance PersistFieldSql ContentIdentifier where sqlType _ = SqlBlob++-- A serialized RawFilePath.+newtype SFilePath = SFilePath S.ByteString+ deriving (Eq, Show)++instance PersistField SFilePath where+ toPersistValue (SFilePath b) = toPersistValue b+ fromPersistValue v = SFilePath <$> fromPersistValue v++instance PersistFieldSql SFilePath where+ sqlType _ = SqlBlob++-- A serialized git Sha+newtype SSha = SSha String+ deriving (Eq, Show)++toSSha :: Sha -> SSha+toSSha (Ref s) = SSha s++fromSSha :: SSha -> Ref+fromSSha (SSha s) = Ref s++instance PersistField SSha where+ toPersistValue (SSha b) = toPersistValue b+ fromPersistValue v = SSha <$> fromPersistValue v++instance PersistFieldSql SSha where+ sqlType _ = SqlString++-- A FileSize could be stored as an Int64, but some systems could+-- conceivably have a larger filesize, and no math is ever done with them+-- in sqlite, so store a string instead.+instance PersistField FileSize where+ toPersistValue = toPersistValue . show+ fromPersistValue v = fromPersistValue v >>= parse+ where+ parse = either (Left . T.pack) (Right . fst) . decimal++instance PersistFieldSql FileSize where+ sqlType _ = SqlString++-- Store EpochTime as an Int64, to allow selecting values in a range.+instance PersistField EpochTime where+ toPersistValue (CTime t) = toPersistValue (fromIntegral t :: Int64)+ fromPersistValue v = CTime . fromIntegral <$> go+ where+ go :: Either T.Text Int64+ go = fromPersistValue v++instance PersistFieldSql EpochTime where+ sqlType _ = SqlInt64
Git/LsFiles.hs view
@@ -1,6 +1,6 @@ {- git ls-files interface -- - Copyright 2010-2018 Joey Hess <id@joeyh.name>+ - Copyright 2010-2019 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -24,6 +24,7 @@ Unmerged(..), unmerged, StagedDetails,+ inodeCaches, ) where import Common@@ -31,9 +32,12 @@ import Git.Command import Git.Types import Git.Sha+import Utility.InodeCache+import Utility.TimeStamp import Numeric import System.Posix.Types+import qualified Data.Map as M import qualified Data.ByteString.Lazy as L {- Scans for files that are checked into git's index at the specified locations. -}@@ -281,3 +285,53 @@ , itreeitemtype = Nothing , isha = Nothing }++{- Gets the InodeCache equivilant information stored in the git index.+ -+ - Note that this uses a --debug option whose output could change at some+ - point in the future. If the output is not as expected, will use Nothing.+ -}+inodeCaches :: [RawFilePath] -> Repo -> IO ([(FilePath, Maybe InodeCache)], IO Bool)+inodeCaches locs repo = do+ (ls, cleanup) <- pipeNullSplit params repo+ return (parse Nothing (map decodeBL ls), cleanup)+ where+ params = + Param "ls-files" :+ Param "--cached" :+ Param "-z" :+ Param "--debug" :+ Param "--" :+ map (File . fromRawFilePath) locs+ + parse Nothing (f:ls) = parse (Just f) ls+ parse (Just f) (s:[]) = + let i = parsedebug s+ in (f, i) : []+ parse (Just f) (s:ls) =+ let (d, f') = splitdebug s+ i = parsedebug d+ in (f, i) : parse (Just f') ls+ parse _ _ = []++ -- First 5 lines are --debug output, remainder is the next filename.+ -- This assumes that --debug does not start outputting more lines.+ splitdebug s = case splitc '\n' s of+ (d1:d2:d3:d4:d5:rest) ->+ ( intercalate "\n" [d1, d2, d3, d4, d5]+ , intercalate "\n" rest+ )+ _ -> ("", s)+ + -- This parser allows for some changes to the --debug output,+ -- including reordering, or adding more items.+ parsedebug s = do+ let l = words s+ let iskey v = ":" `isSuffixOf` v+ let m = M.fromList $ zip+ (filter iskey l)+ (filter (not . iskey) l)+ mkInodeCache+ <$> (readish =<< M.lookup "ino:" m)+ <*> (readish =<< M.lookup "size:" m)+ <*> (parsePOSIXTime =<< (replace ":" "." <$> M.lookup "mtime:" m))
Key.hs view
@@ -68,7 +68,7 @@ deserializeKey = deserializeKey' . encodeBS' deserializeKey' :: S.ByteString -> Maybe Key-deserializeKey' = either (const Nothing) Just . A.parseOnly keyParser+deserializeKey' = eitherToMaybe . A.parseOnly keyParser instance Arbitrary KeyData where arbitrary = Key
NEWS view
@@ -1,3 +1,27 @@+git-annex (8.20200226) upstream; urgency=medium+ + This version of git-annex uses repository version 8 for all repositories.++ Existing repositories will be automatically upgraded by default.+ You can prevent this, by runing: git config annex.autoupgraderepository false+ + The upgrade process involves regenerating some sqlite databases. There are a+ couple consequences of the upgrade to keep in mind:++ * Any incremental fscks that were started in v7 won't resume where+ they left off in v8, but will instead begin again from the first file.+ * An interrupted export that was started in v7 won't resume where it left+ off after upgrade to v8; files will be re-uploaded to the export remote.+ * After the upgrade, git-annex will in some situations have to do extra+ work while it finishes populating its sqlite databases.++ Also, there are some behavior changes around adding dotfiles. While before+ git-annex add skipped adding dotfiles when operating on whole directories,+ and added dotfiles that were explicitly listed to the annex, it now adds+ dotfiles to git by default, unless annex.dotfiles is set to true.++ -- Joey Hess <id@joeyh.name> Wed, 26 Feb 2020 17:18:16 -0400+ git-annex (7.20200226) upstream; urgency=high There was a serious regression in gcrypt and encrypted git-lfs remotes.
Remote.hs view
@@ -24,7 +24,7 @@ remoteTypes, remoteList, remoteList',- gitSyncableRemote,+ gitSyncableRemoteType, remoteMap, remoteMap', uuidDescriptions,@@ -131,7 +131,7 @@ repo <- getRepo r ifM (liftIO $ getDynamicConfig $ remoteAnnexIgnore (gitconfig r)) ( giveup $ noRemoteUUIDMsg r ++- " (" ++ show (remoteConfig repo "ignore") +++ " (" ++ show (remoteAnnexConfig repo "ignore") ++ " is set)" , giveup $ noRemoteUUIDMsg r )
Remote/External.hs view
@@ -171,7 +171,7 @@ c'' <- case getRemoteConfigValue readonlyField pc of Just True -> do- setConfig (remoteConfig (fromJust (lookupName c)) "readonly") (boolConfig True)+ setConfig (remoteAnnexConfig (fromJust (lookupName c)) "readonly") (boolConfig True) return c' _ -> do pc' <- either giveup return $ parseRemoteConfig c' lenientRemoteConfigParser@@ -420,9 +420,9 @@ modifyTVar' (externalConfigChanges st) $ \f -> f . M.insert (Accepted setting) (Accepted value) handleRemoteRequest (GETCONFIG setting) = do- value <- maybe "" fromProposedAccepted+ value <- fromMaybe "" . (M.lookup (Accepted setting))- . unparsedRemoteConfig+ . getRemoteConfigPassedThrough <$> liftIO (atomically $ readTVar $ externalConfig st) send $ VALUE value handleRemoteRequest (SETCREDS setting login password) = case (externalUUID external, externalGitConfig external) of
Remote/GCrypt.hs view
@@ -113,7 +113,7 @@ (Just remotename, Just rc') -> do pc <- parsedRemoteConfig remote rc' setGcryptEncryption pc remotename- storeUUIDIn (remoteConfig baser "uuid") u'+ storeUUIDIn (remoteAnnexConfig baser "uuid") u' setConfig (Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid gen' r u' pc gc rs _ -> do
Remote/Git.hs view
@@ -98,10 +98,10 @@ rs <- mapM (tweakurl c) =<< Annex.getGitRemotes mapM (configRead autoinit) rs where- annexurl n = Git.ConfigKey ("remote." <> encodeBS' n <> ".annexurl")+ annexurl r = remoteConfig r "annexurl" tweakurl c r = do let n = fromJust $ Git.remoteName r- case M.lookup (annexurl n) c of+ case M.lookup (annexurl r) c of Nothing -> return r Just url -> inRepo $ \g -> Git.Construct.remoteNamed n $@@ -257,7 +257,7 @@ | otherwise -> configlist_failed Left _ -> configlist_failed | Git.repoIsHttp r = storeUpdatedRemote geturlconfig- | Git.GCrypt.isEncrypted r = handlegcrypt =<< getConfigMaybe (remoteConfig r "uuid")+ | Git.GCrypt.isEncrypted r = handlegcrypt =<< getConfigMaybe (remoteAnnexConfig r "uuid") | Git.repoIsUrl r = return r | otherwise = storeUpdatedRemote $ liftIO $ readlocalannexconfig `catchNonAsync` (const $ return r)
Remote/GitLFS.hs view
@@ -167,7 +167,7 @@ -- (so it's also usable by git as a non-special remote), -- and set remote.name.annex-git-lfs = true gitConfigSpecialRemote u c' [("git-lfs", "true")]- setConfig (Git.ConfigKey ("remote." <> encodeBS' (getRemoteName c) <> ".url")) url+ setConfig (remoteConfig (getRemoteName c) "url") url return (c', u) where url = maybe (giveup "Specify url=") fromProposedAccepted @@ -202,7 +202,7 @@ set "config-uuid" (fromUUID cu) r' Nothing -> return r' set k v r' = do- let k' = remoteConfig r' k+ let k' = remoteAnnexConfig r' k setConfig k' v return $ Git.Config.store' k' (Git.ConfigValue (encodeBS' v)) r'
Remote/Helper/Special.hs view
@@ -81,8 +81,8 @@ gitConfigSpecialRemote :: UUID -> RemoteConfig -> [(String, String)] -> Annex () gitConfigSpecialRemote u c cfgs = do forM_ cfgs $ \(k, v) -> - setConfig (remoteConfig c (encodeBS' k)) v- storeUUIDIn (remoteConfig c "uuid") u+ setConfig (remoteAnnexConfig c (encodeBS' k)) v+ storeUUIDIn (remoteAnnexConfig c "uuid") u -- RetrievalVerifiableKeysSecure unless overridden by git config. --
Remote/List.hs view
@@ -126,8 +126,8 @@ | otherwise = return r {- Checks if a remote is syncable using git. -}-gitSyncableRemote :: Remote -> Bool-gitSyncableRemote r = remotetype r `elem`+gitSyncableRemoteType :: RemoteType -> Bool+gitSyncableRemoteType t = t `elem` [ Remote.Git.remote , Remote.GCrypt.remote , Remote.P2P.remote
Remote/S3.hs view
@@ -355,9 +355,7 @@ else do -- Calculate size of part that will -- be read.- let sz = if fsz - pos < partsz'- then fsz - pos- else partsz'+ let sz = min (fsz - pos) partsz' let p' = offsetMeterUpdate p (toBytesProcessed pos) let numchunks = ceiling (fromIntegral sz / fromIntegral defaultChunkSize :: Double) let popper = handlePopper numchunks defaultChunkSize p' fh
Test.hs view
@@ -149,9 +149,9 @@ map (\(d, te) -> withTestMode te initTests (unitTests d)) testmodes where testmodes = catMaybes- [ canadjust ("v7 adjusted unlocked branch", (testMode opts (RepoVersion 7)) { adjustedUnlockedBranch = True })- , unlesscrippled ("v7 unlocked", (testMode opts (RepoVersion 7)) { unlockedFiles = True })- , unlesscrippled ("v7 locked", testMode opts (RepoVersion 7))+ [ canadjust ("v8 adjusted unlocked branch", (testMode opts (RepoVersion 8)) { adjustedUnlockedBranch = True })+ , unlesscrippled ("v8 unlocked", (testMode opts (RepoVersion 8)) { unlockedFiles = True })+ , unlesscrippled ("v8 locked", testMode opts (RepoVersion 8)) ] unlesscrippled v | crippledfilesystem = Nothing
Test/Framework.hs view
@@ -584,7 +584,7 @@ where go = Types.Backend.getKey b ks Utility.Metered.nullMeterUpdate ks = Types.KeySource.KeySource- { Types.KeySource.keyFilename = f- , Types.KeySource.contentLocation = f+ { Types.KeySource.keyFilename = toRawFilePath f+ , Types.KeySource.contentLocation = toRawFilePath f , Types.KeySource.inodeCache = Nothing }
Types/GitConfig.hs view
@@ -87,6 +87,7 @@ , annexAriaTorrentOptions :: [String] , annexCrippledFileSystem :: Bool , annexLargeFiles :: Configurable (Maybe String)+ , annexDotFiles :: Configurable Bool , annexGitAddToAnnex :: Bool , annexAddSmallFiles :: Bool , annexFsckNudge :: Bool@@ -161,6 +162,7 @@ , annexCrippledFileSystem = getbool (annex "crippledfilesystem") False , annexLargeFiles = configurable Nothing $ fmap Just $ getmaybe (annex "largefiles")+ , annexDotFiles = configurable False $ getmaybebool (annex "dotfiles") , annexGitAddToAnnex = getbool (annex "gitaddtoannex") True , annexAddSmallFiles = getbool (annex "addsmallfiles") True , annexFsckNudge = getbool (annex "fscknudge") True@@ -236,6 +238,7 @@ , annexSyncOnlyAnnex = merge annexSyncOnlyAnnex , annexResolveMerge = merge annexResolveMerge , annexLargeFiles = merge annexLargeFiles+ , annexDotFiles = merge annexDotFiles , annexAddUnlocked = merge annexAddUnlocked } where
Types/KeySource.hs view
@@ -8,6 +8,7 @@ module Types.KeySource where import Utility.InodeCache+import System.FilePath.ByteString (RawFilePath) {- When content is in the process of being ingested into the annex, - and a Key generated from it, this data type is used. @@ -22,8 +23,8 @@ - files that may be made while they're in the process of being ingested. -} data KeySource = KeySource- { keyFilename :: FilePath- , contentLocation :: FilePath+ { keyFilename :: RawFilePath+ , contentLocation :: RawFilePath , inodeCache :: Maybe InodeCache } deriving (Show)
Types/RemoteConfig.hs view
@@ -23,9 +23,8 @@ {- Before being used a RemoteConfig has to be parsed. -} data ParsedRemoteConfig = ParsedRemoteConfig- { parsedRemoteConfigMap :: M.Map RemoteConfigField RemoteConfigValue- , unparsedRemoteConfig :: RemoteConfig- }+ (M.Map RemoteConfigField RemoteConfigValue)+ RemoteConfig {- Remotes can have configuration values of many types, so use Typeable - to let them all be stored in here. -}
Upgrade.hs view
@@ -23,6 +23,7 @@ import qualified Upgrade.V4 import qualified Upgrade.V5 import qualified Upgrade.V6+import qualified Upgrade.V7 import qualified Data.Map as M @@ -84,4 +85,5 @@ up (RepoVersion 4) = Upgrade.V4.upgrade automatic up (RepoVersion 5) = Upgrade.V5.upgrade automatic up (RepoVersion 6) = Upgrade.V6.upgrade automatic+ up (RepoVersion 7) = Upgrade.V7.upgrade automatic up _ = return True
+ Upgrade/V7.hs view
@@ -0,0 +1,132 @@+{- git-annex v7 -> v8 upgrade support+ -+ - Copyright 2019 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}++module Upgrade.V7 where++import qualified Annex+import Annex.Common+import Annex.CatFile+import qualified Database.Keys+import qualified Database.Keys.SQL+import qualified Git.LsFiles as LsFiles+import qualified Git+import Git.FilePath++upgrade :: Bool -> Annex Bool+upgrade automatic = do+ unless automatic $+ showAction "v7 to v8"++ -- The fsck databases are not transitioned here; any running+ -- incremental fsck can continue to write to the old database.+ -- The next time an incremental fsck is started, it will delete the+ -- old database, and just re-fsck the files.+ + -- The old content identifier database is deleted here, but the+ -- new database is not populated. It will be automatically+ -- populated from the git-annex branch the next time it is used.+ removeOldDb gitAnnexContentIdentifierDbDirOld+ liftIO . nukeFile =<< fromRepo gitAnnexContentIdentifierLockOld++ -- The export databases are deleted here. The new databases+ -- will be populated by the next thing that needs them, the same+ -- way as they would be in a fresh clone.+ removeOldDb gitAnnexExportDir++ populateKeysDb+ removeOldDb gitAnnexKeysDbOld+ liftIO . nukeFile =<< fromRepo gitAnnexKeysDbIndexCacheOld+ liftIO . nukeFile =<< fromRepo gitAnnexKeysDbLockOld+ + updateSmudgeFilter++ return True++gitAnnexKeysDbOld :: Git.Repo -> FilePath+gitAnnexKeysDbOld r = fromRawFilePath (gitAnnexDir r) </> "keys"++gitAnnexKeysDbLockOld :: Git.Repo -> FilePath+gitAnnexKeysDbLockOld r = gitAnnexKeysDbOld r ++ ".lck"++gitAnnexKeysDbIndexCacheOld :: Git.Repo -> FilePath+gitAnnexKeysDbIndexCacheOld r = gitAnnexKeysDbOld r ++ ".cache"++gitAnnexContentIdentifierDbDirOld :: Git.Repo -> FilePath+gitAnnexContentIdentifierDbDirOld r = fromRawFilePath (gitAnnexDir r) </> "cids"++gitAnnexContentIdentifierLockOld :: Git.Repo -> FilePath+gitAnnexContentIdentifierLockOld r = gitAnnexContentIdentifierDbDirOld r ++ ".lck"++removeOldDb :: (Git.Repo -> FilePath) -> Annex ()+removeOldDb getdb = do+ db <- fromRepo getdb+ whenM (liftIO $ doesDirectoryExist db) $ do+ v <- liftIO $ tryNonAsync $+#if MIN_VERSION_directory(1,2,7)+ removePathForcibly db+#else+ removeDirectoryRecursive db+#endif+ case v of+ Left ex -> giveup $ "Failed removing old database directory " ++ db ++ " during upgrade (" ++ show ex ++ ") -- delete that and re-run git-annex to finish the upgrade."+ Right () -> return ()++-- Populate the new keys database with associated files and inode caches.+--+-- The information is queried from git. The index contains inode cache+-- information for all staged files, so that is used.+--+-- Note that typically the inode cache of annex objects is also stored in+-- the keys database. This does not add it though, because it's possible+-- that any annex object has gotten modified. The most likely way would be+-- due to annex.thin having been set at some point in the past, bypassing+-- the usual safeguards against object modification. When a worktree file+-- is still a hardlink to an annex object, then they have the same inode+-- cache, so using the inode cache from the git index will get the right+-- thing added in that case. But there are cases where the annex object's+-- inode cache is not added here, most notably when it's not unlocked. +-- The result will be more work needing to be done by isUnmodified and+-- by inAnnex (the latter only when annex.thin is set) to verify the+-- annex object. That work is only done once, and then the object will+-- finally get its inode cached.+populateKeysDb :: Annex ()+populateKeysDb = do+ top <- fromRepo Git.repoPath+ (l, cleanup) <- inRepo $ LsFiles.inodeCaches [top]+ forM_ l $ \case+ (_f, Nothing) -> giveup "Unable to parse git ls-files --debug output while upgrading git-annex sqlite databases."+ (f, Just ic) -> unlessM (liftIO $ isSymbolicLink <$> getSymbolicLinkStatus f) $ do+ catKeyFile (toRawFilePath f) >>= \case+ Nothing -> noop+ Just k -> do+ topf <- inRepo $ toTopFilePath $ toRawFilePath f+ Database.Keys.runWriter $ \h -> liftIO $ do+ Database.Keys.SQL.addAssociatedFileFast k topf h+ Database.Keys.SQL.addInodeCaches k [ic] h+ liftIO $ void cleanup+ Database.Keys.closeDb++-- The gitatrributes used to have a line that prevented filtering dotfiles,+-- but now they are filtered and annex.dotfiles controls whether they get+-- added to the annex.+--+-- Only done on local gitattributes, not any gitatrributes that might be+-- checked into the repository.+updateSmudgeFilter :: Annex ()+updateSmudgeFilter = do+ lf <- Annex.fromRepo Git.attributesLocal+ ls <- liftIO $ lines <$> catchDefaultIO "" (readFileStrict lf)+ let ls' = removedotfilter ls+ when (ls /= ls') $+ liftIO $ writeFile lf (unlines ls')+ where+ removedotfilter ("* filter=annex":".* !filter":rest) =+ "* filter=annex" : removedotfilter rest+ removedotfilter (l:ls) = l : removedotfilter ls+ removedotfilter [] = []
Utility/IPAddress.hs view
@@ -103,10 +103,12 @@ - match that address in a SockAddr. Nothing when the address cannot be - parsed. -+ - When a port is specified, will only match a SockAddr using the same port.+ - - This does not involve any DNS lookups. -}-makeAddressMatcher :: String -> IO (Maybe (SockAddr -> Bool))-makeAddressMatcher s = go+makeAddressMatcher :: String -> Maybe PortNumber -> IO (Maybe (SockAddr -> Bool))+makeAddressMatcher s mp = go <$> catchDefaultIO [] (getAddrInfo (Just hints) (Just s) Nothing) where hints = defaultHints@@ -117,6 +119,11 @@ go [] = Nothing go l = Just $ \sockaddr -> any (match sockaddr) (map addrAddress l) - match (SockAddrInet _ a) (SockAddrInet _ b) = a == b- match (SockAddrInet6 _ _ a _) (SockAddrInet6 _ _ b _) = a == b+ match (SockAddrInet p a) (SockAddrInet _ b) = a == b && matchport p+ match (SockAddrInet6 p _ a _) (SockAddrInet6 _ _ b _) = a == b && matchport p match _ _ = False++ matchport p = case mp of+ Nothing -> True+ Just p' -> p == p'+
Utility/InodeCache.hs view
@@ -1,7 +1,7 @@ {- Caching a file's inode, size, and modification time - to see when it's changed. -- - Copyright 2013-2018 Joey Hess <id@joeyh.name>+ - Copyright 2013-2019 Joey Hess <id@joeyh.name> - - License: BSD-2-clause -}@@ -12,6 +12,7 @@ module Utility.InodeCache ( InodeCache,+ mkInodeCache, InodeComparisonType(..), inodeCacheFileSize, @@ -23,11 +24,13 @@ showInodeCache, genInodeCache, toInodeCache,- likeInodeCacheWeak, InodeCacheKey, inodeCacheToKey,+ inodeCacheToFileSize, inodeCacheToMtime,+ inodeCacheToEpochTime,+ inodeCacheEpochTimeRange, SentinalFile(..), SentinalStatus(..),@@ -60,6 +63,10 @@ newtype InodeCache = InodeCache InodeCachePrim deriving (Show) +mkInodeCache :: FileID -> FileSize -> POSIXTime -> InodeCache+mkInodeCache inode sz mtime = InodeCache $+ InodeCachePrim inode sz (MTimeHighRes mtime)+ inodeCacheFileSize :: InodeCache -> FileSize inodeCacheFileSize (InodeCache (InodeCachePrim _ sz _)) = sz @@ -102,9 +109,21 @@ inodeCacheToKey :: InodeComparisonType -> InodeCache -> InodeCacheKey inodeCacheToKey ct (InodeCache prim) = InodeCacheKey ct prim +inodeCacheToFileSize :: InodeCache -> FileSize+inodeCacheToFileSize (InodeCache (InodeCachePrim _ sz _)) = sz+ inodeCacheToMtime :: InodeCache -> POSIXTime inodeCacheToMtime (InodeCache (InodeCachePrim _ _ mtime)) = highResTime mtime +inodeCacheToEpochTime :: InodeCache -> EpochTime+inodeCacheToEpochTime (InodeCache (InodeCachePrim _ _ mtime)) = lowResTime mtime++-- Returns min, max EpochTime that weakly match the time of the InodeCache.+inodeCacheEpochTimeRange :: InodeCache -> (EpochTime, EpochTime)+inodeCacheEpochTimeRange i =+ let t = inodeCacheToEpochTime i+ in (t-1, t+1)+ {- For backwards compatability, support low-res mtime with no - fractional seconds. -} data MTime = MTimeLowRes EpochTime | MTimeHighRes POSIXTime@@ -150,22 +169,6 @@ , show size , show mtime ]---- Generates patterns that can be used in a SQL LIKE query to match--- serialized inode caches that are weakly the same as the provided--- InodeCache.------ Like compareWeak, the size has to match, while the mtime can differ--- by anything less than 2 seconds.-likeInodeCacheWeak :: InodeCache -> [String]-likeInodeCacheWeak (InodeCache (InodeCachePrim _ size mtime)) =- lowresl ++ highresl- where- lowresl = map mkpat [t, t+1, t-1]- highresl = map (++ " %") lowresl- t = lowResTime mtime- mkpat t' = "% " ++ ssz ++ " " ++ show t'- ssz = show size readInodeCache :: String -> Maybe InodeCache readInodeCache s = case words s of
doc/git-annex-add.mdwn view
@@ -18,6 +18,8 @@ If annex.largefiles is configured, and does not match a file, `git annex add` will behave the same as `git add` and add the non-large file directly to the git repository, instead of to the annex.+(By default dotfiles are assumed to not be large, and are added directly+to git, but annex.dotfiles can be configured to annex those too.) Large files are added to the annex in locked form, which prevents further modification of their content unless unlocked by [[git-annex-unlock]](1).@@ -30,24 +32,20 @@ # OPTIONS -* `--include-dotfiles`-- Dotfiles are skipped unless explicitly listed, or unless this option is- used.- * `--force` Add gitignored files. * `--force-large` - Treat all files as large files, ignoring annex.largefiles configuration,- and add to the annex.+ Treat all files as large files, ignoring annex.largefiles and annex.dotfiles+ configuration, and add to the annex. * `--force-small` - Treat all files as small files, ignoring annex.largefiles configuration,- and add to git, also ignoring annex.addsmallfiles configuration.+ Treat all files as small files, ignoring annex.largefiles and annex.dotfiles+ configuration, and add to git, also ignoring annex.addsmallfiles+ configuration. * `--backend`
doc/git-annex-enableremote.mdwn view
@@ -8,27 +8,20 @@ # DESCRIPTION -Enables use of an existing remote in the current repository.--This is often used to enable use of a special (non-git) remote, by-a different repository than the one in which it was-originally created with the initremote command. --It can also be used to explicitly enable a git remote,-so that git-annex can store the contents of files there. First-run `git remote add`, and then `git annex enableremote` with the name of-the remote.+Enables use of an existing remote in the current repository,+that was set up earlier by `git annex initremote` run in+another clone of the repository. -When enabling a special remote, specify the same name used when originally-creating that remote with `git annex initremote`. Run +When enabling a remote, specify the same name used when originally+setting up that remote with `git annex initremote`. Run `git annex enableremote` without any name to get a list of-special remote names. Or you can specify the uuid or description of the-special remote.+remote names. Or you can specify the uuid or description of the+remote. -Some special remotes may need parameters to be specified every time they are-enabled. For example, the directory special remote requires a directory=-parameter every time. The command will prompt for any required parameters-you leave out.+Some types of special remotes need parameters to be specified every time+they are enabled. For example, the directory special remote requires a+directory= parameter every time. The command will prompt for any required+parameters you leave out. This command can also be used to modify the configuration of an existing special remote, by specifying new values for parameters that are@@ -60,8 +53,9 @@ this works best when the special remote does not need anything special to be done to get it enabled. -(This command also can be used to enable a remote that git-annex has been-prevented from using by the `remote.<name>.annex-ignore` setting.)+(This command also can be used to enable a git remote that git-annex+has found didn't work before and gave up on using, setting +`remote.<name>.annex-ignore`.) # SEE ALSO
doc/git-annex-init.mdwn view
@@ -36,6 +36,9 @@ Force the repository to be initialized using a different annex.version than the current default. + When the version given is one that automatically upgrades to a newer+ version, it will automatically use the newer version instead.+ # SEE ALSO [[git-annex]](1)
doc/git-annex.mdwn view
@@ -871,11 +871,11 @@ * `annex.maxextensionlength` - Maximum length of what is considered a filename extension when adding a- file to a backend that preserves filename extensions. The default length- is 4, which allows extensions like "jpeg". The dot before the extension- is not counted part of its length. At most two extensions at the end of- a filename will be preserved, e.g. .gz or .tar.gz .+ Maximum length, in bytes, of what is considered a filename extension when+ adding a file to a backend that preserves filename extensions. The+ default length is 4, which allows extensions like "jpeg". The dot before+ the extension is not counted part of its length. At most two extensions+ at the end of a filename will be preserved, e.g. .gz or .tar.gz . * `annex.diskreserve` @@ -901,8 +901,9 @@ This configures the behavior of both git-annex and git when adding files to the repository. By default, `git-annex add` adds all files- to the annex, and `git add` adds files to git (unless they were added- to the annex previously). When annex.largefiles is configured, both+ to the annex (except dotfiles), and `git add` adds files to git+ (unless they were added to the annex previously).+ When annex.largefiles is configured, both `git annex add` and `git add` will add matching large files to the annex, and the other files to git. @@ -910,6 +911,23 @@ `git annex import`, `git annex addurl`, `git annex importfeed` and the assistant. +* `annex.dotfiles`++ Normally, dotfiles are assumed to be files like .gitignore,+ whose content should always be part of the git repository, so + they will not be added to the annex. Setting annex.dotfiles to true+ makes dotfiles be added to the annex the same as any other file. ++ To annex only some dotfiles, set this and configure annex.largefiles+ to match the ones you want. For example, to match only dotfiles ending + in ".big"++ git config annex.largefiles "(include=.*.big or include=*/.*.big) or (exclude=.* and exclude=*/.*)"+ git config annex.dotfiles true+ + To configure a default annex.dotfiles for all clones of the repository,+ this can be set in [[git-annex-config]](1).+ * `annex.gitaddtoannex` Setting this to false will prevent `git add` from adding@@ -1577,8 +1595,9 @@ private network. This setting can override that behavior, allowing access to particular- IP addresses. For example "127.0.0.1 ::1" allows access to localhost- (both IPV4 and IPV6). To allow access to all IP addresses, use "all"+ IP addresses that would normally be blocked. For example "127.0.0.1 ::1"+ allows access to localhost (both IPV4 and IPV6).+ To allow access to all IP addresses, use "all" Think very carefully before changing this; there are security implications. Anyone who can get a commit into your git-annex repository@@ -1589,6 +1608,11 @@ Note that, since the interfaces of curl and youtube-dl do not allow these IP address restrictions to be enforced, curl and youtube-dl will never be used unless annex.security.allowed-ip-addresses=all.+ + To allow accessing local or private IP addresses on only specific ports,+ use the syntax "[addr]:port". For example,+ "[127.0.0.1]:80 [127.0.0.1]:443 [::1]:80 [::1]:443" allows+ localhost on the http ports only. * `annex.security.allowed-http-addresses`
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 7.20200309+Version: 8.20200226 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -1020,6 +1020,7 @@ Upgrade.V5 Upgrade.V5.Direct Upgrade.V6+ Upgrade.V7 Utility.Aeson Utility.Android Utility.Applicative