implement PREPARE-FAILURE for Tobias

Remote/External.hs

@@ -181,7 +181,8 @@ safely a = go =<< tryAnnex a
  -
  - Only one request can be made at a time, so locking is used.
  -
- - May throw exceptions, for example on protocol errors.
+ - May throw exceptions, for example on protocol errors, or
+ - when the repository cannot be used.
  -}
 handleRequest :: External -> Request -> Maybe MeterUpdate -> (Response -> Maybe (Annex a)) -> Annex a
 handleRequest external req mp responsehandler = 
@@ -189,12 +190,15 @@ handleRequest external req mp responsehandler =
 		handleRequest' lck external req mp responsehandler
 
 handleRequest' :: ExternalLock -> External -> Request -> Maybe MeterUpdate -> (Response -> Maybe (Annex a)) -> Annex a
-handleRequest' lck external req mp responsehandler = do
-	when (needsPREPARE req) $
+handleRequest' lck external req mp responsehandler
+	| needsPREPARE req = do
 		checkPrepared lck external
+		go
+	| otherwise = go
+  where
+  	go = do
 		sendMessage lck external req
 		loop
-  where
 	loop = receiveMessage lck external responsehandler
 		(\rreq -> Just $ handleRemoteRequest rreq >> loop)
 		(\msg -> Just $ handleAsyncMessage msg >> loop)
@@ -322,7 +326,7 @@ startExternal externaltype = liftIO $ do
 		{ externalSend = hin
 		, externalReceive = hout
 		, externalPid = pid
-		, externalPrepared = False
+		, externalPrepared = Unprepared
 		}
   where
 	cmd = externalRemoteProgram externaltype
@@ -354,14 +358,30 @@ checkVersion lck external (VERSION v) = Just $
 		else sendMessage lck external (ERROR "unsupported VERSION")
 checkVersion _ _ _ = Nothing
 
+{- If repo has not been prepared, sends PREPARE.
+ -
+ - If the repo fails to prepare, or failed before, throws an exception with
+ - the error message. -}
 checkPrepared :: ExternalLock -> External -> Annex ()
 checkPrepared lck external = 
 	fromExternal lck external externalPrepared $ \prepared ->
-		unless prepared $
+		case prepared of
+			Prepared -> noop
+			FailedPrepare errmsg -> error errmsg
+			Unprepared -> 
 				handleRequest' lck external PREPARE Nothing $ \resp ->
 					case resp of
-					PREPARE_SUCCESS -> Just noop
+						PREPARE_SUCCESS -> Just $
+							setprepared Prepared
+						PREPARE_FAILURE errmsg -> Just $ do
+							setprepared $ FailedPrepare errmsg
+							error errmsg
 						_ -> Nothing
+  where
+	setprepared status = liftIO . atomically $ do
+		let v = externalState external
+		st <- takeTMVar v
+		void $ putTMVar v $ st { externalPrepared = status }
 
 {- 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

Remote/External/Types.hs

@@ -14,6 +14,7 @@ module Remote.External.Types (
 	ExternalLock,
 	withExternalLock,
 	ExternalState(..),
+	PrepareStatus(..),
 	parseMessage,
 	Sendable(..),
 	Receivable(..),
@@ -67,9 +68,11 @@ data ExternalState = ExternalState
 	{ externalSend :: Handle
 	, externalReceive :: Handle
 	, externalPid :: ProcessHandle
-	, externalPrepared :: Bool
+	, externalPrepared :: PrepareStatus
 	}
 
+data PrepareStatus = Unprepared | Prepared | FailedPrepare ErrorMsg
+
 -- Constructor is not exported, and only created by newExternal.
 data ExternalLock = ExternalLock
 
@@ -124,6 +127,7 @@ instance Sendable Request where
 -- Responses the external remote can make to requests.
 data Response
 	= PREPARE_SUCCESS
+	| PREPARE_FAILURE ErrorMsg
 	| TRANSFER_SUCCESS Direction Key
 	| TRANSFER_FAILURE Direction Key ErrorMsg
 	| CHECKPRESENT_SUCCESS Key
@@ -139,6 +143,7 @@ data Response
 
 instance Receivable Response where
 	parseCommand "PREPARE-SUCCESS" = parse0 PREPARE_SUCCESS
+	parseCommand "PREPARE-FAILURE" = parse1 PREPARE_FAILURE
 	parseCommand "TRANSFER-SUCCESS" = parse2 TRANSFER_SUCCESS
 	parseCommand "TRANSFER-FAILURE" = parse3 TRANSFER_FAILURE
 	parseCommand "CHECKPRESENT-SUCCESS" = parse1 CHECKPRESENT_SUCCESS

doc/design/external_special_remote_protocol.mdwn

@@ -130,6 +130,8 @@ while it's handling a request.
 
 * `PREPARE-SUCCESS`  
   Sent as a response to PREPARE once the special remote is ready for use.
+* `PREPARE-FAILURE ErrorMsg`
+  Sent as a response to PREPARE if the special remote cannot be used.
 * `TRANSFER-SUCCESS STORE|RETRIEVE Key`  
   Indicates the transfer completed successfully.
 * `TRANSFER-FAILURE STORE|RETRIEVE Key ErrorMsg`  

doc/special_remotes/external/example.sh

@@ -112,10 +112,14 @@ while read line; do
 			# Use GETCONFIG to get configuration settings,
 			# and do anything needed to get ready for using the
 			# special remote here.
+			getcreds
 			getconfig directory
 			mydirectory="$RET"
-			getcreds
+			if [ -d "$mydirectory" ]; then
 				echo PREPARE-SUCCESS
+			else
+				echo PREPARE-FAILURE "$mydirectory not found"
+			fi
 		;;
 		TRANSFER)
 			key="$3"