mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

implement CLAIMURL for external special remote

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

11
Remote/External.hs
View file

@ -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

11
Remote/External/Types.hs vendored
View file

@ -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)