nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

substitute-binary: Store the cache's URI in the local cached narinfo. 

* guix/scripts/substitute-binary.scm (<narinfo>)[uri-base]: New field.
  (narinfo-maker): Pass CACHE-URL as the 'uri-base' value.
  (string->narinfo): Add 'cache-uri' parameter.
  (lookup-narinfo)[cache-entry]: Switch to version 1.  Add 'cache-uri'
  field.  Adjust body accordingly.
  (remove-expired-cached-narinfos): Switch to version 1 by default.
This commit is contained in:
Ludovic Courtès 2014-03-26 23:31:31 +01:00
parent e9c6c58418
commit 00230df107
1 changed files with 19 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
guix/scripts/substitute-binary.scm
View File

@ -214,11 +214,12 @@ failure."
'("StoreDir" "WantMassQuery"))))) '("StoreDir" "WantMassQuery")))))
(define-record-type <narinfo> (define-record-type <narinfo>
(%make-narinfo path uri compression file-hash file-size nar-hash nar-size (%make-narinfo path uri uri-base compression file-hash file-size nar-hash nar-size
references deriver system signature contents) references deriver system signature contents)
narinfo? narinfo?
(path narinfo-path) (path narinfo-path)
(uri narinfo-uri) (uri narinfo-uri)
(uri-base narinfo-uri-base) ; URI of the cache it originates from
(compression narinfo-compression) (compression narinfo-compression)
(file-hash narinfo-file-hash) (file-hash narinfo-file-hash)
(file-size narinfo-file-size) (file-size narinfo-file-size)
@ -261,6 +262,7 @@ must contain the original contents of a narinfo file."
;; Handle the case where URL is a relative URL. ;; Handle the case where URL is a relative URL.
(or (string->uri url) (or (string->uri url)
(string->uri (string-append cache-url "/" url))) (string->uri (string-append cache-url "/" url)))
cache-url
compression file-hash compression file-hash
(and=> file-size string->number) (and=> file-size string->number)
@ -350,9 +352,9 @@ build full URIs from relative URIs found while reading PORT."
"Return the external representation of NARINFO." "Return the external representation of NARINFO."
(call-with-output-string (cut write-narinfo narinfo <>))) (call-with-output-string (cut write-narinfo narinfo <>)))
(define (string->narinfo str) (define (string->narinfo str cache-uri)
"Return the narinfo represented by STR." "Return the narinfo represented by STR."
(call-with-input-string str (cut read-narinfo <>))) (call-with-input-string str (cut read-narinfo <> cache-uri)))
(define (fetch-narinfo cache path) (define (fetch-narinfo cache path)
"Return the <narinfo> record for PATH, or #f if CACHE does not hold PATH." "Return the <narinfo> record for PATH, or #f if CACHE does not hold PATH."
@ -390,7 +392,8 @@ check what it has."
(store-path-hash-part path))) (store-path-hash-part path)))
(define (cache-entry narinfo) (define (cache-entry narinfo)
`(narinfo (version 0) `(narinfo (version 1)
(cache-uri ,(narinfo-uri-base narinfo))
(date ,(time-second now)) (date ,(time-second now))
(value ,(and=> narinfo narinfo->string)))) (value ,(and=> narinfo narinfo->string))))
@ -400,18 +403,23 @@ check what it has."
(call-with-input-file cache-file (call-with-input-file cache-file
(lambda (p) (lambda (p)
(match (read p) (match (read p)
(('narinfo ('version 0) ('date date) (('narinfo ('version 1)
('value #f)) ('cache-uri cache-uri)
('date date) ('value #f))
;; A cached negative lookup. ;; A cached negative lookup.
(if (obsolete? date now %narinfo-negative-ttl) (if (obsolete? date now %narinfo-negative-ttl)
(values #f #f) (values #f #f)
(values #t #f))) (values #t #f)))
(('narinfo ('version 0) ('date date) (('narinfo ('version 1)
('value value)) ('cache-uri cache-uri)
('date date) ('value value))
;; A cached positive lookup ;; A cached positive lookup
(if (obsolete? date now %narinfo-ttl) (if (obsolete? date now %narinfo-ttl)
(values #f #f) (values #f #f)
(values #t (string->narinfo value)))))))) (values #t (string->narinfo value
cache-uri))))
(('narinfo ('version v) _ ...)
(values #f #f))))))
(lambda _ (lambda _
(values #f #f))))) (values #f #f)))))
(if valid? (if valid?
@ -440,10 +448,10 @@ indefinitely."
(call-with-input-file file (call-with-input-file file
(lambda (port) (lambda (port)
(match (read port) (match (read port)
(('narinfo ('version 0) ('date date) (('narinfo ('version 1) ('cache-uri _) ('date date)
('value #f)) ('value #f))
(obsolete? date now %narinfo-negative-ttl)) (obsolete? date now %narinfo-negative-ttl))
(('narinfo ('version 0) ('date date) (('narinfo ('version 1) ('cache-uri _) ('date date)
('value _)) ('value _))
(obsolete? date now %narinfo-ttl)) (obsolete? date now %narinfo-ttl))
(_ #t))))) (_ #t)))))