Bug: `(open-source-file)` leaks file descriptor if path is a non-seekable device

[cosmos72]

TL;DR
calling (open-source-file sfd) with sfd containing a path to a non-seekable device, fails and returns #f.
Internally it opens a file descriptor that is never closed nor associated to a returned port - i.e. it is leaked.

How to reproduce:

$ scheme
Chez Scheme Version 10.3.0
Copyright 1984-2025 Cisco Systems, Inc.

> (define sfd (make-source-file-descriptor "/dev/tty" (open-bytevector-input-port #vu8())))

On Linux, executing ls -l /proc/CHEZ_SCHEME_PID/fd from another terminal shows:

total 0
lrwx------ 1 max users 64 Apr  6 14:23 0 -> /dev/pts/0
lrwx------ 1 max users 64 Apr  6 14:23 1 -> /dev/pts/0
lrwx------ 1 max users 64 Apr  6 14:23 2 -> /dev/pts/0

Now run the following in Chez Scheme:

> (open-source-file sfd)
#f

Note: (open-source-file sfd) fails and returns #f because /dev/tty is not seekable. One expects that any resource internally allocated by (open-source-file sfd) is released in case of failure.

Execute again ls -l /proc/CHEZ_SCHEME_PID/fd from another terminal. The output is:

total 0
lrwx------ 1 max users 64 Apr  6 14:23 0 -> /dev/pts/0
lrwx------ 1 max users 64 Apr  6 14:23 1 -> /dev/pts/0
lrwx------ 1 max users 64 Apr  6 14:23 2 -> /dev/pts/0
lr-x------ 1 max users 64 Apr  6 14:24 3 -> /dev/tty

i.e. file descriptor for /dev/tty is still open, but not associated to a port or some similar resource: it has been leaked.

[ThePuzzlemaker]

I don't believe the FD is truly leaked, as it was released after a (collect) after my testing. However, it is still likely desirable to release the FD on failure of open-source-file.

[burgerrg]

Thanks for finding this! The code in question is here:

ChezScheme/s/read.ss

Lines 1715 to 1729 in 7842937

	(define source-port
	(let ([paths-tried '()])
	(lambda (path)
	(and (not (member path paths-tried))
	(begin
	(set! paths-tried (cons path paths-tried))
	(guard (c [#t #f])
	(let ([ip ($open-file-input-port '$open-source-file path)])
	(if (let ([new-sfd ($source-file-descriptor path ip)])
	(and (fx= (source-file-descriptor-crc new-sfd)
	(source-file-descriptor-crc sfd))
	(= (source-file-descriptor-length new-sfd)
	(source-file-descriptor-length sfd))))
	(transcoded-port ip (current-transcoder))
	(begin (close-input-port ip) #f)))))))))

It needs another guard clause after binding ip on line 1722 that closes the port when there's an exception.

[burgerrg]

Fixed in #1036