ghc/lib/posix/PosixDB.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-1997
   3 %
   4 \section[PosixDB]{Haskell 1.4 POSIX System Databases}
   5
   6 \begin{code}
   7 module PosixDB (
   8     GroupEntry(..),
   9     UserEntry(..),
  10
  11     getUserEntryForID,    -- :: UserID -> IO UserEntry
  12     getUserEntryForName,  -- :: String -> IO UserEntry
  13
  14     getGroupEntryForID,   -- :: GroupID -> IO GroupEntry
  15     getGroupEntryForName  -- :: String -> IO GroupEntry
  16
  17     ) where
  18
  19 import ST
  20 import PackedString (psToByteArrayST)
  21 import PrelIOBase
  22 import Addr
  23 import IO
  24 import PosixUtil
  25 import Util ( unvectorize )
  26
  27 data GroupEntry =
  28  GroupEntry {
  29   groupName    :: String,
  30   groupID      :: GroupID,
  31   groupMembers :: [String]
  32  }
  33
  34 data UserEntry =
  35  UserEntry {
  36    userName      :: String,
  37    userID        :: UserID,
  38    userGroupID   :: GroupID,
  39    homeDirectory :: String,
  40    userShell     :: String
  41  }
  42
  43
  44 getGroupEntryForID :: GroupID -> IO GroupEntry
  45 getGroupEntryForID gid =
  46     _ccall_ getgrgid gid  >>= \ ptr ->
  47     if ptr == (``NULL'' :: Addr) then
  48         fail (IOError Nothing NoSuchThing
  49              "getGroupEntryForID" "no such group entry")
  50     else
  51         unpackGroupEntry ptr
  52
  53 getGroupEntryForName :: String -> IO GroupEntry
  54 getGroupEntryForName name =
  55     stToIO (psToByteArrayST name)       >>= \ gname ->
  56     _ccall_ getgrnam gname              >>= \ ptr ->
  57     if ptr == (``NULL'' :: Addr) then
  58         fail (IOError Nothing NoSuchThing
  59              "getGroupEntryForName" "no such group entry")
  60     else
  61         unpackGroupEntry ptr
  62
  63 getUserEntryForID :: UserID -> IO UserEntry
  64 getUserEntryForID uid =
  65     _ccall_ getpwuid uid                >>= \ ptr ->
  66     if ptr == ``NULL'' then
  67         fail (IOError Nothing NoSuchThing
  68              "getUserEntryForID" "no such user entry")
  69     else
  70         unpackUserEntry ptr
  71
  72 getUserEntryForName :: String -> IO UserEntry
  73 getUserEntryForName name =
  74     stToIO (psToByteArrayST name)       >>= \ uname ->
  75     _ccall_ getpwnam uname              >>= \ ptr ->
  76     if ptr == ``NULL'' then
  77         fail (IOError Nothing NoSuchThing
  78              "getUserEntryForName" "no such user entry")
  79     else
  80         unpackUserEntry ptr
  81 \end{code}
  82
  83 Local utility functions
  84
  85 \begin{code}
  86 -- Copy the static structure returned by getgr* into a Haskell structure
  87
  88 unpackGroupEntry :: Addr -> IO GroupEntry
  89 unpackGroupEntry ptr =
  90   do
  91    str  <- _casm_ ``%r = ((struct group *)%0)->gr_name;'' ptr
  92    name <- strcpy str
  93    gid  <- _casm_ ``%r = ((struct group *)%0)->gr_gid;'' ptr
  94    mem  <- _casm_ ``%r = ((struct group *)%0)->gr_mem;'' ptr
  95    members <- unvectorize mem 0
  96    return (GroupEntry name gid members)
  97
  98 -- Copy the static structure returned by getpw* into a Haskell structure
  99
 100 unpackUserEntry :: Addr -> IO UserEntry
 101 unpackUserEntry ptr =
 102   do
 103    str   <- _casm_ ``%r = ((struct passwd *)%0)->pw_name;'' ptr
 104    name    <- strcpy str
 105    uid   <- _casm_ ``%r = ((struct passwd *)%0)->pw_uid;'' ptr
 106    gid   <- _casm_ ``%r = ((struct passwd *)%0)->pw_gid;'' ptr
 107    str   <- _casm_ ``%r = ((struct passwd *)%0)->pw_dir;'' ptr
 108    home    <- strcpy str
 109    str   <- _casm_ ``%r = ((struct passwd *)%0)->pw_shell;'' ptr
 110    shell   <- strcpy str
 111    return (UserEntry name uid gid home shell)
 112 \end{code}