packages feed

git-annex 7.20200309 → 8.20200226

raw patch · 66 files changed

+786/−483 lines, 66 files

Files

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