Add fallback for utmp read fail (for chroot).

1 files changed, 10 insertions, 1 deletions

diff --git a/Presence/UTmp.hs b/Presence/UTmp.hs
index b43278da..aa2a7733 100644
--- a/Presence/UTmp.hs
+++ b/Presence/UTmp.hs
@@ -17,8 +17,10 @@ import qualified Data.ByteString.Lazy.Char8 as L
 import Data.BitSyntax
 import Data.Functor.Identity
 import Data.Maybe
+import System.Posix.Process
 import System.Posix.Signals
 import System.Posix.Types
+import System.Posix.User
 import Control.Monad
 import Data.Word
 import Data.Int
@@ -161,7 +163,14 @@ type UserName = L.ByteString
 type Tty      = L.ByteString
 
 users :: IO [(UserName, Tty, ProcessID)]
-users = fmap (map only3) $ do
+users = utmp_users `catchIOError` \_ -> do
+            -- If we can't read utmp file, then return a list with only the current
+            -- user.
+            uname <- getLoginName
+            pid <- getProcessID -- TODO: XXX: Does this make sense as a fallback?
+            return [(L.pack uname,L.empty,pid)]
+ where
+  utmp_users = fmap (map only3) $ do
     us <- utmp
     let us' = map interp_utmp_record us
         us'' = mapMaybe user_proc us'