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.

1 files changed, 50 insertions, 42 deletions

diff --git a/System/Posix/User.hsc b/System/Posix/User.hsc
index 01079c2..f0478ba 100644
--- a/System/Posix/User.hsc
+++ b/System/Posix/User.hsc
@@ -167,13 +167,13 @@ getGroupEntryForID :: GroupID -> IO GroupEntry
 #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"
@@ -190,19 +190,19 @@ 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
-          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
@@ -235,9 +235,9 @@ getAllGroupEntries = error "System.Posix.User.getAllGroupEntries: not supported"
 #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
-grBufSize = 2048	-- just assume some value (1024 is too small on OpenBSD)
+grBufSize = 1024
 #endif
 #endif
 
@@ -284,13 +284,13 @@ getUserEntryForID :: UserID -> IO UserEntry
 #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 -> 
@@ -314,19 +314,19 @@ 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
-          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
@@ -392,6 +392,14 @@ sysconfWithDefault def sc =
                          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