[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/05: import: Add Go importer.
From: |
guix-commits |
Subject: |
03/05: import: Add Go importer. |
Date: |
Wed, 10 Mar 2021 12:04:29 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit 02e2e093e858e8a0ca7bd66c1f1f6fd0a1705edb
Author: Katherine Cox-Buday <cox.katherine.e@gmail.com>
AuthorDate: Thu Oct 22 19:40:17 2020 -0500
import: Add Go importer.
This patch adds a 'guix import go' command.
* doc/guix.texi (Requirements): Mention Guile-Lib dependency.
(Invoking guix import): Document 'guix import go'.
* gnu/packages/package-management.scm (guix)[inputs, propagated-inputs]:
Add GUILE-LIB.
* guix/self.scm (compiled-guix)[guile-lib]: New variable.
[dependencies]: Add it.
(specification->package): Add "guile-lib".
* guix/build-system/go.scm (go-version->git-ref): New procedure.
* guix/import/go.scm, guix/scripts/import/go.scm, tests/go.scm: New files.
* guix/scripts/import.scm: Declare subcommand guix import go
* po/guix/POTFILES.in: Add 'guix/scripts/import/go.scm'.
* Makefile.am (MODULES): Add 'guix/import/go.scm' and
'guix/scripts/import/go.scm'.
(SCM_TESTS): Add 'tests/go.scm'.
Co-Authored-By: Helio Machado <0x2b3bfa0@gmail.com>
Co-Authored-By: Francois Joulaud <francois.joulaud@radiofrance.com>
Co-Authored-By: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Co-Authored-by: Ludovic Courtès <ludo@gnu.org>
---
Makefile.am | 3 +
doc/guix.texi | 26 ++
gnu/packages/package-management.scm | 3 +
guix/build-system/go.scm | 35 ++-
guix/import/go.scm | 501 ++++++++++++++++++++++++++++++++++++
guix/scripts/import.scm | 2 +-
guix/scripts/import/go.scm | 118 +++++++++
guix/self.scm | 6 +-
po/guix/POTFILES.in | 1 +
tests/go.scm | 281 ++++++++++++++++++++
10 files changed, 973 insertions(+), 3 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index 0f87c95..f40d950 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -251,6 +251,7 @@ MODULES = \
guix/import/github.scm \
guix/import/gnome.scm \
guix/import/gnu.scm \
+ guix/import/go.scm \
guix/import/hackage.scm \
guix/import/json.scm \
guix/import/kde.scm \
@@ -294,6 +295,7 @@ MODULES = \
guix/scripts/import/elpa.scm \
guix/scripts/import/gem.scm \
guix/scripts/import/gnu.scm \
+ guix/scripts/import/go.scm \
guix/scripts/import/hackage.scm \
guix/scripts/import/json.scm \
guix/scripts/import/nix.scm \
@@ -455,6 +457,7 @@ SCM_TESTS = \
tests/git-authenticate.scm \
tests/glob.scm \
tests/gnu-maintenance.scm \
+ tests/go.scm \
tests/grafts.scm \
tests/graph.scm \
tests/gremlin.scm \
diff --git a/doc/guix.texi b/doc/guix.texi
index f01e7ca..77aafaf 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -863,6 +863,10 @@ substitutes (@pxref{Invoking guix publish}).
the @code{crate} importer (@pxref{Invoking guix import}).
@item
+@uref{https://www.nongnu.org/guile-lib/doc/ref/htmlprag/, Guile-Lib} for
+the @code{go} importer (@pxref{Invoking guix import}).
+
+@item
When @url{http://www.bzip.org, libbz2} is available,
@command{guix-daemon} can use it to compress build logs.
@end itemize
@@ -11494,6 +11498,28 @@ Select the given repository (a repository name).
Possible values include:
of coq packages.
@end itemize
@end table
+
+@item go
+@cindex go
+Import metadata for a Go module using
+@uref{https://proxy.golang.org, proxy.golang.org}.
+
+This importer is highly experimental. See the source code for more info
+about the current state.
+
+@example
+guix import go gopkg.in/yaml.v2
+@end example
+
+Additional options include:
+
+@table @code
+@item --recursive
+@itemx -r
+Traverse the dependency graph of the given upstream package recursively
+and generate package expressions for all those packages that are not yet
+in Guix.
+@end table
@end table
The structure of the @command{guix import} code is modular. It would be
diff --git a/gnu/packages/package-management.scm
b/gnu/packages/package-management.scm
index 60aa3f8..9bf24f8 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -304,6 +304,7 @@ $(prefix)/etc/init.d\n")))
'((assoc-ref inputs "guile"))))
(avahi (assoc-ref inputs "guile-avahi"))
(gcrypt (assoc-ref inputs "guile-gcrypt"))
+ (guile-lib (assoc-ref inputs "guile-lib"))
(json (assoc-ref inputs "guile-json"))
(sqlite (assoc-ref inputs "guile-sqlite3"))
(zlib (assoc-ref inputs "guile-zlib"))
@@ -367,6 +368,7 @@ $(prefix)/etc/init.d\n")))
`(("guile-avahi" ,guile-avahi)))
("guile-gcrypt" ,guile-gcrypt)
("guile-json" ,guile-json-4)
+ ("guile-lib" ,guile-lib)
("guile-sqlite3" ,guile-sqlite3)
("guile-zlib" ,guile-zlib)
("guile-lzlib" ,guile-lzlib)
@@ -422,6 +424,7 @@ $(prefix)/etc/init.d\n")))
`(("guile-avahi" ,guile-avahi)))
("guile-gcrypt" ,guile-gcrypt)
("guile-json" ,guile-json-4)
+ ("guile-lib" ,guile-lib)
("guile-sqlite3" ,guile-sqlite3)
("guile-ssh" ,guile-ssh)
("guile-git" ,guile-git)
diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm
index f8ebaef..0e2c1cd 100644
--- a/guix/build-system/go.scm
+++ b/guix/build-system/go.scm
@@ -26,9 +26,12 @@
#:use-module (guix build-system gnu)
#:use-module (guix packages)
#:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
#:export (%go-build-system-modules
go-build
- go-build-system))
+ go-build-system
+
+ go-version->git-ref))
;; Commentary:
;;
@@ -37,6 +40,36 @@
;;
;; Code:
+(define %go-version-rx
+ (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
+
+(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."
+ ;; 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
+ ;; the time is the commit time in UTC and the final suffix is the prefix of
+ ;; the commit hash (see: https://golang.org/ref/mod#pseudo-versions).
+ (let* ((version
+ ;; If a source code repository has a v2.0.0 or later tag for a file
+ ;; tree with no go.mod, the version is considered to be part of the
+ ;; v1 module's available versions and is given an +incompatible
+ ;; suffix
+ ;;
(see:https://golang.org/cmd/go/#hdr-Module_compatibility_and_semantic_versioning).
+ (if (string-suffix? "+incompatible" version)
+ (string-drop-right version 13)
+ version))
+ (match (regexp-exec %go-version-rx version)))
+ (if match
+ (match:substring match 4)
+ version)))
+
(define %go-build-system-modules
;; Build-side modules imported and used by default.
`((guix build go-build-system)
diff --git a/guix/import/go.scm b/guix/import/go.scm
new file mode 100644
index 0000000..6b10c60
--- /dev/null
+++ b/guix/import/go.scm
@@ -0,0 +1,501 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Katherine Cox-Buday <cox.katherine.e@gmail.com>
+;;; 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>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import go)
+ #:use-module (guix build-system go)
+ #:use-module (guix git)
+ #:use-module (guix i18n)
+ #:use-module (guix diagnostics)
+ #:use-module (guix import utils)
+ #:use-module (guix import json)
+ #:use-module (guix packages)
+ #:use-module ((guix utils) #:select (string-replace-substring))
+ #:use-module (guix http-client)
+ #:use-module ((guix licenses) #:prefix license:)
+ #:use-module (guix memoization)
+ #:autoload (htmlprag) (html->sxml) ;from Guile-Lib
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 rdelim)
+ #:use-module (ice-9 receive)
+ #:use-module (ice-9 regex)
+ #:use-module ((rnrs io ports) #:select (call-with-port))
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
+ #:use-module (sxml xpath)
+ #:use-module (web client)
+ #:use-module (web response)
+ #:use-module (web uri)
+
+ #:export (go-path-escape
+ go-module->guix-package
+ go-module-recursive-import))
+
+;;; Commentary:
+;;;
+;;; (guix import go) attempts to make it easier to create Guix package
+;;; declarations for Go modules.
+;;;
+;;; Modules in Go are a "collection of related Go packages" which are "the
+;;; unit of source code interchange and versioning". Modules are generally
+;;; hosted in a repository.
+;;;
+;;; At this point it should handle correctly modules which have only Go
+;;; dependencies and are accessible from proxy.golang.org (or configured via
+;;; GOPROXY).
+;;;
+;;; We want it to work more or less this way:
+;;; - get latest version for the module from GOPROXY
+;;; - infer VCS root repo from which we will check-out source by
+;;; + recognising known patterns (like github.com)
+;;; + or recognizing .vcs suffix
+;;; + or parsing meta tag in HTML served at the URL
+;;; + or (TODO) if nothing else works by using zip file served by GOPROXY
+;;; - get go.mod from GOPROXY (which is able to synthetize one if needed)
+;;; - extract list of dependencies from this go.mod
+;;;
+;;; The Go module paths are translated to a Guix package name under the
+;;; 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)
+
+;;; Code:
+
+(define (go-path-escape path)
+ "Escape a module path by replacing every uppercase letter with an
+exclamation mark followed with its lowercase equivalent, as per the module
+Escaped Paths specification (see:
+https://godoc.org/golang.org/x/mod/module#hdr-Escaped_Paths)."
+ (define (escape occurrence)
+ (string-append "!" (string-downcase (match:substring occurrence))))
+ (regexp-substitute/global #f "[A-Z]" path 'pre escape 'post))
+
+(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-package-licenses name)
+ "Retrieve the list of licenses that apply to NAME, a Go package or module
+name (e.g. \"github.com/golang/protobuf/proto\"). The data is scraped from
+the https://pkg.go.dev/ web site."
+ (let*-values (((url) (string-append "https://pkg.go.dev/" name
+ "?tab=licenses"))
+ ((response body) (http-get url))
+ ;; Extract the text contained in a h2 child node of any
+ ;; element marked with a "License" class attribute.
+ ((select) (sxpath `(// (* (@ (equal? (class "License"))))
+ h2 // *text*))))
+ (and (eq? (response-code response) 200)
+ (match (select (html->sxml body))
+ (() #f) ;nothing selected
+ (licenses licenses)))))
+
+(define (go.pkg.dev-info name)
+ (http-get (string-append "https://pkg.go.dev/" name)))
+(define go.pkg.dev-info*
+ (memoize go.pkg.dev-info))
+
+(define (go-package-description name)
+ "Retrieve a short description for NAME, a Go package name,
+e.g. \"google.golang.org/protobuf/proto\". The data is scraped from the
+https://pkg.go.dev/ web site."
+ (let*-values (((response body) (go.pkg.dev-info* name))
+ ;; Extract the text contained in a h2 child node of any
+ ;; element marked with a "License" class attribute.
+ ((select) (sxpath
+ `(// (section
+ (@ (equal? (class "Documentation-overview"))))
+ (p 1)))))
+ (and (eq? (response-code response) 200)
+ (match (select (html->sxml body))
+ (() #f) ;nothing selected
+ (((p . strings))
+ ;; The paragraph text is returned as a list of strings embedding
+ ;; newline characters. Join them and strip the newline
+ ;; characters.
+ (string-delete #\newline (string-join strings)))))))
+
+(define (go-package-synopsis module-name)
+ "Retrieve a short synopsis for a Go module named MODULE-NAME,
+e.g. \"google.golang.org/protobuf\". The data is scraped from
+the https://pkg.go.dev/ web site."
+ ;; Note: Only the *module* (rather than package) page has the README title
+ ;; used as a synopsis on the https://pkg.go.dev web site.
+ (let*-values (((response body) (go.pkg.dev-info* module-name))
+ ;; Extract the text contained in a h2 child node of any
+ ;; element marked with a "License" class attribute.
+ ((select) (sxpath
+ `(// (div (@ (equal? (class "UnitReadme-content"))))
+ // h3 *text*))))
+ (and (eq? (response-code response) 200)
+ (match (select (html->sxml body))
+ (() #f) ;nothing selected
+ ((title more ...) ;title is the first string of the list
+ (string-trim-both title))))))
+
+(define (list->licenses licenses)
+ "Given a list of LICENSES mostly following the SPDX conventions, return the
+corresponding Guix license or 'unknown-license!"
+ (filter-map (lambda (license)
+ (and (not (string-null? license))
+ (not (any (cut string=? <> license)
+ '("AND" "OR" "WITH")))
+ ;; Adjust the license names scraped from
+ ;; https://pkg.go.dev to an equivalent SPDX identifier,
+ ;; if they differ (see: https://github.com/golang/pkgsite
+ ;; /internal/licenses/licenses.go#L174).
+ (or (spdx-string->license
+ (match license
+ ("BlueOak-1.0" "BlueOak-1.0.0")
+ ("BSD-0-Clause" "0BSD")
+ ("BSD-2-Clause" "BSD-2-Clause-FreeBSD")
+ ("GPL2" "GPL-2.0")
+ ("GPL3" "GPL-3.0")
+ ("NIST" "NIST-PD")
+ (_ license)))
+ 'unknown-license!)))
+ licenses))
+
+(define (fetch-go.mod goproxy-url module-path version)
+ "Fetches go.mod from the given GOPROXY-URL server for the given MODULE-PATH
+and VERSION."
+ (let ((url (format #f "~a/~a/@v/~a.mod" goproxy-url
+ (go-path-escape module-path)
+ (go-path-escape version))))
+ (http-fetch url)))
+
+(define %go.mod-require-directive-rx
+ ;; A line in a require directive is composed of a module path and
+ ;; a version separated by whitespace and an optionnal '//' comment at
+ ;; the end.
+ (make-regexp
+ (string-append
+ "^[[:blank:]]*"
+ "([^[:blank:]]+)[[:blank:]]+([^[:blank:]]+)"
+ "([[:blank:]]+//.*)?")))
+
+(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:]]+))?")))
+
+(define (parse-go.mod port)
+ "Parse the go.mod file accessible via the input PORT, 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."
+ (let ((line (read-line port)))
+ (cond
+ ((eof-object? line)
+ ;; parsing ended, give back the result
+ results)
+ ((string=? line "require (")
+ ;; a require block begins, delegate parsing to IN-REQUIRE
+ (in-require results))
+ ((string=? line "replace (")
+ ;; a replace block begins, delegate parsing to IN-REPLACE
+ (in-replace results))
+ ((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)))
+ ((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)))
+ (#t
+ ;; unrecognised line, ignore silently
+ (toplevel results)))))
+
+ (define (in-require results)
+ (let ((line (read-line port)))
+ (cond
+ ((eof-object? line)
+ ;; this should never happen here but we ignore silently
+ results)
+ ((string=? line ")")
+ ;; end of block, coming back to toplevel
+ (toplevel results))
+ (#t
+ (in-require (require-directive results line))))))
+
+ (define (in-replace results)
+ (let ((line (read-line port)))
+ (cond
+ ((eof-object? line)
+ ;; this should never happen here but we ignore silently
+ results)
+ ((string=? line ")")
+ ;; end of block, coming back to toplevel
+ (toplevel results))
+ (#t
+ (in-replace (replace-directive results line))))))
+
+ (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."
+ (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
+ (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)))))
+
+ (let ((results (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)))))
+
+;; Prevent inlining of this procedure, which is accessed by unit tests.
+(set! parse-go.mod parse-go.mod)
+
+(define-record-type <vcs>
+ (%make-vcs url-prefix root-regex type)
+ vcs?
+ (url-prefix vcs-url-prefix)
+ (root-regex vcs-root-regex)
+ (type vcs-type))
+(define (make-vcs prefix regexp type)
+ (%make-vcs prefix (make-regexp regexp) type))
+(define known-vcs
+ ;; See the following URL for the official Go equivalent:
+ ;;
https://github.com/golang/go/blob/846dce9d05f19a1f53465e62a304dea21b99f910/src/cmd/go/internal/vcs/vcs.go#L1026-L1087
+ (list
+ (make-vcs
+ "github.com"
+
"^(github\\.com/[A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+)(/[A-Za-z0-9_.\\-]+)*$"
+ 'git)
+ (make-vcs
+ "bitbucket.org"
+
"^(bitbucket\\.org/([A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+))(/[A-Za-z0-9_.\\-]+)*$"
+ 'unknown)
+ (make-vcs
+ "hub.jazz.net/git/"
+
"^(hub\\.jazz\\.net/git/[a-z0-9]+/[A-Za-z0-9_.\\-]+)(/[A-Za-z0-9_.\\-]+)*$"
+ 'git)
+ (make-vcs
+ "git.apache.org"
+ "^(git\\.apache\\.org/[a-z0-9_.\\-]+\\.git)(/[A-Za-z0-9_.\\-]+)*$"
+ 'git)
+ (make-vcs
+ "git.openstack.org"
+ "^(git\\.openstack\\.org/[A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+)(\\.git)?\
+(/[A-Za-z0-9_.\\-]+)*$"
+ 'git)))
+
+(define (module-path->repository-root module-path)
+ "Infer the repository root from a module path. Go modules can be
+defined at any level of a repository tree, but querying for the meta tag
+usually can only be done from the web page at the root of the repository,
+hence the need to derive this information."
+
+ ;; For reference, see: https://golang.org/ref/mod#vcs-find.
+ (define vcs-qualifiers '(".bzr" ".fossil" ".git" ".hg" ".svn"))
+
+ (define (vcs-qualified-module-path->root-repo-url module-path)
+ (let* ((vcs-qualifiers-group (string-join vcs-qualifiers "|"))
+ (pattern (format #f "^(.*(~a))(/|$)" vcs-qualifiers-group))
+ (m (string-match pattern module-path)))
+ (and=> m (cut match:substring <> 1))))
+
+ (or (and=> (find (lambda (vcs)
+ (string-prefix? (vcs-url-prefix vcs) module-path))
+ known-vcs)
+ (lambda (vcs)
+ (match:substring (regexp-exec (vcs-root-regex vcs)
+ module-path) 1)))
+ (vcs-qualified-module-path->root-repo-url module-path)
+ module-path))
+
+(define (go-module->guix-package-name module-path)
+ "Converts a module's path to the canonical Guix format for Go packages."
+ (string-downcase (string-append "go-" (string-replace-substring
+ (string-replace-substring
+ module-path
+ "." "-")
+ "/" "-"))))
+
+(define-record-type <module-meta>
+ (make-module-meta import-prefix vcs repo-root)
+ module-meta?
+ (import-prefix module-meta-import-prefix)
+ (vcs module-meta-vcs) ;a symbol
+ (repo-root module-meta-repo-root))
+
+(define (fetch-module-meta-data module-path)
+ "Retrieve the module meta-data from its landing page. This is necessary
+because goproxy servers don't currently provide all the information needed to
+build a package."
+ ;; <meta name="go-import" content="import-prefix vcs repo-root">
+ (let* ((port (http-fetch (format #f "https://~a?go-get=1" module-path)))
+ (select (sxpath `(// head (meta (@ (equal? (name "go-import"))))
+ // content))))
+ (match (select (call-with-port port html->sxml))
+ (() #f) ;nothing selected
+ (((content content-text))
+ (match (string-split content-text #\space)
+ ((root-path vcs repo-url)
+ (make-module-meta root-path (string->symbol vcs) repo-url)))))))
+
+(define (module-meta-data-repo-url meta-data goproxy-url)
+ "Return the URL where the fetcher which will be used can download the
+source."
+ (if (member (module-meta-vcs meta-data) '(fossil mod))
+ goproxy-url
+ (module-meta-repo-root meta-data)))
+
+(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."
+ (case vcs-type
+ ((git)
+ (let ((plain-version? (string=? version (go-version->git-ref version)))
+ (v-prefixed? (string-prefix? "v" version)))
+ `(origin
+ (method git-fetch)
+ (uri (git-reference
+ (url ,vcs-repo-url)
+ (commit ,(if (and plain-version? v-prefixed?)
+ '(string-append "v" version)
+ '(go-version->git-ref version)))))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ ;; FIXME: populate hash for git repo checkout
+ "0000000000000000000000000000000000000000000000000000")))))
+ ((hg)
+ `(origin
+ (method hg-fetch)
+ (uri (hg-reference
+ (url ,vcs-repo-url)
+ (changeset ,version)))
+ (file-name (string-append name "-" version "-checkout"))
+ (sha256
+ (base32
+ ;; FIXME: populate hash for hg repo checkout
+ "0000000000000000000000000000000000000000000000000000"))))
+ ((svn)
+ `(origin
+ (method svn-fetch)
+ (uri (svn-reference
+ (url ,vcs-repo-url)
+ (revision (string->number version))))
+ (file-name (string-append name "-" version "-checkout"))
+ (sha256
+ (base32
+ ;; FIXME: populate hash for svn repo checkout
+ "0000000000000000000000000000000000000000000000000000"))))
+ (else
+ (raise
+ (formatted-message (G_ "unsupported vcs type '~a' for package '~a'")
+ 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))
+ (port (fetch-go.mod goproxy-url module-path latest-version))
+ (dependencies (map car (call-with-port port parse-go.mod)))
+ (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))
+ (synopsis (go-package-synopsis root-module-path))
+ (description (go-package-description module-path))
+ (licenses (go-package-licenses module-path)))
+ (values
+ `(package
+ (name ,guix-name)
+ ;; Elide the "v" prefix Go uses
+ (version ,(string-trim latest-version #\v))
+ (source
+ ,(vcs->origin vcs-type vcs-repo-url latest-version))
+ (build-system go-build-system)
+ (arguments
+ '(#:import-path ,root-module-path))
+ ,@(maybe-inputs (map go-module->guix-package-name dependencies))
+ (home-page ,(format #f "https://~a" root-module-path))
+ (synopsis ,synopsis)
+ (description ,description)
+ (license ,(match (and=> licenses list->licenses)
+ ((license) license)
+ ((licenses ...) `(list ,@licenses))
+ (x x))))
+ 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"))
+ (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))
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 0a3863f..1d2b45d 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -77,7 +77,7 @@ rather than \\n."
;;;
(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem"
- "cran" "crate" "texlive" "json" "opam"))
+ "go" "cran" "crate" "texlive" "json" "opam"))
(define (resolve-importer name)
(let ((module (resolve-interface
diff --git a/guix/scripts/import/go.scm b/guix/scripts/import/go.scm
new file mode 100644
index 0000000..afdba4e
--- /dev/null
+++ b/guix/scripts/import/go.scm
@@ -0,0 +1,118 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright � 2020 Katherine Cox-Buday <cox.katherine.e@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts import go)
+ #:use-module (guix ui)
+ #:use-module (guix utils)
+ #:use-module (guix scripts)
+ #:use-module (guix import go)
+ #:use-module (guix scripts import)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-37)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 format)
+ #:export (guix-import-go))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+ '())
+
+(define (show-help)
+ (display (G_ "Usage: guix import go PACKAGE-PATH
+Import and convert the Go module for PACKAGE-PATH.\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"))
+ (display (G_ "
+ -p, --goproxy=GOPROXY specify which goproxy server to use"))
+ (newline)
+ (show-bug-report-information))
+
+(define %options
+ ;; Specification of the command-line options.
+ (cons* (option '(#\h "help") #f #f
+ (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)))
+ (option '(#\p "goproxy") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'goproxy
+ (string->symbol arg)
+ (alist-delete 'goproxy result))))
+ %standard-import-options))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-import-go . args)
+ (define (parse-options)
+ ;; Return the alist of option values.
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (G_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (alist-cons 'argument arg result))
+ %default-options))
+
+ (let* ((opts (parse-options))
+ (args (filter-map (match-lambda
+ (('argument . value)
+ value)
+ (_ #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)))
+ (()
+ (leave (G_ "too few arguments~%")))
+ ((many ...)
+ (leave (G_ "too many arguments~%"))))))
diff --git a/guix/self.scm b/guix/self.scm
index 35fba11..3154d18 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -56,6 +56,7 @@
("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh))
("guile-git" (ref '(gnu packages guile) 'guile-git))
("guile-semver" (ref '(gnu packages guile-xyz) 'guile-semver))
+ ("guile-lib" (ref '(gnu packages guile-xyz) 'guile-lib))
("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
("guile-zlib" (ref '(gnu packages guile) 'guile-zlib))
("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib))
@@ -814,6 +815,9 @@ itself."
(define guile-ssh
(specification->package "guile-ssh"))
+ (define guile-lib
+ (specification->package "guile-lib"))
+
(define guile-git
(specification->package "guile-git"))
@@ -842,7 +846,7 @@ itself."
(append-map transitive-package-dependencies
(list guile-gcrypt gnutls guile-git guile-avahi
guile-json guile-semver guile-ssh guile-sqlite3
- guile-zlib guile-lzlib guile-zstd)))
+ guile-lib guile-zlib guile-lzlib guile-zstd)))
(define *core-modules*
(scheme-node "guix-core"
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index 666e630..cbbfe1e 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -101,6 +101,7 @@ guix/scripts/import/cpan.scm
guix/scripts/import/crate.scm
guix/scripts/import/gem.scm
guix/scripts/import/gnu.scm
+guix/scripts/import/go.scm
guix/scripts/import/hackage.scm
guix/scripts/import/json.scm
guix/scripts/import/nix.scm
diff --git a/tests/go.scm b/tests/go.scm
new file mode 100644
index 0000000..1df5036
--- /dev/null
+++ b/tests/go.scm
@@ -0,0 +1,281 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright � 2021 Fran�ois Joulaud <francois.joulaud@radiofrance.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Summary
+;; Tests for guix/import/go.scm
+
+(define-module (test-import-go)
+ #:use-module (guix base32)
+ #:use-module (guix build-system go)
+ #:use-module (guix import go)
+ #:use-module (guix tests)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-19)
+ #:use-module (srfi srfi-64)
+ #:use-module (web response))
+
+(define parse-go.mod
+ (@@ (guix import go) parse-go.mod))
+
+(define fixture-go-mod-simple
+ "module my/thing
+go 1.12
+require other/thing v1.0.2
+require new/thing/v2 v2.3.4
+exclude old/thing v1.2.3
+replace bad/thing v1.4.5 => good/thing v1.4.5
+")
+
+(define fixture-go-mod-with-block
+ "module M
+
+require (
+ A v1
+ B v1.0.0
+ C v1.0.0
+ D v1.2.3
+ E dev
+)
+
+exclude D v1.2.3
+")
+
+
+(define fixture-go-mod-complete
+ "module M
+
+go 1.13
+
+replace github.com/myname/myproject/myapi => ./api
+
+replace github.com/mymname/myproject/thissdk => ../sdk
+
+replace launchpad.net/gocheck => github.com/go-check/check
v0.0.0-20140225173054-eb6ee6f84d0a
+
+require (
+ github.com/user/project v1.1.11
+ github.com/user/project/sub/directory v1.1.12
+ bitbucket.org/user/project v1.11.20
+ bitbucket.org/user/project/sub/directory v1.11.21
+ launchpad.net/project v1.1.13
+ launchpad.net/project/series v1.1.14
+ launchpad.net/project/series/sub/directory v1.1.15
+ launchpad.net/~user/project/branch v1.1.16
+ launchpad.net/~user/project/branch/sub/directory v1.1.17
+ hub.jazz.net/git/user/project v1.1.18
+ hub.jazz.net/git/user/project/sub/directory v1.1.19
+ k8s.io/kubernetes/subproject v1.1.101
+ one.example.com/abitrary/repo v1.1.111
+ two.example.com/abitrary/repo v0.0.2
+ \"quoted.example.com/abitrary/repo\" v0.0.2
+)
+
+replace two.example.com/abitrary/repo => github.com/corp/arbitrary-repo v0.0.2
+
+replace (
+ golang.org/x/sys => golang.org/x/sys v0.0.0-20190813064441-fde4db37ae7a
// pinned to release-branch.go1.13
+ golang.org/x/tools => golang.org/x/tools
v0.0.0-20190821162956-65e3620a7ae7 // pinned to release-branch.go1.13
+)
+
+")
+
+
+
+(define fixture-latest-for-go-check
+
"{\"Version\":\"v0.0.0-20201130134442-10cb98267c6c\",\"Time\":\"2020-11-30T13:44:42Z\"}")
+
+
+(define fixtures-go-check-test
+ (let ((version
+
"{\"Version\":\"v0.0.0-20201130134442-10cb98267c6c\",\"Time\":\"2020-11-30T13:44:42Z\"}")
+ (go.mod
+ "module gopkg.in/check.v1
+
+go 1.11
+
+require github.com/kr/pretty v0.2.1
+")
+ (go-get
+ "<!DOCTYPE html>
+<html lang=\"en\" >
+ <head>
+ <meta charset=\"utf-8\">
+ <link rel=\"dns-prefetch\" href=\"https://github.githubassets.com\">
+ <script crossorigin=\"anonymous\" defer=\"defer\"
integrity=\"sha512-aw5tciVT0IsECUmMuwp9ez60QReE2/yFNL1diLgZnOom6RhU8+0lG3RlAKto4JwbCoEP15E41Pksd7rK5BKfCQ==\"
type=\"application/javascript\"
src=\"https://github.githubassets.com/assets/topic-suggestions-6b0e6d72.js\"></script>
+ <meta name=\"viewport\" content=\"width=device-width\">
+
+ <title>GitHub - go-check/check: Rich testing for the Go language</title>
+ <meta name=\"description\" content=\"Rich testing for the Go language.
Contribute to go-check/check development by creating an account on GitHub.\">
+ <link rel=\"search\" type=\"application/opensearchdescription+xml\"
href=\"/opensearch.xml\" title=\"GitHub\">
+ <link rel=\"fluid-icon\" href=\"https://github.com/fluidicon.png\"
title=\"GitHub\">
+ <!-- To prevent page flashing, the optimizely JS needs to be loaded in the
+ <head> tag before the DOM renders -->
+ <meta name=\"hostname\" content=\"github.com\">
+ <meta name=\"user-login\" content=\"\">
+ <link href=\"https://github.com/go-check/check/commits/v1.atom\"
rel=\"alternate\" title=\"Recent Commits to check:v1\"
type=\"application/atom+xml\">
+ <meta name=\"go-import\" content=\"github.com/go-check/check git
https://github.com/go-check/check.git\">
+ </head>
+ <body class=\"logged-out env-production page-responsive\" style=\"word-wrap:
break-word;\">
+ </body>
+</html>
+")
+ (pkg.go.dev "<!DOCTYPE html>\n<html lang=\"en\">\n<head>\n <meta
charset=\"utf-8\">\n</head>\n<body class=\"Site Site--wide Site--redesign\">\n
<div class=\"Site-content\">\n <div class=\"Container\">\n <div
class=\"UnitDetails\" data-test-id=\"UnitDetails\">\n <div
class=\"UnitDetails-content js-unitDetailsContent\" role=\"main\"
data-test-id=\"UnitDetails-content\">\n <div class=\"UnitReadme
js-readme\">\n <h2 class=\"UnitReadme-title\" id=\ [...]
+ (pkg.go.dev-licence "<!DOCTYPE html>\n<html lang=\"en\">\n<meta
charset=\"utf-8\">\n<meta http-equiv=\"X-UA-Compatible\"
content=\"IE=edge\">\n<body class=\"Site Site--wide Site--redesign\">\n <div
class=\"Unit-content\" role=\"main\">\n <section class=\"License\"
id=\"lic-0\">\n <h2><div id=\"#lic-0\">BSD-2-Clause</div></h2>\n
<p>This is not legal advice. <a href=\"/license-policy\">Read
disclaimer.</a></p>\n <pre class=\"License-contents\">Gocheck - A rich te
[...]
+
`(("https://proxy.golang.org/github.com/go-check/check/@v/v0.0.0-20201130134442-10cb98267c6c.mod"
+ . ,go.mod)
+ ("https://proxy.golang.org/github.com/go-check/check/@latest"
+ . ,version)
+ ("https://github.com/go-check/check?go-get=1"
+ . ,go-get)
+ ("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))))
+
+(test-begin "go")
+
+;;; Unit tests for go build-system
+
+(test-equal "go-version basic"
+ "v1.0.2"
+ (go-version->git-ref "v1.0.2"))
+
+(test-equal "go-version omited 'v' character"
+ "v1.0.2"
+ (go-version->git-ref "v1.0.2"))
+
+(test-equal "go-version with embeded git-ref"
+ "65e3620a7ae7"
+ (go-version->git-ref "v0.0.0-20190821162956-65e3620a7ae7"))
+
+(test-equal "go-version with complex embeded git-ref"
+ "daa7c04131f5"
+ (go-version->git-ref "v1.2.4-0.20191109021931-daa7c04131f5"))
+
+;;; Unit tests for (guix import go)
+
+(test-equal "go-path-escape"
+ "github.com/!azure/!avere"
+ ((@@ (guix import go) go-path-escape) "github.com/Azure/Avere"))
+
+
+;; We define a function for all similar tests with different go.mod files
+(define (testing-parse-mod name expected input)
+ (define (inf? p1 p2)
+ (string<? (car p1) (car p2)))
+ (let ((input-port (open-input-string input)))
+ (test-equal name
+ (sort expected inf?)
+ (sort
+ ( (@@ (guix import go) parse-go.mod)
+ input-port)
+ inf?))))
+
+(testing-parse-mod "parse-go.mod-simple"
+ '(("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"))
+ 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)
+
+;;; End-to-end tests for (guix import go)
+(define (mock-http-fetch testcase)
+ (lambda (url . rest)
+ (let ((body (assoc-ref testcase url)))
+ (if body
+ (open-input-string body)
+ (error "mocked http-fetch Unexpected URL: " url)))))
+
+(define (mock-http-get testcase)
+ (lambda (url . rest)
+ (let ((body (assoc-ref testcase url))
+ (response-header
+ (build-response
+ #:version '(1 . 1)
+ #:code 200
+ #:reason-phrase "Ok"
+ #:headers `(
+ (content-type text/html (charset . "utf-8"))
+ (date . ,(make-date 0 10 58 12 6 3 2021 0))
+ (transfer-encoding (chunked)))
+ #:port #f
+ #:validate-headers? #t)))
+ (if body
+ (values response-header body)
+ (error "mocked http-get Unexpected URL: " url)))))
+
+(test-equal "go-module->guix-package"
+ '(package
+ (name "go-github-com-go-check-check")
+ (version "0.0.0-20201130134442-10cb98267c6c")
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/go-check/check.git")
+ (commit (go-version->git-ref version))))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "0000000000000000000000000000000000000000000000000000"))))
+ (build-system go-build-system)
+ (arguments
+ (quote (#:import-path "github.com/go-check/check")))
+ (inputs
+ (quasiquote (("go-github-com-kr-pretty"
+ (unquote go-github-com-kr-pretty)))))
+ (home-page "https://github.com/go-check/check")
+ (synopsis "Instructions")
+ (description #f)
+ (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"))))
+
+(test-end "go")
+