From 3e9e1cb9d300e13109206496d825351c4f41cc1c Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Sun, 10 May 2020 19:43:56 +0530 Subject: Fix crashes/busy looping happening via index Right now, with the `StdinReader` plugin enabled - you can crash/cause busy looping of xmobar if the following html file is opened: ``` hello <fn=1>string</fn> ``` More details about this bug is here: https://github.com/jaor/xmobar/issues/442#issuecomment-625706001 This MR also fixes another bug which produces a crash in xmobar if you pass non integer items between fn: --- src/Xmobar/App/EventLoop.hs | 6 ++++-- src/Xmobar/App/Main.hs | 3 ++- src/Xmobar/System/Utils.hs | 24 ++++++++++++++++++++++-- src/Xmobar/X11/Draw.hs | 10 ++++++---- src/Xmobar/X11/Parsers.hs | 3 ++- src/Xmobar/X11/Types.hs | 3 ++- 6 files changed, 38 insertions(+), 11 deletions(-) diff --git a/src/Xmobar/App/EventLoop.hs b/src/Xmobar/App/EventLoop.hs index f6ab932..cad95a5 100644 --- a/src/Xmobar/App/EventLoop.hs +++ b/src/Xmobar/App/EventLoop.hs @@ -40,6 +40,7 @@ import Control.Exception (bracket_, handle, SomeException(..)) import Data.Bits import Data.Map hiding (foldr, map, filter) import Data.Maybe (fromJust, isJust) +import qualified Data.List.NonEmpty as NE import Xmobar.System.Signal import Xmobar.Config.Types @@ -52,6 +53,7 @@ import Xmobar.X11.Text import Xmobar.X11.Draw import Xmobar.X11.Bitmap as Bitmap import Xmobar.X11.Types +import Xmobar.System.Utils (safeIndex) #ifndef THREADED_RUNTIME import Xmobar.X11.Events(nextEvent') @@ -208,7 +210,7 @@ eventLoop tv xc@(XConf d r w fs vos is cfg) as signal = do eventLoop tv xc as signal reposWindow rcfg = do - r' <- repositionWin d w (head fs) rcfg + r' <- repositionWin d w (NE.head fs) rcfg eventLoop tv (XConf d r' w fs vos is rcfg) as signal updateConfigPosition ocfg = @@ -262,7 +264,7 @@ updateActions conf (Rectangle _ _ wid _) ~[left,center,right] = do strLn :: [(Widget, String, Int, Maybe [Action])] -> IO [(Maybe [Action], Position, Position)] strLn = liftIO . mapM getCoords iconW i = maybe 0 Bitmap.width (lookup i $ iconS conf) - getCoords (Text s,_,i,a) = textWidth d (fs!!i) s >>= \tw -> return (a, 0, fi tw) + getCoords (Text s,_,i,a) = textWidth d (safeIndex fs i) s >>= \tw -> return (a, 0, fi tw) getCoords (Icon s,_,_,a) = return (a, 0, fi $ iconW s) partCoord off xs = map (\(a, x, x') -> (fromJust a, x, x')) $ filter (\(a, _,_) -> isJust a) $ diff --git a/src/Xmobar/App/Main.hs b/src/Xmobar/App/Main.hs index e0b0329..f173e12 100644 --- a/src/Xmobar/App/Main.hs +++ b/src/Xmobar/App/Main.hs @@ -29,6 +29,7 @@ import System.Environment (getArgs) import System.FilePath import System.FilePath.Posix (takeBaseName, takeDirectory) import Text.Parsec.Error (ParseError) +import Data.List.NonEmpty (NonEmpty(..)) import Graphics.X11.Xlib @@ -63,7 +64,7 @@ xmobar conf = withDeferSignals $ do let ic = Map.empty to = textOffset conf ts = textOffsets conf ++ replicate (length fl) (-1) - startLoop (XConf d r w (fs:fl) (to:ts) ic conf) sig refLock vars + startLoop (XConf d r w (fs :| fl) (to:ts) ic conf) sig refLock vars configFromArgs :: Config -> IO Config configFromArgs cfg = getArgs >>= getOpts >>= doOpts cfg . fst diff --git a/src/Xmobar/System/Utils.hs b/src/Xmobar/System/Utils.hs index 59c485c..33f221c 100644 --- a/src/Xmobar/System/Utils.hs +++ b/src/Xmobar/System/Utils.hs @@ -17,11 +17,16 @@ ------------------------------------------------------------------------------ -module Xmobar.System.Utils (expandHome, changeLoop, onSomeException) -where +module Xmobar.System.Utils + ( expandHome + , changeLoop + , onSomeException + , safeIndex + ) where import Control.Monad import Control.Concurrent.STM +import qualified Data.List.NonEmpty as NE import System.Environment import System.FilePath @@ -50,3 +55,18 @@ onSomeException :: IO a -> (SomeException -> IO b) -> IO a onSomeException io what = io `catch` \e -> do _ <- what e throwIO (e :: SomeException) +(!!?) :: [a] -> Int -> Maybe a +(!!?) xs i + | i < 0 = Nothing + | otherwise = go i xs + where + go :: Int -> [a] -> Maybe a + go 0 (x:_) = Just x + go j (_:ys) = go (j - 1) ys + go _ [] = Nothing +{-# INLINE (!!?) #-} + +safeIndex :: NE.NonEmpty a -> Int -> a +safeIndex xs index = case (NE.toList xs) !!? index of + Nothing -> NE.head xs + Just value -> value diff --git a/src/Xmobar/X11/Draw.hs b/src/Xmobar/X11/Draw.hs index 23003b3..b7f58ca 100644 --- a/src/Xmobar/X11/Draw.hs +++ b/src/Xmobar/X11/Draw.hs @@ -25,6 +25,7 @@ import Control.Monad.Reader import Control.Monad (when) import Control.Arrow ((&&&)) import Data.Map hiding (foldr, map, filter) +import qualified Data.List.NonEmpty as NE import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras @@ -37,6 +38,7 @@ import Xmobar.X11.Text import Xmobar.X11.ColorCache import Xmobar.X11.Window (drawBorder) import Xmobar.X11.Parsers (Widget(..)) +import Xmobar.System.Utils (safeIndex) #ifdef XFT import Xmobar.X11.MinXft @@ -55,7 +57,7 @@ drawInWin wr@(Rectangle _ _ wid ht) ~[left,center,right] = do strLn = liftIO . mapM getWidth iconW i = maybe 0 B.width (lookup i $ iconS r) getWidth (Text s,cl,i,_) = - textWidth d (fs!!i) s >>= \tw -> return (Text s,cl,i,fi tw) + textWidth d (safeIndex fs i) s >>= \tw -> return (Text s,cl,i,fi tw) getWidth (Icon s,cl,i,_) = return (Icon s,cl,i,fi $ iconW s) p <- liftIO $ createPixmap d w wid ht @@ -126,7 +128,7 @@ printString dpy drw fs@(Xft fonts) _ fc bc x y s al = #endif -- | An easy way to print the stuff we need to print -printStrings :: Drawable -> GC -> [XFont] -> [Int] -> Position +printStrings :: Drawable -> GC -> NE.NonEmpty XFont -> [Int] -> Position -> Align -> [(Widget, String, Int, Position)] -> X () printStrings _ _ _ _ _ _ [] = return () printStrings dr gc fontlist voffs offs a sl@((s,c,i,l):xs) = do @@ -136,7 +138,7 @@ printStrings dr gc fontlist voffs offs a sl@((s,c,i,l):xs) = do Rectangle _ _ wid ht = rect r totSLen = foldr (\(_,_,_,len) -> (+) len) 0 sl remWidth = fi wid - fi totSLen - fontst = fontlist !! i + fontst = safeIndex fontlist i offset = case a of C -> (remWidth + offs) `div` 2 R -> remWidth @@ -144,7 +146,7 @@ printStrings dr gc fontlist voffs offs a sl@((s,c,i,l):xs) = do (fc,bc) = case break (==',') c of (f,',':b) -> (f, b ) (f, _) -> (f, bgColor conf) - valign <- verticalOffset ht s (head fontlist) (voffs !! i) conf + valign <- verticalOffset ht s (NE.head fontlist) (voffs !! i) conf case s of (Text t) -> liftIO $ printString d dr fontst gc fc bc offset valign t alph (Icon p) -> liftIO $ maybe (return ()) diff --git a/src/Xmobar/X11/Parsers.hs b/src/Xmobar/X11/Parsers.hs index 7fa42d7..4c8a130 100644 --- a/src/Xmobar/X11/Parsers.hs +++ b/src/Xmobar/X11/Parsers.hs @@ -21,6 +21,7 @@ import Xmobar.X11.Actions import Control.Monad (guard, mzero) import Text.ParserCombinators.Parsec +import Text.Read (readMaybe) import Graphics.X11.Types (Button) data Widget = Icon String | Text String @@ -138,7 +139,7 @@ fontParser :: ColorString -> Maybe [Action] -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] fontParser c a = do f <- between (string "") colors - s <- manyTill (allParsers c (read f) a) (try $ string "") + s <- manyTill (allParsers c (maybe 0 id $ readMaybe f) a) (try $ string "") return (concat s) -- | Parses a color specification (hex or named) diff --git a/src/Xmobar/X11/Types.hs b/src/Xmobar/X11/Types.hs index 333dc96..b22f807 100644 --- a/src/Xmobar/X11/Types.hs +++ b/src/Xmobar/X11/Types.hs @@ -20,6 +20,7 @@ module Xmobar.X11.Types (X, XConf (..)) where import Graphics.X11.Xlib import Control.Monad.Reader import Data.Map +import qualified Data.List.NonEmpty as NE import Xmobar.X11.Bitmap import Xmobar.X11.Text @@ -33,7 +34,7 @@ data XConf = XConf { display :: Display , rect :: Rectangle , window :: Window - , fontListS :: [XFont] + , fontListS :: NE.NonEmpty XFont , verticalOffsets :: [Int] , iconS :: Map FilePath Bitmap , config :: Config -- cgit v1.2.3