ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-27 04:59:27 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

substitute: Optimize hash-part-to-path conversion on non-200 responses.

Browse source 
Previously this operation was linear in the number of requests and
involved costly calls to 'string-contains'.

* guix/scripts/substitute.scm (fetch-narinfos)[hash-part->path]: New
procedure.
[handle-narinfo-response]: Use it for caching when CODE is not 200.
This commit is contained in:
Ludovic Courtès 2017-07-21 14:07:29 +02:00 committed by Ludovic Courtès
parent 0cf9f9b1e3
commit 3d3e93b3f9
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 13 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
guix/scripts/substitute.scm
View file

@ -47,6 +47,7 @@ (define-module (guix scripts substitute)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (ice-9 binary-ports) #:use-module (ice-9 binary-ports)
#:use-module (ice-9 vlist)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
@ -609,6 +610,17 @@ (define update-progress!
url (* 100. (/ done (length paths)))) url (* 100. (/ done (length paths))))
(set! done (+ 1 done))))) (set! done (+ 1 done)))))
(define hash-part->path
(let ((mapping (fold (lambda (path result)
(vhash-cons (store-path-hash-part path) path
result))
vlist-null
paths)))
(lambda (hash)
(match (vhash-assoc hash mapping)
(#f #f)
((_ . path) path)))))
(define (handle-narinfo-response request response port result) (define (handle-narinfo-response request response port result)
(let* ((code (response-code response)) (let* ((code (response-code response))
(len (response-content-length response)) (len (response-content-length response))
@ -627,9 +639,7 @@ (define (handle-narinfo-response request response port result)
(if len (if len
(get-bytevector-n port len) (get-bytevector-n port len)
(read-to-eof port)) (read-to-eof port))
(cache-narinfo! url (cache-narinfo! url (hash-part->path hash-part) #f
(find (cut string-contains <> hash-part) paths)
#f
(if (= 404 code) (if (= 404 code)
ttl ttl
%narinfo-transient-error-ttl)) %narinfo-transient-error-ttl))