Subject: bug#44178: closed (Re: bug#44178: Add a Go Module Importer)

From: [email-masked] (GNU bug Tracking System)
Date: Wed, 10 Mar 2021 17:14:02 +0000

Your bug report

#44178: Add a Go Module Importer

which was filed against the guix-patches package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
44178: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=44178
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#44178: Add a Go Module Importer
From: Ludovic Courtès <[email-masked]>
To: JOULAUD François <[email-masked]>
Cc: Katherine Cox-Buday <[email-masked]>, "[email-masked]" <[email-masked]>, Maxim Cournoyer <[email-masked]>
Date: Wed, 10 Mar 2021 18:12:49 +0100
List-Id: <debbugs-submit.debbugs.gnu.org>

Hi François, Katherine, & all!

I’m happy to say that it’s finally pushed, on behalf of Katherine and
the rest of you!

  https://git.savannah.gnu.org/cgit/guix.git/commit/?id=02e2e093e858e8a0ca7bd66c1f1f6fd0a1705edb

I had to make a number of changes, among which (off the top of my head):

  • Add files to Makefile.am.  One can now run:

      make check TESTS=tests/go.scm

    See
    <https://guix.gnu.org/manual/en/html_node/Running-the-Test-Suite.html>.

  • Update ‘specification->package’ in (guix self).

  • Fix version handling in the generated sexp (thanks Maxim for helping
    out on IRC!).

  • Fix the generated ‘license’ field.

  • Fix minor issues reported by compiler warnings.

  • Compute the hash of Git checkouts (done in a followup commit) since
    that’s part of the minimum one expects from importers.

  • Recode (guix import go) as UTF-8 rather than Latin-1.

  • Move commentary below ‘define-module’ form.

Let me know if I broke anything on the way or if anything’s unclear!

Now, you’ve already identified things that could be improved, so feel
free to send focused patches addressing specific issues.

Thanks everyone for the great team work!  :-)

Ludo’.

Subject: Add a Go Module Importer
From: Katherine Cox-Buday <[email-masked]>
To: [email-masked]
Date: Fri, 23 Oct 2020 09:06:58 -0500
List-Id: <debbugs-submit.debbugs.gnu.org>

>From cc92cbcf5ae89891f478f319e955419800bdfcf9 Mon Sep 17 00:00:00 2001
From: Katherine Cox-Buday <[email-masked]>
Date: Thu, 22 Oct 2020 19:40:17 -0500
Subject: [PATCH] * guix/import/go.scm: Created Go Importer *
 guix/scripts/import.scm: Created Go Importer Subcommand * guix/import/go.scm
 (importers): Added Go Importer Subcommand

---
 guix/import/go.scm         | 276 +++++++++++++++++++++++++++++++++++++
 guix/scripts/import.scm    |   2 +-
 guix/scripts/import/go.scm | 118 ++++++++++++++++
 3 files changed, 395 insertions(+), 1 deletion(-)
 create mode 100644 guix/import/go.scm
 create mode 100644 guix/scripts/import/go.scm

