add GETAVAILABILITY to external special remote protocol

And some reworking of types, and added an annex-availability git config
setting.

Assistant/DaemonStatus.hs

@@ -64,7 +64,7 @@ calcSyncRemotes = do
 		, syncingToCloudRemote = any iscloud syncdata
 		}
   where
-  	iscloud r = not (Remote.readonly r) && Remote.globallyAvailable r
+  	iscloud r = not (Remote.readonly r) && Remote.availability r == Remote.GloballyAvailable
 
 {- Updates the syncRemotes list from the list of all remotes in Annex state. -}
 updateSyncRemotes :: Assistant ()

Config.hs

@@ -1,6 +1,6 @@
 {- Git configuration
  -
- - 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.
  -}
@@ -13,6 +13,7 @@ import qualified Git.Config
 import qualified Git.Command
 import qualified Annex
 import Config.Cost
+import Types.Availability
 
 type UnqualifiedConfigKey = String
 data ConfigKey = ConfigKey String
@@ -65,6 +66,9 @@ remoteCost' c = case remoteAnnexCostCommand c of
 setRemoteCost :: Git.Repo -> Cost -> Annex ()
 setRemoteCost r c = setConfig (remoteConfig r "cost") (show c)
 
+setRemoteAvailability :: Git.Repo -> Availability -> Annex ()
+setRemoteAvailability r c = setConfig (remoteConfig r "availability") (show c)
+
 getNumCopies :: Maybe Int -> Annex Int
 getNumCopies (Just v) = return v
 getNumCopies Nothing = annexNumCopies <$> Annex.getGitConfig

Remote/Bup.hs

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

Remote/Directory.hs

@@ -61,7 +61,7 @@ gen r u c gc = do
 			gitconfig = gc,
 			localpath = Just dir,
 			readonly = False,
-			globallyAvailable = False,
+			availability = LocallyAvailable,
 			remotetype = remote
 		}
   where

Remote/External.hs

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

Remote/External/Types.hs

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

Remote/GCrypt.hs

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

Remote/Git.hs

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

Remote/Glacier.hs

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

Remote/Helper/Git.hs

@@ -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
+localpathCalc r
-	then Nothing
+	| availabilityCalc r == GloballyAvailable = Nothing
-	else Just $ Git.repoPath r
+	| otherwise = Just $ Git.repoPath r
 
-globallyAvailableCalc :: Git.Repo -> Bool
+availabilityCalc :: Git.Repo -> Availability
-globallyAvailableCalc r = not $
+availabilityCalc r
-	Git.repoIsLocal r || Git.repoIsLocalUnknown 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. -}

Remote/Hook.hs

@@ -59,7 +59,7 @@ gen r u c gc = do
 			repo = r,
 			gitconfig = gc,
 			readonly = False,
-			globallyAvailable = False,
+			availability = GloballyAvailable,
 			remotetype = remote
 		}
   where

Remote/Rsync.hs

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

Remote/S3.hs

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

Remote/Tahoe.hs

@@ -81,7 +81,7 @@ gen r u c gc = do
 		gitconfig = gc,
 		localpath = Nothing,
 		readonly = False,
-		globallyAvailable = True,
+		availability = GloballyAvailable,
 		remotetype = remote
 	}
 

Remote/Web.hs

@@ -61,7 +61,7 @@ gen r _ c gc =
 		localpath = Nothing,
 		repo = r,
 		readonly = True,
-		globallyAvailable = True,
+		availability = GloballyAvailable,
 		remotetype = remote
 	}
 

Remote/WebDAV.hs

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

Types/Availability.hs

