System.Posix.User: make get{Group,User}EntryFor* more portable
Matthias Kilian
kili at outback.escape.de
Sun Mar 29 11:08:42 EDT 2009
Hi,
some oddities let the user001 test of the unix package fail on
getGroupEntryFor*. One reason is that sysconf(_SC_GETGR_R_SIZE_MAX)
returns 1024 on OpenBSD, while getgr*_r(3) actually need a buffer
of 1024 + 200 * sizeof(char*) bytes.
Note that the grBufSize = 2048 workaround in User.hsc did not work
on 64 bit machines with OpenBSD, even before the _SC_GETGR_R_SIZE_MAX
sysconf had been introduced.
Instead of fiddling with stupid numbers again, I just implemented the
try / enlarge / try harder scheme mentioned for example at
http://www.opengroup.org/onlinepubs/9699919799/functions/getgrgid.html
And I did so for all four functions, just in case there are existing
problems with other unices (OpenBSD only needs the getGroupEntryFor*
fixes).
My Haskell sucks badly, so if someone has a cleaner solution: feel
free use it instead of my patch ;-)
Ciao,
Kili
-------------- next part --------------
Sun Mar 29 16:42:52 CEST 2009 Matthias Kilian <kili at outback.escape.de>
* Make get{Group,User}EntryBy{ID,Name} more portable.
Retry with a larger buffer whenever getgrgid_r(3), getgrnam_r(3),
getpwuid_r(3) or getpwnam_r(3) return ERANGE. Suggested in the
examples sections of IEEE Std 1003.1-2008.
While here, change the default for grBufSize back to 1024.
New patches:
[Make get{Group,User}EntryBy{ID,Name} more portable.
Matthias Kilian <kili at outback.escape.de>**20090329144252
Ignore-this: 483362361add825012eac72d66e5b40b
Retry with a larger buffer whenever getgrgid_r(3), getgrnam_r(3),
getpwuid_r(3) or getpwnam_r(3) return ERANGE. Suggested in the
examples sections of IEEE Std 1003.1-2008.
While here, change the default for grBufSize back to 1024.
] {
hunk ./System/Posix/User.hsc 170
#ifdef HAVE_GETGRGID_R
getGroupEntryForID gid = do
allocaBytes (#const sizeof(struct group)) $ \pgr ->
- allocaBytes grBufSize $ \pbuf ->
- alloca $ \ ppgr -> do
- throwErrorIfNonZero_ "getGroupEntryForID" $
- c_getgrgid_r gid pgr pbuf (fromIntegral grBufSize) ppgr
- throwErrnoIfNull "getGroupEntryForID" $
- peekElemOff ppgr 0
- unpackGroupEntry pgr
+ alloca $ \ ppgr -> do
+ throwErrorIfNonZero_ "getGroupEntryForID" $
+ doubleAllocWhile isERANGE grBufSize $ \s b ->
+ c_getgrgid_r gid pgr b (fromIntegral s) ppgr
+ throwErrnoIfNull "getGroupEntryForID" $
+ peekElemOff ppgr 0
+ unpackGroupEntry pgr
foreign import ccall unsafe "getgrgid_r"
hunk ./System/Posix/User.hsc 193
#ifdef HAVE_GETGRNAM_R
getGroupEntryForName name = do
allocaBytes (#const sizeof(struct group)) $ \pgr ->
- allocaBytes grBufSize $ \pbuf ->
- alloca $ \ ppgr ->
- withCString name $ \ pstr -> do
- throwErrorIfNonZero_ "getGroupEntryForName" $
- c_getgrnam_r pstr pgr pbuf (fromIntegral grBufSize) ppgr
- r <- peekElemOff ppgr 0
- when (r == nullPtr) $
- ioError $ flip ioeSetErrorString "no group name"
- $ mkIOError doesNotExistErrorType
- "getGroupEntryForName"
- Nothing
- (Just name)
- unpackGroupEntry pgr
+ alloca $ \ ppgr ->
+ withCString name $ \ pstr -> do
+ throwErrorIfNonZero_ "getGroupEntryForName" $
+ doubleAllocWhile isERANGE grBufSize $ \s b ->
+ c_getgrnam_r pstr pgr b (fromIntegral s) ppgr
+ r <- peekElemOff ppgr 0
+ when (r == nullPtr) $
+ ioError $ flip ioeSetErrorString "no group name"
+ $ mkIOError doesNotExistErrorType
+ "getGroupEntryForName"
+ Nothing
+ (Just name)
+ unpackGroupEntry pgr
foreign import ccall unsafe "getgrnam_r"
c_getgrnam_r :: CString -> Ptr CGroup -> CString
hunk ./System/Posix/User.hsc 238
#if defined(HAVE_GETGRGID_R) || defined(HAVE_GETGRNAM_R)
grBufSize :: Int
#if defined(HAVE_SYSCONF) && defined(HAVE_SC_GETGR_R_SIZE_MAX)
-grBufSize = sysconfWithDefault 2048 (#const _SC_GETGR_R_SIZE_MAX)
+grBufSize = sysconfWithDefault 1024 (#const _SC_GETGR_R_SIZE_MAX)
#else
hunk ./System/Posix/User.hsc 240
-grBufSize = 2048 -- just assume some value (1024 is too small on OpenBSD)
+grBufSize = 1024
#endif
#endif
hunk ./System/Posix/User.hsc 287
#ifdef HAVE_GETPWUID_R
getUserEntryForID uid = do
allocaBytes (#const sizeof(struct passwd)) $ \ppw ->
- allocaBytes pwBufSize $ \pbuf ->
- alloca $ \ pppw -> do
- throwErrorIfNonZero_ "getUserEntryForID" $
- c_getpwuid_r uid ppw pbuf (fromIntegral pwBufSize) pppw
- throwErrnoIfNull "getUserEntryForID" $
- peekElemOff pppw 0
- unpackUserEntry ppw
+ alloca $ \ pppw -> do
+ throwErrorIfNonZero_ "getUserEntryForID" $
+ doubleAllocWhile isERANGE pwBufSize $ \s b ->
+ c_getpwuid_r uid ppw b (fromIntegral s) pppw
+ throwErrnoIfNull "getUserEntryForID" $
+ peekElemOff pppw 0
+ unpackUserEntry ppw
foreign import ccall unsafe "getpwuid_r"
c_getpwuid_r :: CUid -> Ptr CPasswd ->
hunk ./System/Posix/User.hsc 317
#if HAVE_GETPWNAM_R
getUserEntryForName name = do
allocaBytes (#const sizeof(struct passwd)) $ \ppw ->
- allocaBytes pwBufSize $ \pbuf ->
- alloca $ \ pppw ->
- withCString name $ \ pstr -> do
- throwErrorIfNonZero_ "getUserEntryForName" $
- c_getpwnam_r pstr ppw pbuf (fromIntegral pwBufSize) pppw
- r <- peekElemOff pppw 0
- when (r == nullPtr) $
- ioError $ flip ioeSetErrorString "no user name"
- $ mkIOError doesNotExistErrorType
- "getUserEntryForName"
- Nothing
- (Just name)
- unpackUserEntry ppw
+ alloca $ \ pppw ->
+ withCString name $ \ pstr -> do
+ throwErrorIfNonZero_ "getUserEntryForName" $
+ doubleAllocWhile isERANGE pwBufSize $ \s b ->
+ c_getpwnam_r pstr ppw b (fromIntegral s) pppw
+ r <- peekElemOff pppw 0
+ when (r == nullPtr) $
+ ioError $ flip ioeSetErrorString "no user name"
+ $ mkIOError doesNotExistErrorType
+ "getUserEntryForName"
+ Nothing
+ (Just name)
+ unpackUserEntry ppw
foreign import ccall unsafe "getpwnam_r"
c_getpwnam_r :: CString -> Ptr CPasswd
hunk ./System/Posix/User.hsc 395
return $ if v == (-1) then def else v
#endif
+isERANGE :: Integral a => a -> Bool
+isERANGE = (== eRANGE) . Errno . fromIntegral
+
+doubleAllocWhile :: (a -> Bool) -> Int -> (Int -> Ptr b -> IO a) -> IO a
+doubleAllocWhile p s m = do
+ r <- allocaBytes s (m s)
+ if p r then doubleAllocWhile p (2 * s) m else return r
+
unpackUserEntry :: Ptr CPasswd -> IO UserEntry
unpackUserEntry ptr = do
name <- (#peek struct passwd, pw_name) ptr >>= peekCString
}
Context:
[fix this test: we were overflowing the IO manager's pipe with too many signals
Simon Marlow <marlowsd at gmail.com>**20090310090916]
[Add config.guess config.sub install-sh as extra-source-files
Ian Lynagh <igloo at earth.li>**20090307161911]
[Tweak an internal detail
Ian Lynagh <igloo at earth.li>**20090304182836
We now use an EmptyDataDecl rather than recursive newtype as an
argument to Ptr. As well as being prettier, this also avoids an infinite
loop bug in haddock (trac #3066).
]
[Remove an incorrect comment
Ian Lynagh <igloo at earth.li>**20090304162531]
[Remove some debugging CPP
Ian Lynagh <igloo at earth.li>**20090226001636]
[Rewrite of signal-handling.
Simon Marlow <marlowsd at gmail.com>**20090219100532
Ignore-this: 1579194c10020dc34af715c225a9f207
The API is the same (for now). The new implementation has the
capability to define signal handlers that have access to the siginfo
of the signal (#592), but this functionality is not exposed in this
patch.
#2451 is the ticket for the new API.
The main purpose of bringing this in now is to fix race conditions in
the old signal handling code (#2858). Later we can enable the new
API in the HEAD.
Implementation differences:
- More of the signal-handling is moved into Haskell. We store the
table of signal handlers in an MVar, rather than having a table of
StablePtrs in the RTS.
- In the threaded RTS, the siginfo of the signal is passed down the
pipe to the IO manager thread, which manages the business of
starting up new signal handler threads. In the non-threaded RTS,
the siginfo of caught signals is stored in the RTS, and the
scheduler starts new signal handler threads.
]
[Don't put inline'd functions in HsUnix.h; fixes trac #2969
Ian Lynagh <igloo at earth.li>**20090211182906
If they are included into a C file which also has certain symbols
defined, then the behaviour of the HsUnix.h functions can change
(e.g. lstat can become the 32bit, rather than 64bit, version).
]
[fix warnings
Simon Marlow <marlowsd at gmail.com>**20090203100254
Ignore-this: 2dd022ed50c3fa62b2d7839d780e959c
]
[Add check for -lrt to get the shm* functions. Subst. in buildinfo
Don Stewart <dons at galois.com>**20090130113502
Ignore-this: d8e5f5bf086d9149e7b13b32bc6bd93a
]
[SharedMem.hsc wasn't including HsUnixConfig.h, so no #defines were propagating
Don Stewart <dons at galois.com>**20090130113451
Ignore-this: 31548629fdfa469d80009a51883858e8
]
[Require Cabal version >= 1.6
Ian Lynagh <igloo at earth.li>**20090122011331]
[Add "bug-reports" and "source-repository" info to the Cabal file
Ian Lynagh <igloo at earth.li>**20090121182842
Also switched to the modern Cabal file format
]
[generalise type of executeFile (#2948)
Simon Marlow <marlowsd at gmail.com>**20090114124726
Ignore-this: d8bb1f790d53ea4525d474a88cceaa91
]
[Avoid using IOError internals
Ian Lynagh <igloo at earth.li>**20090104173221]
[fix pthread linkage problem for openbsd
Matthias Kilian <kili at outback.escape.de>**20081129000638
This should make my openbsd build slave happy when SplitObjs=NO.
May be useful for other BSDs and even Linux, regardless wether you
need -pthread or -lpthread. Time will tell...
]
[catch up with exception changes
Simon Marlow <marlowsd at gmail.com>**20080927135428]
[Bump version number to 2.3.1.0
Ian Lynagh <igloo at earth.li>**20080920160248]
[TAG 6.10 branch has been forked
Ian Lynagh <igloo at earth.li>**20080919123439]
Patch bundle hash:
b46b3e4da1a8e8cfbf0bd1542b40b384a08c8793
More information about the Libraries
mailing list