aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-11-15 10:23:38 +0100
committerLudovic Courtès <ludo@gnu.org>2017-11-16 08:45:15 +0100
commit7482b98120b5e3380129719f13254b90b18553b9 (patch)
treec2f34e33f67eaecc831b57c852444d65b35c510c
parent866f37fb7e4f3e0bd695a951071383cdff3da8cd (diff)
downloadguix-7482b98120b5e3380129719f13254b90b18553b9.tar
guix-7482b98120b5e3380129719f13254b90b18553b9.tar.gz
cve: Use 'http-fetch/cached' instead of having custom caching.
That way CVE fetching benefits from 'If-Modified-Since' handling. * guix/http-client.scm (http-fetch/cached): Add #:write-cache and #:cache-miss parameters and honor them. * guix/cve.scm (%current-year-ttl, %past-year-ttl): Reduce. (call-with-cve-port): Remove. (write-cache): New procedure. (fetch-vulnerabilities): Rewrite in terms of 'http-fetch/cached'.
-rw-r--r--guix/cve.scm94
-rw-r--r--guix/http-client.scm13
2 files changed, 42 insertions, 65 deletions
diff --git a/guix/cve.scm b/guix/cve.scm
index 38e59944c8..070acfeb3e 100644
--- a/guix/cve.scm
+++ b/guix/cve.scm
@@ -19,7 +19,6 @@
(define-module (guix cve)
#:use-module (guix utils)
#:use-module (guix http-client)
- #:use-module ((guix build utils) #:select (mkdir-p))
#:use-module (sxml ssax)
#:use-module (web uri)
#:use-module (srfi srfi-1)
@@ -68,24 +67,11 @@
(define %current-year-ttl
;; According to <https://nvd.nist.gov/download.cfm#CVE_FEED>, feeds are
;; updated "approximately every two hours."
- (* 3600 3))
+ (* 60 30))
(define %past-year-ttl
;; Update the previous year's database more and more infrequently.
- (* 3600 24 2 (date-month %now)))
-
-(define (call-with-cve-port uri ttl proc)
- "Pass PROC an input port from which to read the CVE stream."
- (let ((port (http-fetch uri)))
- (dynamic-wind
- (const #t)
- (lambda ()
- (call-with-decompressed-port 'gzip port
- (lambda (port)
- (setvbuf port _IOFBF 65536)
- (proc port))))
- (lambda ()
- (close-port port)))))
+ (* 3600 24 (date-month %now)))
(define %cpe-package-rx
;; For applications: "cpe:/a:VENDOR:PACKAGE:VERSION", or sometimes
@@ -194,40 +180,27 @@ vulnerability objects."
(('v id (packages ...))
(vulnerability id packages))))
-(define (fetch-vulnerabilities year ttl)
- "Return the list of <vulnerability> for YEAR, assuming the on-disk cache has
-the given TTL (fetch from the NIST web site when TTL has expired)."
- ;; Note: We used to keep the original XML files in cache but parsing it
- ;; would take typically ~15s for a year of data. Thus, we instead store a
- ;; summarized version thereof as an sexp, which can be parsed in 1s or so.
- (define cache
- (string-append (cache-directory) "/cve/" (number->string year)))
-
- (define (do-fetch)
- (call-with-cve-port (yearly-feed-uri year) ttl
- (lambda (port)
- ;; XXX: The SSAX "error port" is used to send pointless warnings such as
- ;; "warning: Skipping PI". Turn that off.
- (format (current-error-port) "fetching CVE database for ~a...~%" year)
+(define (write-cache input cache)
+ "Read vulnerabilities as gzipped XML from INPUT, and write it as a compact
+sexp to CACHE."
+ (call-with-decompressed-port 'gzip input
+ (lambda (input)
+ ;; XXX: The SSAX "error port" is used to send pointless warnings such as
+ ;; "warning: Skipping PI". Turn that off.
+ (define vulns
(parameterize ((current-ssax-error-port (%make-void-port "w")))
- (xml->vulnerabilities port)))))
+ (xml->vulnerabilities input)))
- (define (update-cache)
- (mkdir-p (dirname cache))
- (let ((vulns (do-fetch)))
- (with-atomic-file-output cache
- (lambda (port)
- (write `(vulnerabilities
- 1 ;format version
- ,(map vulnerability->sexp vulns))
- port)))
- vulns))
+ (write `(vulnerabilities
+ 1 ;format version
+ ,(map vulnerability->sexp vulns))
+ cache))))
- (define (old? file)
- ;; Return true if PORT has passed TTL.
- (let* ((s (stat file))
- (now (current-time time-utc)))
- (< (+ (stat:mtime s) ttl) (time-second now))))
+(define (fetch-vulnerabilities year ttl)
+ "Return the list of <vulnerability> for YEAR, assuming the on-disk cache has
+the given TTL (fetch from the NIST web site when TTL has expired)."
+ (define (cache-miss uri)
+ (format (current-error-port) "fetching CVE database for ~a...~%" year))
(define (read* port)
;; Disable read options to avoid populating the source property weak
@@ -242,17 +215,18 @@ the given TTL (fetch from the NIST web site when TTL has expired)."
(lambda ()
(read-options options)))))
- (catch 'system-error
- (lambda ()
- (if (old? cache)
- (update-cache)
- (match (call-with-input-file cache read*)
- (('vulnerabilities 1 vulns)
- (map sexp->vulnerability vulns))
- (x
- (update-cache)))))
- (lambda args
- (update-cache))))
+ ;; Note: We used to keep the original XML files in cache but parsing it
+ ;; would take typically ~15s for a year of data. Thus, we instead store a
+ ;; summarized version thereof as an sexp, which can be parsed in 1s or so.
+ (let* ((port (http-fetch/cached (yearly-feed-uri year)
+ #:ttl ttl
+ #:write-cache write-cache
+ #:cache-miss cache-miss))
+ (sexp (read* port)))
+ (close-port port)
+ (match sexp
+ (('vulnerabilities 1 vulns)
+ (map sexp->vulnerability vulns)))))
(define (current-vulnerabilities)
"Return the current list of Common Vulnerabilities and Exposures (CVE) as
@@ -307,8 +281,4 @@ vulnerabilities affecting the given package version."
package table)))
-;;; Local Variables:
-;;; eval: (put 'call-with-cve-port 'scheme-indent-function 2)
-;;; End:
-
;;; cve.scm ends here
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 59788c1f38..bab31875d1 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -302,9 +302,15 @@ Raise an '&http-get-error' condition if downloading fails."
(base64-encode digest 0 (bytevector-length digest)
#f #f base64url-alphabet))))
-(define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?)
+(define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?
+ (write-cache dump-port)
+ (cache-miss (const #t)))
"Like 'http-fetch', return an input port, but cache its contents in
-~/.cache/guix. The cache remains valid for TTL seconds."
+~/.cache/guix. The cache remains valid for TTL seconds.
+
+Call WRITE-CACHE with the HTTP input port and the cache output port to write
+the data to cache. Call CACHE-MISS with URI just before fetching data from
+URI."
(let ((file (cache-file-for-uri uri)))
(define (update-cache cache-port)
(define cache-time
@@ -327,11 +333,12 @@ Raise an '&http-get-error' condition if downloading fails."
(raise c))))
(let ((port (http-fetch uri #:text? text?
#:headers headers)))
+ (cache-miss uri)
(mkdir-p (dirname file))
(when cache-port
(close-port cache-port))
(with-atomic-file-output file
- (cut dump-port port <>))
+ (cut write-cache port <>))
(close-port port)
(open-input-file file))))