include all remotes back in

This commit is contained in:
Joey Hess 2019-12-02 12:26:33 -04:00
parent 1100e0d3c9
commit 650a631ef8
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
9 changed files with 31 additions and 27 deletions

View file

@ -269,7 +269,7 @@ listImportableContentsM serial adir = liftIO $
let (stat, fn) = separate (== '\t') l let (stat, fn) = separate (== '\t') l
sz = fromMaybe 0 (readish (takeWhile (/= ' ') stat)) sz = fromMaybe 0 (readish (takeWhile (/= ' ') stat))
cid = ContentIdentifier (encodeBS' stat) cid = ContentIdentifier (encodeBS' stat)
loc = mkImportLocation $ loc = mkImportLocation $ toRawFilePath $
Posix.makeRelative (fromAndroidPath adir) fn Posix.makeRelative (fromAndroidPath adir) fn
in Just (loc, (cid, sz)) in Just (loc, (cid, sz))
mk _ = Nothing mk _ = Nothing
@ -331,7 +331,7 @@ checkPresentExportWithContentIdentifierM serial adir _k loc knowncids =
androidExportLocation :: AndroidPath -> ExportLocation -> AndroidPath androidExportLocation :: AndroidPath -> ExportLocation -> AndroidPath
androidExportLocation adir loc = AndroidPath $ androidExportLocation adir loc = AndroidPath $
fromAndroidPath adir ++ "/" ++ fromExportLocation loc fromAndroidPath adir ++ "/" ++ fromRawFilePath (fromExportLocation loc)
-- | List all connected Android devices. -- | List all connected Android devices.
enumerateAdbConnected :: IO [AndroidSerial] enumerateAdbConnected :: IO [AndroidSerial]

View file

