From f46082b665d7748bdec2981e21d332ee90a7c1cd Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 19 Dec 2002 13:52:55 +0000 Subject: [project @ 2002-12-19 13:52:55 by simonmar] Fill in some more bits in the new Unix library: specifically the contents of PosixTTY and PosixDB (now System.Posix.Terminal and System.Posix.User respectively). We're now about 95% complete w.r.t. the old posix library. I've identified the reminaing bits to do in System/Posix.hs. --- System/Posix/User.hsc | 260 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 260 insertions(+) create mode 100644 System/Posix/User.hsc (limited to 'System/Posix/User.hsc') diff --git a/System/Posix/User.hsc b/System/Posix/User.hsc new file mode 100644 index 0000000..1201164 --- /dev/null +++ b/System/Posix/User.hsc @@ -0,0 +1,260 @@ +{-# OPTIONS -fffi #-} +----------------------------------------------------------------------------- +-- | +-- Module : System.Posix.User +-- 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 ( + -- * User environment + -- ** Querying the user environment + getRealUserID, + getRealGroupID, + getEffectiveUserID, + getEffectiveGroupID, +#if !defined(cygwin32_TARGET_OS) + getGroups, +#endif + getLoginName, + getEffectiveUserName, + + -- *** The group database + GroupEntry(..), + getGroupEntryForID, + getGroupEntryForName, + + -- *** The user database + UserEntry(..), + getUserEntryForID, + getUserEntryForName, + + -- ** Modifying the user environment + setUserID, + setGroupID, + + ) where + +#include "HsUnix.h" + +import System.Posix.Types +import Foreign +import Foreign.C +import GHC.Posix ( CGroup, CPasswd ) + +-- ----------------------------------------------------------------------------- +-- user environemnt + +getRealUserID :: IO UserID +getRealUserID = c_getuid + +foreign import ccall unsafe "getuid" + c_getuid :: IO CUid + +getRealGroupID :: IO GroupID +getRealGroupID = c_getgid + +foreign import ccall unsafe "getgid" + c_getgid :: IO CGid + +getEffectiveUserID :: IO UserID +getEffectiveUserID = c_geteuid + +foreign import ccall unsafe "geteuid" + c_geteuid :: IO CUid + +getEffectiveGroupID :: IO GroupID +getEffectiveGroupID = c_getegid + +foreign import ccall unsafe "getegid" + c_getegid :: IO CGid + +-- getgroups() is not supported in beta18 of +-- cygwin32 +#if !defined(cygwin32_TARGET_OS) +getGroups :: IO [GroupID] +getGroups = do + ngroups <- c_getgroups 0 nullPtr + allocaArray (fromIntegral ngroups) $ \arr -> do + throwErrnoIfMinus1_ "getGroups" (c_getgroups ngroups arr) + groups <- peekArray (fromIntegral ngroups) arr + return groups + +foreign import ccall unsafe "getgroups" + c_getgroups :: CInt -> Ptr CGid -> IO CInt +#endif + +-- ToDo: use getlogin_r +getLoginName :: IO String +getLoginName = do + str <- throwErrnoIfNull "getLoginName" c_getlogin + peekCString str + +foreign import ccall unsafe "getlogin" + c_getlogin :: IO CString + +setUserID :: UserID -> IO () +setUserID uid = throwErrnoIfMinus1_ "setUserID" (c_setuid uid) + +foreign import ccall unsafe "setuid" + c_setuid :: CUid -> IO CInt + +setGroupID :: GroupID -> IO () +setGroupID gid = throwErrnoIfMinus1_ "setGroupID" (c_setgid gid) + +foreign import ccall unsafe "setgid" + c_setgid :: CGid -> IO CInt + +-- ----------------------------------------------------------------------------- +-- User names + +getEffectiveUserName :: IO String +getEffectiveUserName = do + euid <- getEffectiveUserID + pw <- getUserEntryForID euid + return (userName pw) + +-- ----------------------------------------------------------------------------- +-- The group database (grp.h) + +data GroupEntry = + GroupEntry { + groupName :: String, + groupID :: GroupID, + groupMembers :: [String] + } + +getGroupEntryForID :: GroupID -> IO GroupEntry +#ifdef HAVE_GETGRGID_R +getGroupEntryForID gid = do + allocaBytes (#const sizeof(struct group)) $ \pgr -> + allocaBytes grBufSize $ \pbuf -> + alloca $ \ ppgr -> do + err <- c_getgrgid_r gid pgr pbuf (fromIntegral grBufSize) ppgr + if (err == 0) + then unpackGroupEntry pgr + else ioError (errnoToIOError "getGroupEntryForID" + (Errno (fromIntegral err)) Nothing Nothing) + +foreign import ccall unsafe "getgrgid_r" + c_getgrgid_r :: CGid -> Ptr CGroup -> CString + -> CSize -> Ptr (Ptr CGroup) -> IO CInt +#else +getGroupEntryForID = error "System.Posix.User.getGroupEntryForID: not supported" +#endif + + +getGroupEntryForName :: String -> IO GroupEntry +#ifdef HAVE_GETGRNAM_R +getGroupEntryForName name = do + allocaBytes (#const sizeof(struct group)) $ \pgr -> + allocaBytes grBufSize $ \pbuf -> + alloca $ \ ppgr -> + withCString name $ \ pstr -> do + err <- c_getgrnam_r pstr pgr pbuf (fromIntegral grBufSize) ppgr + if (err == 0) + then unpackGroupEntry pgr + else ioError (errnoToIOError "getGroupEntryForName" + (Errno (fromIntegral err)) Nothing Nothing) + +foreign import ccall unsafe "getgrnam_r" + c_getgrnam_r :: CString -> Ptr CGroup -> CString + -> CSize -> Ptr (Ptr CGroup) -> IO CInt +#else +getGroupEntryForName = error "System.Posix.User.getGroupEntryForName: not supported" +#endif + +#if (defined(HAVE_GETGRGID_R) || defined(HAVE_GETGRNAM_R)) \ + && defined(HAVE_SYSCONF) +grBufSize :: Int +grBufSize = fromIntegral $ unsafePerformIO $ + c_sysconf (#const _SC_GETGR_R_SIZE_MAX) +#endif + +unpackGroupEntry :: Ptr CGroup -> IO GroupEntry +unpackGroupEntry ptr = do + name <- (#peek struct group, gr_name) ptr >>= peekCString + gid <- (#peek struct group, gr_gid) ptr + mem <- (#peek struct group, gr_mem) ptr + members <- peekArray0 nullPtr mem >>= mapM peekCString + return (GroupEntry name gid members) + +-- ----------------------------------------------------------------------------- +-- The user database (pwd.h) + +data UserEntry = + UserEntry { + userName :: String, + userID :: UserID, + userGroupID :: GroupID, + homeDirectory :: String, + userShell :: String + } + +getUserEntryForID :: UserID -> IO UserEntry +#ifdef HAVE_GETPWUID_R +getUserEntryForID uid = do + allocaBytes (#const sizeof(struct passwd)) $ \ppw -> + allocaBytes pwBufSize $ \pbuf -> + alloca $ \ pppw -> do + err <- c_getpwuid_r uid ppw pbuf (fromIntegral pwBufSize) pppw + if (err == 0) + then unpackUserEntry ppw + else ioError (errnoToIOError "getUserEntryForID" + (Errno (fromIntegral err)) Nothing Nothing) + +foreign import ccall unsafe "getpwuid_r" + c_getpwuid_r :: CUid -> Ptr CPasswd -> + CString -> CSize -> Ptr (Ptr CPasswd) -> IO CInt +#else +getUserEntryForID = error "System.Posix.User.getUserEntryForID: not supported" +#endif + +getUserEntryForName :: String -> IO UserEntry +#if HAVE_GETPWNAM_R +getUserEntryForName name = do + allocaBytes (#const sizeof(struct passwd)) $ \ppw -> + allocaBytes pwBufSize $ \pbuf -> + alloca $ \ pppw -> + withCString name $ \ pstr -> do + err <- c_getpwnam_r pstr ppw pbuf (fromIntegral pwBufSize) pppw + if (err == 0) + then unpackUserEntry ppw + else ioError (errnoToIOError "getUserEntryForID" + (Errno (fromIntegral err)) Nothing Nothing) + +foreign import ccall unsafe "getpwnam_r" + c_getpwnam_r :: CString -> Ptr CPasswd -> + CString -> CSize -> Ptr (Ptr CPasswd) -> IO CInt +#else +getUserEntryForName = error "System.Posix.User.getUserEntryForName: not supported" +#endif + +#if (defined(HAVE_GETPWUID_R) || defined(HAVE_GETPWNAM_R)) \ + && defined(HAVE_SYSCONF) +pwBufSize :: Int +pwBufSize = fromIntegral $ unsafePerformIO $ + c_sysconf (#const _SC_GETPW_R_SIZE_MAX) +#endif + +#ifdef HAVE_SYSCONF +foreign import ccall unsafe "sysconf" + c_sysconf :: CInt -> IO CLong +#endif + +unpackUserEntry :: Ptr CPasswd -> IO UserEntry +unpackUserEntry ptr = do + name <- (#peek struct passwd, pw_name) ptr >>= peekCString + uid <- (#peek struct passwd, pw_uid) ptr + gid <- (#peek struct passwd, pw_gid) ptr + dir <- (#peek struct passwd, pw_dir) ptr >>= peekCString + shell <- (#peek struct passwd, pw_shell) ptr >>= peekCString + return (UserEntry name uid gid dir shell) + -- cgit v1.2.3