@@ -0,0 +1,11 @@
+{- git-annex remote availability
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.Availability where
+
+data Availability = GloballyAvailable | LocallyAvailable
+	deriving (Eq, Show, Read)

Types/GitConfig.hs

@@ -18,6 +18,7 @@ import qualified Git.Config
 import Utility.DataUnits
 import Config.Cost
 import Types.Distribution
+import Types.Availability
 
 {- Main git-annex settings. Each setting corresponds to a git-config key
  - such as annex.foo -}
@@ -101,6 +102,7 @@ data RemoteGitConfig = RemoteGitConfig
 	, remoteAnnexTrustLevel :: Maybe String
 	, remoteAnnexStartCommand :: Maybe String
 	, remoteAnnexStopCommand :: Maybe String
+	, remoteAnnexAvailability :: Maybe Availability
 
 	{- These settings are specific to particular types of remotes
 	 - including special remotes. -}
@@ -130,6 +132,7 @@ extractRemoteGitConfig r remotename = RemoteGitConfig
 	, remoteAnnexTrustLevel = notempty $ getmaybe "trustlevel"
 	, remoteAnnexStartCommand = notempty $ getmaybe "start-command"
 	, remoteAnnexStopCommand = notempty $ getmaybe "stop-command"
+	, remoteAnnexAvailability = getmayberead "availability"
 
 	, remoteAnnexSshOptions = getoptions "ssh-options"
 	, remoteAnnexRsyncOptions = getoptions "rsync-options"

Types/Remote.hs

@@ -2,12 +2,19 @@
  -
  - Most things should not need this, using Types instead
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Types.Remote where
+module Types.Remote
+	( RemoteConfigKey
+	, RemoteConfig
+	, RemoteTypeA(..)
+	, RemoteA(..)
+	, Availability(..)
+	)
+	where
 
 import Data.Map as M
 import Data.Ord
@@ -16,6 +23,7 @@ import qualified Git
 import Types.Key
 import Types.UUID
 import Types.GitConfig
+import Types.Availability
 import Config.Cost
 import Utility.Metered
 import Git.Types
@@ -82,7 +90,7 @@ data RemoteA a = Remote {
 	-- a Remote can be known to be readonly
 	readonly :: Bool,
 	-- a Remote can be globally available. (Ie, "in the cloud".)
-	globallyAvailable :: Bool,
+	availability :: Availability,
 	-- the type of the remote
 	remotetype :: RemoteTypeA a
 }

debian/changelog

@@ -1,7 +1,7 @@
 git-annex (5.20140108) UNRELEASED; urgency=medium
 
   * Added tahoe special remote.
-  * external special remote protocol: Added GETGITDIR.
+  * external special remote protocol: Added GETGITDIR, and GETAVAILABILITY.
 
  -- Joey Hess <joeyh@debian.org>  Wed, 08 Jan 2014 13:13:54 -0400
 

doc/design/external_special_remote_protocol.mdwn

@@ -118,6 +118,11 @@ replying with `UNSUPPORTED-REQUEST` is acceptable.
 * `GETCOST`  
   Requests the remote return a use cost. Higher costs are more expensive.
   (See Config/Cost.hs for some standard costs.)
+* `GETAVAILABILITY`
+  Requests the remote send back an `AVAILABILITY` reply.
+  If the remote replies with `UNSUPPORTED-REQUEST`, its availability
+  is asssumed to be global. So, only remotes that are only reachable
+  locally need to worry about implementing this.
 
 More optional requests may be added, without changing the protocol version,
 so if an unknown request is seen, reply with `UNSUPPORTED-REQUEST`.
@@ -153,6 +158,9 @@ while it's handling a request.
   Indicates that the key was unable to be removed from the remote.
 * `COST Int`  
   Indicates the cost of the remote.
+* `AVAILABILITY GLOBAL|LOCAL`
+  Indicates if the remote is globally or only locally available.
+  (Ie stored in the cloud vs on a local disk.)
 * `INITREMOTE-SUCCESS`  
   Indicates the INITREMOTE succeeded and the remote is ready to use.
 * `INITREMOTE-FAILURE ErrorMsg`  

doc/git-annex.mdwn

@@ -1297,6 +1297,11 @@ Here are all the supported configuration settings.
   configured by the trust and untrust commands. The value can be any of
   "trusted", "semitrusted" or "untrusted".
 
+* `remote.<name>.availability`
+
+  Can be used to tell git-annex whether a remote is LocallyAvailable
+  or GloballyAvailable. Normally, git-annex determines this automatically.
+
 * `remote.<name>.annex-ssh-options`
 
   Options to use when using ssh to talk to this remote.