Package: guix-patches;
Reported by: Sarah Morgensen <iskarian <at> mgsn.dev>
Date: Sun, 15 Aug 2021 23:17:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
Message #11 received at 50072 <at> debbugs.gnu.org (full text, mbox):
From: Sarah Morgensen <iskarian <at> mgsn.dev> To: 50072 <at> debbugs.gnu.org Subject: [PATCH WIP 2/4] import: Factorize file hashing. Date: Sun, 15 Aug 2021 16:25:25 -0700
* 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/cran.scm | 32 +++-----------------------------
guix/import/elpa.scm | 28 ++++------------------------
guix/import/go.scm | 26 +++-----------------------
3 files changed, 10 insertions(+), 76 deletions(-)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index f649928c5a..ac24bc117e 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;; Copyright © 2020 Martin Becze <mjbecze <at> riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian <at> mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -34,9 +35,8 @@
#:use-module (web uri)
#:use-module (guix memoization)
#:use-module (guix http-client)
- #:use-module (gcrypt hash)
+ #:use-module (guix 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)
@@ -194,17 +194,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
@@ -437,16 +426,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."
@@ -544,12 +523,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 c0dc5acf51..22c937ca5f 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2018 Oleg Pykhalov <go.wigust <at> gmail.com>
;;; Copyright © 2020 Martin Becze <mjbecze <at> riseup.net>
;;; Copyright © 2020 Ricardo Wurmus <rekado <at> elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian <at> mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -36,10 +37,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)
@@ -226,27 +227,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."
@@ -268,7 +248,7 @@ RECIPE."
(sha256
(base32
,(bytevector->nix-base32-string
- (file-hash directory (negate vcs-file?) #t)))))))
+ (file-hash* directory)))))))
(define* (melpa-recipe->origin recipe)
"Fetch origin details from the MELPA recipe and associated repository for
@@ -379,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 617a0d0e23..c6425667f8 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -25,6 +25,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)
@@ -35,9 +36,7 @@
#: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 (gcrypt hash) (hash-algorithm sha256)
#:autoload (guix base32) (bytevector->nix-base32-string)
#:autoload (guix build utils) (mkdir-p)
#:use-module (ice-9 match)
@@ -494,25 +493,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."
@@ -531,7 +511,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
--
2.31.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.