From 1fe958d62ac33ef5e6da26ccc9213f4dae2ee1ae Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 22 Apr 2017 01:09:45 +0200 Subject: download: Work around Guile 2.2 bug with 'time-monotonic' objects. * guix/build/download.scm (time-monotonic) [guile-2.2]: New variable. --- guix/build/download.scm | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'guix/build/download.scm') diff --git a/guix/build/download.scm b/guix/build/download.scm index e3d5244590..6563341b9f 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -140,6 +140,14 @@ Otherwise return STORE-PATH." (string-drop base 32))) store-path)) +(cond-expand + (guile-2.2 + ;; Guile 2.2.0 to 2.2.2 included has a bug whereby 'time-monotonic' objects + ;; have seconds and nanoseconds swapped (fixed in Guile commit 886ac3e). + ;; Work around it. + (define time-monotonic time-tai)) + (else #t)) + (define* (progress-proc file size #:optional (log-port (current-output-port)) #:key (abbreviation basename)) -- cgit v1.2.3 From 25a49294caf2386e65fc1b12a2508324be0b1cc2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 22 Apr 2017 14:40:51 +0200 Subject: cache: Work around 'time-monotonic' bug in Guile 2.2.2. * guix/cache.scm (time-monotonic) [guile-2.2]: New variable. * tests/cache.scm (time-monotonic) [guile-2.2]: Likewise. * guix/build/download.scm (time-monotonic) [guile-2.2]: Adjust comment: it's a 2.2.2 bug. --- guix/build/download.scm | 5 ++--- guix/cache.scm | 7 +++++++ tests/cache.scm | 7 +++++++ 3 files changed, 16 insertions(+), 3 deletions(-) (limited to 'guix/build/download.scm') diff --git a/guix/build/download.scm b/guix/build/download.scm index 6563341b9f..67a8952599 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -142,9 +142,8 @@ Otherwise return STORE-PATH." (cond-expand (guile-2.2 - ;; Guile 2.2.0 to 2.2.2 included has a bug whereby 'time-monotonic' objects - ;; have seconds and nanoseconds swapped (fixed in Guile commit 886ac3e). - ;; Work around it. + ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and + ;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it. (define time-monotonic time-tai)) (else #t)) diff --git a/guix/cache.scm b/guix/cache.scm index 077b0780bd..1dc0083f1d 100644 --- a/guix/cache.scm +++ b/guix/cache.scm @@ -33,6 +33,13 @@ ;;; ;;; Code: +(cond-expand + (guile-2.2 + ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and + ;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it. + (define time-monotonic time-tai)) + (else #t)) + (define (obsolete? date now ttl) "Return #t if DATE is obsolete compared to NOW + TTL seconds." (time>? (subtract-duration now (make-time time-duration 0 ttl)) diff --git a/tests/cache.scm b/tests/cache.scm index 0e1e08b693..e46cdd816d 100644 --- a/tests/cache.scm +++ b/tests/cache.scm @@ -24,6 +24,13 @@ #:use-module ((guix utils) #:select (call-with-temporary-directory)) #:use-module (ice-9 match)) +(cond-expand + (guile-2.2 + ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and + ;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it. + (define time-monotonic time-tai)) + (else #t)) + (test-begin "cache") (test-equal "remove-expired-cache-entries" -- cgit v1.2.3 From 7b9ac883ea62a816afbfa747c1377dc273c15c20 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 2 May 2017 21:43:18 +0200 Subject: download: Continue handshake upon TLS warning alerts. This allows us to download from site such as where the server does not recognize the server name passed via the 'server_name' extension. * guix/build/download.scm (tls-wrap): Catch 'gnutls-error' around 'handshake'. Upon ERROR/WARNING-ALERT-RECEIVED, print a message and call 'handshake'. --- guix/build/download.scm | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'guix/build/download.scm') diff --git a/guix/build/download.scm b/guix/build/download.scm index 67a8952599..ce4708a873 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -396,7 +396,21 @@ host name without trailing dot." ;;(set-log-level! 10) ;;(set-log-procedure! log) - (handshake session) + (catch 'gnutls-error + (lambda () + (handshake session)) + (lambda (key err proc . rest) + (cond ((eq? err error/warning-alert-received) + ;; Like Wget, do no stop upon non-fatal alerts such as + ;; 'alert-description/unrecognized-name'. + (format (current-error-port) + "warning: TLS warning alert received: ~a~%" + (alert-description->string (alert-get session))) + (handshake session)) + (else + ;; XXX: We'd use 'gnutls_error_is_fatal' but (gnutls) doesn't + ;; provide a binding for this. + (apply throw key err proc rest))))) ;; Verify the server's certificate if needed. (when verify-certificate? -- cgit v1.2.3