From: "Ludovic Courtès" <ludo@gnu.org>
To: 49169@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#49169] [PATCH v2 07/16] utils: 'edit-expression' no longer leaks file ports.
Date: Wed, 30 Jun 2021 22:48:23 +0200 [thread overview]
Message-ID: <20210630204832.25753-8-ludo@gnu.org> (raw)
In-Reply-To: <20210630204832.25753-1-ludo@gnu.org>
* guix/utils.scm (edit-expression): Use 'call-with-input-file' to make
sure IN gets closed.
---
guix/utils.scm | 64 ++++++++++++++++++++++++++------------------------
1 file changed, 33 insertions(+), 31 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index 19990ceb8a..a13b13c4fa 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -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
one. ENCODING will be used to interpret all port I/O, it default to UTF-8.
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))
- (let* ((file (assq-ref source-properties 'filename))
- (line (assq-ref source-properties 'line))
- (column (assq-ref source-properties 'column))
- (in (open-input-file file))
- ;; The start byte position of the expression.
- (start (begin (while (not (and (= line (port-line in))
- (= column (port-column in))))
- (when (eof-object? (read-char in))
- (error (format #f "~a: end of file~%" in))))
- (ftell in)))
- ;; The end byte position of the expression.
- (end (begin (read in) (ftell in))))
- (seek in 0 SEEK_SET) ; read from the beginning of the file.
- (let* ((pre-bv (get-bytevector-n in start))
- ;; The expression in string form.
- (str (iconv:bytevector->string
- (get-bytevector-n in (- end start))
- (port-encoding in)))
- (post-bv (get-bytevector-all in))
- (str* (proc str)))
- ;; Verify the edited expression is still a scheme expression.
- (call-with-input-string str* read)
- ;; Update the file with edited expression.
- (with-atomic-file-output file
- (lambda (out)
- (put-bytevector out pre-bv)
- (display str* out)
- ;; post-bv maybe the end-of-file object.
- (when (not (eof-object? post-bv))
- (put-bytevector out post-bv))
- #t))))))
+ (call-with-input-file file
+ (lambda (in)
+ (let* ( ;; The start byte position of the expression.
+ (start (begin (while (not (and (= line (port-line in))
+ (= column (port-column in))))
+ (when (eof-object? (read-char in))
+ (error (format #f "~a: end of file~%" in))))
+ (ftell in)))
+ ;; The end byte position of the expression.
+ (end (begin (read in) (ftell in))))
+ (seek in 0 SEEK_SET) ; read from the beginning of the file.
+ (let* ((pre-bv (get-bytevector-n in start))
+ ;; The expression in string form.
+ (str (iconv:bytevector->string
+ (get-bytevector-n in (- end start))
+ (port-encoding in)))
+ (post-bv (get-bytevector-all in))
+ (str* (proc str)))
+ ;; Verify the edited expression is still a scheme expression.
+ (call-with-input-string str* read)
+ ;; Update the file with edited expression.
+ (with-atomic-file-output file
+ (lambda (out)
+ (put-bytevector out pre-bv)
+ (display str* out)
+ ;; post-bv maybe the end-of-file object.
+ (when (not (eof-object? post-bv))
+ (put-bytevector out post-bv))
+ #t))))))))
\f
;;;
--
2.32.0
next prev parent reply other threads:[~2021-06-30 20:50 UTC|newest]
Thread overview: 40+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-06-22 9:02 [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 02/11] packages: Allow inputs to be plain package lists Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 03/11] lint: Add 'input-labels' checker Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 04/11] packages: Add 'lookup-package-input' & co Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 05/11] packages: Add 'modify-inputs' Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 06/11] gnu: Change inputs of core packages to plain lists Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 07/11] utils: 'edit-expression' no longer leaks file ports Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 08/11] utils: Add 'go-to-location' with source location caching Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 09/11] utils: 'edit-expression' modifies the file only if necessary Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 10/11] utils: 'edit-expression' copies part of the original source map Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 11/11] Add 'guix style' Ludovic Courtès
2021-06-22 9:09 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
2021-06-27 18:37 ` Christopher Baines
2021-06-28 9:54 ` Ludovic Courtès
2021-06-27 11:00 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 01/16] records: Support field sanitizers Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 02/16] packages: Allow inputs to be plain package lists Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 03/16] lint: Add 'input-labels' checker Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 04/16] packages: Add 'lookup-package-input' & co Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 05/16] packages: Add 'modify-inputs' Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 06/16] gnu: Change inputs of core packages to plain lists Ludovic Courtès
2021-06-30 20:48 ` Ludovic Courtès [this message]
2021-06-30 20:48 ` [bug#49169] [PATCH v2 08/16] utils: Add 'go-to-location' with source location caching Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 09/16] utils: 'edit-expression' modifies the file only if necessary Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 10/16] utils: 'edit-expression' copies part of the original source map Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 11/16] Add 'guix style' Ludovic Courtès
2021-07-01 14:13 ` zimoun
2021-06-30 20:48 ` [bug#49169] [PATCH v2 12/16] packages: 'hidden-package' inherits the original package location Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 13/16] import: pypi: Emit new-style package inputs Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 14/16] import: cran: " Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 15/16] import: print: Emit new-style package inputs when possible Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 16/16] import: elpa: Emit new-style package inputs Ludovic Courtès
2021-07-10 4:53 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Sarah Morgensen via Guix-patches via
2021-07-10 13:45 ` Ludovic Courtès
2021-07-10 23:15 ` Ludovic Courtès
2021-07-12 6:15 ` Sarah Morgensen via Guix-patches via
2021-07-12 8:47 ` Ludovic Courtès
2021-07-10 23:11 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210630204832.25753-8-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=49169@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.