{-# LINE 1 "libraries/unix/./System/Posix/User.hsc" #-}{-# LANGUAGE ForeignFunctionInterface #-}{-# LINE 2 "libraries/unix/./System/Posix/User.hsc" #-}{-# LINE 3 "libraries/unix/./System/Posix/User.hsc" #-}{-# LANGUAGE Trustworthy #-}{-# LINE 5 "libraries/unix/./System/Posix/User.hsc" #-}------------------------------------------------------------------------------- |-- 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-------------------------------------------------------------------------------moduleSystem.Posix.User(-- * User environment-- ** Querying the user environmentgetRealUserID,getRealGroupID,getEffectiveUserID,getEffectiveGroupID,getGroups,getLoginName,getEffectiveUserName,-- *** The group databaseGroupEntry(..),getGroupEntryForID,getGroupEntryForName,getAllGroupEntries,-- *** The user databaseUserEntry(..),getUserEntryForID,getUserEntryForName,getAllUserEntries,-- ** Modifying the user environmentsetUserID,setGroupID,setEffectiveUserID,setEffectiveGroupID,setGroups)where{-# LINE 52 "libraries/unix/./System/Posix/User.hsc" #-}importSystem.Posix.TypesimportForeignhiding(unsafePerformIO)importSystem.IO.Unsafe(unsafePerformIO)importForeign.CimportSystem.Posix.Internals(CGroup,CPasswd){-# LINE 60 "libraries/unix/./System/Posix/User.hsc" #-}importControl.Concurrent.MVar(MVar,newMVar,withMVar){-# LINE 62 "libraries/unix/./System/Posix/User.hsc" #-}{-# LINE 63 "libraries/unix/./System/Posix/User.hsc" #-}importControl.Exception{-# LINE 65 "libraries/unix/./System/Posix/User.hsc" #-}{-# LINE 66 "libraries/unix/./System/Posix/User.hsc" #-}importControl.MonadimportSystem.IO.Error{-# LINE 69 "libraries/unix/./System/Posix/User.hsc" #-}-- ------------------------------------------------------------------------------- user environemnt-- | @getRealUserID@ calls @getuid@ to obtain the real @UserID@-- associated with the current process.getRealUserID::IOUserIDgetRealUserID=c_getuidforeignimportccallunsafe"getuid"c_getuid::IOCUid-- | @getRealGroupID@ calls @getgid@ to obtain the real @GroupID@-- associated with the current process.getRealGroupID::IOGroupIDgetRealGroupID=c_getgidforeignimportccallunsafe"getgid"c_getgid::IOCGid-- | @getEffectiveUserID@ calls @geteuid@ to obtain the effective-- @UserID@ associated with the current process.getEffectiveUserID::IOUserIDgetEffectiveUserID=c_geteuidforeignimportccallunsafe"geteuid"c_geteuid::IOCUid-- | @getEffectiveGroupID@ calls @getegid@ to obtain the effective-- @GroupID@ associated with the current process.getEffectiveGroupID::IOGroupIDgetEffectiveGroupID=c_getegidforeignimportccallunsafe"getegid"c_getegid::IOCGid-- | @getGroups@ calls @getgroups@ to obtain the list of-- supplementary @GroupID@s associated with the current process.getGroups::IO[GroupID]getGroups=dongroups<-c_getgroups0nullPtrallocaArray(fromIntegralngroups)$\arr->dothrowErrnoIfMinus1_"getGroups"(c_getgroupsngroupsarr)groups<-peekArray(fromIntegralngroups)arrreturngroupsforeignimportccallunsafe"getgroups"c_getgroups::CInt->PtrCGid->IOCInt-- | @setGroups@ calls @setgroups@ to set the list of-- supplementary @GroupID@s associated with the current process.setGroups::[GroupID]->IO()setGroupsgroups=dowithArrayLengroups$\ngroupsarr->throwErrnoIfMinus1_"setGroups"(c_setgroups(fromIntegralngroups)arr)foreignimportccallunsafe"setgroups"c_setgroups::CInt->PtrCGid->IOCInt-- | @getLoginName@ calls @getlogin@ to obtain the login name-- associated with the current process.getLoginName::IOStringgetLoginName=do-- ToDo: use getlogin_rstr<-throwErrnoIfNull"getLoginName"c_getloginpeekCAStringstrforeignimportccallunsafe"getlogin"c_getlogin::IOCString-- | @setUserID uid@ calls @setuid@ to set the real, effective, and-- saved set-user-id associated with the current process to @uid@.setUserID::UserID->IO()setUserIDuid=throwErrnoIfMinus1_"setUserID"(c_setuiduid)foreignimportccallunsafe"setuid"c_setuid::CUid->IOCInt-- | @setEffectiveUserID uid@ calls @seteuid@ to set the effective-- user-id associated with the current process to @uid@. This-- does not update the real user-id or set-user-id.setEffectiveUserID::UserID->IO()setEffectiveUserIDuid=throwErrnoIfMinus1_"setEffectiveUserID"(c_seteuiduid)foreignimportccallunsafe"seteuid"c_seteuid::CUid->IOCInt-- | @setGroupID gid@ calls @setgid@ to set the real, effective, and-- saved set-group-id associated with the current process to @gid@.setGroupID::GroupID->IO()setGroupIDgid=throwErrnoIfMinus1_"setGroupID"(c_setgidgid)foreignimportccallunsafe"setgid"c_setgid::CGid->IOCInt-- | @setEffectiveGroupID uid@ calls @setegid@ to set the effective-- group-id associated with the current process to @gid@. This-- does not update the real group-id or set-group-id.setEffectiveGroupID::GroupID->IO()setEffectiveGroupIDgid=throwErrnoIfMinus1_"setEffectiveGroupID"(c_setegidgid)foreignimportccallunsafe"setegid"c_setegid::CGid->IOCInt-- ------------------------------------------------------------------------------- User names-- | @getEffectiveUserName@ gets the name-- associated with the effective @UserID@ of the process.getEffectiveUserName::IOStringgetEffectiveUserName=doeuid<-getEffectiveUserIDpw<-getUserEntryForIDeuidreturn(userNamepw)-- ------------------------------------------------------------------------------- The group database (grp.h)dataGroupEntry=GroupEntry{groupName::String,-- ^ The name of this group (gr_name)groupPassword::String,-- ^ The password for this group (gr_passwd)groupID::GroupID,-- ^ The unique numeric ID for this group (gr_gid)groupMembers::[String]-- ^ A list of zero or more usernames that are members (gr_mem)}deriving(Show,Read,Eq)-- | @getGroupEntryForID gid@ calls @getgrgid@ to obtain-- the @GroupEntry@ information associated with @GroupID@-- @gid@.getGroupEntryForID::GroupID->IOGroupEntry{-# LINE 205 "libraries/unix/./System/Posix/User.hsc" #-}getGroupEntryForIDgid=doallocaBytes(16)$\pgr->{-# LINE 207 "libraries/unix/./System/Posix/User.hsc" #-}alloca$\ppgr->dothrowErrorIfNonZero_"getGroupEntryForID"$doubleAllocWhileisERANGEgrBufSize$\sb->c_getgrgid_rgidpgrb(fromIntegrals)ppgr_<-throwErrnoIfNull"getGroupEntryForID"$peekElemOffppgr0unpackGroupEntrypgrforeignimportccallunsafe"getgrgid_r"c_getgrgid_r::CGid->PtrCGroup->CString->CSize->Ptr(PtrCGroup)->IOCInt{-# LINE 222 "libraries/unix/./System/Posix/User.hsc" #-}-- | @getGroupEntryForName name@ calls @getgrnam@ to obtain-- the @GroupEntry@ information associated with the group called-- @name@.getGroupEntryForName::String->IOGroupEntry{-# LINE 228 "libraries/unix/./System/Posix/User.hsc" #-}getGroupEntryForNamename=doallocaBytes(16)$\pgr->{-# LINE 230 "libraries/unix/./System/Posix/User.hsc" #-}alloca$\ppgr->withCAStringname$\pstr->dothrowErrorIfNonZero_"getGroupEntryForName"$doubleAllocWhileisERANGEgrBufSize$\sb->c_getgrnam_rpstrpgrb(fromIntegrals)ppgrr<-peekElemOffppgr0when(r==nullPtr)$ioError$flipioeSetErrorString"no group name"$mkIOErrordoesNotExistErrorType"getGroupEntryForName"Nothing(Justname)unpackGroupEntrypgrforeignimportccallunsafe"getgrnam_r"c_getgrnam_r::CString->PtrCGroup->CString->CSize->Ptr(PtrCGroup)->IOCInt{-# LINE 250 "libraries/unix/./System/Posix/User.hsc" #-}-- | @getAllGroupEntries@ returns all group entries on the system by-- repeatedly calling @getgrent@---- getAllGroupEntries may fail with isDoesNotExistError on Linux due to-- this bug in glibc:-- http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=466647--getAllGroupEntries::IO[GroupEntry]{-# LINE 261 "libraries/unix/./System/Posix/User.hsc" #-}getAllGroupEntries=withMVarlock$\_->bracket_c_setgrentc_endgrent$worker[]whereworkeraccum=doresetErrnoppw<-throwErrnoIfNullAndError"getAllGroupEntries"$c_getgrentifppw==nullPtrthenreturn(reverseaccum)elsedothisentry<-unpackGroupEntryppwworker(thisentry:accum)foreignimportccallunsafe"getgrent"c_getgrent::IO(PtrCGroup)foreignimportccallunsafe"setgrent"c_setgrent::IO()foreignimportccallunsafe"endgrent"c_endgrent::IO(){-# LINE 281 "libraries/unix/./System/Posix/User.hsc" #-}{-# LINE 283 "libraries/unix/./System/Posix/User.hsc" #-}grBufSize::Int{-# LINE 285 "libraries/unix/./System/Posix/User.hsc" #-}grBufSize=sysconfWithDefault1024(69){-# LINE 286 "libraries/unix/./System/Posix/User.hsc" #-}{-# LINE 289 "libraries/unix/./System/Posix/User.hsc" #-}{-# LINE 290 "libraries/unix/./System/Posix/User.hsc" #-}unpackGroupEntry::PtrCGroup->IOGroupEntryunpackGroupEntryptr=doname<-((\hsc_ptr->peekByteOffhsc_ptr0))ptr>>=peekCAString{-# LINE 294 "libraries/unix/./System/Posix/User.hsc" #-}passwd<-((\hsc_ptr->peekByteOffhsc_ptr4))ptr>>=peekCAString{-# LINE 295 "libraries/unix/./System/Posix/User.hsc" #-}gid<-((\hsc_ptr->peekByteOffhsc_ptr8))ptr{-# LINE 296 "libraries/unix/./System/Posix/User.hsc" #-}mem<-((\hsc_ptr->peekByteOffhsc_ptr12))ptr{-# LINE 297 "libraries/unix/./System/Posix/User.hsc" #-}members<-peekArray0nullPtrmem>>=mapMpeekCAStringreturn(GroupEntrynamepasswdgidmembers)-- ------------------------------------------------------------------------------- The user database (pwd.h)dataUserEntry=UserEntry{userName::String,-- ^ Textual name of this user (pw_name)userPassword::String,-- ^ Password -- may be empty or fake if shadow is in use (pw_passwd)userID::UserID,-- ^ Numeric ID for this user (pw_uid)userGroupID::GroupID,-- ^ Primary group ID (pw_gid)userGecos::String,-- ^ Usually the real name for the user (pw_gecos)homeDirectory::String,-- ^ Home directory (pw_dir)userShell::String-- ^ Default shell (pw_shell)}deriving(Show,Read,Eq)---- getpwuid and getpwnam leave results in a static object. Subsequent-- calls modify the same object, which isn't threadsafe. We attempt to-- mitigate this issue, on platforms that don't provide the safe _r versions---- Also, getpwent/setpwent require a global lock since they maintain-- an internal file position pointer.{-# LINE 322 "libraries/unix/./System/Posix/User.hsc" #-}lock::MVar()lock=unsafePerformIO$newMVar(){-# NOINLINE lock #-}{-# LINE 326 "libraries/unix/./System/Posix/User.hsc" #-}-- | @getUserEntryForID gid@ calls @getpwuid@ to obtain-- the @UserEntry@ information associated with @UserID@-- @uid@.getUserEntryForID::UserID->IOUserEntry{-# LINE 332 "libraries/unix/./System/Posix/User.hsc" #-}getUserEntryForIDuid=doallocaBytes(28)$\ppw->{-# LINE 334 "libraries/unix/./System/Posix/User.hsc" #-}alloca$\pppw->dothrowErrorIfNonZero_"getUserEntryForID"$doubleAllocWhileisERANGEpwBufSize$\sb->c_getpwuid_ruidppwb(fromIntegrals)pppw_<-throwErrnoIfNull"getUserEntryForID"$peekElemOffpppw0unpackUserEntryppwforeignimportccallunsafe"__hsunix_getpwuid_r"c_getpwuid_r::CUid->PtrCPasswd->CString->CSize->Ptr(PtrCPasswd)->IOCInt{-# LINE 356 "libraries/unix/./System/Posix/User.hsc" #-}-- | @getUserEntryForName name@ calls @getpwnam@ to obtain-- the @UserEntry@ information associated with the user login-- @name@.getUserEntryForName::String->IOUserEntry{-# LINE 362 "libraries/unix/./System/Posix/User.hsc" #-}getUserEntryForNamename=doallocaBytes(28)$\ppw->{-# LINE 364 "libraries/unix/./System/Posix/User.hsc" #-}alloca$\pppw->withCAStringname$\pstr->dothrowErrorIfNonZero_"getUserEntryForName"$doubleAllocWhileisERANGEpwBufSize$\sb->c_getpwnam_rpstrppwb(fromIntegrals)pppwr<-peekElemOffpppw0when(r==nullPtr)$ioError$flipioeSetErrorString"no user name"$mkIOErrordoesNotExistErrorType"getUserEntryForName"Nothing(Justname)unpackUserEntryppwforeignimportccallunsafe"__hsunix_getpwnam_r"c_getpwnam_r::CString->PtrCPasswd->CString->CSize->Ptr(PtrCPasswd)->IOCInt{-# LINE 393 "libraries/unix/./System/Posix/User.hsc" #-}-- | @getAllUserEntries@ returns all user entries on the system by -- repeatedly calling @getpwent@getAllUserEntries::IO[UserEntry]{-# LINE 398 "libraries/unix/./System/Posix/User.hsc" #-}getAllUserEntries=withMVarlock$\_->bracket_c_setpwentc_endpwent$worker[]whereworkeraccum=doresetErrnoppw<-throwErrnoIfNullAndError"getAllUserEntries"$c_getpwentifppw==nullPtrthenreturn(reverseaccum)elsedothisentry<-unpackUserEntryppwworker(thisentry:accum)foreignimportccallunsafe"__hsunix_getpwent"c_getpwent::IO(PtrCPasswd)foreignimportccallunsafe"setpwent"c_setpwent::IO()foreignimportccallunsafe"endpwent"c_endpwent::IO(){-# LINE 418 "libraries/unix/./System/Posix/User.hsc" #-}{-# LINE 420 "libraries/unix/./System/Posix/User.hsc" #-}pwBufSize::Int{-# LINE 422 "libraries/unix/./System/Posix/User.hsc" #-}pwBufSize=sysconfWithDefault1024(70){-# LINE 423 "libraries/unix/./System/Posix/User.hsc" #-}{-# LINE 426 "libraries/unix/./System/Posix/User.hsc" #-}{-# LINE 427 "libraries/unix/./System/Posix/User.hsc" #-}{-# LINE 429 "libraries/unix/./System/Posix/User.hsc" #-}foreignimportccallunsafe"sysconf"c_sysconf::CInt->IOCLong-- We need a default value since sysconf can fail and return -1-- even when the parameter name is defined in unistd.h.-- One example of this is _SC_GETPW_R_SIZE_MAX under -- Mac OS X 10.4.9 on i386.sysconfWithDefault::Int->CInt->IntsysconfWithDefaultdefsc=unsafePerformIO$dov<-fmapfromIntegral$c_sysconfscreturn$ifv==(-1)thendefelsev{-# LINE 441 "libraries/unix/./System/Posix/User.hsc" #-}isERANGE::Integrala=>a->BoolisERANGE=(==eRANGE).Errno.fromIntegraldoubleAllocWhile::(a->Bool)->Int->(Int->Ptrb->IOa)->IOadoubleAllocWhilepsm=dor<-allocaBytess(ms)ifprthendoubleAllocWhilep(2*s)melsereturnrunpackUserEntry::PtrCPasswd->IOUserEntryunpackUserEntryptr=doname<-((\hsc_ptr->peekByteOffhsc_ptr0))ptr>>=peekCAString{-# LINE 453 "libraries/unix/./System/Posix/User.hsc" #-}passwd<-((\hsc_ptr->peekByteOffhsc_ptr4))ptr>>=peekCAString{-# LINE 454 "libraries/unix/./System/Posix/User.hsc" #-}uid<-((\hsc_ptr->peekByteOffhsc_ptr8))ptr{-# LINE 455 "libraries/unix/./System/Posix/User.hsc" #-}gid<-((\hsc_ptr->peekByteOffhsc_ptr12))ptr{-# LINE 456 "libraries/unix/./System/Posix/User.hsc" #-}gecos<-((\hsc_ptr->peekByteOffhsc_ptr16))ptr>>=peekCAString{-# LINE 457 "libraries/unix/./System/Posix/User.hsc" #-}dir<-((\hsc_ptr->peekByteOffhsc_ptr20))ptr>>=peekCAString{-# LINE 458 "libraries/unix/./System/Posix/User.hsc" #-}shell<-((\hsc_ptr->peekByteOffhsc_ptr24))ptr>>=peekCAString{-# LINE 459 "libraries/unix/./System/Posix/User.hsc" #-}return(UserEntrynamepasswduidgidgecosdirshell)-- Used when calling re-entrant system calls that signal their 'errno' -- directly through the return value.throwErrorIfNonZero_::String->IOCInt->IO()throwErrorIfNonZero_locact=dorc<-actif(rc==0)thenreturn()elseioError(errnoToIOErrorloc(Errnorc)NothingNothing)-- Used when a function returns NULL to indicate either an error or-- EOF, depending on whether the global errno is nonzero.throwErrnoIfNullAndError::String->IO(Ptra)->IO(Ptra)throwErrnoIfNullAndErrorlocact=dorc<-acterrno<-getErrnoifrc==nullPtr&&errno/=eOKthenthrowErrnolocelsereturnrc