import: go: Compute the hash of Git checkouts.

* guix/import/go.scm (vcs-file?, file-hash, git-checkout-hash): New
procedures.
(vcs->origin): Use 'git-checkout-hash' in the 'git case.
This commit is contained in:
Ludovic Courtès 2021-03-10 17:48:14 +01:00
parent 02e2e093e8
commit d028aef31c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 65 additions and 8 deletions

View File

@ -3,6 +3,7 @@
;;; Copyright © 2020 Helio Machado <0x2b3bfa0+guix@googlemail.com>
;;; Copyright © 2021 François Joulaud <francois.joulaud@radiofrance.com>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -32,6 +33,11 @@
#: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)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 receive)
@ -407,6 +413,45 @@ source."
goproxy-url
(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."
(define cache
(string-append (or (getenv "TMPDIR") "/tmp")
"/guix-import-go-"
(passwd:name (getpwuid (getuid)))))
;; Use a custom cache to avoid cluttering the default one under
;; ~/.cache/guix, but choose one under /tmp so that it's persistent across
;; subsequent "guix import" invocations.
(mkdir-p cache)
(chmod cache #o700)
(let-values (((checkout commit _)
(parameterize ((%repository-cache-directory cache))
(update-cached-checkout url
#:ref
`(tag-or-commit . ,reference)))))
(file-hash checkout algorithm)))
(define (vcs->origin vcs-type vcs-repo-url version)
"Generate the `origin' block of a package depending on what type of source
control system is being used."
@ -424,8 +469,9 @@ control system is being used."
(file-name (git-file-name name version))
(sha256
(base32
;; FIXME: populate hash for git repo checkout
"0000000000000000000000000000000000000000000000000000")))))
,(bytevector->nix-base32-string
(git-checkout-hash vcs-repo-url (go-version->git-ref version)
(hash-algorithm sha256))))))))
((hg)
`(origin
(method hg-fetch)

View File

@ -23,6 +23,8 @@
#:use-module (guix base32)
#:use-module (guix build-system go)
#:use-module (guix import go)
#:use-module (guix base32)
#:use-module ((guix utils) #:select (call-with-temporary-directory))
#:use-module (guix tests)
#:use-module (ice-9 match)
#:use-module (srfi srfi-19)
@ -258,7 +260,7 @@ require github.com/kr/pretty v0.2.1
(file-name (git-file-name name version))
(sha256
(base32
"0000000000000000000000000000000000000000000000000000"))))
"0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5"))))
(build-system go-build-system)
(arguments
(quote (#:import-path "github.com/go-check/check")))
@ -271,11 +273,20 @@ require github.com/kr/pretty v0.2.1
(license license:bsd-2))
;; Replace network resources with sample data.
(mock ((web client) http-get
(mock-http-get fixtures-go-check-test))
(mock ((guix http-client) http-fetch
(mock-http-fetch fixtures-go-check-test))
(go-module->guix-package "github.com/go-check/check"))))
(call-with-temporary-directory
(lambda (checkout)
(mock ((web client) http-get
(mock-http-get fixtures-go-check-test))
(mock ((guix http-client) http-fetch
(mock-http-fetch fixtures-go-check-test))
(mock ((guix git) update-cached-checkout
(lambda* (url #:key ref)
;; Return an empty directory and its hash.
(values checkout
(nix-base32-string->bytevector
"0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")
#f)))
(go-module->guix-package "github.com/go-check/check")))))))
(test-end "go")