Re: [PATCH 0/1] Go importer

[Leo Famulari <leo@famulari.name>]

[-- Attachment #1.1: Type: text/plain, Size: 2491 bytes --]

On Mon, Jun 04, 2018 at 10:18:53AM +0200, Pierre-Antoine Rouby wrote:
> Attached an update of importer.

Thanks! I'm sorry my response is so late.

> From 3e9b4fa12811432fdd7a4d6330f9093dcc72d25a Mon Sep 17 00:00:00 2001
> From: Rouby Pierre-Antoine <pierre-antoine.rouby@inria.fr>
> Date: Thu, 26 Apr 2018 15:05:23 +0200
> Subject: [PATCH] import: Add gopkg importer.
> 
> * guix/import/gopkg.scm: New file.
> * guix/scripts/import/gopkg.scm: New file.
> * guix/scripts/import.scm: Add 'gopkg'.
> * Makefile.am: Add 'gopkg' importer in modules list.

I wonder which of the new files needs to be added to Makefile.am? My
Autotools knowledge is not very strong...

> +(define (get-new-tmp-dir)
> +  "Return new temp directory."
> +  (let ((tmp "/tmp/guix-import-gopkg"))
> +    (define (new num)
> +      (let ((new-dir (string-append tmp "-" (number->string num))))
> +        (if (file-exists? new-dir)
> +            (new (+ num 1))
> +            new-dir)))
> +    (if (file-exists? tmp)
> +        (new 0)
> +        tmp)))
> +
> +(define tmp-dir (get-new-tmp-dir))

I noticed a couple issues with this code. First, the names of the
temporary directories are predictable (they use an incrementing
integer). Second, the temporary files are not deleted after the importer
runs. I've attached a modified patch that addresses this by using ((guix
utils) call-with-temporary-directory), which should address these
problems. [0]

