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

View file

@ -1,6 +1,6 @@
{- 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.
-}
@ -8,6 +8,7 @@
module Remote.Bup (remote) where
import qualified Data.Map as M
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.UTF8 (fromString)
@ -15,6 +16,7 @@ import Annex.Common
import qualified Annex
import Types.Remote
import Types.Creds
import Git.Types (fromConfigKey)
import qualified Git
import qualified Git.Command
import qualified Git.Config
@ -207,12 +209,12 @@ storeBupUUID u buprepo = do
then do
showAction "storing uuid"
unlessM (onBupRemote r boolSystem "git"
[Param "config", Param "annex.uuid", Param v]) $
[Param "config", Param (fromConfigKey configkeyUUID), Param v]) $
giveup "ssh failed"
else liftIO $ do
r' <- Git.Config.read r
let olduuid = Git.Config.get "annex.uuid" "" r'
when (olduuid == "") $
let olduuid = Git.Config.get configkeyUUID mempty r'
when (S.null olduuid) $
Git.Command.run
[ Param "config"
, Param "annex.uuid"
@ -248,7 +250,7 @@ getBupUUID r u
| otherwise = liftIO $ do
ret <- tryIO $ Git.Config.read r
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)
{- 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.
-}
{-# LANGUAGE OverloadedStrings #-}
module Remote.External (remote) where
import Remote.External.Types

View file

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

View file

@ -11,6 +11,7 @@ import Annex.Common
import Types.Remote
import Types.Creds
import qualified Git
import Git.Types (fromConfigKey)
import Config
import Config.Cost
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 = do
command <- getConfig (annexConfig hook) ""
command <- decodeBS' <$> getConfig hook mempty
if null command
then do
fallback <- getConfig (annexConfig hookfallback) ""
fallback <- decodeBS' <$> getConfig hookfallback mempty
if null fallback
then do
warning $ "missing configuration for " ++ hook ++ " or " ++ hookfallback
warning $ "missing configuration for " ++ fromConfigKey hook ++ " or " ++ fromConfigKey hookfallback
return Nothing
else return $ Just fallback
else return $ Just command
where
hook = hookname ++ "-" ++ action ++ "-hook"
hookfallback = hookname ++ "-hook"
hook = annexConfig $ encodeBS' $ hookname ++ "-" ++ action ++ "-hook"
hookfallback = annexConfig $ encodeBS' $ hookname ++ "-hook"
runHook :: HookName -> Action -> Key -> Maybe FilePath -> Annex Bool -> Annex Bool
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 Remote.Git
{-
import qualified Remote.GCrypt
import qualified Remote.P2P
#ifdef WITH_S3
@ -45,12 +44,10 @@ import qualified Remote.Ddar
import qualified Remote.GitLFS
import qualified Remote.Hook
import qualified Remote.External
-}
remoteTypes :: [RemoteType]
remoteTypes = map adjustExportImportRemoteType
[ Remote.Git.remote
{-
, Remote.GCrypt.remote
, Remote.P2P.remote
#ifdef WITH_S3
@ -71,7 +68,6 @@ remoteTypes = map adjustExportImportRemoteType
, Remote.GitLFS.remote
, Remote.Hook.remote
, Remote.External.remote
-}
]
{- Builds a list of all available Remotes.
@ -133,9 +129,7 @@ updateRemote remote = do
gitSyncableRemote :: Remote -> Bool
gitSyncableRemote r = remotetype r `elem`
[ Remote.Git.remote
{-
, Remote.GCrypt.remote
, Remote.P2P.remote
, Remote.GitLFS.remote
-}
]

View file

@ -881,7 +881,8 @@ getBucketObject c = munge . serializeKey
_ -> getFilePrefix c ++ s
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 c obj
@ -889,7 +890,8 @@ getBucketImportLocation c obj
| obj == uuidfile = Nothing
-- Only import files that are under the fileprefix, when
-- one is configured.
| prefix `isPrefixOf` obj = Just $ mkImportLocation $ drop prefixlen obj
| prefix `isPrefixOf` obj = Just $ mkImportLocation $
toRawFilePath $ drop prefixlen obj
| otherwise = Nothing
where
prefix = getFilePrefix c

View file

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

View file

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