external special remotes mostly implemented (untested)

This has not been tested at all. It compiles!

The only known missing things are support for encryption, and for get/set
of special remote configuration, and of key state. (The latter needs
separate work to add a new per-key log file to store that state.)

Only thing I don't much like is that initremote needs to be passed both
type=external and externaltype=foo. It would be better to have just
type=foo

Most of this is quite straightforward code, that largely wrote itself given
the types. The only tricky parts were:

* Need to lock the remote when using it to eg make a request, because
  in theory git-annex could have multiple threads that each try to use
  a remote at the same time. I don't think that git-annex ever does
  that currently, but better safe than sorry.

* Rather than starting up every external special remote program when
  git-annex starts, they are started only on demand, when first used.
  This will avoid slowdown, especially when running fast git-annex query
  commands. Once started, they keep running until git-annex stops, currently,
  which may not be ideal, but it's hard to know a better time to stop them.

* Bit of a chicken and egg problem with caching the cost of the remote,
  because setting annex-cost in the git config needs the remote to already
  be set up. Managed to finesse that.

This commit was sponsored by Lukas Anzinger.

Assistant/Pairing/MakeRemote.hs

@@ -15,6 +15,7 @@ import Assistant.MakeRemote
 import Assistant.Sync
 import Config.Cost
 import Config
+import qualified Types.Remote as Remote
 
 import Network.Socket
 import qualified Data.Text as T
@@ -46,7 +47,7 @@ finishedLocalPairing msg keypair = do
 			]
 			Nothing
 	r <- liftAnnex $ addRemote $ makeSshRemote sshdata
-	liftAnnex $ setRemoteCost r semiExpensiveRemoteCost
+	liftAnnex $ setRemoteCost (Remote.repo r) semiExpensiveRemoteCost
 	syncRemote r
 
 {- Mostly a straightforward conversion.  Except:

Assistant/WebApp/MakeRemote.hs

@@ -14,6 +14,7 @@ import Assistant.Common
 import Assistant.WebApp.Types
 import Assistant.Sync
 import qualified Remote
+import qualified Types.Remote as Remote
 import qualified Config
 import Config.Cost
 import Types.StandardGroups
@@ -31,6 +32,6 @@ setupCloudRemote defaultgroup mcost maker = do
 	r <- liftAnnex $ addRemote maker
 	liftAnnex $ do
 		setStandardGroup (Remote.uuid r) defaultgroup
-		maybe noop (Config.setRemoteCost r) mcost
+		maybe noop (Config.setRemoteCost (Remote.repo r)) mcost
 	liftAssistant $ syncRemote r
 	redirect $ EditNewCloudRepositoryR $ Remote.uuid r

Assistant/WebApp/RepoList.hs

@@ -223,7 +223,7 @@ getRepositoriesReorderR = do
 		rs <- catMaybes <$> mapM Remote.remoteFromUUID list
 		forM_ (reorderCosts remote rs) $ \(r, newcost) ->
 			when (Remote.cost r /= newcost) $
-				setRemoteCost r newcost
+				setRemoteCost (Remote.repo r) newcost
 		void remoteListRefresh
   	fromjs = toUUID . T.unpack
 

Config.hs

@@ -12,7 +12,6 @@ import qualified Git
 import qualified Git.Config
 import qualified Git.Command
 import qualified Annex
-import qualified Types.Remote as Remote
 import Config.Cost
 
 type UnqualifiedConfigKey = String
@@ -55,14 +54,16 @@ annexConfig key = ConfigKey $ "annex." ++ key
  - by remote.<name>.annex-cost, or if remote.<name>.annex-cost-command
  - is set and prints a number, that is used. -}
 remoteCost :: RemoteGitConfig -> Cost -> Annex Cost
-remoteCost c def = case remoteAnnexCostCommand c of
+remoteCost c def = fromMaybe def <$> remoteCost' c
-	Just cmd | not (null cmd) -> liftIO $
-		(fromMaybe def . readish) <$>
-			readProcess "sh" ["-c", cmd]
-	_ -> return $ fromMaybe def $ remoteAnnexCost c
 
