{-# LINE 1 "libraries/unix/System/Posix/User.hsc" #-}
{-# LANGUAGE Trustworthy, CApiFFI, PatternSynonyms, ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.User
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- POSIX user\/group support
--
-----------------------------------------------------------------------------

module System.Posix.User (
    -- * User environment
    -- ** Querying the user environment
    getRealUserID,
    getRealGroupID,
    getEffectiveUserID,
    getEffectiveGroupID,
    getGroups,
    getLoginName,
    getEffectiveUserName,

    -- *** The group database
    groupName,
    groupPassword,
    groupID,
    groupMembers,
    pattern GroupEntry,
    getGroupEntryForID,
    getGroupEntryForName,
    getAllGroupEntries,

    -- *** The user database
    userName,
    userPassword,
    userID,
    userGroupID,
    userGecos,
    homeDirectory,
    userShell,
    pattern UserEntry,

    getUserEntryForID,
    getUserEntryForName,
    getAllUserEntries,

    -- ** Modifying the user environment
    setUserID,
    setGroupID,
    setEffectiveUserID,
    setEffectiveGroupID,
    setGroups

  ) where



import System.Posix.Types
import System.IO.Unsafe (unsafePerformIO)
import Foreign.C
import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable
import System.Posix.User.Common ( UserEntry, GroupEntry

{-# LINE 70 "libraries/unix/System/Posix/User.hsc" #-}
      , unpackUserEntry, unpackGroupEntry, LKUPTYPE(..), CPasswd, CGroup

{-# LINE 72 "libraries/unix/System/Posix/User.hsc" #-}
  )
import qualified System.Posix.User.Common as User


{-# LINE 76 "libraries/unix/System/Posix/User.hsc" #-}

{-# LINE 77 "libraries/unix/System/Posix/User.hsc" #-}
import Control.Concurrent (runInBoundThread, rtsSupportsBoundThreads)

{-# LINE 79 "libraries/unix/System/Posix/User.hsc" #-}
import Control.Concurrent.MVar ( MVar, newMVar, withMVar )
import Control.Exception

{-# LINE 82 "libraries/unix/System/Posix/User.hsc" #-}
import Control.Monad
import System.IO.Error
import qualified Data.ByteString.Char8 as C8


{-# LINE 90 "libraries/unix/System/Posix/User.hsc" #-}



{-# LINE 155 "libraries/unix/System/Posix/User.hsc" #-}
-- -----------------------------------------------------------------------------
-- Thread safety of passwd/group database access APIs:
--
-- All supported unix platforms have @get(pw|gr)(nam|[ug]id)_r(3)@, which
-- store the result in a caller provided buffer, which solves the most
-- immediate thread-safety issues.
--
-- Things are more complicated for getpwent(3) and getgrent(3).
--
-- * On Linux systems, these read a global open file, opened via
--   setpwent(3) and closed via endpwent(3).  Only one thread at
--   a time can safely iterate through the file.
--
-- * On macOS (through Catalina 10.15), there is no getpwent_r(3) or
--   getgrent_r(3), so a lock is also required for safe buffer sharing.
--
-- * On FreeBSD, in the default configuration with passwd lookups configured
--   in nsswitch.conf to use "compat" rather than "files", the getpwnam_r(3)
--   and getpwuid_r(3) functions reset the iterator index used by getpwent(3).
--   A bug [report](https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=252094)
--   has been filed to track this long-standing issue.  A similar issue affects
--   getgrent(3), this time regardless of the nsswitch.conf setting.  This too
--   should be fixed at some point in the future.  The state in question is
--   thread-specific, so both issues only affect overlapping use of the @*ent@
--   and @*(nam|[ug]id)_r(3)@ functions in the /same/ thread.
--
-- * Despite rather similar manpages for getpwent(3) and getpwnam(3), ... as
--   on FreeBSD, the above issue is not seen on NetBSD or macOS.
--
--   This is not an issue with 1-to-1 thread models, where the code executing
--   @get(pw|gr)ent@ has exclusive use of its thread, but it is a real issue
--   for Haskell with its many-to-1 green threads, because multiple `forkIO`
--   threads may take turns using the same underlying OS thread, breaking the
--   thread-safety of the @*_r@ functions, which mutate the file-offset of the
--   open file shared with any overlapping execution of @*ent(3)@ in the same
--   thread.
--
-- Consequently, correct portable support for @get(pw|gr)ent(3)@ is rather
-- non-trivial.  In the threaded runtime, we can run these functions in a
-- /bound thread/ (via 'forkOS'), thereby avoiding the FreeBSD issues.  We
-- still need a lock to serialise multiple threads calling these functions
-- on at least macOS for lack of @_r@ equivalents.  While on FreeBSD we could
-- use @getpwent_r(3)@ and @getgrent_r(3)@ in a bound thread without any
-- locks, implementing this special case is likely not worthwhile.
--
-- In the non-threaded runtime, `forkOS` is not available, and so on FreeBSD
-- systems we have to also lock the @*(nam|[ug]id)_r(3)@ functions to avoid
-- concurrent use with @*ent(3)@.
--
-- FWIW, the below Perl one-liners will quickly show whether interleaved calls
-- of getpwuid() or getgrgid() disturb iteration through all the entries. If
-- each line of output is distinct, there is likely no issue.  If the same
-- passwd or group entry repeats multiple times, the system is affected.
--
-- > for ($i=0;$i<3;++$i) {getpwuid(0); print join(":",getpwent()),"\n"}
-- > for ($i=0;$i<3;++$i) {getgrgid(0); print join(":",getgrent()),"\n"}
--
-- XXX: It has been suggested, not without some merit, that attempts to
-- enumerate /all/ users or /all/ groups are fundamentally flawed.  Modern
-- unix systems have a variety nsswitch backends, some of which instantiate
-- users on demand or may enumerate slowly or not at all.  We could shed a
-- lot of complexity by deprecating the "get all" functions and simply
-- always returning an empty list.
--


{-# LINE 221 "libraries/unix/System/Posix/User.hsc" #-}
pwlock :: MVar ()
pwlock :: MVar ()
pwlock = IO (MVar ()) -> MVar ()
forall a. IO a -> a
unsafePerformIO (IO (MVar ()) -> MVar ()) -> IO (MVar ()) -> MVar ()
forall a b. (a -> b) -> a -> b
$ () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
{-# NOINLINE pwlock #-}

lockpw :: LKUPTYPE -> IO a -> IO a

{-# LINE 227 "libraries/unix/System/Posix/User.hsc" #-}
lockpw GETONE
    | rtsSupportsBoundThreads = id
    | otherwise = withMVar pwlock . const
lockpw GETALL
    | rtsSupportsBoundThreads = runInBoundThread . withMVar pwlock . const
    | otherwise = withMVar pwlock . const

{-# LINE 237 "libraries/unix/System/Posix/User.hsc" #-}

{-# LINE 240 "libraries/unix/System/Posix/User.hsc" #-}


{-# LINE 242 "libraries/unix/System/Posix/User.hsc" #-}
grlock :: MVar ()
grlock :: MVar ()
grlock = IO (MVar ()) -> MVar ()
forall a. IO a -> a
unsafePerformIO (IO (MVar ()) -> MVar ()) -> IO (MVar ()) -> MVar ()
forall a b. (a -> b) -> a -> b
$ () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
{-# NOINLINE grlock #-}

lockgr :: LKUPTYPE -> IO a -> IO a

{-# LINE 248 "libraries/unix/System/Posix/User.hsc" #-}
lockgr GETONE
    | rtsSupportsBoundThreads = id
    | otherwise = withMVar grlock . const
lockgr GETALL
    | rtsSupportsBoundThreads = runInBoundThread . withMVar grlock . const
    | otherwise = withMVar grlock . const

{-# LINE 258 "libraries/unix/System/Posix/User.hsc" #-}

{-# LINE 261 "libraries/unix/System/Posix/User.hsc" #-}

-- -----------------------------------------------------------------------------
-- user environment

-- | @getRealUserID@ calls @getuid@ to obtain the real @UserID@
--   associated with the current process.
getRealUserID :: IO UserID
getRealUserID :: IO UserID
getRealUserID = IO UserID
c_getuid

foreign import ccall unsafe "getuid"
  c_getuid :: IO CUid

-- | @getRealGroupID@ calls @getgid@ to obtain the real @GroupID@
--   associated with the current process.
getRealGroupID :: IO GroupID
getRealGroupID :: IO GroupID
getRealGroupID = IO GroupID
c_getgid

foreign import ccall unsafe "getgid"
  c_getgid :: IO CGid

-- | @getEffectiveUserID@ calls @geteuid@ to obtain the effective
--   @UserID@ associated with the current process.
getEffectiveUserID :: IO UserID
getEffectiveUserID :: IO UserID
getEffectiveUserID = IO UserID
c_geteuid

foreign import ccall unsafe "geteuid"
  c_geteuid :: IO CUid

-- | @getEffectiveGroupID@ calls @getegid@ to obtain the effective
--   @GroupID@ associated with the current process.
getEffectiveGroupID :: IO GroupID
getEffectiveGroupID :: IO GroupID
getEffectiveGroupID = IO GroupID
c_getegid

foreign import ccall unsafe "getegid"
  c_getegid :: IO CGid

-- | @getGroups@ calls @getgroups@ to obtain the list of
--   supplementary @GroupID@s associated with the current process.
getGroups :: IO [GroupID]
getGroups :: IO [GroupID]
getGroups = do
    CInt
ngroups <- CInt -> Ptr GroupID -> IO CInt
c_getgroups CInt
0 Ptr GroupID
forall a. Ptr a
nullPtr
    Int -> (Ptr GroupID -> IO [GroupID]) -> IO [GroupID]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
ngroups) ((Ptr GroupID -> IO [GroupID]) -> IO [GroupID])
-> (Ptr GroupID -> IO [GroupID]) -> IO [GroupID]
forall a b. (a -> b) -> a -> b
$ \Ptr GroupID
arr -> do
       String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"getGroups" (CInt -> Ptr GroupID -> IO CInt
c_getgroups CInt
ngroups Ptr GroupID
arr)
       [GroupID]
groups <- Int -> Ptr GroupID -> IO [GroupID]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
ngroups) Ptr GroupID
arr
       [GroupID] -> IO [GroupID]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [GroupID]
groups

foreign import ccall unsafe "getgroups"
  c_getgroups :: CInt -> Ptr CGid -> IO CInt


-- | @setGroups@ calls @setgroups@ to set the list of
--   supplementary @GroupID@s associated with the current process.
setGroups :: [GroupID] -> IO ()
setGroups :: [GroupID] -> IO ()
setGroups [GroupID]
groups = do
    [GroupID] -> (Int -> Ptr GroupID -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [GroupID]
groups ((Int -> Ptr GroupID -> IO ()) -> IO ())
-> (Int -> Ptr GroupID -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Int
ngroups Ptr GroupID
arr ->
       String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setGroups" (CInt -> Ptr GroupID -> IO CInt
c_setgroups (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ngroups) Ptr GroupID
arr)

foreign import ccall unsafe "setgroups"
  c_setgroups :: CInt -> Ptr CGid -> IO CInt


-- | @getLoginName@ calls @getlogin@ to obtain the login name
--   associated with the current process.
getLoginName :: IO String
getLoginName :: IO String
getLoginName =  do
    -- ToDo: use getlogin_r
    Ptr CChar
str <- String -> IO (Ptr CChar) -> IO (Ptr CChar)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNull String
"getLoginName" IO (Ptr CChar)
c_getlogin
    Ptr CChar -> IO String
peekCAString Ptr CChar
str

foreign import ccall unsafe "getlogin"
  c_getlogin :: IO CString

-- | @setUserID uid@ calls @setuid@ to set the real, effective, and
--   saved set-user-id associated with the current process to @uid@.
setUserID :: UserID -> IO ()
setUserID :: UserID -> IO ()
setUserID UserID
uid = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setUserID" (UserID -> IO CInt
c_setuid UserID
uid)

foreign import ccall unsafe "setuid"
  c_setuid :: CUid -> IO CInt

-- | @setEffectiveUserID uid@ calls @seteuid@ to set the effective
--   user-id associated with the current process to @uid@. This
--   does not update the real user-id or set-user-id.
setEffectiveUserID :: UserID -> IO ()
setEffectiveUserID :: UserID -> IO ()
setEffectiveUserID UserID
uid = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setEffectiveUserID" (UserID -> IO CInt
c_seteuid UserID
uid)

foreign import ccall unsafe "seteuid"
  c_seteuid :: CUid -> IO CInt

-- | @setGroupID gid@ calls @setgid@ to set the real, effective, and
--   saved set-group-id associated with the current process to @gid@.
setGroupID :: GroupID -> IO ()
setGroupID :: GroupID -> IO ()
setGroupID GroupID
gid = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setGroupID" (GroupID -> IO CInt
c_setgid GroupID
gid)

foreign import ccall unsafe "setgid"
  c_setgid :: CGid -> IO CInt

-- | @setEffectiveGroupID uid@ calls @setegid@ to set the effective
--   group-id associated with the current process to @gid@. This
--   does not update the real group-id or set-group-id.
setEffectiveGroupID :: GroupID -> IO ()
setEffectiveGroupID :: GroupID -> IO ()
setEffectiveGroupID GroupID
gid =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setEffectiveGroupID" (GroupID -> IO CInt
c_setegid GroupID
gid)


foreign import ccall unsafe "setegid"
  c_setegid :: CGid -> IO CInt

-- -----------------------------------------------------------------------------
-- User names

-- | @getEffectiveUserName@ gets the name
--   associated with the effective @UserID@ of the process.
getEffectiveUserName :: IO String
getEffectiveUserName :: IO String
getEffectiveUserName = do
    UserID
euid <- IO UserID
getEffectiveUserID
    UserEntry
pw <- UserID -> IO UserEntry
getUserEntryForID UserID
euid
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UserEntry -> String
userName UserEntry
pw)


{-# LINE 381 "libraries/unix/System/Posix/User.hsc" #-}

-- -----------------------------------------------------------------------------
-- The group database (grp.h)

groupName :: GroupEntry -> String
groupName :: GroupEntry -> String
groupName (GroupEntry String
gn String
_ GroupID
_ [String]
_) = String
gn

groupPassword :: GroupEntry -> String
groupPassword :: GroupEntry -> String
groupPassword (GroupEntry String
_ String
gp GroupID
_ [String]
_) = String
gp

groupID :: GroupEntry -> GroupID
groupID :: GroupEntry -> GroupID
groupID (GroupEntry String
_ String
_ GroupID
id' [String]
_) = GroupID
id'

groupMembers :: GroupEntry -> [String]
groupMembers :: GroupEntry -> [String]
groupMembers (GroupEntry String
_ String
_ GroupID
_ [String]
gm) = [String]
gm

-- | Manually constructing 'GroupEntry' in String modules is discouraged. It will truncate
-- Chars to 8bit. Use 'System.Posix.User.ByteString' instead.
pattern GroupEntry :: String          -- ^ The name of this group (gr_name)
                   -> String          -- ^ The password for this group (gr_passwd)
                   -> GroupID         -- ^ The unique numeric ID for this group (gr_gid)
                   -> [String]        -- ^ A list of zero or more usernames that are members (gr_mem)
                   -> GroupEntry
pattern $mGroupEntry :: forall {r}.
GroupEntry
-> (String -> String -> GroupID -> [String] -> r)
-> ((# #) -> r)
-> r
$bGroupEntry :: String -> String -> GroupID -> [String] -> GroupEntry
GroupEntry gn gp gi gm <- User.GroupEntry (C8.unpack -> gn) (C8.unpack -> gp) gi (fmap C8.unpack -> gm) where
  GroupEntry String
gn String
gp GroupID
gi [String]
gm = ByteString -> ByteString -> GroupID -> [ByteString] -> GroupEntry
User.GroupEntry (String -> ByteString
C8.pack String
gn) (String -> ByteString
C8.pack String
gp) GroupID
gi (String -> ByteString
C8.pack (String -> ByteString) -> [String] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
gm)
{-# COMPLETE GroupEntry #-}


{-# LINE 426 "libraries/unix/System/Posix/User.hsc" #-}

-- | @getGroupEntryForID gid@ calls @getgrgid_r@ to obtain
--   the @GroupEntry@ information associated with @GroupID@
--   @gid@. This operation may fail with 'isDoesNotExistError'
--   if no such group exists.
getGroupEntryForID :: GroupID -> IO GroupEntry

{-# LINE 433 "libraries/unix/System/Posix/User.hsc" #-}
getGroupEntryForID gid = lockgr GETONE $
    allocaBytes (32) $ \pgr ->
{-# LINE 435 "libraries/unix/System/Posix/User.hsc" #-}
        doubleAllocWhileERANGE "getGroupEntryForID" "group"
            grBufSize unpackGroupEntry $ c_getgrgid_r gid pgr

foreign import capi safe "HsUnix.h getgrgid_r"
  c_getgrgid_r :: CGid -> Ptr CGroup -> CString
                 -> CSize -> Ptr (Ptr CGroup) -> IO CInt

{-# LINE 445 "libraries/unix/System/Posix/User.hsc" #-}

-- | @getGroupEntryForName name@ calls @getgrnam_r@ to obtain
--   the @GroupEntry@ information associated with the group called
--   @name@. This operation may fail with 'isDoesNotExistError'
--   if no such group exists.
getGroupEntryForName :: String -> IO GroupEntry

{-# LINE 452 "libraries/unix/System/Posix/User.hsc" #-}
getGroupEntryForName name = lockgr GETONE $
    allocaBytes (32) $ \pgr ->
{-# LINE 454 "libraries/unix/System/Posix/User.hsc" #-}
        withCAString name $ \ pstr ->
            doubleAllocWhileERANGE "getGroupEntryForName" "group"
                grBufSize unpackGroupEntry $ c_getgrnam_r pstr pgr

foreign import capi safe "HsUnix.h getgrnam_r"
  c_getgrnam_r :: CString -> Ptr CGroup -> CString
                 -> CSize -> Ptr (Ptr CGroup) -> IO CInt

{-# LINE 465 "libraries/unix/System/Posix/User.hsc" #-}

-- | @getAllGroupEntries@ returns all group entries on the system by
--   repeatedly calling @getgrent@

--
-- getAllGroupEntries may fail with isDoesNotExistError on Linux due to
-- this bug in glibc:
--   http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=466647
--
getAllGroupEntries :: IO [GroupEntry]

{-# LINE 476 "libraries/unix/System/Posix/User.hsc" #-}
getAllGroupEntries = lockgr GETALL $ bracket_ c_setgrent c_endgrent $ worker []
  where
    worker accum = do
        resetErrno
        ppw <- throwErrnoIfNullAndError "getAllGroupEntries" $ c_getgrent
        if ppw == nullPtr
            then return (reverse accum)
            else do thisentry <- unpackGroupEntry ppw
                    worker (thisentry : accum)

foreign import ccall safe "getgrent" c_getgrent :: IO (Ptr CGroup)
foreign import ccall safe "setgrent" c_setgrent :: IO ()
foreign import ccall safe "endgrent" c_endgrent :: IO ()

{-# LINE 493 "libraries/unix/System/Posix/User.hsc" #-}


{-# LINE 495 "libraries/unix/System/Posix/User.hsc" #-}
grBufSize :: Int

{-# LINE 497 "libraries/unix/System/Posix/User.hsc" #-}
grBufSize = sysconfWithDefault 1024 (70)
{-# LINE 498 "libraries/unix/System/Posix/User.hsc" #-}

{-# LINE 501 "libraries/unix/System/Posix/User.hsc" #-}

{-# LINE 502 "libraries/unix/System/Posix/User.hsc" #-}


{-# LINE 504 "libraries/unix/System/Posix/User.hsc" #-}

-- -----------------------------------------------------------------------------
-- The user database (pwd.h)

userName :: UserEntry -> String
userName :: UserEntry -> String
userName (UserEntry String
n String
_ UserID
_ GroupID
_ String
_ String
_ String
_) = String
n

userPassword :: UserEntry -> String
userPassword :: UserEntry -> String
userPassword (UserEntry String
_ String
p UserID
_ GroupID
_ String
_ String
_ String
_) = String
p

userID :: UserEntry -> UserID
userID :: UserEntry -> UserID
userID (UserEntry String
_ String
_ UserID
id' GroupID
_ String
_ String
_ String
_) = UserID
id'

userGroupID :: UserEntry -> GroupID
userGroupID :: UserEntry -> GroupID
userGroupID (UserEntry String
_ String
_ UserID
_ GroupID
gid String
_ String
_ String
_) = GroupID
gid

userGecos :: UserEntry -> String
userGecos :: UserEntry -> String
userGecos (UserEntry String
_ String
_ UserID
_ GroupID
_ String
ge String
_ String
_) = String
ge

homeDirectory :: UserEntry -> String
homeDirectory :: UserEntry -> String
homeDirectory (UserEntry String
_ String
_ UserID
_ GroupID
_ String
_ String
hd String
_) = String
hd

userShell :: UserEntry -> String
userShell :: UserEntry -> String
userShell (UserEntry String
_ String
_ UserID
_ GroupID
_ String
_ String
_ String
us) = String
us

-- | Manually constructing 'UserEntry' in String modules is discouraged. It will truncate
-- Chars to 8bit. Use 'System.Posix.User.ByteString' instead.
pattern UserEntry :: String         -- ^ Textual name of this user (pw_name)
                  -> String         -- ^ Password -- may be empty or fake if shadow is in use (pw_passwd)
                  -> UserID         -- ^ Numeric ID for this user (pw_uid)
                  -> GroupID        -- ^ Primary group ID (pw_gid)
                  -> String         -- ^ Usually the real name for the user (pw_gecos)
                  -> String         -- ^ Home directory (pw_dir)
                  -> String         -- ^ Default shell (pw_shell)
                  -> UserEntry
pattern $mUserEntry :: forall {r}.
UserEntry
-> (String
    -> String -> UserID -> GroupID -> String -> String -> String -> r)
-> ((# #) -> r)
-> r
$bUserEntry :: String
-> String
-> UserID
-> GroupID
-> String
-> String
-> String
-> UserEntry
UserEntry un up ui ugi ug hd us <- User.UserEntry (C8.unpack -> un)
                                                       (C8.unpack -> up)
                                                       ui
                                                       ugi
                                                       (C8.unpack -> ug)
                                                       (C8.unpack -> hd)
                                                       (C8.unpack -> us) where
  UserEntry String
un String
up UserID
ui GroupID
ugi String
ug String
hd String
us = ByteString
-> ByteString
-> UserID
-> GroupID
-> ByteString
-> ByteString
-> ByteString
-> UserEntry
User.UserEntry (String -> ByteString
C8.pack String
un)
                                                (String -> ByteString
C8.pack String
up)
                                                UserID
ui
                                                GroupID
ugi
                                                (String -> ByteString
C8.pack String
ug)
                                                (String -> ByteString
C8.pack String
hd)
                                                (String -> ByteString
C8.pack String
us)
{-# COMPLETE UserEntry #-}

-- | @getUserEntryForID uid@ calls @getpwuid_r@ to obtain
--   the @UserEntry@ information associated with @UserID@
--   @uid@. This operation may fail with 'isDoesNotExistError'
--   if no such user exists.
getUserEntryForID :: UserID -> IO UserEntry

{-# LINE 561 "libraries/unix/System/Posix/User.hsc" #-}
getUserEntryForID uid = lockpw GETONE $
    allocaBytes (80) $ \ppw ->
{-# LINE 563 "libraries/unix/System/Posix/User.hsc" #-}
        doubleAllocWhileERANGE "getUserEntryForID" "user"
            pwBufSize unpackUserEntry $ c_getpwuid_r uid ppw

foreign import capi safe "HsUnix.h getpwuid_r"
  c_getpwuid_r :: CUid -> Ptr CPasswd ->
                        CString -> CSize -> Ptr (Ptr CPasswd) -> IO CInt

{-# LINE 573 "libraries/unix/System/Posix/User.hsc" #-}

-- | @getUserEntryForName name@ calls @getpwnam_r@ to obtain
--   the @UserEntry@ information associated with the user login
--   @name@. This operation may fail with 'isDoesNotExistError'
--   if no such user exists.
getUserEntryForName :: String -> IO UserEntry

{-# LINE 580 "libraries/unix/System/Posix/User.hsc" #-}
getUserEntryForName name = lockpw GETONE $
    allocaBytes (80) $ \ppw ->
{-# LINE 582 "libraries/unix/System/Posix/User.hsc" #-}
        withCAString name $ \ pstr ->
            doubleAllocWhileERANGE "getUserEntryForName" "user"
                pwBufSize unpackUserEntry $ c_getpwnam_r pstr ppw

foreign import capi safe "HsUnix.h getpwnam_r"
  c_getpwnam_r :: CString -> Ptr CPasswd
               -> CString -> CSize -> Ptr (Ptr CPasswd) -> IO CInt

{-# LINE 593 "libraries/unix/System/Posix/User.hsc" #-}

-- | @getAllUserEntries@ returns all user entries on the system by
--   repeatedly calling @getpwent@
getAllUserEntries :: IO [UserEntry]

{-# LINE 598 "libraries/unix/System/Posix/User.hsc" #-}
getAllUserEntries = lockpw GETALL $ bracket_ c_setpwent c_endpwent $ worker []
  where
    worker accum = do
        resetErrno
        ppw <- throwErrnoIfNullAndError "getAllUserEntries" $ c_getpwent
        if ppw == nullPtr
            then return (reverse accum)
            else do thisentry <- unpackUserEntry ppw
                    worker (thisentry : accum)

foreign import ccall safe "getpwent" c_getpwent :: IO (Ptr CPasswd)
foreign import ccall safe "setpwent" c_setpwent :: IO ()
foreign import ccall safe "endpwent" c_endpwent :: IO ()

{-# LINE 615 "libraries/unix/System/Posix/User.hsc" #-}


{-# LINE 617 "libraries/unix/System/Posix/User.hsc" #-}
pwBufSize :: Int

{-# LINE 619 "libraries/unix/System/Posix/User.hsc" #-}
pwBufSize = sysconfWithDefault 1024 (71)
{-# LINE 620 "libraries/unix/System/Posix/User.hsc" #-}

{-# LINE 623 "libraries/unix/System/Posix/User.hsc" #-}

{-# LINE 624 "libraries/unix/System/Posix/User.hsc" #-}


{-# LINE 626 "libraries/unix/System/Posix/User.hsc" #-}
foreign import ccall unsafe "sysconf"
  c_sysconf :: CInt -> IO CLong

-- We need a default value since sysconf can fail and return -1
-- even when the parameter name is defined in unistd.h.
-- One example of this is _SC_GETPW_R_SIZE_MAX under
-- Mac OS X 10.4.9 on i386.
sysconfWithDefault :: Int -> CInt -> Int
sysconfWithDefault :: Int -> CInt -> Int
sysconfWithDefault Int
def CInt
sc =
    IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ do Int
v <- (CLong -> Int) -> IO CLong -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CLong -> IO Int) -> IO CLong -> IO Int
forall a b. (a -> b) -> a -> b
$ CInt -> IO CLong
c_sysconf CInt
sc
                         Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ if Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1) then Int
def else Int
v

{-# LINE 638 "libraries/unix/System/Posix/User.hsc" #-}


{-# LINE 640 "libraries/unix/System/Posix/User.hsc" #-}

-- The following function is used by the getgr*_r, c_getpw*_r
-- families of functions. These functions return their result
-- in a struct that contains strings and they need a buffer
-- that they can use to store those strings. We have to be
-- careful to unpack the struct containing the result before
-- the buffer is deallocated.
doubleAllocWhileERANGE
  :: String
  -> String -- entry type: "user" or "group"
  -> Int
  -> (Ptr r -> IO a)
  -> (Ptr b -> CSize -> Ptr (Ptr r) -> IO CInt)
  -> IO a
doubleAllocWhileERANGE :: forall r a b.
String
-> String
-> Int
-> (Ptr r -> IO a)
-> (Ptr b -> CSize -> Ptr (Ptr r) -> IO CInt)
-> IO a
doubleAllocWhileERANGE String
loc String
enttype Int
initlen Ptr r -> IO a
unpack Ptr b -> CSize -> Ptr (Ptr r) -> IO CInt
action =
  (Ptr (Ptr r) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr r) -> IO a) -> IO a) -> (Ptr (Ptr r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ Int -> Ptr (Ptr r) -> IO a
go Int
initlen
 where
  go :: Int -> Ptr (Ptr r) -> IO a
go Int
len Ptr (Ptr r)
res = do
    Either CInt a
r <- Int -> (Ptr b -> IO (Either CInt a)) -> IO (Either CInt a)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
len ((Ptr b -> IO (Either CInt a)) -> IO (Either CInt a))
-> (Ptr b -> IO (Either CInt a)) -> IO (Either CInt a)
forall a b. (a -> b) -> a -> b
$ \Ptr b
buf -> do
           CInt
rc <- Ptr b -> CSize -> Ptr (Ptr r) -> IO CInt
action Ptr b
buf (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr (Ptr r)
res
           if CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
             then Either CInt a -> IO (Either CInt a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Either CInt a
forall a b. a -> Either a b
Left CInt
rc)
             else do Ptr r
p <- Ptr (Ptr r) -> IO (Ptr r)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr r)
res
                     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr r
p Ptr r -> Ptr r -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr r
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
forall {a}. IO a
notFoundErr
                     (a -> Either CInt a) -> IO a -> IO (Either CInt a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either CInt a
forall a b. b -> Either a b
Right (Ptr r -> IO a
unpack Ptr r
p)
    case Either CInt a
r of
      Right a
x -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      Left CInt
rc | CInt -> Errno
Errno CInt
rc Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eRANGE ->
        -- ERANGE means this is not an error
        -- we just have to try again with a larger buffer
        Int -> Ptr (Ptr r) -> IO a
go (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Ptr (Ptr r)
res
      Left CInt
rc ->
        IOError -> IO a
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
loc (CInt -> Errno
Errno CInt
rc) Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
  notFoundErr :: IO a
notFoundErr =
    IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$ (IOError -> String -> IOError) -> String -> IOError -> IOError
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOError -> String -> IOError
ioeSetErrorString (String
"no such " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
enttype)
            (IOError -> IOError) -> IOError -> IOError
forall a b. (a -> b) -> a -> b
$ IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
doesNotExistErrorType String
loc Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing


-- Used when a function returns NULL to indicate either an error or
-- EOF, depending on whether the global errno is nonzero.
throwErrnoIfNullAndError :: String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNullAndError :: forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNullAndError String
loc IO (Ptr a)
act = do
    Ptr a
rc <- IO (Ptr a)
act
    Errno
errno <- IO Errno
getErrno
    if Ptr a
rc Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
&& Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
/= Errno
eOK
       then String -> IO (Ptr a)
forall a. String -> IO a
throwErrno String
loc
       else Ptr a -> IO (Ptr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
rc


{-# LINE 689 "libraries/unix/System/Posix/User.hsc" #-}