diff options
-rw-r--r-- | System/Posix/User.hsc | 21 | ||||
-rw-r--r-- | tests/all.T | 2 | ||||
-rw-r--r-- | tests/getGroupEntryForName.hs | 5 | ||||
-rw-r--r-- | tests/getGroupEntryForName.stderr | 2 |
4 files changed, 24 insertions, 6 deletions
diff --git a/System/Posix/User.hsc b/System/Posix/User.hsc index d7a786d..7ec49b6 100644 --- a/System/Posix/User.hsc +++ b/System/Posix/User.hsc @@ -55,6 +55,10 @@ import Control.Concurrent.MVar ( newMVar, withMVar ) #ifdef HAVE_GETPWENT import Control.Exception #endif +#ifdef HAVE_GETGRNAM_R +import Control.Monad +import System.IO.Error +#endif -- ----------------------------------------------------------------------------- -- user environemnt @@ -187,13 +191,18 @@ getGroupEntryForName :: String -> IO GroupEntry getGroupEntryForName name = do allocaBytes (#const sizeof(struct group)) $ \pgr -> allocaBytes grBufSize $ \pbuf -> - alloca $ \ ppgr -> - withCString name $ \ pstr -> do + alloca $ \ ppgr -> + withCString name $ \ pstr -> do throwErrorIfNonZero_ "getGroupEntryForName" $ - c_getgrnam_r pstr pgr pbuf (fromIntegral grBufSize) ppgr - throwErrnoIfNull "getGroupEntryForName" $ - peekElemOff ppgr 0 - unpackGroupEntry pgr + 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 foreign import ccall unsafe "getgrnam_r" c_getgrnam_r :: CString -> Ptr CGroup -> CString diff --git a/tests/all.T b/tests/all.T index 2ae037f..6df75fe 100644 --- a/tests/all.T +++ b/tests/all.T @@ -18,4 +18,6 @@ if config.platform == 'i386-unknown-freebsd': test('queryfdoption01', compose(omit_ways(['ghci']), compose(only_compiler_types(['ghc']), conf)), compile_and_run, ['-package unix']) test('getEnvironment01', conf, compile_and_run, ['-package unix']) +test('getGroupEntryForName', compose(conf, expect_fail), compile_and_run, + ['-package unix']) diff --git a/tests/getGroupEntryForName.hs b/tests/getGroupEntryForName.hs new file mode 100644 index 0000000..bdb4272 --- /dev/null +++ b/tests/getGroupEntryForName.hs @@ -0,0 +1,5 @@ + +import System.Posix.User + +main :: IO () +main = getGroupEntryForName "thisIsNotMeantToExist" >> return () diff --git a/tests/getGroupEntryForName.stderr b/tests/getGroupEntryForName.stderr new file mode 100644 index 0000000..baf3997 --- /dev/null +++ b/tests/getGroupEntryForName.stderr @@ -0,0 +1,2 @@ +getGroupEntryForName: thisIsNotMeantToExist: getGroupEntryForName: does not exist (no group name) + |