From 0be1c97f27cca1b514c545f03ed618a7f0043aec Mon Sep 17 00:00:00 2001 From: Jens Petersen Date: Mon, 22 Jul 2013 21:21:25 +0900 Subject: [PATCH 1/2] backport patch from 0.11.2 to sanitize DynamicLog output (potential vulnerability) --- ghc-xmonad-contrib.spec | 3 +- xmonad-contrib-DynamicLog-0.11.2.patch | 84 ++++++++++++++++++++++++++ 2 files changed, 86 insertions(+), 1 deletion(-) create mode 100644 xmonad-contrib-DynamicLog-0.11.2.patch diff --git a/ghc-xmonad-contrib.spec b/ghc-xmonad-contrib.spec index 40347c1..9b58b70 100644 --- a/ghc-xmonad-contrib.spec +++ b/ghc-xmonad-contrib.spec @@ -31,6 +31,7 @@ Patch3: xmonad-contrib-0.10-BorderResize-smaller.patch Patch4: xmonad-contrib-0.10-PositionStore-dont-rescale-with-screen.patch Patch5: xmonad-contrib-0.10-X11-1.6.patch Patch6: xmonad-contrib-0.10-takeFocus-core.patch +Patch7: xmonad-contrib-DynamicLog-0.11.2.patch BuildRequires: ghc-Cabal-devel BuildRequires: ghc-rpm-macros @@ -65,7 +66,7 @@ BuildRequires: ghc-xmonad-devel %patch5 -p1 -b .orig-X11 %endif %patch6 -p1 -b .orig-Focus - +%patch7 -p1 -b .orig-sanitize %build %ghc_lib_build diff --git a/xmonad-contrib-DynamicLog-0.11.2.patch b/xmonad-contrib-DynamicLog-0.11.2.patch new file mode 100644 index 0000000..0caa5df --- /dev/null +++ b/xmonad-contrib-DynamicLog-0.11.2.patch @@ -0,0 +1,84 @@ +diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs +index 0547c80..1d256c6 100644 +--- a/XMonad/Hooks/DynamicLog.hs ++++ b/XMonad/Hooks/DynamicLog.hs +@@ -1,4 +1,4 @@ +-{-# LANGUAGE FlexibleContexts #-} ++{-# LANGUAGE FlexibleContexts, PatternGuards #-} + + ----------------------------------------------------------------------------- + -- | +@@ -57,10 +57,10 @@ module XMonad.Hooks.DynamicLog ( + -- Useful imports + + import Codec.Binary.UTF8.String (encodeString) +-import Control.Monad (liftM2) ++import Control.Monad (liftM2, msum) + import Data.Char ( isSpace, ord ) +-import Data.List (intersperse, isPrefixOf, sortBy) +-import Data.Maybe ( isJust, catMaybes ) ++import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy) ++import Data.Maybe ( isJust, catMaybes, mapMaybe ) + import Data.Ord ( comparing ) + import qualified Data.Map as M + import qualified XMonad.StackSet as S +@@ -279,7 +279,7 @@ dynamicLogString pp = do + return $ encodeString . sepBy (ppSep pp) . ppOrder pp $ + [ ws + , ppLayout pp ld +- , ppTitle pp wt ++ , ppTitle pp $ ppTitleSanitize pp wt + ] + ++ catMaybes extras + +@@ -396,14 +396,26 @@ xmobarColor fg bg = wrap t "" + + -- | Strip xmobar markup. + xmobarStrip :: String -> String +-xmobarStrip = strip [] where ++xmobarStrip = xmobarStripTags ["fc","icon","action"] where ++ ++xmobarStripTags :: [String] -- ^ tags ++ -> String -> String -- ^ with all ... removed ++xmobarStripTags tags = strip [] where ++ strip keep [] = keep + strip keep x +- | null x = keep +- | "') $ x) +- | "" `isPrefixOf` x = strip keep (drop 5 x) +- | '<' == head x = strip (keep ++ "<") (tail x) +- | otherwise = let (good,x') = span (/= '<') x +- in strip (keep ++ good) x' ++ | rest: _ <- mapMaybe dropTag tags = strip keep rest ++ ++ ++ | '<':xs <- x = strip (keep ++ "<") xs ++ | (good,x') <- span (/= '<') x = strip (keep ++ good) x' -- this is n^2 bad... but titles have few tags ++ where dropTag :: String -> Maybe String ++ dropTag tag = msum [fmap dropTilClose (openTag tag `stripPrefix` x), ++ closeTag tag `stripPrefix` x] ++ ++ dropTilClose, openTag, closeTag :: String -> String ++ dropTilClose = drop 1 . dropWhile (/= '>') ++ openTag str = "<" ++ str ++ "=" ++ closeTag str = "" + + -- | The 'PP' type allows the user to customize the formatting of + -- status information. +@@ -427,6 +439,8 @@ data PP = PP { ppCurrent :: WorkspaceId -> String + -- ^ separator to use between workspace tags + , ppTitle :: String -> String + -- ^ window title format ++ , ppTitleSanitize :: String -> String ++ -- ^ escape / sanitizes input to 'ppTitle' + , ppLayout :: String -> String + -- ^ layout name format + , ppOrder :: [String] -> [String] +@@ -468,6 +482,7 @@ defaultPP = PP { ppCurrent = wrap "[" "]" + , ppSep = " : " + , ppWsSep = " " + , ppTitle = shorten 80 ++ , ppTitleSanitize = xmobarStrip . dzenEscape + , ppLayout = id + , ppOrder = id + , ppOutput = putStrLn From 98b3b016c7e5566c1e5229861d6185bbbb12ed41 Mon Sep 17 00:00:00 2001 From: Jens Petersen Date: Mon, 22 Jul 2013 21:53:11 +0900 Subject: [PATCH 2/2] bump release --- ghc-xmonad-contrib.spec | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/ghc-xmonad-contrib.spec b/ghc-xmonad-contrib.spec index 9b58b70..4197677 100644 --- a/ghc-xmonad-contrib.spec +++ b/ghc-xmonad-contrib.spec @@ -18,7 +18,7 @@ your own extensions. Name: ghc-%{pkg_name} Version: 0.10 -Release: 7%{?dist} +Release: 7.1%{?dist} Summary: %{common_summary} License: BSD @@ -89,6 +89,10 @@ BuildRequires: ghc-xmonad-devel %changelog +* Mon Jul 22 2013 Jens Petersen - 0.10-7.1 +- backport patch from 0.11.2 to sanitize DynamicLog output + (potential vulnerability) + * Sat Nov 17 2012 Jens Petersen - 0.10-7 - add ICCCMFocus patch from upstream for WM_TAKE_FOCUS move to core (#874855) - use a patch for use_xft flag