From debbugs-submit-bounces@debbugs.gnu.org Tue Oct 05 10:09:57 2021 Received: (at 50515) by debbugs.gnu.org; 5 Oct 2021 14:09:57 +0000 Received: from localhost ([127.0.0.1]:41541 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mXl8m-000467-P2 for submit@debbugs.gnu.org; Tue, 05 Oct 2021 10:09:57 -0400 Received: from mail-wm1-f46.google.com ([209.85.128.46]:35490) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mXl8k-00045c-7r for 50515@debbugs.gnu.org; Tue, 05 Oct 2021 10:09:55 -0400 Received: by mail-wm1-f46.google.com with SMTP id z184-20020a1c7ec1000000b003065f0bc631so3231328wmc.0 for <50515@debbugs.gnu.org>; Tue, 05 Oct 2021 07:09:54 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=J1ixy7v9ulTATuLK12zUG+8X8VozY0FWmbsamB2kBk4=; b=W/zL+QsyJKMRUFKEq/KAbAChoV/6UpNyK+Cq0N0LbMdsXmCS/MBkBqpiDiRrnARUAE ff4/fAr4Eijxmfs7s5uGQ+Nxvh8xeQxyAI62kY4Ej50st2swKee9Yz0Jz2QeVty/8/u4 Y8loMW17kLm9iOz4hJugp0FUIh1/V63xYN0y4xjJk6SNkve+FYBjdq6OLQ6sKtUTeSvt /h1Sp/8WqpAOlhqHhRpT0ZG/mD7nqHpJdXKiVG6+kLQLVUrEBCTgKfgNyzpHiPpv9khR DYuY72Q/5zzZynbhE94Sry3nFd5MYuoJoP0Ks9yTrE3SUxgJUlw91x/39PExFsffS0ju hT6w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=J1ixy7v9ulTATuLK12zUG+8X8VozY0FWmbsamB2kBk4=; b=GE6PGrx3ub366G11XvQo4NWBkZpNVfuoxTSbnCksVPN+gdEGhM3/LRh/ydAybbHQDY zly0sB9/KNzDajFVG+HHetdBtfjfE5L3Yu2chX06LDdykQbSfTZxuzNXVwkYLDSOu5RI oIZqTRGpFO03hPir1w1Z+/Nj7IBvk0u3bKjp5F/m7DAKBLXJ/ivi8ltJogBjifOPCFrZ 5GjqhCzdGh4vI31mfmqK35aASeUqDe768gIulPI8TzWMbObcQg+BNDRt4WPjflRuYUCU G6+ydXj2gMZ0wM0CHlbAMVbH/FLkdTFQGEi5GuhWsC0WD1E6DRwtCtdUGDR4NESXBors bnKQ== X-Gm-Message-State: AOAM532ikvGueun4H/GWo5MihFbNsqFI3gNEmxdggbNMaqtgLYQk9Ez7 fr8kU4SsEw17lwyB81QpHjDnBHSOnuR6FA== X-Google-Smtp-Source: ABdhPJwslJTC1xoTpIjBpmQeuZWYqIzPkzpJnLL90NlsavezgnOS+NQhmlVLXhFad4IUp3Kq/JzZ4A== X-Received: by 2002:a1c:4e11:: with SMTP id g17mr2669844wmh.17.1633442988403; Tue, 05 Oct 2021 07:09:48 -0700 (PDT) Received: from localhost.localdomain ([2a01:e0a:59b:9120:65d2:2476:f637:db1e]) by smtp.gmail.com with ESMTPSA id k9sm17478479wrz.22.2021.10.05.07.09.47 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 05 Oct 2021 07:09:48 -0700 (PDT) From: zimoun To: 50515@debbugs.gnu.org Subject: [PATCH v2 2/2] website: Add 'computed-origin-method' packages to 'sources.json'. Date: Tue, 5 Oct 2021 16:09:37 +0200 Message-Id: <20211005140937.19272-2-zimon.toutoune@gmail.com> X-Mailer: git-send-email 2.29.2 In-Reply-To: <20211005140937.19272-1-zimon.toutoune@gmail.com> References: <20211005140937.19272-1-zimon.toutoune@gmail.com> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: 2.0 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: With Guix 9875f9bca3976bf3576eab9be42164fde454597e, the packages considered are IceCat and the Linux kernel; see: gnu/packages/gnuzilla.scm and gnu/packages/linux.scm. * website/apps/packages/builder.scm (gexp-references): Unexported procedure from the module '(guix gexp)'. (origin->json): Add 'computed-origin-method' case. (package-json-builder): Adjust. (sources-j [...] Content analysis details: (2.0 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 SPF_PASS SPF: sender matches SPF record 0.0 FREEMAIL_FROM Sender email is commonly abused enduser mail provider (zimon.toutoune[at]gmail.com) 2.0 PDS_OTHER_BAD_TLD Untrustworthy TLDs [URI: nixo.xyz (xyz)] 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record -0.0 RCVD_IN_MSPIKE_H2 RBL: Average reputation (+2) [209.85.128.46 listed in wl.mailspike.net] -0.0 RCVD_IN_DNSWL_NONE RBL: Sender listed at https://www.dnswl.org/, no trust [209.85.128.46 listed in list.dnswl.org] X-Debbugs-Envelope-To: 50515 Cc: zimoun X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 1.0 (+) With Guix 9875f9bca3976bf3576eab9be42164fde454597e, the packages considered are IceCat and the Linux kernel; see: gnu/packages/gnuzilla.scm and gnu/packages/linux.scm. * website/apps/packages/builder.scm (gexp-references): Unexported procedure from the module '(guix gexp)'. (origin->json): Add 'computed-origin-method' case. (package-json-builder): Adjust. (sources-json-builder): Idem. [flatten]: New procedure. --- website/apps/packages/builder.scm | 141 +++++++++++++++++++----------- 1 file changed, 89 insertions(+), 52 deletions(-) diff --git a/website/apps/packages/builder.scm b/website/apps/packages/builder.scm index fb53215..9237d89 100644 --- a/website/apps/packages/builder.scm +++ b/website/apps/packages/builder.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2017 Ludovic Courtès ;;; Copyright © 2019 Ricardo Wurmus ;;; Copyright © 2019 Nicolò Balzarotti -;;; Copyright © 2020 Simon Tournier +;;; Copyright © 2020, 2021 Simon Tournier ;;; ;;; Initially written by sirgazil ;;; who waives all copyright interest on this file. @@ -49,11 +49,14 @@ #:use-module ((guix base64) #:select (base64-encode)) #:use-module ((guix describe) #:select (current-profile)) #:use-module ((guix config) #:select (%guix-version)) + #:use-module (guix gexp) #:use-module (json) #:use-module (ice-9 match) #:use-module ((web uri) #:select (string->uri uri->string)) #:export (builder)) +;;; Required by 'origin->json' for 'computed-origin-method' corner cases +(define gexp-references (@@ (guix gexp) gexp-references)) ;;; ;;; Application builder. @@ -98,7 +101,7 @@ (define method (origin-method origin)) - (define uri ;represented as string + (define uri (origin-uri origin)) (define (resolve urls) @@ -106,53 +109,70 @@ (append-map (cut maybe-expand-mirrors <> %mirrors) (map string->uri urls)))) - `((type . ,(cond ((or (eq? url-fetch method) - (eq? url-fetch/tarbomb method) - (eq? url-fetch/zipbomb method)) 'url) - ((eq? git-fetch method) 'git) - ((or (eq? svn-fetch method) - (eq? svn-multi-fetch method)) 'svn) - ((eq? hg-fetch method) 'hg) - (else #nil))) - ,@(cond ((or (eq? url-fetch method) - (eq? url-fetch/tarbomb method) - (eq? url-fetch/zipbomb method)) - `(("urls" . ,(list->vector - (resolve - (match uri - ((? string? url) (list url)) - ((urls ...) urls))))))) - ((eq? git-fetch method) - `(("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 (or (eq? url-fetch method) - (eq? url-fetch/tarbomb method) - (eq? url-fetch/zipbomb method)) - (let* ((content-hash (origin-hash origin)) - (hash-value (content-hash-value content-hash)) - (hash-algorithm (content-hash-algorithm content-hash)) - (algorithm-string (symbol->string hash-algorithm))) - `(("integrity" . ,(string-append algorithm-string "-" - (base64-encode hash-value))))) - '()) - ,@(if (eq? method git-fetch) - `(("git_ref" . ,(git-reference-commit uri))) - '()) - ,@(if (eq? method svn-fetch) - `(("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))) - '()))) + (if (eq? method (@@ (guix packages) computed-origin-method)) + ;; Packages in gnu/packages/gnuzilla.scm and gnu/packages/linux.scm + ;; represent their 'uri' as 'promise'. + (match uri + ((? promise? promise) + (match (force promise) + ((? gexp? g) + (map origin->json + (filter-map (match-lambda + ((? gexp-input? thing) + (match (gexp-input-thing thing) + ((? origin? o) o) + (_ #f))) + (_ #f)) + (gexp-references g)))) + (_ `((type . #nil)))))) + ;;Regular packages represent 'uri' as string. + `((type . ,(cond ((or (eq? url-fetch method) + (eq? url-fetch/tarbomb method) + (eq? url-fetch/zipbomb method)) 'url) + ((eq? git-fetch method) 'git) + ((or (eq? svn-fetch method) + (eq? svn-multi-fetch method)) 'svn) + ((eq? hg-fetch method) 'hg) + (else #nil))) + ,@(cond ((or (eq? url-fetch method) + (eq? url-fetch/tarbomb method) + (eq? url-fetch/zipbomb method)) + `(("urls" . ,(list->vector + (resolve + (match uri + ((? string? url) (list url)) + ((urls ...) urls))))))) + ((eq? git-fetch method) + `(("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 (or (eq? url-fetch method) + (eq? url-fetch/tarbomb method) + (eq? url-fetch/zipbomb method)) + (let* ((content-hash (origin-hash origin)) + (hash-value (content-hash-value content-hash)) + (hash-algorithm (content-hash-algorithm content-hash)) + (algorithm-string (symbol->string hash-algorithm))) + `(("integrity" . ,(string-append algorithm-string "-" + (base64-encode hash-value))))) + '()) + ,@(if (eq? method git-fetch) + `(("git_ref" . ,(git-reference-commit uri))) + '()) + ,@(if (eq? method svn-fetch) + `(("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) "Return a JSON page listing all packages." @@ -167,7 +187,12 @@ ,@(if cpe-name `(("cpe_name" . ,cpe-name)) '()) ,@(if cpe-version `(("cpe_version" . ,cpe-version)) '()) ,@(if (origin? (package-source package)) - `(("source" . ,(origin->json (package-source package)))) + `(("source" . ,(let ((json (origin->json (package-source package)))) + (match json + ((('type . x) other ...) + json) + ((head tail ...) ;multi-origin + head))))) ;XXXX: Improve this approximation '()) ("synopsis" . ,(package-synopsis package)) ,@(if (package-home-page package) @@ -195,11 +220,23 @@ (define (package->json package) `(,@(if (origin? (package-source package)) (origin->json (package-source package)) - `(("type" . "no-origin") + `((type . "no-origin") ("name" . ,(package-name package)))))) + (define (flatten lst) + ;; Convert nested lists to simple list + `(,@(if (null? lst) + '() + (match lst + ((head tail ...) + (match head + ((('type . x) other ...) + (cons head (flatten tail))) + (_ + (append (flatten head) (flatten tail))))))))) + (make-page "sources.json" - `(("sources" . ,(list->vector (map package->json (all-packages)))) + `(("sources" . ,(list->vector (flatten (map package->json (all-packages))))) ("version" . "1") ("revision" . ,(match (current-profile) -- 2.29.2