From 4092d51202e0060fa08fe87dbae1274c4b4aeed2 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 20 Nov 2018 23:11:29 -0500 Subject: [PATCH 1/3] Add (guix bzr-download). * guix/bzr-download.scm, guix/build/bzr.scm, etc/snippets/scheme-mode/guix-bzr-reference: New files. * Makefile.am (MODULES): Add them. * etc/snippets/scheme-mode/guix-origin: Add "bzr-fetch" to the origin choices. --- Makefile.am | 2 + etc/snippets/scheme-mode/guix-bzr-reference | 7 ++ etc/snippets/scheme-mode/guix-origin | 6 +- guix/build/bzr.scm | 44 +++++++++++ guix/bzr-download.scm | 87 +++++++++++++++++++++ 5 files changed, 144 insertions(+), 2 deletions(-) create mode 100644 etc/snippets/scheme-mode/guix-bzr-reference create mode 100644 guix/build/bzr.scm create mode 100644 guix/bzr-download.scm diff --git a/Makefile.am b/Makefile.am index c63b65ba5..2b599217e 100644 --- a/Makefile.am +++ b/Makefile.am @@ -72,6 +72,7 @@ MODULES = \ guix/modules.scm \ guix/download.scm \ guix/discovery.scm \ + guix/bzr-download.scm \ guix/git-download.scm \ guix/hg-download.scm \ guix/monads.scm \ @@ -145,6 +146,7 @@ MODULES = \ guix/build/font-build-system.scm \ guix/build/go-build-system.scm \ guix/build/asdf-build-system.scm \ + guix/build/bzr.scm \ guix/build/git.scm \ guix/build/hg.scm \ guix/build/glib-or-gtk-build-system.scm \ diff --git a/etc/snippets/scheme-mode/guix-bzr-reference b/etc/snippets/scheme-mode/guix-bzr-reference new file mode 100644 index 000000000..a801cc36f --- /dev/null +++ b/etc/snippets/scheme-mode/guix-bzr-reference @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: guix-bzr-reference +# key: bzr-reference... +# -- +(bzr-reference + (url "$1") + (revision ${2:ref})) \ No newline at end of file diff --git a/etc/snippets/scheme-mode/guix-origin b/etc/snippets/scheme-mode/guix-origin index 1a068f885..2820a369f 100644 --- a/etc/snippets/scheme-mode/guix-origin +++ b/etc/snippets/scheme-mode/guix-origin @@ -9,15 +9,17 @@ "cvs-fetch" "git-fetch" "hg-fetch" - "svn-fetch")}) + "svn-fetch" + "bzr-fetch")}) (uri ${1:$(cond ((equal yas-text "git-fetch") "git-reference...") ((equal yas-text "svn-fetch") "svn-reference...") ((equal yas-text "hg-fetch") "hg-reference...") ((equal yas-text "cvs-fetch") "cvs-reference...") + ((equal yas-text "bzr-fetch") "bzr-reference...") (t "(string-append \\"https://\\" version \\".tar.gz\\")"))}$0) ${1:$(cond ((equal yas-text "git-fetch") "(file-name (git-file-name name version))") - ((member yas-text '("svn-fetch" "hg-fetch" "cvs-fetch")) + ((member yas-text '("svn-fetch" "hg-fetch" "cvs-fetch" "bzr-fetch")) "(file-name (string-append name \\"-\\" version \\"-checkout\\"))") (t ""))} (sha256 diff --git a/guix/build/bzr.scm b/guix/build/bzr.scm new file mode 100644 index 000000000..31639e440 --- /dev/null +++ b/guix/build/bzr.scm @@ -0,0 +1,44 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Maxim Cournoyer +;;; +;;; 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 . + +(define-module (guix build bzr) + #:use-module (guix build utils) + #:export (bzr-fetch)) + +;;; Commentary: +;;; +;;; This is the build-side support code of (guix bzr-download). It allows a +;;; Bazaar repository to be branched at a specific revision. +;;; +;;; Code: + +(define* (bzr-fetch url revision directory + #:key (bzr-command "bzr")) + "Fetch REVISION from URL into DIRECTORY. REVISION must be a valid Bazaar +revision identifier. Return #t on success, #f otherwise." + ;; Do not attempt to write .bzr.log to $HOME, which doesn't exist. + (setenv "BZR_LOG" "/dev/null") + ;; Disable SSL certificate verification; we rely on the hash instead. + (and (zero? (system* bzr-command "-Ossl.cert_reqs=none" "checkout" + "--lightweight" "-r" revision url directory)) + (with-directory-excursion directory + (begin + (delete-file-recursively ".bzr") + #t)))) + +;;; bzr.scm ends here diff --git a/guix/bzr-download.scm b/guix/bzr-download.scm new file mode 100644 index 000000000..e990d9de1 --- /dev/null +++ b/guix/bzr-download.scm @@ -0,0 +1,87 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Maxim Cournoyer +;;; +;;; 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 . + +(define-module (guix bzr-download) + #:use-module (guix gexp) + #:use-module (guix modules) ;for 'source-module-closure' + #:use-module (guix monads) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix store) + + #:export (bzr-reference + bzr-reference? + bzr-reference-url + bzr-reference-revision + + bzr-fetch)) + +;;; Commentary: +;;; +;;; An method that fetches a specific revision from a Bazaar +;;; repository. The repository URL and revision identifier are specified with +;;; a object. +;;; +;;; Code: + +(define-record-type* + bzr-reference make-bzr-reference + bzr-reference? + (url bzr-reference-url) + (revision bzr-reference-revision)) + +(define (bzr-package) + "Return the default Bazaar package." + (let ((distro (resolve-interface '(gnu packages version-control)))) + (module-ref distro 'bazaar))) + +(define* (bzr-fetch ref hash-algo hash + #:optional name + #:key (system (%current-system)) (guile (default-guile)) + (bzr (bzr-package))) + "Return a fixed-output derivation that fetches REF, a +object. The output is expected to have recursive hash HASH of type +HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." + (define build + (with-imported-modules (source-module-closure + '((guix build bzr))) + #~(begin + (use-modules (guix build bzr)) + (bzr-fetch + (getenv "bzr url") (getenv "bzr reference") #$output + #:bzr-command (string-append #+bzr "/bin/bzr"))))) + + (mlet %store-monad ((guile (package->derivation guile system))) + (gexp->derivation (or name "bzr-branch") build + + ;; Use environment variables and a fixed script name so + ;; there's only one script in store for all the + ;; downloads. + #:script-name "bzr-download" + #:env-vars + `(("bzr url" . ,(bzr-reference-url ref)) + ("bzr reference" . ,(bzr-reference-revision ref))) + + #:system system + #:local-build? #t ;don't offload repo branching + #:hash-algo hash-algo + #:hash hash + #:recursive? #t + #:guile-for-build guile))) + +;;; bzr-download.scm ends here -- 2.19.0