From e50372f632de988bbe48173081ba0367d7790193 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 17 Aug 2017 16:08:35 -0400 Subject: external: nice error message for keys with spaces in their name External special remotes will refuse to operate on keys with spaces in their names. That has never worked correctly due to the design of the external special remote protocol. Display an error message suggesting migration. Not super happy with this, but it's a pragmatic solution. Better than complicating the external special remote interface and all external special remotes. Note that I only made it use SafeKey in Request, not Response. git-annex does not construct a Response, so that would not add any safety. And presumably, if git-annex avoids feeding any such keys to an external special remote, it will never have a reason to make a Response using such a key. If it did, it would result in a protocol error anyway. There's still a Serializeable instance for Key; it's used by P2P.Protocol. There, the Key is always in the final position, so it's ok if it contains spaces. Note that the protocol documentation has been fixed to say that the File may contain spaces. One way that can happen, even though the Key can't, is when using direct mode, and the work tree filename contains spaces. When sending such a file to the external special remote the worktree filename is used. This commit was sponsored by Thom May on Patreon. --- Remote/External.hs | 15 ++++++++++----- Remote/External/Types.hs | 35 +++++++++++++++++++++++++++++++---- 2 files changed, 41 insertions(+), 9 deletions(-) (limited to 'Remote') diff --git a/Remote/External.hs b/Remote/External.hs index 0ac381b8c..32b95e9bb 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -134,7 +134,7 @@ externalSetup _ mu _ c gc = do store :: External -> Storer store external = fileStorer $ \k f p -> - handleRequest external (TRANSFER Upload k f) (Just p) $ \resp -> + handleRequestKey external (\sk -> TRANSFER Upload sk f) k (Just p) $ \resp -> case resp of TRANSFER_SUCCESS Upload k' | k == k' -> Just $ return True @@ -146,7 +146,7 @@ store external = fileStorer $ \k f p -> retrieve :: External -> Retriever retrieve external = fileRetriever $ \d k p -> - handleRequest external (TRANSFER Download k d) (Just p) $ \resp -> + handleRequestKey external (\sk -> TRANSFER Download sk d) k (Just p) $ \resp -> case resp of TRANSFER_SUCCESS Download k' | k == k' -> Just $ return () @@ -156,7 +156,7 @@ retrieve external = fileRetriever $ \d k p -> remove :: External -> Remover remove external k = safely $ - handleRequest external (REMOVE k) Nothing $ \resp -> + handleRequestKey external REMOVE k Nothing $ \resp -> case resp of REMOVE_SUCCESS k' | k == k' -> Just $ return True @@ -169,7 +169,7 @@ remove external k = safely $ checkKey :: External -> CheckPresent checkKey external k = either giveup id <$> go where - go = handleRequest external (CHECKPRESENT k) Nothing $ \resp -> + go = handleRequestKey external CHECKPRESENT k Nothing $ \resp -> case resp of CHECKPRESENT_SUCCESS k' | k' == k -> Just $ return $ Right True @@ -180,7 +180,7 @@ checkKey external k = either giveup id <$> go _ -> Nothing whereis :: External -> Key -> Annex [String] -whereis external k = handleRequest external (WHEREIS k) Nothing $ \resp -> case resp of +whereis external k = handleRequestKey external WHEREIS k Nothing $ \resp -> case resp of WHEREIS_SUCCESS s -> Just $ return [s] WHEREIS_FAILURE -> Just $ return [] UNSUPPORTED_REQUEST -> Just $ return [] @@ -212,6 +212,11 @@ handleRequest external req mp responsehandler = withExternalState external $ \st -> handleRequest' st external req mp responsehandler +handleRequestKey :: External -> (SafeKey -> Request) -> Key -> Maybe MeterUpdate -> (Response -> Maybe (Annex a)) -> Annex a +handleRequestKey external mkreq k mp responsehandler = case mkSafeKey k of + Right sk -> handleRequest external (mkreq sk) mp responsehandler + Left e -> giveup e + handleRequest' :: ExternalState -> External -> Request -> Maybe MeterUpdate -> (Response -> Maybe (Annex a)) -> Annex a handleRequest' st external req mp responsehandler | needsPREPARE req = do diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index ef8724ee7..cda934220 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -18,6 +18,8 @@ module Remote.External.Types ( Proto.Sendable(..), Proto.Receivable(..), Request(..), + SafeKey, + mkSafeKey, needsPREPARE, Response(..), RemoteRequest(..), @@ -36,11 +38,13 @@ import Types.Transfer (Direction(..)) import Config.Cost (Cost) import Types.Remote (RemoteConfig) import Types.Availability (Availability(..)) +import Types.Key import Utility.Url (URLString) import qualified Utility.SimpleProtocol as Proto import Control.Concurrent.STM import Network.URI +import Data.Char data External = External { externalType :: ExternalType @@ -77,6 +81,29 @@ type PID = Int data PrepareStatus = Unprepared | Prepared | FailedPrepare ErrorMsg +-- The protocol does not support keys with spaces in their names; +-- SafeKey can only be constructed for keys that are safe to use with the +-- protocol. +newtype SafeKey = SafeKey Key + deriving (Show) + +mkSafeKey :: Key -> Either String SafeKey +mkSafeKey k + | any isSpace (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=" + , formatKeyVariety (keyVariety k) + , " and pass it the name of the file" + ] + | otherwise = Right (SafeKey k) + +fromSafeKey :: SafeKey -> Key +fromSafeKey (SafeKey k) = k + +instance Proto.Serializable SafeKey where + serialize = Proto.serialize . fromSafeKey + deserialize = fmap SafeKey . Proto.deserialize + -- Messages that can be sent to the external remote to request it do something. data Request = PREPARE @@ -85,10 +112,10 @@ data Request | GETAVAILABILITY | CLAIMURL URLString | CHECKURL URLString - | TRANSFER Direction Key FilePath - | CHECKPRESENT Key - | REMOVE Key - | WHEREIS Key + | TRANSFER Direction SafeKey FilePath + | CHECKPRESENT SafeKey + | REMOVE SafeKey + | WHEREIS SafeKey deriving (Show) -- Does PREPARE need to have been sent before this request? -- cgit v1.2.3