From 42b995ed82e26bc18d2a2874ceb65781bceab421 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 22 Sep 2016 14:59:43 -0400
Subject: avoid zenity choking on something it seems to expect to be html

Not documented at all as expecting html in --text. Such bad documentation..
---
 UI/Zenity.hs | 25 ++++++++++++++++++-------
 1 file changed, 18 insertions(+), 7 deletions(-)

diff --git a/UI/Zenity.hs b/UI/Zenity.hs
index 74810d9..85347c6 100644
--- a/UI/Zenity.hs
+++ b/UI/Zenity.hs
@@ -38,7 +38,7 @@ myShowError desc = bracket go cleanup (\_ -> return ())
 	go = runZenity
 		[ "--error"
 		, "--title", "keysafe"
-		, "--text", "Error: " ++ desc
+		, "--text", "Error: " ++ escape desc
 		]
 	cleanup h = do
 		_ <- waitZenity h
@@ -50,7 +50,7 @@ myShowInfo title desc = bracket go cleanup (\_ -> return ())
 	go = runZenity
 		[ "--info"
 		, "--title", title
-		, "--text", desc
+		, "--text", escape desc
 		]
 	cleanup h = do
 		_ <- waitZenity h
@@ -61,7 +61,7 @@ myPromptQuestion title desc question = do
 	h <- runZenity
 		[ "--question"
 		, "--title", title
-		, "--text",  desc ++ "\n" ++ question
+		, "--text",  escape $ desc ++ "\n" ++ question
 		]
 	(_, ok) <- waitZenity h
 	return ok
@@ -73,7 +73,7 @@ myPromptName title desc suggested checkproblem = go ""
 		h <- runZenity
 			[ "--entry"
 			, "--title", title
-			, "--text", desc ++ "\n" ++ extradesc
+			, "--text", escape $ desc ++ "\n" ++ extradesc
 			, "--entry-text", case suggested of
 				Nothing -> ""
 				Just (Name b) -> BU8.toString b
@@ -94,7 +94,7 @@ myPromptPassword confirm title desc = go ""
 		h <- runZenity $
 			[ "--forms"
 			, "--title", title
-			, "--text", desc ++ "\n" ++ extradesc ++ "\n"
+			, "--text", escape $ desc ++ "\n" ++ extradesc ++ "\n"
 			, "--separator", "\BEL"
 			, "--add-password", "Enter password"
 			] ++ if confirm
@@ -117,7 +117,7 @@ myPromptKeyId title desc l = do
 	h <- runZenity $
 		[ "--list"
 		, "--title", title
-		, "--text", desc
+		, "--text", escape desc
 		, "--column", "gpg secret key name"
 		, "--column", "keyid"
 		, "--print-column", "ALL"
@@ -138,7 +138,7 @@ myWithProgress title desc a = bracket setup teardown (a . sendpercent)
 		h <- runZenity
 			[ "--progress"
 			, "--title", title
-			, "--text", desc
+			, "--text", escape desc
 			, "--auto-close"
 			, "--auto-kill"
 			]
@@ -170,3 +170,14 @@ waitZenity (ZenityHandle hin hout ph) = do
 	ret <- hGetContents hout
 	exit <- waitForProcess ph
 	return (takeWhile (/= '\n') ret, exit == ExitSuccess)
+
+-- Zenity parses --text as html and will choke on invalid tags
+-- and '&' used outside a html entity. We don't want to use html, so
+-- escape these things.
+escape :: String -> String
+escape = concatMap esc 
+  where
+	esc '&' = "&amp;"
+	esc '<' = "&lt;"
+	esc '>' = "&gt;"
+	esc c = [c]
-- 
cgit v1.2.3