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, 9 months ago)

proposed fix

  • System/Posix/User.hsc

    From 192c7d86dc99da1b10eb2721d8cbd1a5f7c9bb9b Mon Sep 17 00:00:00 2001
    From: Marios Titas <redneb@gmx.com>
    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)