[PATCH 1/2] import: json: Silence json-fetch output.

[PATCH 1/2] import: json: Silence json-fetch output.

[Eric Bavier]

* guix/import/json.scm (json-fetch): Use http-fetch instead of url-fetch
to avoid writing to stdout and a temporary file for each invocation.
* guix/import/gem.scm (rubygems-fetch): Do not redirect json-fetch
output to /dev/null.
* guix/import/pypi.scm (pypi-fetch): Likewise.
---
 guix/import/gem.scm  | 10 ++--------
 guix/import/json.scm | 14 +++++++-------
 guix/import/pypi.scm | 10 ++--------
 3 files changed, 11 insertions(+), 23 deletions(-)

diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index 3d0c190..3ad7fac 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -38,14 +38,8 @@
 (define (rubygems-fetch name)
   "Return an alist representation of the RubyGems metadata for the package NAME,
 or #f on failure."
-  ;; XXX: We want to silence the download progress report, which is especially
-  ;; annoying for 'guix refresh', but we have to use a file port.
-  (call-with-output-file "/dev/null"
-    (lambda (null)
-      (with-error-to-port null
-        (lambda ()
-          (json-fetch
-           (string-append "https://rubygems.org/api/v1/gems/" name ".json")))))))
+  (json-fetch
+   (string-append "https://rubygems.org/api/v1/gems/" name ".json")))

 (define (ruby-package-name name)
   "Given the NAME of a package on RubyGems, return a Guix-compliant name for
diff --git a/guix/import/json.scm b/guix/import/json.scm
index c3092a5..f0d75fd 100644
--- a/guix/import/json.scm
+++ b/guix/import/json.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
-;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2015, 2016 Eric Bavier <bavier@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,14 +19,14 @@

 (define-module (guix import json)
   #:use-module (json)
-  #:use-module (guix utils)
+  #:use-module (guix http-client)
   #:use-module (guix import utils)
   #:export (json-fetch))

 (define (json-fetch url)
   "Return an alist representation of the JSON resource URL, or #f on failure."
-  (call-with-temporary-output-file
-   (lambda (temp port)
-     (and (url-fetch url temp)
-          (hash-table->alist
-           (call-with-input-file temp json->scm))))))
+  (and=> (false-if-exception (http-fetch url))
+         (lambda (port)
+           (let ((result (hash-table->alist (json->scm port))))
+             (close-port port)
+             result))))
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index 68153d5..9794ff9 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -51,14 +51,8 @@
 (define (pypi-fetch name)
   "Return an alist representation of the PyPI metadata for the package NAME,
 or #f on failure."
-  ;; XXX: We want to silence the download progress report, which is especially
-  ;; annoying for 'guix refresh', but we have to use a file port.
-  (call-with-output-file "/dev/null"
-    (lambda (null)
-      (with-error-to-port null
-        (lambda ()
-          (json-fetch (string-append "https://pypi.python.org/pypi/"
-                                     name "/json")))))))
+  (json-fetch (string-append "https://pypi.python.org/pypi/"
+                             name "/json")))

 ;; For packages found on PyPI that lack a source distribution.
 (define-condition-type &missing-source-error &error
--
2.10.2

[PATCH 2/2] import: cpan: Add CPAN updater.

[Eric Bavier]

* guix/import/cpan.scm (module->dist-name): Fetch the field of interest.
(cpan-fetch): Accept release name rather than module name.
(fix-source-url): Rename to ...
(cpan-source-url): ... this.  Take metadata as parameter.
(cpan-module->sexp): Move local core-module? procedure to ...
(core-module?): ... here.
(package->upstream-name, cpan-version, cpan-package?, latest-release):
New procedures.
(%cpan-updater): New variable.
* guix/scripts/refresh.scm (%updaters): Add %cpan-updater.
---
 guix/import/cpan.scm     | 170 ++++++++++++++++++++++++++++++++++-------------
 guix/scripts/refresh.scm |   1 +
 2 files changed, 125 insertions(+), 46 deletions(-)

diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index d244969..b19d56d 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -24,18 +24,23 @@
   #:use-module ((ice-9 popen) #:select (open-pipe* close-pipe))
   #:use-module ((ice-9 rdelim) #:select (read-line))
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (json)
   #:use-module (guix hash)
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix base32)
-  #:use-module ((guix download) #:select (download-to-store))
-  #:use-module (guix import utils)
+  #:use-module (guix ui)
+  #:use-module ((guix download) #:select (download-to-store url-fetch))
+  #:use-module ((guix import utils) #:select (factorize-uri
+                                              flatten assoc-ref*))
   #:use-module (guix import json)
   #:use-module (guix packages)
