summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2019-08-08 00:35:37 +0200
committerMarius Bakke <mbakke@fastmail.com>2019-08-08 00:35:37 +0200
commit8e7f97b9ffee10af3cf16958ebc0a7d410a19ca8 (patch)
treeb3836f9cea849fd8bfb61a77ba225a0054babe58 /guix
parentfa228db78bc9dcb0e7da607dd8783224c76d7ef5 (diff)
parentba7ff983d613f735ee270f0b0e3c5dba5cbeda3c (diff)
Merge branch 'master' into staging
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/texlive.scm15
-rw-r--r--guix/build/svn.scm9
-rw-r--r--guix/scripts/deploy.scm6
-rw-r--r--guix/scripts/system/reconfigure.scm20
-rw-r--r--guix/svn-download.scm59
5 files changed, 93 insertions, 16 deletions
diff --git a/guix/build-system/texlive.scm b/guix/build-system/texlive.scm
index b6a86a1c62..ad99d1e2d0 100644
--- a/guix/build-system/texlive.scm
+++ b/guix/build-system/texlive.scm
@@ -30,6 +30,7 @@
texlive-build
texlive-build-system
texlive-ref
+ texlive-origin
%texlive-tag
%texlive-revision))
@@ -44,6 +45,20 @@
(define %texlive-tag "texlive-2018.2")
(define %texlive-revision 49435)
+(define (texlive-origin name version locations hash)
+ "Return an <origin> object for a TeX Live package consisting of multiple
+LOCATIONS with a provided HASH. Use NAME and VERSION to compute a prettier
+name for the checkout directory."
+ (origin
+ (method svn-multi-fetch)
+ (uri (svn-multi-reference
+ (url (string-append "svn://www.tug.org/texlive/tags/"
+ %texlive-tag "/Master/texmf-dist/"))
+ (locations locations)
+ (revision %texlive-revision)))
+ (file-name (string-append name "-" version "-checkout"))
+ (sha256 hash)))
+
(define (texlive-ref component id)
"Return a <svn-reference> object for the package ID, which is part of the
given Texlive COMPONENT."
diff --git a/guix/build/svn.scm b/guix/build/svn.scm
index 913f89471b..e3188add3e 100644
--- a/guix/build/svn.scm
+++ b/guix/build/svn.scm
@@ -36,7 +36,7 @@
"Fetch REVISION from URL into DIRECTORY. REVISION must be an integer, and a
valid Subversion revision. Return #t on success, #f otherwise."
(apply invoke svn-command
- "checkout" "--non-interactive"
+ "export" "--non-interactive"
;; Trust the server certificate. This is OK as we
;; verify the checksum later. This can be removed when
;; ca-certificates package is added.
@@ -46,13 +46,6 @@ valid Subversion revision. Return #t on success, #f otherwise."
(string-append "--password=" password))
'())
,url ,directory))
-
- ;; The contents of '.svn' vary as a function of the current status
- ;; of the repo. Since we want a fixed output, this directory needs
- ;; to be taken out.
- (with-directory-excursion directory
- (for-each delete-file-recursively (find-files "." "^\\.svn$" #:directories? #t)))
-
#t)
;;; svn.scm ends here
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 52bba3f3bf..ebc99e52cc 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -19,6 +19,7 @@
(define-module (guix scripts deploy)
#:use-module (gnu machine)
+ #:use-module (guix discovery)
#:use-module (guix scripts)
#:use-module (guix scripts build)
#:use-module (guix store)
@@ -74,7 +75,10 @@ Perform the deployment specified by FILE.\n"))
(define (load-source-file file)
"Load FILE as a user module."
- (let ((module (make-user-module '((gnu) (gnu machine) (gnu machine ssh)))))
+ (let* ((guix-path (dirname (search-path %load-path "guix.scm")))
+ (environment-modules (scheme-modules* guix-path "gnu/machine"))
+ (module (make-user-module (append '((gnu) (gnu machine))
+ environment-modules))))
(load* file module)))
(define (guix-deploy . args)
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index dee0c24bd2..579b7fffbe 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -195,21 +195,31 @@ BOOTLOADER-PACKAGE."
(srfi srfi-34)
(srfi srfi-35))
(let* ((gc-root (string-append #$target %gc-roots-directory "/bootcfg"))
- (temp-gc-root (string-append gc-root ".new")))
- (switch-symlinks temp-gc-root gc-root)
- (install-boot-config #$bootcfg #$bootcfg-file #$target)
+ (new-gc-root (string-append gc-root ".new")))
+ ;; #$bootcfg has dependencies.
+ ;; The bootloader magically loads the configuration from
+ ;; (string-append #$target #$bootcfg-file) (for example
+ ;; "/boot/grub/grub.cfg").
+ ;; If we didn't do something special, the garbage collector
+ ;; would remove the dependencies of #$bootcfg.
+ ;; Register #$bootcfg as a GC root.
;; Preserve the previous activation's garbage collector root
;; until the bootloader installer has run, so that a failure in
;; the bootloader's installer script doesn't leave the user with
;; a broken installation.
+ (switch-symlinks new-gc-root #$bootcfg)
+ (install-boot-config #$bootcfg #$bootcfg-file #$target)
(when #$installer
(catch #t
(lambda ()
(#$installer #$bootloader-package #$device #$target))
(lambda args
- (delete-file temp-gc-root)
+ (delete-file new-gc-root)
(apply throw args))))
- (rename-file temp-gc-root gc-root)))))))
+ ;; We are sure that the installation of the bootloader
+ ;; succeeded, so we can replace the old GC root by the new
+ ;; GC root now.
+ (rename-file new-gc-root gc-root)))))))
(define* (install-bootloader eval configuration bootcfg
#:key
diff --git a/guix/svn-download.scm b/guix/svn-download.scm
index c118869af1..5c25437059 100644
--- a/guix/svn-download.scm
+++ b/guix/svn-download.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
-;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -32,7 +32,14 @@
svn-reference-url
svn-reference-revision
svn-fetch
- download-svn-to-store))
+ download-svn-to-store
+
+ svn-multi-reference
+ svn-multi-reference?
+ svn-multi-reference-url
+ svn-multi-reference-revision
+ svn-multi-reference-locations
+ svn-multi-fetch))
;;; Commentary:
;;;
@@ -83,6 +90,54 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
#:guile-for-build guile
#:local-build? #t)))
+(define-record-type* <svn-multi-reference>
+ svn-multi-reference make-svn-multi-reference
+ svn-multi-reference?
+ (url svn-multi-reference-url) ; string
+ (revision svn-multi-reference-revision) ; number
+ (locations svn-multi-reference-locations) ; list of strings
+ (user-name svn-multi-reference-user-name (default #f))
+ (password svn-multi-reference-password (default #f)))
+
+(define* (svn-multi-fetch ref hash-algo hash
+ #:optional name
+ #:key (system (%current-system)) (guile (default-guile))
+ (svn (subversion-package)))
+ "Return a fixed-output derivation that fetches REF, a <svn-multi-reference>
+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 '((guix build svn)
+ (guix build utils))
+ #~(begin
+ (use-modules (guix build svn)
+ (guix build utils)
+ (srfi srfi-1))
+ (every (lambda (location)
+ ;; The directory must exist if we are to fetch only a
+ ;; single file.
+ (unless (string-suffix? "/" location)
+ (mkdir-p (string-append #$output "/" (dirname location))))
+ (svn-fetch (string-append '#$(svn-multi-reference-url ref)
+ "/" location)
+ '#$(svn-multi-reference-revision ref)
+ (if (string-suffix? "/" location)
+ (string-append #$output "/" location)
+ (string-append #$output "/" (dirname location)))
+ #:svn-command (string-append #+svn "/bin/svn")
+ #:user-name #$(svn-multi-reference-user-name ref)
+ #:password #$(svn-multi-reference-password ref)))
+ '#$(svn-multi-reference-locations ref)))))
+
+ (mlet %store-monad ((guile (package->derivation guile system)))
+ (gexp->derivation (or name "svn-checkout") build
+ #:system system
+ #:hash-algo hash-algo
+ #:hash hash
+ #:recursive? #t
+ #:guile-for-build guile
+ #:local-build? #t)))
+
(define* (download-svn-to-store store ref
#:optional (name (basename (svn-reference-url ref)))
#:key (log (current-error-port)))