summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/local.mk1
-rw-r--r--gnu/packages/guile-xyz.scm3
-rw-r--r--gnu/packages/patches/guile-fibers-fd-finalizer-leak.patch54
3 files changed, 57 insertions, 1 deletions
diff --git a/gnu/local.mk b/gnu/local.mk
index 9e5c6bfe9d..27b31ea27f 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1278,6 +1278,7 @@ dist_patch_DATA = \
%D%/packages/patches/guile-cross-compilation.patch \
%D%/packages/patches/guile-fibers-destroy-peer-schedulers.patch \
%D%/packages/patches/guile-fibers-epoll-instance-is-dead.patch \
+ %D%/packages/patches/guile-fibers-fd-finalizer-leak.patch \
%D%/packages/patches/guile-fibers-wait-for-io-readiness.patch \
%D%/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch \
%D%/packages/patches/guile-git-adjust-for-libgit2-1.2.0.patch \
diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm
index 71bbba7fbe..c9f1257380 100644
--- a/gnu/packages/guile-xyz.scm
+++ b/gnu/packages/guile-xyz.scm
@@ -661,7 +661,8 @@ Unix-style DSV format and RFC 4180 format.")
"0ll63d7202clapg1k4bilbnlmfa4qvpjnsd7chbkka4kxf5klilc"))
(patches
(search-patches "guile-fibers-wait-for-io-readiness.patch"
- "guile-fibers-epoll-instance-is-dead.patch"))))
+ "guile-fibers-epoll-instance-is-dead.patch"
+ "guile-fibers-fd-finalizer-leak.patch"))))
(build-system gnu-build-system)
(arguments
(list #:make-flags
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