git-annex 7.20191114 → 7.20191218

raw patch · 130 files changed

+1041/−519 lines, 130 files

Files

• Annex.hs +1/−1
• Annex/Content.hs +7/−7
• Annex/Content/LowLevel.hs +1/−1
• Annex/DirHashes.hs +2/−2
• Annex/Export.hs +1/−1
• Annex/GitOverlay.hs +15/−15
• Annex/Import.hs +1/−1
• Annex/Init.hs +2/−2
• Annex/Locations.hs +3/−3
• Annex/SpecialRemote.hs +1/−13
• Annex/SpecialRemote/Config.hs +8/−0
• Annex/Transfer.hs +4/−4
• Annex/VariantFile.hs +3/−3
• Annex/WorkTree.hs +2/−1
• Assistant/DeleteRemote.hs +1/−1
• Assistant/Threads/TransferScanner.hs +1/−1
• Assistant/TransferQueue.hs +2/−2
• Assistant/Unused.hs +1/−1
• Assistant/Upgrade.hs +4/−5
• Backend.hs +6/−4
• Backend/Hash.hs +14/−11
• Backend/URL.hs +1/−1
• Backend/WORM.hs +5/−5
• CHANGELOG +27/−0
• CmdLine/GitAnnex/Options.hs +18/−13
• Command/AddUrl.hs +5/−3
• Command/Benchmark.hs +6/−5
• Command/Find.hs +4/−4
• Command/FromKey.hs +4/−4
• Command/Fsck.hs +5/−5
• Command/Import.hs +1/−1
• Command/Info.hs +28/−28
• Command/Inprogress.hs +9/−9
• Command/MatchExpression.hs +1/−1
• Command/Migrate.hs +1/−1
• Command/RegisterUrl.hs +3/−3
• Command/SendKey.hs +1/−1
• Command/SetKey.hs +3/−3
• Command/Smudge.hs +1/−1
• Command/TestRemote.hs +4/−4
• Command/TransferInfo.hs +1/−1
• Crypto.hs +2/−2
• Database/Benchmark.hs +22/−23
• Git/Config.hs +8/−0
• Git/CurrentRepo.hs +5/−1
• Git/Remote.hs +1/−0
• Key.hs +23/−120
• Limit.hs +3/−3
• Logs/Transfer.hs +13/−11
• Messages/Progress.hs +2/−2
• Remote/BitTorrent.hs +1/−1
• Remote/External.hs +1/−1
• Remote/External/Types.hs +2/−2
• Remote/Git.hs +44/−28
• Remote/GitLFS.hs +42/−13
• Remote/Glacier.hs +1/−1
• Remote/Helper/Chunked.hs +10/−8
• Remote/Helper/ExportImport.hs +2/−2
• Remote/List.hs +5/−1
• Remote/S3.hs +2/−2
• Remote/Web.hs +1/−1
• Types/Distribution.hs +5/−3
• Types/Key.hs +171/−2
• Types/Transfer.hs +6/−2
• Upgrade/V1.hs +11/−7
• Utility/Android.hs +3/−1
• Utility/Applicative.hs +5/−1
• Utility/Batch.hs +8/−1
• Utility/DBus.hs +7/−1
• Utility/Daemon.hs +6/−1
• Utility/Data.hs +4/−1
• Utility/DebugLocks.hs +1/−1
• Utility/DirWatcher.hs +9/−1
• Utility/DirWatcher/FSEvents.hs +1/−1
• Utility/DirWatcher/INotify.hs +1/−1
• Utility/DirWatcher/Types.hs +5/−1
• Utility/DirWatcher/Win32Notify.hs +1/−1
• Utility/Directory/Stream.hs +7/−18
• Utility/Dot.hs +13/−1
• Utility/DottedVersion.hs +5/−1
• Utility/Env.hs +8/−1
• Utility/Env/Basic.hs +4/−1
• Utility/Env/Set.hs +4/−1
• Utility/FileSize.hs +6/−1
• Utility/Gpg.hs +29/−3
• Utility/Hash.hs +4/−0
• Utility/HtmlDetect.hs +5/−1
• Utility/HumanNumber.hs +1/−1
• Utility/IPAddress.hs +6/−1
• Utility/InodeCache.hs +3/−5
• Utility/LinuxMkLibs.hs +6/−1
• Utility/LockFile/LockStatus.hs +1/−1
• Utility/LogFile.hs +9/−1
• Utility/Lsof.hs +6/−1
• Utility/Metered.hs +34/−6
• Utility/Misc.hs +13/−1
• Utility/Monad.hs +13/−1
• Utility/Network.hs +1/−1
• Utility/OSX.hs +6/−1
• Utility/OptParse.hs +4/−1
• Utility/PID.hs +1/−1
• Utility/Parallel.hs +1/−1
• Utility/PartialPrelude.hs +12/−1
• Utility/Path.hs +23/−1
• Utility/Path/Max.hs +1/−1
• Utility/Process/Transcript.hs +5/−1
• Utility/Rsync.hs +12/−4
• Utility/SafeCommand.hs +17/−1
• Utility/Scheduled/QuickCheck.hs +1/−1
• Utility/Shell.hs +5/−1
• Utility/Split.hs +6/−1
• Utility/SshConfig.hs +18/−1
• Utility/Su.hs +9/−1
• Utility/TList.hs +11/−1
• Utility/Tense.hs +7/−4
• Utility/ThreadLock.hs +5/−1
• Utility/ThreadScheduler.hs +8/−1
• Utility/TimeStamp.hs +5/−1
• Utility/Tmp.hs +7/−1
• Utility/Tmp/Dir.hs +4/−1
• Utility/Tor.hs +11/−1
• Utility/Tuple.hs +5/−1
• Utility/Url.hs +1/−1
• Utility/Verifiable.hs +8/−1
• Utility/WebApp.hs +8/−7
• doc/git-annex-import.mdwn +11/−6
• doc/git-annex-inprogress.mdwn +5/−1
• doc/git-annex.mdwn +2/−3
• git-annex.cabal +1/−1
• templates/dashboard/transfers.hamlet +1/−1

@@ -147,7 +147,7 @@ 	, activeremotes :: MVar (M.Map (Types.Remote.RemoteA Annex) Integer) 	, keysdbhandle :: Maybe Keys.DbHandle 	, cachedcurrentbranch :: (Maybe (Maybe Git.Branch, Maybe Adjustment))-	, cachedgitenv :: Maybe [(String, String)]+	, cachedgitenv :: Maybe (FilePath, [(String, String)]) 	, urloptions :: Maybe UrlOptions 	} 

