From 44c4f503ae4c79739c52c73fdfa35e754621011c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 22 Sep 2016 11:47:25 -0400 Subject: copy in Utility.UserInfo from git-annex This is worth doing to support falling back to HOME on systems using LDAP or NIS where getpwent fails. --- BackupRecord.hs | 6 ++-- Storage/Local.hs | 6 ++-- Utility/Data.hs | 19 ++++++++++++ Utility/Env.hs | 84 +++++++++++++++++++++++++++++++++++++++++++++++++++++ Utility/UserInfo.hs | 62 +++++++++++++++++++++++++++++++++++++++ 5 files changed, 171 insertions(+), 6 deletions(-) create mode 100644 Utility/Data.hs create mode 100644 Utility/Env.hs create mode 100644 Utility/UserInfo.hs diff --git a/BackupRecord.hs b/BackupRecord.hs index 0a90de2..88a9b68 100644 --- a/BackupRecord.hs +++ b/BackupRecord.hs @@ -10,13 +10,13 @@ module BackupRecord where import Types import Types.Cost import Types.Server +import Utility.UserInfo import GHC.Generics import Data.Time.Clock.POSIX import Data.Aeson import Data.Maybe import System.FilePath import System.Directory -import System.Posix.User import System.Posix.Files import qualified Data.ByteString.Lazy as B @@ -51,8 +51,8 @@ mkBackupRecord servers sks (Entropy n) = BackupRecord backupRecordFile :: IO FilePath backupRecordFile = do - u <- getUserEntryForID =<< getEffectiveUserID - return $ homeDirectory u ".keysafe/backup.log" + home <- myHomeDir + return $ home ".keysafe/backup.log" readBackupRecords :: IO [BackupRecord] readBackupRecords = do diff --git a/Storage/Local.hs b/Storage/Local.hs index 90da7b8..99b92db 100644 --- a/Storage/Local.hs +++ b/Storage/Local.hs @@ -14,12 +14,12 @@ module Storage.Local import Types import Types.Storage import Serialization () +import Utility.UserInfo import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as U8 import Data.Monoid import Data.List import Data.Maybe -import System.Posix.User import System.IO import System.Directory import System.Posix @@ -143,8 +143,8 @@ onError f a = do storageDir :: Maybe LocalStorageDirectory -> GetShareDir storageDir Nothing (Section section) = do - u <- getUserEntryForID =<< getEffectiveUserID - return $ homeDirectory u dotdir section + home <- myHomeDir + return $ home dotdir section storageDir (Just (LocalStorageDirectory d)) (Section section) = pure $ d section diff --git a/Utility/Data.hs b/Utility/Data.hs new file mode 100644 index 0000000..27c0a82 --- /dev/null +++ b/Utility/Data.hs @@ -0,0 +1,19 @@ +{- utilities for simple data types + - + - Copyright 2013 Joey Hess + - + - License: BSD-2-clause + -} + +{-# OPTIONS_GHC -fno-warn-tabs #-} + +module Utility.Data where + +{- First item in the list that is not Nothing. -} +firstJust :: Eq a => [Maybe a] -> Maybe a +firstJust ms = case dropWhile (== Nothing) ms of + [] -> Nothing + (md:_) -> md + +eitherToMaybe :: Either a b -> Maybe b +eitherToMaybe = either (const Nothing) Just diff --git a/Utility/Env.hs b/Utility/Env.hs new file mode 100644 index 0000000..c56f4ec --- /dev/null +++ b/Utility/Env.hs @@ -0,0 +1,84 @@ +{- portable environment variables + - + - Copyright 2013 Joey Hess + - + - License: BSD-2-clause + -} + +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} + +module Utility.Env where + +#ifdef mingw32_HOST_OS +import Utility.Exception +import Control.Applicative +import Data.Maybe +import Prelude +import qualified System.Environment as E +import qualified System.SetEnv +#else +import qualified System.Posix.Env as PE +#endif + +getEnv :: String -> IO (Maybe String) +#ifndef mingw32_HOST_OS +getEnv = PE.getEnv +#else +getEnv = catchMaybeIO . E.getEnv +#endif + +getEnvDefault :: String -> String -> IO String +#ifndef mingw32_HOST_OS +getEnvDefault = PE.getEnvDefault +#else +getEnvDefault var fallback = fromMaybe fallback <$> getEnv var +#endif + +getEnvironment :: IO [(String, String)] +#ifndef mingw32_HOST_OS +getEnvironment = PE.getEnvironment +#else +getEnvironment = E.getEnvironment +#endif + +{- Sets an environment variable. To overwrite an existing variable, + - overwrite must be True. + - + - On Windows, setting a variable to "" unsets it. -} +setEnv :: String -> String -> Bool -> IO () +#ifndef mingw32_HOST_OS +setEnv var val overwrite = PE.setEnv var val overwrite +#else +setEnv var val True = System.SetEnv.setEnv var val +setEnv var val False = do + r <- getEnv var + case r of + Nothing -> setEnv var val True + Just _ -> return () +#endif + +unsetEnv :: String -> IO () +#ifndef mingw32_HOST_OS +unsetEnv = PE.unsetEnv +#else +unsetEnv = System.SetEnv.unsetEnv +#endif + +{- Adds the environment variable to the input environment. If already + - present in the list, removes the old value. + - + - This does not really belong here, but Data.AssocList is for some reason + - buried inside hxt. + -} +addEntry :: Eq k => k -> v -> [(k, v)] -> [(k, v)] +addEntry k v l = ( (k,v) : ) $! delEntry k l + +addEntries :: Eq k => [(k, v)] -> [(k, v)] -> [(k, v)] +addEntries = foldr (.) id . map (uncurry addEntry) . reverse + +delEntry :: Eq k => k -> [(k, v)] -> [(k, v)] +delEntry _ [] = [] +delEntry k (x@(k1,_) : rest) + | k == k1 = rest + | otherwise = ( x : ) $! delEntry k rest diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs new file mode 100644 index 0000000..ec0b0d0 --- /dev/null +++ b/Utility/UserInfo.hs @@ -0,0 +1,62 @@ +{- user info + - + - Copyright 2012 Joey Hess + - + - 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 -- cgit v1.2.3