From: Maxime Devos <maximedevos@telenet.be>
To: 50072@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>, "Sarah Morgensen" <iskarian@mgsn.dev>
Subject: [bug#50072] [PATCH v2 2/4] import: Factorize file hashing.
Date: Sat, 1 Jan 2022 20:39:38 +0000 [thread overview]
Message-ID: <20220101203940.149517-3-maximedevos@telenet.be> (raw)
In-Reply-To: <20220101203940.149517-1-maximedevos@telenet.be>
From: Sarah Morgensen <iskarian@mgsn.dev>
* guix/import/cran.scm (vcs-file?, file-hash): Remove procedures.
(description->package): Use 'file-hash*' instead.
* guix/import/elpa.scm (vcs-file?, file-hash): Remove procedures.
(git-repository->origin, elpa-package->sexp): Use 'file-hash* instead'.
* guix/import/go.scm (vcs-file?, file-hash): Remove procedures.
(git-checkout-hash): Use 'file-hash*' instead.
* guix/import/minetest.scm (file-hash): Remove procedure.
(make-minetest-sexp): Use 'file-hash*' instead.
---
guix/import/cran.scm | 32 +++-----------------------------
guix/import/elpa.scm | 29 ++++-------------------------
guix/import/go.scm | 25 +++----------------------
guix/import/minetest.scm | 18 +++++++-----------
4 files changed, 17 insertions(+), 87 deletions(-)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 1389576cad..69f4533da7 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -35,10 +36,9 @@
#:use-module (guix memoization)
#:use-module (guix http-client)
#:use-module (guix diagnostics)
+ #:use-module (guix hash)
#:use-module (guix i18n)
- #:use-module (gcrypt hash)
#:use-module (guix store)
- #:use-module ((guix serialization) #:select (write-file))
#:use-module (guix base32)
#:use-module ((guix download) #:select (download-to-store))
#:use-module (guix import utils)
@@ -196,17 +196,6 @@ bioconductor package NAME, or #F if the package is unknown."
(bioconductor-packages-list type))
(cut assoc-ref <> "Version")))
-;; XXX taken from (guix scripts hash)
-(define (vcs-file? file stat)
- (case (stat:type stat)
- ((directory)
- (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
- ((regular)
- ;; Git sub-modules have a '.git' file that is a regular text file.
- (string=? (basename file) ".git"))
- (else
- #f)))
-
;; Little helper to download URLs only once.
(define download
(memoize
@@ -464,16 +453,6 @@ reference the pkg-config tool."
(define (needs-knitr? meta)
(member "knitr" (listify meta "VignetteBuilder")))
-;; XXX adapted from (guix scripts hash)
-(define (file-hash file select? recursive?)
- ;; Compute the hash of FILE.
- (if recursive?
- (let-values (((port get-hash) (open-sha256-port)))
- (write-file file port #:select? select?)
- (force-output port)
- (get-hash))
- (call-with-input-file file port-sha256)))
-
(define (description->package repository meta)
"Return the `package' s-expression for an R package published on REPOSITORY
from the alist META, which was derived from the R package's DESCRIPTION file."
@@ -571,12 +550,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(sha256
(base32
,(bytevector->nix-base32-string
- (case repository
- ((git)
- (file-hash source (negate vcs-file?) #t))
- ((hg)
- (file-hash source (negate vcs-file?) #t))
- (else (file-sha256 source))))))))
+ (file-hash* source))))))
,@(if (not (and git? hg?
(equal? (string-append "r-" name)
(cran-guix-name name))))
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index edabb88b7a..c1f40ed915 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,10 +38,10 @@
#:use-module (guix import utils)
#:use-module (guix http-client)
#:use-module (guix git)
+ #:use-module (guix hash)
#:use-module ((guix serialization) #:select (write-file))
#:use-module (guix store)
#:use-module (guix ui)
- #:use-module (gcrypt hash)
#:use-module (guix base32)
#:use-module (guix upstream)
#:use-module (guix packages)
@@ -229,27 +230,6 @@ keywords to values."
(close-port port)
(data->recipe (cons ':name data))))
-;; XXX adapted from (guix scripts hash)
-(define (file-hash file select? recursive?)
- ;; Compute the hash of FILE.
- (if recursive?
- (let-values (((port get-hash) (open-sha256-port)))
- (write-file file port #:select? select?)
- (force-output port)
- (get-hash))
- (call-with-input-file file port-sha256)))
-
-;; XXX taken from (guix scripts hash)
-(define (vcs-file? file stat)
- (case (stat:type stat)
- ((directory)
- (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
- ((regular)
- ;; Git sub-modules have a '.git' file that is a regular text file.
- (string=? (basename file) ".git"))
- (else
- #f)))
-
(define (git-repository->origin recipe url)
"Fetch origin details from the Git repository at URL for the provided MELPA
RECIPE."
@@ -270,8 +250,7 @@ RECIPE."
(commit ,commit)))
(sha256
(base32
- ,(bytevector->nix-base32-string
- (file-hash directory (negate vcs-file?) #t)))))))
+ ,(bytevector->nix-base32-string (file-hash* directory)))))))
(define* (melpa-recipe->origin recipe)
"Fetch origin details from the MELPA recipe and associated repository for
@@ -380,7 +359,7 @@ type '<elpa-package>'."
(sha256
(base32
,(if tarball
- (bytevector->nix-base32-string (file-sha256 tarball))
+ (bytevector->nix-base32-string (file-hash* tarball))
"failed to download package")))))))
(build-system emacs-build-system)
,@(maybe-inputs 'propagated-inputs dependencies)
diff --git a/guix/import/go.scm b/guix/import/go.scm
index 26dbc34b63..ea999d290c 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -26,6 +26,7 @@
(define-module (guix import go)
#:use-module (guix build-system go)
#:use-module (guix git)
+ #:use-module (guix hash)
#:use-module (guix i18n)
#:use-module (guix diagnostics)
#:use-module (guix import utils)
@@ -36,11 +37,10 @@
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix memoization)
#:autoload (htmlprag) (html->sxml) ;from Guile-Lib
- #:autoload (guix git) (update-cached-checkout)
- #:autoload (gcrypt hash) (open-hash-port hash-algorithm sha256)
#:autoload (guix serialization) (write-file)
#:autoload (guix base32) (bytevector->nix-base32-string)
#:autoload (guix build utils) (mkdir-p)
+ #:autoload (gcrypt hash) (hash-algorithm sha256)
#:use-module (ice-9 match)
#:use-module (ice-9 peg)
#:use-module (ice-9 rdelim)
@@ -499,25 +499,6 @@ source."
goproxy
(module-meta-repo-root meta-data)))
-;; XXX: Copied from (guix scripts hash).
-(define (vcs-file? file stat)
- (case (stat:type stat)
- ((directory)
- (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
- ((regular)
- ;; Git sub-modules have a '.git' file that is a regular text file.
- (string=? (basename file) ".git"))
- (else
- #f)))
-
-;; XXX: Adapted from 'file-hash' in (guix scripts hash).
-(define* (file-hash file #:optional (algorithm (hash-algorithm sha256)))
- ;; Compute the hash of FILE.
- (let-values (((port get-hash) (open-hash-port algorithm)))
- (write-file file port #:select? (negate vcs-file?))
- (force-output port)
- (get-hash)))
-
(define* (git-checkout-hash url reference algorithm)
"Return the ALGORITHM hash of the checkout of URL at REFERENCE, a commit or
tag."
@@ -536,7 +517,7 @@ tag."
(update-cached-checkout url
#:ref
`(tag-or-commit . ,reference)))))
- (file-hash checkout algorithm)))
+ (file-hash* checkout #:algorithm algorithm)))
(define (vcs->origin vcs-type vcs-repo-url version)
"Generate the `origin' block of a package depending on what type of source
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index abddd885ee..44671d8480 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -39,6 +39,7 @@
#:use-module (guix base32)
#:use-module (guix git)
#:use-module ((guix git-download) #:prefix download:)
+ #:use-module (guix hash)
#:use-module (guix store)
#:export (%default-sort-key
%contentdb-api
@@ -286,14 +287,6 @@ results. The return value is a list of <package-keys> records."
(with-store store
(latest-repository-commit store url #:ref ref)))
-;; XXX adapted from (guix scripts hash)
-(define (file-hash file)
- "Compute the hash of FILE."
- (let-values (((port get-hash) (open-sha256-port)))
- (write-file file port)
- (force-output port)
- (get-hash)))
-
(define (make-minetest-sexp author/name version repository commit
inputs home-page synopsis
description media-license license)
@@ -314,9 +307,12 @@ MEDIA-LICENSE and LICENSE."
;; The git commit is not always available.
,(and commit
(bytevector->nix-base32-string
- (file-hash
+ (file-hash*
(download-git-repository repository
- `(commit . ,commit)))))))
+ `(commit . ,commit))
+ ;; 'download-git-repository' already filtered out the '.git'
+ ;; directory.
+ #:select? (const #true))))))
(file-name (git-file-name name version))))
(build-system minetest-mod-build-system)
,@(maybe-propagated-inputs (map contentdb->package-name inputs))
--
2.30.2
next prev parent reply other threads:[~2022-01-01 20:40 UTC|newest]
Thread overview: 66+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-08-15 23:16 [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins Sarah Morgensen
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 1/4] guix hash: Extract file hashing procedures Sarah Morgensen
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 2/4] import: Factorize file hashing Sarah Morgensen
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 3/4] refresh: Support non-tarball sources Sarah Morgensen
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins Sarah Morgensen
2021-08-16 10:46 ` Maxime Devos
2021-08-16 13:02 ` Xinglu Chen
2021-08-16 18:15 ` Maxime Devos
2021-08-18 14:45 ` Xinglu Chen
2021-08-16 19:56 ` [bug#50072] [PATCH WIP 0/4] Add upstream updater for " Sarah Morgensen
2021-08-17 10:18 ` Maxime Devos
2021-08-30 21:36 ` Maxime Devos
2021-09-06 10:23 ` Ludovic Courtès
2021-09-06 11:47 ` Maxime Devos
2021-09-07 1:16 ` [bug#50072] [PATCH WIP 4/4] upstream: Support updating " Sarah Morgensen
2021-09-07 10:00 ` Maxime Devos
2021-09-07 17:51 ` Sarah Morgensen
2021-09-07 20:58 ` Maxime Devos
2021-09-06 10:27 ` [bug#50072] [PATCH WIP 0/4] Add upstream updater for " Ludovic Courtès
2021-09-07 1:59 ` Sarah Morgensen
2021-09-29 21:28 ` Ludovic Courtès
2021-11-17 15:03 ` Ludovic Courtès
2022-01-01 17:35 ` Maxime Devos
2022-01-01 20:39 ` [bug#50072] [PATCH v2 " Maxime Devos
2022-01-01 20:39 ` [bug#50072] [PATCH v2 1/4] guix hash: Extract file hashing procedures Maxime Devos
2022-01-01 20:39 ` Maxime Devos [this message]
2022-01-01 20:39 ` [bug#50072] [PATCH v2 3/4] refresh: Support non-tarball sources Maxime Devos
2022-01-03 13:55 ` Ludovic Courtès
2022-01-01 20:39 ` [bug#50072] [PATCH v2 4/4] upstream: Support updating 'git-fetch' origins Maxime Devos
2022-01-03 14:02 ` Ludovic Courtès
2022-01-04 15:09 ` [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins Maxime Devos
2022-01-04 15:09 ` [bug#50072] [PATCH v3 1/4] guix hash: Extract file hashing procedures Maxime Devos
2022-01-04 15:09 ` [bug#50072] [PATCH v3 2/4] import: Factorize file hashing Maxime Devos
2022-01-04 15:09 ` [bug#50072] [PATCH v3 3/4] refresh: Support non-tarball sources Maxime Devos
2022-01-04 15:09 ` [bug#50072] [PATCH v3 4/4] upstream: Support updating and fetching 'git-fetch' origins Maxime Devos
2022-01-04 19:05 ` [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins Maxime Devos
2022-01-04 20:06 ` [bug#50072] [PATCH v4 " Maxime Devos
2022-01-04 20:06 ` [bug#50072] [PATCH v4 1/4] guix hash: Extract file hashing procedures Maxime Devos
2022-01-04 22:22 ` [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins zimoun
2022-01-05 10:07 ` Maxime Devos
2022-01-05 11:48 ` zimoun
2022-01-05 12:10 ` Maxime Devos
2022-01-06 10:06 ` Ludovic Courtès
2022-01-05 12:27 ` Maxime Devos
2022-01-05 12:58 ` zimoun
2022-01-05 14:06 ` Maxime Devos
2022-01-05 15:08 ` zimoun
2022-01-05 15:54 ` Maxime Devos
2022-01-06 10:13 ` Ludovic Courtès
2022-01-06 10:32 ` Maxime Devos
2022-01-06 11:19 ` zimoun
2022-01-05 10:09 ` Maxime Devos
2022-01-04 20:06 ` [bug#50072] [PATCH v4 2/4] import: Factorize file hashing Maxime Devos
2022-01-04 20:06 ` [bug#50072] [PATCH v4 3/4] refresh: Support non-tarball sources Maxime Devos
2022-01-04 20:06 ` [bug#50072] [PATCH v4 4/4] upstream: Support updating and fetching 'git-fetch' origins Maxime Devos
2022-01-05 14:07 ` [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures Maxime Devos
2022-01-05 14:07 ` [bug#50072] [PATCH v5 2/4] import: Factorize file hashing Maxime Devos
2022-01-05 14:07 ` [bug#50072] [PATCH v5 3/4] refresh: Support non-tarball sources Maxime Devos
2022-01-05 14:07 ` [bug#50072] [PATCH v5 4/4] upstream: Support updating and fetching 'git-fetch' origins Maxime Devos
2022-01-05 15:57 ` [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures zimoun
2022-01-05 15:56 ` Maxime Devos
2022-01-05 15:56 ` [bug#50072] [PATCH v5 2/4] import: Factorize file hashing Maxime Devos
2022-01-05 15:56 ` [bug#50072] [PATCH v5 3/4] refresh: Support non-tarball sources Maxime Devos
2022-01-05 15:56 ` [bug#50072] [PATCH v5 4/4] upstream: Support updating and fetching 'git-fetch' origins Maxime Devos
2022-01-06 10:20 ` bug#50072: [PATCH WIP 0/4] Add upstream updater for git-fetch origins Ludovic Courtès
2022-01-06 14:12 ` [bug#50072] " Maxime Devos
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20220101203940.149517-3-maximedevos@telenet.be \
--to=maximedevos@telenet.be \
--cc=50072@debbugs.gnu.org \
--cc=iskarian@mgsn.dev \
--cc=ludo@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).