-setRemoteCost :: Remote -> Cost -> Annex ()
+remoteCost' :: RemoteGitConfig -> Annex (Maybe Cost)
-setRemoteCost r c = setConfig (remoteConfig (Remote.repo r) "cost") (show c)
+remoteCost' c = case remoteAnnexCostCommand c of
+	Just cmd | not (null cmd) -> liftIO $
+		readish <$> readProcess "sh" ["-c", cmd]
+	_ -> return $ remoteAnnexCost c
+
+setRemoteCost :: Git.Repo -> Cost -> Annex ()
+setRemoteCost r c = setConfig (remoteConfig r "cost") (show c)
 
 getNumCopies :: Maybe Int -> Annex Int
 getNumCopies (Just v) = return v

Remote/External.hs

@@ -5,15 +5,12 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
-
 module Remote.External (remote) where
 
-import Data.Char
+import Remote.External.Types
-
+import qualified Annex
 import Common.Annex
 import Types.Remote
-import Types.Key
 import qualified Git
 import Config
 import Remote.Helper.Special
@@ -22,30 +19,39 @@ import Crypto
 import Utility.Metered
 import Logs.Transfer
 import Config.Cost
+import Annex.Content
+import Annex.UUID
+import Annex.Exception
+
+import Control.Concurrent.STM
+import System.Process (std_in, std_out, std_err)
+import qualified Data.Map as M
 
 remote :: RemoteType
 remote = RemoteType {
-	typename = "hook",
+	typename = "external",
-	enumerate = findSpecialRemotes "hooktype",
+	enumerate = findSpecialRemotes "externaltype",
 	generate = gen,
-	setup = undefined
+	setup = externalSetup
 }
 
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = do
-	cst <- remoteCost gc expensiveRemoteCost
+	external <- newExternal externaltype
+	Annex.addCleanup (fromUUID u) $ stopExternal external
+	cst <- getCost external r gc
 	return $ Just $ encryptableRemote c
-		(storeEncrypted $ getGpgEncParams (c,gc))
+		(storeEncrypted external $ getGpgEncParams (c,gc))
-		retrieveEncrypted
+		(retrieveEncrypted external)
 		Remote {
 			uuid = u,
 			cost = cst,
 			name = Git.repoDescribe r,
-			storeKey = store,
+			storeKey = store external,
-			retrieveKeyFile = retrieve,
+			retrieveKeyFile = retrieve external,
 			retrieveKeyFileCheap = retrieveCheap,
-			removeKey = remove,
+			removeKey = remove external,
-			hasKey = checkPresent r,
+			hasKey = checkPresent external,
 			hasKeyCheap = False,
 			whereisKey = Nothing,
 			remoteFsck = Nothing,
@@ -58,197 +64,234 @@ gen r u c gc = do
 			globallyAvailable = False,
 			remotetype = remote
 		}
+  where
+	externaltype = fromMaybe (error "missing externaltype") $ remoteAnnexExternalType gc
 
-store :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
+externalSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
-store k _f _p = undefined
+externalSetup mu c = do
+	u <- maybe (liftIO genUUID) return mu
+	let externaltype = fromMaybe (error "Specify externaltype=") $
+		M.lookup "externaltype" c
+	c' <- encryptionSetup c
 
