diff options
| -rw-r--r-- | Remote/External.hs | 11 | ||||
| -rw-r--r-- | Remote/External/Types.hs | 11 | ||||
| -rw-r--r-- | Types/Remote.hs | 2 | ||||
| -rw-r--r-- | doc/design/external_special_remote_protocol.mdwn | 8 | ||||
| -rw-r--r-- | doc/todo/extensible_addurl.mdwn | 2 |
5 files changed, 29 insertions, 5 deletions
diff --git a/Remote/External.hs b/Remote/External.hs index a8526566f..97aa247ba 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -70,7 +70,7 @@ gen r u c gc = do mkUnavailable = gen r u c $ gc { remoteAnnexExternalType = Just "!dne!" }, getInfo = return [("externaltype", externaltype)], - claimUrl = Nothing + claimUrl = Just (claimurl external) } where externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc) @@ -416,3 +416,12 @@ getAvailability external r gc = maybe query return (remoteAnnexAvailability gc) _ -> Nothing setRemoteAvailability r avail return avail + +claimurl :: External -> URLString -> Annex Bool +claimurl external url = + handleRequest external (CLAIMURL url) Nothing $ \req -> case req of + CLAIMURL_SUCCESS -> Just $ return True + CLAIMURL_FAILURE -> Just $ return False + UNSUPPORTED_REQUEST -> Just $ return False + _ -> Nothing + diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index cdcb657ea..2fc29e5b4 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -39,6 +39,7 @@ import Logs.Transfer (Direction(..)) import Config.Cost (Cost) import Types.Remote (RemoteConfig) import Types.Availability (Availability(..)) +import Utility.Url (URLString) import qualified Utility.SimpleProtocol as Proto import Control.Concurrent.STM @@ -90,6 +91,7 @@ data Request | INITREMOTE | GETCOST | GETAVAILABILITY + | CLAIMURL URLString | TRANSFER Direction Key FilePath | CHECKPRESENT Key | REMOVE Key @@ -106,6 +108,7 @@ instance Proto.Sendable Request where formatMessage INITREMOTE = ["INITREMOTE"] formatMessage GETCOST = ["GETCOST"] formatMessage GETAVAILABILITY = ["GETAVAILABILITY"] + formatMessage (CLAIMURL url) = [ "CLAIMURL", Proto.serialize url ] formatMessage (TRANSFER direction key file) = [ "TRANSFER" , Proto.serialize direction @@ -130,6 +133,8 @@ data Response | AVAILABILITY Availability | INITREMOTE_SUCCESS | INITREMOTE_FAILURE ErrorMsg + | CLAIMURL_SUCCESS + | CLAIMURL_FAILURE | UNSUPPORTED_REQUEST deriving (Show) @@ -147,6 +152,8 @@ instance Proto.Receivable Response where parseCommand "AVAILABILITY" = Proto.parse1 AVAILABILITY parseCommand "INITREMOTE-SUCCESS" = Proto.parse0 INITREMOTE_SUCCESS parseCommand "INITREMOTE-FAILURE" = Proto.parse1 INITREMOTE_FAILURE + parseCommand "CLAIMURL-SUCCESS" = Proto.parse0 CLAIMURL_SUCCESS + parseCommand "CLAIMURL-FAILURE" = Proto.parse0 CLAIMURL_FAILURE parseCommand "UNSUPPORTED-REQUEST" = Proto.parse0 UNSUPPORTED_REQUEST parseCommand _ = Proto.parseFail @@ -165,8 +172,8 @@ data RemoteRequest | GETWANTED | SETSTATE Key String | GETSTATE Key - | SETURLPRESENT Key String - | SETURLMISSING Key String + | SETURLPRESENT Key URLString + | SETURLMISSING Key URLString | GETURLS Key String | DEBUG String deriving (Show) diff --git a/Types/Remote.hs b/Types/Remote.hs index 46a0648bb..3f71e1fb4 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -103,7 +103,7 @@ data RemoteA a = Remote { -- Information about the remote, for git annex info to display. getInfo :: a [(String, String)], -- Some remotes can download from an url (or uri). - claimUrl :: Maybe (URLString -> IO Bool) + claimUrl :: Maybe (URLString -> a Bool) } instance Show (RemoteA a) where diff --git a/doc/design/external_special_remote_protocol.mdwn b/doc/design/external_special_remote_protocol.mdwn index 00533095c..332cc37b1 100644 --- a/doc/design/external_special_remote_protocol.mdwn +++ b/doc/design/external_special_remote_protocol.mdwn @@ -125,6 +125,10 @@ replying with `UNSUPPORTED-REQUEST` is acceptable. If the remote replies with `UNSUPPORTED-REQUEST`, its availability is assumed to be global. So, only remotes that are only reachable locally need to worry about implementing this. +* `CLAIMURL Value` + Asks the remote if it wishes to claim responsibility for downloading + an url. If so, the remote should send back an `CLAIMURL-SUCCESS` reply. + If not, it can send `CLAIMURL-FAILURE`. More optional requests may be added, without changing the protocol version, so if an unknown request is seen, reply with `UNSUPPORTED-REQUEST`. @@ -167,6 +171,10 @@ while it's handling a request. Indicates the INITREMOTE succeeded and the remote is ready to use. * `INITREMOTE-FAILURE ErrorMsg` Indicates that INITREMOTE failed. +* `CLAIMURL-SUCCESS` + Indicates that the CLAIMURL url will be handled by this remote. +* `CLAIMURL-FAILURE` + Indicates that the CLAIMURL url wil not be handled by this remote. * `UNSUPPORTED-REQUEST` Indicates that the special remote does not know how to handle a request. diff --git a/doc/todo/extensible_addurl.mdwn b/doc/todo/extensible_addurl.mdwn index 0db4085d1..e9a8d070a 100644 --- a/doc/todo/extensible_addurl.mdwn +++ b/doc/todo/extensible_addurl.mdwn @@ -22,7 +22,7 @@ both available from CERN and from a torrent, for example. Solution: Add a new method to remotes: - claimUrl :: Maybe (URLString -> IO Bool) + claimUrl :: Maybe (URLString -> Annex Bool) Remotes that implement this method (including special remotes) will be queried when such an uri is added, to see which claims it. Once the |