implement CLAIMURL for external special remote

This commit is contained in:
Joey Hess 2014-12-08 13:57:13 -04:00
parent cb6e16947d
commit ee27298b91
5 changed files with 29 additions and 5 deletions

View file

@ -70,7 +70,7 @@ gen r u c gc = do
mkUnavailable = gen r u c $ mkUnavailable = gen r u c $
gc { remoteAnnexExternalType = Just "!dne!" }, gc { remoteAnnexExternalType = Just "!dne!" },
getInfo = return [("externaltype", externaltype)], getInfo = return [("externaltype", externaltype)],
claimUrl = Nothing claimUrl = Just (claimurl external)
} }
where where
externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc) externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)
@ -416,3 +416,12 @@ getAvailability external r gc = maybe query return (remoteAnnexAvailability gc)
_ -> Nothing _ -> Nothing
setRemoteAvailability r avail setRemoteAvailability r avail
return 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

View file

@ -39,6 +39,7 @@ import Logs.Transfer (Direction(..))
import Config.Cost (Cost) import Config.Cost (Cost)
import Types.Remote (RemoteConfig) import Types.Remote (RemoteConfig)
import Types.Availability (Availability(..)) import Types.Availability (Availability(..))
import Utility.Url (URLString)
import qualified Utility.SimpleProtocol as Proto import qualified Utility.SimpleProtocol as Proto
import Control.Concurrent.STM import Control.Concurrent.STM
@ -90,6 +91,7 @@ data Request
| INITREMOTE | INITREMOTE
| GETCOST | GETCOST
| GETAVAILABILITY | GETAVAILABILITY
| CLAIMURL URLString
| TRANSFER Direction Key FilePath | TRANSFER Direction Key FilePath
| CHECKPRESENT Key | CHECKPRESENT Key
| REMOVE Key | REMOVE Key
@ -106,6 +108,7 @@ instance Proto.Sendable Request where
formatMessage INITREMOTE = ["INITREMOTE"] formatMessage INITREMOTE = ["INITREMOTE"]
formatMessage GETCOST = ["GETCOST"] formatMessage GETCOST = ["GETCOST"]
formatMessage GETAVAILABILITY = ["GETAVAILABILITY"] formatMessage GETAVAILABILITY = ["GETAVAILABILITY"]
formatMessage (CLAIMURL url) = [ "CLAIMURL", Proto.serialize url ]
formatMessage (TRANSFER direction key file) = formatMessage (TRANSFER direction key file) =
[ "TRANSFER" [ "TRANSFER"
, Proto.serialize direction , Proto.serialize direction
@ -130,6 +133,8 @@ data Response
| AVAILABILITY Availability | AVAILABILITY Availability
| INITREMOTE_SUCCESS | INITREMOTE_SUCCESS
| INITREMOTE_FAILURE ErrorMsg | INITREMOTE_FAILURE ErrorMsg
| CLAIMURL_SUCCESS
| CLAIMURL_FAILURE
| UNSUPPORTED_REQUEST | UNSUPPORTED_REQUEST
deriving (Show) deriving (Show)
@ -147,6 +152,8 @@ instance Proto.Receivable Response where
parseCommand "AVAILABILITY" = Proto.parse1 AVAILABILITY parseCommand "AVAILABILITY" = Proto.parse1 AVAILABILITY
parseCommand "INITREMOTE-SUCCESS" = Proto.parse0 INITREMOTE_SUCCESS parseCommand "INITREMOTE-SUCCESS" = Proto.parse0 INITREMOTE_SUCCESS
parseCommand "INITREMOTE-FAILURE" = Proto.parse1 INITREMOTE_FAILURE 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 "UNSUPPORTED-REQUEST" = Proto.parse0 UNSUPPORTED_REQUEST
parseCommand _ = Proto.parseFail parseCommand _ = Proto.parseFail
@ -165,8 +172,8 @@ data RemoteRequest
| GETWANTED | GETWANTED
| SETSTATE Key String | SETSTATE Key String
| GETSTATE Key | GETSTATE Key
| SETURLPRESENT Key String | SETURLPRESENT Key URLString
| SETURLMISSING Key String | SETURLMISSING Key URLString
| GETURLS Key String | GETURLS Key String
| DEBUG String | DEBUG String
deriving (Show) deriving (Show)

View file

@ -103,7 +103,7 @@ data RemoteA a = Remote {
-- Information about the remote, for git annex info to display. -- Information about the remote, for git annex info to display.
getInfo :: a [(String, String)], getInfo :: a [(String, String)],
-- Some remotes can download from an url (or uri). -- Some remotes can download from an url (or uri).
claimUrl :: Maybe (URLString -> IO Bool) claimUrl :: Maybe (URLString -> a Bool)
} }
instance Show (RemoteA a) where instance Show (RemoteA a) where

View file

@ -125,6 +125,10 @@ replying with `UNSUPPORTED-REQUEST` is acceptable.
If the remote replies with `UNSUPPORTED-REQUEST`, its availability If the remote replies with `UNSUPPORTED-REQUEST`, its availability
is assumed to be global. So, only remotes that are only reachable is assumed to be global. So, only remotes that are only reachable
locally need to worry about implementing this. 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, More optional requests may be added, without changing the protocol version,
so if an unknown request is seen, reply with `UNSUPPORTED-REQUEST`. 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. Indicates the INITREMOTE succeeded and the remote is ready to use.
* `INITREMOTE-FAILURE ErrorMsg` * `INITREMOTE-FAILURE ErrorMsg`
Indicates that INITREMOTE failed. 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` * `UNSUPPORTED-REQUEST`
Indicates that the special remote does not know how to handle a request. Indicates that the special remote does not know how to handle a request.

View file

@ -22,7 +22,7 @@ both available from CERN and from a torrent, for example.
Solution: Add a new method to remotes: 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 Remotes that implement this method (including special remotes) will
be queried when such an uri is added, to see which claims it. Once the be queried when such an uri is added, to see which claims it. Once the