bartronx7/guix
1
0
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2026-01-25 03:55:08 -06:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: Add Go importer

Browse source
This commit is contained in:
Pierre Neidhardt 2018-10-17 15:38:21 +02:00
parent d0a7961e14
commit 58d5f8fbc2
No known key found for this signature in database
GPG key ID: 9BDCF497A4BBCC7F
5 changed files with 470 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
Makefile.am
View file

@ -188,8 +188,9 @@ MODULES = \
guix/import/cabal.scm \
guix/import/cran.scm \
guix/import/hackage.scm \
guix/import/elpa.scm \
guix/import/texlive.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 \
@ -214,8 +215,9 @@ MODULES = \
guix/scripts/import/gnu.scm \
guix/scripts/import/nix.scm \
guix/scripts/import/hackage.scm \
guix/scripts/import/elpa.scm \
guix/scripts/import/texlive.scm \
guix/scripts/import/elpa.scm \
guix/scripts/import/texlive.scm \
guix/scripts/import/gopkg.scm \
guix/scripts/environment.scm \
guix/scripts/publish.scm \
guix/scripts/edit.scm \

9
doc/guix.texi
View file

@ -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@*
@ -7179,6 +7179,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

356
guix/import/gopkg.scm Normal file
View file

@ -0,0 +1,356 @@
;;; 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 (gcrypt hash)
;; #: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)
;; TODO: Factorize
(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? (string-append file "/.git")))
(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."
(call-with-temporary-directory
(lambda (dir)
(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
dir))
(commit-hash (if (< (string-length commit) 40)
(git-ref->commit dir
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)))))))

2
guix/scripts/import.scm
View file

@ -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

99
guix/scripts/import/gopkg.scm Normal file
View file

@ -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))
;;;
;;; 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))
;;;
;;; 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~%"))))))