diff options
| -rw-r--r-- | Makefile.am | 10 | ||||
| -rw-r--r-- | doc/guix.texi | 9 | ||||
| -rw-r--r-- | guix/import/gopkg.scm | 356 | ||||
| -rw-r--r-- | guix/scripts/import.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/import/gopkg.scm | 99 |
5 files changed, 470 insertions, 6 deletions
diff --git a/Makefile.am b/Makefile.am index 1acf0b12d0..ab67221905 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 \ diff --git a/doc/guix.texi b/doc/guix.texi index 12346c4b8e..1112b81e5f 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@* @@ -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 diff --git a/guix/import/gopkg.scm b/guix/import/gopkg.scm new file mode 100644 index 0000000000..204bf18abb --- /dev/null +++ b/guix/import/gopkg.scm @@ -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))))))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 0b326e1049..56b34971e3 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 0000000000..9a39e58d78 --- /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)) + + +;;; +;;; 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~%")))))) |