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: ``` <html> <head> <title>hello <fn=1>string</fn> </title> </head> </html> ``` 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: <fn=crash>
author: Sibi Prabakaran <sibi@psibi.in> 2020-05-10 19:43:56 +0530
committer: Sibi Prabakaran <sibi@psibi.in> 2020-05-10 19:43:56 +0530
commit: 3e9e1cb9d300e13109206496d825351c4f41cc1c (patch)
tree: d40f6c9f185ea4b01b6652e4178a5f28e450c8fa
parent: 6f3b730415147041ff34558fe7292a76dc87b1f0 (diff)
download: xmobar-3e9e1cb9d300e13109206496d825351c4f41cc1c.tar.gz
xmobar-3e9e1cb9d300e13109206496d825351c4f41cc1c.tar.bz2
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 "<fn=") (string ">") colors
-  s <- manyTill (allParsers c (read f) a) (try $ string "</fn>")
+  s <- manyTill (allParsers c (maybe 0 id $ readMaybe f) a) (try $ string "</fn>")
   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
author	Sibi Prabakaran <sibi@psibi.in>	2020-05-10 19:43:56 +0530
committer	Sibi Prabakaran <sibi@psibi.in>	2020-05-10 19:43:56 +0530
commit	3e9e1cb9d300e13109206496d825351c4f41cc1c (patch)
tree	d40f6c9f185ea4b01b6652e4178a5f28e450c8fa
parent	6f3b730415147041ff34558fe7292a76dc87b1f0 (diff)
download	xmobar-3e9e1cb9d300e13109206496d825351c4f41cc1c.tar.gz xmobar-3e9e1cb9d300e13109206496d825351c4f41cc1c.tar.bz2