git-annex 7.20181121 → 7.20181205

raw patch · 26 files changed

+155/−68 lines, 26 files

Files

• Annex/AdjustedBranch.hs +2/−0
• Annex/Content.hs +6/−0
• Annex/DirHashes.hs +3/−1
• Annex/Init.hs +25/−6
• Annex/Version.hs +3/−0
• Annex/YoutubeDl.hs +1/−0
• CHANGELOG +22/−0
• Command/DropUnused.hs +14/−3
• Command/Multicast.hs +1/−1
• Creds.hs +36/−35
• Git/Remote.hs +1/−2
• Messages/Concurrent.hs +1/−1
• P2P/Address.hs +4/−4
• P2P/Auth.hs +5/−5
• Remote/BitTorrent.hs +1/−1
• Remote/External.hs +1/−1
• Remote/Helper/AWS.hs +1/−1
• Remote/Helper/Export.hs +5/−1
• Remote/WebDAV.hs +1/−1
• Types/Export.hs +2/−1
• Types/GitConfig.hs +2/−0
• Utility/Scheduled.hs +2/−1
• Utility/Split.hs +4/−0
• Utility/Url.hs +1/−2
• doc/git-annex.mdwn +10/−0
• git-annex.cabal +1/−1

@@ -28,6 +28,7 @@ 	checkAdjustedClone, 	isSupported, 	checkVersionSupported,+	isGitVersionSupported, ) where  import Annex.Common@@ -227,6 +228,7 @@ adjustToCrippledFileSystem :: Annex () adjustToCrippledFileSystem = do 	warning "Entering an adjusted branch where files are unlocked as this filesystem does not support locked files."+	checkVersionSupported 	whenM (isNothing <$> originalBranch) $ 		void $ inRepo $ Git.Branch.commitCommand Git.Branch.AutomaticCommit 			[ Param "--quiet"

@@ -12,6 +12,7 @@ 	inAnnex', 	inAnnexSafe, 	inAnnexCheck,+	objectFileExists, 	lockContentShared, 	lockContentForRemoval, 	ContentRemovalLock,@@ -130,6 +131,11 @@ 				, checkdirect locs 				) 			else checkdirect locs++{- Like inAnnex, checks if the object file for a key exists,+ - but there are no guarantees it has the right content. -}+objectFileExists :: Key -> Annex Bool+objectFileExists key = calcRepo (gitAnnexLocation key) >>= liftIO . doesFileExist  {- A safer check; the key's content must not only be present, but  - is not in the process of being removed. -}

@@ -55,7 +55,9 @@  - came first, and is fine, except for the problem of case-strict  - filesystems such as Linux VFAT (mounted with shortname=mixed),  - which do not allow using a directory "XX" when "xx" already exists.- - To support that, most repositories use the lower case hash for new data. -}+ - To support that, some git-annex repositories use the lower case-hash.+ - All special remotes use the lower-case hash for new data, but old data+ - may still used the mixed case hash. -} dirHashes :: [HashLevels -> Hasher] dirHashes = [hashDirLower, hashDirMixed] 