-storeEncrypted :: [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+	external <- newExternal externaltype
-storeEncrypted gpgOpts (cipher, enck) k _p = undefined
+	handleRequest external INITREMOTE Nothing $ \resp -> case resp of
+		INITREMOTE_SUCCESS -> Just noop
+		INITREMOTE_FAILURE errmsg -> Just $ error errmsg
+		_ -> Nothing
 
-retrieve :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+	gitConfigSpecialRemote u c' "externaltype" externaltype
-retrieve k _f d _p = undefined
+	return (c', u)
+
+store :: External -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
+store external k _f p = safely $ sendAnnex k rollback $ \f ->
+	handleRequest external (TRANSFER Upload k f) (Just p) $ \resp ->
+		case resp of
+			TRANSFER_SUCCESS Upload k'
+				| k == k' -> Just $ return True
+			TRANSFER_FAILURE Upload k' errmsg
+				| k == k' -> Just $ do
+					warning errmsg
+					return False
+			_ -> Nothing
+  where
+	rollback = void $ remove external k
+
+storeEncrypted :: External -> [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+storeEncrypted external gpgOpts (cipher, enck) k _p = safely $ undefined
+
+retrieve :: External -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+retrieve external k _f d p = safely $
+	handleRequest external (TRANSFER Download k d) (Just p) $ \resp ->
+		case resp of
+			TRANSFER_SUCCESS Download k'
+				| k == k' -> Just $ return True
+			TRANSFER_FAILURE Download k' errmsg
+				| k == k' -> Just $ do
+					warning errmsg
+					return False
+			_ -> Nothing
 
 retrieveCheap :: Key -> FilePath -> Annex Bool
-retrieveCheap _ _ = undefined
+retrieveCheap _ _ = return False
 
-retrieveEncrypted :: (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
+retrieveEncrypted :: External -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
-retrieveEncrypted (cipher, enck) _ f _p = undefined
+retrieveEncrypted external (cipher, enck) _ f _p = safely $ undefined
 
-remove :: Key -> Annex Bool
+remove :: External -> Key -> Annex Bool
-remove k = undefined
+remove external k = safely $ 
+	handleRequest external (REMOVE k) Nothing $ \resp ->
+		case resp of
+			REMOVE_SUCCESS k'
+				| k == k' -> Just $ return True
+			REMOVE_FAILURE k' errmsg
+				| k == k' -> Just $ do
+					warning errmsg
+					return False
+			_ -> Nothing
 
-checkPresent :: Git.Repo -> Key -> Annex (Either String Bool)
+checkPresent :: External -> Key -> Annex (Either String Bool)
-checkPresent r k = undefined
+checkPresent external k = either (Left . show) id <$> tryAnnex go
-
--- Messages that git-annex can send.
-class Sendable m where
-	formatMessage :: m -> [String]
-
--- Messages that git-annex can receive.
-class Receivable m where
-	-- Passed the first word of the message, returns
-	-- a Parser that can be be fed the rest of the message to generate
-	-- the value.
-	parseCommand :: String -> Parser m
-
-parseMessage :: (Receivable m) => String -> Maybe m
-parseMessage s = parseCommand command rest
   where
-	(command, rest) = splitWord s
+	go = handleRequest external (CHECKPRESENT k) Nothing $ \resp ->
+		case resp of
+			CHECKPRESENT_SUCCESS k'
+				| k' == k -> Just $ return $ Right True
+			CHECKPRESENT_FAILURE k'
+				| k' == k -> Just $ return $ Right False
+			CHECKPRESENT_UNKNOWN k' errmsg
+				| k' == k -> Just $ return $ Left errmsg
+			_ -> Nothing
 
--- Messages that can be sent to the external remote to request it do something.
+safely :: Annex Bool -> Annex Bool
-data Request 
+safely a = go =<< tryAnnex a
-	= PREPARE 
+  where
-	| INITREMOTE
+	go (Right r) = return r
-	| GETCOST
+	go (Left e) = do
-	| TRANSFER Direction Key FilePath
+		warning $ show e
-	| CHECKPRESENT Key
+		return False
-	| REMOVE Key
-	deriving (Show)
 
-instance Sendable Request where
+{- Sends a Request to the external remote, and waits for it to generate
-	formatMessage PREPARE = ["PREPARE"]
+ - a Response that the responsehandler accepts.
-	formatMessage INITREMOTE = ["INITREMOTE"]
+ -
-	formatMessage GETCOST = ["GETCOST"]
+ - While the external remote is processing the Request, it may send
-	formatMessage (TRANSFER direction key file) =
+ - any number of RemoteRequests, that are handled here.
-		[ "TRANSFER", serialize direction, serialize key, serialize file ]
+ -
-	formatMessage (CHECKPRESENT key) = [ "CHECKPRESENT", serialize key ]
+ - Only one request can be made at a time, so locking is used.
-	formatMessage (REMOVE key) = [ "REMOVE", serialize key ]
+ -
-
+ - May throw exceptions, for example on protocol errors.
--- Responses the external remote can make to requests.
-data Response
-	= PREPARE_SUCCESS
-	| TRANSFER_SUCCESS Direction Key
-	| TRANSFER_FAILURE Direction Key ErrorMsg
-	| CHECKPRESENT_SUCCESS Key
-	| CHECKPRESENT_FAILURE Key
-	| CHECKPRESENT_UNKNOWN Key ErrorMsg
-	| REMOVE_SUCCESS Key
-	| REMOVE_FAILURE Key ErrorMsg
-	| COST Cost
-	| COST_UNKNOWN
-	| INITREMOTE_SUCCESS
-	| INITREMOTE_FAILURE ErrorMsg
-	| UNKNOWN_REQUEST
-	deriving (Show)
-
-instance Receivable Response where
-	parseCommand "PREPARE-SUCCESS" = parse0 PREPARE_SUCCESS
-	parseCommand "TRANSFER-SUCCESS" = parse2 TRANSFER_SUCCESS
-	parseCommand "TRANSFER-FAILURE" = parse3 TRANSFER_FAILURE
-	parseCommand "CHECKPRESENT-SUCCESS" = parse1 CHECKPRESENT_SUCCESS
-	parseCommand "CHECKPRESENT-FAILURE" = parse1 CHECKPRESENT_FAILURE
-	parseCommand "CHECKPRESENT-UNKNOWN" = parse2 CHECKPRESENT_UNKNOWN
-	parseCommand "REMOVE-SUCCESS" = parse1 REMOVE_SUCCESS
-	parseCommand "REMOVE-FAILURE" = parse2 REMOVE_FAILURE
-	parseCommand "COST" = parse1 COST
-	parseCommand "COST_UNKNOWN" = parse0 COST_UNKNOWN
-	parseCommand "INITREMOTE-SUCCESS" = parse0 INITREMOTE_SUCCESS
-	parseCommand "INITREMOTE-FAILURE" = parse1 INITREMOTE_FAILURE
-	parseCommand "UNKNOWN-REQUEST" = parse0 UNKNOWN_REQUEST
-	parseCommand _ = parseFail
-
--- Requests that the external remote can send at any time it's in control.
-data RemoteRequest
-	= VERSION Int
-	| PROGRESS Direction Key Int
-	| DIRHASH Key
-	| SETCONFIG Setting String
-	| GETCONFIG Setting
-	| SETSTATE Key String
-	| GETSTATE Key
-	deriving (Show)
-
-instance Receivable RemoteRequest where
-	parseCommand "VERSION" = parse1 VERSION
-	parseCommand "PROGRESS" = parse3 PROGRESS
-	parseCommand "DIRHASH" = parse1 DIRHASH
-	parseCommand "SETCONFIG" = parse2 SETCONFIG
-	parseCommand "GETCONFIG" = parse1 GETCONFIG
-	parseCommand "SETSTATE" = parse2 SETSTATE
-	parseCommand "GETSTATE" = parse1 GETSTATE
-	parseCommand _ = parseFail
-
--- Responses to RemoteRequest.
-data RemoteResponse
-	= VALUE String
-	deriving (Show)
-
-instance Sendable RemoteResponse where
-	formatMessage (VALUE s) = [ "VALUE", serialize s ]
-
--- Messages that can be sent at any time by either git-annex or the remote.
-data AsyncMessages 
-	= ERROR ErrorMsg
-	deriving (Show)
-
-instance Sendable AsyncMessages where
-	formatMessage (ERROR err) = [ "ERROR", serialize err ]
-
-instance Receivable AsyncMessages where
-	parseCommand "ERROR" = parse1 ERROR
-	parseCommand _ = parseFail
-
--- Data types used for parameters when communicating with the remote.
--- All are serializable.
-type ErrorMsg = String
-type Setting = String
-
-class Serializable a where
-	serialize :: a -> String
-	deserialize :: String -> Maybe a
-
-instance Serializable Direction where
-	serialize Upload = "STORE"
-	serialize Download = "RETRIEVE"
-
-	deserialize "STORE" = Just Upload
-	deserialize "RETRIEVE" = Just Download
-	deserialize _ = Nothing
-
-instance Serializable Key where
-	serialize = key2file
-	deserialize = file2key
-
-instance Serializable [Char] where
-	serialize = id
-	deserialize = Just
-
-instance Serializable Cost where
-	serialize = show
-	deserialize = readish
-
-instance Serializable Int where
-	serialize = show
-	deserialize = readish
-
-{- Parsing the parameters of messages. Using the right parseN ensures
- - that the string is split into exactly the requested number of words,
- - which allows the last parameter of a message to contain arbitrary
- - whitespace, etc, without needing any special quoting.
  -}
-type Parser a = String -> Maybe a
+handleRequest :: External -> Request -> Maybe MeterUpdate -> (Response -> Maybe (Annex a)) -> Annex a
+handleRequest external req mp responsehandler = 
+	withExternalLock external $ \lck ->
+		handleRequest' lck external req mp responsehandler
 
-parseFail :: Parser a
+handleRequest' :: ExternalLock -> External -> Request -> Maybe MeterUpdate -> (Response -> Maybe (Annex a)) -> Annex a
-parseFail _ = Nothing
+handleRequest' lck external req mp responsehandler = do
-
+	sendMessage lck external req
-parse0 :: a -> Parser a
+	loop
-parse0 mk "" = Just mk
-parse0 _ _ = Nothing
-
-parse1 :: Serializable p1 => (p1 -> a) -> Parser a
-parse1 mk p1 = mk <$> deserialize p1
-
-parse2 :: (Serializable p1, Serializable p2) => (p1 -> p2 -> a) -> Parser a
-parse2 mk s = mk <$> deserialize p1 <*> deserialize p2
   where
-	(p1, p2) = splitWord s
+	loop = receiveMessage lck external responsehandler
+		(\rreq -> Just $ handleRemoteRequest rreq >> loop)
+		(\msg -> Just $ handleAsyncMessage msg >> loop)
 
-parse3 :: (Serializable p1, Serializable p2, Serializable p3) => (p1 -> p2 -> p3 -> a) -> Parser a
+	handleRemoteRequest (PROGRESS bytesprocessed) =
-parse3 mk s = mk <$> deserialize p1 <*> deserialize p2 <*> deserialize p3
+		maybe noop (\a -> liftIO $ a bytesprocessed) mp
+	handleRemoteRequest (DIRHASH k) = 
+		sendMessage lck external (VALUE $ hashDirMixed k)
+	handleRemoteRequest (SETCONFIG setting value) = error "TODO"
+	handleRemoteRequest (GETCONFIG setting) = error "TODO"
+	handleRemoteRequest (SETSTATE k value) = error "TODO"
+	handleRemoteRequest (GETSTATE k) = error "TODO"
+	handleRemoteRequest (VERSION _) =
+		sendMessage lck external (ERROR "too late to send VERSION")
+
+	handleAsyncMessage (ERROR err) = error $ "external special remote error: " ++ err
+
+sendMessage :: Sendable m => ExternalLock -> External -> m -> Annex ()
+sendMessage lck external m = 
+	fromExternal lck external externalSend $ \h ->
+		liftIO $ hPutStrLn h $ unwords $ formatMessage m
+
+{- Waits for a message from the external remote, and passes it to the
+ - apppropriate handler. 
+ -
+ - If the handler returns Nothing, this is a protocol error.-}
+receiveMessage
+	:: ExternalLock
+	-> External 
+	-> (Response -> Maybe (Annex a))
+	-> (RemoteRequest -> Maybe (Annex a))
+	-> (AsyncMessage -> Maybe (Annex a))
+	-> Annex a
+receiveMessage lck external handleresponse handlerequest handleasync = do
+	s <- fromExternal lck external externalReceive $ liftIO . hGetLine
+	case parseMessage s :: Maybe Response of
+		Just resp -> maybe (protocolError s) id (handleresponse resp)
+		Nothing -> case parseMessage s :: Maybe RemoteRequest of
+			Just req -> maybe (protocolError s) id (handlerequest req)
+			Nothing -> case parseMessage s :: Maybe AsyncMessage of
+				Just msg -> maybe (protocolError s) id (handleasync msg)
+				Nothing -> protocolError s
   where
-	(p1, rest) = splitWord s
+	protocolError s = error $ "external special remote protocol error, unexpectedly received \"" ++ s ++ "\""
-	(p2, p3) = splitWord rest
 
-splitWord :: String -> (String, String)
+{- Starts up the external remote if it's not yet running,
-splitWord = separate isSpace
+ - and passes a value extracted from its state to an action.
+ -}
+fromExternal :: ExternalLock -> External -> (ExternalState -> v) -> (v -> Annex a) -> Annex a
+fromExternal lck external extractor a =
+	go =<< liftIO (atomically (tryReadTMVar v))
+  where
+	go (Just st) = run st
+	go Nothing = do
+		st <- startExternal $ externalType external
+		void $ liftIO $ atomically $ swapTMVar v st
+
+		{- Handle initial protocol startup; check the VERSION
+		 - the remote sends, and send it the PREPARE request. -}
+		receiveMessage lck external
+			(const Nothing)
+			(checkVersion lck external)
+			(const Nothing)
+		handleRequest' lck external PREPARE Nothing $ \resp -> 
+			case resp of
+				PREPARE_SUCCESS -> Just $ run st
+				_ -> Nothing
+
+	run st = a $ extractor st
+	v = externalState external
+
+{- Starts an external remote process running, but does not handle checking
+ - VERSION, etc. -}
+startExternal :: ExternalType -> Annex ExternalState
+startExternal externaltype = liftIO $ do
+	(Just hin, Just hout, _, pid) <- createProcess $
+		(proc (externalRemoteProgram externaltype) [])
+			{ std_in = CreatePipe
+			, std_out = CreatePipe
+			, std_err = Inherit
+			}
+	fileEncoding hin
+	fileEncoding hout
+	return $ ExternalState
+		{ externalSend = hin
+		, externalReceive = hout
+		, externalPid = pid
+		}
+
+stopExternal :: External -> Annex ()
+stopExternal external = liftIO $ stop =<< atomically (tryReadTMVar v)
+  where
+	stop Nothing = noop
+	stop (Just st) = do
+		void $ atomically $ tryTakeTMVar v
+		hClose $ externalSend st
+		hClose $ externalReceive st
+		void $ waitForProcess $ externalPid st
+	v = externalState external
+
+externalRemoteProgram :: ExternalType -> String
+externalRemoteProgram externaltype = "git-annex-remote-" ++ externaltype
+
+checkVersion :: ExternalLock -> External -> RemoteRequest -> Maybe (Annex ())
+checkVersion lck external (VERSION v) = Just $
+	if v `elem` supportedProtocolVersions
+		then noop
+		else sendMessage lck external (ERROR "unsupported VERSION")
+checkVersion _ _ _ = Nothing
+
+{- Caches the cost in the git config to avoid needing to start up an
+ - external special remote every time time just to ask it what its
+ - cost is. -}
+getCost :: External -> Git.Repo -> RemoteGitConfig -> Annex Cost
+getCost external r gc = go =<< remoteCost' gc
+  where
+	go (Just c) = return c
+	go Nothing = do
+		c <- handleRequest external GETCOST Nothing $ \req -> case req of
+			COST c -> Just $ return c
+			COST_UNKNOWN -> Just $ return expensiveRemoteCost
+			_ -> Nothing
+		setRemoteCost r c
+		return c

Remote/External/Types.hs

@@ -0,0 +1,254 @@
+{- External special remote data types.
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+
+module Remote.External.Types (
+	External(..),
+	newExternal,
+	ExternalType,
+	ExternalLock,
+	withExternalLock,
+	ExternalState(..),
+	parseMessage,
+	Sendable(..),
+	Receivable(..),
+	Request(..),
+	Response(..),
+	RemoteRequest(..),
+	RemoteResponse(..),
+	AsyncMessage(..),
+	ErrorMsg,
+	Setting,
+	ProtocolVersion,
+	supportedProtocolVersions,
+) where
+
+import Common.Annex
+import Types.Key
+import Utility.Metered
+import Logs.Transfer
+import Config.Cost
+import Annex.Exception
+
+import Data.Char
+import Control.Concurrent.STM
+
+-- If the remote is not yet running, the ExternalState TMVar is empty.
+-- The 
+data External = External
+	{ externalType :: ExternalType
+	-- Empty until the remote is running.
+	, externalState :: TMVar ExternalState
+	-- Empty when a remote is in use.
+	, externalLock :: TMVar ExternalLock
+	}
+
+newExternal :: ExternalType -> Annex External
+newExternal externaltype = liftIO $ External
+	<$> pure externaltype
+	<*> atomically newEmptyTMVar
+	<*> atomically (newTMVar ExternalLock)
+
+type ExternalType = String
+
+data ExternalState = ExternalState
+	{ externalSend :: Handle
+	, externalReceive :: Handle
+	, externalPid :: ProcessHandle
+	}
+
+-- Constructor is not exported, and only created by newExternal.
+data ExternalLock = ExternalLock
+
+withExternalLock :: External -> (ExternalLock -> Annex a) -> Annex a
+withExternalLock external = bracketIO setup cleanup
+  where
+	setup = atomically $ takeTMVar v
+	cleanup = atomically . putTMVar v
+	v = externalLock external
+
+-- Messages that git-annex can send.
+class Sendable m where
+	formatMessage :: m -> [String]
+
+-- Messages that git-annex can receive.
+class Receivable m where
+	-- Passed the first word of the message, returns
+	-- a Parser that can be be fed the rest of the message to generate
+	-- the value.
+	parseCommand :: String -> Parser m
+
+parseMessage :: (Receivable m) => String -> Maybe m
+parseMessage s = parseCommand command rest
+  where
+	(command, rest) = splitWord s
+
+-- Messages that can be sent to the external remote to request it do something.
+data Request 
+	= PREPARE 
+	| INITREMOTE
+	| GETCOST
+	| TRANSFER Direction Key FilePath
+	| CHECKPRESENT Key
+	| REMOVE Key
+	deriving (Show)
+
+instance Sendable Request where
+	formatMessage PREPARE = ["PREPARE"]
+	formatMessage INITREMOTE = ["INITREMOTE"]
+	formatMessage GETCOST = ["GETCOST"]
+	formatMessage (TRANSFER direction key file) =
+		[ "TRANSFER", serialize direction, serialize key, serialize file ]
+	formatMessage (CHECKPRESENT key) = [ "CHECKPRESENT", serialize key ]
+	formatMessage (REMOVE key) = [ "REMOVE", serialize key ]
+
+-- Responses the external remote can make to requests.
+data Response
+	= PREPARE_SUCCESS
+	| TRANSFER_SUCCESS Direction Key
+	| TRANSFER_FAILURE Direction Key ErrorMsg
+	| CHECKPRESENT_SUCCESS Key
+	| CHECKPRESENT_FAILURE Key
+	| CHECKPRESENT_UNKNOWN Key ErrorMsg
+	| REMOVE_SUCCESS Key
+	| REMOVE_FAILURE Key ErrorMsg
+	| COST Cost
+	| COST_UNKNOWN
+	| INITREMOTE_SUCCESS
+	| INITREMOTE_FAILURE ErrorMsg
+	| UNKNOWN_REQUEST
+	deriving (Show)
+
+instance Receivable Response where
+	parseCommand "PREPARE-SUCCESS" = parse0 PREPARE_SUCCESS
+	parseCommand "TRANSFER-SUCCESS" = parse2 TRANSFER_SUCCESS
+	parseCommand "TRANSFER-FAILURE" = parse3 TRANSFER_FAILURE
+	parseCommand "CHECKPRESENT-SUCCESS" = parse1 CHECKPRESENT_SUCCESS
+	parseCommand "CHECKPRESENT-FAILURE" = parse1 CHECKPRESENT_FAILURE
+	parseCommand "CHECKPRESENT-UNKNOWN" = parse2 CHECKPRESENT_UNKNOWN
+	parseCommand "REMOVE-SUCCESS" = parse1 REMOVE_SUCCESS
+	parseCommand "REMOVE-FAILURE" = parse2 REMOVE_FAILURE
+	parseCommand "COST" = parse1 COST
+	parseCommand "COST_UNKNOWN" = parse0 COST_UNKNOWN
+	parseCommand "INITREMOTE-SUCCESS" = parse0 INITREMOTE_SUCCESS
+	parseCommand "INITREMOTE-FAILURE" = parse1 INITREMOTE_FAILURE
+	parseCommand "UNKNOWN-REQUEST" = parse0 UNKNOWN_REQUEST
+	parseCommand _ = parseFail
+
+-- Requests that the external remote can send at any time it's in control.
+data RemoteRequest
+	= VERSION ProtocolVersion
+	| PROGRESS BytesProcessed
+	| DIRHASH Key
+	| SETCONFIG Setting String
+	| GETCONFIG Setting
+	| SETSTATE Key String
+	| GETSTATE Key
+	deriving (Show)
+
+instance Receivable RemoteRequest where
+	parseCommand "VERSION" = parse1 VERSION
+	parseCommand "PROGRESS" = parse1 PROGRESS
+	parseCommand "DIRHASH" = parse1 DIRHASH
+	parseCommand "SETCONFIG" = parse2 SETCONFIG
+	parseCommand "GETCONFIG" = parse1 GETCONFIG
+	parseCommand "SETSTATE" = parse2 SETSTATE
+	parseCommand "GETSTATE" = parse1 GETSTATE
+	parseCommand _ = parseFail
+
+-- Responses to RemoteRequest.
+data RemoteResponse
+	= VALUE String
+	deriving (Show)
+
+instance Sendable RemoteResponse where
+	formatMessage (VALUE s) = [ "VALUE", serialize s ]
+
+-- Messages that can be sent at any time by either git-annex or the remote.
+data AsyncMessage
+	= ERROR ErrorMsg
+	deriving (Show)
+
+instance Sendable AsyncMessage where
+	formatMessage (ERROR err) = [ "ERROR", serialize err ]
+
+instance Receivable AsyncMessage where
+	parseCommand "ERROR" = parse1 ERROR
+	parseCommand _ = parseFail
+
+-- Data types used for parameters when communicating with the remote.
+-- All are serializable.
+type ErrorMsg = String
+type Setting = String
+type ProtocolVersion = Int
+
+supportedProtocolVersions :: [ProtocolVersion]
+supportedProtocolVersions = [1]
+
+class Serializable a where
+	serialize :: a -> String
+	deserialize :: String -> Maybe a
+
+instance Serializable Direction where
+	serialize Upload = "STORE"
+	serialize Download = "RETRIEVE"
+
+	deserialize "STORE" = Just Upload
+	deserialize "RETRIEVE" = Just Download
+	deserialize _ = Nothing
+
+instance Serializable Key where
+	serialize = key2file
+	deserialize = file2key
+
+instance Serializable [Char] where
+	serialize = id
+	deserialize = Just
+
+instance Serializable ProtocolVersion where
+	serialize = show
+	deserialize = readish
+
+instance Serializable Cost where
+	serialize = show
+	deserialize = readish
+
+instance Serializable BytesProcessed where
+	serialize (BytesProcessed n) = show n
+	deserialize = BytesProcessed <$$> readish
+
+{- Parsing the parameters of messages. Using the right parseN ensures
+ - that the string is split into exactly the requested number of words,
+ - which allows the last parameter of a message to contain arbitrary
+ - whitespace, etc, without needing any special quoting.
+ -}
+type Parser a = String -> Maybe a
+
+parseFail :: Parser a
+parseFail _ = Nothing
+
+parse0 :: a -> Parser a
+parse0 mk "" = Just mk
+parse0 _ _ = Nothing
+
+parse1 :: Serializable p1 => (p1 -> a) -> Parser a
+parse1 mk p1 = mk <$> deserialize p1
+
+parse2 :: (Serializable p1, Serializable p2) => (p1 -> p2 -> a) -> Parser a
+parse2 mk s = mk <$> deserialize p1 <*> deserialize p2
+  where
+	(p1, p2) = splitWord s
+
+parse3 :: (Serializable p1, Serializable p2, Serializable p3) => (p1 -> p2 -> p3 -> a) -> Parser a
+parse3 mk s = mk <$> deserialize p1 <*> deserialize p2 <*> deserialize p3
+  where
+	(p1, rest) = splitWord s
+	(p2, p3) = splitWord rest
+
+splitWord :: String -> (String, String)
+splitWord = separate isSpace

Remote/Hook.hs

@@ -63,7 +63,7 @@ gen r u c gc = do
 			remotetype = remote
 		}
   where
-	hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc	
+	hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc
 
 hookSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
 hookSetup mu c = do

Remote/List.hs

@@ -35,6 +35,7 @@ import qualified Remote.WebDAV
 #endif
 import qualified Remote.Glacier
 import qualified Remote.Hook
+import qualified Remote.External
 
 remoteTypes :: [RemoteType]
 remoteTypes =
@@ -52,6 +53,7 @@ remoteTypes =
 #endif
 	, Remote.Glacier.remote
 	, Remote.Hook.remote
+	, Remote.External.remote
 	]
 
 {- Builds a list of all available Remotes.

Types/GitConfig.hs

@@ -113,6 +113,7 @@ data RemoteGitConfig = RemoteGitConfig
 	, remoteAnnexDirectory :: Maybe FilePath
 	, remoteAnnexGCrypt :: Maybe String
 	, remoteAnnexHookType :: Maybe String
+	, remoteAnnexExternalType :: Maybe String
 	{- A regular git remote's git repository config. -}
 	, remoteGitConfig :: Maybe GitConfig
 	}
@@ -137,6 +138,7 @@ extractRemoteGitConfig r remotename = RemoteGitConfig
 	, remoteAnnexDirectory = notempty $ getmaybe "directory"
 	, remoteAnnexGCrypt = notempty $ getmaybe "gcrypt"
 	, remoteAnnexHookType = notempty $ getmaybe "hooktype"
+	, remoteAnnexExternalType = notempty $ getmaybe "externaltype"
 	, remoteGitConfig = Nothing
 	}
   where

Utility/Metered.hs

@@ -25,7 +25,7 @@ type MeterUpdate = (BytesProcessed -> IO ())
 
 {- Total number of bytes processed so far. -}
 newtype BytesProcessed = BytesProcessed Integer
-	deriving (Eq, Ord)
+	deriving (Eq, Ord, Show)
 
 class AsBytesProcessed a where
 	toBytesProcessed :: a -> BytesProcessed