branch master updated: website: Add fetch methods to JSON sources and packages list.

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script.

civodul pushed a commit to branch master
in repository guix-artwork.

The following commit(s) were added to refs/heads/master by this push:
     new 991684d  website: Add fetch methods to JSON sources and packages list.
991684d is described below

commit 991684dfa5963c94fb8b2a01f916a384b203cd3c
Author: zimoun <zimon.toutoune@gmail.com>
AuthorDate: Wed Jun 3 17:00:10 2020 +0200

    website: Add fetch methods to JSON sources and packages list.
    
    * website/apps/packages/builder.scm (origin->json): Add 'url-fetch/tarbomb',
      'url-fetc/zipbomb', 'svn-multi-fetch' and 'hg-fetch' methods.
    
    Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 website/apps/packages/builder.scm | 26 +++++++++++++++++++++-----
 1 file changed, 21 insertions(+), 5 deletions(-)

diff --git a/website/apps/packages/builder.scm 
b/website/apps/packages/builder.scm
index 85494a6..d2bccd7 100644
--- a/website/apps/packages/builder.scm
+++ b/website/apps/packages/builder.scm
@@ -43,6 +43,7 @@
   #:use-module (guix download)
   #:use-module (guix git-download)
   #:use-module (guix svn-download)
+  #:use-module (guix hg-download)
   #:use-module (guix utils)                       ;location
   #:use-module ((guix build download) #:select (maybe-expand-mirrors))
   #:use-module (json)
@@ -102,11 +103,17 @@
          (append-map (cut maybe-expand-mirrors <> %mirrors)
                      (map string->uri urls))))
 
-  `((type . ,(cond ((eq? url-fetch method) 'url)
+  `((type . ,(cond ((or (eq? url-fetch method)
+                        (eq? url-fetch/tarbomb method)
+                        (eq? url-fetch/zipbomb method)) 'url)
                    ((eq? git-fetch method) 'git)
-                   ((eq? svn-fetch method) 'svn)
+                   ((or (eq? svn-fetch method)
+                        (eq? svn-multi-fetch method)) 'svn)
+                   ((eq? hg-fetch method) 'hg)
                    (else                   #nil)))
-    ,@(cond ((eq? url-fetch method)
+    ,@(cond ((or (eq? url-fetch method)
+                 (eq? url-fetch/tarbomb method)
+                 (eq? url-fetch/zipbomb method))
              `(("url" . ,(list->vector
                           (resolve
                            (match uri
@@ -116,13 +123,22 @@
              `(("git_url" . ,(git-reference-url uri))))
             ((eq? svn-fetch method)
              `(("svn_url" . ,(svn-reference-url uri))))
+            ((eq? svn-multi-fetch method)
+             `(("svn_url" . ,(svn-multi-reference-url uri))))
+            ((eq? hg-fetch method)
+             `(("hg_url" . ,(hg-reference-url uri))))
             (else '()))
     ,@(if (eq? method git-fetch)
           `(("git_ref" . ,(git-reference-commit uri)))
           '())
     ,@(if (eq? method svn-fetch)
-          `(("svn_revision" . ,(svn-reference-revision
-                                uri)))
+          `(("svn_revision" . ,(svn-reference-revision uri)))
+          '())
+    ,@(if (eq? method svn-multi-fetch)
+          `(("svn_revision" . ,(svn-multi-reference-revision uri)))
+          '())
+    ,@(if (eq? method hg-fetch)
+          `(("hg_changeset" . ,(hg-reference-changeset uri)))
           '())))
 
 (define (packages-json-builder)