import: go: Add an option to use pinned versions.

The ability to pin versions is handy when having to deal to packages that
bootstrap themselves through a chain of former versions.  Not using pinned
versions in these case could introduce dependency cycles.

* guix/build-system/go.scm (guix)
(%go-version-rx): Rename to...
(%go-pseudo-version-rx): ... this.  Simplify the regular expression, which in
turns makes it more robust.
* guix/build-system/go.scm (go-version->git-ref): Adjust following the above
rename.
(go-pseudo-version?): New predicate.
(go-module-latest-version): Rename to ...
(go-module-version-string): ... this.  Rename goproxy-url argument to just
goproxy.  Add a VERSION keyword argument, update docstring and adjust to have
it used.
(go-module-available-versions): New procedure.
(%go.mod-require-directive-rx): Document regexp.
(parse-go.mod): Harmonize the way dependencies are recorded to a list of lists
rather than a list of pairs, as done for other importers.  Rewrite to directly pass
multiple values rather than a record object.  Filter the replaced modules in a
functional style.
(go-module->guix-package): Add docstring.
[version, pin-versions?]: New arguments.  Rename the GOPROXY-URL argument to
GOPROXY.  Adjust to the new returned value of fetch-go.mod, which is a string.
Fail when the provided version doesn't exist.  Return a list dependencies and
their versions when in pinned versions mode, else just the dependencies.
(go-module-recursive-import)[version, pin-versions?]: New arguments.
Honor the new arguments and guard against network errors.
* guix/scripts/import/go.scm (%default-options): Register a default value for
the goproxy argument.
(show-help): Document that a version can be specified.  Remove the --version
argument and add a --pin-versions argument.
(%options)[version]: Remove option.
[pin-versions]: Add option.
(guix-import-go): Adjust so the version provided from the module name is
honored, along the new pin-versions? argument.
* tests/go.scm: Adjust and add new tests.
This commit is contained in:
Maxim Cournoyer 2021-03-19 16:41:51 -04:00
parent 6aee902eaf
commit a8b927a562
No known key found for this signature in database
GPG key ID: 1260E46482E63562
4 changed files with 232 additions and 161 deletions

View file