> +(define* (git-fetch url commit directory
> +                    #:key (git-command "git") recursive?)
> +  "Fetch COMMIT from URL into DIRECTORY.  COMMIT must be a valid Git commit
> +identifier.  When RECURSIVE? is true, all the sub-modules of URL are fetched,
> +recursively.  Return #t on success, #f otherwise."
> +  ;; Disable TLS certificate verification.  The hash of the checkout is known
> +  ;; in advance anyway.
> +  (setenv "GIT_SSL_NO_VERIFY" "true")

My patch turns certificate verification back on. When importing, the
hash of the checkout is not known in advance.

And finally I added some brief documentation to the manual. Maybe there
could be further clean-up and code deduplication with other parts of the
Guix codebase, but I think it's better to have this importer in Guix
now.

What do you think of my patch? Does it still work for you?

[0] Actually, the temp directories will not be cleaned up due to
<https://bugs.gnu.org/32126>, but I think this will eventually be fixed.

[-- Attachment #1.2: 0001-import-Add-gopkg-importer.patch --]
[-- Type: text/plain, Size: 21413 bytes --]

From 50c12ff1770286fae00dac469cad3af4a9df1070 Mon Sep 17 00:00:00 2001
From: Rouby Pierre-Antoine <pierre-antoine.rouby@inria.fr>
Date: Thu, 26 Apr 2018 15:05:23 +0200
Subject: [PATCH] import: Add gopkg importer.

* guix/import/gopkg.scm: New file.
* guix/scripts/import/gopkg.scm: New file.
* guix/scripts/import.scm: Add 'gopkg'.
* Makefile.am: Add 'gopkg' importer in modules list.

Co-authored-by: Leo Famulari <leo@famulari.name>
---
 Makefile.am                   |   1 +
 doc/guix.texi                 |   9 +-
 guix/import/gopkg.scm         | 352 ++++++++++++++++++++++++++++++++++
 guix/scripts/import.scm       |   2 +-
 guix/scripts/import/gopkg.scm |  99 ++++++++++
 5 files changed, 461 insertions(+), 2 deletions(-)
 create mode 100644 guix/import/gopkg.scm
 create mode 100644 guix/scripts/import/gopkg.scm

diff --git a/Makefile.am b/Makefile.am
index 618d1653e..a93a280b2 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -186,6 +186,7 @@ MODULES =					\
   guix/import/hackage.scm			\
   guix/import/elpa.scm   			\
   guix/import/texlive.scm   			\
+  guix/import/gopkg.scm   			\
   guix/scripts.scm				\
   guix/scripts/download.scm			\
   guix/scripts/perform-download.scm		\
diff --git a/doc/guix.texi b/doc/guix.texi
index a8e53a530..07100cd25 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -20,7 +20,7 @@ Copyright @copyright{} 2014, 2015, 2016 Alex Kost@*
 Copyright @copyright{} 2015, 2016 Mathieu Lirzin@*
 Copyright @copyright{} 2014 Pierre-Antoine Rault@*
 Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@*
-Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@*
+Copyright @copyright{} 2015, 2016, 2017, 2018 Leo Famulari@*
 Copyright @copyright{} 2015, 2016, 2017, 2018 Ricardo Wurmus@*
 Copyright @copyright{} 2016 Ben Woodcroft@*
 Copyright @copyright{} 2016, 2017, 2018 Chris Marusich@*
@@ -6667,6 +6667,13 @@ Import metadata from the crates.io Rust package repository
 @cindex OCaml
 Import metadata from the @uref{https://opam.ocaml.org/, OPAM} package
 repository used by the OCaml community.
+
+@item gopkg
+@cindex gopkg
+@cindex Golang
+@cindex Go
+Import metadata from the @uref{https://gopkg.in/, gopkg} package
+versioning service used by some Go software.
 @end table
 
 The structure of the @command{guix import} code is modular.  It would be
diff --git a/guix/import/gopkg.scm b/guix/import/gopkg.scm
new file mode 100644
index 000000000..c2b72616a
--- /dev/null
+++ b/guix/import/gopkg.scm
@@ -0,0 +1,352 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
+;;;
+;;; 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 gopkg)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module ((ice-9 rdelim) #:select (read-line))
+  #:use-module (srfi srfi-11)
+  #:use-module (texinfo string-utils) ; transform-string
+  #:use-module (guix hash)
+  #:use-module (guix base32)
+  #:use-module (guix serialization)
+  #:use-module (guix utils)
+  #:use-module (guix build utils)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:export (gopkg->guix-package))
+
+(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 (file->hash-base32 file)
+  "Return hash of FILE in nix base32 sha256 format.  If FILE is a directory,
+exclude vcs files."
+  (let-values (((port get-hash) (open-sha256-port)))
+    (write-file file port #:select? (negate vcs-file?))
+    (force-output port)
+    (bytevector->nix-base32-string (get-hash))))
+
+(define (git->hash url commit file)
+  "Clone git repository and return FILE hash in nix base32 sha256 format."
+  (if (not (file-exists? file))
+      (git-fetch url commit file #:recursive? #f))
+  (file->hash-base32 file))
+
+(define (git-ref->commit path tag)
+  "Return commit number coresponding to git TAG.  Return \"XXX\" if tag is not
+found."
+  (define (loop port)
+    (let ((line (read-line port)))
+      (cond
+       ((eof-object? line)              ; EOF
+        (begin
+          (close-port port)
+          "XXX"))
+       ((string-match tag line)         ; Match tag
+        (let ((commit (car (string-split (transform-string line #\tab " ")
+                                         #\ ))))
+          commit))
+       (else                            ; Else
+        (loop port)))))
+
+  (let ((file (if (file-exists? (string-append path "/.git/packed-refs"))
+                  (string-append path "/.git/packed-refs")
+                  (string-append path "/.git/FETCH_HEAD"))))
+    (loop (open-input-file file))))
+
+(define* (git-fetch url commit directory
+                    #:key (git-command "git") recursive?)
+  "Fetch COMMIT from URL into DIRECTORY.  COMMIT must be a valid Git commit
+identifier.  When RECURSIVE? is true, all the sub-modules of URL are fetched,
+recursively.  Return #t on success, #f otherwise."
+  (mkdir-p directory)
+
+  (with-directory-excursion directory
+    (invoke git-command "init")
+    (invoke git-command "remote" "add" "origin" url)
+    (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit))
+        (invoke git-command "checkout" "FETCH_HEAD")
+        (begin
+          (invoke git-command "fetch" "origin")
+          (if (not (zero? (system* git-command "checkout" commit)))
+              (let ((commit-hash (git-ref->commit directory commit)))
+                (invoke git-command "checkout" "master")
+                (if (not (equal? "XXX" commit-hash)) ;HACK else stay on master
+                    (zero? (system* git-command "checkout" commit-hash))))
+              #t)))))
+
+;;
+;; Append attributes.
+;;
+
+(define (append-inputs inputs name)
+  "Return list with new input corresponding to package NAME."
+  (let ((unquote-name (list 'unquote (string->symbol name))))
+    (append inputs (list (list name unquote-name)))))
+
+;;
+;; Parse attributes.
+;;
+
+(define (url->package-name url)
+  "Compute URL and return package name."
+  (let* ((url-no-slash (string-replace-substring url "/" "-"))
+         (url-no-slash-no-dot (string-replace-substring url-no-slash
+                                                        "." "-")))
+    (string-downcase (string-append "go-" url-no-slash-no-dot))))
+
+(define (cut-url url)
+  "Return URL without protocol prefix and git file extension."
+  (string-replace-substring
+   (cond
+    ((string-match "http://"  url)
+     (string-replace-substring url "http://" ""))
+    ((string-match "https://" url)
+     (string-replace-substring url "https://" ""))
+    ((string-match "git://"   url)
+     (string-replace-substring url "git://" ""))
+    (else
+     url))
+   ".git" ""))
+
+(define (url->dn url)
+  "Return the web site DN form url 'gnu.org/software/guix' --> 'gnu.org'"
+  (car (string-split url #\/)))
+
+(define (url->git-url url)
+  (string-append "https://" url ".git"))
+
+(define (comment? line)
+  "Return #t if LINE start with comment delimiter, else return #f."
+  (eq? (string-ref (string-trim line) 0) #\#))
+
+(define (empty-line? line)
+  "Return #t if LINE is empty, else #f."
+  (string-null? (string-trim line)))
+
+(define (attribute? line attribute)
+  "Return #t if LINE contain ATTRIBUTE."
+  (equal? (string-trim-right
+           (string-trim
+            (car (string-split line #\=)))) attribute))
+
+(define (attribute-by-name line name)
+  "Return attribute value corresponding to NAME."
+  (let* ((line-no-attribut-name (string-replace-substring
+                                 line
+                                 (string-append name " = ") ""))
+         (value-no-double-quote (string-replace-substring
+                                 line-no-attribut-name
+                                 "\"" "")))
+    (string-trim value-no-double-quote)))
+
+;;
+;; Packages functions.
+;;
+
+(define (make-go-sexp->package packages dependencies
+                               name url version revision
+                               commit str-license home-page
+                               git-url is-dep? hash)
+  "Create Guix sexp package for Go software NAME. Return new package sexp."
+  (define (package-inputs)
+    (if (not is-dep?)
+        `((native-inputs ,(list 'quasiquote dependencies)))
+        '()))
+
+  (values
+   `(define-public ,(string->symbol name)
+      (let ((commit ,commit)
+            (revision ,revision))
+        (package
+          (name ,name)
+          (version (git-version ,version revision commit))
+          (source (origin
+                    (method git-fetch)
+                    (uri (git-reference
+                          (url ,git-url)
+                          (commit commit)))
+                    (file-name (git-file-name name version))
+                    (sha256
+                     (base32
+                      ,hash))))
+          (build-system go-build-system)
+          (arguments
+           '(#:import-path ,url))
+          ,@(package-inputs)
+          (home-page ,home-page)
+          (synopsis "XXX")
+          (description "XXX")
+          (license #f))))))
+
+(define (create-package->packages+dependencies packages dependencies
+                                               url version directory
+                                               revision commit
+                                               constraint? is-dep?)
+  "Return packages and dependencies with new package sexp corresponding to
+URL."
+  (let ((name (url->package-name url))
+        (home-page (string-append "https://" url))
+        (git-url (url->git-url url))
+        (synopsis "XXX")
+        (description "XXX")
+        (license "XXX"))
+    (let ((hash (git->hash (url->git-url url)
+                           commit
+                           directory))
+          (commit-hash (if (< (string-length commit) 40)
+                           (git-ref->commit directory
+                                            commit)
+                           commit)))
+      (values
+       (append packages
+               (list
+                (make-go-sexp->package packages dependencies
+                                       name url version
+                                       revision commit-hash
+                                       license home-page
+                                       git-url is-dep? hash)))
+       (if constraint?
+           (append-inputs dependencies name)
+           dependencies)))))
+
+(define (parse-dependencies->packages+dependencies port constraint?
+                                                   packages dependencies)
+  "Parse one dependencies in PORT, and return packages and dependencies list."
+  (let ((url "XXX")
+        (version "0.0.0")
+        (revision "0")
+        (commit "XXX"))
+    (define (loop port url commit packages dependencies)
+      (let ((line (read-line port)))
+        (cond
+         ((eof-object? line)            ; EOF
+          (values packages dependencies))
+         ((empty-line? line)                               ; Empty line
+          (if (not (or (equal? "k8s.io" (url->dn url))     ; HACK bypass k8s
+                       (equal? "golang.org" (url->dn url)) ; HACK bypass golang
+                       (equal? "cloud.google.com" (url->dn url)))) ; HACK bypass cloud.google
+              (create-package->packages+dependencies packages dependencies
+                                                     url version port revision
+                                                     commit
+                                                     constraint? #t)
+              (values packages dependencies)))
+         ((comment? line)               ; Comment
+          (loop port url commit
+                packages dependencies))
+         ((attribute? line "name")      ; Name
+          (loop port
+                (attribute-by-name line "name")
+                commit
+                packages dependencies))
+         ((attribute? line "revision")  ; Revision
+          (loop port
+                url
+                (attribute-by-name line "revision")
+                packages dependencies))
+         ((attribute? line "version")   ; Version
+          (loop port
+                url
+                (attribute-by-name line "version")
+                packages dependencies))
+         ((attribute? line "branch")    ; Branch
+          (loop port
+                url
+                (attribute-by-name line "branch")
+                packages dependencies))
+         ((string-match "=" line)       ; Other options
+          (loop port url commit
+                packages dependencies))
+         (else (loop port url commit
+                     packages dependencies)))))
+    (loop port url commit
+          packages dependencies)))
+
+(define (parse-toml->packages+dependencies port packages dependencies)
+  "Read toml file on PORT and return all dependencies packages sexp and list
+of constraint dependencies."
+  (define (loop port packages dependencies)
+    (let ((line (read-line port)))
+      (cond
+       ((eof-object? line)              ; EOF
+        (values packages dependencies))
+       ((empty-line? line)              ; Empty line
+        (loop port packages dependencies))
+       ((comment? line)                 ; Comment
+        (loop port packages dependencies))
+       ((equal? line "[prune]")         ; Ignored
+        (loop port packages dependencies))
+       ((equal? "[[constraint]]" line)  ; Direct dependencies
+        (let-values (((packages dependencies)
+                      (parse-dependencies->packages+dependencies port #t
+                                                                 packages
+                                                                 dependencies)))
+          (loop port packages dependencies)))
+       ((equal? "[[override]]" line)    ; Dependencies of dependencies
+        (let-values (((packages dependencies)
+                      (parse-dependencies->packages+dependencies port #f
+                                                                 packages
+                                                                 dependencies)))
+          (loop port packages dependencies)))
+       (else (loop port packages dependencies)))))
+  (loop port packages dependencies))
+
+(define (gopkg-dep->packages+dependencies path)
+  "Open toml file if exist and parse it and return packages sexp and
+dependencies list. Or return two empty list if file not found."
+  (if (file-exists? path)
+      (let ((port (open-input-file path)))
+        (let-values (((packages dependencies)
+                      (parse-toml->packages+dependencies port
+                                                         '() '())))
+          (close-port port)
+          (values packages dependencies)))
+      (values '() '())))
+
+;;
+;; Entry point.
+;;
+
+(define (gopkg->guix-package url branch)
+  "Create package for git repository dans branch verison and all dependencies
+sexp packages with Gopkg.toml file."
+  (let ((name (url->package-name (cut-url url)))
+        (version "0.0.0")
+        (revision "0"))
+    (call-with-temporary-directory
+      (lambda (directory)
+        (git-fetch url branch directory #:recursive? #f)
+
+        (let-values (((packages dependencies)
+                      (gopkg-dep->packages+dependencies
+                        (string-append directory
+                                       "/Gopkg.toml"))))
+          (let-values (((packages dependencies)
+                        (create-package->packages+dependencies packages dependencies
+                                                               (cut-url url) version
+                                                               directory
+                                                               revision branch
+                                                               #f #f)))
+                      (values packages)))))))
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 0b326e104..56b34971e 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -75,7 +75,7 @@ rather than \\n."
 ;;;
 
 (define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem"
-                    "cran" "crate" "texlive" "json" "opam"))
+                    "cran" "crate" "texlive" "json" "opam" "gopkg"))
 
 (define (resolve-importer name)
   (let ((module (resolve-interface
diff --git a/guix/scripts/import/gopkg.scm b/guix/scripts/import/gopkg.scm
new file mode 100644
index 000000000..9a39e58d7
--- /dev/null
+++ b/guix/scripts/import/gopkg.scm
@@ -0,0 +1,99 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
+;;;
+;;; 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 gopkg)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:use-module (guix scripts)
+  #:use-module (guix import gopkg)
+  #: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-gopkg))
+
+\f
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  '())
+
+(define (show-help)
+  (display (G_ "Usage: guix import gopkg PACKAGE-URL BRANCH
+Import and convert the Git repository with TOML file to a Guix package
+using PACKAGE-URL and matching BRANCH.\n"))
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (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 gopkg")))
+         %standard-import-options))
+
+\f
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-import-gopkg . 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
+      ((package-url branch)
+       (let ((sexp (gopkg->guix-package package-url branch)))
+         (unless sexp
+           (leave (G_ "failed to download meta-data for package '~a'~%")
+                  package-url))
+         sexp))
+      ((package-url)
+       (let ((sexp (gopkg->guix-package package-url "master")))
+         (unless sexp
+           (leave (G_ "failed to download meta-data for package '~a'~%")
+                  package-url))
+         sexp))
+      (()
+       (leave (G_ "too few arguments~%")))
+      ((many ...)
+       (leave (G_ "too many arguments~%"))))))
-- 
2.18.0


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]