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
  26 data GroupEntry =
  27  GroupEntry {
  28   groupName    :: String,
  29   groupID      :: GroupID,
  30   groupMembers :: [String]
  31  }
  32
  33 data UserEntry =
  34  UserEntry {
  35    userName      :: String,
  36    userID        :: UserID,
  37    userGroupID   :: GroupID,
  38    homeDirectory :: String,
  39    userShell     :: String
  40  }
  41
  42
  43 getGroupEntryForID :: GroupID -> IO GroupEntry
  44 getGroupEntryForID gid =
  45     _ccall_ getgrgid gid  >>= \ ptr ->
  46     if ptr == (``NULL'' :: Addr) then
  47         fail (IOError Nothing NoSuchThing
  48              "getGroupEntryForID: no such group entry")
  49     else
  50         unpackGroupEntry ptr
  51
  52 getGroupEntryForName :: String -> IO GroupEntry
  53 getGroupEntryForName name =
  54     stToIO (psToByteArrayST name)       >>= \ gname ->
  55     _ccall_ getgrnam gname              >>= \ ptr ->
  56     if ptr == (``NULL'' :: Addr) then
  57         fail (IOError Nothing NoSuchThing
  58              "getGroupEntryForName: no such group entry")
  59     else
  60         unpackGroupEntry ptr
  61
  62 getUserEntryForID :: UserID -> IO UserEntry
  63 getUserEntryForID uid =
  64     _ccall_ getpwuid uid                >>= \ ptr ->
  65     if ptr == ``NULL'' then
  66         fail (IOError Nothing NoSuchThing
  67              "getUserEntryForID: no such user entry")
  68     else
  69         unpackUserEntry ptr
  70
  71 getUserEntryForName :: String -> IO UserEntry
  72 getUserEntryForName name =
  73     stToIO (psToByteArrayST name)       >>= \ uname ->
  74     _ccall_ getpwnam uname              >>= \ ptr ->
  75     if ptr == ``NULL'' then
  76         fail (IOError Nothing NoSuchThing
  77              "getUserEntryForName: no such user entry")
  78     else
  79         unpackUserEntry ptr
  80 \end{code}
  81
  82 Local utility functions
  83
  84 \begin{code}
  85 -- Copy the static structure returned by getgr* into a Haskell structure
  86
  87 unpackGroupEntry :: Addr -> IO GroupEntry
  88 unpackGroupEntry ptr =
  89   do
  90    str  <- _casm_ ``%r = ((struct group *)%0)->gr_name;'' ptr
  91    name <- strcpy str
  92    gid  <- _casm_ ``%r = ((struct group *)%0)->gr_gid;'' ptr
  93    mem  <- _casm_ ``%r = ((struct group *)%0)->gr_mem;'' ptr
  94    members <- unvectorize mem 0
  95    return (GroupEntry name gid members)
  96
  97 -- Copy the static structure returned by getpw* into a Haskell structure
  98
  99 unpackUserEntry :: Addr -> IO UserEntry
 100 unpackUserEntry ptr =
 101   do
 102    str   <- _casm_ ``%r = ((struct passwd *)%0)->pw_name;'' ptr
 103    name    <- strcpy str
 104    uid   <- _casm_ ``%r = ((struct passwd *)%0)->pw_uid;'' ptr
 105    gid   <- _casm_ ``%r = ((struct passwd *)%0)->pw_gid;'' ptr
 106    str   <- _casm_ ``%r = ((struct passwd *)%0)->pw_dir;'' ptr
 107    home    <- strcpy str
 108    str   <- _casm_ ``%r = ((struct passwd *)%0)->pw_shell;'' ptr
 109    shell   <- strcpy str
 110    return (UserEntry name uid gid home shell)
 111 \end{code}