diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -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" diff --git a/Annex/Content.hs b/Annex/Content.hs --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -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. -} diff --git a/Annex/DirHashes.hs b/Annex/DirHashes.hs --- a/Annex/DirHashes.hs +++ b/Annex/DirHashes.hs @@ -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] diff --git a/Annex/Init.hs b/Annex/Init.hs --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -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 diff --git a/Annex/Version.hs b/Annex/Version.hs --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -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] diff --git a/Annex/YoutubeDl.hs b/Annex/YoutubeDl.hs --- a/Annex/YoutubeDl.hs +++ b/Annex/YoutubeDl.hs @@ -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)) diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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 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 diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010,2012 Joey Hess + - Copyright 2010,2012,2018 Joey Hess - - 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 diff --git a/Command/Multicast.hs b/Command/Multicast.hs --- a/Command/Multicast.hs +++ b/Command/Multicast.hs @@ -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 diff --git a/Creds.hs b/Creds.hs --- a/Creds.hs +++ b/Creds.hs @@ -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" diff --git a/Git/Remote.hs b/Git/Remote.hs --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -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. - diff --git a/Messages/Concurrent.hs b/Messages/Concurrent.hs --- a/Messages/Concurrent.hs +++ b/Messages/Concurrent.hs @@ -135,5 +135,5 @@ liftIO $ hFlush stdout a #else -hideRegionsWhile = id +hideRegionsWhile _ = id #endif diff --git a/P2P/Address.hs b/P2P/Address.hs --- a/P2P/Address.hs +++ b/P2P/Address.hs @@ -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. diff --git a/P2P/Auth.hs b/P2P/Auth.hs --- a/P2P/Auth.hs +++ b/P2P/Auth.hs @@ -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) diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs --- a/Remote/BitTorrent.hs +++ b/Remote/BitTorrent.hs @@ -288,7 +288,7 @@ where deps = [ "aria2c" -#ifndef TORRENT +#ifndef WITH_TORRENTPARSER , "btshowmetainfo" #endif ] diff --git a/Remote/External.hs b/Remote/External.hs --- a/Remote/External.hs +++ b/Remote/External.hs @@ -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 diff --git a/Remote/Helper/AWS.hs b/Remote/Helper/AWS.hs --- a/Remote/Helper/AWS.hs +++ b/Remote/Helper/AWS.hs @@ -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 diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs --- a/Remote/Helper/Export.hs +++ b/Remote/Helper/Export.hs @@ -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)) diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -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. -} diff --git a/Types/Export.hs b/Types/Export.hs --- a/Types/Export.hs +++ b/Types/Export.hs @@ -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 diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -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 diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs --- a/Utility/Scheduled.hs +++ b/Utility/Scheduled.hs @@ -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 diff --git a/Utility/Split.hs b/Utility/Split.hs --- a/Utility/Split.hs +++ b/Utility/Split.hs @@ -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) diff --git a/Utility/Url.hs b/Utility/Url.hs --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -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 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -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..annex-cost` When determining which repository to diff --git a/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 7.20181121 +Version: 7.20181205 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess