git-annex/Utility/UserInfo.hs
Joey Hess 8e4cbefbc6
also avoid crashing in most circumstances if unable to determine the username
Mostly the username is only used for the git committer or other display
purposes, and we can just fall back to a dummy value in these cases.

The only remaining place where an error is thrown is when starting local
pairing, which needs the username to be known.
2016-06-08 15:04:15 -04:00

62 lines
1.4 KiB
Haskell

{- user info
-
- Copyright 2012 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.UserInfo (
myHomeDir,
myUserName,
myUserGecos,
) where
import Utility.Env
import Utility.Data
import System.PosixCompat
import Control.Applicative
import Prelude
{- Current user's home directory.
-
- getpwent will fail on LDAP or NIS, so use HOME if set. -}
myHomeDir :: IO FilePath
myHomeDir = either error return =<< myVal env homeDirectory
where
#ifndef mingw32_HOST_OS
env = ["HOME"]
#else
env = ["USERPROFILE", "HOME"] -- HOME is used in Cygwin
#endif
{- Current user's user name. -}
myUserName :: IO (Either String String)
myUserName = myVal env userName
where
#ifndef mingw32_HOST_OS
env = ["USER", "LOGNAME"]
#else
env = ["USERNAME", "USER", "LOGNAME"]
#endif
myUserGecos :: IO (Maybe String)
-- userGecos crashes on Android and is not available on Windows.
#if defined(__ANDROID__) || defined(mingw32_HOST_OS)
myUserGecos = return Nothing
#else
myUserGecos = eitherToMaybe <$> myVal [] userGecos
#endif
myVal :: [String] -> (UserEntry -> String) -> IO (Either String String)
myVal envvars extract = go envvars
where
#ifndef mingw32_HOST_OS
go [] = Right . extract <$> (getUserEntryForID =<< getEffectiveUserID)
#else
go [] = return $ Left ("environment not set: " ++ show envvars)
#endif
go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v