ghc/lib/haskell-1.3/LibPosixDB.lhs

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