@ -31,6 +31,7 @@ (define-module (guix build-system go)
go-build
go-build-system
go-pseudo-version?
go-version->git-ref))
;; Commentary:
@ -40,17 +41,19 @@ (define-module (guix build-system go)
;;
;; Code:
(define %go-version-rx
(define %go-pseudo-version-rx
;; Match only the end of the version string; this is so that matching the
;; more complex leading semantic version pattern is not required.
(make-regexp (string-append
"(v?[0-9]\\.[0-9]\\.[0-9])" ;"v" prefix can be omitted in version prefix
"(-|-pre\\.0\\.|-0\\.)" ;separator
"([0-9]{14})-" ;timestamp
"([0-9A-Fa-f]{12})"))) ;commit hash
"([0-9]{14}-)" ;timestamp
"([0-9A-Fa-f]{12})" ;commit hash
"(\\+incompatible)?$"))) ;optional +incompatible tag
(define (go-version->git-ref version)
"Parse VERSION, a \"pseudo-version\" as defined at
<https://golang.org/ref/mod#pseudo-versions>, and extract the commit hash from
it, defaulting to full VERSION if a pseudo-version pattern is not recognized."
it, defaulting to full VERSION (stripped from the \"+incompatible\" suffix if
present) if a pseudo-version pattern is not recognized."
;; A module version like v1.2.3 is introduced by tagging a revision in the
;; underlying source repository. Untagged revisions can be referred to
;; using a "pseudo-version" like v0.0.0-yyyymmddhhmmss-abcdefabcdef, where
@ -65,11 +68,16 @@ (define (go-version->git-ref version)
(if (string-suffix? "+incompatible" version)
(string-drop-right version 13)
version))
(match (regexp-exec %go-version-rx version)))
(match (regexp-exec %go-pseudo-version-rx version)))
(if match
(match:substring match 4)
(match:substring match 2)
version)))
(define (go-pseudo-version? version)
"True if VERSION is a Go pseudo-version, i.e., a version string made of a
commit hash and its date rather than a proper release tag."
(regexp-exec %go-pseudo-version-rx version))
(define %go-build-system-modules
;; Build-side modules imported and used by default.
`((guix build go-build-system)

View file

@ -50,6 +50,7 @@ (define-module (guix import go)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (sxml match)
#:use-module ((sxml xpath) #:renamer (lambda (s)
(if (eq? 'filter s)
@ -92,9 +93,7 @@ (define-module (guix import go)
;;; assumption that there will be no collision.
;;; TODO list
;;; - get correct hash in vcs->origin
;;; - print partial result during recursive imports (need to catch
;;; exceptions)
;;; - get correct hash in vcs->origin for Mercurial and Subversion
;;; Code:
@ -121,12 +120,26 @@ (define (escape occurrence)
(define (go.pkg.dev-info name)
(http-fetch* (string-append "https://pkg.go.dev/" name)))
(define (go-module-latest-version goproxy-url module-path)
"Fetch the version number of the latest version for MODULE-PATH from the
given GOPROXY-URL server."
(assoc-ref (json-fetch* (format #f "~a/~a/@latest" goproxy-url
(go-path-escape module-path)))
"Version"))
(define* (go-module-version-string goproxy name #:key version)
"Fetch the version string of the latest version for NAME from the given
GOPROXY server, or for VERSION when specified."
(let ((file (if version
(string-append "@v/" version ".info")
"@latest")))
(assoc-ref (json-fetch* (format #f "~a/~a/~a"
goproxy (go-path-escape name) file))
"Version")))
(define* (go-module-available-versions goproxy name)
"Retrieve the available versions for a given module from the module proxy.
Versions are being returned **unordered** and may contain different versioning
styles for the same package."
(let* ((url (string-append goproxy "/" (go-path-escape name) "/@v/list"))
(body (http-fetch* url))
(versions (remove string-null? (string-split body #\newline))))
(if (null? versions)
(list (go-module-version-string goproxy name)) ;latest version
versions)))
(define (go-package-licenses name)
"Retrieve the list of licenses that apply to NAME, a Go package or module
@ -238,119 +251,119 @@ (define %go.mod-require-directive-rx
;; the end.
(make-regexp
(string-append
"^[[:blank:]]*"
"([^[:blank:]]+)[[:blank:]]+([^[:blank:]]+)"
"([[:blank:]]+//.*)?")))
"^[[:blank:]]*([^[:blank:]]+)[[:blank:]]+" ;the module path
"([^[:blank:]]+)" ;the version
"([[:blank:]]+//.*)?"))) ;an optional comment
(define %go.mod-replace-directive-rx
;; ReplaceSpec = ModulePath [ Version ] "=>" FilePath newline
;; | ModulePath [ Version ] "=>" ModulePath Version newline .
(make-regexp
(string-append
"([^[:blank:]]+)([[:blank:]]+([^[:blank:]]+))?"
"[[:blank:]]+" "=>" "[[:blank:]]+"
"([^[:blank:]]+)([[:blank:]]+([^[:blank:]]+))?")))
"([^[:blank:]]+)" ;the module path
"([[:blank:]]+([^[:blank:]]+))?" ;optional version
"[[:blank:]]+=>[[:blank:]]+"
"([^[:blank:]]+)" ;the file or module path
"([[:blank:]]+([^[:blank:]]+))?"))) ;the version (if a module path)
(define (parse-go.mod content)
"Parse the go.mod file CONTENT, returning a list of requirements."
(define-record-type <results>
(make-results requirements replacements)
results?
(requirements results-requirements)
(replacements results-replacements))
;; We parse only a subset of https://golang.org/ref/mod#go-mod-file-grammar
;; which we think necessary for our use case.
(define (toplevel results)
"Main parser, RESULTS is a pair of alist serving as accumulator for
all encountered requirements and replacements."
(define (toplevel requirements replaced)
"This is the main parser. The results are accumulated in THE REQUIREMENTS
and REPLACED lists."
(let ((line (read-line)))
(cond
((eof-object? line)
;; parsing ended, give back the result
results)
(values requirements replaced))
((string=? line "require (")
;; a require block begins, delegate parsing to IN-REQUIRE
(in-require results))
(in-require requirements replaced))
((string=? line "replace (")
;; a replace block begins, delegate parsing to IN-REPLACE
(in-replace results))
(in-replace requirements replaced))
((string-prefix? "require " line)
;; a standalone require directive
(let* ((stripped-line (string-drop line 8))
(new-results (require-directive results stripped-line)))
(toplevel new-results)))
;; a require directive by itself
(let* ((stripped-line (string-drop line 8)))
(call-with-values
(lambda ()
(require-directive requirements replaced stripped-line))
toplevel)))
((string-prefix? "replace " line)
;; a standalone replace directive
(let* ((stripped-line (string-drop line 8))
(new-results (replace-directive results stripped-line)))
(toplevel new-results)))
;; a replace directive by itself
(let* ((stripped-line (string-drop line 8)))
(call-with-values
(lambda ()
(replace-directive requirements replaced stripped-line))
toplevel)))
(#t
;; unrecognised line, ignore silently
(toplevel results)))))
(toplevel requirements replaced)))))
(define (in-require results)
(define (in-require requirements replaced)
(let ((line (read-line)))
(cond
((eof-object? line)
;; this should never happen here but we ignore silently
results)
(values requirements replaced))
((string=? line ")")
;; end of block, coming back to toplevel
(toplevel results))
(toplevel requirements replaced))
(#t
(in-require (require-directive results line))))))
(call-with-values (lambda ()
(require-directive requirements replaced line))
in-require)))))
(define (in-replace results)
(define (in-replace requirements replaced)
(let ((line (read-line)))
(cond
((eof-object? line)
;; this should never happen here but we ignore silently
results)
(values requirements replaced))
((string=? line ")")
;; end of block, coming back to toplevel
(toplevel results))
(toplevel requirements replaced))
(#t
(in-replace (replace-directive results line))))))
(call-with-values (lambda ()
(replace-directive requirements replaced line))
in-replace)))))
(define (replace-directive results line)
"Extract replaced modules and new requirements from replace directive
in LINE and add to RESULTS."
(match results
(($ <results> requirements replaced)
(let* ((rx-match (regexp-exec %go.mod-replace-directive-rx line))
(module-path (match:substring rx-match 1))
(version (match:substring rx-match 3))
(new-module-path (match:substring rx-match 4))
(new-version (match:substring rx-match 6))
(new-replaced (alist-cons module-path version replaced))
(new-requirements
(if (string-match "^\\.?\\./" new-module-path)
requirements
(alist-cons new-module-path new-version requirements))))
(make-results new-requirements new-replaced)))))
(define (require-directive results line)
"Extract requirement from LINE and add it to RESULTS."
(define (replace-directive requirements replaced line)
"Extract replaced modules and new requirements from the replace directive
in LINE and add them to the REQUIREMENTS and REPLACED lists."
(let* ((rx-match (regexp-exec %go.mod-replace-directive-rx line))
(module-path (match:substring rx-match 1))
(version (match:substring rx-match 3))
(new-module-path (match:substring rx-match 4))
(new-version (match:substring rx-match 6))
(new-replaced (cons (list module-path version) replaced))
(new-requirements
(if (string-match "^\\.?\\./" new-module-path)
requirements
(cons (list new-module-path new-version) requirements))))
(values new-requirements new-replaced)))
(define (require-directive requirements replaced line)
"Extract requirement from LINE and augment the REQUIREMENTS and REPLACED
lists."
(let* ((rx-match (regexp-exec %go.mod-require-directive-rx line))
(module-path (match:substring rx-match 1))
;; we saw double-quoted string in the wild without escape
;; sequences so we just trim the quotes
;; Double-quoted strings were seen in the wild without escape
;; sequences; trim the quotes to be on the safe side.
(module-path (string-trim-both module-path #\"))
(version (match:substring rx-match 2)))
(match results
(($ <results> requirements replaced)
(make-results (alist-cons module-path version requirements) replaced)))))
(values (cons (list module-path version) requirements) replaced)))
(let ((results (with-input-from-string content
(lambda _
(toplevel (make-results '() '()))))))
(match results
(($ <results> requirements replaced)
;; At last we remove replaced modules from the requirements list
(fold
(lambda (replacedelem requirements)
(alist-delete! (car replacedelem) requirements))
requirements
replaced)))))
(with-input-from-string content
(lambda ()
(receive (requirements replaced)
(toplevel '() '())
;; At last remove the replaced modules from the requirements list.
(remove (lambda (r)
(assoc (car r) replaced))
requirements)))))
;; Prevent inlining of this procedure, which is accessed by unit tests.
(set! parse-go.mod parse-go.mod)
@ -553,17 +566,32 @@ (define (vcs->origin vcs-type vcs-repo-url version)
vcs-type vcs-repo-url)))))
(define* (go-module->guix-package module-path #:key
(goproxy-url "https://proxy.golang.org"))
(let* ((latest-version (go-module-latest-version goproxy-url module-path))
(content (fetch-go.mod goproxy-url module-path latest-version))
(dependencies (map car (parse-go.mod content)))
(goproxy "https://proxy.golang.org")
version
pin-versions?)
"Return the package S-expression corresponding to MODULE-PATH at VERSION, a Go package.
The meta-data is fetched from the GOPROXY server and https://pkg.go.dev/.
When VERSION is unspecified, the latest version available is used."
(let* ((available-versions (go-module-available-versions goproxy module-path))
(version* (or version
(go-module-version-string goproxy module-path))) ;latest
;; Pseudo-versions do not appear in the versions list; skip the
;; following check.
(_ (unless (or (go-pseudo-version? version*)
(member version* available-versions))
(error (format #f "error: version ~s is not available
hint: use one of the following available versions ~a\n"
version* available-versions))))
(content (fetch-go.mod goproxy module-path version*))
(dependencies+versions (parse-go.mod content))
(dependencies (map car dependencies+versions))
(guix-name (go-module->guix-package-name module-path))
(root-module-path (module-path->repository-root module-path))
;; The VCS type and URL are not included in goproxy information. For
;; this we need to fetch it from the official module page.
(meta-data (fetch-module-meta-data root-module-path))
(vcs-type (module-meta-vcs meta-data))
(vcs-repo-url (module-meta-data-repo-url meta-data goproxy-url))
(vcs-repo-url (module-meta-data-repo-url meta-data goproxy))
(synopsis (go-package-synopsis root-module-path))
(description (go-package-description module-path))
(licenses (go-package-licenses module-path)))
@ -571,14 +599,14 @@ (define* (go-module->guix-package module-path #:key
`(package
(name ,guix-name)
;; Elide the "v" prefix Go uses
(version ,(string-trim latest-version #\v))
(version ,(string-trim version* #\v))
(source
,(vcs->origin vcs-type vcs-repo-url latest-version))
,(vcs->origin vcs-type vcs-repo-url version*))
(build-system go-build-system)
(arguments
'(#:import-path ,root-module-path))
,@(maybe-propagated-inputs
(map go-module->guix-package-name dependencies))
,@(maybe-propagated-inputs (map go-module->guix-package-name
dependencies))
(home-page ,(format #f "https://~a" root-module-path))
(synopsis ,synopsis)
(description ,(and=> description beautify-description))
@ -588,16 +616,37 @@ (define* (go-module->guix-package module-path #:key
license)
((license ...) ;a list of licenses
`(list ,@license)))))
dependencies)))
(if pin-versions?
dependencies+versions
dependencies))))
(define go-module->guix-package* (memoize go-module->guix-package))
(define* (go-module-recursive-import package-name
#:key (goproxy-url "https://proxy.golang.org"))
#:key (goproxy "https://proxy.golang.org")
version
pin-versions?)
(recursive-import
package-name
#:repo->guix-package (lambda* (name . _)
(go-module->guix-package*
name
#:goproxy-url goproxy-url))
#:guix-name go-module->guix-package-name))
#:repo->guix-package
(lambda* (name #:key version repo)
;; Disable output buffering so that the following warning gets printed
;; consistently.
(setvbuf (current-error-port) 'none)
(guard (c ((http-get-error? c)
(warning (G_ "Failed to import package ~s.
reason: ~s could not be fetched: HTTP error ~a (~s).
This package and its dependencies won't be imported.~%")
name
(uri->string (http-get-error-uri c))
(http-get-error-code c)
(http-get-error-reason c))
(values '() '())))
(receive (package-sexp dependencies)
(go-module->guix-package* name #:goproxy goproxy
#:version version
#:pin-versions? pin-versions?)
(values package-sexp dependencies))))
#:guix-name go-module->guix-package-name
#:version version))

View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Katherine Cox-Buday <cox.katherine.e@gmail.com>
;;; Copyright © 2020 Katherine Cox-Buday <cox.katherine.e@gmail.com>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -27,28 +28,30 @@ (define-module (guix scripts import go)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (ice-9 receive)
#:export (guix-import-go))
;;;
;;; Command-line options.
;;;
(define %default-options
'())
'((goproxy . "https://proxy.golang.org")))
(define (show-help)
(display (G_ "Usage: guix import go PACKAGE-PATH
Import and convert the Go module for PACKAGE-PATH.\n"))
(display (G_ "Usage: guix import go PACKAGE-PATH[@VERSION]
Import and convert the Go module for PACKAGE-PATH. Optionally, a version
can be specified after the arobas (@) character.\n"))
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
-V, --version display version information and exit"))
(display (G_ "
-r, --recursive generate package expressions for all Go modules\
that are not yet in Guix"))
-r, --recursive generate package expressions for all Go modules
that are not yet in Guix"))
(display (G_ "
-p, --goproxy=GOPROXY specify which goproxy server to use"))
(display (G_ "
--pin-versions use the exact versions of a module's dependencies"))
(newline)
(show-bug-report-information))
@ -58,9 +61,6 @@ (define %options
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix import go")))
(option '(#\r "recursive") #f #f
(lambda (opt name arg result)
(alist-cons 'recursive #t result)))
@ -69,9 +69,12 @@ (define %options
(alist-cons 'goproxy
(string->symbol arg)
(alist-delete 'goproxy result))))
(option '("pin-versions") #f #f
(lambda (opt name arg result)
(alist-cons 'pin-versions? #t result)))
%standard-import-options))
;;;
;;; Entry point.
;;;
@ -93,25 +96,28 @@ (define (parse-options)
(_ #f))
(reverse opts))))
(match args
((module-name)
(if (assoc-ref opts 'recursive)
(map (match-lambda
((and ('package ('name name) . rest) pkg)
`(define-public ,(string->symbol name)
,pkg))
(_ #f))
(go-module-recursive-import module-name
#:goproxy-url
(or (assoc-ref opts 'goproxy)
"https://proxy.golang.org")))
(let ((sexp (go-module->guix-package module-name
#:goproxy-url
(or (assoc-ref opts 'goproxy)
"https://proxy.golang.org"))))
(unless sexp
(leave (G_ "failed to download meta-data for module '~a'~%")
module-name))
sexp)))
((spec) ;e.g., github.com/golang/protobuf@v1.3.1
(receive (name version)
(package-name->name+version spec)
(let ((arguments (list name
#:goproxy (assoc-ref opts 'goproxy)
#:version version
#:pin-versions?
(assoc-ref opts 'pin-versions?))))
(if (assoc-ref opts 'recursive)
;; Recursive import.
(map (match-lambda
((and ('package ('name name) . rest) pkg)
`(define-public ,(string->symbol name)
,pkg))
(_ #f))
(apply go-module-recursive-import arguments))
;; Single import.
(let ((sexp (apply go-module->guix-package arguments)))
(unless sexp
(leave (G_ "failed to download meta-data for module '~a'~%")
module-name))
sexp)))))
(()
(leave (G_ "too few arguments~%")))
((many ...)

View file

@ -19,7 +19,7 @@
;;; Summary
;; Tests for guix/import/go.scm
(define-module (test-import-go)
(define-module (tests-import-go)
#:use-module (guix base32)
#:use-module (guix build-system go)
#:use-module (guix import go)
@ -147,7 +147,8 @@ (define fixtures-go-check-test
("https://pkg.go.dev/github.com/go-check/check"
. ,pkg.go.dev)
("https://pkg.go.dev/github.com/go-check/check?tab=licenses"
. ,pkg.go.dev-licence))))
. ,pkg.go.dev-licence)
("https://proxy.golang.org/github.com/go-check/check/@v/list" . ""))))
(test-begin "go")
@ -169,6 +170,12 @@ (define fixtures-go-check-test
"daa7c04131f5"
(go-version->git-ref "v1.2.4-0.20191109021931-daa7c04131f5"))
(test-assert "go-pseudo-version? multi-digit version number"
(go-pseudo-version? "v1.23.1-0.20200526195155-81db48ad09cc"))
(test-assert "go-pseudo-version? semantic version with rc"
(go-pseudo-version? "v1.4.0-rc.4.0.20200313231945-b860323f09d0"))
;;; Unit tests for (guix import go)
(test-equal "go-path-escape"
@ -185,37 +192,38 @@ (define (inf? p1 p2)
(sort ((@@ (guix import go) parse-go.mod) input) inf?)))
(testing-parse-mod "parse-go.mod-simple"
'(("good/thing" . "v1.4.5")
("new/thing/v2" . "v2.3.4")
("other/thing" . "v1.0.2"))
'(("good/thing" "v1.4.5")
("new/thing/v2" "v2.3.4")
("other/thing" "v1.0.2"))
fixture-go-mod-simple)
(testing-parse-mod "parse-go.mod-with-block"
'(("A" . "v1")
("B" . "v1.0.0")
("C" . "v1.0.0")
("D" . "v1.2.3")
("E" . "dev"))
'(("A" "v1")
("B" "v1.0.0")
("C" "v1.0.0")
("D" "v1.2.3")
("E" "dev"))
fixture-go-mod-with-block)
(testing-parse-mod "parse-go.mod-complete"
'(("github.com/corp/arbitrary-repo" . "v0.0.2")
("quoted.example.com/abitrary/repo" . "v0.0.2")
("one.example.com/abitrary/repo" . "v1.1.111")
("hub.jazz.net/git/user/project/sub/directory" . "v1.1.19")
("hub.jazz.net/git/user/project" . "v1.1.18")
("launchpad.net/~user/project/branch/sub/directory" . "v1.1.17")
("launchpad.net/~user/project/branch" . "v1.1.16")
("launchpad.net/project/series/sub/directory" . "v1.1.15")
("launchpad.net/project/series" . "v1.1.14")
("launchpad.net/project" . "v1.1.13")
("bitbucket.org/user/project/sub/directory" . "v1.11.21")
("bitbucket.org/user/project" . "v1.11.20")
("k8s.io/kubernetes/subproject" . "v1.1.101")
("github.com/user/project/sub/directory" . "v1.1.12")
("github.com/user/project" . "v1.1.11")
("github.com/go-check/check" . "v0.0.0-20140225173054-eb6ee6f84d0a"))
fixture-go-mod-complete)
(testing-parse-mod
"parse-go.mod-complete"
'(("github.com/corp/arbitrary-repo" "v0.0.2")
("quoted.example.com/abitrary/repo" "v0.0.2")
("one.example.com/abitrary/repo" "v1.1.111")
("hub.jazz.net/git/user/project/sub/directory" "v1.1.19")
("hub.jazz.net/git/user/project" "v1.1.18")
("launchpad.net/~user/project/branch/sub/directory" "v1.1.17")
("launchpad.net/~user/project/branch" "v1.1.16")
("launchpad.net/project/series/sub/directory" "v1.1.15")
("launchpad.net/project/series" "v1.1.14")
("launchpad.net/project" "v1.1.13")
("bitbucket.org/user/project/sub/directory" "v1.11.21")
("bitbucket.org/user/project" "v1.11.20")
("k8s.io/kubernetes/subproject" "v1.1.101")
("github.com/user/project/sub/directory" "v1.1.12")
("github.com/user/project" "v1.1.11")
("github.com/go-check/check" "v0.0.0-20140225173054-eb6ee6f84d0a"))
fixture-go-mod-complete)
;;; End-to-end tests for (guix import go)
(define (mock-http-fetch testcase)