nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' into core-updates

This commit is contained in:
Mark H Weaver 2016-11-07 00:33:16 -05:00
parent 19ac2ba858 14ac8e4865
commit 71e21fb26d
No known key found for this signature in database
GPG Key ID: 7CEF29847562C516
25 changed files with 656 additions and 506 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
doc/guix.texi
View File

@ -11991,8 +11991,9 @@ supported:
@table @code
@item reconfigure
Build the operating system described in @var{file}, activate it, and
switch to it@footnote{This action is usable only on systems already
running GuixSD.}.
switch to it@footnote{This action (and the related actions
@code{switch-generation} and @code{roll-back}) are usable only on
systems already running GuixSD.}.
This effects all the configuration specified in @var{file}: user
accounts, system services, global package list, setuid programs, etc.
@ -12014,6 +12015,52 @@ guix pull}). Failing to do that you would see an older version of Guix
once @command{reconfigure} has completed.
@end quotation
@item switch-generation
Switch to an existing system generation. This action atomically
switches the system profile to the specified system generation. It also
rearranges the system's existing GRUB menu entries. It makes the menu
entry for the specified system generation the default, and it moves the
entries for the other generations to a submenu. The next time the
system boots, it will use the specified system generation.
The target generation can be specified explicitly by its generation
number. For example, the following invocation would switch to system
generation 7:
@example
guix system switch-generation 7
@end example
The target generation can also be specified relative to the current
generation with the form @code{+N} or @code{-N}, where @code{+3} means
``3 generations ahead of the current generation,'' and @code{-1} means
``1 generation prior to the current generation.'' When specifying a
negative value such as @code{-1}, you must precede it with @code{--} to
prevent it from being parsed as an option. For example:
@example
guix system switch-generation -- -1
@end example
Currently, the effect of invoking this action is @emph{only} to switch
the system profile to an existing generation and rearrange the GRUB menu
entries. To actually start using the target system generation, you must
reboot after running this action. In the future, it will be updated to
do the same things as @command{reconfigure}, like activating and
deactivating services.
This action will fail if the specified generation does not exist.
@item roll-back
Switch to the preceding system generation. The next time the system
boots, it will use the preceding system generation. This is the inverse
of @command{reconfigure}, and it is exactly the same as invoking
@command{switch-generation} with an argument of @code{-1}.
Currently, as with @command{switch-generation}, you must reboot after
running this action to actually start using the preceding system
generation.
@item build
Build the derivation of the operating system, which includes all the
configuration files and programs needed to boot and run the system.

2
gnu/build/file-systems.scm
View File

