From de9d8f0e295928d92e0e5ea43a4e594fa78c76fb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 4 Jun 2017 22:53:40 +0200 Subject: ssh: Improve error reporting when 'send-files' fails. Fixes . * guix/ssh.scm (store-import-channel)[import]: Add 'consume-input' procedure. Wrap body in 'catch' and 'guard'. Use 'open-remote-pipe' with OPEN_BOTH instead of 'open-remote-output-pipe'. (send-files): After the 'channel-send-eof' call, do (read port). Interpret the result sexp and raise an error condition if needed. --- guix/ssh.scm | 76 ++++++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 58 insertions(+), 18 deletions(-) (limited to 'guix') diff --git a/guix/ssh.scm b/guix/ssh.scm index 4fb145230d..32cf6e464b 100644 --- a/guix/ssh.scm +++ b/guix/ssh.scm @@ -150,23 +150,44 @@ can be written." ;; makes a round trip every time 32 KiB have been transferred. This ;; procedure instead opens a separate channel to use the remote ;; 'import-paths' procedure, which consumes all the data in a single round - ;; trip. + ;; trip. This optimizes the successful case at the expense of error + ;; conditions: errors can only be reported once all the input has been + ;; consumed. (define import `(begin - (use-modules (guix)) - - (with-store store - (setvbuf (current-input-port) _IONBF) - - ;; FIXME: Exceptions are silently swallowed. We should report them - ;; somehow. - (import-paths store (current-input-port))))) - - (open-remote-output-pipe session - (string-join - `("guile" "-c" - ,(object->string - (object->string import)))))) + (use-modules (guix) (srfi srfi-34) + (rnrs io ports) (rnrs bytevectors)) + + (define (consume-input port) + (let ((bv (make-bytevector 32768))) + (let loop () + (let ((n (get-bytevector-n! port bv 0 + (bytevector-length bv)))) + (unless (eof-object? n) + (loop)))))) + + ;; Upon completion, write an sexp that denotes the status. + (write + (catch #t + (lambda () + (guard (c ((nix-protocol-error? c) + ;; Consume all the input since the only time we can + ;; report the error is after everything has been + ;; consumed. + (consume-input (current-input-port)) + (list 'protocol-error (nix-protocol-error-message c)))) + (with-store store + (setvbuf (current-input-port) _IONBF) + (import-paths store (current-input-port)) + '(success)))) + (lambda args + (cons 'error args)))))) + + (open-remote-pipe session + (string-join + `("guile" "-c" + ,(object->string (object->string import)))) + OPEN_BOTH)) (define* (store-export-channel session files #:key recursive?) @@ -224,10 +245,29 @@ Return the list of store items actually sent." ;; mark of 'export-paths' would be enough, but in practice it's not.) (channel-send-eof port) - ;; Wait for completion of the remote process. - (let ((result (zero? (channel-get-exit-status port)))) + ;; Wait for completion of the remote process and read the status sexp from + ;; PORT. + (let* ((result (false-if-exception (read port))) + (status (zero? (channel-get-exit-status port)))) (close-port port) - missing))) + (match result + (('success . _) + missing) + (('protocol-error message) + (raise (condition + (&nix-protocol-error (message message) (status 42))))) + (('error key args ...) + (raise (condition + (&nix-protocol-error + (message (call-with-output-string + (lambda (port) + (print-exception port #f key args)))) + (status 43))))) + (_ + (raise (condition + (&nix-protocol-error + (message "unknown error while sending files over SSH") + (status 44))))))))) (define (remote-store-session remote) "Return the SSH channel beneath REMOTE, a remote store as returned by -- cgit v1.2.3 From 4679dd6967c21e21c740cd88e17191b8e2aac5ee Mon Sep 17 00:00:00 2001 From: James Richardson Date: Sat, 3 Jun 2017 14:37:54 -0400 Subject: import: cpan: Update CPAN importer to use MetaCPAN v1 API. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/import/cpan.scm (module->dist-name, cpan-fetch): Use metacpan.org URLs. * tests/cpan.scm ("cpan->guix-package"): Adjust accordingly. Signed-off-by: Ludovic Courtès --- guix/import/cpan.scm | 4 ++-- tests/cpan.scm | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index 32c5c310e1..a41f918049 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -88,7 +88,7 @@ "Return the base distribution module for a given module. E.g. the 'ok' module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would return \"Test-Simple\"" - (assoc-ref (json-fetch (string-append "https://api.metacpan.org/module/" + (assoc-ref (json-fetch (string-append "https://fastapi.metacpan.org/v1/module/" module "?fields=distribution")) "distribution")) @@ -113,7 +113,7 @@ return \"Test-Simple\"" "Return an alist representation of the CPAN metadata for the perl module MODULE, or #f on failure. MODULE should be e.g. \"Test::Script\"" ;; This API always returns the latest release of the module. - (json-fetch (string-append "https://api.metacpan.org/release/" name))) + (json-fetch (string-append "https://fastapi.metacpan.org/v1/release/" name))) (define (cpan-home name) (string-append "http://search.cpan.org/dist/" name)) diff --git a/tests/cpan.scm b/tests/cpan.scm index 8b588517c9..de865b22be 100644 --- a/tests/cpan.scm +++ b/tests/cpan.scm @@ -74,10 +74,10 @@ (mock ((guix http-client) http-fetch (lambda (url . rest) (match url - ("https://api.metacpan.org/release/Foo-Bar" + ("https://fastapi.metacpan.org/v1/release/Foo-Bar" (values (open-input-string test-json) (string-length test-json))) - ("https://api.metacpan.org/module/Test::Script?fields=distribution" + ("https://fastapi.metacpan.org/v1/module/Test::Script?fields=distribution" (let ((result "{ \"distribution\" : \"Test-Script\" }")) (values (open-input-string result) (string-length result)))) -- cgit v1.2.3