@@ -23,6 +23,7 @@ import qualified Git import qualified Git.Config import qualified Git.Objects+import qualified Git.LsFiles import qualified Annex.Branch import Logs.UUID import Logs.Trust.Basic@@ -32,11 +33,12 @@ import Annex.Version import Annex.Difference import Annex.UUID+import Annex.Link import Annex.WorkTree import Config import Config.Smudge import Annex.Direct-import Annex.AdjustedBranch+import qualified Annex.AdjustedBranch as AdjustedBranch import Annex.Environment import Annex.Hook import Annex.InodeSentinal@@ -114,13 +116,13 @@ 		unlessM isBareRepo $ do 			hookWrite postCheckoutHook 			hookWrite postMergeHook-	checkAdjustedClone >>= \case-		NeedUpgradeForAdjustedClone -> +	AdjustedBranch.checkAdjustedClone >>= \case+		AdjustedBranch.NeedUpgradeForAdjustedClone ->  			void $ upgrade True versionForAdjustedClone-		InAdjustedClone -> return ()-		NotInAdjustedClone ->+		AdjustedBranch.InAdjustedClone -> return ()+		AdjustedBranch.NotInAdjustedClone -> 			ifM (crippledFileSystem <&&> (not <$> isBareRepo))-				( adjustToCrippledFileSystem+				( adjustToCrippledFilesystem 				-- Handle case where this repo was cloned from a 				-- direct mode repo 				, unlessM isBareRepo@@ -282,3 +284,20 @@ propigateSecureHashesOnly = 	maybe noop (setConfig (ConfigKey "annex.securehashesonly")) 		=<< getGlobalConfig "annex.securehashesonly"++adjustToCrippledFilesystem :: Annex ()+adjustToCrippledFilesystem = ifM (liftIO $ AdjustedBranch.isGitVersionSupported)+	( do+		void $ upgrade True versionForCrippledFilesystem+		AdjustedBranch.adjustToCrippledFileSystem+	, enableDirectMode +	)++enableDirectMode :: Annex ()+enableDirectMode = unlessM isDirect $ do+	warning "Enabling direct mode."+	top <- fromRepo Git.repoPath+	(l, clean) <- inRepo $ Git.LsFiles.inRepo [top]+	forM_ l $ \f ->+		maybe noop (`toDirect` f) =<< isAnnexLink f+	void $ liftIO clean

@@ -28,6 +28,9 @@ versionForAdjustedClone :: RepoVersion versionForAdjustedClone = RepoVersion 7 +versionForCrippledFilesystem :: RepoVersion+versionForCrippledFilesystem = RepoVersion 7+ upgradableVersions :: [RepoVersion] #ifndef mingw32_HOST_OS upgradableVersions = map RepoVersion [0..6]

@@ -204,6 +204,7 @@ 			[ Param url 			, Param "--get-filename" 			, Param "--no-warnings"+			, Param "--no-playlist" 			] 		(Nothing, Just o, Just e, pid) <- liftIO $ createProcess 			(proc "youtube-dl" (toCommand opts))

@@ -1,3 +1,25 @@+git-annex (7.20181205) upstream; urgency=medium++  * Make bittorrent special remote work w/o btshowmetainfo installed+    when it was build with torrentparser.+    Thanks, Robert Schütz+  * When running youtube-dl to get a filename, pass --no-playlist.+  * Fix build without concurrent-output.+  * init: When a crippled filesystem causes an adjusted unlocked branch to+    be used, set repo version to 7, which it neglected to do before.+  * init: When on a crippled filesystem, and the git version is too old+    to use an adjusted unlocked branch, fall back to using direct mode.+  * info: When used with an exporttree remote, includes an "exportedtree"+    info, which is the tree last exported to the remote. During an export+    conflict, multiple values will be listed.+  * dropunused: When an unused object file has gotten modified, eg due to+    annex.thin being set, don't silently skip it, but display a warning+    and let --force drop it.+  * annex.cachecreds: New config to allow disabling of credentials caching+    for special remotes.++ -- Joey Hess <id@joeyh.name>  Wed, 05 Dec 2018 14:02:27 -0400+ git-annex (7.20181121) upstream; urgency=medium    * git-annex-shell: Fix hang when transferring the same objects to two

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010,2012 Joey Hess <id@joeyh.name>+ - Copyright 2010,2012,2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -8,6 +8,7 @@ module Command.DropUnused where  import Command+import qualified Annex import qualified Command.Drop import qualified Remote import qualified Git@@ -48,9 +49,19 @@ 		showAction $ "from " ++ Remote.name r 		Command.Drop.performRemote key (AssociatedFile Nothing) numcopies r 	Nothing -> ifM (inAnnex key)-		( Command.Drop.performLocal key (AssociatedFile Nothing) numcopies []-		, next (return True)+		( droplocal+		, ifM (objectFileExists key)+			( ifM (Annex.getState Annex.force)+				( droplocal+				, do+					warning "Annexed object has been modified and dropping it would probably lose the only copy. Run this command with --force if you want to drop it anyway."+					next $ return False+				)+			, next $ return True+			) 		)+  where+	droplocal = Command.Drop.performLocal key (AssociatedFile Nothing) numcopies []  performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform performOther filespec key = do

@@ -232,7 +232,7 @@ 	u <- getUUID 	return $ KeyContainer $ "annex-" ++ fromUUID u #else-uftpKey = KeyFile <$> cacheCredsFile "multicast"+uftpKey = KeyFile <$> credsFile "multicast" #endif  -- uftp needs a unique UID for each client and server, which 

@@ -13,9 +13,9 @@ 	getRemoteCredPairFor, 	warnMissingCredPairFor, 	getEnvCredPair,-	writeCacheCreds,-	readCacheCreds,-	cacheCredsFile,+	writeCreds,+	readCreds,+	credsFile, 	removeCreds, 	includeCredsInfo, ) where@@ -34,12 +34,12 @@ import qualified Data.Map as M import Utility.Base64 -{- A CredPair can be stored in a file, or in the environment, or perhaps+{- A CredPair can be stored in a file, or in the environment, or  - in a remote's configuration. -} data CredPairStorage = CredPairStorage 	{ credPairFile :: FilePath 	, credPairEnvironment :: (String, String)-	, credPairRemoteKey :: Maybe RemoteConfigKey+	, credPairRemoteKey :: RemoteConfigKey 	}  {- Stores creds in a remote's configuration, if the remote allows@@ -57,9 +57,9 @@ 	Nothing -> maybe (return c) (setRemoteCredPair encsetup c gc storage . Just) 		=<< getRemoteCredPair c gc storage 	Just creds-		| embedCreds c -> case credPairRemoteKey storage of-			Nothing -> localcache creds-			Just key -> storeconfig creds key =<< flip remoteCipher gc =<< localcache creds+		| embedCreds c ->+			let key = credPairRemoteKey storage+			in storeconfig creds key =<< flip remoteCipher gc =<< localcache creds 		| otherwise -> localcache creds   where 	localcache creds = do@@ -83,16 +83,15 @@   where 	fromenv = liftIO $ getEnvCredPair storage 	fromcache = maybe fromconfig (return . Just) =<< readCacheCredPair storage-	fromconfig = case credPairRemoteKey storage of-		Just key -> do-			mcipher <- remoteCipher' c gc-			case (M.lookup key c, mcipher) of-				(Nothing, _) -> return Nothing-				(Just enccreds, Just (cipher, storablecipher)) ->-					fromenccreds enccreds cipher storablecipher-				(Just bcreds, Nothing) ->-					fromcreds $ fromB64 bcreds-		Nothing -> return Nothing+	fromconfig = do+		let key = credPairRemoteKey storage+		mcipher <- remoteCipher' c gc+		case (M.lookup key c, mcipher) of+			(Nothing, _) -> return Nothing+			(Just enccreds, Just (cipher, storablecipher)) ->+				fromenccreds enccreds cipher storablecipher+			(Just bcreds, Nothing) ->+				fromcreds $ fromB64 bcreds 	fromenccreds enccreds cipher storablecipher = do 		cmd <- gpgCmd <$> Annex.getGitConfig 		mcreds <- liftIO $ catchMaybeIO $ decrypt cmd (c, gc) cipher@@ -140,34 +139,36 @@   where 	(uenv, penv) = credPairEnvironment storage +{- Writes a cred pair to local cache, unless prevented by configuration. -} writeCacheCredPair :: CredPair -> CredPairStorage -> Annex ()-writeCacheCredPair credpair storage =-	writeCacheCreds (encodeCredPair credpair) (credPairFile storage)+writeCacheCredPair credpair storage = +	whenM (annexCacheCreds <$> Annex.getGitConfig) $+		writeCreds (encodeCredPair credpair) (credPairFile storage) +readCacheCredPair :: CredPairStorage -> Annex (Maybe CredPair)+readCacheCredPair storage = maybe Nothing decodeCredPair+	<$> readCreds (credPairFile storage)++existsCacheCredPair :: CredPairStorage -> Annex Bool+existsCacheCredPair storage = +	liftIO . doesFileExist =<< credsFile (credPairFile storage)+ {- Stores the creds in a file inside gitAnnexCredsDir that only the user  - can read. -}-writeCacheCreds :: Creds -> FilePath -> Annex ()-writeCacheCreds creds file = do+writeCreds :: Creds -> FilePath -> Annex ()+writeCreds creds file = do 	d <- fromRepo gitAnnexCredsDir 	createAnnexDirectory d 	liftIO $ writeFileProtected (d </> file) creds -readCacheCredPair :: CredPairStorage -> Annex (Maybe CredPair)-readCacheCredPair storage = maybe Nothing decodeCredPair-	<$> readCacheCreds (credPairFile storage)--readCacheCreds :: FilePath -> Annex (Maybe Creds)-readCacheCreds f = liftIO . catchMaybeIO . readFileStrict =<< cacheCredsFile f+readCreds :: FilePath -> Annex (Maybe Creds)+readCreds f = liftIO . catchMaybeIO . readFileStrict =<< credsFile f -cacheCredsFile :: FilePath -> Annex FilePath-cacheCredsFile basefile = do+credsFile :: FilePath -> Annex FilePath+credsFile basefile = do 	d <- fromRepo gitAnnexCredsDir 	return $ d </> basefile -existsCacheCredPair :: CredPairStorage -> Annex Bool-existsCacheCredPair storage = -	liftIO . doesFileExist =<< cacheCredsFile (credPairFile storage)- encodeCredPair :: CredPair -> Creds encodeCredPair (l, p) = unlines [l, p] @@ -189,7 +190,7 @@ 		Just _ -> do 			let (uenv, penv) = credPairEnvironment storage 			ret $ "from environment variables (" ++ unwords [uenv, penv] ++ ")"-		Nothing -> case (`M.lookup` c) =<< credPairRemoteKey storage of+		Nothing -> case (`M.lookup` c) (credPairRemoteKey storage) of 			Nothing -> ifM (existsCacheCredPair storage) 				( ret "stored locally" 				, ret "not available"

@@ -26,8 +26,7 @@  {- Get a remote's name from the config key that specifies its location. -} remoteKeyToRemoteName :: String -> RemoteName-remoteKeyToRemoteName k = intercalate "." $-	reverse $ drop 1 $ reverse $ drop 1 $ splitc '.' k+remoteKeyToRemoteName k = intercalate "." $ dropFromEnd 1 $ drop 1 $ splitc '.' k  {- Construct a legal git remote name out of an arbitrary input string.  -

@@ -135,5 +135,5 @@ 		liftIO $ hFlush stdout 		a #else-hideRegionsWhile = id+hideRegionsWhile _ = id #endif

@@ -65,7 +65,7 @@ -- | Load known P2P addresses for this repository. loadP2PAddresses :: Annex [P2PAddress] loadP2PAddresses = mapMaybe unformatP2PAddress . maybe [] lines-	<$> readCacheCreds p2pAddressCredsFile+	<$> readCreds p2pAddressCredsFile  -- | Store a new P2P address for this repository. storeP2PAddress :: P2PAddress -> Annex ()@@ -74,9 +74,9 @@ 	unless (addr `elem` addrs) $ do 		let s = unlines $ map formatP2PAddress (addr:addrs) 		let tmpnam = p2pAddressCredsFile ++ ".new"-		writeCacheCreds s tmpnam-		tmpf <- cacheCredsFile tmpnam-		destf <- cacheCredsFile p2pAddressCredsFile+		writeCreds s tmpnam+		tmpf <- credsFile tmpnam+		destf <- credsFile p2pAddressCredsFile 		-- This may be run by root, so make the creds file 		-- and directory have the same owner and group as 		-- the git repository directory has.

@@ -25,7 +25,7 @@         . map T.pack         . lines         . fromMaybe []-        <$> readCacheCreds p2pAuthCredsFile+        <$> readCreds p2pAuthCredsFile  -- | Stores an AuthToken, making it be accepted by this repository. storeP2PAuthToken :: AuthToken -> Annex ()@@ -33,7 +33,7 @@ 	ts <- loadP2PAuthTokens' 	unless (t `elem` ts) $ do 		let d = unlines $ map (T.unpack . fromAuthToken) (t:ts)-		writeCacheCreds d p2pAuthCredsFile+		writeCreds d p2pAuthCredsFile  p2pAuthCredsFile :: FilePath p2pAuthCredsFile = "p2pauth"@@ -45,7 +45,7 @@ loadP2PRemoteAuthToken :: P2PAddress -> Annex (Maybe AuthToken) loadP2PRemoteAuthToken addr = maybe Nothing mk <$> getM id 	[ liftIO $ getEnv "GIT_ANNEX_P2P_AUTHTOKEN"-	, readCacheCreds (addressCredsFile addr)+	, readCreds (addressCredsFile addr) 	]   where 	mk = toAuthToken . T.pack . takeWhile (/= '\n')@@ -53,9 +53,9 @@ p2pAuthTokenEnv :: String p2pAuthTokenEnv = "GIT_ANNEX_P2P_AUTHTOKEN" --- | Stores the AuthToken o use when connecting with a given P2P address.+-- | Stores the AuthToken to use when connecting with a given P2P address. storeP2PRemoteAuthToken :: P2PAddress -> AuthToken -> Annex ()-storeP2PRemoteAuthToken addr t = writeCacheCreds+storeP2PRemoteAuthToken addr t = writeCreds 	(T.unpack $ fromAuthToken t) 	(addressCredsFile addr) 

@@ -288,7 +288,7 @@   where 	deps = 		[ "aria2c"-#ifndef TORRENT+#ifndef WITH_TORRENTPARSER 		, "btshowmetainfo" #endif 		]

@@ -438,7 +438,7 @@ 	credstorage setting = CredPairStorage 		{ credPairFile = base 		, credPairEnvironment = (base ++ "login", base ++ "password")-		, credPairRemoteKey = Just setting+		, credPairRemoteKey = setting 		} 	  where 		base = replace "/" "_" $ fromUUID (externalUUID external) ++ "-" ++ setting

@@ -23,7 +23,7 @@ creds u = CredPairStorage 	{ credPairFile = fromUUID u 	, credPairEnvironment = ("AWS_ACCESS_KEY_ID", "AWS_SECRET_ACCESS_KEY")-	, credPairRemoteKey = Just "s3creds"+	, credPairRemoteKey = "s3creds" 	}  data Service = S3 | Glacier

@@ -18,6 +18,8 @@ import Database.Export import Annex.Export import Config+import Git.Types (fromRef)+import Logs.Export  import qualified Data.Map as M import Control.Concurrent.STM@@ -186,8 +188,10 @@ 			, checkPresentCheap = False 			, mkUnavailable = return Nothing 			, getInfo = do+				ts <- map (fromRef . exportedTreeish)+					<$> getExport (uuid r) 				is <- getInfo r-				return (is++[("export", "yes")])+				return (is++[("export", "yes"), ("exportedtree", unwords ts)]) 			} 	retrieveKeyFileFromExport getexportlocs exportinconflict k _af dest p = unVerified $ 		if maybe False (isJust . verifyKeyContent) (maybeLookupBackendVariety (keyVariety k))

@@ -328,7 +328,7 @@ davCreds u = CredPairStorage 	{ credPairFile = fromUUID u 	, credPairEnvironment = ("WEBDAV_USERNAME", "WEBDAV_PASSWORD")-	, credPairRemoteKey = Just "davcreds"+	, credPairRemoteKey = "davcreds" 	}  {- Content-Type to use for files uploaded to WebDAV. -}

@@ -16,6 +16,7 @@ ) where  import Git.FilePath+import Utility.Split  import qualified System.FilePath.Posix as Posix @@ -50,4 +51,4 @@ 	subs ps (d:ds) = (d:ps) : subs (d:ps) ds  	dirs = map Posix.dropTrailingPathSeparator $-		reverse $ drop 1 $ reverse $ Posix.splitPath f+		dropFromEnd 1 $ Posix.splitPath f

@@ -102,6 +102,7 @@ 	, annexAllowUnverifiedDownloads :: Bool 	, annexMaxExtensionLength :: Maybe Int 	, annexJobs :: Concurrency+	, annexCacheCreds :: Bool 	, coreSymlinks :: Bool 	, coreSharedRepository :: SharedRepository 	, receiveDenyCurrentBranch :: DenyCurrentBranch@@ -177,6 +178,7 @@ 		getmaybe (annex "security.allow-unverified-downloads") 	, annexMaxExtensionLength = getmayberead (annex "maxextensionlength") 	, annexJobs = maybe NonConcurrent Concurrent $ getmayberead (annex "jobs")+	, annexCacheCreds = getbool (annex "cachecreds") True 	, coreSymlinks = getbool "core.symlinks" True 	, coreSharedRepository = getSharedRepository r 	, receiveDenyCurrentBranch = getDenyCurrentBranch r

@@ -30,6 +30,7 @@ import Utility.PartialPrelude import Utility.Misc import Utility.Tuple+import Utility.Split  import Data.List import Data.Time.Clock@@ -265,7 +266,7 @@ 	constructor "month" = Just Monthly 	constructor "year" = Just Yearly 	constructor u-		| "s" `isSuffixOf` u = constructor $ reverse $ drop 1 $ reverse u+		| "s" `isSuffixOf` u = constructor $ dropFromEnd 1 u 		| otherwise = Nothing 	withday sd u = do 		c <- constructor u

@@ -28,3 +28,7 @@ -- | same as Data.List.Utils.replace replace :: Eq a => [a] -> [a] -> [a] -> [a]  replace old new = intercalate new . split old++-- | Only traverses the list once while dropping the last n characters.+dropFromEnd :: Int -> [a] -> [a]+dropFromEnd n l = zipWith const l (drop n l)

@@ -278,8 +278,7 @@ contentDispositionFilename :: String -> Maybe FilePath contentDispositionFilename s 	| "attachment; filename=\"" `isPrefixOf` s && "\"" `isSuffixOf` s =-		Just $ reverse $ drop 1 $ reverse $ -			drop 1 $ dropWhile (/= '"') s+		Just $ dropFromEnd 1 $ drop 1 $ dropWhile (/= '"') s 	| otherwise = Nothing  headRequest :: Request -> Request

@@ -1160,6 +1160,16 @@   git-annex will wait up to this many seconds for the pid lock   file to go away, and will then abort if it cannot continue. Default: 300 +* `annex.cachecreds`++  When "true" (the default), git-annex will cache credentials used to+  access special remotes in files in .git/annex/creds/+  that only you can read. To disable that caching, set to "false",+  and credentials will only be read from the environment, or if+  they have been embedded in encrypted form in the git repository, will+  be extracted and decrypted each time git-annex needs to access the+  remote.+ * `remote.<name>.annex-cost`    When determining which repository to

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