diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-09-22 14:59:43 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-09-22 14:59:43 -0400 |
commit | 42b995ed82e26bc18d2a2874ceb65781bceab421 (patch) | |
tree | d9b3b7da38b18d242c8ff11c48c2757255d599f8 | |
parent | 47d41db1070afe84fbb3e173aed87e32cb4587bb (diff) | |
download | keysafe-42b995ed82e26bc18d2a2874ceb65781bceab421.tar.gz |
avoid zenity choking on something it seems to expect to be html
Not documented at all as expecting html in --text. Such bad documentation..
-rw-r--r-- | UI/Zenity.hs | 25 |
1 files 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 '&' = "&" + esc '<' = "<" + esc '>' = ">" + esc c = [c] |