@@ -329,7 +329,7 @@ 	checkallowed a = case rsp of 		RetrievalAllKeysSecure -> a 		RetrievalVerifiableKeysSecure-			| isVerifiable (keyVariety key) -> a+			| isVerifiable (fromKey keyVariety key) -> a 			| otherwise -> ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig) 				( a 				, warnUnverifiableInsecure key >> return False@@ -353,7 +353,7 @@ verifyKeyContent rsp v verification k f = case (rsp, verification) of 	(_, Verified) -> return True 	(RetrievalVerifiableKeysSecure, _)-		| isVerifiable (keyVariety k) -> verify+		| isVerifiable (fromKey keyVariety k) -> verify 		| otherwise -> ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig) 			( verify 			, warnUnverifiableInsecure k >> return False@@ -365,12 +365,12 @@ 	(_, MustVerify) -> verify   where 	verify = enteringStage VerifyStage $ verifysize <&&> verifycontent-	verifysize = case keySize k of+	verifysize = case fromKey keySize k of 		Nothing -> return True 		Just size -> do 			size' <- liftIO $ catchDefaultIO 0 $ getFileSize f 			return (size' == size)-	verifycontent = case Types.Backend.verifyKeyContent =<< Backend.maybeLookupBackendVariety (keyVariety k) of+	verifycontent = case Types.Backend.verifyKeyContent =<< Backend.maybeLookupBackendVariety (fromKey keyVariety k) of 		Nothing -> return True 		Just verifier -> verifier k f @@ -382,7 +382,7 @@ 	, "this safety check.)" 	]   where-	kv = decodeBS (formatKeyVariety (keyVariety k))+	kv = decodeBS (formatKeyVariety (fromKey keyVariety k))  data VerifyConfig = AlwaysVerify | NoVerify | RemoteVerify Remote | DefaultVerify @@ -490,10 +490,10 @@  checkSecureHashes :: Key -> Annex Bool checkSecureHashes key-	| cryptographicallySecure (keyVariety key) = return True+	| cryptographicallySecure (fromKey keyVariety key) = return True 	| otherwise = ifM (annexSecureHashesOnly <$> Annex.getGitConfig) 		( do-			warning $ "annex.securehashesonly blocked adding " ++ decodeBS (formatKeyVariety (keyVariety key)) ++ " key to annex objects"+			warning $ "annex.securehashesonly blocked adding " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key to annex objects" 			return False 		, return True 		)

@@ -100,7 +100,7 @@  - when doing concurrent downloads.  -} checkDiskSpace :: Maybe FilePath -> Key -> Integer -> Bool -> Annex Bool-checkDiskSpace destdir key = checkDiskSpace' (fromMaybe 1 (keySize key)) destdir key+checkDiskSpace destdir key = checkDiskSpace' (fromMaybe 1 (fromKey keySize key)) destdir key  {- Allows specifying the size of the key, if it's known, which is useful  - as not all keys know their size. -}

@@ -65,14 +65,14 @@ hashDirs _ sz s = addTrailingPathSeparator $ take sz s </> drop sz s  hashDirLower :: HashLevels -> Hasher-hashDirLower n k = hashDirs n 3 $ take 6 $ show $ md5 $ serializeKey' $ nonChunkKey k+hashDirLower n k = hashDirs n 3 $ take 6 $ show $ md5s $ serializeKey' $ nonChunkKey k  {- This was originally using Data.Hash.MD5 from MissingH. This new version - is faster, but ugly as it has to replicate the 4 Word32's that produced. -} hashDirMixed :: HashLevels -> Hasher hashDirMixed n k = hashDirs n 2 $ take 4 $ concatMap display_32bits_as_dir $ 	encodeWord32 $ map fromIntegral $ Data.ByteArray.unpack $-		Utility.Hash.md5 $ serializeKey' $ nonChunkKey k+		Utility.Hash.md5s $ serializeKey' $ nonChunkKey k   where 	encodeWord32 (b1:b2:b3:b4:rest) = 		(shiftL b4 24 .|. shiftL b3 16 .|. shiftL b2 8 .|. b1)

@@ -33,7 +33,7 @@ exportKey sha = mk <$> catKey sha   where 	mk (Just k) = AnnexKey k-	mk Nothing = GitKey $ Key+	mk Nothing = GitKey $ mkKey $ \k -> k 		{ keyName = encodeBS $ Git.fromRef sha 		, keyVariety = SHA1Key (HasExt False) 		, keySize = Nothing

@@ -14,7 +14,6 @@ import Git.Types import Git.Index import Git.Env-import Utility.Env import qualified Annex import qualified Annex.Queue @@ -23,28 +22,29 @@ withIndexFile f a = do 	f' <- liftIO $ indexEnvVal f 	withAltRepo-		(usecachedgitenv $ \g -> liftIO $ addGitEnv g indexEnv f')+		(usecachedgitenv f' $ \g -> addGitEnv g indexEnv f') 		(\g g' -> g' { gitEnv = gitEnv g }) 		a   where 	-- This is an optimisation. Since withIndexFile is run repeatedly,-	-- and addGitEnv uses the slow getEnvironment when gitEnv is Nothing, -	-- we cache the environment the first time, and reuse it in-	-- subsequent calls.+	-- typically with the same file, and addGitEnv uses the slow+	-- getEnvironment when gitEnv is Nothing, and has to do a+	-- nontrivial amount of work, we cache the modified environment+	-- the first time, and reuse it in subsequent calls for the same+	-- index file. 	-- 	-- (This could be done at another level; eg when creating the 	-- Git object in the first place, but it's more efficient to let-	-- the enviroment be inherited in all calls to git where it+	-- the environment be inherited in all calls to git where it 	-- does not need to be modified.)-	usecachedgitenv m g = case gitEnv g of-		Just _ -> m g-		Nothing -> do-			e <- Annex.withState $ \s -> case Annex.cachedgitenv s of-				Nothing -> do-					e <- getEnvironment-					return (s { Annex.cachedgitenv = Just e }, e)-				Just e -> return (s, e)-			m (g { gitEnv = Just e })+	usecachedgitenv f' m g = case gitEnv g of+		Just _ -> liftIO $ m g+		Nothing -> Annex.withState $ \s -> case Annex.cachedgitenv s of+			Just (cachedf, cachede) | f' == cachedf ->+				return (s, g { gitEnv = Just cachede })+			_ -> do+				g' <- m g+				return (s { Annex.cachedgitenv = (,) <$> Just f' <*> gitEnv g' }, g')  {- Runs an action using a different git work tree.  -

@@ -398,7 +398,7 @@ {- Temporary key used for import of a ContentIdentifier while downloading  - content, before generating its real key. -} importKey :: ContentIdentifier -> Integer -> Key-importKey (ContentIdentifier cid) size = stubKey+importKey (ContentIdentifier cid) size = mkKey $ \k -> k 	{ keyName = cid 	, keyVariety = OtherKey "CID" 	, keySize = Just size

@@ -108,9 +108,9 @@ 	unlessM (isJust <$> getVersion) $ 		setVersion (fromMaybe defaultVersion mversion) 	configureSmudgeFilter-	showSideAction "scanning for unlocked files"-	scanUnlockedFiles 	unlessM isBareRepo $ do+		showSideAction "scanning for unlocked files"+		scanUnlockedFiles 		hookWrite postCheckoutHook 		hookWrite postMergeHook 	AdjustedBranch.checkAdjustedClone >>= \case

@@ -93,7 +93,6 @@ import Data.Char import Data.Default import qualified Data.ByteString.Char8 as S8-import qualified Data.ByteString.Lazy as L  import Common import Key@@ -563,8 +562,8 @@  keyFile' :: Key -> RawFilePath keyFile' k = -	let b = L.toStrict (serializeKey' k)-	in if any (`S8.elem` b) ['&', '%', ':', '/']+	let b = serializeKey' k+	in if S8.any (`elem` ['&', '%', ':', '/']) b 		then S8.concatMap esc b 		else b   where@@ -573,6 +572,7 @@ 	esc ':' = "&c" 	esc '/' = "%" 	esc c = S8.singleton c+  {- Reverses keyFile, converting a filename fragment (ie, the basename of  - the symlink target) into a key. -}

@@ -34,20 +34,8 @@ 	t <- trustMap 	headMaybe 		. sortBy (comparing $ \(u, _, _) -> Down $ M.lookup u t)-		. findByName name+		. findByRemoteConfig (\c -> lookupName c == Just name) 		<$> Logs.Remote.readRemoteLog--findByName :: RemoteName ->  M.Map UUID RemoteConfig -> [(UUID, RemoteConfig, Maybe (ConfigFrom UUID))]-findByName n = map sameasuuid . filter (matching . snd) . M.toList-  where-	matching c = case lookupName c of-		Nothing -> False-		Just n'-			| n' == n -> True-			| otherwise -> False-	sameasuuid (u, c) = case M.lookup sameasUUIDField c of-		Nothing -> (u, c, Nothing)-		Just u' -> (toUUID u', c, Just (ConfigFrom u))  newConfig 	:: RemoteName

@@ -101,3 +101,11 @@ removeSameasInherited c = case M.lookup sameasUUIDField c of 	Nothing -> c 	Just _ -> M.withoutKeys c sameasInherits++{- Finds remote uuids with matching RemoteConfig. -}+findByRemoteConfig :: (RemoteConfig -> Bool) -> M.Map UUID RemoteConfig -> [(UUID, RemoteConfig, Maybe (ConfigFrom UUID))]+findByRemoteConfig matching = map sameasuuid . filter (matching . snd) . M.toList+  where+	sameasuuid (u, c) = case M.lookup sameasUUIDField c of+		Nothing -> (u, c, Nothing)+		Just u' -> (toUUID u', c, Just (ConfigFrom u))

@@ -40,15 +40,15 @@  upload :: Observable v => UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> NotifyWitness -> Annex v upload u key f d a _witness = guardHaveUUID u $ -	runTransfer (Transfer Upload u key) f d a+	runTransfer (Transfer Upload u (fromKey id key)) f d a  alwaysUpload :: Observable v => UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> NotifyWitness -> Annex v alwaysUpload u key f d a _witness = guardHaveUUID u $ -	alwaysRunTransfer (Transfer Upload u key) f d a+	alwaysRunTransfer (Transfer Upload u (fromKey id key)) f d a  download :: Observable v => UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> NotifyWitness -> Annex v download u key f d a _witness = guardHaveUUID u $-	runTransfer (Transfer Download u key) f d a+	runTransfer (Transfer Download u (fromKey id key)) f d a  guardHaveUUID :: Observable v => UUID -> Annex v -> Annex v guardHaveUUID u a@@ -185,7 +185,7 @@ 		, a 		)   where-	variety = keyVariety (transferKey t)+	variety = fromKey keyVariety (transferKey t)  type RetryDecider = Annex (TransferInfo -> TransferInfo -> Annex Bool) 

@@ -10,7 +10,7 @@ import Annex.Common import Utility.Hash -import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as S  variantMarker :: String variantMarker = ".variant-"@@ -41,5 +41,5 @@   where 	doubleconflict = variantMarker `isInfixOf` file -shortHash :: L.ByteString -> String-shortHash = take 4 . show . md5+shortHash :: S.ByteString -> String+shortHash = take 4 . show . md5s

@@ -22,6 +22,7 @@ import Database.Types import qualified Database.Keys import qualified Database.Keys.SQL+import Config  {- Looks up the key corresponding to an annexed file in the work tree,  - by examining what the file links to.@@ -75,7 +76,7 @@  - as-is.  -} scanUnlockedFiles :: Annex ()-scanUnlockedFiles = whenM (inRepo Git.Ref.headExists) $ do+scanUnlockedFiles = whenM (inRepo Git.Ref.headExists <&&> not <$> isBareRepo) $ do 	Database.Keys.runWriter $ 		liftIO . Database.Keys.SQL.dropAllAssociatedFiles 	(l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.LsTree.LsTreeRecursive Git.Ref.headRef

@@ -64,7 +64,7 @@   where 	queueremaining r k =  		queueTransferWhenSmall "remaining object in unwanted remote"-			(AssociatedFile Nothing) (Transfer Download uuid k) r+			(AssociatedFile Nothing) (Transfer Download uuid (fromKey id k)) r 	{- Scanning for keys can take a long time; do not tie up 	 - the Annex monad while doing it, so other threads continue to 	 - run. -}

@@ -186,7 +186,7 @@ genTransfer direction want key slocs r 	| direction == Upload && Remote.readonly r = Nothing 	| S.member (Remote.uuid r) slocs == want = Just-		(r, Transfer direction (Remote.uuid r) key)+		(r, Transfer direction (Remote.uuid r) (fromKey id key)) 	| otherwise = Nothing  remoteHas :: Remote -> Key -> Annex Bool

@@ -96,7 +96,7 @@ 		inset s r = S.member (Remote.uuid r) s 	gentransfer r = Transfer 		{ transferDirection = direction-		, transferKey = k+		, transferKeyData = fromKey id k 		, transferUUID = Remote.uuid r 		} 	defer@@ -129,7 +129,7 @@ 	  where 		gentransfer r = Transfer 			{ transferDirection = Download-			, transferKey = k+			, transferKeyData = fromKey id k 			, transferUUID = Remote.uuid r 			} 

@@ -62,7 +62,7 @@ 	tenthused Nothing _ = False 	tenthused (Just disksize) used = used >= disksize `div` 10 -	sumkeysize s k = s + fromMaybe 0 (keySize k)+	sumkeysize s k = s + fromMaybe 0 (fromKey keySize k)  	forpath a = inRepo $ liftIO . a . Git.repoPath 

@@ -25,7 +25,6 @@ import Annex.UUID import qualified Backend import qualified Types.Backend-import qualified Types.Key import Assistant.TransferQueue import Assistant.TransferSlots import Remote (remoteFromUUID)@@ -91,13 +90,13 @@ 		maybe noop (queueTransfer "upgrade" Next (AssociatedFile (Just f)) t) 			=<< liftAnnex (remoteFromUUID webUUID) 		startTransfer t-	k = distributionKey d+	k = mkKey $ const $ distributionKey d 	u = distributionUrl d 	f = takeFileName u ++ " (for upgrade)" 	t = Transfer 		{ transferDirection = Download 		, transferUUID = webUUID-		, transferKey = k+		, transferKeyData = fromKey id k 		} 	cleanup = liftAnnex $ do 		lockContentForRemoval k removeAnnex@@ -117,8 +116,8 @@ 			=<< liftAnnex (withObjectLoc k fsckit) 	| otherwise = cleanup   where-	k = distributionKey d-	fsckit f = case Backend.maybeLookupBackendVariety (Types.Key.keyVariety k) of+	k = mkKey $ const $ distributionKey d+	fsckit f = case Backend.maybeLookupBackendVariety (fromKey keyVariety k) of 		Nothing -> return $ Just f 		Just b -> case Types.Backend.verifyKeyContent b of 			Nothing -> return $ Just f

@@ -59,16 +59,18 @@ 		Just k -> Just (makesane k, b)   where 	-- keyNames should not contain newline characters.-	makesane k = k { keyName = S8.map fixbadchar (keyName k) }+	makesane k = alterKey k $ \d -> d+		{ keyName = S8.map fixbadchar (fromKey keyName k)+		} 	fixbadchar c 		| c == '\n' = '_' 		| otherwise = c  getBackend :: FilePath -> Key -> Annex (Maybe Backend)-getBackend file k = case maybeLookupBackendVariety (keyVariety k) of+getBackend file k = case maybeLookupBackendVariety (fromKey keyVariety k) of 	Just backend -> return $ Just backend 	Nothing -> do-		warning $ "skipping " ++ file ++ " (unknown backend " ++ decodeBS (formatKeyVariety (keyVariety k)) ++ ")"+		warning $ "skipping " ++ file ++ " (unknown backend " ++ decodeBS (formatKeyVariety (fromKey keyVariety k)) ++ ")" 		return Nothing  {- Looks up the backend that should be used for a file.@@ -95,4 +97,4 @@  isStableKey :: Key -> Bool isStableKey k = maybe False (`B.isStableKey` k) -	(maybeLookupBackendVariety (keyVariety k))+	(maybeLookupBackendVariety (fromKey keyVariety k))

@@ -91,7 +91,7 @@ 	let file = contentLocation source 	filesize <- liftIO $ getFileSize file 	s <- hashFile hash file meterupdate-	return $ Just $ stubKey+	return $ Just $ mkKey $ \k -> k 		{ keyName = encodeBS s 		, keyVariety = hashKeyVariety hash (HasExt False) 		, keySize = Just filesize@@ -105,8 +105,8 @@ 	addE k = do 		maxlen <- annexMaxExtensionLength <$> Annex.getGitConfig 		let ext = selectExtension maxlen (keyFilename source)-		return $ Just $ k-			{ keyName = keyName k <> encodeBS ext+		return $ Just $ alterKey k $ \d -> d+			{ keyName = keyName d <> encodeBS ext 			, keyVariety = hashKeyVariety hash (HasExt True) 			} @@ -169,7 +169,7 @@ needsUpgrade key = or 	[ "\\" `S8.isPrefixOf` keyHash key 	, any (not . validInExtension) (decodeBS $ snd $ splitKeyNameExtension key)-	, not (hasExt (keyVariety key)) && keyHash key /= keyName key+	, not (hasExt (fromKey keyVariety key)) && keyHash key /= fromKey keyName key 	]  trivialMigrate :: Key -> Backend -> AssociatedFile -> Annex (Maybe Key)@@ -179,14 +179,14 @@ trivialMigrate' :: Key -> Backend -> AssociatedFile -> Maybe Int -> Maybe Key trivialMigrate' oldkey newbackend afile maxextlen 	{- Fast migration from hashE to hash backend. -}-	| migratable && hasExt oldvariety = Just $ oldkey+	| migratable && hasExt oldvariety = Just $ alterKey oldkey $ \d -> d 		{ keyName = keyHash oldkey 		, keyVariety = newvariety 		} 	{- Fast migration from hash to hashE backend. -} 	| migratable && hasExt newvariety = case afile of 		AssociatedFile Nothing -> Nothing-		AssociatedFile (Just file) -> Just $ oldkey+		AssociatedFile (Just file) -> Just $ alterKey oldkey $ \d -> d 			{ keyName = keyHash oldkey  				<> encodeBS (selectExtension maxextlen file) 			, keyVariety = newvariety@@ -195,14 +195,15 @@ 	 - non-extension preserving key, with an extension 	 - in its keyName. -} 	| newvariety == oldvariety && not (hasExt oldvariety) &&-		keyHash oldkey /= keyName oldkey = Just $ oldkey-			{ keyName = keyHash oldkey-			}+		keyHash oldkey /= fromKey keyName oldkey = +			Just $ alterKey oldkey $ \d -> d+				{ keyName = keyHash oldkey+				} 	| otherwise = Nothing   where 	migratable = oldvariety /= newvariety  		&& sameExceptExt oldvariety newvariety-	oldvariety = keyVariety oldkey+	oldvariety = fromKey keyVariety oldkey 	newvariety = backendVariety newbackend  hashFile :: Hash -> FilePath -> MeterUpdate -> Annex String@@ -294,5 +295,7 @@ 	let b = genBackendE (SHA2Hash (HashSize 256)) 	in b { getKey = \ks p -> (fmap addE) <$> getKey b ks p }    where-	addE k = k { keyName = keyName k <> longext }+	addE k = alterKey k $ \d -> d+		{ keyName = keyName d <> longext+		} 	longext = ".this-is-a-test-key"

@@ -32,7 +32,7 @@  {- Every unique url has a corresponding key. -} fromUrl :: String -> Maybe Integer -> Key-fromUrl url size = stubKey+fromUrl url size = mkKey $ \k -> k 	{ keyName = genKeyName url 	, keyVariety = URLKey 	, keySize = size

@@ -39,7 +39,7 @@ 	stat <- liftIO $ getFileStatus f 	sz <- liftIO $ getFileSize' f stat 	relf <- getTopFilePath <$> inRepo (toTopFilePath $ keyFilename source)-	return $ Just $ stubKey+	return $ Just $ mkKey $ \k -> k 		{ keyName = genKeyName relf 		, keyVariety = WORMKey 		, keySize = Just sz@@ -48,14 +48,14 @@  {- Old WORM keys could contain spaces, and can be upgraded to remove them. -} needsUpgrade :: Key -> Bool-needsUpgrade key = ' ' `S8.elem` keyName key+needsUpgrade key = ' ' `S8.elem` fromKey keyName key  removeSpaces :: Key -> Backend -> AssociatedFile -> Annex (Maybe Key) removeSpaces oldkey newbackend _-	| migratable = return $ Just $ oldkey-		{ keyName = encodeBS $ reSanitizeKeyName $ decodeBS $ keyName oldkey }+	| migratable = return $ Just $ alterKey oldkey $ \d -> d+		{ keyName = encodeBS $ reSanitizeKeyName $ decodeBS $ keyName d } 	| otherwise = return Nothing   where 	migratable = oldvariety == newvariety-	oldvariety = keyVariety oldkey+	oldvariety = fromKey keyVariety oldkey 	newvariety = backendVariety newbackend

@@ -1,3 +1,30 @@+git-annex (7.20191218) upstream; urgency=medium++  * git-lfs: The url provided to initremote/enableremote will now be+    stored in the git-annex branch, allowing enableremote to be used without+    an url. initremote --sameas can be used to add additional urls.+  * git-lfs: When there's a git remote with an url that's known to be+    used for git-lfs, automatically enable the special remote.+  * sync, assistant: Pull and push from git-lfs remotes.+  * Fix bug that made bare repos be treated as non-bare when --git-dir+    was used.+  * inprogress: Support --key.+  * Sped up many git-annex commands that operate on many files, by +    avoiding reserialization of keys.+    find is 7% faster; whereis is 3% faster; and git-annex get when+    all files are already present is 5% faster+  * Stop displaying rsync progress, and use git-annex's own progress display+    for local-to-local repo transfers.+  * benchmark: Changed --databases to take a parameter specifiying the size+    of the database to benchmark.+  * benchmark --databases: Display size of the populated database.+  * benchmark --databases: Improve the "addAssociatedFile (new)"+    benchmark to really add new values, not overwriting old values.+  * Windows: Fix handling of changes to time zone. (Used to work but was+    broken in version 7.20181031.)++ -- Joey Hess <id@joeyh.name>  Wed, 18 Dec 2019 13:53:51 -0400+ git-annex (7.20191114) upstream; urgency=medium    * Added annex.allowsign option.

@@ -176,21 +176,26 @@ parseKeyOptions :: Parser KeyOptions parseKeyOptions = parseAllOption 	<|> parseBranchKeysOption-	<|> flag' WantUnusedKeys-		( long "unused" <> short 'U'-		<> help "operate on files found by last run of git-annex unused"-		)-	<|> (WantSpecificKey <$> option (str >>= parseKey)-		( long "key" <> metavar paramKey-		<> help "operate on specified key"-		))+	<|> parseUnusedKeysOption+	<|> parseSpecificKeyOption +parseUnusedKeysOption :: Parser KeyOptions+parseUnusedKeysOption = flag' WantUnusedKeys+	( long "unused" <> short 'U'+	<> help "operate on files found by last run of git-annex unused"+	)++parseSpecificKeyOption :: Parser KeyOptions+parseSpecificKeyOption = WantSpecificKey <$> option (str >>= parseKey)+	( long "key" <> metavar paramKey+	<> help "operate on specified key"+	)+ parseBranchKeysOption :: Parser KeyOptions-parseBranchKeysOption =-	WantBranchKeys <$> some (option (str >>= pure . Ref)-		( long "branch" <> metavar paramRef-		<> help "operate on files in the specified branch or treeish"-		))+parseBranchKeysOption = WantBranchKeys <$> some (option (str >>= pure . Ref)+	( long "branch" <> metavar paramRef+	<> help "operate on files in the specified branch or treeish"+	))  parseFailedTransfersOption :: Parser KeyOptions parseFailedTransfersOption = flag' WantFailedTransfers

@@ -162,7 +162,7 @@ 	adduri = addUrlChecked o loguri file (Remote.uuid r) checkexistssize 	checkexistssize key = return $ case sz of 		Nothing -> (True, True, loguri)-		Just n -> (True, n == fromMaybe n (keySize key), loguri)+		Just n -> (True, n == fromMaybe n (fromKey keySize key), loguri) 	geturi = next $ isJust <$> downloadRemoteFile r (downloadOptions o) uri file sz  downloadRemoteFile :: Remote -> DownloadOptions -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key)@@ -218,7 +218,7 @@ 	addurl = addUrlChecked o url file webUUID $ \k -> 		ifM (pure (not (rawOption (downloadOptions o))) <&&> youtubeDlSupported url) 			( return (True, True, setDownloader url YoutubeDownloader)-			, return (Url.urlExists urlinfo, Url.urlSize urlinfo == keySize k, url)+			, return (Url.urlExists urlinfo, Url.urlSize urlinfo == fromKey keySize k, url) 			)  {- Check that the url exists, and has the same size as the key,@@ -379,7 +379,9 @@  {- Adds the url size to the Key. -} addSizeUrlKey :: Url.UrlInfo -> Key -> Key-addSizeUrlKey urlinfo key = key { keySize = Url.urlSize urlinfo }+addSizeUrlKey urlinfo key = alterKey key $ \d -> d+	{ keySize = Url.urlSize urlinfo+	}  {- Adds worktree file to the repository. -} addWorkTree :: UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex ()

@@ -26,7 +26,7 @@  data BenchmarkOptions  	= BenchmarkOptions CmdParams CriterionMode-	| BenchmarkDatabases CriterionMode+	| BenchmarkDatabases CriterionMode Integer  optParser :: CmdParamsDesc -> Parser BenchmarkOptions optParser desc = benchmarkoptions <|> benchmarkdatabases@@ -36,10 +36,11 @@ 		<*> criterionopts 	benchmarkdatabases = BenchmarkDatabases 		<$> criterionopts-		<* flag' () -			( long "databases"+		<*> option auto+	                ( long "databases" +			<> metavar paramNumber 			<> help "benchmark sqlite databases"-			)+                	) #ifdef WITH_BENCHMARK 	criterionopts = parseWith defaultConfig #else@@ -51,7 +52,7 @@ seek generator (BenchmarkOptions ps mode) = do 	runner <- generator ps 	liftIO $ runMode mode [ bench (unwords ps) $ nfIO runner ]-seek _ (BenchmarkDatabases mode) = benchmarkDbs mode+seek _ (BenchmarkDatabases mode n) = benchmarkDbs mode n #else seek _ _ = giveup "git-annex is not built with benchmarking support" #endif

@@ -87,14 +87,14 @@ keyVars :: Key -> [(String, String)] keyVars key = 	[ ("key", serializeKey key)-	, ("backend", decodeBS $ formatKeyVariety $ keyVariety key)+	, ("backend", decodeBS $ formatKeyVariety $ fromKey keyVariety key) 	, ("bytesize", size show) 	, ("humansize", size $ roughSize storageUnits True)-	, ("keyname", decodeBS $ keyName key)+	, ("keyname", decodeBS $ fromKey keyName key) 	, ("hashdirlower", hashDirLower def key) 	, ("hashdirmixed", hashDirMixed def key)-	, ("mtime", whenavail show $ keyMtime key)+	, ("mtime", whenavail show $ fromKey keyMtime key) 	]   where-	size c = whenavail c $ keySize key+	size c = whenavail c $ fromKey keySize key 	whenavail = maybe "unknown"

@@ -49,14 +49,14 @@ 	parse s =  		let (keyname, file) = separate (== ' ') s 		in if not (null keyname) && not (null file)-			then Right $ go file (mkKey keyname)+			then Right $ go file (keyOpt keyname) 			else Left "Expected pairs of key and filename" 	go file key = starting "fromkey" (mkActionItem (key, file)) $ 		perform key file  start :: Bool -> (String, FilePath) -> CommandStart start force (keyname, file) = do-	let key = mkKey keyname+	let key = keyOpt keyname 	unless force $ do 		inbackend <- inAnnex key 		unless inbackend $ giveup $@@ -71,8 +71,8 @@ -- For example, "WORM--a:a" parses as an uri. To disambiguate, check -- the uri scheme, to see if it looks like the prefix of a key. This relies -- on key backend names never containing a ':'.-mkKey :: String -> Key-mkKey s = case parseURI s of+keyOpt :: String -> Key+keyOpt s = case parseURI s of 	Just u | not (isKeyPrefix (uriScheme u)) -> 		Backend.URL.fromUrl s Nothing 	_ -> case deserializeKey s of

@@ -182,7 +182,7 @@  startKey :: Maybe Remote -> Incremental -> (Key, ActionItem) -> NumCopies -> CommandStart startKey from inc (key, ai) numcopies =-	case Backend.maybeLookupBackendVariety (keyVariety key) of+	case Backend.maybeLookupBackendVariety (fromKey keyVariety key) of 		Nothing -> stop 		Just backend -> runFsck inc ai key $ 			case from of@@ -244,9 +244,9 @@ 	 - insecure hash is present. This should only be able to happen 	 - if the repository already contained the content before the 	 - config was set. -}-	when (present && not (cryptographicallySecure (keyVariety key))) $+	when (present && not (cryptographicallySecure (fromKey keyVariety key))) $ 		whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $-			warning $ "** Despite annex.securehashesonly being set, " ++ obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (keyVariety key)) ++ " key"+			warning $ "** Despite annex.securehashesonly being set, " ++ obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key"  	verifyLocationLog' key ai present u (logChange key u) @@ -362,7 +362,7 @@ 	checkKeySizeOr (badContentRemote remote localcopy) key localcopy ai  checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> ActionItem -> Annex Bool-checkKeySizeOr bad key file ai = case keySize key of+checkKeySizeOr bad key file ai = case fromKey keySize key of 	Nothing -> return True 	Just size -> do 		size' <- liftIO $ getFileSize file@@ -396,7 +396,7 @@ 				[ actionItemDesc ai 				, ": Can be upgraded to an improved key format. " 				, "You can do so by running: git annex migrate --backend="-				, decodeBS (formatKeyVariety (keyVariety key)) ++ " "+				, decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " " 				, file 				] 			return True

@@ -39,7 +39,7 @@ cmd = notBareRepo $ 	withGlobalOptions [jobsOption, jsonOptions, fileMatchingOptions] $ 		command "import" SectionCommon -			"import files from elsewhere into the repository"+			"add a tree of files to the repository" 			(paramPaths ++ "|BRANCH[:SUBDIR]") 			(seek <$$> optParser) 

@@ -50,23 +50,23 @@ type Stat = StatState (Maybe (String, StatState String))  -- data about a set of keys-data KeyData = KeyData+data KeyInfo = KeyInfo 	{ countKeys :: Integer 	, sizeKeys :: Integer 	, unknownSizeKeys :: Integer 	, backendsKeys :: M.Map KeyVariety Integer 	} 	-instance Sem.Semigroup KeyData where-	a <> b = KeyData+instance Sem.Semigroup KeyInfo where+	a <> b = KeyInfo 		{ countKeys = countKeys a + countKeys b 		, sizeKeys = sizeKeys a + sizeKeys b 		, unknownSizeKeys = unknownSizeKeys a + unknownSizeKeys b 		, backendsKeys = backendsKeys a <> backendsKeys b 		} -instance Monoid KeyData where-	mempty = KeyData 0 0 0 M.empty+instance Monoid KeyInfo where+	mempty = KeyInfo 0 0 0 M.empty  data NumCopiesStats = NumCopiesStats 	{ numCopiesVarianceMap :: M.Map Variance Integer@@ -82,9 +82,9 @@  -- cached info that multiple Stats use data StatInfo = StatInfo-	{ presentData :: Maybe KeyData-	, referencedData :: Maybe KeyData-	, repoData :: M.Map UUID KeyData+	{ presentData :: Maybe KeyInfo+	, referencedData :: Maybe KeyInfo+	, repoData :: M.Map UUID KeyInfo 	, numCopiesStats :: Maybe NumCopiesStats 	, infoOptions :: InfoOptions 	}@@ -512,7 +512,7 @@ reposizes_total = simpleStat "combined size of repositories containing these files" $ 	showSizeKeys . mconcat . M.elems =<< cachedRepoData -cachedPresentData :: StatState KeyData+cachedPresentData :: StatState KeyInfo cachedPresentData = do 	s <- get 	case presentData s of@@ -522,7 +522,7 @@ 			put s { presentData = Just v } 			return v -cachedRemoteData :: UUID -> StatState KeyData+cachedRemoteData :: UUID -> StatState KeyInfo cachedRemoteData u = do 	s <- get 	case M.lookup u (repoData s) of@@ -531,19 +531,19 @@ 			let combinedata d uk = finishCheck uk >>= \case 				Nothing -> return d 				Just k -> return $ addKey k d-			v <- lift $ foldM combinedata emptyKeyData+			v <- lift $ foldM combinedata emptyKeyInfo 				=<< loggedKeysFor' u 			put s { repoData = M.insert u v (repoData s) } 			return v -cachedReferencedData :: StatState KeyData+cachedReferencedData :: StatState KeyInfo cachedReferencedData = do 	s <- get 	case referencedData s of 		Just v -> return v 		Nothing -> do 			!v <- lift $ Command.Unused.withKeysReferenced-				emptyKeyData addKey+				emptyKeyInfo addKey 			put s { referencedData = Just v } 			return v @@ -552,7 +552,7 @@ cachedNumCopiesStats = numCopiesStats <$> get  -- currently only available for directory info-cachedRepoData :: StatState (M.Map UUID KeyData)+cachedRepoData :: StatState (M.Map UUID KeyInfo) cachedRepoData = repoData <$> get  getDirStatInfo :: InfoOptions -> FilePath -> Annex StatInfo@@ -564,7 +564,7 @@ 			(update matcher fast) 	return $ StatInfo (Just presentdata) (Just referenceddata) repodata (Just numcopiesstats) o   where-	initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats, M.empty)+	initial = (emptyKeyInfo, emptyKeyInfo, emptyNumCopiesStats, M.empty) 	update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats, repodata) = 		ifM (matcher $ MatchingFile $ FileInfo file file) 			( do@@ -594,7 +594,7 @@ 		, return Nothing 		)   where-	initial = (emptyKeyData, emptyKeyData, M.empty)+	initial = (emptyKeyInfo, emptyKeyInfo, M.empty) 	go _ [] vs = return vs 	go fast (l:ls) vs@(presentdata, referenceddata, repodata) = do 		mk <- catKey (LsTree.sha l)@@ -613,33 +613,33 @@ 						return (updateRepoData key locs repodata) 				go fast ls $! (presentdata', referenceddata', repodata') -emptyKeyData :: KeyData-emptyKeyData = KeyData 0 0 0 M.empty+emptyKeyInfo :: KeyInfo+emptyKeyInfo = KeyInfo 0 0 0 M.empty  emptyNumCopiesStats :: NumCopiesStats emptyNumCopiesStats = NumCopiesStats M.empty -foldKeys :: [Key] -> KeyData-foldKeys = foldl' (flip addKey) emptyKeyData+foldKeys :: [Key] -> KeyInfo+foldKeys = foldl' (flip addKey) emptyKeyInfo -addKey :: Key -> KeyData -> KeyData-addKey key (KeyData count size unknownsize backends) =-	KeyData count' size' unknownsize' backends'+addKey :: Key -> KeyInfo -> KeyInfo+addKey key (KeyInfo count size unknownsize backends) =+	KeyInfo count' size' unknownsize' backends'   where 	{- All calculations strict to avoid thunks when repeatedly 	 - applied to many keys. -} 	!count' = count + 1-	!backends' = M.insertWith (+) (keyVariety key) 1 backends+	!backends' = M.insertWith (+) (fromKey keyVariety key) 1 backends 	!size' = maybe size (+ size) ks 	!unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks-	ks = keySize key+	ks = fromKey keySize key -updateRepoData :: Key -> [UUID] -> M.Map UUID KeyData -> M.Map UUID KeyData+updateRepoData :: Key -> [UUID] -> M.Map UUID KeyInfo -> M.Map UUID KeyInfo updateRepoData key locs m = m'   where 	!m' = M.unionWith (\_old new -> new) m $ 		M.fromList $ zip locs (map update locs)-	update loc = addKey key (fromMaybe emptyKeyData $ M.lookup loc m)+	update loc = addKey key (fromMaybe emptyKeyInfo $ M.lookup loc m)  updateNumCopiesStats :: FilePath -> NumCopiesStats -> [UUID] -> Annex NumCopiesStats updateNumCopiesStats file (NumCopiesStats m) locs = do@@ -649,7 +649,7 @@ 	let !ret = NumCopiesStats m' 	return ret -showSizeKeys :: KeyData -> StatState String+showSizeKeys :: KeyInfo -> StatState String showSizeKeys d = do 	sizer <- mkSizer 	return $ total sizer ++ missingnote

@@ -19,24 +19,24 @@  data InprogressOptions = InprogressOptions 	{ inprogressFiles :: CmdParams-	, allOption :: Bool+	, keyOptions :: Maybe KeyOptions 	}  optParser :: CmdParamsDesc -> Parser InprogressOptions optParser desc = InprogressOptions 	<$> cmdParams desc-	<*> switch-		( long "all"-		<> short 'A'-		<> help "access all files currently being downloaded"-		)+	<*> optional (parseAllOption <|> parseSpecificKeyOption)  seek :: InprogressOptions -> CommandSeek seek o = do 	ts <- map (transferKey . fst) <$> getTransfers-	if allOption o-		then forM_ ts $ commandAction . start'-		else do+	case keyOptions o of+		Just WantAllKeys ->+			forM_ ts $ commandAction . start'+		Just (WantSpecificKey k)+			| k `elem` ts -> commandAction (start' k)+			| otherwise -> commandAction stop+		_ -> do 			let s = S.fromList ts 			withFilesInGit 				(commandAction . (whenAnnexed (start s)))

@@ -67,7 +67,7 @@ 	missingdata datadesc = bail $ "cannot match this expression without " ++ datadesc ++ " data" 	-- When a key is provided, make its size also be provided. 	addkeysize p = case providedKey p of-		Right k -> case keySize k of+		Right k -> case fromKey keySize k of 			Just sz -> p { providedFileSize = Right sz } 			Nothing -> p 		Left _ -> p

@@ -50,7 +50,7 @@  -  - Something has changed in the backend, such as a bug fix.  -} upgradableKey :: Backend -> Key -> Bool-upgradableKey backend key = isNothing (keySize key) || backendupgradable+upgradableKey backend key = isNothing (fromKey keySize key) || backendupgradable   where 	backendupgradable = maybe False (\a -> a key) (canUpgradeKey backend) 

@@ -11,7 +11,7 @@  import Command import Logs.Web-import Command.FromKey (mkKey)+import Command.FromKey (keyOpt) import qualified Remote  cmd :: Command@@ -41,7 +41,7 @@ start :: [String] -> CommandStart start (keyname:url:[]) =  	starting "registerurl" (ActionItemOther (Just url)) $ do-		let key = mkKey keyname+		let key = keyOpt keyname 		perform key url start _ = giveup "specify a key and an url" @@ -55,7 +55,7 @@   where 	go status [] = next $ return status 	go status ((keyname,u):rest) | not (null keyname) && not (null u) = do-		let key = mkKey keyname+		let key = keyOpt keyname 		ok <- perform' key u 		let !status' = status && ok 		go status' rest

@@ -49,7 +49,7 @@ 	afile <- AssociatedFile <$> Fields.getField Fields.associatedFile 	ok <- maybe (a $ const noop) 		-- Using noRetry here because we're the sender.-		(\u -> runner (Transfer direction (toUUID u) key) afile noRetry a)+		(\u -> runner (Transfer direction (toUUID u) (fromKey id key)) afile noRetry a) 		=<< Fields.getField Fields.remoteUUID 	liftIO $ debugM "fieldTransfer" "transfer done" 	liftIO $ exitBool ok

@@ -21,11 +21,11 @@  start :: [String] -> CommandStart start (keyname:file:[]) = starting "setkey" (ActionItemOther (Just file)) $-	perform file (mkKey keyname)+	perform file (keyOpt keyname) start _ = giveup "specify a key and a content file" -mkKey :: String -> Key-mkKey = fromMaybe (giveup "bad key") . deserializeKey+keyOpt :: String -> Key+keyOpt = fromMaybe (giveup "bad key") . deserializeKey  perform :: FilePath -> Key -> CommandPerform perform file key = do

@@ -119,7 +119,7 @@ 		-- Look up the backend that was used for this file 		-- before, so that when git re-cleans a file its 		-- backend does not change.-		let oldbackend = maybe Nothing (maybeLookupBackendVariety . keyVariety) oldkey+		let oldbackend = maybe Nothing (maybeLookupBackendVariety . fromKey keyVariety) oldkey 		-- Can't restage associated files because git add 		-- runs this and has the index locked. 		let norestage = Restage False

@@ -107,14 +107,14 @@ 	next $ cleanup rs ks ok   where 	desc r' k = intercalate "; " $ map unwords-		[ [ "key size", show (keySize k) ]+		[ [ "key size", show (fromKey keySize k) ] 		, [ show (getChunkConfig (Remote.config r')) ] 		, ["encryption", fromMaybe "none" (M.lookup "encryption" (Remote.config r'))] 		] 	descexport k1 k2 = intercalate "; " $ map unwords 		[ [ "exporttree=yes" ]-		, [ "key1 size", show (keySize k1) ]-		, [ "key2 size", show (keySize k2) ]+		, [ "key1 size", show (fromKey keySize k1) ]+		, [ "key2 size", show (fromKey keySize k2) ] 		]  adjustChunkSize :: Remote -> Int -> Annex (Maybe Remote)@@ -199,7 +199,7 @@ 		Annex.eval st (Annex.setOutput QuietOutput >> a) @? "failed" 	present b = check ("present " ++ show b) $ 		(== Right b) <$> Remote.hasKey r k-	fsck = case maybeLookupBackendVariety (keyVariety k) of+	fsck = case maybeLookupBackendVariety (fromKey keyVariety k) of 		Nothing -> return True 		Just b -> case Backend.verifyKeyContent b of 			Nothing -> return True

@@ -47,7 +47,7 @@ 			let t = Transfer 				{ transferDirection = Upload 				, transferUUID = u-				, transferKey = key+				, transferKeyData = fromKey id key 				} 			tinfo <- liftIO $ startTransferInfo afile 			(update, tfile, createtfile, _) <- mkProgressUpdater t tinfo

@@ -161,7 +161,7 @@  - reversable, nor does it need to be the same type of encryption used  - on content. It does need to be repeatable. -} encryptKey :: Mac -> Cipher -> EncKey-encryptKey mac c k = stubKey+encryptKey mac c k = mkKey $ \d -> d 	{ keyName = encodeBS (macWithCipher mac c (serializeKey k)) 	, keyVariety = OtherKey $ 		encryptedBackendNamePrefix <> encodeBS (showMac mac)@@ -171,7 +171,7 @@ encryptedBackendNamePrefix = "GPG"  isEncKey :: Key -> Bool-isEncKey k = case keyVariety k of+isEncKey k = case fromKey keyVariety k of 	OtherKey s -> encryptedBackendNamePrefix `S.isPrefixOf` s 	_ -> False 

@@ -20,6 +20,7 @@ import Utility.Tmp.Dir import Git.FilePath import Types.Key+import Utility.DataUnits  import Criterion.Main import Control.Monad.IO.Class (liftIO)@@ -27,17 +28,12 @@ import System.Random #endif -benchmarkDbs :: CriterionMode -> Annex ()+benchmarkDbs :: CriterionMode -> Integer -> Annex () #ifdef WITH_BENCHMARK-benchmarkDbs mode = withTmpDirIn "." "benchmark" $ \tmpdir -> do-	-- benchmark different sizes of databases-	dbs <- mapM (benchDb tmpdir)-		[ 1000-		, 10000-		-- , 100000-		]+benchmarkDbs mode n = withTmpDirIn "." "benchmark" $ \tmpdir -> do+	db <- benchDb tmpdir n 	liftIO $ runMode mode-		[ bgroup "keys database" $ flip concatMap dbs $ \db ->+		[ bgroup "keys database" 			[ getAssociatedFilesHitBench db 			, getAssociatedFilesMissBench db 			, getAssociatedKeyHitBench db@@ -53,50 +49,50 @@ #ifdef WITH_BENCHMARK  getAssociatedFilesHitBench :: BenchDb -> Benchmark-getAssociatedFilesHitBench (BenchDb h num) = bench ("getAssociatedFiles from " ++ show num ++ " (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)  getAssociatedFilesMissBench :: BenchDb -> Benchmark-getAssociatedFilesMissBench (BenchDb h num) = bench ("getAssociatedFiles from " ++ show num ++ " (miss)") $ nfIO $+getAssociatedFilesMissBench (BenchDb h _num) = bench ("getAssociatedFiles (miss)") $ nfIO $ 	SQL.getAssociatedFiles (toIKey keyMiss) (SQL.ReadHandle h)  getAssociatedKeyHitBench :: BenchDb -> Benchmark-getAssociatedKeyHitBench (BenchDb h num) = bench ("getAssociatedKey from " ++ show num ++ " (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)  getAssociatedKeyMissBench :: BenchDb -> Benchmark-getAssociatedKeyMissBench (BenchDb h num) = bench ("getAssociatedKey from " ++ show num ++ " (miss)") $ nfIO $+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)  addAssociatedFileOldBench :: BenchDb -> Benchmark-addAssociatedFileOldBench (BenchDb h num) = bench ("addAssociatedFile to " ++ show num ++ " (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) 	H.flushDbQueue h  addAssociatedFileNewBench :: BenchDb -> Benchmark-addAssociatedFileNewBench (BenchDb h num) = bench ("addAssociatedFile to " ++ show num ++ " (new)") $ nfIO $ do+addAssociatedFileNewBench (BenchDb h num) = bench ("addAssociatedFile to (new)") $ nfIO $ do 	n <- getStdRandom (randomR (1,num))-	SQL.addAssociatedFile (toIKey (keyN n)) (fileN (n+1)) (SQL.WriteHandle h)+	SQL.addAssociatedFile (toIKey (keyN n)) (fileN (num+n)) (SQL.WriteHandle h) 	H.flushDbQueue h -populateAssociatedFiles :: H.DbQueue -> Int -> IO ()+populateAssociatedFiles :: H.DbQueue -> Integer -> IO () populateAssociatedFiles h num = do 	forM_ [1..num] $ \n -> 		SQL.addAssociatedFile (toIKey (keyN n)) (fileN n) (SQL.WriteHandle h) 	H.flushDbQueue h -keyN :: Int -> Key-keyN n = stubKey+keyN :: Integer -> Key+keyN n = mkKey $ \k -> k 	{ keyName = B8.pack $ "key" ++ show n 	, keyVariety = OtherKey "BENCH" 	} -fileN :: Int -> TopFilePath+fileN :: Integer -> TopFilePath fileN n = asTopFilePath ("file" ++ show n)  keyMiss :: Key@@ -105,14 +101,17 @@ fileMiss :: TopFilePath fileMiss = fileN 0 -- 0 is never stored -data BenchDb = BenchDb H.DbQueue Int+data BenchDb = BenchDb H.DbQueue Integer -benchDb :: FilePath -> Int -> Annex BenchDb+benchDb :: FilePath -> Integer -> Annex BenchDb benchDb tmpdir num = do-	liftIO $ putStrLn $ "setting up database with " ++ show num+	liftIO $ putStrLn $ "setting up database with " ++ show num ++ " items" 	initDb db SQL.createTables 	h <- liftIO $ H.openDbQueue H.MultiWriter db SQL.containedTable 	liftIO $ populateAssociatedFiles h num+	sz <- liftIO $ getFileSize db+	liftIO $ putStrLn $ "size of database on disk: " ++ +		roughSize storageUnits False sz 	return (BenchDb h num)   where 	db = tmpdir </> show num </> "db"

@@ -94,6 +94,14 @@ 		, fullconfig = M.unionWith (++) c (fullconfig repo) 		} +{- Stores a single config setting in a Repo, returning the new version of+ - the Repo. Config settings can be updated incrementally. -}+store' :: String -> String -> Repo -> Repo+store' k v repo = repo+	{ config = M.singleton k v `M.union` config repo+	, fullconfig = M.unionWith (++) (M.singleton k [v]) (fullconfig repo)+	}+ {- Updates the location of a repo, based on its configuration.  -  - Git.Construct makes LocalUknown repos, of which only a directory is

@@ -67,8 +67,12 @@ 	configure (Just d) _ = do 		absd <- absPath d 		curr <- getCurrentDirectory-		Git.Config.read $ newFrom $+		r <- Git.Config.read $ newFrom $ 			Local { gitdir = absd, worktree = Just curr }+		return $ if Git.Config.isBare r+			then r { location = (location r) { worktree = Nothing } }+			else r+ 	configure Nothing Nothing = giveup "Not in a git repository."  	addworktree w r = changelocation r $

@@ -51,6 +51,7 @@ 	legal c = isAlphaNum c 	 data RemoteLocation = RemoteUrl String | RemotePath FilePath+	deriving (Eq)  remoteLocationIsUrl :: RemoteLocation -> Bool remoteLocationIsUrl (RemoteUrl _) = True

@@ -8,10 +8,12 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Key (-	Key(..),+	Key,+	KeyData(..), 	AssociatedFile(..),-	stubKey,-	buildKey,+	fromKey,+	mkKey,+	alterKey, 	keyParser, 	serializeKey, 	serializeKey',@@ -28,13 +30,7 @@  import qualified Data.Text as T import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as S8-import qualified Data.ByteString.Lazy as L-import Data.ByteString.Builder-import Data.ByteString.Builder.Extra import qualified Data.Attoparsec.ByteString as A-import qualified Data.Attoparsec.ByteString.Char8 as A8-import Foreign.C.Types  import Common import Types.Key@@ -43,134 +39,37 @@ import Utility.Aeson import qualified Utility.SimpleProtocol as Proto -stubKey :: Key-stubKey = Key-	{ keyName = mempty-	, keyVariety = OtherKey mempty-	, keySize = Nothing-	, keyMtime = Nothing-	, keyChunkSize = Nothing-	, keyChunkNum = Nothing-	}- -- Gets the parent of a chunk key. nonChunkKey :: Key -> Key-nonChunkKey k = k-	{ keyChunkSize = Nothing-	, keyChunkNum = Nothing-	}+nonChunkKey k+	| fromKey keyChunkSize k == Nothing && fromKey keyChunkNum k == Nothing = k+	| otherwise = alterKey k $ \d -> d+		{ keyChunkSize = Nothing+		, keyChunkNum = Nothing+		}  -- Where a chunk key is offset within its parent. chunkKeyOffset :: Key -> Maybe Integer chunkKeyOffset k = (*)-	<$> keyChunkSize k-	<*> (pred <$> keyChunkNum k)+	<$> fromKey keyChunkSize k+	<*> (pred <$> fromKey keyChunkNum k)  isChunkKey :: Key -> Bool-isChunkKey k = isJust (keyChunkSize k) && isJust (keyChunkNum k)---- Checks if a string looks like at least the start of a key.-isKeyPrefix :: String -> Bool-isKeyPrefix s = [fieldSep, fieldSep] `isInfixOf` s--fieldSep :: Char-fieldSep = '-'--{- Builds a ByteString from a Key.- -- - The name field is always shown last, separated by doubled fieldSeps,- - and is the only field allowed to contain the fieldSep.- -}-buildKey :: Key -> Builder-buildKey k = byteString (formatKeyVariety (keyVariety k))-	<> 's' ?: (integerDec <$> keySize k)-	<> 'm' ?: (integerDec . (\(CTime t) -> fromIntegral t) <$> keyMtime k)-	<> 'S' ?: (integerDec <$> keyChunkSize k)-	<> 'C' ?: (integerDec <$> keyChunkNum k)-	<> sepbefore (sepbefore (byteString (keyName k)))-  where-	sepbefore s = char7 fieldSep <> s-	c ?: (Just b) = sepbefore (char7 c <> b)-	_ ?: Nothing = mempty+isChunkKey k = isJust (fromKey keyChunkSize k) && isJust (fromKey keyChunkNum k)  serializeKey :: Key -> String-serializeKey = decodeBL' . serializeKey'--serializeKey' :: Key -> L.ByteString-serializeKey' = toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty . buildKey+serializeKey = decodeBS' . serializeKey' -{- This is a strict parser for security reasons; a key- - can contain only 4 fields, which all consist only of numbers.- - Any key containing other fields, or non-numeric data will fail- - to parse.- -- - If a key contained non-numeric fields, they could be used to- - embed data used in a SHA1 collision attack, which would be a- - problem since the keys are committed to git.- -}-keyParser :: A.Parser Key-keyParser = do-	-- key variety cannot be empty-	v <- (parseKeyVariety <$> A8.takeWhile1 (/= fieldSep))-	s <- parsesize-	m <- parsemtime-	cs <- parsechunksize-	cn <- parsechunknum-	_ <- A8.char fieldSep-	_ <- A8.char fieldSep-	n <- A.takeByteString-	if validKeyName v n-		then return $ Key-			{ keyName = n-			, keyVariety = v-			, keySize = s-			, keyMtime = m-			, keyChunkSize = cs-			, keyChunkNum = cn-			}-		else fail "invalid keyName"-  where-	parseopt p = (Just <$> (A8.char fieldSep *> p)) <|> pure Nothing-	parsesize = parseopt $ A8.char 's' *> A8.decimal-	parsemtime = parseopt $ CTime <$> (A8.char 'm' *> A8.decimal)-	parsechunksize = parseopt $ A8.char 'S' *> A8.decimal-	parsechunknum = parseopt $ A8.char 'C' *> A8.decimal+serializeKey' :: Key -> S.ByteString+serializeKey' = keySerialization  deserializeKey :: String -> Maybe Key deserializeKey = deserializeKey' . encodeBS'  deserializeKey' :: S.ByteString -> Maybe Key-deserializeKey' b = eitherToMaybe $ A.parseOnly keyParser b--{- This splits any extension out of the keyName, returning the - - keyName minus extension, and the extension (including leading dot).- -}-splitKeyNameExtension :: Key -> (S.ByteString, S.ByteString)-splitKeyNameExtension = splitKeyNameExtension' . keyName--splitKeyNameExtension' :: S.ByteString -> (S.ByteString, S.ByteString)-splitKeyNameExtension' keyname = S8.span (/= '.') keyname--{- Limits the length of the extension in the keyName to mitigate against- - SHA1 collision attacks.- -- - In such an attack, the extension of the key could be made to contain- - the collision generation data, with the result that a signed git commit- - including such keys would not be secure.- -- - The maximum extension length ever generated for such a key was 8- - characters, but they may be unicode which could use up to 4 bytes each,- - so 32 bytes. 64 bytes is used here to give a little future wiggle-room. - - The SHA1 common-prefix attack needs 128 bytes of data.- -}-validKeyName :: KeyVariety -> S.ByteString -> Bool-validKeyName kv name-	| hasExt kv = -		let ext = snd $ splitKeyNameExtension' name-		in S.length ext <= 64-	| otherwise = True+deserializeKey' = either (const Nothing) Just . A.parseOnly keyParser -instance Arbitrary Key where+instance Arbitrary KeyData where 	arbitrary = Key 		<$> (encodeBS <$> (listOf1 $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_\r\n \t")) 		<*> (parseKeyVariety . encodeBS <$> (listOf1 $ elements ['A'..'Z'])) -- BACKEND@@ -179,6 +78,9 @@ 		<*> ((abs <$>) <$> arbitrary) -- chunksize cannot be negative 		<*> ((succ . abs <$>) <$> arbitrary) -- chunknum cannot be 0 or negative +instance Arbitrary Key where+	arbitrary = mkKey . const <$> arbitrary+ instance Hashable Key where 	hashIO32 = hashIO32 . serializeKey' 	hashIO64 = hashIO64 . serializeKey'@@ -196,3 +98,4 @@  prop_isomorphic_key_encode :: Key -> Bool prop_isomorphic_key_encode k = Just k == (deserializeKey . serializeKey) k+

@@ -294,7 +294,7 @@ limitInBackend :: MkLimit Annex limitInBackend name = Right $ const $ checkKey check   where-	check key = pure $ keyVariety key == variety+	check key = pure $ fromKey keyVariety key == variety 	variety = parseKeyVariety (encodeBS name)  {- Adds a limit to skip files not using a secure hash. -}@@ -302,7 +302,7 @@ addSecureHash = addLimit $ Right limitSecureHash  limitSecureHash :: MatchFiles Annex-limitSecureHash _ = checkKey $ pure . cryptographicallySecure . keyVariety+limitSecureHash _ = checkKey $ pure . cryptographicallySecure . fromKey keyVariety  {- Adds a limit to skip files that are too large or too small -} addLargerThan :: String -> Annex ()@@ -327,7 +327,7 @@ 	go sz _ (MatchingInfo p) = 		getInfo (providedFileSize p)  			>>= \sz' -> return (Just sz' `vs` Just sz)-	checkkey sz key = return $ keySize key `vs` Just sz+	checkkey sz key = return $ fromKey keySize key `vs` Just sz  addMetaData :: String -> Annex () addMetaData = addLimit . limitMetaData

@@ -1,6 +1,6 @@ {- git-annex transfer information files and lock files  -- - Copyright 2012 Joey Hess <id@joeyh.name>+ - Copyright 2012-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -41,12 +41,14 @@ equivilantTransfer :: Transfer -> Transfer -> Bool equivilantTransfer t1 t2 	| transferDirection t1 == Download && transferDirection t2 == Download &&-	  transferKey t1 == transferKey t2 = True+	  transferKeyData t1 == transferKeyData t2 = True 	| otherwise = t1 == t2  percentComplete :: Transfer -> TransferInfo -> Maybe Percentage-percentComplete (Transfer { transferKey = key }) info =-	percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info)+percentComplete t info =+	percentage+		<$> keySize (transferKeyData t)+		<*> Just (fromMaybe 0 $ bytesComplete info)  {- Generates a callback that can be called as transfer progresses to update  - the transfer info file. Also returns the file it'll be updating, @@ -72,7 +74,7 @@ 	{- The minimum change in bytesComplete that is worth 	 - updating a transfer info file for is 1% of the total 	 - keySize, rounded down. -}-	mindelta = case keySize (transferKey t) of+	mindelta = case keySize (transferKeyData t) of 		Just sz -> sz `div` 100 		Nothing -> 100 * 1024 -- arbitrarily, 100 kb @@ -155,7 +157,7 @@ 	<$> getTransfers' [Download] wanted   where 	remaining (t, info) =-		case (keySize (transferKey t), bytesComplete info) of+		case (fromKey keySize (transferKey t), bytesComplete info) of 			(Just sz, Just done) -> sz - done 			(Just sz, Nothing) -> sz 			(Nothing, _) -> 0@@ -191,14 +193,14 @@  {- The transfer information file to use for a given Transfer. -} transferFile :: Transfer -> Git.Repo -> FilePath-transferFile (Transfer direction u key) r = transferDir direction r+transferFile (Transfer direction u kd) r = transferDir direction r 	</> filter (/= '/') (fromUUID u)-	</> keyFile key+	</> keyFile (mkKey (const kd))  {- The transfer information file to use to record a failed Transfer -} failedTransferFile :: Transfer -> Git.Repo -> FilePath-failedTransferFile (Transfer direction u key) r = failedTransferDir u direction r-	</> keyFile key+failedTransferFile (Transfer direction u kd) r = failedTransferDir u direction r+	</> keyFile (mkKey (const kd))  {- The transfer lock file corresponding to a given transfer info file. -} transferLockFile :: FilePath -> FilePath@@ -213,7 +215,7 @@ 		[direction, u, key] -> Transfer 			<$> parseDirection direction 			<*> pure (toUUID u)-			<*> fileKey key+			<*> fmap (fromKey id) (fileKey key) 		_ -> Nothing   where 	bits = splitDirectories file

@@ -36,7 +36,7 @@ 	getMeterSize = pure . Just  instance MeterSize Key where-	getMeterSize = pure . keySize+	getMeterSize = pure . fromKey keySize  instance MeterSize InodeCache where 	getMeterSize = pure . Just . inodeCacheFileSize@@ -51,7 +51,7 @@ data KeySizer = KeySizer Key (Annex (Maybe FilePath))  instance MeterSize KeySizer where-	getMeterSize (KeySizer k getsrcfile) = case keySize k of+	getMeterSize (KeySizer k getsrcfile) = case fromKey keySize k of 		Just sz -> return (Just sz) 		Nothing -> do 			srcfile <- getsrcfile

@@ -258,7 +258,7 @@ 			, return False 			)   where-	download torrent tmpdir = ariaProgress (keySize k) p+	download torrent tmpdir = ariaProgress (fromKey keySize k) p 		[ Param $ "--select-file=" ++ show filenum 		, File torrent 		, Param "-d"

@@ -716,7 +716,7 @@ checkKeyUrl r k = do 	showChecking r 	us <- getWebUrls k-	anyM (\u -> withUrlOptions $ checkBoth u (keySize k)) us+	anyM (\u -> withUrlOptions $ checkBoth u (fromKey keySize k)) us  getWebUrls :: Key -> Annex [URLString] getWebUrls key = filter supported <$> getUrls key

@@ -101,10 +101,10 @@  mkSafeKey :: Key -> Either String SafeKey mkSafeKey k -	| any isSpace (decodeBS $ keyName k) = Left $ concat+	| any isSpace (decodeBS $ fromKey keyName k) = Left $ concat 		[ "Sorry, this file cannot be stored on an external special remote because its key's name contains a space. " 		, "To avoid this problem, you can run: git-annex migrate --backend="-		, decodeBS (formatKeyVariety (keyVariety k))+		, decodeBS (formatKeyVariety (fromKey keyVariety k)) 		, " and pass it the name of the file" 		] 	| otherwise = Right (SafeKey k)

@@ -143,7 +143,9 @@ 		(True, _, _) 			| remoteAnnexCheckUUID gc -> tryGitConfigRead autoinit r 			| otherwise -> return r-		(False, _, NoUUID) -> tryGitConfigRead autoinit r+		(False, _, NoUUID) -> configSpecialGitRemotes r >>= \case+			Nothing -> tryGitConfigRead autoinit r+			Just r' -> return r' 		_ -> return r  gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)@@ -231,7 +233,7 @@ tryGitConfigRead :: Bool -> Git.Repo -> Annex Git.Repo tryGitConfigRead autoinit r  	| haveconfig r = return r -- already read-	| Git.repoIsSsh r = store $ do+	| Git.repoIsSsh r = storeUpdatedRemote $ do 		v <- Ssh.onRemote NoConsumeStdin r 			(pipedconfig, return (Left $ giveup "configlist failed")) 			"configlist" [] configlistfields@@ -240,10 +242,10 @@ 				| haveconfig r' -> return r' 				| otherwise -> configlist_failed 			Left _ -> configlist_failed-	| Git.repoIsHttp r = store geturlconfig+	| Git.repoIsHttp r = storeUpdatedRemote geturlconfig 	| Git.GCrypt.isEncrypted r = handlegcrypt =<< getConfigMaybe (remoteConfig r "uuid") 	| Git.repoIsUrl r = return r-	| otherwise = store $ liftIO $ +	| otherwise = storeUpdatedRemote $ liftIO $  		readlocalannexconfig `catchNonAsync` (const $ return r)   where 	haveconfig = not . M.null . Git.config@@ -278,18 +280,6 @@ 				set_ignore "not usable by git-annex" False 				return r -	store = observe $ \r' -> do-		l <- Annex.getGitRemotes-		let rs = exchange l r'-		Annex.changeState $ \s -> s { Annex.gitremotes = Just rs }--	exchange [] _ = []-	exchange (old:ls) new-		| Git.remoteName old == Git.remoteName new =-			new : exchange ls new-		| otherwise =-			old : exchange ls new- 	{- Is this remote just not available, or does 	 - it not have git-annex-shell? 	 - Find out by trying to fetch from the remote. -}@@ -319,7 +309,7 @@ 		g <- gitRepo 		case Git.GCrypt.remoteRepoId g (Git.remoteName r) of 			Nothing -> return r-			Just v -> store $ liftIO $ setUUID r $+			Just v -> storeUpdatedRemote $ liftIO $ setUUID r $ 				genUUIDInNameSpace gCryptNameSpace v  	{- The local repo may not yet be initialized, so try to initialize@@ -337,6 +327,31 @@ 		then [(Fields.autoInit, "1")] 		else [] +{- Handles special remotes that can be enabled by the presence of+ - regular git remotes.+ -+ - When a remote repo is found to be such a special remote, its+ - UUID is cached in the git config, and the repo returned with+ - the UUID set.+ -}+configSpecialGitRemotes :: Git.Repo -> Annex (Maybe Git.Repo)+configSpecialGitRemotes r = Remote.GitLFS.configKnownUrl r >>= \case+	Nothing -> return Nothing+	Just r' -> Just <$> storeUpdatedRemote (return r')++storeUpdatedRemote :: Annex Git.Repo -> Annex Git.Repo+storeUpdatedRemote = observe $ \r' -> do+	l <- Annex.getGitRemotes+	let rs = exchange l r'+	Annex.changeState $ \s -> s { Annex.gitremotes = Just rs }+  where+	exchange [] _ = []+	exchange (old:ls) new+		| Git.remoteName old == Git.remoteName new =+			new : exchange ls new+		| otherwise =+			old : exchange ls new+ {- Checks if a given remote has the content for a key in its annex. -} inAnnex :: Remote -> State -> Key -> Annex Bool inAnnex rmt st key = do@@ -352,7 +367,7 @@ 	checkhttp = do 		showChecking repo 		gc <- Annex.getGitConfig-		ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls gc repo rmt key))+		ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (fromKey keySize key) uo) (keyUrls gc repo rmt key)) 			( return True 			, giveup "not found" 			)@@ -496,9 +511,10 @@ 				Nothing -> return (False, UnVerified) 				Just (object, checksuccess) -> do 					copier <- mkCopier hardlink st params-					runTransfer (Transfer Download u key)-						file stdRetry-						(\p -> copier object dest (combineMeterUpdate p meterupdate) checksuccess)+					runTransfer (Transfer Download u (fromKey id key))+						file stdRetry $ \p ->+							metered (Just (combineMeterUpdate p meterupdate)) key $ \_ p' -> +								copier object dest p' checksuccess 	| Git.repoIsSsh repo = if forcersync 		then fallback meterupdate 		else P2PHelper.retrieve@@ -631,15 +647,15 @@ 		-- run copy from perspective of remote 		onLocalFast repo r $ ifM (Annex.Content.inAnnex key) 			( return True-			, do+			, runTransfer (Transfer Download u (fromKey id key)) file stdRetry $ \p -> do 				copier <- mkCopier hardlink st params 				let verify = Annex.Content.RemoteVerify r 				let rsp = RetrievalAllKeysSecure-				runTransfer (Transfer Download u key) file stdRetry $ \p ->-					let p' = combineMeterUpdate meterupdate p-					in Annex.Content.saveState True `after`-						Annex.Content.getViaTmp rsp verify key-							(\dest -> copier object dest p' (liftIO checksuccessio))+				res <- Annex.Content.getViaTmp rsp verify key $ \dest ->+					metered (Just (combineMeterUpdate meterupdate p)) key $ \_ p' -> +						copier object dest p' (liftIO checksuccessio)+				Annex.Content.saveState True+				return res 			) 	copyremotefallback p = Annex.Content.sendAnnex key noop $ \object -> do 		-- This is too broad really, but recvkey normally@@ -749,7 +765,7 @@ 	dorsync = do 		-- dest may already exist, so make sure rsync can write to it 		void $ liftIO $ tryIO $ allowWrite dest-		oh <- mkOutputHandler+		oh <- mkOutputHandlerQuiet 		Ssh.rsyncHelper oh (Just p) $ 			rsyncparams ++ [File src, File dest] 	docopycow = docopywith copyCoW

@@ -5,7 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -module Remote.GitLFS (remote, gen) where+module Remote.GitLFS (remote, gen, configKnownUrl) where  import Annex.Common import Types.Remote@@ -13,9 +13,11 @@ import Types.Key import Types.Creds import qualified Annex+import qualified Annex.SpecialRemote.Config import qualified Git import qualified Git.Types as Git import qualified Git.Url+import qualified Git.Remote import qualified Git.GCrypt import qualified Git.Credential as Git import Config@@ -31,8 +33,10 @@ import Backend.Hash import Utility.Hash import Utility.SshHost+import Logs.Remote import Logs.RemoteState import qualified Utility.GitLFS as LFS+import qualified Git.Config  import Control.Concurrent.STM import Data.String@@ -145,21 +149,46 @@ 				, "likely insecure configuration.)" 				] -	-- The url is not stored in the remote log, because the same-	-- git-lfs repo can be accessed using different urls by different-	-- people (eg over ssh or http).-	---	-- Instead, set up remote.name.url to point to the repo,+	-- Set up remote.name.url to point to the repo, 	-- (so it's also usable by git as a non-special remote),-	-- and set remote.name.git-lfs = true-	let c'' = M.delete "url" c'-	gitConfigSpecialRemote u c'' [("git-lfs", "true")]+	-- and set remote.name.annex-git-lfs = true+	gitConfigSpecialRemote u c' [("git-lfs", "true")] 	setConfig (ConfigKey ("remote." ++ getRemoteName c ++ ".url")) url-	return (c'', u)+	return (c', u)   where 	url = fromMaybe (giveup "Specify url=") (M.lookup "url" c) 	remotename = fromJust (lookupName c) +{- Check if a remote's url is one known to belong to a git-lfs repository.+ - If so, set the necessary configuration to enable using the remote+ - with git-lfs. -}+configKnownUrl :: Git.Repo -> Annex (Maybe Git.Repo)+configKnownUrl r+	| Git.repoIsUrl r = do+		l <- readRemoteLog+		g <- Annex.gitRepo+		case Annex.SpecialRemote.Config.findByRemoteConfig (match g) l of+			((u, _, mcu):[]) -> Just <$> go u mcu+			_ -> return Nothing+	| otherwise = return Nothing+  where+	match g c = fromMaybe False $ do+		t <- M.lookup Annex.SpecialRemote.Config.typeField c+		u <- M.lookup "url" c+		let u' = Git.Remote.parseRemoteLocation u g+		return $ Git.Remote.RemoteUrl (Git.repoLocation r) == u' +			&& t == typename remote+	go u mcu = do+		r' <- set "uuid" (fromUUID u) =<< set "git-lfs" "true" r+		case mcu of+			Just (Annex.SpecialRemote.Config.ConfigFrom cu) ->+				set "config-uuid" (fromUUID cu) r'+			Nothing -> return r'+	set k v r' = do+		let ck@(ConfigKey k') = remoteConfig r' k+		setConfig ck v+		return $ Git.Config.store' k' v r'+ data LFSHandle = LFSHandle 	{ downloadEndpoint :: Maybe LFS.Endpoint 	, uploadEndpoint :: Maybe LFS.Endpoint@@ -315,10 +344,10 @@ 		LFS.ParseFailed err -> Left err  extractKeySha256 :: Key -> Maybe LFS.SHA256-extractKeySha256 k = case keyVariety k of+extractKeySha256 k = case fromKey keyVariety k of 	SHA2Key (HashSize 256) (HasExt hasext) 		| hasext -> eitherToMaybe $ E.decodeUtf8' (keyHash k)-		| otherwise -> eitherToMaybe $ E.decodeUtf8' (keyName k)+		| otherwise -> eitherToMaybe $ E.decodeUtf8' (fromKey keyName k) 	_ -> Nothing  -- The size of an encrypted key is the size of the input data, but we need@@ -326,7 +355,7 @@ extractKeySize :: Key -> Maybe Integer extractKeySize k 	| isEncKey k = Nothing-	| otherwise = keySize k+	| otherwise = fromKey keySize k  mkUploadRequest :: RemoteStateHandle -> Key -> FilePath -> Annex (LFS.TransferRequest, LFS.SHA256, Integer) mkUploadRequest rs k content = case (extractKeySha256 k, extractKeySize k) of

@@ -117,7 +117,7 @@  nonEmpty :: Key -> Annex Bool nonEmpty k-	| keySize k == Just 0 = do+	| fromKey keySize k == Just 0 = do 		warning "Cannot store empty files in Glacier." 		return False 	| otherwise = return True

@@ -68,8 +68,10 @@ chunkKeyStream :: Key -> ChunkSize -> ChunkKeyStream chunkKeyStream basek chunksize = ChunkKeyStream $ map mk [1..]   where-	mk chunknum = sizedk { keyChunkNum = Just chunknum }-	sizedk = basek { keyChunkSize = Just (toInteger chunksize) }+	mk chunknum = alterKey sizedk $ \d -> d+		{ keyChunkNum = Just chunknum }+	sizedk = alterKey basek $ \d -> d+		{ keyChunkSize = Just (toInteger chunksize) }  nextChunkKeyStream :: ChunkKeyStream -> (Key, ChunkKeyStream) nextChunkKeyStream (ChunkKeyStream (k:l)) = (k, ChunkKeyStream l)@@ -80,7 +82,7 @@  -- Number of chunks already consumed from the stream. numChunks :: ChunkKeyStream -> Integer-numChunks = pred . fromJust . keyChunkNum . fst . nextChunkKeyStream+numChunks = pred . fromJust . fromKey keyChunkNum . fst . nextChunkKeyStream  {- Splits up the key's content into chunks, passing each chunk to  - the storer action, along with a corresponding chunk key and a@@ -173,7 +175,7 @@ 	-> Annex (ChunkKeyStream, BytesProcessed) seekResume h encryptor chunkkeys checker = do 	sz <- liftIO (hFileSize h)-	if sz <= fromMaybe 0 (keyChunkSize $ fst $ nextChunkKeyStream chunkkeys)+	if sz <= fromMaybe 0 (fromKey keyChunkSize $ fst $ nextChunkKeyStream chunkkeys) 		then return (chunkkeys, zeroBytesProcessed) 		else check 0 chunkkeys sz   where@@ -193,7 +195,7 @@ 					return (cks, toBytesProcessed pos) 	  where 		(k, cks') = nextChunkKeyStream cks-		pos' = pos + fromMaybe 0 (keyChunkSize k)+		pos' = pos + fromMaybe 0 (fromKey keyChunkSize k)  {- Removes all chunks of a key from a remote, by calling a remover  - action on each.@@ -208,7 +210,7 @@ 	ls <- chunkKeys u chunkconfig k 	ok <- allM (remover . encryptor) (concat ls) 	when ok $ do-		let chunksizes = catMaybes $ map (keyChunkSize <=< headMaybe) ls+		let chunksizes = catMaybes $ map (fromKey keyChunkSize <=< headMaybe) ls 		forM_ chunksizes $ chunksRemoved u k . FixedSizeChunks . fromIntegral 	return ok @@ -272,7 +274,7 @@ 					bracketIO (maybe opennew openresume offset) hClose $ \h -> do 						void $ tosink (Just h) p content 						let sz = toBytesProcessed $-							fromMaybe 0 $ keyChunkSize k+							fromMaybe 0 $ fromKey keyChunkSize k 						getrest p h sz sz ks 							`catchNonAsync` unable 			case v of@@ -333,7 +335,7 @@ setupResume ls currsize = map dropunneeded ls   where 	dropunneeded [] = []-	dropunneeded l@(k:_) = case keyChunkSize k of+	dropunneeded l@(k:_) = case fromKey keyChunkSize k of 		Just chunksize | chunksize > 0 -> 			genericDrop (currsize `div` chunksize) l 		_ -> l

@@ -324,7 +324,7 @@ 		liftIO $ Export.getExportTree db k  	retrieveKeyFileFromExport dbv k _af dest p = unVerified $-		if maybe False (isJust . verifyKeyContent) (maybeLookupBackendVariety (keyVariety k))+		if maybe False (isJust . verifyKeyContent) (maybeLookupBackendVariety (fromKey keyVariety k)) 			then do 				locs <- getexportlocs dbv k 				case locs of@@ -336,5 +336,5 @@ 						return False 					(l:_) -> retrieveExport (exportActions r) k l dest p 			else do-				warning $ "exported content cannot be verified due to using the " ++ decodeBS (formatKeyVariety (keyVariety k)) ++ " backend"+				warning $ "exported content cannot be verified due to using the " ++ decodeBS (formatKeyVariety (fromKey keyVariety k)) ++ " backend" 				return False

@@ -128,4 +128,8 @@ {- Checks if a remote is syncable using git. -} gitSyncableRemote :: Remote -> Bool gitSyncableRemote r = remotetype r `elem`-	[ Remote.Git.remote, Remote.GCrypt.remote, Remote.P2P.remote ]+	[ Remote.Git.remote+	, Remote.GCrypt.remote+	, Remote.P2P.remote+	, Remote.GitLFS.remote+	]

@@ -347,7 +347,7 @@ 			Right us -> do 				showChecking r 				let check u = withUrlOptions $ -					Url.checkBoth u (keySize k)+					Url.checkBoth u (fromKey keySize k) 				anyM check us  checkKeyHelper :: S3Info -> S3Handle -> (Either S3.Object S3VersionID) -> Annex Bool@@ -417,7 +417,7 @@ 	Just h -> checkKeyHelper info h (Left (T.pack $ bucketExportLocation info loc)) 	Nothing -> case getPublicUrlMaker info of 		Just geturl -> withUrlOptions $-			Url.checkBoth (geturl $ bucketExportLocation info loc) (keySize k)+			Url.checkBoth (geturl $ bucketExportLocation info loc) (fromKey keySize k) 		Nothing -> do 			warning $ needS3Creds (uuid r) 			giveup "No S3 credentials configured"

@@ -117,7 +117,7 @@ 	case downloader of 		YoutubeDownloader -> youtubeDlCheck u' 		_ -> catchMsgIO $-			Url.withUrlOptions $ Url.checkBoth u' (keySize key)+			Url.withUrlOptions $ Url.checkBoth u' (fromKey keySize key)   where 	firsthit [] miss _ = return miss 	firsthit (u:rest) _ a = do

@@ -21,7 +21,9 @@  data GitAnnexDistribution = GitAnnexDistribution 	{ distributionUrl :: String-	, distributionKey :: Key+	, distributionKey :: KeyData+	-- ^ This used to be a Key, but now KeyData serializes+	-- to Key { ... }, so back-compat for Read and Show is preserved. 	, distributionVersion :: GitAnnexVersion 	, distributionReleasedate :: UTCTime 	, distributionUrgentUpgrade :: Maybe GitAnnexVersion@@ -46,7 +48,7 @@ formatGitAnnexDistribution :: GitAnnexDistribution -> String formatGitAnnexDistribution d = unlines 	[ distributionUrl d-	, serializeKey (distributionKey d)+	, serializeKey $ mkKey $ const $ distributionKey d 	, distributionVersion d 	, show (distributionReleasedate d) 	, maybe "" show (distributionUrgentUpgrade d)@@ -56,7 +58,7 @@ parseGitAnnexDistribution s = case lines s of 	(u:k:v:d:uu:_) -> GitAnnexDistribution 		<$> pure u-		<*> deserializeKey k+		<*> fmap (fromKey id) (deserializeKey k) 		<*> pure v 		<*> readish d 		<*> pure (readish uu)

@@ -7,19 +7,47 @@  {-# LANGUAGE OverloadedStrings, DeriveGeneric #-} -module Types.Key where+module Types.Key (+	KeyData(..),+	Key,+	fromKey,+	mkKey,+	alterKey,+	isKeyPrefix,+	splitKeyNameExtension,+	keyParser,+	keySerialization,+	AssociatedFile(..),+	KeyVariety(..),+	HasExt(..),+	HashSize(..),+	hasExt,+	sameExceptExt,+	cryptographicallySecure,+	isVerifiable,+	formatKeyVariety,+	parseKeyVariety,+) where  import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Builder+import Data.ByteString.Builder.Extra+import qualified Data.Attoparsec.ByteString as A+import qualified Data.Attoparsec.ByteString.Char8 as A8+import Data.List import System.Posix.Types+import Foreign.C.Types import Data.Monoid+import Control.Applicative import GHC.Generics import Control.DeepSeq import Prelude  {- A Key has a unique name, which is derived from a particular backend,  - and may contain other optional metadata. -}-data Key = Key+data KeyData = Key 	{ keyName :: S.ByteString 	, keyVariety :: KeyVariety 	, keySize :: Maybe Integer@@ -28,7 +56,148 @@ 	, keyChunkNum :: Maybe Integer 	} deriving (Eq, Ord, Read, Show, Generic) +instance NFData KeyData++{- Caching the seralization of a key is an optimization.+ -+ - This constructor is not exported, and all smart constructors maintain+ - the serialization.+ -}+data Key = MkKey+	{ keyData :: KeyData+	, keySerialization :: S.ByteString+	} deriving (Show, Generic)++instance Eq Key where+	-- comparing the serialization would be unncessary work+	a == b = keyData a == keyData b++instance Ord Key where+	compare a b = compare (keyData a) (keyData b)+ instance NFData Key++{- Access a field of data from the KeyData. -}+{-# INLINE fromKey #-}+fromKey :: (KeyData -> a) -> Key -> a+fromKey f = f . keyData++{- Smart constructor for a Key. The provided KeyData has all values empty. -}+mkKey :: (KeyData -> KeyData) -> Key+mkKey f =+	let d = f stub+	in MkKey d (mkKeySerialization d)+  where+	stub = Key+		{ keyName = mempty+		, keyVariety = OtherKey mempty+		, keySize = Nothing+		, keyMtime = Nothing+		, keyChunkSize = Nothing+		, keyChunkNum = Nothing+		}++{- Alter a Key's data. -}+alterKey :: Key -> (KeyData -> KeyData) -> Key+alterKey k f = +	let d = f (keyData k)+	in MkKey d (mkKeySerialization d)++-- Checks if a string looks like at least the start of a key.+isKeyPrefix :: String -> Bool+isKeyPrefix s = [fieldSep, fieldSep] `isInfixOf` s++fieldSep :: Char+fieldSep = '-'++mkKeySerialization :: KeyData -> S.ByteString+mkKeySerialization = L.toStrict+    	. toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty+	. buildKeyData++{- Builds a ByteString from a KeyData.+ -+ - The name field is always shown last, separated by doubled fieldSeps,+ - and is the only field allowed to contain the fieldSep.+ -}+buildKeyData :: KeyData -> Builder+buildKeyData k = byteString (formatKeyVariety (keyVariety k))+	<> 's' ?: (integerDec <$> keySize k)+	<> 'm' ?: (integerDec . (\(CTime t) -> fromIntegral t) <$> keyMtime k)+	<> 'S' ?: (integerDec <$> keyChunkSize k)+	<> 'C' ?: (integerDec <$> keyChunkNum k)+	<> sepbefore (sepbefore (byteString (keyName k)))+  where+	sepbefore s = char7 fieldSep <> s+	c ?: (Just b) = sepbefore (char7 c <> b)+	_ ?: Nothing = mempty++{- This is a strict parser for security reasons; a key+ - can contain only 4 fields, which all consist only of numbers.+ - Any key containing other fields, or non-numeric data will fail+ - to parse.+ -+ - If a key contained non-numeric fields, they could be used to+ - embed data used in a SHA1 collision attack, which would be a+ - problem since the keys are committed to git.+ -}+keyParser :: A.Parser Key+keyParser = do+	-- key variety cannot be empty+	v <- (parseKeyVariety <$> A8.takeWhile1 (/= fieldSep))+	s <- parsesize+	m <- parsemtime+	cs <- parsechunksize+	cn <- parsechunknum+	_ <- A8.char fieldSep+	_ <- A8.char fieldSep+	n <- A.takeByteString+	if validKeyName v n+		then +			let d = Key+				{ keyName = n+				, keyVariety = v+				, keySize = s+				, keyMtime = m+				, keyChunkSize = cs+				, keyChunkNum = cn+				}+			in pure $ MkKey d (mkKeySerialization d)+		else fail "invalid keyName"+  where+	parseopt p = (Just <$> (A8.char fieldSep *> p)) <|> pure Nothing+	parsesize = parseopt $ A8.char 's' *> A8.decimal+	parsemtime = parseopt $ CTime <$> (A8.char 'm' *> A8.decimal)+	parsechunksize = parseopt $ A8.char 'S' *> A8.decimal+	parsechunknum = parseopt $ A8.char 'C' *> A8.decimal++{- Limits the length of the extension in the keyName to mitigate against+ - SHA1 collision attacks.+ -+ - In such an attack, the extension of the key could be made to contain+ - the collision generation data, with the result that a signed git commit+ - including such keys would not be secure.+ -+ - The maximum extension length ever generated for such a key was 8+ - characters, but they may be unicode which could use up to 4 bytes each,+ - so 32 bytes. 64 bytes is used here to give a little future wiggle-room. + - The SHA1 common-prefix attack needs 128 bytes of data.+ -}+validKeyName :: KeyVariety -> S.ByteString -> Bool+validKeyName kv name+	| hasExt kv = +		let ext = snd $ splitKeyNameExtension' name+		in S.length ext <= 64+	| otherwise = True++{- This splits any extension out of the keyName, returning the + - keyName minus extension, and the extension (including leading dot).+ -}+splitKeyNameExtension :: Key -> (S.ByteString, S.ByteString)+splitKeyNameExtension = splitKeyNameExtension' . keyName . keyData++splitKeyNameExtension' :: S.ByteString -> (S.ByteString, S.ByteString)+splitKeyNameExtension' keyname = S8.span (/= '.') keyname  {- A filename may be associated with a Key. -} newtype AssociatedFile = AssociatedFile (Maybe FilePath)

@@ -11,6 +11,7 @@  import Types import Types.Remote (Verification(..))+import Types.Key import Utility.PID import Utility.QuickCheck import Utility.Url@@ -24,9 +25,12 @@ data Transfer = Transfer 	{ transferDirection :: Direction 	, transferUUID :: UUID-	, transferKey :: Key+	, transferKeyData :: KeyData 	}-	deriving (Eq, Ord, Read, Show)+	deriving (Eq, Ord, Show, Read)++transferKey :: Transfer -> Key+transferKey = mkKey . const . transferKeyData  {- Information about a Transfer, stored in the transfer information file.  -

@@ -134,7 +134,7 @@   where 	len = length l - 4 	k = readKey1 (take len l)-	sane = (not . S.null $ keyName k) && (not . S.null $ formatKeyVariety $ keyVariety k)+	sane = (not . S.null $ fromKey keyName k) && (not . S.null $ formatKeyVariety $ fromKey keyVariety k)  -- WORM backend keys: "WORM:mtime:size:filename" -- all the rest: "backend:key"@@ -145,7 +145,7 @@ readKey1 :: String -> Key readKey1 v 	| mixup = fromJust $ deserializeKey $ intercalate ":" $ Prelude.tail bits-	| otherwise = stubKey+	| otherwise = mkKey $ \d -> d 		{ keyName = encodeBS n 		, keyVariety = parseKeyVariety (encodeBS b) 		, keySize = s@@ -165,12 +165,16 @@ 	mixup = wormy && isUpper (Prelude.head $ bits !! 1)  showKey1 :: Key -> String-showKey1 Key { keyName = n , keyVariety = v, keySize = s, keyMtime = t } =-	intercalate ":" $ filter (not . null) [b, showifhere t, showifhere s, decodeBS n]+showKey1 k = intercalate ":" $ filter (not . null)+	[b, showifhere t, showifhere s, decodeBS n]   where 	showifhere Nothing = "" 	showifhere (Just x) = show x 	b = decodeBS $ formatKeyVariety v+	n = fromKey keyName k+	v = fromKey keyVariety k+	s = fromKey keySize k+	t = fromKey keyMtime k  keyFile1 :: Key -> FilePath keyFile1 key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a"  $ showKey1 key@@ -194,7 +198,7 @@ 		Right l -> makekey l   where 	getsymlink = takeFileName <$> readSymbolicLink file-	makekey l = case maybeLookupBackendVariety (keyVariety k) of+	makekey l = case maybeLookupBackendVariety (fromKey keyVariety k) of 		Nothing -> do 			unless (null kname || null bname || 			        not (isLinkToAnnex (toRawFilePath l))) $@@ -203,8 +207,8 @@ 		Just backend -> return $ Just (k, backend) 	  where 		k = fileKey1 l-		bname = decodeBS (formatKeyVariety (keyVariety k))-		kname = decodeBS (keyName k)+		bname = decodeBS (formatKeyVariety (fromKey keyVariety k))+		kname = decodeBS (fromKey keyName k) 		skip = "skipping " ++ file ++  			" (unknown backend " ++ bname ++ ")" 

@@ -7,7 +7,9 @@  - License: BSD-2-clause  -} -module Utility.Android where+module Utility.Android (+	osAndroid+) where  #ifdef linux_HOST_OS import Common

@@ -5,7 +5,11 @@  - License: BSD-2-clause  -} -module Utility.Applicative where+{-# OPTIONS_GHC -fno-warn-tabs #-}++module Utility.Applicative (+	(<$$>),+) where  {- Like <$> , but supports one level of currying.  - 

@@ -7,7 +7,14 @@  {-# LANGUAGE CPP #-} -module Utility.Batch where+module Utility.Batch (+	batch,+	BatchCommandMaker,+	getBatchCommandMaker,+	toBatchCommand,+	batchCommand,+	batchCommandEnv,+) where  import Common 

@@ -7,7 +7,13 @@  {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} -module Utility.DBus where+module Utility.DBus (+	ServiceName,+	listServiceNames,+	callDBus,+	runClient,+	persistentClient,+) where  import Utility.PartialPrelude import Utility.Exception

@@ -7,7 +7,12 @@  {-# LANGUAGE CPP #-} -module Utility.Daemon where+module Utility.Daemon (+	daemonize,+	foreground,+	checkDaemon,+	stopDaemon,+) where  import Common import Utility.PID

@@ -7,7 +7,10 @@  {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Data where+module Utility.Data (+	firstJust,+	eitherToMaybe,+) where  {- First item in the list that is not Nothing. -} firstJust :: Eq a => [Maybe a] -> Maybe a

@@ -8,7 +8,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -module Utility.DebugLocks where+module Utility.DebugLocks (debugLocks) where  import Control.Monad.Catch import Control.Monad.IO.Class

@@ -11,7 +11,15 @@  {-# LANGUAGE CPP #-} -module Utility.DirWatcher where+module Utility.DirWatcher (+	canWatch,+	eventsCoalesce,+	closingTracked,+	modifyTracked,+	DirWatcherHandle,+	watchDir,+	stopWatchDir,+) where  import Utility.DirWatcher.Types 

@@ -5,7 +5,7 @@  - License: BSD-2-clause  -} -module Utility.DirWatcher.FSEvents where+module Utility.DirWatcher.FSEvents (watchDir) where  import Common hiding (isDirectory) import Utility.DirWatcher.Types

@@ -5,7 +5,7 @@  - License: BSD-2-clause  -} -module Utility.DirWatcher.INotify where+module Utility.DirWatcher.INotify (watchDir) where  import Common hiding (isDirectory) import Utility.ThreadLock

@@ -5,7 +5,11 @@  - License: BSD-2-clause  -} -module Utility.DirWatcher.Types where+module Utility.DirWatcher.Types (+	Hook,+	WatchHooks(..),+	mkWatchHooks,+) where  import Common 

@@ -5,7 +5,7 @@  - License: BSD-2-clause  -} -module Utility.DirWatcher.Win32Notify where+module Utility.DirWatcher.Win32Notify (watchDir) where  import Common hiding (isDirectory) import Utility.DirWatcher.Types

@@ -9,11 +9,16 @@ {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Directory.Stream where+module Utility.Directory.Stream (+	DirectoryHandle,+	openDirectory,+	closeDirectory,+	readDirectory,+	isDirectoryEmpty,+) where  import Control.Monad import System.FilePath-import System.IO.Unsafe (unsafeInterleaveIO) import Control.Concurrent import Data.Maybe import Prelude@@ -99,22 +104,6 @@ 		filename <- Win32.getFindDataFileName fdat 		return (Just filename) #endif---- | Like getDirectoryContents, but rather than buffering the whole--- directory content in memory, lazily streams.------ This is like lazy readFile in that the handle to the directory remains--- open until the whole list is consumed, or until the list is garbage--- collected. So use with caution particularly when traversing directory--- trees.-streamDirectoryContents :: FilePath -> IO [FilePath]-streamDirectoryContents d = openDirectory d >>= collect-  where-	collect hdl = readDirectory hdl >>= \case-		Nothing -> return []-		Just f -> do-			rest <- unsafeInterleaveIO (collect hdl)-			return (f:rest)  -- | True only when directory exists and contains nothing. -- Throws exception if directory does not exist.

@@ -1,11 +1,23 @@ {- a simple graphviz / dot(1) digraph description generator library  -+ - import qualified+ -  - Copyright 2010 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -} -module Utility.Dot where -- import qualified+module Utility.Dot (+	graph,+	graphNode,+	graphEdge,+	label,+	attr,+	fillColor,+	subGraph,+	indent,+	quote,+) where  {- generates a graph description from a list of lines -} graph :: [String] -> String

@@ -7,7 +7,11 @@  {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.DottedVersion where+module Utility.DottedVersion (+	DottedVersion,+	fromDottedVersion,+	normalize,+) where  import Common 

@@ -8,7 +8,14 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Env where+module Utility.Env (+	getEnv,+	getEnvDefault,+	getEnvironment,+	addEntry,+	addEntries,+	delEntry,+) where  #ifdef mingw32_HOST_OS import Utility.Exception

@@ -7,7 +7,10 @@  {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Env.Basic where+module Utility.Env.Basic (+	getEnv,+	getEnvDefault,+) where  import Utility.Exception import Control.Applicative

@@ -7,7 +7,10 @@  {-# LANGUAGE CPP #-} -module Utility.Env.Set where+module Utility.Env.Set (+	setEnv,+	unsetEnv,+) where  #ifdef mingw32_HOST_OS import qualified System.SetEnv

@@ -4,8 +4,13 @@  -}  {-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.FileSize where+module Utility.FileSize (+	FileSize,+	getFileSize,+	getFileSize',+) where  import System.PosixCompat.Files #ifdef mingw32_HOST_OS

@@ -7,7 +7,32 @@  {-# LANGUAGE CPP #-} -module Utility.Gpg where+module Utility.Gpg (+	KeyId,+	KeyIds(..),+	GpgCmd(..),+	mkGpgCmd,+	boolGpgCmd,+	pkEncTo,+	stdEncryptionParams,+	pipeStrict,+	feedRead,+	pipeLazy,+	findPubKeys,+	UserId,+	secretKeys,+	KeyType(..),+	maxRecommendedKeySize,+	genSecretKey,+	genRandom,+	testKeyId,+#ifndef mingw32_HOST_OS+	testHarness,+	testTestHarness,+	checkEncryptionFile,+	checkEncryptionStream,+#endif+) where  import Common import qualified BuildInfo@@ -279,6 +304,7 @@  - It has an empty passphrase. -} testKeyId :: String testKeyId = "129D6E0AC537B9C7"+ testKey :: String testKey = keyBlock True 	[ "mI0ETvFAZgEEAKnqwWgZqznMhi1RQExem2H8t3OyKDxaNN3rBN8T6LWGGqAYV4wT"@@ -299,6 +325,7 @@ 	, "+gQkDF9/" 	, "=1k11" 	]+ testSecretKey :: String testSecretKey = keyBlock False 	[ "lQHYBE7xQGYBBACp6sFoGas5zIYtUUBMXpth/Ldzsig8WjTd6wTfE+i1hhqgGFeM"@@ -332,6 +359,7 @@ 	, "IJf+/dFjxEmflWpbxw/36pEd/EReLX8b8qDIYadK6BpiWN9xgEiBv/oEJAxffw==" 	, "=LDsg" 	]+ keyBlock :: Bool -> [String] -> String keyBlock public ls = unlines 	[ "-----BEGIN PGP "++t++" KEY BLOCK-----"@@ -381,9 +409,7 @@ testTestHarness tmpdir cmd = do 	keys <- testHarness tmpdir cmd $ findPubKeys cmd testKeyId 	return $ KeyIds [testKeyId] == keys-#endif -#ifndef mingw32_HOST_OS checkEncryptionFile :: GpgCmd -> FilePath -> Maybe KeyIds -> IO Bool checkEncryptionFile cmd filename keys = 	checkGpgPackets cmd keys =<< readStrict cmd params

@@ -24,6 +24,7 @@ 	blake2b_512, 	blake2bp_512, 	md5,+	md5s, 	prop_hashes_stable, 	Mac(..), 	calcMac,@@ -105,6 +106,9 @@  md5 ::  L.ByteString -> Digest MD5 md5 = hashlazy++md5s ::  S.ByteString -> Digest MD5+md5s = hash  {- Check that all the hashes continue to hash the same. -} prop_hashes_stable :: Bool

@@ -5,7 +5,11 @@  - License: BSD-2-clause  -} -module Utility.HtmlDetect where+module Utility.HtmlDetect (+	isHtml,+	isHtmlBs,+	htmlPrefixLength,+) where  import Text.HTML.TagSoup import Data.Char

@@ -5,7 +5,7 @@  - License: BSD-2-clause  -} -module Utility.HumanNumber where+module Utility.HumanNumber (showImprecise) where  {- Displays a fractional value as a string with a limited number  - of decimal digits. -}

@@ -5,7 +5,12 @@  - License: BSD-2-clause  -} -module Utility.IPAddress where+module Utility.IPAddress (+	extractIPAddress,+	isLoopbackAddress,+	isPrivateAddress,+	makeAddressMatcher,+) where  import Utility.Exception 

@@ -187,16 +187,14 @@ toInodeCache :: TSDelta -> FilePath -> FileStatus -> IO (Maybe InodeCache) toInodeCache (TSDelta getdelta) f s 	| isRegularFile s = do-#ifndef mingw32_HOST_OS 		delta <- getdelta-#endif 		sz <- getFileSize' f s #ifdef mingw32_HOST_OS-		mtime <- MTimeHighRes . utcTimeToPOSIXSeconds <$> getModificationTime f+		mtime <- utcTimeToPOSIXSeconds <$> getModificationTime f #else- 		let mtime = (MTimeHighRes (modificationTimeHiRes s + highResTime delta))+		let mtime = modificationTimeHiRes s #endif-		return $ Just $ InodeCache $ InodeCachePrim (fileID s) sz mtime+		return $ Just $ InodeCache $ InodeCachePrim (fileID s) sz (MTimeHighRes (mtime + highResTime delta)) 	| otherwise = pure Nothing  {- Some filesystem get new random inodes each time they are mounted.

@@ -5,7 +5,12 @@  - License: BSD-2-clause  -} -module Utility.LinuxMkLibs where+module Utility.LinuxMkLibs (+	installLib,+	parseLdd,+	glibcLibs,+	inTop,+) where  import Utility.PartialPrelude import Utility.Directory

@@ -5,7 +5,7 @@  - License: BSD-2-clause  -} -module Utility.LockFile.LockStatus where+module Utility.LockFile.LockStatus (LockStatus(..)) where  import System.Posix 

@@ -7,7 +7,15 @@  {-# LANGUAGE CPP #-} -module Utility.LogFile where+module Utility.LogFile (+	openLog,+	listLogs,+	maxLogs,+#ifndef mingw32_HOST_OS+	redirLog,+	redir,+#endif+) where  import Common 

@@ -5,7 +5,12 @@  - License: BSD-2-clause  -} -module Utility.Lsof where+module Utility.Lsof (+	LsofOpenMode(..),+	setup,+	queryDir,+	query,+) where  import Common import BuildInfo

@@ -7,7 +7,40 @@  {-# LANGUAGE TypeSynonymInstances, BangPatterns #-} -module Utility.Metered where+module Utility.Metered (+	MeterUpdate,+	nullMeterUpdate,+	combineMeterUpdate,+	BytesProcessed(..),+	toBytesProcessed,+	fromBytesProcessed,+	addBytesProcessed,+	zeroBytesProcessed,+	withMeteredFile,+	meteredWrite,+	meteredWrite',+	meteredWriteFile,+	offsetMeterUpdate,+	hGetContentsMetered,+	hGetMetered,+	defaultChunkSize,+	watchFileSize,+	OutputHandler(..),+	ProgressParser,+	commandMeter,+	commandMeter',+	demeterCommand,+	demeterCommandEnv,+	avoidProgress,+	rateLimitMeterUpdate,+	Meter,+	mkMeter,+	setMeterTotalSize,+	updateMeter,+	displayMeterHandle,+	clearMeterHandle,+	bandwidthMeter,+) where  import Common import Utility.Percentage@@ -79,11 +112,6 @@ withMeteredFile :: FilePath -> MeterUpdate -> (L.ByteString -> IO a) -> IO a withMeteredFile f meterupdate a = withBinaryFile f ReadMode $ \h -> 	hGetContentsMetered h meterupdate >>= a--{- Sends the content of a file to a Handle, updating the meter as it's- - written. -}-streamMeteredFile :: FilePath -> MeterUpdate -> Handle -> IO ()-streamMeteredFile f meterupdate h = withMeteredFile f meterupdate $ L.hPut h  {- Writes a ByteString to a Handle, updating a meter as it's written. -} meteredWrite :: MeterUpdate -> Handle -> L.ByteString -> IO ()

@@ -7,7 +7,19 @@  {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Misc where+module Utility.Misc (+	hGetContentsStrict,+	readFileStrict,+	separate,+	firstLine,+	segment,+	segmentDelim,+	massReplace,+	hGetSomeString,+	exitBool,++	prop_segment_regressionTest,+) where  import System.IO import Control.Monad

@@ -7,7 +7,19 @@  {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Monad where+module Utility.Monad (+	firstM,+	getM,+	anyM,+	allM,+	untilTrue,+	ifM,+	(<||>),+	(<&&>),+	observe,+	after,+	noop,+) where  import Data.Maybe import Control.Monad

@@ -7,7 +7,7 @@  {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Network where+module Utility.Network (getHostname) where  import Utility.Process import Utility.Exception

@@ -7,7 +7,12 @@  {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.OSX where+module Utility.OSX (+	autoStartBase,+	systemAutoStart,+	userAutoStart,+	genOSXAutoStartFile,+) where  import Utility.UserInfo 

@@ -5,7 +5,10 @@  - License: BSD-2-clause  -} -module Utility.OptParse where+module Utility.OptParse (+	invertableSwitch,+	invertableSwitch',+) where  import Options.Applicative import Data.Monoid

@@ -7,7 +7,7 @@  {-# LANGUAGE CPP #-} -module Utility.PID where+module Utility.PID (PID, getPID) where  #ifndef mingw32_HOST_OS import System.Posix.Types (ProcessID)

@@ -5,7 +5,7 @@  - License: BSD-2-clause  -} -module Utility.Parallel where+module Utility.Parallel (inParallel) where  import Common 

@@ -7,7 +7,18 @@  {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.PartialPrelude where+module Utility.PartialPrelude (+	Utility.PartialPrelude.read,+	Utility.PartialPrelude.head,+	Utility.PartialPrelude.tail,+	Utility.PartialPrelude.init,+	Utility.PartialPrelude.last,+	Utility.PartialPrelude.readish,+	Utility.PartialPrelude.headMaybe,+	Utility.PartialPrelude.lastMaybe,+	Utility.PartialPrelude.beginning,+	Utility.PartialPrelude.end,+) where  import qualified Data.Maybe 

@@ -8,7 +8,29 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Path where+module Utility.Path (+	simplifyPath,+	absPathFrom,+	parentDir,+	upFrom,+	dirContains,+	absPath,+	relPathCwdToFile,+	relPathDirToFile,+	relPathDirToFileAbs,+	segmentPaths,+	runSegmentPaths,+	relHome,+	inPath,+	searchPath,+	dotfile,+	sanitizeFilePath,+	splitShortExtensions,++	prop_upFrom_basics,+	prop_relPathDirToFile_basics,+	prop_relPathDirToFile_regressionTest,+) where  import System.FilePath import Data.List

@@ -8,7 +8,7 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Path.Max where+module Utility.Path.Max (fileNameLengthLimit) where  #ifndef mingw32_HOST_OS import Utility.Exception

@@ -8,7 +8,11 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Process.Transcript where+module Utility.Process.Transcript (+	processTranscript,+	processTranscript',+	processTranscript'',+) where  import Utility.Process import Utility.Misc

@@ -7,7 +7,17 @@  {-# LANGUAGE CPP #-} -module Utility.Rsync where+module Utility.Rsync (+	rsyncShell,+	rsyncServerSend,+	rsyncServerReceive,+	rsyncUseDestinationPermissions,+	rsync,+	rsyncUrlIsShell,+	rsyncUrlIsPath,+	rsyncProgress,+	filterRsyncSafeOptions,+) where  import Common import Utility.Metered@@ -161,10 +171,8 @@  - The virtual filesystem contains:  -  /c, /d, ...	mount points for Windows drives  -}+#ifdef mingw32_HOST_OS toMSYS2Path :: FilePath -> FilePath-#ifndef mingw32_HOST_OS-toMSYS2Path = id-#else toMSYS2Path p 	| null drive = recombine parts 	| otherwise = recombine $ "/" : driveletter drive : parts

@@ -7,7 +7,23 @@  {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.SafeCommand where+module Utility.SafeCommand (+	CommandParam(..),+	toCommand,+	boolSystem,+	boolSystem',+	boolSystemEnv,+	safeSystem,+	safeSystem',+	safeSystemEnv,+	shellWrap,+	shellEscape,+	shellUnEscape,+	segmentXargsOrdered,+	segmentXargsUnordered,+	prop_isomorphic_shellEscape,+	prop_isomorphic_shellEscape_multiword,+) where  import System.Exit import Utility.Process

@@ -7,7 +7,7 @@  {-# OPTIONS_GHC -fno-warn-orphans #-} -module Utility.Scheduled.QuickCheck where+module Utility.Scheduled.QuickCheck (prop_schedule_roundtrips) where  import Utility.Scheduled import Utility.QuickCheck

@@ -7,7 +7,11 @@  {-# LANGUAGE CPP #-} -module Utility.Shell where+module Utility.Shell (+	shellPath,+	shebang,+	findShellCommand,+) where  import Utility.SafeCommand #ifdef mingw32_HOST_OS

@@ -7,7 +7,12 @@  {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Split where+module Utility.Split (+	split,+	splitc,+	replace,+	dropFromEnd,+) where  import Data.List (intercalate) import Data.List.Split (splitOn)

@@ -5,7 +5,24 @@  - License: BSD-2-clause  -} -module Utility.SshConfig where+module Utility.SshConfig (+	SshConfig(..),+	Comment(..),+	SshSetting(..),+	Indent,+	Host,+	Key,+	Value,+	parseSshConfig,+	genSshConfig,+	findHostConfigKey,+	addToHostConfig,+	modifyUserSshConfig,+	changeUserSshConfig,+	writeSshConfig,+	setSshConfigMode,+	sshDir,+) where  import Common import Utility.UserInfo

@@ -7,7 +7,15 @@  {-# LANGUAGE CPP #-} -module Utility.Su where+module Utility.Su (+	WhosePassword(..),+	PasswordPrompt(..),+	describePasswordPrompt,+	describePasswordPrompt',+	SuCommand,+	runSuCommand,+	mkSuCommand,+) where  import Common 

@@ -11,7 +11,17 @@  {-# LANGUAGE BangPatterns #-} -module Utility.TList where+module Utility.TList (+	TList,+	newTList,+	getTList,+	setTList,+	takeTList,+	readTList,+	consTList,+	snocTList,+	appendTList,+) where  import Common 

@@ -7,7 +7,13 @@  {-# LANGUAGE OverloadedStrings #-} -module Utility.Tense where+module Utility.Tense (+	Tense(..),+	TenseChunk(..),+	TenseText,+	renderTense,+	tenseWords,+) where  import qualified Data.Text as T import Data.Text (Text)@@ -52,6 +58,3 @@ 	go c ((Tensed w1 w2):ws) = 		go (Tensed (addspace w1) (addspace w2) : c) ws 	addspace w = T.append w " "--unTensed :: Text -> TenseText-unTensed t = TenseText [UnTensed t]

@@ -5,7 +5,11 @@  - License: BSD-2-clause  -} -module Utility.ThreadLock where+module Utility.ThreadLock (+	Lock,+	newLock,+	withLock,+) where  import Control.Concurrent.MVar 

@@ -8,7 +8,14 @@  {-# LANGUAGE CPP #-} -module Utility.ThreadScheduler where+module Utility.ThreadScheduler (+	Seconds(..),+	Microseconds,+	runEvery,+	threadDelaySeconds,+	waitForTermination,+	oneSecond,+) where  import Control.Monad import Control.Concurrent

@@ -5,7 +5,11 @@  - License: BSD-2-clause  -} -module Utility.TimeStamp where+module Utility.TimeStamp (+	parserPOSIXTime,+	parsePOSIXTime,+	formatPOSIXTime,+) where  import Utility.Data 

@@ -8,7 +8,13 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Tmp where+module Utility.Tmp (+	Template,+	viaTmp,+	withTmpFile,+	withTmpFileIn,+	relatedTemplate,+) where  import System.IO import System.FilePath

@@ -8,7 +8,10 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Tmp.Dir where+module Utility.Tmp.Dir (+	withTmpDir,+	withTmpDirIn,+) where  import Control.Monad.IfElse import System.FilePath

@@ -7,7 +7,17 @@  {-# LANGUAGE CPP #-} -module Utility.Tor where+module Utility.Tor (+	OnionPort,+	OnionAddress(..),+	OnionSocket,+	UniqueIdent,+	AppName,+	connectHiddenService,+	addHiddenService,+	getHiddenServiceSocketFile,+	torIsInstalled,+) where  import Common import Utility.ThreadScheduler

@@ -5,7 +5,11 @@  - License: BSD-2-clause  -} -module Utility.Tuple where+module Utility.Tuple (+	fst3,+	snd3,+	thd3,+) where  fst3 :: (a,b,c) -> a fst3 (a,_,_) = a

@@ -445,7 +445,7 @@ 			liftIO $ debugM "url" (show req'') 			resp <- http req'' (httpManager uo) 			if responseStatus resp == partialContent206-				then store (BytesProcessed sz) AppendMode resp+				then store (toBytesProcessed sz) AppendMode resp 				else if responseStatus resp == ok200 					then store zeroBytesProcessed WriteMode resp 					else respfailure resp

@@ -5,7 +5,14 @@  - License: BSD-2-clause  -} -module Utility.Verifiable where+module Utility.Verifiable (+	Secret,+	HMACDigest,+	Verifiable(..),+	mkVerifiable,+	verify,+	prop_verifiable_sane,+) where  import Data.ByteString.UTF8 (fromString) import qualified Data.ByteString as S

@@ -7,7 +7,14 @@  {-# LANGUAGE OverloadedStrings, CPP, RankNTypes #-} -module Utility.WebApp where+module Utility.WebApp (+	browserProc,+	runWebApp,+	webAppSessionBackend,+	checkAuthToken,+	insertAuthToken,+	writeHtmlShim,+) where  import Common import Utility.Tmp@@ -19,11 +26,9 @@ import Network.Wai.Handler.Warp import Network.Wai.Handler.WarpTLS import Network.HTTP.Types-import qualified Data.CaseInsensitive as CI import Network.Socket import "crypto-api" Crypto.Random import qualified Web.ClientSession as CS-import qualified Data.ByteString as B import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Blaze.ByteString.Builder.Char.Utf8 (fromText)@@ -119,9 +124,6 @@ 		listen sock maxListenQueue 		return sock -lookupRequestField :: CI.CI B.ByteString -> Wai.Request -> B.ByteString-lookupRequestField k req = fromMaybe "" . lookup k $ Wai.requestHeaders req- {- Rather than storing a session key on disk, use a random key  - that will only be valid for this run of the webapp. -} webAppSessionBackend :: Yesod.Yesod y => y -> IO (Maybe Yesod.SessionBackend)@@ -188,7 +190,6 @@ writeHtmlShim :: String -> String -> FilePath -> IO () writeHtmlShim title url file = viaTmp writeFileProtected file $ genHtmlShim title url -{- TODO: generate this static file using Yesod. -} genHtmlShim :: String -> String -> String genHtmlShim title url = unlines 	[ "<html>"

@@ -1,16 +1,16 @@ # NAME -git-annex import - add files from a non-versioned directory or a special remote+git-annex import - add a tree of files to the repository  # SYNOPSIS -git annex import `[path ...]` | git annex import --from remote branch[:subdir]+git annex import --from remote branch[:subdir] | `[path ...]`  # DESCRIPTION -This command is a way to import files from elsewhere into your git-annex-repository. It can import files from a directory into your repository, -or it can import files from a git-annex special remote.+This command is a way to import a tree of files from elsewhere into your+git-annex repository. It can import files from a git-annex special remote,+or from a directory.  # IMPORTING FROM A SPECIAL REMOTE @@ -30,7 +30,8 @@  You can only import from special remotes that were configured with `importtree=yes` when set up with [[git-annex-initremote]](1). Only some-kinds of special remotes will let you configure them this way.+kinds of special remotes will let you configure them this way. A perhaps+non-exhastive list is the directory, s3, and adb special remotes.  To import from a special remote, you must specify the name of a branch. A corresponding remote tracking branch will be updated by `git annex@@ -87,6 +88,10 @@  When run with a path, `git annex import` moves files from somewhere outside the git working copy, and adds them to the annex.++This is a legacy interface. It is still supported, but please consider+switching to importing from a directory special remote instead, using the+interface documented above.  Individual files to import can be specified. If a directory is specified, the entire directory is imported.

@@ -40,6 +40,10 @@   Rather than specifying a filename or path, this option can be   used to access all files that are currently being downloaded. +* `--key=keyname`++  Access the file that is currently being downloaded for the specified key.+ * file matching options     The [[git-annex-matching-options]](1)@@ -47,7 +51,7 @@  # EXIT STATUS -If any of the requested files are not currently being downloaded,+If any of the requested items are not currently being downloaded, the exit status will be 1.  # SEE ALSO

@@ -146,10 +146,9 @@      See [[git-annex-rmurl]](1) for details. -* `import [path ...]`+* `import --from remote branch[:subdir] | [path ...]` -  Add files from a non-version-controlled directory or a -  special remote into the annex.+  Add a tree of files to the repository.      See [[git-annex-import]](1) for details. 

@@ -1,5 +1,5 @@ Name: git-annex-Version: 7.20191114+Version: 7.20191218 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>

@@ -15,7 +15,7 @@               <small>                 <a href="@{EditRepositoryR $ RepoUUID $ transferUUID transfer}">                   #{maybe "unknown" Remote.name $ transferRemote info}-                $with size <- maybe "unknown" (roughSize dataUnits True) $ keySize $ transferKey transfer+                $with size <- maybe "unknown" (roughSize dataUnits True) $ keySize $ transferKeyData transfer                   $if isJust $ startedTime info                     $if isrunning info                       <span .pull-right><b>#{percent} of #{size}</b>