diff options
Diffstat (limited to 'Remote')
| -rw-r--r-- | Remote/External.hs | 15 | ||||
| -rw-r--r-- | Remote/External/Types.hs | 35 |
2 files changed, 41 insertions, 9 deletions
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? |