include external special remote process number in debug

Not actual pid, because System.Process does not expose that.

Remote/External.hs

@@ -303,7 +303,7 @@ handleRequest' st external req mp responsehandler
 
 sendMessage :: Sendable m => ExternalState -> External -> m -> Annex ()
 sendMessage st external m = liftIO $ do
-	protocolDebug external True line
+	protocolDebug external st True line
 	hPutStrLn h line
 	hFlush h
   where
@@ -326,7 +326,7 @@ receiveMessage st external handleresponse handlerequest handleasync =
   where
 	go Nothing = protocolError False ""
 	go (Just s) = do
-		liftIO $ protocolDebug external False s
+		liftIO $ protocolDebug external st False s
 		case parseMessage s :: Maybe Response of
 			Just resp -> maybe (protocolError True s) id (handleresponse resp)
 			Nothing -> case parseMessage s :: Maybe RemoteRequest of
@@ -337,9 +337,10 @@ receiveMessage st external handleresponse handlerequest handleasync =
 	protocolError parsed s = error $ "external special remote protocol error, unexpectedly received \"" ++ s ++ "\" " ++
 		if parsed then "(command not allowed at this time)" else "(unable to parse command)"
 
-protocolDebug :: External -> Bool -> String -> IO ()
-protocolDebug external sendto line = debugM "external" $ unwords
-	[ externalRemoteProgram (externalType external)
+protocolDebug :: External -> ExternalState -> Bool -> String -> IO ()
+protocolDebug external st sendto line = debugM "external" $ unwords
+	[ externalRemoteProgram (externalType external) ++ 
+		"[" ++ show (externalPid st) ++ "]"
 	, if sendto then "<--" else "-->"
 	, line
 	]
@@ -388,21 +389,26 @@ startExternal external = do
 			, std_err = CreatePipe
 			}
 		p <- propgit g basep
-		(Just hin, Just hout, Just herr, pid) <- 
+		(Just hin, Just hout, Just herr, ph) <- 
 			createProcess p `catchIO` runerr
 		fileEncoding hin
 		fileEncoding hout
 		fileEncoding herr
 		stderrelay <- async $ errrelayer herr
-		checkearlytermination =<< getProcessExitCode pid
+		checkearlytermination =<< getProcessExitCode ph
 		cv <- newTMVarIO $ externalDefaultConfig external
 		pv <- newTMVarIO Unprepared
+		pid <- atomically $ do
+			n <- succ <$> takeTMVar (externalLastPid external)
+			putTMVar (externalLastPid external) n
+			return n
 		return $ ExternalState
 			{ externalSend = hin
 			, externalReceive = hout
+			, externalPid = pid
 			, externalShutdown = do
 				cancel stderrelay
-				void $ waitForProcess pid
+				void $ waitForProcess ph
 			, externalPrepared = pv
 			, externalConfig = cv
 			}
@@ -423,8 +429,6 @@ startExternal external = do
 			error $ basecmd ++ " is not installed in PATH (" ++ path ++ ")"
 		)
 
--- Note: Does not stop any externals that have a withExternalState
--- action currently running.
 stopExternal :: External -> Annex ()
 stopExternal external = liftIO $ do
 	l <- atomically $ do

Remote/External/Types.hs

@@ -48,6 +48,7 @@ data External = External
 	, externalState :: TMVar [ExternalState]
 	-- ^ TMVar is never left empty; list contains states for external
 	-- special remote processes that are not currently in use.
+	, externalLastPid :: TMVar PID
 	, externalDefaultConfig :: RemoteConfig
 	, externalGitConfig :: RemoteGitConfig
 	}
@@ -57,6 +58,7 @@ newExternal externaltype u c gc = liftIO $ External
 	<$> pure externaltype
 	<*> pure u
 	<*> atomically (newTMVar [])
+	<*> atomically (newTMVar 0)
 	<*> pure c
 	<*> pure gc
 
@@ -66,12 +68,15 @@ data ExternalState = ExternalState
 	{ externalSend :: Handle
 	, externalReceive :: Handle
 	, externalShutdown :: IO ()
+	, externalPid :: PID
 	, externalPrepared :: TMVar PrepareStatus
 	-- ^ Never left empty.
 	, externalConfig :: TMVar RemoteConfig
 	-- ^ Never left empty.
 	}
 
+type PID = Int
+
 data PrepareStatus = Unprepared | Prepared | FailedPrepare ErrorMsg
 
 -- Messages that can be sent to the external remote to request it do something.