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