diff --git a/guix/import/go.scm b/guix/import/go.scm
new file mode 100644
index 0000000000..61009f3565
--- /dev/null
+++ b/guix/import/go.scm
@@ -0,0 +1,276 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Katherine Cox-Buday <[email-masked]>
+;;;
+;;; 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 (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (guix json)
+  #:use-module ((guix download) #:prefix download:)
+  #:use-module (guix import utils)
+  #:use-module (guix import json)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix base16)
+  #:use-module (guix base32)
+  #:use-module (guix build download)
+  #:use-module (web uri)
+
+  #:export (go-module->guix-package
+            go-module-recursive-import
+            infer-module-root))
+
+(define (escape-capital-letters s)
+  "To avoid ambiguity when serving from case-insensitive file systems, the
+$module and $version elements are case-encoded by replacing every uppercase
+letter with an exclamation mark followed by the corresponding lower-case
+letter."
+  (let ((escaped-string (string)))
+    (string-for-each-index
+     (lambda (i)
+       (let ((c (string-ref s i)))
+         (set! escaped-string
+           (string-concatenate
+            (list escaped-string
+                  (if (char-upper-case? c) "!" "")
+                  (string (char-downcase c)))))))
+     s)
+    escaped-string))
+
+(define (fetch-latest-version goproxy-url module-path)
+  "Fetches 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
+                       (escape-capital-letters module-path)))
+   "Version"))
+
+(define (fetch-go.mod goproxy-url module-path version file)
+  "Fetches go.mod from the given GOPROXY-URL server for the given MODULE-PATH
+and VERSION."
+  (url-fetch (format #f "~a/~a/@v/~a.mod" goproxy-url
+                     (escape-capital-letters module-path)
+                     (escape-capital-letters version))
+             file
+             #:print-build-trace? #f))
+
+(define (parse-go.mod go.mod-path)
+  "Parses a go.mod file and returns an alist of module path to version."
+  (with-input-from-file go.mod-path
+    (lambda ()
+      (let ((in-require? #f)
+            (requirements (list)))
+        (do ((line (read-line) (read-line)))
+            ((eof-object? line))
+          (set! line (string-trim line))
+          ;; The parser is either entering, within, exiting, or after the
+          ;; require block. The Go toolchain is trustworthy so edge-cases like
+          ;; double-entry, etc. need not complect the parser.
+          (cond
+           ((string=? line "require (")
+            (set! in-require? #t))
+           ((and in-require? (string=? line ")"))
+            (set! in-require? #f))
+           (in-require?
+            (let* ((requirement (string-split line #\space))
+                   ;; Modules should be unquoted
+                   (module-path (string-delete #\" (car requirement)))
+                   (version (list-ref requirement 1)))
+              (set! requirements (acons module-path version requirements))))
+           ((string-prefix? "replace" line)
+            (let* ((requirement (string-split line #\space))
+                   (module-path (list-ref requirement 1))
+                   (new-module-path (list-ref requirement 3))
+                   (version (list-ref requirement 4)))
+              (set! requirements (assoc-remove! requirements module-path))
+              (set! requirements (acons new-module-path version requirements))))))
+        requirements))))
+
+(define (module-path-without-major-version module-path)
+  "Go modules can be appended with a major version indicator,
+e.g. /v3. Sometimes it is desirable to work with the root module path. For
+instance, for a module path github.com/foo/bar/v3 this function returns
+github.com/foo/bar."
+  (let ((m (string-match "(.*)\\/v[0-9]+$" module-path)))
+    (if m
+        (match:substring m 1)
+        module-path)))
+
+(define (infer-module-root module-path)
+  "Go modules can be defined at any level of a repository's tree, but querying
+for the meta tag usually can only be done at the webpage at the root of the
+repository. Therefore, it is sometimes necessary to try and derive a module's
+root path from its path. For a set of well-known forges, the pattern of what
+consists of a module's root page is known before hand."
+  ;; 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
+  (define-record-type <scs>
+    (make-scs url-prefix root-regex type)
+    scs?
+    (url-prefix	scs-url-prefix)
+    (root-regex scs-root-regex)
+    (type	scs-type))
+  (let* ((known-scs
+          (list
+           (make-scs
+            "github.com"
+            "^(github\\.com/[A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+)(/[A-Za-z0-9_.\\-]+)*$"
+            'git)
+           (make-scs
+            "bitbucket.org"
+            "^(bitbucket\\.org/([A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+))(/[A-Za-z0-9_.\\-]+)*$`"
+            'unknown)
+           (make-scs
+            "hub.jazz.net/git/"
+            "^(hub\\.jazz\\.net/git/[a-z0-9]+/[A-Za-z0-9_.\\-]+)(/[A-Za-z0-9_.\\-]+)*$"
+            'git)
+           (make-scs
+            "git.apache.org"
+            "^(git\\.apache\\.org/[a-z0-9_.\\-]+\\.git)(/[A-Za-z0-9_.\\-]+)*$"
+            'git)
+           (make-scs
+            "git.openstack.org"
+            "^(git\\.openstack\\.org/[A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+)(\\.git)?(/[A-Za-z0-9_.\\-]+)*$"
+            'git)))
+         (scs (find (lambda (scs) (string-prefix? (scs-url-prefix scs) module-path))
+                    known-scs)))
+    (if scs
+        (match:substring (string-match (scs-root-regex scs) module-path) 1)
+        module-path)))
+
+(define (to-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
+                    ;; Guix has its own field for version
+                    (module-path-without-major-version module-path)
+                    "." "-")
+                   "/" "-"))))
+
+(define (fetch-module-meta-data module-path)
+  "Fetches module meta-data from a module's landing page. This is necessary
+because goproxy servers don't currently provide all the information needed to
+build a package."
+  (let* ((port (http-fetch (string->uri (format #f "https://~a?go-get=1" module-path))))
+         (module-metadata #f)
+         (meta-tag-prefix "<meta name=\"go-import\" content=\"")
+         (meta-tag-prefix-length (string-length meta-tag-prefix)))
+    (do ((line (read-line port) (read-line port)))
+        ((or (eof-object? line)
+             module-metadata))
+      (let ((meta-tag-index (string-contains line meta-tag-prefix)))
+        (when meta-tag-index
+          (let* ((start (+ meta-tag-index meta-tag-prefix-length))
+                 (end (string-index line #\" start)))
+            (set! module-metadata
+              (string-split (substring/shared line start end) #\space))))))
+    (close-port port)
+    module-metadata))
+
+(define (module-meta-data-scs meta-data)
+  "Return the source control system specified by a module's meta-data."
+  (string->symbol (list-ref meta-data 1)))
+
+(define (module-meta-data-repo-url meta-data goproxy-url)
+  "Return the URL where the fetcher which will be used can download the source
+control."
+  (if (member (module-meta-data-scs meta-data) '(fossil mod))
+      goproxy-url
+      (list-ref meta-data 2)))
+
+(define (source-uri scs-type scs-repo-url file)
+  "Generate the `origin' block of a package depending on what type of source
+control system is being used."
+  (case scs-type
+    ((git)
+     `(origin
+        (method git-fetch)
+        (uri (git-reference
+              (url ,scs-repo-url)
+              (commit (string-append "v" version))))
+        (file-name (git-file-name name version))
+        (sha256
+         (base32
+          ,(guix-hash-url file)))))
+    ((hg)
+     `(origin
+        (method hg-fetch)
+        (uri (hg-reference
+              (url ,scs-repo-url)
+              (changeset ,version)))
+        (file-name (format #f "~a-~a-checkout" name version))))
+    ((svn)
+     `(origin
+        (method svn-fetch)
+        (uri (svn-reference
+              (url ,scs-repo-url)
+              (revision (string->number version))
+              (recursive? #f)))
+        (file-name (format #f "~a-~a-checkout" name version))
+        (sha256
+         (base32
+          ,(guix-hash-url file)))))
+    (else
+     (raise-exception (format #f "unsupported scs type: ~a" scs-type)))))
+
+(define* (go-module->guix-package module-path #:key (goproxy-url "https://proxy.golang.org"))
+  (call-with-temporary-output-file
+   (lambda (temp port)
+     (let* ((latest-version (fetch-latest-version goproxy-url module-path))
+            (go.mod-path (fetch-go.mod goproxy-url module-path latest-version
+                                       temp))
+            (dependencies (map car (parse-go.mod temp)))
+            (guix-name (to-guix-package-name module-path))
+            (root-module-path (infer-module-root module-path))
+            ;; SCS 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))
+            (scs-type (module-meta-data-scs meta-data))
+            (scs-repo-url (module-meta-data-repo-url meta-data goproxy-url)))
+       (values
+        `(package
+           (name ,guix-name)
+           ;; Elide the "v" prefix Go uses
+           (version ,(string-trim latest-version #\v))
+           (source
+            ,(source-uri scs-type scs-repo-url temp))
+           (build-system go-build-system)
+           ,@(maybe-inputs (map to-guix-package-name dependencies))
+           ;; TODO(katco): It would be nice to make an effort to fetch this
+           ;; from known forges, e.g. GitHub
+           (home-page ,(format #f "https://~a" root-module-path))
+           (synopsis "A Go package")
+           (description ,(format #f "~a is a Go package." guix-name))
+           (license #f))
+        dependencies)))))
+
+(define* (go-module-recursive-import package-name
+                                     #:key (goproxy-url "https://proxy.golang.org"))
+  (recursive-import package-name #f
+                    #:repo->guix-package
+                    (lambda (name _)
+                      (go-module->guix-package name
+                                               #:goproxy-url goproxy-url))
+                    #:guix-name to-guix-package-name))
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 0a3863f965..1d2b45d942 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 0000000000..000039769c
--- /dev/null
+++ b/guix/scripts/import/go.scm
@@ -0,0 +1,118 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Katherine Cox-Buday <[email-masked]>
+;;;
+;;; 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~%"))))))
-- 
2.28.0

-- 
Katherine