@ -1,6 +1,6 @@
{- Using bup as a remote. {- Using bup as a remote.
- -
- Copyright 2011-2014 Joey Hess <id@joeyh.name> - Copyright 2011-2019 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -8,6 +8,7 @@
module Remote.Bup (remote) where module Remote.Bup (remote) where
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.UTF8 (fromString) import Data.ByteString.Lazy.UTF8 (fromString)
@ -15,6 +16,7 @@ import Annex.Common
import qualified Annex import qualified Annex
import Types.Remote import Types.Remote
import Types.Creds import Types.Creds
import Git.Types (fromConfigKey)
import qualified Git import qualified Git
import qualified Git.Command import qualified Git.Command
import qualified Git.Config import qualified Git.Config
@ -207,12 +209,12 @@ storeBupUUID u buprepo = do
then do then do
showAction "storing uuid" showAction "storing uuid"
unlessM (onBupRemote r boolSystem "git" unlessM (onBupRemote r boolSystem "git"
[Param "config", Param "annex.uuid", Param v]) $ [Param "config", Param (fromConfigKey configkeyUUID), Param v]) $
giveup "ssh failed" giveup "ssh failed"
else liftIO $ do else liftIO $ do
r' <- Git.Config.read r r' <- Git.Config.read r
let olduuid = Git.Config.get "annex.uuid" "" r' let olduuid = Git.Config.get configkeyUUID mempty r'
when (olduuid == "") $ when (S.null olduuid) $
Git.Command.run Git.Command.run
[ Param "config" [ Param "config"
, Param "annex.uuid" , Param "annex.uuid"
@ -248,7 +250,7 @@ getBupUUID r u
| otherwise = liftIO $ do | otherwise = liftIO $ do
ret <- tryIO $ Git.Config.read r ret <- tryIO $ Git.Config.read r
case ret of case ret of
Right r' -> return (toUUID $ Git.Config.get "annex.uuid" "" r', r') Right r' -> return (toUUID $ Git.Config.get configkeyUUID mempty r', r')
Left _ -> return (NoUUID, r) Left _ -> return (NoUUID, r)
{- Converts a bup remote path spec into a Git.Repo. There are some {- Converts a bup remote path spec into a Git.Repo. There are some

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
{-# LANGUAGE OverloadedStrings #-}
module Remote.External (remote) where module Remote.External (remote) where
import Remote.External.Types import Remote.External.Types

View file

@ -384,12 +384,12 @@ instance Proto.Serializable URI where
deserialize = parseURI deserialize = parseURI
instance Proto.Serializable ExportLocation where instance Proto.Serializable ExportLocation where
serialize = fromExportLocation serialize = fromRawFilePath . fromExportLocation
deserialize = Just . mkExportLocation deserialize = Just . mkExportLocation . toRawFilePath
instance Proto.Serializable ExportDirectory where instance Proto.Serializable ExportDirectory where
serialize = fromExportDirectory serialize = fromRawFilePath . fromExportDirectory
deserialize = Just . mkExportDirectory deserialize = Just . mkExportDirectory . toRawFilePath
instance Proto.Serializable ExtensionList where instance Proto.Serializable ExtensionList where
serialize (ExtensionList l) = unwords l serialize (ExtensionList l) = unwords l

View file

@ -11,6 +11,7 @@ import Annex.Common
import Types.Remote import Types.Remote
import Types.Creds import Types.Creds
import qualified Git import qualified Git
import Git.Types (fromConfigKey)
import Config import Config
import Config.Cost import Config.Cost
import Annex.UUID import Annex.UUID
@ -107,19 +108,19 @@ hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)
lookupHook :: HookName -> Action -> Annex (Maybe String) lookupHook :: HookName -> Action -> Annex (Maybe String)
lookupHook hookname action = do lookupHook hookname action = do
command <- getConfig (annexConfig hook) "" command <- decodeBS' <$> getConfig hook mempty
if null command if null command
then do then do
fallback <- getConfig (annexConfig hookfallback) "" fallback <- decodeBS' <$> getConfig hookfallback mempty
if null fallback if null fallback
then do then do
warning $ "missing configuration for " ++ hook ++ " or " ++ hookfallback warning $ "missing configuration for " ++ fromConfigKey hook ++ " or " ++ fromConfigKey hookfallback
return Nothing return Nothing
else return $ Just fallback else return $ Just fallback
else return $ Just command else return $ Just command
where where
hook = hookname ++ "-" ++ action ++ "-hook" hook = annexConfig $ encodeBS' $ hookname ++ "-" ++ action ++ "-hook"
hookfallback = hookname ++ "-hook" hookfallback = annexConfig $ encodeBS' $ hookname ++ "-hook"
runHook :: HookName -> Action -> Key -> Maybe FilePath -> Annex Bool -> Annex Bool runHook :: HookName -> Action -> Key -> Maybe FilePath -> Annex Bool -> Annex Bool
runHook hook action k f a = maybe (return False) run =<< lookupHook hook action runHook hook action k f a = maybe (return False) run =<< lookupHook hook action

View file

@ -24,7 +24,6 @@ import qualified Git
import qualified Git.Config import qualified Git.Config
import qualified Remote.Git import qualified Remote.Git
{-
import qualified Remote.GCrypt import qualified Remote.GCrypt
import qualified Remote.P2P import qualified Remote.P2P
#ifdef WITH_S3 #ifdef WITH_S3
@ -45,12 +44,10 @@ import qualified Remote.Ddar
import qualified Remote.GitLFS import qualified Remote.GitLFS
import qualified Remote.Hook import qualified Remote.Hook
import qualified Remote.External import qualified Remote.External
-}
remoteTypes :: [RemoteType] remoteTypes :: [RemoteType]
remoteTypes = map adjustExportImportRemoteType remoteTypes = map adjustExportImportRemoteType
[ Remote.Git.remote [ Remote.Git.remote
{-
, Remote.GCrypt.remote , Remote.GCrypt.remote
, Remote.P2P.remote , Remote.P2P.remote
#ifdef WITH_S3 #ifdef WITH_S3
@ -71,7 +68,6 @@ remoteTypes = map adjustExportImportRemoteType
, Remote.GitLFS.remote , Remote.GitLFS.remote
, Remote.Hook.remote , Remote.Hook.remote
, Remote.External.remote , Remote.External.remote
-}
] ]
{- Builds a list of all available Remotes. {- Builds a list of all available Remotes.
@ -133,9 +129,7 @@ updateRemote remote = do
gitSyncableRemote :: Remote -> Bool gitSyncableRemote :: Remote -> Bool
gitSyncableRemote r = remotetype r `elem` gitSyncableRemote r = remotetype r `elem`
[ Remote.Git.remote [ Remote.Git.remote
{-
, Remote.GCrypt.remote , Remote.GCrypt.remote
, Remote.P2P.remote , Remote.P2P.remote
, Remote.GitLFS.remote , Remote.GitLFS.remote
-}
] ]

View file

@ -881,7 +881,8 @@ getBucketObject c = munge . serializeKey
_ -> getFilePrefix c ++ s _ -> getFilePrefix c ++ s
getBucketExportLocation :: RemoteConfig -> ExportLocation -> BucketObject getBucketExportLocation :: RemoteConfig -> ExportLocation -> BucketObject
getBucketExportLocation c loc = getFilePrefix c ++ fromExportLocation loc getBucketExportLocation c loc =
getFilePrefix c ++ fromRawFilePath (fromExportLocation loc)
getBucketImportLocation :: RemoteConfig -> BucketObject -> Maybe ImportLocation getBucketImportLocation :: RemoteConfig -> BucketObject -> Maybe ImportLocation
getBucketImportLocation c obj getBucketImportLocation c obj
@ -889,7 +890,8 @@ getBucketImportLocation c obj
| obj == uuidfile = Nothing | obj == uuidfile = Nothing
-- Only import files that are under the fileprefix, when -- Only import files that are under the fileprefix, when
-- one is configured. -- one is configured.
| prefix `isPrefixOf` obj = Just $ mkImportLocation $ drop prefixlen obj | prefix `isPrefixOf` obj = Just $ mkImportLocation $
toRawFilePath $ drop prefixlen obj
| otherwise = Nothing | otherwise = Nothing
where where
prefix = getFilePrefix c prefix = getFilePrefix c

View file

@ -229,7 +229,7 @@ removeExportDav r _k loc = case exportLocation loc of
removeExportDirectoryDav :: Remote -> ExportDirectory -> Annex Bool removeExportDirectoryDav :: Remote -> ExportDirectory -> Annex Bool
removeExportDirectoryDav r dir = withDAVHandle r $ \mh -> runExport mh $ \_dav -> do removeExportDirectoryDav r dir = withDAVHandle r $ \mh -> runExport mh $ \_dav -> do
let d = fromExportDirectory dir let d = fromRawFilePath $ fromExportDirectory dir
debugDav $ "delContent " ++ d debugDav $ "delContent " ++ d
safely (inLocation d delContentM) safely (inLocation d delContentM)
>>= maybe (return False) (const $ return True) >>= maybe (return False) (const $ return True)

View file

@ -17,6 +17,7 @@ import Utility.Url (URLString)
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
import Utility.Split import Utility.Split
#endif #endif
import Utility.FileSystemEncoding
import System.FilePath.Posix -- for manipulating url paths import System.FilePath.Posix -- for manipulating url paths
import Network.Protocol.HTTP.DAV (inDAVLocation, DAVT) import Network.Protocol.HTTP.DAV (inDAVLocation, DAVT)
@ -50,10 +51,12 @@ keyLocation k = keyDir k ++ keyFile k
- those. -} - those. -}
exportLocation :: ExportLocation -> Either String DavLocation exportLocation :: ExportLocation -> Either String DavLocation
exportLocation l = exportLocation l =
let p = fromExportLocation l let p = fromRawFilePath $ fromExportLocation l
in if any (`elem` p) ['#', '?'] in if any (`elem` p) illegalinurl
then Left ("Cannot store file containing '#' or '?' on webdav: " ++ p) then Left ("Cannot store file containing '#' or '?' on webdav: " ++ p)
else Right p else Right p
where
illegalinurl = ['#', '?'] :: [Char]
{- Where we store temporary data for a key as it's being uploaded. -} {- Where we store temporary data for a key as it's being uploaded. -}
keyTmpLocation :: Key -> DavLocation keyTmpLocation :: Key -> DavLocation