add GETAVAILABILITY to external special remote protocol
And some reworking of types, and added an annex-availability git config setting.
This commit is contained in:
parent
47d2ebd374
commit
c20f31a1ad
22 changed files with 99 additions and 26 deletions
|
@ -72,7 +72,7 @@ gen r u c gc = do
|
|||
then Just buprepo
|
||||
else Nothing
|
||||
, remotetype = remote
|
||||
, globallyAvailable = not $ bupLocal buprepo
|
||||
, availability = if bupLocal buprepo then LocallyAvailable else GloballyAvailable
|
||||
, readonly = False
|
||||
}
|
||||
return $ Just $ encryptableRemote c
|
||||
|
|
|
@ -61,7 +61,7 @@ gen r u c gc = do
|
|||
gitconfig = gc,
|
||||
localpath = Just dir,
|
||||
readonly = False,
|
||||
globallyAvailable = False,
|
||||
availability = LocallyAvailable,
|
||||
remotetype = remote
|
||||
}
|
||||
where
|
||||
|
|
|
@ -45,6 +45,7 @@ gen r u c gc = do
|
|||
external <- newExternal externaltype u c
|
||||
Annex.addCleanup (fromUUID u) $ stopExternal external
|
||||
cst <- getCost external r gc
|
||||
avail <- getAvailability external r gc
|
||||
return $ Just $ encryptableRemote c
|
||||
(storeEncrypted external $ getGpgEncParams (c,gc))
|
||||
(retrieveEncrypted external)
|
||||
|
@ -66,11 +67,11 @@ gen r u c gc = do
|
|||
repo = r,
|
||||
gitconfig = gc,
|
||||
readonly = False,
|
||||
globallyAvailable = False,
|
||||
availability = avail,
|
||||
remotetype = remote
|
||||
}
|
||||
where
|
||||
externaltype = fromMaybe (error "missing externaltype") $ remoteAnnexExternalType gc
|
||||
externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)
|
||||
|
||||
externalSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||
externalSetup mu c = do
|
||||
|
@ -419,3 +420,21 @@ getCost external r gc = go =<< remoteCost' gc
|
|||
_ -> Nothing
|
||||
setRemoteCost r c
|
||||
return c
|
||||
|
||||
{- Caches the availability in the git config to avoid needing to start up an
|
||||
- external special remote every time time just to ask it what its
|
||||
- availability is.
|
||||
-
|
||||
- Most remotes do not bother to implement a reply to this request;
|
||||
- globally available is the default.
|
||||
-}
|
||||
getAvailability :: External -> Git.Repo -> RemoteGitConfig -> Annex Availability
|
||||
getAvailability external r gc = maybe query return (remoteAnnexAvailability gc)
|
||||
where
|
||||
query = do
|
||||
avail <- handleRequest external GETAVAILABILITY Nothing $ \req -> case req of
|
||||
AVAILABILITY avail -> Just $ return avail
|
||||
UNSUPPORTED_REQUEST -> Just $ return GloballyAvailable
|
||||
_ -> Nothing
|
||||
setRemoteAvailability r avail
|
||||
return avail
|
||||
|
|
13
Remote/External/Types.hs
vendored
13
Remote/External/Types.hs
vendored
|
@ -38,6 +38,7 @@ import Utility.Metered (BytesProcessed(..))
|
|||
import Logs.Transfer (Direction(..))
|
||||
import Config.Cost (Cost)
|
||||
import Types.Remote (RemoteConfig)
|
||||
import Types.Availability (Availability(..))
|
||||
|
||||
import Data.Char
|
||||
import Control.Concurrent.STM
|
||||
|
@ -105,6 +106,7 @@ data Request
|
|||
= PREPARE
|
||||
| INITREMOTE
|
||||
| GETCOST
|
||||
| GETAVAILABILITY
|
||||
| TRANSFER Direction Key FilePath
|
||||
| CHECKPRESENT Key
|
||||
| REMOVE Key
|
||||
|
@ -120,6 +122,7 @@ instance Sendable Request where
|
|||
formatMessage PREPARE = ["PREPARE"]
|
||||
formatMessage INITREMOTE = ["INITREMOTE"]
|
||||
formatMessage GETCOST = ["GETCOST"]
|
||||
formatMessage GETAVAILABILITY = ["GETAVAILABILITY"]
|
||||
formatMessage (TRANSFER direction key file) =
|
||||
[ "TRANSFER", serialize direction, serialize key, serialize file ]
|
||||
formatMessage (CHECKPRESENT key) = [ "CHECKPRESENT", serialize key ]
|
||||
|
@ -137,6 +140,7 @@ data Response
|
|||
| REMOVE_SUCCESS Key
|
||||
| REMOVE_FAILURE Key ErrorMsg
|
||||
| COST Cost
|
||||
| AVAILABILITY Availability
|
||||
| INITREMOTE_SUCCESS
|
||||
| INITREMOTE_FAILURE ErrorMsg
|
||||
| UNSUPPORTED_REQUEST
|
||||
|
@ -153,6 +157,7 @@ instance Receivable Response where
|
|||
parseCommand "REMOVE-SUCCESS" = parse1 REMOVE_SUCCESS
|
||||
parseCommand "REMOVE-FAILURE" = parse2 REMOVE_FAILURE
|
||||
parseCommand "COST" = parse1 COST
|
||||
parseCommand "AVAILABILITY" = parse1 AVAILABILITY
|
||||
parseCommand "INITREMOTE-SUCCESS" = parse0 INITREMOTE_SUCCESS
|
||||
parseCommand "INITREMOTE-FAILURE" = parse1 INITREMOTE_FAILURE
|
||||
parseCommand "UNSUPPORTED-REQUEST" = parse0 UNSUPPORTED_REQUEST
|
||||
|
@ -252,6 +257,14 @@ instance Serializable Cost where
|
|||
serialize = show
|
||||
deserialize = readish
|
||||
|
||||
instance Serializable Availability where
|
||||
serialize GloballyAvailable = "GLOBAL"
|
||||
serialize LocallyAvailable = "LOCAL"
|
||||
|
||||
deserialize "GLOBAL" = Just GloballyAvailable
|
||||
deserialize "LOCAL" = Just LocallyAvailable
|
||||
deserialize _ = Nothing
|
||||
|
||||
instance Serializable BytesProcessed where
|
||||
serialize (BytesProcessed n) = show n
|
||||
deserialize = BytesProcessed <$$> readish
|
||||
|
|
|
@ -114,7 +114,7 @@ gen' r u c gc = do
|
|||
, repo = r
|
||||
, gitconfig = gc { remoteGitConfig = Just $ extractGitConfig r }
|
||||
, readonly = Git.repoIsHttp r
|
||||
, globallyAvailable = globallyAvailableCalc r
|
||||
, availability = availabilityCalc r
|
||||
, remotetype = remote
|
||||
}
|
||||
return $ Just $ encryptableRemote c
|
||||
|
|
|
@ -126,7 +126,7 @@ gen r u c gc
|
|||
, gitconfig = gc
|
||||
{ remoteGitConfig = Just $ extractGitConfig r }
|
||||
, readonly = Git.repoIsHttp r
|
||||
, globallyAvailable = globallyAvailableCalc r
|
||||
, availability = availabilityCalc r
|
||||
, remotetype = remote
|
||||
}
|
||||
|
||||
|
|
|
@ -66,7 +66,7 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
|
|||
gitconfig = gc,
|
||||
localpath = Nothing,
|
||||
readonly = False,
|
||||
globallyAvailable = True,
|
||||
availability = GloballyAvailable,
|
||||
remotetype = remote
|
||||
}
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{- Utilities for git remotes.
|
||||
-
|
||||
- Copyright 2011-2012 Joey Hess <joey@kitenet.net>
|
||||
- Copyright 2011-2014 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
@ -9,18 +9,20 @@ module Remote.Helper.Git where
|
|||
|
||||
import Common.Annex
|
||||
import qualified Git
|
||||
import Types.Availability
|
||||
|
||||
repoCheap :: Git.Repo -> Bool
|
||||
repoCheap = not . Git.repoIsUrl
|
||||
|
||||
localpathCalc :: Git.Repo -> Maybe FilePath
|
||||
localpathCalc r = if globallyAvailableCalc r
|
||||
then Nothing
|
||||
else Just $ Git.repoPath r
|
||||
localpathCalc r
|
||||
| availabilityCalc r == GloballyAvailable = Nothing
|
||||
| otherwise = Just $ Git.repoPath r
|
||||
|
||||
globallyAvailableCalc :: Git.Repo -> Bool
|
||||
globallyAvailableCalc r = not $
|
||||
Git.repoIsLocal r || Git.repoIsLocalUnknown r
|
||||
availabilityCalc :: Git.Repo -> Availability
|
||||
availabilityCalc r
|
||||
| (Git.repoIsLocal r || Git.repoIsLocalUnknown r) = LocallyAvailable
|
||||
| otherwise = GloballyAvailable
|
||||
|
||||
{- Avoids performing an action on a local repository that's not usable.
|
||||
- Does not check that the repository is still available on disk. -}
|
||||
|
|
|
@ -59,7 +59,7 @@ gen r u c gc = do
|
|||
repo = r,
|
||||
gitconfig = gc,
|
||||
readonly = False,
|
||||
globallyAvailable = False,
|
||||
availability = GloballyAvailable,
|
||||
remotetype = remote
|
||||
}
|
||||
where
|
||||
|
|
|
@ -88,7 +88,7 @@ gen r u c gc = do
|
|||
then Just $ rsyncUrl o
|
||||
else Nothing
|
||||
, readonly = False
|
||||
, globallyAvailable = not islocal
|
||||
, availability = if islocal then LocallyAvailable else GloballyAvailable
|
||||
, remotetype = remote
|
||||
}
|
||||
|
||||
|
|
|
@ -69,7 +69,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
|
|||
gitconfig = gc,
|
||||
localpath = Nothing,
|
||||
readonly = False,
|
||||
globallyAvailable = True,
|
||||
availability = GloballyAvailable,
|
||||
remotetype = remote
|
||||
}
|
||||
|
||||
|
|
|
@ -81,7 +81,7 @@ gen r u c gc = do
|
|||
gitconfig = gc,
|
||||
localpath = Nothing,
|
||||
readonly = False,
|
||||
globallyAvailable = True,
|
||||
availability = GloballyAvailable,
|
||||
remotetype = remote
|
||||
}
|
||||
|
||||
|
|
|
@ -61,7 +61,7 @@ gen r _ c gc =
|
|||
localpath = Nothing,
|
||||
repo = r,
|
||||
readonly = True,
|
||||
globallyAvailable = True,
|
||||
availability = GloballyAvailable,
|
||||
remotetype = remote
|
||||
}
|
||||
|
||||
|
|
|
@ -72,7 +72,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
|
|||
gitconfig = gc,
|
||||
localpath = Nothing,
|
||||
readonly = False,
|
||||
globallyAvailable = True,
|
||||
availability = GloballyAvailable,
|
||||
remotetype = remote
|
||||
}
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue