mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-17 12:17:10 -05:00
import: Factorize file hashing.
* 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. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Sarah Morgensen
Ludovic Courtès
parent
064c367716
commit
b4c677c2ed
4 changed files with 19 additions and 86 deletions
|
|
@ -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 @@ (define-module (guix import cran)
|
|||
#: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 @@ (define* (latest-bioconductor-package-version name #:optional type)
|
|||
(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 @@ (define (needs-pkg-config? thing tarball?)
|
|||
(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 @@ (define (description->package repository meta)
|
|||
(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 #:recursive? (or git? hg?)))))))
|
||||
,@(if (not (and git? hg?
|
||||
(equal? (string-append "r-" name)
|
||||
(cran-guix-name name))))
|
||||
|
|
|
|||
|
|
@ -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 @@ (define-module (guix import elpa)
|
|||
#: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)
|
||||
|
|
@ -230,27 +231,6 @@ (define (data->recipe data)
|
|||
(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."
|
||||
|
|
@ -272,7 +252,7 @@ (define ref
|
|||
(sha256
|
||||
(base32
|
||||
,(bytevector->nix-base32-string
|
||||
(file-hash directory (negate vcs-file?) #t)))))))
|
||||
(file-hash* directory #:recursive? #true)))))))
|
||||
|
||||
(define* (melpa-recipe->origin recipe)
|
||||
"Fetch origin details from the MELPA recipe and associated repository for
|
||||
|
|
@ -381,7 +361,8 @@ (define melpa-source
|
|||
(sha256
|
||||
(base32
|
||||
,(if tarball
|
||||
(bytevector->nix-base32-string (file-sha256 tarball))
|
||||
(bytevector->nix-base32-string
|
||||
(file-hash* tarball #:recursive? #false))
|
||||
"failed to download package")))))))
|
||||
(build-system emacs-build-system)
|
||||
,@(maybe-inputs 'propagated-inputs dependencies)
|
||||
|
|
|
|||
|
|
@ -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 @@ (define-module (guix import go)
|
|||
#: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 @@ (define (module-meta-data-repo-url meta-data goproxy)
|
|||
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 @@ (define cache
|
|||
(update-cached-checkout url
|
||||
#:ref
|
||||
`(tag-or-commit . ,reference)))))
|
||||
(file-hash checkout algorithm)))
|
||||
(file-hash* checkout #:algorithm algorithm #:recursive? #true)))
|
||||
|
||||
(define (vcs->origin vcs-type vcs-repo-url version)
|
||||
"Generate the `origin' block of a package depending on what type of source
|
||||
|
|
|
|||
|
|
@ -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 @@ (define-module (guix import minetest)
|
|||
#: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 @@ (define* (download-git-repository url ref)
|
|||
(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,13 @@ (define (make-minetest-sexp author/name version repository commit
|
|||
;; 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)
|
||||
#:recursive? #true)))))
|
||||
(file-name (git-file-name name version))))
|
||||
(build-system minetest-mod-build-system)
|
||||
,@(maybe-propagated-inputs (map contentdb->package-name inputs))
|
||||
|
|
|
|||
Loading…
Reference in a new issue