{-# LINE 1 "libraries/unix/System/Posix/User.hsc" #-}
{-# LANGUAGE Trustworthy, CApiFFI #-}
-----------------------------------------------------------------------------
-- |
-- 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
    GroupEntry(..),
    getGroupEntryForID,
    getGroupEntryForName,
    getAllGroupEntries,

    -- *** The user database
    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


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

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

{-# LINE 61 "libraries/unix/System/Posix/User.hsc" #-}
import Control.Exception

{-# LINE 63 "libraries/unix/System/Posix/User.hsc" #-}
import Control.Monad
import System.IO.Error

-- internal types
data {-# CTYPE "struct passwd" #-} CPasswd
data {-# CTYPE "struct group"  #-} CGroup

-- -----------------------------------------------------------------------------
-- user environemnt

-- | @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
External instance of the constraint type Storable GroupID
allocaArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral CInt
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 ()
External instance of the constraint type Num CInt
External instance of the constraint type Eq CInt
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]
External instance of the constraint type Storable GroupID
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral CInt
fromIntegral CInt
ngroups) Ptr GroupID
arr
       [GroupID] -> IO [GroupID]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type Storable GroupID
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 ()
External instance of the constraint type Num CInt
External instance of the constraint type Eq CInt
throwErrnoIfMinus1_ String
"setGroups" (CInt -> Ptr GroupID -> IO CInt
c_setgroups (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num CInt
External instance of the constraint type Integral Int
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
    CString
str <- String -> IO CString -> IO CString
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNull String
"getLoginName" IO CString
c_getlogin
    CString -> IO String
peekCAString CString
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 ()
External instance of the constraint type Num CInt
External instance of the constraint type Eq CInt
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 ()
External instance of the constraint type Num CInt
External instance of the constraint type Eq CInt
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 ()
External instance of the constraint type Num CInt
External instance of the constraint type Eq CInt
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 ()
External instance of the constraint type Num CInt
External instance of the constraint type Eq CInt
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 (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (UserEntry -> String
userName UserEntry
pw)

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

data GroupEntry =
 GroupEntry {
  GroupEntry -> String
groupName    :: String,       -- ^ The name of this group (gr_name)
  GroupEntry -> String
groupPassword :: String,      -- ^ The password for this group (gr_passwd)
  GroupEntry -> GroupID
groupID      :: GroupID,      -- ^ The unique numeric ID for this group (gr_gid)
  GroupEntry -> [String]
groupMembers :: [String]      -- ^ A list of zero or more usernames that are members (gr_mem)
 } deriving (Int -> GroupEntry -> ShowS
[GroupEntry] -> ShowS
GroupEntry -> String
(Int -> GroupEntry -> ShowS)
-> (GroupEntry -> String)
-> ([GroupEntry] -> ShowS)
-> Show GroupEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupEntry] -> ShowS
$cshowList :: [GroupEntry] -> ShowS
show :: GroupEntry -> String
$cshow :: GroupEntry -> String
showsPrec :: Int -> GroupEntry -> ShowS
$cshowsPrec :: Int -> GroupEntry -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type Show GroupID
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type Ord Int
Show, ReadPrec [GroupEntry]
ReadPrec GroupEntry
Int -> ReadS GroupEntry
ReadS [GroupEntry]
(Int -> ReadS GroupEntry)
-> ReadS [GroupEntry]
-> ReadPrec GroupEntry
-> ReadPrec [GroupEntry]
-> Read GroupEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GroupEntry]
$creadListPrec :: ReadPrec [GroupEntry]
readPrec :: ReadPrec GroupEntry
$creadPrec :: ReadPrec GroupEntry
readList :: ReadS [GroupEntry]
$creadList :: ReadS [GroupEntry]
readsPrec :: Int -> ReadS GroupEntry
$creadsPrec :: Int -> ReadS GroupEntry
External instance of the constraint type Read Char
External instance of the constraint type Read GroupID
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read GroupEntry
Read, GroupEntry -> GroupEntry -> Bool
(GroupEntry -> GroupEntry -> Bool)
-> (GroupEntry -> GroupEntry -> Bool) -> Eq GroupEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupEntry -> GroupEntry -> Bool
$c/= :: GroupEntry -> GroupEntry -> Bool
== :: GroupEntry -> GroupEntry -> Bool
$c== :: GroupEntry -> GroupEntry -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Eq GroupID
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
Eq)

-- | @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 206 "libraries/unix/System/Posix/User.hsc" #-}
getGroupEntryForID gid =
  allocaBytes (32) $ \pgr ->
{-# LINE 208 "libraries/unix/System/Posix/User.hsc" #-}
   doubleAllocWhileERANGE "getGroupEntryForID" "group" grBufSize unpackGroupEntry $
     c_getgrgid_r gid pgr

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

{-# LINE 217 "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 224 "libraries/unix/System/Posix/User.hsc" #-}
getGroupEntryForName name =
  allocaBytes (32) $ \pgr ->
{-# LINE 226 "libraries/unix/System/Posix/User.hsc" #-}
    withCAString name $ \ pstr ->
      doubleAllocWhileERANGE "getGroupEntryForName" "group" grBufSize unpackGroupEntry $
        c_getgrnam_r pstr pgr

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

{-# LINE 236 "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 247 "libraries/unix/System/Posix/User.hsc" #-}
getAllGroupEntries =
    withMVar lock $ \_ -> 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 unsafe "getgrent"
  c_getgrent :: IO (Ptr CGroup)
foreign import ccall unsafe "setgrent"
  c_setgrent :: IO ()
foreign import ccall unsafe "endgrent"
  c_endgrent :: IO ()

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


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

{-# LINE 271 "libraries/unix/System/Posix/User.hsc" #-}
grBufSize = sysconfWithDefault 1024 (69)
{-# LINE 272 "libraries/unix/System/Posix/User.hsc" #-}

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

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

unpackGroupEntry :: Ptr CGroup -> IO GroupEntry
unpackGroupEntry :: Ptr CGroup -> IO GroupEntry
unpackGroupEntry Ptr CGroup
ptr = do
   String
name    <- ((\Ptr CGroup
hsc_ptr -> Ptr CGroup -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
External instance of the constraint type forall a. Storable (Ptr a)
peekByteOff Ptr CGroup
hsc_ptr Int
0)) Ptr CGroup
ptr IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
External instance of the constraint type Monad IO
>>= CString -> IO String
peekCAString
{-# LINE 280 "libraries/unix/System/Posix/User.hsc" #-}
   passwd  <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr >>= peekCAString
{-# LINE 281 "libraries/unix/System/Posix/User.hsc" #-}
   gid     <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 282 "libraries/unix/System/Posix/User.hsc" #-}
   mem     <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 283 "libraries/unix/System/Posix/User.hsc" #-}
   members <- peekArray0 nullPtr mem >>= mapM peekCAString
   GroupEntry -> IO GroupEntry
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (String -> String -> GroupID -> [String] -> GroupEntry
GroupEntry String
name String
passwd GroupID
gid [String]
members)

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

data UserEntry =
 UserEntry {
   UserEntry -> String
userName      :: String,     -- ^ Textual name of this user (pw_name)
   UserEntry -> String
userPassword  :: String,     -- ^ Password -- may be empty or fake if shadow is in use (pw_passwd)
   UserEntry -> UserID
userID        :: UserID,     -- ^ Numeric ID for this user (pw_uid)
   UserEntry -> GroupID
userGroupID   :: GroupID,    -- ^ Primary group ID (pw_gid)
   UserEntry -> String
userGecos     :: String,     -- ^ Usually the real name for the user (pw_gecos)
   UserEntry -> String
homeDirectory :: String,     -- ^ Home directory (pw_dir)
   UserEntry -> String
userShell     :: String      -- ^ Default shell (pw_shell)
 } deriving (Int -> UserEntry -> ShowS
[UserEntry] -> ShowS
UserEntry -> String
(Int -> UserEntry -> ShowS)
-> (UserEntry -> String)
-> ([UserEntry] -> ShowS)
-> Show UserEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserEntry] -> ShowS
$cshowList :: [UserEntry] -> ShowS
show :: UserEntry -> String
$cshow :: UserEntry -> String
showsPrec :: Int -> UserEntry -> ShowS
$cshowsPrec :: Int -> UserEntry -> ShowS
External instance of the constraint type Show UserID
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type Show Char
External instance of the constraint type Show GroupID
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
Show, ReadPrec [UserEntry]
ReadPrec UserEntry
Int -> ReadS UserEntry
ReadS [UserEntry]
(Int -> ReadS UserEntry)
-> ReadS [UserEntry]
-> ReadPrec UserEntry
-> ReadPrec [UserEntry]
-> Read UserEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserEntry]
$creadListPrec :: ReadPrec [UserEntry]
readPrec :: ReadPrec UserEntry
$creadPrec :: ReadPrec UserEntry
readList :: ReadS [UserEntry]
$creadList :: ReadS [UserEntry]
readsPrec :: Int -> ReadS UserEntry
$creadsPrec :: Int -> ReadS UserEntry
External instance of the constraint type Read UserID
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Read Char
External instance of the constraint type Read GroupID
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read UserEntry
Read, UserEntry -> UserEntry -> Bool
(UserEntry -> UserEntry -> Bool)
-> (UserEntry -> UserEntry -> Bool) -> Eq UserEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserEntry -> UserEntry -> Bool
$c/= :: UserEntry -> UserEntry -> Bool
== :: UserEntry -> UserEntry -> Bool
$c== :: UserEntry -> UserEntry -> Bool
External instance of the constraint type Eq UserID
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type Eq Char
External instance of the constraint type Eq GroupID
External instance of the constraint type forall a. Eq a => Eq [a]
Eq)

--
-- getpwuid and getpwnam leave results in a static object. Subsequent
-- calls modify the same object, which isn't threadsafe. We attempt to
-- mitigate this issue, on platforms that don't provide the safe _r versions
--
-- Also, getpwent/setpwent require a global lock since they maintain
-- an internal file position pointer.

{-# LINE 308 "libraries/unix/System/Posix/User.hsc" #-}
lock :: MVar ()
lock :: MVar ()
lock = 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 lock #-}

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

-- | @getUserEntryForID gid@ 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 319 "libraries/unix/System/Posix/User.hsc" #-}
getUserEntryForID uid =
  allocaBytes (48) $ \ppw ->
{-# LINE 321 "libraries/unix/System/Posix/User.hsc" #-}
    doubleAllocWhileERANGE "getUserEntryForID" "user" pwBufSize unpackUserEntry $
      c_getpwuid_r uid ppw

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

{-# LINE 338 "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 345 "libraries/unix/System/Posix/User.hsc" #-}
getUserEntryForName name =
  allocaBytes (48) $ \ppw ->
{-# LINE 347 "libraries/unix/System/Posix/User.hsc" #-}
    withCAString name $ \ pstr ->
      doubleAllocWhileERANGE "getUserEntryForName" "user" pwBufSize unpackUserEntry $
        c_getpwnam_r pstr ppw

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

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

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

{-# LINE 371 "libraries/unix/System/Posix/User.hsc" #-}
getAllUserEntries =
    withMVar lock $ \_ -> 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 capi unsafe "HsUnix.h getpwent"
  c_getpwent :: IO (Ptr CPasswd)
foreign import capi unsafe "HsUnix.h setpwent"
  c_setpwent :: IO ()
foreign import capi unsafe "HsUnix.h endpwent"
  c_endpwent :: IO ()

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


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

{-# LINE 395 "libraries/unix/System/Posix/User.hsc" #-}
pwBufSize = sysconfWithDefault 1024 (70)
{-# LINE 396 "libraries/unix/System/Posix/User.hsc" #-}

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

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


{-# LINE 402 "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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap CLong -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral CLong
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 (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type Eq Int
== (-Int
1) then Int
def else Int
v

{-# LINE 414 "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 :: 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
External instance of the constraint type forall a. Storable (Ptr a)
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
External instance of the constraint type Num CSize
External instance of the constraint type Integral Int
fromIntegral Int
len) Ptr (Ptr r)
res
           if CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq CInt
/= CInt
0
             then Either CInt a -> IO (Either CInt a)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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
External instance of the constraint type forall a. Storable (Ptr a)
peek Ptr (Ptr r)
res
                     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
when (Ptr r
p Ptr r -> Ptr r -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq (Ptr a)
== 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
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 (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return a
x
      Left CInt
rc | CInt -> Errno
Errno CInt
rc Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Errno
== 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
External instance of the constraint type Num Int
* 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 -> ShowS
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

unpackUserEntry :: Ptr CPasswd -> IO UserEntry
unpackUserEntry :: Ptr CPasswd -> IO UserEntry
unpackUserEntry Ptr CPasswd
ptr = do
   String
name   <- ((\Ptr CPasswd
hsc_ptr -> Ptr CPasswd -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
External instance of the constraint type forall a. Storable (Ptr a)
peekByteOff Ptr CPasswd
hsc_ptr Int
0))   Ptr CPasswd
ptr IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
External instance of the constraint type Monad IO
>>= CString -> IO String
peekCAString
{-# LINE 454 "libraries/unix/System/Posix/User.hsc" #-}
   passwd <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr >>= peekCAString
{-# LINE 455 "libraries/unix/System/Posix/User.hsc" #-}
   uid    <- ((\hsc_ptr -> peekByteOff hsc_ptr 16))    ptr
{-# LINE 456 "libraries/unix/System/Posix/User.hsc" #-}
   gid    <- ((\hsc_ptr -> peekByteOff hsc_ptr 20))    ptr
{-# LINE 457 "libraries/unix/System/Posix/User.hsc" #-}

{-# LINE 460 "libraries/unix/System/Posix/User.hsc" #-}
   String
gecos  <- ((\Ptr CPasswd
hsc_ptr -> Ptr CPasswd -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
External instance of the constraint type forall a. Storable (Ptr a)
peekByteOff Ptr CPasswd
hsc_ptr Int
24))  Ptr CPasswd
ptr IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
External instance of the constraint type Monad IO
>>= CString -> IO String
peekCAString
{-# LINE 461 "libraries/unix/System/Posix/User.hsc" #-}

{-# LINE 462 "libraries/unix/System/Posix/User.hsc" #-}
   dir    <- ((\hsc_ptr -> peekByteOff hsc_ptr 32))    ptr >>= peekCAString
{-# LINE 463 "libraries/unix/System/Posix/User.hsc" #-}
   shell  <- ((\hsc_ptr -> peekByteOff hsc_ptr 40))  ptr >>= peekCAString
{-# LINE 464 "libraries/unix/System/Posix/User.hsc" #-}
   return (UserEntry name passwd uid gid gecos dir shell)

-- 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 :: 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
External instance of the constraint type forall a. Eq (Ptr a)
== Ptr a
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
&& Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Errno
/= Errno
eOK
       then String -> IO (Ptr a)
forall a. String -> IO a
throwErrno String
loc
       else Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Ptr a
rc