@ -139,7 +139,7 @@ if DEVICE does not contain an ext2 file system."
;;;
;; The LUKS header format is described in "LUKS On-Disk Format Specification":
;; <http://wiki.cryptsetup.googlecode.com/git/LUKS-standard/>. We follow
;; <https://gitlab.com/cryptsetup/cryptsetup/wikis/Specification>. We follow
;; version 1.2.1 of this document.
(define-syntax %luks-endianness

23
gnu/build/install.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,6 +23,7 @@
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (install-grub
install-grub-config
populate-root-file-system
reset-timestamps
register-closure
@ -36,13 +38,24 @@
;;;
;;; Code:
(define* (install-grub grub.cfg device mount-point)
(define (install-grub grub.cfg device mount-point)
"Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
MOUNT-POINT.
Note that the caller must make sure that GRUB.CFG is registered as a GC root
so that the fonts, background images, etc. referred to by GRUB.CFG are not
GC'd."
(install-grub-config grub.cfg mount-point)
(unless (zero? (system* "grub-install" "--no-floppy"
"--boot-directory"
(string-append mount-point "/boot")
device))
(error "failed to install GRUB")))
(define (install-grub-config grub.cfg mount-point)
"Atomically copy GRUB.CFG into boot/grub/grub.cfg on the MOUNT-POINT. Note
that the caller must make sure that GRUB.CFG is registered as a GC root so
that the fonts, background images, etc. referred to by GRUB.CFG are not GC'd."
(let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
(pivot (string-append target ".new")))
(mkdir-p (dirname target))
@ -50,13 +63,7 @@ GC'd."
;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
;; work when /boot is on a separate partition. Do that atomically.
(copy-file grub.cfg pivot)
(rename-file pivot target)
(unless (zero? (system* "grub-install" "--no-floppy"
"--boot-directory"
(string-append mount-point "/boot")
device))
(error "failed to install GRUB"))))
(rename-file pivot target)))
(define (evaluate-populate-directive directive target)
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under

3
gnu/local.mk
View File

@ -614,7 +614,6 @@ dist_patch_DATA = \
%D%/packages/patches/ilmbase-fix-tests.patch \
%D%/packages/patches/inkscape-drop-wait-for-targets.patch \
%D%/packages/patches/isl-0.11.1-aarch64-support.patch \
%D%/packages/patches/jansson-CVE-2016-4425.patch \
%D%/packages/patches/jbig2dec-ignore-testtest.patch \
%D%/packages/patches/jq-CVE-2015-8863.patch \
%D%/packages/patches/khmer-use-libraries.patch \
@ -690,7 +689,7 @@ dist_patch_DATA = \
%D%/packages/patches/lua-pkgconfig.patch \
%D%/packages/patches/lua51-liblua-so.patch \
%D%/packages/patches/lua51-pkgconfig.patch \
%D%/packages/patches/lua52-liblua-so.patch \
%D%/packages/patches/lua-liblua-so.patch \
%D%/packages/patches/luajit-no_ldconfig.patch \
%D%/packages/patches/luajit-symlinks.patch \
%D%/packages/patches/luit-posix.patch \

10
gnu/packages/admin.scm
View File

@ -1570,14 +1570,14 @@ done with the @code{auditctl} utility.")
(define-public nmap
(package
(name "nmap")
(version "7.12")
(version "7.31")
(source (origin
(method url-fetch)
(uri (string-append "https://nmap.org/dist/nmap-" version
".tar.bz2"))
(sha256
(base32
"014vagh9ak10hidwzp9s6g30y5h5fhsh8wykcnc1hnn9hwm0ipv3"))
"0hiqb28950kn4bjsmw0ksfyss7j2qdmgrj3xsjf7073pq01lx7yb"))
(modules '((guix build utils)))
(snippet
'(map delete-file-recursively
@ -1603,6 +1603,12 @@ done with the @code{auditctl} utility.")
'(#:configure-flags '("--without-zenmap")
#:phases
(modify-phases %standard-phases
(add-after 'configure 'patch-Makefile
(lambda _
(substitute* "Makefile"
;; Do not attempt to build lua.
(("build-dnet build-lua") "build-dnet"))
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(define (make out . args)

23
gnu/packages/game-development.scm
View File

@ -69,20 +69,25 @@
(define-public bullet
(package
(name "bullet")
(version "2.82-r2704")
(version "2.85.1")
(source (origin
(method url-fetch)
(uri (string-append "https://bullet.googlecode.com/files/bullet-"
version ".tgz"))
(uri (string-append "https://github.com/bulletphysics/bullet3/"
"archive/" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1lnfksxa9b1slyfcxys313ymsllvbsnxh9np06azkbgpfvmwkr37"))))
"0qpd37ws0xlxwy55dg058a5b4yw2jxiz09yyc3lc0frpa05pq5bf"))))
(build-system cmake-build-system)
(arguments '(#:tests? #f ; no 'test' target
#:configure-flags (list
(string-append
"-DCMAKE_CXX_FLAGS=-fPIC "
(or (getenv "CXXFLAGS") "")))))
(arguments
'(#:configure-flags (list (string-append
"-DBUILD_SHARED_LIBS=ON "
"-DCMAKE_CXX_FLAGS=-fPIC "
(or (getenv "CXXFLAGS") "")))))
(inputs
`(("glu" ,glu)
("libx11" ,libx11)
("mesa" ,mesa)))
(home-page "http://bulletphysics.org/")
(synopsis "3D physics engine library")
(description

7
gnu/packages/games.scm
View File

@ -233,11 +233,12 @@ that beneath its ruins lay buried an ancient evil.")
(source
(origin
(method url-fetch)
(uri (string-append "http://pingus.googlecode.com/files/pingus-"
version ".tar.bz2"))
(uri (string-append "https://github.com/Pingus/pingus/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0q34d2k6anzqvb0mf67x85q92lfx9jr71ry13dlp47jx0x9i573m"))
"0r9v6as5vi7skvvy7b0fcaimhdlzmik64pyy68plgljhsghqkkf4"))
(patches (search-patches "pingus-sdl-libs-config.patch"))))
(build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config)

3
gnu/packages/ghostscript.scm
View File

@ -200,7 +200,8 @@ file format. It also includes a C library that implements the graphics
capabilities of the PostScript language. It supports a wide variety of
output file formats and printers.")
(license license:agpl3+)
(home-page "http://www.gnu.org/software/ghostscript/")))
(home-page "http://www.gnu.org/software/ghostscript/")
(properties '((upstream-name . "gnu-ghostscript")))))
(define-public ghostscript/x
(package (inherit ghostscript)

16
gnu/packages/java.scm
View File

@ -1180,16 +1180,16 @@ an Ant task that extends the built-in @code{jar} task.")
(version "1.3")
(source (origin
(method url-fetch)
(uri (string-append "https://hamcrest.googlecode.com/files/"
"hamcrest-" version ".tgz"))
(uri (string-append "https://github.com/hamcrest/JavaHamcrest/"
"archive/hamcrest-java-" version ".tar.gz"))
(sha256
(base32
"1hi0jv0zrgsf4l25aizxrgvxpsrmdklsmvw0jzwz7zv9s108whn6"))
"11g0s105fmwzijbv08lx8jlb521yravjmxnpgdx08fvg1kjivhva"))
(modules '((guix build utils)))
(snippet
'(begin
;; Delete bundled jar archives.
(for-each delete-file (find-files "." "\\.jar$"))
;; Delete bundled thirds-party jar archives.
(delete-file-recursively "lib")
#t))))
(build-system ant-build-system)
(arguments
@ -1237,6 +1237,12 @@ private Method[] allMethods = getSortedMethods();")))))
(string-append (assoc-ref inputs "java-qdox-1.12")
"/share/java/qdox.jar")))
#t))
;; build.xml searches for .jar files in this directoy, which
;; we remove from the source archive.
(add-before 'build 'create-dummy-directories
(lambda _
(mkdir-p "lib/integration")
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(install-file (string-append "build/hamcrest-core-"

25
gnu/packages/lua.scm
View File

@ -40,15 +40,15 @@
(define-public lua
(package
(name "lua")
(version "5.2.4")
(version "5.3.3")
(source (origin
(method url-fetch)
(uri (string-append "http://www.lua.org/ftp/lua-"
(uri (string-append "https://www.lua.org/ftp/lua-"
version ".tar.gz"))
(sha256
(base32 "0jwznq0l8qg9wh5grwg07b5cy3lzngvl5m2nl1ikp6vqssmf9qmr"))
(base32 "18mcfbbmjyp8f2l9yy7n6dzk066nq6man0kpwly4bppphilc04si"))
(patches (search-patches "lua-pkgconfig.patch"
"lua52-liblua-so.patch"))))
"lua-liblua-so.patch"))))
(build-system gnu-build-system)
(inputs `(("readline" ,readline)))
(arguments
@ -69,7 +69,7 @@
(string-append "INSTALL_TOP=" out)
(string-append "INSTALL_MAN=" out
"/share/man/man1")))))))))
(home-page "http://www.lua.org/")
(home-page "https://www.lua.org/")
(synopsis "Embeddable scripting language")
(description
"Lua is a powerful, fast, lightweight, embeddable scripting language. Lua
@ -80,12 +80,25 @@ automatic memory management with incremental garbage collection, making it ideal
for configuration, scripting, and rapid prototyping.")
(license license:x11)))
(define-public lua-5.2
(package (inherit lua)
(version "5.2.4")
(source
(origin
(method url-fetch)
(uri (string-append "https://www.lua.org/ftp/lua-"
version ".tar.gz"))
(sha256
(base32 "0jwznq0l8qg9wh5grwg07b5cy3lzngvl5m2nl1ikp6vqssmf9qmr"))
(patches (search-patches "lua-pkgconfig.patch"
"lua-liblua-so.patch"))))))
(define-public lua-5.1
(package (inherit lua)
(version "5.1.5")
(source (origin
(method url-fetch)
(uri (string-append "http://www.lua.org/ftp/lua-"
(uri (string-append "https://www.lua.org/ftp/lua-"
version ".tar.gz"))
(sha256
(base32 "0cskd4w0g6rdm2q8q3i4n1h3j8kylhs3rq8mxwl9vwlmlxbgqh16"))

2
gnu/packages/networking.scm
View File

@ -487,7 +487,7 @@ which can be used to encrypt a password with @code{crypt(3)}.")
("libgcrypt" ,libgcrypt)
("libnl" ,libnl)
("libpcap" ,libpcap)
("lua" ,lua)
("lua" ,lua-5.2)
("krb5" ,mit-krb5)
("openssl" ,openssl)
("portaudio" ,portaudio)

125
gnu/packages/patches/jansson-CVE-2016-4425.patch
View File

File diff suppressed because one or more lines are too long

2
gnu/packages/patches/lua52-liblua-so.patch → gnu/packages/patches/lua-liblua-so.patch
View File

@ -1,3 +1,5 @@
This applies to Lua 5.2 and 5.3.
From 7a1b4e0829124976878ca2765a8e546667a92ceb Mon Sep 17 00:00:00 2001
From: Leo Famulari <leo@famulari.name>
Date: Fri, 30 Oct 2015 19:11:31 -0400

139
gnu/packages/python.scm
View File

@ -3922,6 +3922,141 @@ simple and Pythonic domain language.")
(define-public python2-sqlalchemy
(package-with-python2 python-sqlalchemy))
(define-public python-pycodestyle
(package
(name "python-pycodestyle")
(version "2.0.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "pycodestyle" version))
(sha256
(base32
"1rz2v8506mdjdyxcnv9ygiw6v0d4dqx8z5sjyjm0w2v32h5l5w1p"))))
(build-system python-build-system)
(home-page "https://pycodestyle.readthedocs.io/")
(synopsis "Python style guide checker")
(description "@code{pycodestyle} (formerly pep8) is a tool to check
Python code against some of the style conventions in
@url{http://www.python.org/dev/peps/pep-0008/,PEP 8}.")
(license license:expat)
(properties `((python2-variant . ,(delay python2-pycodestyle))))))
(define-public python2-pycodestyle
(let ((base (package-with-python2 (strip-python2-variant
python-pycodestyle))))
(package (inherit base)
(native-inputs
`(("python2-setuptools" ,python2-setuptools)
,@(package-native-inputs base))))))
(define-public python-orderedmultidict
(package
(name "python-orderedmultidict")
(version "0.7.10")
(source
(origin
(method url-fetch)
(uri (pypi-uri "orderedmultidict" version))
(sha256
(base32
"1gvqk0jd432wsn88kq4svad68xz3r012jfpnhh9in7bqrkyxidky"))))
(build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-tests
(lambda _
;; The package uses nosetest for running the tests.
;; Adding this initfile allows to run the test suite
;; without requiring nosetest.
(zero? (system* "touch" "tests/__init__.py")))))))
(propagated-inputs
`(("python-six" ,python-six)))
(native-inputs
`(("python-pycodestyle" ,python-pycodestyle)))
(home-page "https://github.com/gruns/orderedmultidict")
(synopsis "Python Ordered Multivalue Dictionary - omdict")
(description "This package contains a library for ordered multivalue
dictionaries. A multivalue dictionary is a dictionary that can store
multiple values for the same key. An ordered multivalue dictionary is a
multivalue dictionary that retains the order of insertions and deletions.")
(license license:unlicense)
(properties `((python2-variant . ,(delay python2-orderedmultidict))))))
(define-public python2-orderedmultidict
(let ((base (package-with-python2 (strip-python2-variant
python-orderedmultidict))))
(package (inherit base)
(native-inputs
`(("python2-setuptools" ,python2-setuptools)
,@(package-native-inputs base))))))
(define-public python-furl
(package
(name "python-furl")
(version "0.5.6")
(source
(origin
(method url-fetch)
(uri (pypi-uri "furl" version))
(sha256
(base32
"0lzpfpm686hvz3sr1mcrnd1b3lgmnw8v59gb43wfi98r3b671pqc"))))
(build-system python-build-system)
(propagated-inputs
`(("python-six" ,python-six)
("python-orderedmultidict" ,python-orderedmultidict)))
(native-inputs
`(("python-pycodestyle" ,python-pycodestyle)))
(home-page "https://github.com/gruns/furl")
(synopsis "URL manipulation in Python")
(description "Furl provides an easy-to-use alternative to the
@code{urllib} and @code{urlparse} modules for manipulating URLs.")
(license license:unlicense)
(properties `((python2-variant . ,(delay python2-furl))))))
(define-public python2-furl
(let ((base (package-with-python2 (strip-python2-variant
python-furl))))
(package (inherit base)
(native-inputs
`(("python2-setuptools" ,python2-setuptools)
,@(package-native-inputs base))))))
(define-public python-flask-babel
(package
(name "python-flask-babel")
(version "0.11.1")
(source
(origin
(method url-fetch)
(uri (pypi-uri "Flask-Babel" version))
(sha256
(base32
"16b80cipdba9xj3jlaiaq6wgrgpjb70w3j01jjy9hbp4k71kd6yj"))))
(build-system python-build-system)
(propagated-inputs
`(("python-flask" ,python-flask)
("python-babel" ,python-babel)
("python-jinja2" ,python-jinja2)
("python-pytz" ,python-pytz)))
(home-page "https://github.com/python-babel/flask-babel")
(synopsis "Add i18n/l10n support to Flask applications")
(description "This package implements internationalization and localization
support for Flask. This is based on the Python babel module as well as pytz -
both of which are installed automatically if you install this library.")
(license license:bsd-3)
(properties `((python2-variant . ,(delay python2-flask-babel))))))
(define-public python2-flask-babel
(let ((base (package-with-python2 (strip-python2-variant
python-flask-babel))))
(package (inherit base)
(native-inputs
`(("python2-setuptools" ,python2-setuptools)
,@(package-native-inputs base))))))
(define-public python-sqlalchemy-utils
(package
(name "python-sqlalchemy-utils")
@ -3934,9 +4069,11 @@ simple and Pythonic domain language.")
(base32
"1zbmmh7n8m01ikizn2mj1mfwch26nsr1awv9mvskqry7av0mpy98"))))
(build-system python-build-system)
(inputs
(propagated-inputs
`(("python-six" ,python-six)
("python-sqlalchemy" ,python-sqlalchemy)))
(native-inputs
`(("python-pytest" ,python-pytest)))
(home-page "https://github.com/kvesteri/sqlalchemy-utils")
(synopsis "Various utility functions for SQLAlchemy")
(description

13
gnu/packages/qt.scm
View File

@ -541,7 +541,11 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"1rb27x7i2pmvsck6wax2cg31gqpzaakciy45wm5l3lcl86j48czg"))))
"1rb27x7i2pmvsck6wax2cg31gqpzaakciy45wm5l3lcl86j48czg"))
(modules '((guix build utils)))
(snippet
'(begin
(delete-file-recursively "src/3rdparty")))))
(native-inputs `())
(inputs
`(("libmng" ,libmng)
@ -677,7 +681,12 @@ developers using C++ or QML, a CSS & JavaScript like language.")
version ".tar.xz"))
(sha256
(base32
"0ndmhiflmyr144nq8drd5njsdi282ixsm4730q5n0ji2v9dp1bh5"))))
"0ndmhiflmyr144nq8drd5njsdi282ixsm4730q5n0ji2v9dp1bh5"))
(modules '((guix build utils)))
(snippet
'(begin
(delete-file-recursively
"examples/multimedia/spectrum/3rdparty")))))
(native-inputs
`(("perl" ,perl)
("pkg-config" ,pkg-config)

2
gnu/packages/statistics.scm
View File

@ -514,7 +514,7 @@ panels or collapse high-dimensional arrays to simpler summary statistics.")
(sha256
(base32 "1l843p8vckjckdhgv37ngv47fga5jzy0n00pmipvp05nnaixk54j"))))
(build-system r-build-system)
(home-page "http://r-proto.googlecode.com")
(home-page "https://github.com/hadley/proto")
(synopsis "Prototype object-based programming")
(description
"Proto is an object oriented system using object-based, also called

4
gnu/packages/tls.scm
View File

@ -681,7 +681,7 @@ number generator")
(define-public acme-client
(package
(name "acme-client")
(version "0.1.11")
(version "0.1.14")
(source (origin
(method url-fetch)
(uri (string-append "https://kristaps.bsd.lv/" name "/"
@ -689,7 +689,7 @@ number generator")
version ".tgz"))
(sha256
(base32
"09pipyfk448gxqr7ci56gsq5la8wlydv7wwn9wk0zgjxmlh7h6fb"))))
"1qq4xk41pn65m3v7nnvkmxg96pr06vz6hzdrm0vcmlp3clzpbahl"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f ; no test suite

4
gnu/packages/vim.scm
View File

@ -48,7 +48,7 @@
(define-public vim
(package
(name "vim")
(version "8.0.0054")
(version "8.0.0069")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/vim/vim/archive/v"
@ -56,7 +56,7 @@
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"018my9vmvflww9yzrrzgdbja8j075yxqj0czg351r6wrndqiv9vq"))))
"1xxg0m296jqcg7wxxw1zcr0i10j1a85aw6ainpql2h4jrqbwqvy9"))))
(build-system gnu-build-system)
(arguments
`(#:test-target "test"

5
gnu/packages/web.scm
View File

@ -236,7 +236,7 @@ and UNIX socket support.")
(define-public jansson
(package
(name "jansson")
(version "2.7")
(version "2.9")
(source (origin
(method url-fetch)
(uri
@ -244,8 +244,7 @@ and UNIX socket support.")
version ".tar.gz"))
(sha256
(base32
"1mvq9p85khsl818i4vbszyfab0fd45mdrwrxjkzw05mk1xcyc1br"))
(patches (search-patches "jansson-CVE-2016-4425.patch"))))
"19fjgfwjfj99rqa3kf96x5rssj88siazggksgrikd6h4r9sd1l0a"))))
(build-system gnu-build-system)
(home-page "http://www.digip.org/jansson/")
(synopsis "JSON C library")

22
gnu/system.scm
View File

@ -60,6 +60,7 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (rnrs bytevectors)
#:export (operating-system
operating-system?
@ -733,7 +734,7 @@ listed in OS. The C library expects to find it under
(label label)
;; The device where the kernel and initrd live.
(device (file-system-device store-fs))
(device (grub-device store-fs))
(device-mount-point
(file-system-mount-point store-fs))
@ -748,6 +749,14 @@ listed in OS. The C library expects to find it under
(grub-configuration-file (operating-system-bootloader os) entries
#:old-entries old-entries)))
(define (grub-device fs)
"Given FS, a <file-system> object, return a value suitable for use as the
device in a <menu-entry>."
(case (file-system-title fs)
((uuid) (file-system-device fs))
((label) (file-system-device fs))
(else #f)))
(define (operating-system-parameters-file os)
"Return a file that describes the boot parameters of OS. The primary use of
this file is the reconstruction of GRUB menu entries for old configurations."
@ -766,10 +775,7 @@ this file is the reconstruction of GRUB menu entries for old configurations."
#$(operating-system-kernel-arguments os))
(initrd #$initrd)
(store
(device #$(case (file-system-title store)
((uuid) (file-system-device store))
((label) (file-system-device store))
(else #f)))
(device #$(grub-device store))
(mount-point #$(file-system-mount-point store))))
#:set-load-path? #f)))
@ -831,7 +837,11 @@ this file is the reconstruction of GRUB menu entries for old configurations."
(('store ('device device) _ ...)
device)
(_ ;the old format
root)))
;; Root might be a device path like "/dev/sda1", which is not a
;; suitable GRUB device identifier.
(if (string-prefix? "/" root)
#f
root))))
(store-mount-point
(match (assq 'store rest)

2
gnu/system/pam.scm
View File

@ -316,4 +316,4 @@ all the PAM services."
(pam-configuration (services base)
(transform transform))))
;;; linux.scm ends here

19
guix/profiles.scm
View File

@ -5,6 +5,7 @@
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -97,6 +98,7 @@
generation-number
generation-numbers
profile-generations
relative-generation-spec->number
relative-generation
previous-generation-number
generation-time
@ -1048,6 +1050,23 @@ former profiles were found."
'()
generations)))
(define (relative-generation-spec->number profile spec)
"Return PROFILE's generation specified by SPEC, which is a string. The SPEC
may be a N, -N, or +N, where N is a number. If the spec is N, then the number
returned is N. If it is -N, then the number returned is the profile's current
generation number minus N. If it is +N, then the number returned is the
profile's current generation number plus N. Return #f if there is no such
generation."
(let ((number (string->number spec)))
(and number
(case (string-ref spec 0)
((#\+ #\-)
(relative-generation profile number))
(else (if (memv number (profile-generations profile))
number
#f))))))
(define* (relative-generation profile shift #:optional
(current (generation-number profile)))
"Return PROFILE's generation shifted from the CURRENT generation by SHIFT.

8
guix/scripts/package.scm
View File

@ -5,6 +5,7 @@
;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -782,12 +783,7 @@ processed, #f otherwise."
#:key dry-run?)
"Switch PROFILE to the generation specified by SPEC."
(unless dry-run?
(let* ((number (string->number spec))
(number (and number
(case (string-ref spec 0)
((#\+ #\-)
(relative-generation profile number))
(else number)))))
(let ((number (relative-generation-spec->number profile spec)))
(if number
(switch-to-generation* profile number)
(leave (_ "cannot switch to generation '~a'~%") spec)))))

106
guix/scripts/system.scm
View File

@ -366,8 +366,10 @@ it atomically, and then run OS's activation script."
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M")))
(define* (previous-grub-entries #:optional (profile %system-profile))
"Return a list of 'menu-entry' for the generations of PROFILE."
(define* (profile-grub-entries #:optional (profile %system-profile)
(numbers (generation-numbers profile)))
"Return a list of 'menu-entry' for the generations of PROFILE specified by
NUMBERS, which is a list of generation numbers."
(define (system->grub-entry system number time)
(unless-file-not-found
(let* ((file (string-append system "/parameters"))
@ -395,8 +397,7 @@ it atomically, and then run OS's activation script."
kernel-arguments))
(initrd initrd)))))
(let* ((numbers (generation-numbers profile))
(systems (map (cut generation-file-name profile <>)
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
(unless-file-not-found
@ -404,6 +405,65 @@ it atomically, and then run OS's activation script."
systems)))
(filter-map system->grub-entry systems numbers times)))
;;;
;;; Roll-back.
;;;
(define (roll-back-system store)
"Roll back the system profile to its previous generation. STORE is an open
connection to the store."
(switch-to-system-generation store "-1"))
;;;
;;; Switch generations.
;;;
(define (switch-to-system-generation store spec)
"Switch the system profile to the generation specified by SPEC, and
re-install grub with a grub configuration file that uses the specified system
generation as its default entry. STORE is an open connection to the store."
(let ((number (relative-generation-spec->number %system-profile spec)))
(if number
(begin
(reinstall-grub store number)
(switch-to-generation* %system-profile number))
(leave (_ "cannot switch to system generation '~a'~%") spec))))
(define (reinstall-grub store number)
"Re-install grub for existing system profile generation NUMBER. STORE is an
open connection to the store."
(let* ((generation (generation-file-name %system-profile number))
(file (string-append generation "/parameters"))
(params (unless-file-not-found
(call-with-input-file file read-boot-parameters)))
(root-device (boot-parameters-root-device params))
;; We don't currently keep track of past menu entries' details. The
;; default values will allow the system to boot, even if they differ
;; from the actual past values for this generation's entry.
(grub-config (grub-configuration (device root-device)))
;; Make the specified system generation the default entry.
(entries (profile-grub-entries %system-profile (list number)))
(old-generations (delv number (generation-numbers %system-profile)))
(old-entries (profile-grub-entries %system-profile old-generations))
(grub.cfg (run-with-store store
(grub-configuration-file grub-config
entries
#:old-entries old-entries))))
(show-what-to-build store (list grub.cfg))
(build-derivations store (list grub.cfg))
;; This is basically the same as install-grub*, but for now we avoid
;; re-installing the GRUB boot loader itself onto a device, mainly because
;; we don't in general have access to the same version of the GRUB package
;; which was used when installing this other system generation.
(let* ((grub.cfg-path (derivation->output-path grub.cfg))
(gc-root (string-append %gc-roots-directory "/grub.cfg"))
(temp-gc-root (string-append gc-root ".new")))
(switch-symlinks temp-gc-root grub.cfg-path)
(unless (false-if-exception (install-grub-config grub.cfg-path "/"))
(delete-file temp-gc-root)
(leave (_ "failed to re-install GRUB configuration file: '~a'~%")
grub.cfg-path))
(rename-file temp-gc-root gc-root))))
;;;
;;; Graphs.
@ -563,7 +623,7 @@ building anything."
(operating-system-grub.cfg os
(if (eq? 'init action)
'()
(previous-grub-entries)))))
(profile-grub-entries)))))
;; For 'init' and 'reconfigure', always build GRUB.CFG, even if
;; --no-grub is passed, because GRUB.CFG because we then use it as a GC
@ -640,13 +700,18 @@ building anything."
;;;
(define (show-help)
(display (_ "Usage: guix system [OPTION] ACTION [FILE]
Build the operating system declared in FILE according to ACTION.\n"))
(display (_ "Usage: guix system [OPTION ...] ACTION [ARG ...] [FILE]
Build the operating system declared in FILE according to ACTION.
Some ACTIONS support additional ARGS.\n"))
(newline)
(display (_ "The valid values for ACTION are:\n"))
(newline)
(display (_ "\
reconfigure switch to a new operating system configuration\n"))
(display (_ "\
roll-back switch to the previous operating system configuration\n"))
(display (_ "\
switch-generation switch to an existing operating system configuration\n"))
(display (_ "\
list-generations list the system generations\n"))
(display (_ "\
@ -808,15 +873,33 @@ resulting from command-line parsing."
"Process COMMAND, one of the 'guix system' sub-commands. ARGS is its
argument list and OPTS is the option alist."
(case command
;; The following commands do not need to use the store, and they do not need
;; an operating system configuration file.
((list-generations)
;; List generations. No need to connect to the daemon, etc.
(let ((pattern (match args
(() "")
((pattern) pattern)
(x (leave (_ "wrong number of arguments~%"))))))
(list-generations pattern)))
(else
(process-action command args opts))))
;; The following commands need to use the store, but they do not need an
;; operating system configuration file.
((switch-generation)
(let ((pattern (match args
((pattern) pattern)
(x (leave (_ "wrong number of arguments~%"))))))
(with-store store
(set-build-options-from-command-line store opts)
(switch-to-system-generation store pattern))))
((roll-back)
(let ((pattern (match args
(() "")
(x (leave (_ "wrong number of arguments~%"))))))
(with-store store
(set-build-options-from-command-line store opts)
(roll-back-system store))))
;; The following commands need to use the store, and they also
;; need an operating system configuration file.
(else (process-action command args opts))))
(define (guix-system . args)
(define (parse-sub-command arg result)
@ -826,7 +909,8 @@ argument list and OPTS is the option alist."
(let ((action (string->symbol arg)))
(case action
((build container vm vm-image disk-image reconfigure init
extension-graph shepherd-graph list-generations)
extension-graph shepherd-graph list-generations roll-back
switch-generation)
(alist-cons 'action action result))
(else (leave (_ "~a: unknown action~%") action))))))

546
po/guix/fr.po
View File

File diff suppressed because it is too large Load Diff