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

add CHECKPRESENT

Browse source 
Using SUCCESS to mean the content is present and FAILURE to mean it's not.
This commit is contained in:
Joey Hess 2016-11-17 21:56:02 -04:00
parent cbffb61083
commit 27c8a4a229
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
1 changed files with 16 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

20
Remote/Helper/P2P.hs
View file

@ -13,6 +13,7 @@ module Remote.Helper.P2P (
runPure,
protoDump,
auth,
checkPresent,
remove,
get,
put,
@ -45,6 +46,7 @@ data Message
= AUTH UUID AuthToken -- uuid of the peer that is authenticating
| AUTH_SUCCESS UUID -- uuid of the remote peer
| AUTH_FAILURE
| CHECKPRESENT Key
| REMOVE Key
| GET Offset Key
| PUT Key
@ -77,7 +79,7 @@ data ProtoF next
-- content been transferred.
| CheckAuthToken UUID AuthToken (Bool -> next)
| SetPresent Key UUID next
| CheckPresent Key (Bool -> next)
| CheckContentPresent Key (Bool -> next)
-- ^ Checks if the whole content of the key is locally present.
| RemoveKeyFile Key (Bool -> next)
-- ^ If the key file is not present, still succeeds.
@ -101,8 +103,8 @@ runPure (Free (ReadKeyFile _ _ next)) ms = runPure (next L.empty) ms
runPure (Free (WriteKeyFile _ _ _ _ next)) ms = runPure (next True) ms
runPure (Free (CheckAuthToken _ _ next)) ms = runPure (next True) ms
runPure (Free (SetPresent _ _ next)) ms = runPure next ms
runPure (Free (CheckPresent _ next)) ms = runPure (next False) ms
runPure (Free (RemoveKeyFile _ next)) ms = runPure (next False) ms
runPure (Free (CheckContentPresent _ next)) ms = runPure (next False) ms
runPure (Free (RemoveKeyFile _ next)) ms = runPure (next True) ms
protoDump :: [(String, Maybe Message)] -> String
protoDump = unlines . map protoDump'
@ -122,6 +124,11 @@ auth myuuid t = do
sendMessage (PROTO_ERROR "auth failed")
return Nothing
checkPresent :: Key -> Proto Bool
checkPresent key = do
sendMessage (CHECKPRESENT key)
checkSuccess
remove :: Key -> Proto Bool
remove key = do
sendMessage (REMOVE key)
@ -176,11 +183,14 @@ serve myuuid = go Nothing
go autheduuid
authed _theiruuid r = case r of
CHECKPRESENT key -> do
ok <- checkContentPresent key
sendMessage $ if ok then SUCCESS else FAILURE
REMOVE key -> do
ok <- removeKeyFile key
sendMessage $ if ok then SUCCESS else FAILURE
PUT key -> do
have <- checkPresent key
have <- checkContentPresent key
if have
then sendMessage ALREADY_HAVE
else do
@ -241,6 +251,7 @@ instance Proto.Sendable Message where
formatMessage (AUTH uuid authtoken) = ["AUTH", Proto.serialize uuid, Proto.serialize authtoken]
formatMessage (AUTH_SUCCESS uuid) = ["AUTH-SUCCESS", Proto.serialize uuid]
formatMessage AUTH_FAILURE = ["AUTH-FAILURE"]
formatMessage (CHECKPRESENT key) = ["CHECKPRESENT", Proto.serialize key]
formatMessage (REMOVE key) = ["REMOVE", Proto.serialize key]
formatMessage (GET offset key) = ["GET", Proto.serialize offset, Proto.serialize key]
formatMessage (PUT key) = ["PUT", Proto.serialize key]
@ -255,6 +266,7 @@ instance Proto.Receivable Message where
parseCommand "AUTH" = Proto.parse2 AUTH
parseCommand "AUTH-SUCCESS" = Proto.parse1 AUTH_SUCCESS
parseCommand "AUTH-FAILURE" = Proto.parse0 AUTH_FAILURE
parseCommand "CHECKPRESENT" = Proto.parse1 CHECKPRESENT
parseCommand "REMOVE" = Proto.parse1 REMOVE
parseCommand "GET" = Proto.parse2 GET
parseCommand "PUT" = Proto.parse1 PUT