{-# LINE 1 "System/Posix/User/Common.hsc" #-}
{-# LANGUAGE Safe #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.User.Common
-- 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.Common where

import Data.ByteString ( ByteString )
import System.Posix.Types





{-# LINE 25 "System/Posix/User/Common.hsc" #-}
import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable
import Data.ByteString ( packCString )

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

data LKUPTYPE = GETONE | GETALL

unpackGroupEntry :: Ptr CGroup -> IO GroupEntry
unpackGroupEntry ptr = do
   name    <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr >>= packCString
{-# LINE 39 "System/Posix/User/Common.hsc" #-}
   passwd  <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr >>= packCString
{-# LINE 40 "System/Posix/User/Common.hsc" #-}
   gid     <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 41 "System/Posix/User/Common.hsc" #-}
   mem     <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 42 "System/Posix/User/Common.hsc" #-}
   members <- peekArray0 nullPtr mem >>= mapM packCString
   return (GroupEntry name passwd gid members)

unpackUserEntry :: Ptr CPasswd -> IO UserEntry
unpackUserEntry ptr = do
   name   <- ((\hsc_ptr -> peekByteOff hsc_ptr 0))   ptr >>= packCString
{-# LINE 48 "System/Posix/User/Common.hsc" #-}
   passwd <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr >>= packCString
{-# LINE 49 "System/Posix/User/Common.hsc" #-}
   uid    <- ((\hsc_ptr -> peekByteOff hsc_ptr 16))    ptr
{-# LINE 50 "System/Posix/User/Common.hsc" #-}
   gid    <- ((\hsc_ptr -> peekByteOff hsc_ptr 20))    ptr
{-# LINE 51 "System/Posix/User/Common.hsc" #-}

{-# LINE 54 "System/Posix/User/Common.hsc" #-}
   gecos  <- ((\hsc_ptr -> peekByteOff hsc_ptr 24))  ptr >>= packCString
{-# LINE 55 "System/Posix/User/Common.hsc" #-}

{-# LINE 56 "System/Posix/User/Common.hsc" #-}
   dir    <- ((\hsc_ptr -> peekByteOff hsc_ptr 32))    ptr >>= packCString
{-# LINE 57 "System/Posix/User/Common.hsc" #-}
   shell  <- ((\hsc_ptr -> peekByteOff hsc_ptr 40))  ptr >>= packCString
{-# LINE 58 "System/Posix/User/Common.hsc" #-}
   return (UserEntry name passwd uid gid gecos dir shell)


{-# LINE 61 "System/Posix/User/Common.hsc" #-}

data UserEntry =
 UserEntry {
   userName      :: ByteString,     -- ^ Textual name of this user (pw_name)
   userPassword  :: ByteString,     -- ^ Password -- may be empty or fake if shadow is in use (pw_passwd)
   userID        :: UserID,         -- ^ Numeric ID for this user (pw_uid)
   userGroupID   :: GroupID,        -- ^ Primary group ID (pw_gid)
   userGecos     :: ByteString,     -- ^ Usually the real name for the user (pw_gecos)
   homeDirectory :: ByteString,     -- ^ Home directory (pw_dir)
   userShell     :: ByteString      -- ^ Default shell (pw_shell)
 } deriving (Show, Read, Eq)

data GroupEntry =
 GroupEntry {
  groupName     :: ByteString,   -- ^ The name of this group (gr_name)
  groupPassword :: ByteString,   -- ^ The password for this group (gr_passwd)
  groupID       :: GroupID,      -- ^ The unique numeric ID for this group (gr_gid)
  groupMembers  :: [ByteString]  -- ^ A list of zero or more usernames that are members (gr_mem)
 } deriving (Show, Read, Eq)