Ticket #8108: 0001-Extract-the-result-of-get-_r-before-we-deallocate-th.patch

File 0001-Extract-the-result-of-get-_r-before-we-deallocate-th.patch, 7.7 KB (added by redneb, 2 years ago)

proposed fix

  • System/Posix/User.hsc

    From 192c7d86dc99da1b10eb2721d8cbd1a5f7c9bb9b Mon Sep 17 00:00:00 2001
    From: Marios Titas <[email protected]>
    Date: Mon, 8 Jul 2013 03:55:59 -0400
    Subject: [PATCH] Extract the result of get*_r before we deallocate the
     auxiliary buffer
    
    ---
     System/Posix/User.hsc | 130 +++++++++++++++++++++++---------------------------
     1 file changed, 61 insertions(+), 69 deletions(-)
    
    diff --git a/System/Posix/User.hsc b/System/Posix/User.hsc
    index 71d2ea0..672193b 100644
    a b data GroupEntry = 
    197197  groupMembers :: [String]      -- ^ A list of zero or more usernames that are members (gr_mem)
    198198 } deriving (Show, Read, Eq)
    199199
    200 -- | @getGroupEntryForID gid@ calls @getgrgid@ to obtain
     200-- | @getGroupEntryForID gid@ calls @getgrgid_r@ to obtain
    201201--   the @GroupEntry@ information associated with @GroupID@
    202 --   @gid@.
     202--   @gid@. This operation may fail with 'isDoesNotExistError'
     203--   if no such group exists.
    203204getGroupEntryForID :: GroupID -> IO GroupEntry
    204205#ifdef HAVE_GETGRGID_R
    205 getGroupEntryForID gid = do
     206getGroupEntryForID gid =
    206207  allocaBytes (#const sizeof(struct group)) $ \pgr ->
    207     alloca $ \ ppgr -> do
    208       throwErrorIfNonZero_ "getGroupEntryForID" $
    209            doubleAllocWhile isERANGE grBufSize $ \s b ->
    210              c_getgrgid_r gid pgr b (fromIntegral s) ppgr
    211       _ <- throwErrnoIfNull "getGroupEntryForID" $
    212            peekElemOff ppgr 0
    213       unpackGroupEntry pgr
    214 
     208   doubleAllocWhileERANGE "getGroupEntryForID" "group" grBufSize unpackGroupEntry $
     209     c_getgrgid_r gid pgr
    215210
    216211foreign import ccall unsafe "getgrgid_r"
    217212  c_getgrgid_r :: CGid -> Ptr CGroup -> CString
    foreign import ccall unsafe "getgrgid_r" 
    220215getGroupEntryForID = error "System.Posix.User.getGroupEntryForID: not supported"
    221216#endif
    222217
    223 -- | @getGroupEntryForName name@ calls @getgrnam@ to obtain
     218-- | @getGroupEntryForName name@ calls @getgrnam_r@ to obtain
    224219--   the @GroupEntry@ information associated with the group called
    225 --   @name@.
     220--   @name@. This operation may fail with 'isDoesNotExistError'
     221--   if no such group exists.
    226222getGroupEntryForName :: String -> IO GroupEntry
    227223#ifdef HAVE_GETGRNAM_R
    228 getGroupEntryForName name = do
     224getGroupEntryForName name =
    229225  allocaBytes (#const sizeof(struct group)) $ \pgr ->
    230     alloca $ \ ppgr ->
    231       withCAString name $ \ pstr -> do
    232         throwErrorIfNonZero_ "getGroupEntryForName" $
    233           doubleAllocWhile isERANGE grBufSize $ \s b ->
    234             c_getgrnam_r pstr pgr b (fromIntegral s) ppgr
    235         r <- peekElemOff ppgr 0
    236         when (r == nullPtr) $
    237           ioError $ flip ioeSetErrorString "no group name"
    238                   $ mkIOError doesNotExistErrorType
    239                               "getGroupEntryForName"
    240                               Nothing
    241                               (Just name)
    242         unpackGroupEntry pgr
     226    withCAString name $ \ pstr ->
     227      doubleAllocWhileERANGE "getGroupEntryForName" "group" grBufSize unpackGroupEntry $
     228        c_getgrnam_r pstr pgr
    243229
    244230foreign import ccall unsafe "getgrnam_r"
    245231  c_getgrnam_r :: CString -> Ptr CGroup -> CString
    lock = unsafePerformIO $ newMVar () 
    324310{-# NOINLINE lock #-}
    325311#endif
    326312
    327 -- | @getUserEntryForID gid@ calls @getpwuid@ to obtain
     313-- | @getUserEntryForID gid@ calls @getpwuid_r@ to obtain
    328314--   the @UserEntry@ information associated with @UserID@
    329 --   @uid@.
     315--   @uid@. This operation may fail with 'isDoesNotExistError'
     316--   if no such user exists.
    330317getUserEntryForID :: UserID -> IO UserEntry
    331318#ifdef HAVE_GETPWUID_R
    332 getUserEntryForID uid = do
     319getUserEntryForID uid =
    333320  allocaBytes (#const sizeof(struct passwd)) $ \ppw ->
    334     alloca $ \ pppw -> do
    335       throwErrorIfNonZero_ "getUserEntryForID" $
    336            doubleAllocWhile isERANGE pwBufSize $ \s b ->
    337              c_getpwuid_r uid ppw b (fromIntegral s) pppw
    338       _ <- throwErrnoIfNull "getUserEntryForID" $
    339            peekElemOff pppw 0
    340       unpackUserEntry ppw
     321    doubleAllocWhileERANGE "getUserEntryForID" "user" pwBufSize unpackUserEntry $
     322      c_getpwuid_r uid ppw
    341323
    342324foreign import ccall unsafe "__hsunix_getpwuid_r"
    343325  c_getpwuid_r :: CUid -> Ptr CPasswd ->
    foreign import ccall unsafe "getpwuid" 
    354336getUserEntryForID = error "System.Posix.User.getUserEntryForID: not supported"
    355337#endif
    356338
    357 -- | @getUserEntryForName name@ calls @getpwnam@ to obtain
     339-- | @getUserEntryForName name@ calls @getpwnam_r@ to obtain
    358340--   the @UserEntry@ information associated with the user login
    359 --   @name@.
     341--   @name@. This operation may fail with 'isDoesNotExistError'
     342--   if no such user exists.
    360343getUserEntryForName :: String -> IO UserEntry
    361344#if HAVE_GETPWNAM_R
    362 getUserEntryForName name = do
     345getUserEntryForName name =
    363346  allocaBytes (#const sizeof(struct passwd)) $ \ppw ->
    364     alloca $ \ pppw ->
    365       withCAString name $ \ pstr -> do
    366         throwErrorIfNonZero_ "getUserEntryForName" $
    367           doubleAllocWhile isERANGE pwBufSize $ \s b ->
    368             c_getpwnam_r pstr ppw b (fromIntegral s) pppw
    369         r <- peekElemOff pppw 0
    370         when (r == nullPtr) $
    371           ioError $ flip ioeSetErrorString "no user name"
    372                   $ mkIOError doesNotExistErrorType
    373                               "getUserEntryForName"
    374                               Nothing
    375                               (Just name)
    376         unpackUserEntry ppw
     347    withCAString name $ \ pstr ->
     348      doubleAllocWhileERANGE "getUserEntryForName" "user" pwBufSize unpackUserEntry $
     349        c_getpwnam_r pstr ppw
    377350
    378351foreign import ccall unsafe "__hsunix_getpwnam_r"
    379352  c_getpwnam_r :: CString -> Ptr CPasswd
    sysconfWithDefault def sc = 
    439412                         return $ if v == (-1) then def else v
    440413#endif
    441414
    442 isERANGE :: Integral a => a -> Bool
    443 isERANGE = (== eRANGE) . Errno . fromIntegral
    444 
    445 doubleAllocWhile :: (a -> Bool) -> Int -> (Int -> Ptr b -> IO a) -> IO a
    446 doubleAllocWhile p s m = do
    447   r <- allocaBytes s (m s)
    448   if p r then doubleAllocWhile p (2 * s) m else return r
     415-- The following function is used by the getgr*_r, c_getpw*_r
     416-- families of functions. These functions return their result
     417-- in a struct that contains strings and they need a buffer
     418-- that they can use to store those strings. We have to be
     419-- careful to unpack the struct containing the result before
     420-- the buffer is deallocated.
     421doubleAllocWhileERANGE
     422  :: String
     423  -> String -- entry type: "user" or "group"
     424  -> Int
     425  -> (Ptr r -> IO a)
     426  -> (Ptr b -> CSize -> Ptr (Ptr r) -> IO CInt)
     427  -> IO a
     428doubleAllocWhileERANGE loc enttype initlen unpack action =
     429  alloca $ go initlen
     430 where
     431  go len res = do
     432    r <- allocaBytes len $ \buf -> do
     433           rc <- action buf (fromIntegral len) res
     434           if rc /= 0
     435             then return (Left rc)
     436             else do p <- peek res
     437                     when (p == nullPtr) $ notFoundErr
     438                     fmap Right (unpack p)
     439    case r of
     440      Right x -> return x
     441      Left rc | Errno rc == eRANGE ->
     442        -- ERANGE means this is not an error
     443        -- we just have to try again with a larger buffer
     444        go (2 * len) res
     445      Left rc ->
     446        ioError (errnoToIOError loc (Errno rc) Nothing Nothing)
     447  notFoundErr =
     448    ioError $ flip ioeSetErrorString ("no such " ++ enttype)
     449            $ mkIOError doesNotExistErrorType loc Nothing Nothing
    449450
    450451unpackUserEntry :: Ptr CPasswd -> IO UserEntry
    451452unpackUserEntry ptr = do
    unpackUserEntry ptr = do 
    458459   shell  <- (#peek struct passwd, pw_shell)  ptr >>= peekCAString
    459460   return (UserEntry name passwd uid gid gecos dir shell)
    460461
    461 -- Used when calling re-entrant system calls that signal their 'errno'
    462 -- directly through the return value.
    463 throwErrorIfNonZero_ :: String -> IO CInt -> IO ()
    464 throwErrorIfNonZero_ loc act = do
    465     rc <- act
    466     if (rc == 0)
    467      then return ()
    468      else ioError (errnoToIOError loc (Errno rc) Nothing Nothing)
    469 
    470462-- Used when a function returns NULL to indicate either an error or
    471463-- EOF, depending on whether the global errno is nonzero.
    472464throwErrnoIfNullAndError :: String -> IO (Ptr a) -> IO (Ptr a)