[Git][ghc/ghc][master] RTS: cleanup timerfd file descriptors after a fork (#25280)

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
e9dc2690 by Sylvain Henry at 2024-10-02T22:20:06-04:00
RTS: cleanup timerfd file descriptors after a fork (#25280)

When we init a timerfd-based ticker, we should be careful to cleanup the
old file descriptors (e.g. after a fork).

- - - - -


3 changed files:

- rts/posix/ticker/TimerFd.c
- + testsuite/tests/rts/T25280.hs
- testsuite/tests/rts/all.T


Changes:

=====================================
rts/posix/ticker/TimerFd.c
=====================================
@@ -192,6 +192,14 @@ initTicker (Time interval, TickProc handle_tick)
     it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000;
     it.it_interval = it.it_value;
 
+    if (timerfd != -1) {
+        // don't leak the old file descriptors after a fork (#25280)
+        close(timerfd);
+        close(pipefds[0]);
+        close(pipefds[1]);
+        timerfd = -1;
+    }
+
     timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC);
     if (timerfd == -1) {
         barf("timerfd_create: %s", strerror(errno));


=====================================
testsuite/tests/rts/T25280.hs
=====================================
@@ -0,0 +1,24 @@
+module Main where
+
+import Control.Concurrent
+import qualified System.Posix.Process as SPP
+import System.Directory
+import Control.Monad
+import System.Exit
+
+main = do
+  fds <- listDirectory "/proc/self/fd"
+  go 0 5 fds
+
+go :: Int -> Int -> [FilePath] -> IO ()
+go i n fds
+  | i == n = return ()
+  | otherwise = do
+    fds' <- listDirectory "/proc/self/fd"
+    when (fds /= fds') $ do
+      putStrLn "File descriptors changed after fork:"
+      putStrLn $ "Before:" ++ show fds
+      putStrLn $ "After: " ++ show fds'
+      exitFailure
+    pid <- SPP.forkProcess $ go (i+1) n fds
+    void (SPP.getProcessStatus True True pid)


=====================================
testsuite/tests/rts/all.T
=====================================
@@ -618,3 +618,4 @@ test('IOManager', [js_skip, when(arch('wasm32'), skip), when(opsys('mingw32'), s
 test('T24142', [req_target_smp], compile_and_run, ['-threaded -with-rtsopts "-N2"'])
 
 test('T25232', [unless(have_profiling(), skip), only_ways(['normal','nonmoving','nonmoving_prof','nonmoving_thr_prof']), extra_ways(['nonmoving', 'nonmoving_prof'] + (['nonmoving_thr_prof'] if have_threaded() else []))], compile_and_run, [''])
+test('T25280', [unless(opsys('linux'),skip),req_process,js_skip], compile_and_run, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9dc26907e13eeb73514ff3f70323b40b40ef8ac

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9dc26907e13eeb73514ff3f70323b40b40ef8ac
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241002/59db72a5/attachment-0001.html>