futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

utils: 'edit-expression' no longer leaks file ports.

Browse Source 
* guix/utils.scm (edit-expression): Use 'call-with-input-file' to make
sure IN gets closed.
This commit is contained in:
Ludovic Courtès 2021-06-19 22:00:44 +02:00
parent 2f73ea3487
commit 4dcc606766
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 33 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
guix/utils.scm
View File

@ -342,38 +342,40 @@ a list of command-line arguments passed to the compression program."
be a procedure that takes the original expression in string and returns a new be a procedure that takes the original expression in string and returns a new
one. ENCODING will be used to interpret all port I/O, it default to UTF-8. one. ENCODING will be used to interpret all port I/O, it default to UTF-8.
This procedure returns #t on success." This procedure returns #t on success."
(define file (assq-ref source-properties 'filename))
(define line (assq-ref source-properties 'line))
(define column (assq-ref source-properties 'column))
(with-fluids ((%default-port-encoding encoding)) (with-fluids ((%default-port-encoding encoding))
(let* ((file (assq-ref source-properties 'filename)) (call-with-input-file file
(line (assq-ref source-properties 'line)) (lambda (in)
(column (assq-ref source-properties 'column)) (let* ( ;; The start byte position of the expression.
(in (open-input-file file)) (start (begin (while (not (and (= line (port-line in))
;; The start byte position of the expression. (= column (port-column in))))
(start (begin (while (not (and (= line (port-line in)) (when (eof-object? (read-char in))
(= column (port-column in)))) (error (format #f "~a: end of file~%" in))))
(when (eof-object? (read-char in)) (ftell in)))
(error (format #f "~a: end of file~%" in)))) ;; The end byte position of the expression.
(ftell in))) (end (begin (read in) (ftell in))))
;; The end byte position of the expression. (seek in 0 SEEK_SET) ; read from the beginning of the file.
(end (begin (read in) (ftell in)))) (let* ((pre-bv (get-bytevector-n in start))
(seek in 0 SEEK_SET) ; read from the beginning of the file. ;; The expression in string form.
(let* ((pre-bv (get-bytevector-n in start)) (str (iconv:bytevector->string
;; The expression in string form. (get-bytevector-n in (- end start))
(str (iconv:bytevector->string (port-encoding in)))
(get-bytevector-n in (- end start)) (post-bv (get-bytevector-all in))
(port-encoding in))) (str* (proc str)))
(post-bv (get-bytevector-all in)) ;; Verify the edited expression is still a scheme expression.
(str* (proc str))) (call-with-input-string str* read)
;; Verify the edited expression is still a scheme expression. ;; Update the file with edited expression.
(call-with-input-string str* read) (with-atomic-file-output file
;; Update the file with edited expression. (lambda (out)
(with-atomic-file-output file (put-bytevector out pre-bv)
(lambda (out) (display str* out)
(put-bytevector out pre-bv) ;; post-bv maybe the end-of-file object.
(display str* out) (when (not (eof-object? post-bv))
;; post-bv maybe the end-of-file object. (put-bytevector out post-bv))
(when (not (eof-object? post-bv)) #t))))))))
(put-bytevector out post-bv))
#t))))))
;;; ;;;