TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

progress: Add 'progress-report-port'. 

* guix/scripts/substitute.scm (progress-report-port): Move to...
* guix/progress.scm (progress-report-port): ... here.  New procedure.
This commit is contained in:
Ludovic Courtès 2019-12-06 00:40:41 +01:00
parent 1d9a4456a8
commit 22f06a2128
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 31 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
guix/progress.scm
View File

@ -40,6 +40,7 @@
progress-reporter/file
progress-reporter/bar
progress-reporter/trace
progress-report-port
display-download-progress
erase-current-line
@ -342,3 +343,33 @@ should be a <progress-reporter> object."
(put-bytevector out buffer 0 bytes)
(report total)
(loop total (get-bytevector-n! in buffer 0 buffer-size))))))))
(define (progress-report-port reporter port)
"Return a port that continuously reports the bytes read from PORT using
REPORTER, which should be a <progress-reporter> object."
(match reporter
(($ <progress-reporter> start report stop)
(let* ((total 0)
(read! (lambda (bv start count)
(let ((n (match (get-bytevector-n! port bv start count)
((? eof-object?) 0)
(x x))))
(set! total (+ total n))
(report total)
n))))
(start)
(make-custom-binary-input-port "progress-port-proc"
read! #f #f
(lambda ()
;; XXX: Kludge! When used through
;; 'decompressed-port', this port ends
;; up being closed twice: once in a
;; child process early on, and at the
;; end in the parent process. Ignore
;; the early close so we don't output
;; a spurious "download-succeeded"
;; trace.
(unless (zero? total)
(stop))
(close-port port)))))))

29
guix/scripts/substitute.scm
View File

@ -823,35 +823,6 @@ was found."
(= (string-length file) 32)))))
(narinfo-cache-directories directory)))
(define (progress-report-port reporter port)
"Return a port that continuously reports the bytes read from PORT using
REPORTER, which should be a <progress-reporter> object."
(match reporter
(($ <progress-reporter> start report stop)
(let* ((total 0)
(read! (lambda (bv start count)
(let ((n (match (get-bytevector-n! port bv start count)
((? eof-object?) 0)
(x x))))
(set! total (+ total n))
(report total)
n))))
(start)
(make-custom-binary-input-port "progress-port-proc"
read! #f #f
(lambda ()
;; XXX: Kludge! When used through
;; 'decompressed-port', this port ends
;; up being closed twice: once in a
;; child process early on, and at the
;; end in the parent process. Ignore
;; the early close so we don't output
;; a spurious "download-succeeded"
;; trace.
(unless (zero? total)
(stop))
(close-port port)))))))
(define-syntax with-networking
(syntax-rules ()
"Catch DNS lookup errors and TLS errors and gracefully exit."