fix crash when offline

1 files changed, 24 insertions, 18 deletions

diff --git a/ControlWindow.hs b/ControlWindow.hs
index 7d4d2bc..3f050aa 100644
--- a/ControlWindow.hs
+++ b/ControlWindow.hs
@@ -20,6 +20,7 @@ import System.IO
 import System.Environment
 import System.Process
 import System.Posix
+import Control.Exception
 import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Concurrent.STM.TMChan
@@ -132,37 +133,42 @@ askToAllow ochan promptchan responsechan k@(GpgSigned pk _) = do
 	putStrLn "Someone wants to connect to this debug-me session."
 	putStrLn "Checking their Gnupg signature ..."
 	v <- gpgVerify [] k
-	let reject = do
-		putStrLn "Rejecting their connection."
-		atomically $ writeTMChan ochan $
-			ControlOutputAction $ SessionKeyRejected pk
-	let accept = do
-		putStrLn "Accepting their connection. They can now enter commands in this debug-me session."
-		putStrLn "(And, you can type in this window to chat with them.)"
-		atomically $ writeTMChan ochan $
-			ControlOutputAction $ SessionKeyAccepted pk
 	case v of
 		Nothing -> do
 			putStrLn "Unable to download their Gnupg key, or signature verification failed."
 			reject
-		Just gpgkeyid -> do
+		Just gpgkeyid -> flip catch woterror $ do
 			putStrLn "Checking the Gnupg web of trust ..."
 			ss <- isInStrongSet gpgkeyid
 			ws <- downloadWotStats gpgkeyid
 			putStrLn $ describeWot ws ss
-			ok <- promptconnect
-			if ok
-				then accept
-				else reject
+			promptconnect
   where
+	promptconnect :: IO ()
 	promptconnect = do
 		atomically $ writeTChan promptchan ()
 		putStr "Let them connect to the debug-me session and run commands? [y/n] "
 		hFlush stdout
 		r <- atomically $ readTChan responsechan
 		case map toLower (toString r) of
-			"y" -> return True
-			"yes" -> return True
-			"n" -> return False
-			"no" -> return False
+			"y" -> accept
+			"yes" -> accept
+			"n" -> reject
+			"no" -> reject
 			_ -> promptconnect
+	reject = do
+		putStrLn "Rejecting their connection."
+		atomically $ writeTMChan ochan $
+			ControlOutputAction $ SessionKeyRejected pk
+	accept = do
+		putStrLn "Accepting their connection. They can now enter commands in this debug-me session."
+		putStrLn "(And, you can type in this window to chat with them.)"
+		atomically $ writeTMChan ochan $
+			ControlOutputAction $ SessionKeyAccepted pk
+	woterror :: SomeException -> IO ()
+	woterror e = do
+		putStrLn (show e)
+		putStrLn "Web of trust check failed!"
+		putStrLn ""
+		putStrLn "Their identity cannot be verified!"
+		promptconnect