{-# LINE 1 "System/Posix/User/ByteString.hsc" #-}{-# LANGUAGE Trustworthy, CApiFFI, PatternSynonyms, ViewPatterns #-}------------------------------------------------------------------------------- |-- Module : System.Posix.User.ByteString-- 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.ByteString(-- * 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 )whereimportSystem.Posix.TypesimportSystem.IO.Unsafe(unsafePerformIO)importForeign.C(CSize(..),CInt(..),CString,CLong(..),getErrno,throwErrno,eOK,throwErrnoIfMinus1_,throwErrnoIfNull,resetErrno,Errno(..),eRANGE,errnoToIOError)importForeign.PtrimportForeign.MarshalimportForeign.StorableimportSystem.Posix.User.Common {-# LINE 61 "System/Posix/User/ByteString.hsc" #-}{-# LINE 64 "System/Posix/User/ByteString.hsc" #-}importControl.Concurrent.MVar(MVar,newMVar,withMVar)importControl.Exception{-# LINE 67 "System/Posix/User/ByteString.hsc" #-}importControl.MonadimportSystem.IO.ErrorimportData.ByteString(ByteString,packCString,useAsCString){-# LINE 75 "System/Posix/User/ByteString.hsc" #-}{-# LINE 140 "System/Posix/User/ByteString.hsc" #-}-- ------------------------------------------------------------------------------- Thread safety of passwd/group database access APIs:---- All supported unix platforms have @get(pw|gr)(nam|[ug]id)_r(3)@, which-- store the result in a caller provided buffer, which solves the most-- immediate thread-safety issues.---- Things are more complicated for getpwent(3) and getgrent(3).---- * On Linux systems, these read a global open file, opened via-- setpwent(3) and closed via endpwent(3). Only one thread at-- a time can safely iterate through the file.---- * On macOS (through Catalina 10.15), there is no getpwent_r(3) or-- getgrent_r(3), so a lock is also required for safe buffer sharing.---- * On FreeBSD, in the default configuration with passwd lookups configured-- in nsswitch.conf to use "compat" rather than "files", the getpwnam_r(3)-- and getpwuid_r(3) functions reset the iterator index used by getpwent(3).-- A bug [report](https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=252094)-- has been filed to track this long-standing issue. A similar issue affects-- getgrent(3), this time regardless of the nsswitch.conf setting. This too-- should be fixed at some point in the future. The state in question is-- thread-specific, so both issues only affect overlapping use of the @*ent@-- and @*(nam|[ug]id)_r(3)@ functions in the /same/ thread.---- * Despite rather similar manpages for getpwent(3) and getpwnam(3), ... as-- on FreeBSD, the above issue is not seen on NetBSD or macOS.---- This is not an issue with 1-to-1 thread models, where the code executing-- @get(pw|gr)ent@ has exclusive use of its thread, but it is a real issue-- for Haskell with its many-to-1 green threads, because multiple `forkIO`-- threads may take turns using the same underlying OS thread, breaking the-- thread-safety of the @*_r@ functions, which mutate the file-offset of the-- open file shared with any overlapping execution of @*ent(3)@ in the same-- thread.---- Consequently, correct portable support for @get(pw|gr)ent(3)@ is rather-- non-trivial. In the threaded runtime, we can run these functions in a-- /bound thread/ (via 'forkOS'), thereby avoiding the FreeBSD issues. We-- still need a lock to serialise multiple threads calling these functions-- on at least macOS for lack of @_r@ equivalents. While on FreeBSD we could-- use @getpwent_r(3)@ and @getgrent_r(3)@ in a bound thread without any-- locks, implementing this special case is likely not worthwhile.---- In the non-threaded runtime, `forkOS` is not available, and so on FreeBSD-- systems we have to also lock the @*(nam|[ug]id)_r(3)@ functions to avoid-- concurrent use with @*ent(3)@.---- FWIW, the below Perl one-liners will quickly show whether interleaved calls-- of getpwuid() or getgrgid() disturb iteration through all the entries. If-- each line of output is distinct, there is likely no issue. If the same-- passwd or group entry repeats multiple times, the system is affected.---- > for ($i=0;$i<3;++$i) {getpwuid(0); print join(":",getpwent()),"\n"}-- > for ($i=0;$i<3;++$i) {getgrgid(0); print join(":",getgrent()),"\n"}---- XXX: It has been suggested, not without some merit, that attempts to-- enumerate /all/ users or /all/ groups are fundamentally flawed. Modern-- unix systems have a variety nsswitch backends, some of which instantiate-- users on demand or may enumerate slowly or not at all. We could shed a-- lot of complexity by deprecating the "get all" functions and simply-- always returning an empty list.--{-# LINE 206 "System/Posix/User/ByteString.hsc" #-}pwlock::MVar()pwlock :: MVar ()
pwlock =IO (MVar ()) -> MVar ()
forall a. IO a -> a
unsafePerformIO(IO (MVar ()) -> MVar ()) -> IO (MVar ()) -> MVar ()
forall a b. (a -> b) -> a -> b
$() -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar(){-# NOINLINEpwlock #-}lockpw ::LKUPTYPE ->IOa ->IOa {-# LINE 219 "System/Posix/User/ByteString.hsc" #-}lockpw :: forall a. LKUPTYPE -> IO a -> IO a
lockpw LKUPTYPE
GETONE =IO a -> IO a
forall a. a -> a
idlockpw LKUPTYPE
GETALL =MVar () -> (() -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVarMVar ()
pwlock ((() -> IO a) -> IO a) -> (IO a -> () -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.IO a -> () -> IO a
forall a b. a -> b -> a
const{-# LINE 222 "System/Posix/User/ByteString.hsc" #-}{-# LINE 225 "System/Posix/User/ByteString.hsc" #-}{-# LINE 227 "System/Posix/User/ByteString.hsc" #-}grlock::MVar()grlock :: MVar ()
grlock =IO (MVar ()) -> MVar ()
forall a. IO a -> a
unsafePerformIO(IO (MVar ()) -> MVar ()) -> IO (MVar ()) -> MVar ()
forall a b. (a -> b) -> a -> b
$() -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar(){-# NOINLINEgrlock #-}lockgr ::LKUPTYPE ->IOa ->IOa {-# LINE 240 "System/Posix/User/ByteString.hsc" #-}lockgr :: forall a. LKUPTYPE -> IO a -> IO a
lockgr LKUPTYPE
GETONE =IO a -> IO a
forall a. a -> a
idlockgr LKUPTYPE
GETALL =MVar () -> (() -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVarMVar ()
grlock ((() -> IO a) -> IO a) -> (IO a -> () -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.IO a -> () -> IO a
forall a b. a -> b -> a
const{-# LINE 243 "System/Posix/User/ByteString.hsc" #-}{-# LINE 246 "System/Posix/User/ByteString.hsc" #-}-- ------------------------------------------------------------------------------- user environment-- | @getRealUserID@ calls @getuid@ to obtain the real @UserID@-- associated with the current process.getRealUserID ::IOUserIDgetRealUserID :: IO UserID
getRealUserID =IO UserID
c_getuid foreignimportccallunsafe"getuid"c_getuid ::IOCUid-- | @getRealGroupID@ calls @getgid@ to obtain the real @GroupID@-- associated with the current process.getRealGroupID ::IOGroupIDgetRealGroupID :: IO GroupID
getRealGroupID =IO GroupID
c_getgid foreignimportccallunsafe"getgid"c_getgid ::IOCGid-- | @getEffectiveUserID@ calls @geteuid@ to obtain the effective-- @UserID@ associated with the current process.getEffectiveUserID ::IOUserIDgetEffectiveUserID :: IO UserID
getEffectiveUserID =IO UserID
c_geteuid foreignimportccallunsafe"geteuid"c_geteuid ::IOCUid-- | @getEffectiveGroupID@ calls @getegid@ to obtain the effective-- @GroupID@ associated with the current process.getEffectiveGroupID ::IOGroupIDgetEffectiveGroupID :: IO GroupID
getEffectiveGroupID =IO GroupID
c_getegid foreignimportccallunsafe"getegid"c_getegid ::IOCGid-- | @getGroups@ calls @getgroups@ to obtain the list of-- supplementary @GroupID@s associated with the current process.getGroups ::IO[GroupID]getGroups :: IO [GroupID]
getGroups =doCInt
ngroups <-CInt -> Ptr GroupID -> IO CInt
c_getgroups CInt
0Ptr GroupID
forall a. Ptr a
nullPtrInt -> (Ptr GroupID -> IO [GroupID]) -> IO [GroupID]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray(CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralCInt
ngroups )((Ptr GroupID -> IO [GroupID]) -> IO [GroupID])
-> (Ptr GroupID -> IO [GroupID]) -> IO [GroupID]
forall a b. (a -> b) -> a -> b
$\Ptr GroupID
arr ->doString -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"getGroups"(CInt -> Ptr GroupID -> IO CInt
c_getgroups CInt
ngroups Ptr GroupID
arr )[GroupID]
groups <-Int -> Ptr GroupID -> IO [GroupID]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray(CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralCInt
ngroups )Ptr GroupID
arr [GroupID] -> IO [GroupID]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return[GroupID]
groups foreignimportccallunsafe"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()setGroups :: [GroupID] -> IO ()
setGroups [GroupID]
groups =do[GroupID] -> (Int -> Ptr GroupID -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen[GroupID]
groups ((Int -> Ptr GroupID -> IO ()) -> IO ())
-> (Int -> Ptr GroupID -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\Int
ngroups Ptr GroupID
arr ->String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"setGroups"(CInt -> Ptr GroupID -> IO CInt
c_setgroups (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
ngroups )Ptr GroupID
arr )foreignimportccallunsafe"setgroups"c_setgroups ::CInt->PtrCGid->IOCInt-- | @getLoginName@ calls @getlogin@ to obtain the login name-- associated with the current process.getLoginName ::IOByteStringgetLoginName :: IO ByteString
getLoginName =do-- ToDo: use getlogin_rPtr CChar
str <-String -> IO (Ptr CChar) -> IO (Ptr CChar)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNullString
"getLoginName"IO (Ptr CChar)
c_getlogin Ptr CChar -> IO ByteString
packCStringPtr CChar
str foreignimportccallunsafe"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()setUserID :: UserID -> IO ()
setUserID UserID
uid =String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"setUserID"(UserID -> IO CInt
c_setuid UserID
uid )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()setEffectiveUserID :: UserID -> IO ()
setEffectiveUserID UserID
uid =String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"setEffectiveUserID"(UserID -> IO CInt
c_seteuid UserID
uid )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()setGroupID :: GroupID -> IO ()
setGroupID GroupID
gid =String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"setGroupID"(GroupID -> IO CInt
c_setgid GroupID
gid )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()setEffectiveGroupID :: GroupID -> IO ()
setEffectiveGroupID GroupID
gid =String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_String
"setEffectiveGroupID"(GroupID -> IO CInt
c_setegid GroupID
gid )foreignimportccallunsafe"setegid"c_setegid ::CGid->IOCInt-- ------------------------------------------------------------------------------- User names-- | @getEffectiveUserName@ gets the name-- associated with the effective @UserID@ of the process.getEffectiveUserName ::IOByteStringgetEffectiveUserName :: IO ByteString
getEffectiveUserName =doUserID
euid <-IO UserID
getEffectiveUserID UserEntry
pw <-UserID -> IO UserEntry
getUserEntryForID UserID
euid ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(UserEntry -> ByteString
userName UserEntry
pw ){-# LINE 366 "System/Posix/User/ByteString.hsc" #-}-- ------------------------------------------------------------------------------- The group database (grp.h){-# LINE 389 "System/Posix/User/ByteString.hsc" #-}-- | @getGroupEntryForID gid@ calls @getgrgid_r@ to obtain-- the @GroupEntry@ information associated with @GroupID@-- @gid@. This operation may fail with 'isDoesNotExistError'-- if no such group exists.getGroupEntryForID ::GroupID->IOGroupEntry {-# LINE 396 "System/Posix/User/ByteString.hsc" #-}getGroupEntryForIDgid=lockgrGETONE$allocaBytes(32)$\pgr->{-# LINE 398 "System/Posix/User/ByteString.hsc" #-}doubleAllocWhileERANGE"getGroupEntryForID""group"grBufSizeunpackGroupEntry$c_getgrgid_rgidpgrforeignimportcapisafe"HsUnix.h getgrgid_r"c_getgrgid_r ::CGid->PtrCGroup ->CString->CSize->Ptr(PtrCGroup )->IOCInt{-# LINE 408 "System/Posix/User/ByteString.hsc" #-}-- | @getGroupEntryForName name@ calls @getgrnam_r@ to obtain-- the @GroupEntry@ information associated with the group called-- @name@. This operation may fail with 'isDoesNotExistError'-- if no such group exists.getGroupEntryForName ::ByteString->IOGroupEntry {-# LINE 415 "System/Posix/User/ByteString.hsc" #-}getGroupEntryForNamename=lockgrGETONE$allocaBytes(32)$\pgr->{-# LINE 417 "System/Posix/User/ByteString.hsc" #-}useAsCStringname$\pstr->doubleAllocWhileERANGE"getGroupEntryForName""group"grBufSizeunpackGroupEntry$c_getgrnam_rpstrpgrforeignimportcapisafe"HsUnix.h getgrnam_r"c_getgrnam_r ::CString->PtrCGroup ->CString->CSize->Ptr(PtrCGroup )->IOCInt{-# LINE 428 "System/Posix/User/ByteString.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 439 "System/Posix/User/ByteString.hsc" #-}getAllGroupEntries=lockgrGETALL$bracket_c_setgrentc_endgrent$worker[]whereworkeraccum=doresetErrnoppw<-throwErrnoIfNullAndError"getAllGroupEntries"$c_getgrentifppw==nullPtrthenreturn(reverseaccum)elsedothisentry<-unpackGroupEntryppwworker(thisentry:accum)foreignimportccallsafe"getgrent"c_getgrent ::IO(PtrCGroup )foreignimportccallsafe"setgrent"c_setgrent ::IO()foreignimportccallsafe"endgrent"c_endgrent ::IO(){-# LINE 456 "System/Posix/User/ByteString.hsc" #-}{-# LINE 458 "System/Posix/User/ByteString.hsc" #-}grBufSize::Int{-# LINE 460 "System/Posix/User/ByteString.hsc" #-}grBufSize=sysconfWithDefault1024(69){-# LINE 461 "System/Posix/User/ByteString.hsc" #-}{-# LINE 464 "System/Posix/User/ByteString.hsc" #-}{-# LINE 465 "System/Posix/User/ByteString.hsc" #-}{-# LINE 467 "System/Posix/User/ByteString.hsc" #-}-- ------------------------------------------------------------------------------- The user database (pwd.h)-- | @getUserEntryForID uid@ calls @getpwuid_r@ to obtain-- the @UserEntry@ information associated with @UserID@-- @uid@. This operation may fail with 'isDoesNotExistError'-- if no such user exists.getUserEntryForID ::UserID->IOUserEntry {-# LINE 478 "System/Posix/User/ByteString.hsc" #-}getUserEntryForIDuid=lockpwGETONE$allocaBytes(48)$\ppw->{-# LINE 480 "System/Posix/User/ByteString.hsc" #-}doubleAllocWhileERANGE"getUserEntryForID""user"pwBufSizeunpackUserEntry$c_getpwuid_ruidppwforeignimportcapisafe"HsUnix.h getpwuid_r"c_getpwuid_r ::CUid->PtrCPasswd ->CString->CSize->Ptr(PtrCPasswd )->IOCInt{-# LINE 490 "System/Posix/User/ByteString.hsc" #-}-- | @getUserEntryForName name@ calls @getpwnam_r@ to obtain-- the @UserEntry@ information associated with the user login-- @name@. This operation may fail with 'isDoesNotExistError'-- if no such user exists.getUserEntryForName ::ByteString->IOUserEntry {-# LINE 497 "System/Posix/User/ByteString.hsc" #-}getUserEntryForNamename=lockpwGETONE$allocaBytes(48)$\ppw->{-# LINE 499 "System/Posix/User/ByteString.hsc" #-}useAsCStringname$\pstr->doubleAllocWhileERANGE"getUserEntryForName""user"pwBufSizeunpackUserEntry$c_getpwnam_rpstrppwforeignimportcapisafe"HsUnix.h getpwnam_r"c_getpwnam_r ::CString->PtrCPasswd ->CString->CSize->Ptr(PtrCPasswd )->IOCInt{-# LINE 510 "System/Posix/User/ByteString.hsc" #-}-- | @getAllUserEntries@ returns all user entries on the system by-- repeatedly calling @getpwent@getAllUserEntries ::IO[UserEntry ]{-# LINE 515 "System/Posix/User/ByteString.hsc" #-}getAllUserEntries=lockpwGETALL$bracket_c_setpwentc_endpwent$worker[]whereworkeraccum=doresetErrnoppw<-throwErrnoIfNullAndError"getAllUserEntries"$c_getpwentifppw==nullPtrthenreturn(reverseaccum)elsedothisentry<-unpackUserEntryppwworker(thisentry:accum)foreignimportccallsafe"getpwent"c_getpwent ::IO(PtrCPasswd )foreignimportccallsafe"setpwent"c_setpwent ::IO()foreignimportccallsafe"endpwent"c_endpwent ::IO(){-# LINE 532 "System/Posix/User/ByteString.hsc" #-}{-# LINE 534 "System/Posix/User/ByteString.hsc" #-}pwBufSize::Int{-# LINE 536 "System/Posix/User/ByteString.hsc" #-}pwBufSize=sysconfWithDefault1024(70){-# LINE 537 "System/Posix/User/ByteString.hsc" #-}{-# LINE 540 "System/Posix/User/ByteString.hsc" #-}{-# LINE 541 "System/Posix/User/ByteString.hsc" #-}{-# LINE 543 "System/Posix/User/ByteString.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->IntsysconfWithDefault :: Int -> CInt -> Int
sysconfWithDefault Int
def CInt
sc =IO Int -> Int
forall a. IO a -> a
unsafePerformIO(IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$doInt
v <-(CLong -> Int) -> IO CLong -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapCLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(IO CLong -> IO Int) -> IO CLong -> IO Int
forall a b. (a -> b) -> a -> b
$CInt -> IO CLong
c_sysconf CInt
sc Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ifInt
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==(-Int
1)thenInt
def elseInt
v {-# LINE 555 "System/Posix/User/ByteString.hsc" #-}{-# LINE 557 "System/Posix/User/ByteString.hsc" #-}-- The following function is used by the getgr*_r, c_getpw*_r-- families of functions. These functions return their result-- in a struct that contains strings and they need a buffer-- that they can use to store those strings. We have to be-- careful to unpack the struct containing the result before-- the buffer is deallocated.doubleAllocWhileERANGE ::String->String-- entry type: "user" or "group"->Int->(Ptrr ->IOa )->(Ptrb ->CSize->Ptr(Ptrr )->IOCInt)->IOa doubleAllocWhileERANGE :: forall r a b.
String
-> String
-> Int
-> (Ptr r -> IO a)
-> (Ptr b -> CSize -> Ptr (Ptr r) -> IO CInt)
-> IO a
doubleAllocWhileERANGE String
loc String
enttype Int
initlen Ptr r -> IO a
unpack Ptr b -> CSize -> Ptr (Ptr r) -> IO CInt
action =(Ptr (Ptr r) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca((Ptr (Ptr r) -> IO a) -> IO a) -> (Ptr (Ptr r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$Int -> Ptr (Ptr r) -> IO a
go Int
initlen wherego :: Int -> Ptr (Ptr r) -> IO a
go Int
len Ptr (Ptr r)
res =doEither CInt a
r <-Int -> (Ptr b -> IO (Either CInt a)) -> IO (Either CInt a)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytesInt
len ((Ptr b -> IO (Either CInt a)) -> IO (Either CInt a))
-> (Ptr b -> IO (Either CInt a)) -> IO (Either CInt a)
forall a b. (a -> b) -> a -> b
$\Ptr b
buf ->doCInt
rc <-Ptr b -> CSize -> Ptr (Ptr r) -> IO CInt
action Ptr b
buf (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
len )Ptr (Ptr r)
res ifCInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/=CInt
0thenEither CInt a -> IO (Either CInt a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(CInt -> Either CInt a
forall a b. a -> Either a b
LeftCInt
rc )elsedoPtr r
p <-Ptr (Ptr r) -> IO (Ptr r)
forall a. Storable a => Ptr a -> IO a
peekPtr (Ptr r)
res Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when(Ptr r
p Ptr r -> Ptr r -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr r
forall a. Ptr a
nullPtr)(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$IO ()
forall {a}. IO a
notFoundErr (a -> Either CInt a) -> IO a -> IO (Either CInt a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapa -> Either CInt a
forall a b. b -> Either a b
Right(Ptr r -> IO a
unpack Ptr r
p )caseEither CInt a
r ofRighta
x ->a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
returna
x LeftCInt
rc |CInt -> Errno
ErrnoCInt
rc Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
==Errno
eRANGE->-- ERANGE means this is not an error-- we just have to try again with a larger bufferInt -> Ptr (Ptr r) -> IO a
go (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
len )Ptr (Ptr r)
res LeftCInt
rc ->IOError -> IO a
forall a. IOError -> IO a
ioError(String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOErrorString
loc (CInt -> Errno
ErrnoCInt
rc )Maybe Handle
forall a. Maybe a
NothingMaybe String
forall a. Maybe a
Nothing)notFoundErr :: IO a
notFoundErr =IOError -> IO a
forall a. IOError -> IO a
ioError(IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$(IOError -> String -> IOError) -> String -> IOError -> IOError
forall a b c. (a -> b -> c) -> b -> a -> c
flipIOError -> String -> IOError
ioeSetErrorString(String
"no such "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
enttype )(IOError -> IOError) -> IOError -> IOError
forall a b. (a -> b) -> a -> b
$IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOErrorIOErrorType
doesNotExistErrorTypeString
loc Maybe Handle
forall a. Maybe a
NothingMaybe String
forall a. Maybe a
Nothing-- 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 )throwErrnoIfNullAndError :: forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNullAndError String
loc IO (Ptr a)
act =doPtr a
rc <-IO (Ptr a)
act Errno
errno <-IO Errno
getErrnoifPtr a
rc Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr a
forall a. Ptr a
nullPtrBool -> Bool -> Bool
&&Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
/=Errno
eOKthenString -> IO (Ptr a)
forall a. String -> IO a
throwErrnoString
loc elsePtr a -> IO (Ptr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
returnPtr a
rc {-# LINE 605 "System/Posix/User/ByteString.hsc" #-}