{-# LINE 1 "libraries/unix/System/Posix/User/Common.hsc" #-}
{-# LANGUAGE Safe #-}
module System.Posix.User.Common where
import Data.ByteString ( ByteString )
import System.Posix.Types
{-# LINE 25 "libraries/unix/System/Posix/User/Common.hsc" #-}
import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable
import Data.ByteString ( packCString )
data {-# CTYPE "struct passwd" #-} CPasswd
data {-# CTYPE "struct group" #-} CGroup
data LKUPTYPE = GETONE | GETALL
unpackGroupEntry :: Ptr CGroup -> IO GroupEntry
unpackGroupEntry :: Ptr CGroup -> IO GroupEntry
unpackGroupEntry Ptr CGroup
ptr = do
name <- ((\Ptr CGroup
hsc_ptr -> Ptr CGroup -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CGroup
hsc_ptr Int
0)) Ptr CGroup
ptr IO CString -> (CString -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO ByteString
packCString
{-# LINE 39 "libraries/unix/System/Posix/User/Common.hsc" #-}
passwd <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr >>= packCString
{-# LINE 40 "libraries/unix/System/Posix/User/Common.hsc" #-}
gid <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 41 "libraries/unix/System/Posix/User/Common.hsc" #-}
mem <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 42 "libraries/unix/System/Posix/User/Common.hsc" #-}
members <- peekArray0 nullPtr mem >>= mapM packCString
return (GroupEntry name passwd gid members)
unpackUserEntry :: Ptr CPasswd -> IO UserEntry
unpackUserEntry :: Ptr CPasswd -> IO UserEntry
unpackUserEntry Ptr CPasswd
ptr = do
name <- ((\Ptr CPasswd
hsc_ptr -> Ptr CPasswd -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CPasswd
hsc_ptr Int
0)) Ptr CPasswd
ptr IO CString -> (CString -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO ByteString
packCString
{-# LINE 48 "libraries/unix/System/Posix/User/Common.hsc" #-}
passwd <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr >>= packCString
{-# LINE 49 "libraries/unix/System/Posix/User/Common.hsc" #-}
uid <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 50 "libraries/unix/System/Posix/User/Common.hsc" #-}
gid <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 51 "libraries/unix/System/Posix/User/Common.hsc" #-}
{-# LINE 54 "libraries/unix/System/Posix/User/Common.hsc" #-}
gecos <- ((\Ptr CPasswd
hsc_ptr -> Ptr CPasswd -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CPasswd
hsc_ptr Int
24)) ptr >>= packCString
{-# LINE 55 "libraries/unix/System/Posix/User/Common.hsc" #-}
{-# LINE 56 "libraries/unix/System/Posix/User/Common.hsc" #-}
dir <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr >>= packCString
{-# LINE 57 "libraries/unix/System/Posix/User/Common.hsc" #-}
shell <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr >>= packCString
{-# LINE 58 "libraries/unix/System/Posix/User/Common.hsc" #-}
return (UserEntry name passwd uid gid gecos dir shell)
{-# LINE 61 "libraries/unix/System/Posix/User/Common.hsc" #-}
data UserEntry =
UserEntry {
UserEntry -> ByteString
userName :: ByteString,
UserEntry -> ByteString
userPassword :: ByteString,
UserEntry -> UserID
userID :: UserID,
UserEntry -> GroupID
userGroupID :: GroupID,
UserEntry -> ByteString
userGecos :: ByteString,
UserEntry -> ByteString
homeDirectory :: ByteString,
UserEntry -> ByteString
userShell :: ByteString
} 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
$cshowsPrec :: Int -> UserEntry -> ShowS
showsPrec :: Int -> UserEntry -> ShowS
$cshow :: UserEntry -> String
show :: UserEntry -> String
$cshowList :: [UserEntry] -> ShowS
showList :: [UserEntry] -> ShowS
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
$creadsPrec :: Int -> ReadS UserEntry
readsPrec :: Int -> ReadS UserEntry
$creadList :: ReadS [UserEntry]
readList :: ReadS [UserEntry]
$creadPrec :: ReadPrec UserEntry
readPrec :: ReadPrec UserEntry
$creadListPrec :: ReadPrec [UserEntry]
readListPrec :: ReadPrec [UserEntry]
Read, UserEntry -> UserEntry -> Bool
(UserEntry -> UserEntry -> Bool)
-> (UserEntry -> UserEntry -> Bool) -> Eq UserEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserEntry -> UserEntry -> Bool
== :: UserEntry -> UserEntry -> Bool
$c/= :: UserEntry -> UserEntry -> Bool
/= :: UserEntry -> UserEntry -> Bool
Eq)
data GroupEntry =
GroupEntry {
GroupEntry -> ByteString
groupName :: ByteString,
GroupEntry -> ByteString
groupPassword :: ByteString,
GroupEntry -> GroupID
groupID :: GroupID,
GroupEntry -> [ByteString]
groupMembers :: [ByteString]
} 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
$cshowsPrec :: Int -> GroupEntry -> ShowS
showsPrec :: Int -> GroupEntry -> ShowS
$cshow :: GroupEntry -> String
show :: GroupEntry -> String
$cshowList :: [GroupEntry] -> ShowS
showList :: [GroupEntry] -> ShowS
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
$creadsPrec :: Int -> ReadS GroupEntry
readsPrec :: Int -> ReadS GroupEntry
$creadList :: ReadS [GroupEntry]
readList :: ReadS [GroupEntry]
$creadPrec :: ReadPrec GroupEntry
readPrec :: ReadPrec GroupEntry
$creadListPrec :: ReadPrec [GroupEntry]
readListPrec :: ReadPrec [GroupEntry]
Read, GroupEntry -> GroupEntry -> Bool
(GroupEntry -> GroupEntry -> Bool)
-> (GroupEntry -> GroupEntry -> Bool) -> Eq GroupEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GroupEntry -> GroupEntry -> Bool
== :: GroupEntry -> GroupEntry -> Bool
$c/= :: GroupEntry -> GroupEntry -> Bool
/= :: GroupEntry -> GroupEntry -> Bool
Eq)