{-# LINE 1 "libraries/unix/System/Posix/User.hsc" #-}
{-# LANGUAGE Trustworthy, CApiFFI #-}
module System.Posix.User (
getRealUserID,
getRealGroupID,
getEffectiveUserID,
getEffectiveGroupID,
getGroups,
getLoginName,
getEffectiveUserName,
GroupEntry(..),
getGroupEntryForID,
getGroupEntryForName,
getAllGroupEntries,
UserEntry(..),
getUserEntryForID,
getUserEntryForName,
getAllUserEntries,
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
data {-# CTYPE "struct passwd" #-} CPasswd
data {-# CTYPE "struct group" #-} CGroup
getRealUserID :: IO UserID
getRealUserID = c_getuid
foreign import ccall unsafe "getuid"
c_getuid :: IO CUid
getRealGroupID :: IO GroupID
getRealGroupID = c_getgid
foreign import ccall unsafe "getgid"
c_getgid :: IO CGid
getEffectiveUserID :: IO UserID
getEffectiveUserID = c_geteuid
foreign import ccall unsafe "geteuid"
c_geteuid :: IO CUid
getEffectiveGroupID :: IO GroupID
getEffectiveGroupID = c_getegid
foreign import ccall unsafe "getegid"
c_getegid :: IO CGid
getGroups :: IO [GroupID]
getGroups = do
ngroups <- c_getgroups 0 nullPtr
allocaArray (fromIntegral ngroups) $ \arr -> do
throwErrnoIfMinus1_ "getGroups" (c_getgroups ngroups arr)
groups <- peekArray (fromIntegral ngroups) arr
return groups
foreign import ccall unsafe "getgroups"
c_getgroups :: CInt -> Ptr CGid -> IO CInt
setGroups :: [GroupID] -> IO ()
setGroups groups = do
withArrayLen groups $ \ ngroups arr ->
throwErrnoIfMinus1_ "setGroups" (c_setgroups (fromIntegral ngroups) arr)
foreign import ccall unsafe "setgroups"
c_setgroups :: CInt -> Ptr CGid -> IO CInt
getLoginName :: IO String
getLoginName = do
str <- throwErrnoIfNull "getLoginName" c_getlogin
peekCAString str
foreign import ccall unsafe "getlogin"
c_getlogin :: IO CString
setUserID :: UserID -> IO ()
setUserID uid = throwErrnoIfMinus1_ "setUserID" (c_setuid uid)
foreign import ccall unsafe "setuid"
c_setuid :: CUid -> IO CInt
setEffectiveUserID :: UserID -> IO ()
setEffectiveUserID uid = throwErrnoIfMinus1_ "setEffectiveUserID" (c_seteuid uid)
foreign import ccall unsafe "seteuid"
c_seteuid :: CUid -> IO CInt
setGroupID :: GroupID -> IO ()
setGroupID gid = throwErrnoIfMinus1_ "setGroupID" (c_setgid gid)
foreign import ccall unsafe "setgid"
c_setgid :: CGid -> IO CInt
setEffectiveGroupID :: GroupID -> IO ()
setEffectiveGroupID gid =
throwErrnoIfMinus1_ "setEffectiveGroupID" (c_setegid gid)
foreign import ccall unsafe "setegid"
c_setegid :: CGid -> IO CInt
getEffectiveUserName :: IO String
getEffectiveUserName = do
euid <- getEffectiveUserID
pw <- getUserEntryForID euid
return (userName pw)
data GroupEntry =
GroupEntry {
groupName :: String,
groupPassword :: String,
groupID :: GroupID,
groupMembers :: [String]
} deriving (Show, Read, Eq)
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 :: 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 :: 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 = do
name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr >>= 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
return (GroupEntry name passwd gid members)
data UserEntry =
UserEntry {
userName :: String,
userPassword :: String,
userID :: UserID,
userGroupID :: GroupID,
userGecos :: String,
homeDirectory :: String,
userShell :: String
} deriving (Show, Read, Eq)
{-# LINE 308 "libraries/unix/System/Posix/User.hsc" #-}
lock :: MVar ()
lock = unsafePerformIO $ newMVar ()
{-# NOINLINE lock #-}
{-# LINE 312 "libraries/unix/System/Posix/User.hsc" #-}
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 :: 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 :: 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
sysconfWithDefault :: Int -> CInt -> Int
sysconfWithDefault def sc =
unsafePerformIO $ do v <- fmap fromIntegral $ c_sysconf sc
return $ if v == (-1) then def else v
{-# LINE 414 "libraries/unix/System/Posix/User.hsc" #-}
doubleAllocWhileERANGE
:: String
-> String
-> Int
-> (Ptr r -> IO a)
-> (Ptr b -> CSize -> Ptr (Ptr r) -> IO CInt)
-> IO a
doubleAllocWhileERANGE loc enttype initlen unpack action =
alloca $ go initlen
where
go len res = do
r <- allocaBytes len $ \buf -> do
rc <- action buf (fromIntegral len) res
if rc /= 0
then return (Left rc)
else do p <- peek res
when (p == nullPtr) $ notFoundErr
fmap Right (unpack p)
case r of
Right x -> return x
Left rc | Errno rc == eRANGE ->
go (2 * len) res
Left rc ->
ioError (errnoToIOError loc (Errno rc) Nothing Nothing)
notFoundErr =
ioError $ flip ioeSetErrorString ("no such " ++ enttype)
$ mkIOError doesNotExistErrorType loc Nothing Nothing
unpackUserEntry :: Ptr CPasswd -> IO UserEntry
unpackUserEntry ptr = do
name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr >>= 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" #-}
gecos <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr >>= 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)
throwErrnoIfNullAndError :: String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNullAndError loc act = do
rc <- act
errno <- getErrno
if rc == nullPtr && errno /= eOK
then throwErrno loc
else return rc