implement CLAIMURL for external special remote
This commit is contained in:
parent
cb6e16947d
commit
ee27298b91
5 changed files with 29 additions and 5 deletions
|
@ -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
|
||||||
|
|
||||||
|
|
11
Remote/External/Types.hs
vendored
11
Remote/External/Types.hs
vendored
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue