summary refs log tree commit diff
path: root/gnu/packages/patches
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-11-09 12:52:05 +0100
committerLudovic Courtès <ludo@gnu.org>2022-11-09 12:53:03 +0100
commitd9ca9cdd01bf1097343a047b51a1392131c7cf58 (patch)
treea312cde3999ab4a968f72fb3ff15e6af030aa478 /gnu/packages/patches
parente7c1f8979a8801493d4b4541881981e785937f2f (diff)
downloadguix-d9ca9cdd01bf1097343a047b51a1392131c7cf58.tar.gz
gnu: guile-fibers: Add patch fixing FD finalizer memory leak.
Fixes <https://issues.guix.gnu.org/58631>.

* gnu/packages/patches/guile-fibers-fd-finalizer-leak.patch: New file.
* gnu/packages/guile-xyz.scm (guile-fibers-1.1)[source]: Use it.
* gnu/local.mk (dist_patch_DATA): Add it.
Diffstat (limited to 'gnu/packages/patches')
-rw-r--r--gnu/packages/patches/guile-fibers-fd-finalizer-leak.patch54
1 files changed, 54 insertions, 0 deletions
diff --git a/gnu/packages/patches/guile-fibers-fd-finalizer-leak.patch b/gnu/packages/patches/guile-fibers-fd-finalizer-leak.patch
new file mode 100644
index 0000000000..2d8f9c2cf5
--- /dev/null
+++ b/gnu/packages/patches/guile-fibers-fd-finalizer-leak.patch
@@ -0,0 +1,54 @@
+Upstream fix for a memory leak introduced in Fibers 1.1.0 that would manifest
+in shepherd:
+
+  https://github.com/wingo/fibers/issues/65
+  https://issues.guix.gnu.org/58631
+
+diff --git a/fibers/scheduler.scm b/fibers/scheduler.scm
+index 2b03941..760b037 100644
+--- a/fibers/scheduler.scm
++++ b/fibers/scheduler.scm
+@@ -182,8 +182,10 @@ remote kernel thread."
+     (#f (warn "scheduler for unknown fd" fd))
+     ((and events+waiters (active-events . waiters))
+      ;; First, clear the active status, as the EPOLLONESHOT has
+-     ;; deactivated our entry in the epoll set.
+-     (set-car! events+waiters #f)
++     ;; deactivated our entry in the epoll set.  Set the car to 0, not #f, so
++     ;; that 'schedule-tasks-for-active-fd' doesn't end up re-adding a
++     ;; finalizer on FD.
++     (set-car! events+waiters 0)
+      (set-cdr! events+waiters '())
+      (unless (zero? (logand revents (logior EPOLLHUP EPOLLERR)))
+        (hashv-remove! (scheduler-fd-waiters sched) fd))
+@@ -336,21 +338,19 @@ expressed as an epoll bitfield."
+ 
+   (let ((fd-waiters (hashv-ref (scheduler-fd-waiters sched) fd)))
+     (match fd-waiters
+-      ((active-events . waiters)
+-       (set-cdr! fd-waiters (acons events task waiters))
+-       (unless (and active-events
+-                    (= (logand events active-events) events))
+-         (let ((active-events (logior events (or active-events 0))))
+-           (set-car! fd-waiters active-events)
+-           (add-fdes-finalizer! fd (fd-finalizer fd-waiters))
+-           (epoll-add*! (scheduler-epfd sched) fd
+-                        (logior active-events EPOLLONESHOT)))))
+-      (#f
++      ((or #f (#f))                               ;FD is new or was finalized
+        (let ((fd-waiters (list events (cons events task))))
+          (hashv-set! (scheduler-fd-waiters sched) fd fd-waiters)
+          (add-fdes-finalizer! fd (fd-finalizer fd-waiters))
+          (epoll-add*! (scheduler-epfd sched) fd
+-                      (logior events EPOLLONESHOT)))))))
++                      (logior events EPOLLONESHOT))))
++      ((active-events . waiters)
++       (set-cdr! fd-waiters (acons events task waiters))
++       (unless (= (logand events active-events) events)
++         (let ((active-events (logior events active-events)))
++           (set-car! fd-waiters active-events)
++           (epoll-add*! (scheduler-epfd sched) fd
++                        (logior active-events EPOLLONESHOT))))))))
+ 
+ (define (schedule-task-when-fd-readable sched fd task)
+   "Arrange to schedule @var{task} on @var{sched} when the file