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.
This commit is contained in:
Ludovic Courtès 2022-11-09 12:52:05 +01:00
parent e7c1f8979a
commit d9ca9cdd01
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 57 additions and 1 deletions

View file

@ -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 \

View file

@ -661,7 +661,8 @@ (define-public guile-fibers-1.1
"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

View file

@ -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