+  #:use-module (guix upstream)
   #:use-module (guix derivations)
   #:use-module (gnu packages perl)
-  #:export (cpan->guix-package))
+  #:export (cpan->guix-package
+            %cpan-updater))
 
 ;;; Commentary:
 ;;;
@@ -84,28 +89,49 @@
 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/"
-                                        module))
+                                        module
+                                        "?fields=distribution"))
              "distribution"))
 
-(define (cpan-fetch module)
+(define (package->upstream-name package)
+  "Return the CPAN name of PACKAGE."
+  (let* ((properties (package-properties package))
+         (upstream-name (and=> properties
+                               (cut assoc-ref <> 'upstream-name))))
+    (or upstream-name
+        (match (package-source package)
+          ((? origin? origin)
+           (match (origin-uri origin)
+             ((or (? string? url) (url _ ...))
+              (match (string-match (string-append "([^/]*)-v?[0-9\\.]+") url)
+                (#f #f)
+                (m (match:substring m 1))))
+             (_ #f)))
+          (_ #f)))))
+
+(define (cpan-fetch name)
   "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/"
-                             ;; XXX: The 'release' api requires the "release"
-                             ;; name of the package.  This substitution seems
-                             ;; reasonably consistent across packages.
-                             (module->name module))))
+  (json-fetch (string-append "https://api.metacpan.org/release/" name)))
 
 (define (cpan-home name)
   (string-append "http://search.cpan.org/dist/" name))
 
-(define (fix-source-url download-url)
-  "Return a new download URL based on DOWNLOAD-URL which now uses our mirrors,
-if the original's domain was metacpan."
-  (regexp-substitute/global #f "http[s]?://cpan.metacpan.org" download-url
+(define (cpan-source-url meta)
+  "Return the download URL for a module's source tarball."
+  (regexp-substitute/global #f "http[s]?://cpan.metacpan.org"
+                            (assoc-ref meta "download_url")
                             'pre "mirror://cpan" 'post))
 
+(define (cpan-version meta)
+  "Return the version number from META."
+  (match (assoc-ref meta "version")
+    ((? number? version)
+     ;; version is sometimes not quoted in the module json, so it gets
+     ;; imported into Guile as a number, so convert it to a string.
+     (number->string version))
+    (version version)))
 
 (define %corelist
   (delay
@@ -116,6 +142,31 @@ if the original's domain was metacpan."
       (and (access? core X_OK)
            core))))
 
+(define core-module?
+  (let ((perl-version (package-version perl))
+        (rx (make-regexp
+             (string-append "released with perl v?([0-9\\.]*)"
+                            "(.*and removed from v?([0-9\\.]*))?"))))
+    (lambda (name)
+      (define (version-between? lower version upper)
+        (and (version>=? version lower)
+             (or (not upper)
+                 (version>? upper version))))
+      (and (force %corelist)
+           (parameterize ((current-error-port (%make-void-port "w")))
+             (let* ((corelist (open-pipe* OPEN_READ (force %corelist) name)))
+               (let loop ()
+                 (let ((line (read-line corelist)))
+                   (if (eof-object? line)
+                       (begin (close-pipe corelist) #f)
+                       (or (and=> (regexp-exec rx line)
+                                  (lambda (m)
+                                    (let ((first (match:substring m 1))
+                                          (last  (match:substring m 3)))
+                                      (version-between?
+                                       first perl-version last))))
+                           (loop)))))))))))
+
 (define (cpan-module->sexp meta)
   "Return the `package' s-expression for a CPAN module from the metadata in
 META."
@@ -127,35 +178,8 @@ META."
         (string-downcase name)
         (string-append "perl-" (string-downcase name))))
 
-  (define version
-    (match (assoc-ref meta "version")
-      ((? number? vrs) (number->string vrs))
-      ((? string? vrs) vrs)))
-
-  (define core-module?
-    (let ((perl-version (package-version perl))
-          (rx (make-regexp
-               (string-append "released with perl v?([0-9\\.]*)"
-                              "(.*and removed from v?([0-9\\.]*))?"))))
-      (lambda (name)
-        (define (version-between? lower version upper)
-          (and (version>=? version lower)
-               (or (not upper)
-                   (version>? upper version))))
-        (and (force %corelist)
-             (parameterize ((current-error-port (%make-void-port "w")))
-               (let* ((corelist (open-pipe* OPEN_READ (force %corelist) name)))
-                 (let loop ()
-                   (let ((line (read-line corelist)))
-                     (if (eof-object? line)
-                         (begin (close-pipe corelist) #f)
-                         (or (and=> (regexp-exec rx line)
-                                    (lambda (m)
-                                      (let ((first (match:substring m 1))
-                                            (last  (match:substring m 3)))
-                                        (version-between?
-                                         first perl-version last))))
-                             (loop)))))))))))
+  (define version (cpan-version meta))
+  (define source-url (cpan-source-url meta))
 
   (define (convert-inputs phases)
     ;; Convert phase dependencies into a list of name/variable pairs.
@@ -193,8 +217,6 @@ META."
        (list (list guix-name
                    (list 'quasiquote inputs))))))
 
-  (define source-url (fix-source-url (assoc-ref meta "download_url")))
-
   (let ((tarball (with-store store
                    (download-to-store store source-url))))
     `(package
@@ -224,5 +246,61 @@ META."
 (define (cpan->guix-package module-name)
   "Fetch the metadata for PACKAGE-NAME from metacpan.org, and return the
 `package' s-expression corresponding to that package, or #f on failure."
-  (let ((module-meta (cpan-fetch module-name)))
+  (let ((module-meta (cpan-fetch (module->name module-name))))
     (and=> module-meta cpan-module->sexp)))
+
+(define (cpan-package? package)
+  "Return #t if PACKAGE is a package from CPAN."
+  (define cpan-url?
+    (let ((cpan-rx (make-regexp (string-append "("
+                                               "mirror://cpan" "|"
+                                               "https?://www.cpan.org" "|"
+                                               "https?://cpan.metacpan.org"
+                                               ")"))))
+      (lambda (url)
+        (regexp-exec cpan-rx url))))
+
+  (let ((source-url (and=> (package-source package) origin-uri))
+        (fetch-method (and=> (package-source package) origin-method)))
+    (and (eq? fetch-method url-fetch)
+         (match source-url
+           ((? string?)
+            (cpan-url? source-url))
+           ((source-url ...)
+            (any cpan-url? source-url))))))
+
+(define (latest-release package)
+  "Return an <upstream-source> for the latest release of PACKAGE."
+  (match (cpan-fetch (package->upstream-name package))
+    (#f #f)
+    (meta
+     (let ((core-inputs
+            (match (package-direct-inputs package)
+              (((_ inputs _ ...) ...)
+               (filter-map (match-lambda
+                             ((and (? package?)
+                                   (? cpan-package?)
+                                   (= package->upstream-name
+                                      (? core-module? name)))
+                              name)
+                             (else #f))
+                           inputs)))))
+       ;; Warn about inputs that are part of perl's core
+       (unless (null? core-inputs)
+         (for-each (lambda (module)
+                     (warning (_ "input '~a' of ~a is in Perl core~%")
+                              module (package-name package)))
+                   core-inputs)))
+     (let ((version (cpan-version meta))
+           (url (cpan-source-url meta)))
+       (upstream-source
+        (package (package-name package))
+        (version version)
+        (urls url))))))
+
+(define %cpan-updater
+  (upstream-updater
+   (name 'cpan)
+   (description "Updater for CPAN packages")
+   (pred cpan-package?)
+   (latest latest-release)))
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index e1ff544..be284ab 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -206,6 +206,7 @@ unavailable optional dependencies such as Guile-JSON."
                  %cran-updater
                  %bioconductor-updater
                  %hackage-updater
+                 ((guix import cpan) => %cpan-updater)
                  ((guix import pypi) => %pypi-updater)
                  ((guix import gem) => %gem-updater)
                  ((guix import github) => %github-updater)))
-- 
2.10.2

Re: [PATCH 1/2] import: json: Silence json-fetch output.

[Ludovic Courtès]

Eric Bavier <bavier@member.fsf.org> skribis:

> * guix/import/json.scm (json-fetch): Use http-fetch instead of url-fetch
> to avoid writing to stdout and a temporary file for each invocation.
> * guix/import/gem.scm (rubygems-fetch): Do not redirect json-fetch
> output to /dev/null.
> * guix/import/pypi.scm (pypi-fetch): Likewise.

[...]

>  (define (json-fetch url)
>    "Return an alist representation of the JSON resource URL, or #f on failure."
> -  (call-with-temporary-output-file
> -   (lambda (temp port)
> -     (and (url-fetch url temp)
> -          (hash-table->alist
> -           (call-with-input-file temp json->scm))))))
> +  (and=> (false-if-exception (http-fetch url))
> +         (lambda (port)
> +           (let ((result (hash-table->alist (json->scm port))))
> +             (close-port port)
> +             result))))

It’d be better to not catch exceptions raised by ‘http-fetch’ here.
Instead they’d be caught at the top level and a detailed error message
would be displayed, which is always better than silently ignoring
issues.

However we’d need to check if there are uses where this is a problem.
For example, there might be updaters or importers that assume that #f
means that the package doesn’t exist or something like that.

WDYT?

> diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
> index 68153d5..9794ff9 100644
> --- a/guix/import/pypi.scm
> +++ b/guix/import/pypi.scm
> @@ -51,14 +51,8 @@
>  (define (pypi-fetch name)
>    "Return an alist representation of the PyPI metadata for the package NAME,
>  or #f on failure."
> -  ;; XXX: We want to silence the download progress report, which is especially
> -  ;; annoying for 'guix refresh', but we have to use a file port.
> -  (call-with-output-file "/dev/null"
> -    (lambda (null)
> -      (with-error-to-port null
> -        (lambda ()
> -          (json-fetch (string-append "https://pypi.python.org/pypi/"
> -                                     name "/json")))))))
> +  (json-fetch (string-append "https://pypi.python.org/pypi/"
> +                             name "/json")))

The rest LGTM, thanks!

Ludo’.

Re: [PATCH 2/2] import: cpan: Add CPAN updater.

[Ludovic Courtès]

Eric Bavier <bavier@member.fsf.org> skribis:

> * guix/import/cpan.scm (module->dist-name): Fetch the field of interest.
> (cpan-fetch): Accept release name rather than module name.
> (fix-source-url): Rename to ...
> (cpan-source-url): ... this.  Take metadata as parameter.
> (cpan-module->sexp): Move local core-module? procedure to ...
> (core-module?): ... here.
> (package->upstream-name, cpan-version, cpan-package?, latest-release):
> New procedures.
> (%cpan-updater): New variable.
> * guix/scripts/refresh.scm (%updaters): Add %cpan-updater.

[...]

> +(define core-module?
> +  (let ((perl-version (package-version perl))
> +        (rx (make-regexp
> +             (string-append "released with perl v?([0-9\\.]*)"
> +                            "(.*and removed from v?([0-9\\.]*))?"))))
> +    (lambda (name)

For clarity you could make this change (moving ‘core-module?’ to the top
level) in a separate patch maybe.

Otherwise that LGTM, though I haven’t actually tested it.

Thank you!

Ludo’.

Re: [PATCH 2/2] import: cpan: Add CPAN updater.

[Eric Bavier]

On Wed, 07 Dec 2016 12:02:35 +0100
ludo@gnu.org (Ludovic Courtès) wrote:

> Eric Bavier <bavier@member.fsf.org> skribis:
> 
> > * guix/import/cpan.scm (module->dist-name): Fetch the field of interest.
> > (cpan-fetch): Accept release name rather than module name.
> > (fix-source-url): Rename to ...
> > (cpan-source-url): ... this.  Take metadata as parameter.
> > (cpan-module->sexp): Move local core-module? procedure to ...
> > (core-module?): ... here.
> > (package->upstream-name, cpan-version, cpan-package?, latest-release):
> > New procedures.
> > (%cpan-updater): New variable.
> > * guix/scripts/refresh.scm (%updaters): Add %cpan-updater.  
> 
> [...]
> 
> > +(define core-module?
> > +  (let ((perl-version (package-version perl))
> > +        (rx (make-regexp
> > +             (string-append "released with perl v?([0-9\\.]*)"
> > +                            "(.*and removed from v?([0-9\\.]*))?"))))
> > +    (lambda (name)  
> 
> For clarity you could make this change (moving ‘core-module?’ to the top
> level) in a separate patch maybe.

Good idea.

> Otherwise that LGTM, though I haven’t actually tested it.

Great.  For me it detects over 100 package upgrades :)

`~Eric

Re: [PATCH 1/2] import: json: Silence json-fetch output.

[Eric Bavier]

On Wed, 07 Dec 2016 11:59:10 +0100
ludo@gnu.org (Ludovic Courtès) wrote:

> Eric Bavier <bavier@member.fsf.org> skribis:
> 
> > * guix/import/json.scm (json-fetch): Use http-fetch instead of url-fetch
> > to avoid writing to stdout and a temporary file for each invocation.
> > * guix/import/gem.scm (rubygems-fetch): Do not redirect json-fetch
> > output to /dev/null.
> > * guix/import/pypi.scm (pypi-fetch): Likewise.  
> 
> [...]
> 
> >  (define (json-fetch url)
> >    "Return an alist representation of the JSON resource URL, or #f on failure."
> > -  (call-with-temporary-output-file
> > -   (lambda (temp port)
> > -     (and (url-fetch url temp)
> > -          (hash-table->alist
> > -           (call-with-input-file temp json->scm))))))
> > +  (and=> (false-if-exception (http-fetch url))
> > +         (lambda (port)
> > +           (let ((result (hash-table->alist (json->scm port))))
> > +             (close-port port)
> > +             result))))  
> 
> It’d be better to not catch exceptions raised by ‘http-fetch’ here.
> Instead they’d be caught at the top level and a detailed error message
> would be displayed, which is always better than silently ignoring
> issues.
> 
> However we’d need to check if there are uses where this is a problem.
> For example, there might be updaters or importers that assume that #f
> means that the package doesn’t exist or something like that.
> 
> WDYT?

The importers that use json-fetch all do something like '(and=> meta
->package)', so a #f result from json-fetch is passed up to (@ (guix
scripts import) guix-import) and interpreted as a "import failed".

Using the false-if-exception* syntax which prints the exception message,
from guix/build/download.scm might be nicer.  This is the syntax
that url-fetch uses.  That syntax would need to be exported from
somewhere.  WDYT?

`~Eric

Re: [PATCH 1/2] import: json: Silence json-fetch output.

[Ludovic Courtès]

Eric Bavier <ericbavier@centurylink.net> skribis:

> On Wed, 07 Dec 2016 11:59:10 +0100
> ludo@gnu.org (Ludovic Courtès) wrote:
>
>> Eric Bavier <bavier@member.fsf.org> skribis:
>> 
>> > * guix/import/json.scm (json-fetch): Use http-fetch instead of url-fetch
>> > to avoid writing to stdout and a temporary file for each invocation.
>> > * guix/import/gem.scm (rubygems-fetch): Do not redirect json-fetch
>> > output to /dev/null.
>> > * guix/import/pypi.scm (pypi-fetch): Likewise.  
>> 
>> [...]
>> 
>> >  (define (json-fetch url)
>> >    "Return an alist representation of the JSON resource URL, or #f on failure."
>> > -  (call-with-temporary-output-file
>> > -   (lambda (temp port)
>> > -     (and (url-fetch url temp)
>> > -          (hash-table->alist
>> > -           (call-with-input-file temp json->scm))))))
>> > +  (and=> (false-if-exception (http-fetch url))
>> > +         (lambda (port)
>> > +           (let ((result (hash-table->alist (json->scm port))))
>> > +             (close-port port)
>> > +             result))))  
>> 
>> It’d be better to not catch exceptions raised by ‘http-fetch’ here.
>> Instead they’d be caught at the top level and a detailed error message
>> would be displayed, which is always better than silently ignoring
>> issues.
>> 
>> However we’d need to check if there are uses where this is a problem.
>> For example, there might be updaters or importers that assume that #f
>> means that the package doesn’t exist or something like that.
>> 
>> WDYT?
>
> The importers that use json-fetch all do something like '(and=> meta
> ->package)', so a #f result from json-fetch is passed up to (@ (guix

OK.

So if we instead “let the exception through”, ‘guix import’ would
something like “failed to download from http://…: 404 (Not Found)”,
which is worse than “package not found in repo” in this case.

A middle ground would be this:

  (guard (c ((http-get-error? c)
             (if (= 404 (http-get-error-code c))
                 #f ;this is “expected”, just means the package isn’t known
                 (raise c)))) ;using (srfi srfi-34) here
    (let* ((port (json->scm port)))
      …))

That way, 404 would still be treated as an expected error meaning
“package does not exist in upstream repo”, but more problematic errors
(DNS lookup errors, 403, etc.) would go through.

How does that sound?

Thanks,
Ludo’.

Re: [PATCH 1/2] import: json: Silence json-fetch output.

[David Craven]

I think this commit broke the pypi tests.

Re: [PATCH 1/2] import: json: Silence json-fetch output.

[Ludovic Courtès]

David Craven <david@craven.ch> skribis:

> I think this commit broke the pypi tests.

Indeed, because it’s a different procedure that needs to be mocked now.

Eric, could you have a look?

Thanks for the heads-up!

Ludo’.

Re: [PATCH 1/2] import: json: Silence json-fetch output.

[Eric Bavier]

On Thu, 15 Dec 2016 18:37:34 +0100
ludo@gnu.org (Ludovic Courtès) wrote:

> David Craven <david@craven.ch> skribis:
> 
> > I think this commit broke the pypi tests.  
> 
> Indeed, because it’s a different procedure that needs to be mocked now.
> 
> Eric, could you have a look?
> 
> Thanks for the heads-up!

Ricardo seems to have fixed this fallout before I had a chance to.
Thanks Ricardo!

Commits 662a1aa6b049d29977cfc376d4a185a3e8be4a07,
e69c1a544606d6870eef959c3cda17fe6bdce875, and
506abddb99e02f824bff7ed7d7f7b37c4dafe0a7.

`~Eric