diff options
56 files changed, 1640 insertions, 444 deletions
diff --git a/Makefile.am b/Makefile.am index 1f257a009c..5cee3d3b6f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -27,7 +27,7 @@ nodist_noinst_SCRIPTS = \ pre-inst-env \ test-env -include gnu-system.am +include gnu/local.mk MODULES = \ guix/base32.scm \ @@ -416,11 +416,11 @@ install-data-hook: set-bootstrap-executable-permissions SUBDIRS = po/guix po/packages BUILT_SOURCES = -include doc.am +include doc/local.mk if BUILD_DAEMON -include daemon.am +include nix/local.mk endif BUILD_DAEMON @@ -437,7 +437,7 @@ AM_DISTCHECK_CONFIGURE_FLAGS = \ dist_emacsui_DATA = emacs/guix-main.scm nodist_emacsui_DATA = emacs/guix-helper.scm -include emacs.am +include emacs/local.mk # The self-contained tarball. guix-binary.%.tar.xz: @@ -10,6 +10,12 @@ Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> Please send Guix bug reports to bug-guix@gnu.org. +* Changes in 0.11.0 (since 0.10.0) + +** Package management + +*** New Emacs interface for package locations: M-x guix-locations + * Changes in 0.10.0 (since 0.9.0) ** Community diff --git a/doc/emacs.texi b/doc/emacs.texi index c4fdfff272..ed8896ad43 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -10,6 +10,7 @@ Guix convenient and fun. * Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}. * Package Management: Emacs Package Management. Managing packages and generations. * Licenses: Emacs Licenses. Interface for licenses of Guix packages. +* Package Source Locations: Emacs Package Locations. Interface for package location files. * Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands. * Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names. * Build Log Mode: Emacs Build Log. Highlighting Guix build logs. @@ -160,6 +161,11 @@ Display package(s) with the specified name. @item M-x guix-packages-by-license Display package(s) with the specified license. +@item M-x guix-packages-by-location +Display package(s) located in the specified file. These files usually +have the following form: @file{gnu/packages/emacs.scm}, but don't type +them manually! Press @key{TAB} to complete the file name. + @item M-x guix-search-by-regexp Search for packages by a specified regexp. By default ``name'', ``synopsis'' and ``description'' of the packages will be searched. This @@ -217,30 +223,6 @@ With @kbd{C-u}, make it verbose. Once @command{guix pull} has succeeded, the Guix REPL is restared. This allows you to keep using the Emacs interface with the updated Guix. -Finally, there is an Emacs variant of @command{guix edit} command -(@pxref{Invoking guix edit}): - -@table @kbd -@item M-x guix-edit -As with @kbd{M-x guix-packages-by-name}, you can press @key{TAB} to -complete a package name. -@end table - -If you are contributing to Guix, you may find it useful for @kbd{M-x -guix-edit} to open package files from your git directory. This can be -done by setting @code{guix-directory} variable. For example, after -this: - -@example -(setq guix-directory "~/src/guix") -@end example - -@kbd{M-x guix-edit guix} opens -@file{~/src/guix/gnu/packages/package-management.scm} file. - -Also you can use @kbd{C-u} prefix argument to specify a directory just -for the current @kbd{M-x guix-edit} command. - @node Emacs General info @subsection General information @@ -565,6 +547,51 @@ guix-packages-by-license} would do (@pxref{Emacs Commands}). @end table +@node Emacs Package Locations +@section Package Source Locations + +As you know, package definitions are placed in Guile files, also known +as @dfn{package locations}. The following commands should help you not +get lost in these locations: + +@table @kbd + +@item M-x guix-locations +Display a list of package locations. You can press @key{RET} there to +display packages placed in the current location in the same way as +@kbd{M-x guix-packages-by-location} would do (@pxref{Emacs Commands}). +Note that when the point is on a location button, @key{RET} will open +this location file. + +@item M-x guix-find-location +Open the given package definition source file (press @key{TAB} to choose +a location from a completion list). + +@item M-x guix-edit +Find location of a specified package. This is an Emacs analog of +@command{guix edit} command (@pxref{Invoking guix edit}). As with +@kbd{M-x guix-packages-by-name}, you can press @key{TAB} to complete a +package name. + +@end table + +If you are contributing to Guix, you may find it useful for @kbd{M-x +guix-find-location} and @kbd{M-x guix-edit} to open locations from your +Git checkout. This can be done by setting @code{guix-directory} +variable. For example, after this: + +@example +(setq guix-directory "~/src/guix") +@end example + +@kbd{M-x guix-edit guix} opens +@file{~/src/guix/gnu/packages/package-management.scm} file. + +Also you can use @kbd{C-u} prefix argument to specify a directory just +for the current @kbd{M-x guix-find-location} or @kbd{M-x guix-edit} +command. + + @node Emacs Popup Interface @section Popup Interface diff --git a/doc/guix.texi b/doc/guix.texi index 9b7a0cb455..ab07d1066e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -118,6 +118,7 @@ Emacs Interface * Initial Setup: Emacs Initial Setup. Preparing @file{~/.emacs}. * Package Management: Emacs Package Management. Managing packages and generations. * Licenses: Emacs Licenses. Interface for licenses of Guix packages. +* Package Source Locations: Emacs Package Locations. Interface for package location files. * Popup Interface: Emacs Popup Interface. Magit-like interface for guix commands. * Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names. * Build Log Mode: Emacs Build Log. Highlighting Guix build logs. @@ -225,6 +226,7 @@ Packaging Guidelines * Synopses and Descriptions:: Helping users find the right package. * Python Modules:: Taming the snake. * Perl Modules:: Little pearls. +* Java Packages:: Coffee break. * Fonts:: Fond of fonts. Contributing @@ -1157,6 +1159,16 @@ for Chinese languages: guix package -i font-adobe-source-han-sans:cn @end example +@subsection X.509 Certificates + +The @code{nss-certs} package provides X.509 certificates, which allow +programs to authenticate Web servers accessed over HTTPS. + +When using Guix on a foreign distro, you can install this package and +define the relevant environment variables so that packages know where to +look for certificates. @pxref{X.509 Certificates}, for detailed +information. + @subsection Emacs Packages When you install Emacs packages with Guix, the elisp files may be placed @@ -6039,6 +6051,15 @@ partition): mount /dev/sda1 /mnt @end example +Finally, if you plan to use one or more swap partitions (@pxref{Memory +Concepts, swap space,, libc, The GNU C Library Reference Manual}), make +sure to initialize them with @command{mkswap}. Assuming you have one +swap partition on @file{/dev/sda2}, you would run: + +@example +mkswap /dev/sda2 +@end example + @node Proceeding with the Installation @subsection Proceeding with the Installation @@ -6227,7 +6248,7 @@ version: (operating-system ;; ... (packages (append (map specification->package - '("tcpdump" "htop" "gnupg-2.0")) + '("tcpdump" "htop" "gnupg@@2.0")) %base-packages))) @end lisp @@ -6426,15 +6447,17 @@ For example, @code{'("/dev/sda3")}. List of user accounts and groups. @xref{User Accounts}. @item @code{skeletons} (default: @code{(default-skeletons)}) -A monadic list of pairs of target file name and files. These are the -files that will be used as skeletons as new accounts are created. +A list target file name/file-like object tuples (@pxref{G-Expressions, +file-like objects}). These are the skeleton files that will be added to +the home directory of newly-created user accounts. For instance, a valid value may look like this: @example -(mlet %store-monad ((bashrc (text-file "bashrc" "\ - export PATH=$HOME/.guix-profile/bin"))) - (return `((".bashrc" ,bashrc)))) +`((".bashrc" ,(plain-file "bashrc" "echo Hello\n")) + (".guile" ,(plain-file "guile" + "(use-modules (ice-9 readline)) + (activate-readline)"))) @end example @item @code{issue} (default: @var{%default-issue}) @@ -6686,13 +6709,29 @@ Mapped devices are declared using the @code{mapped-device} form: (type luks-device-mapping)) @end example -@noindent +Or, better yet, like this: + +@example +(mapped-device + (source (uuid "cb67fc72-0d54-4c88-9d4b-b225f30b0f44")) + (target "home") + (type luks-device-mapping)) +@end example + @cindex disk encryption @cindex LUKS This example specifies a mapping from @file{/dev/sda3} to @file{/dev/mapper/home} using LUKS---the @url{http://code.google.com/p/cryptsetup,Linux Unified Key Setup}, a -standard mechanism for disk encryption. The @file{/dev/mapper/home} +standard mechanism for disk encryption. In the second example, the UUID +(unique identifier) is the LUKS UUID returned for the device by a +command like: + +@example +cryptsetup luksUUID /dev/sdx9 +@end example + +The @file{/dev/mapper/home} device can then be used as the @code{device} of a @code{file-system} declaration (@pxref{File Systems}). The @code{mapped-device} form is detailed below. @@ -7260,10 +7299,25 @@ Return a service that runs the Guix build daemon according to Run @var{udev}, which populates the @file{/dev} directory dynamically. @end deffn -@deffn {Scheme Procedure} console-keymap-service @var{file} +@deffn {Scheme Procedure} console-keymap-service @var{files} ... @cindex keyboard layout -Return a service to load console keymap from @var{file} using -@command{loadkeys} command. +Return a service to load console keymaps from @var{files} using +@command{loadkeys} command. Most likely, you want to load some default +keymap, which can be done like this: + +@example +(console-keymap-service "dvorak") +@end example + +Or, for example, for a Swedish keyboard, you may need to combine +the following keymaps: +@example +(console-keymap-service "se-lat6" "se-fi-lat6") +@end example + +Also you can specify a full file name (or file names) of your keymap(s). +See @code{man loadkeys} for details. + @end deffn @deffn {Scheme Procedure} gpm-service-type [#:gpm @var{gpm}] @ @@ -9315,14 +9369,22 @@ explicitly add it. The @file{/etc/ssl/certs} directory, which is where most applications and libraries look for certificates by default, points to the certificates installed globally. -Unprivileged users can also install their own certificate package in +Unprivileged users, including users of Guix on a foreign distro, +can also install their own certificate package in their profile. A number of environment variables need to be defined so that applications and libraries know where to find them. Namely, the OpenSSL library honors the @code{SSL_CERT_DIR} and @code{SSL_CERT_FILE} variables. Some applications add their own environment variables; for instance, the Git version control system honors the certificate bundle -pointed to by the @code{GIT_SSL_CAINFO} environment variable. +pointed to by the @code{GIT_SSL_CAINFO} environment variable. Thus, you +would typically run something like: +@example +$ guix package -i nss-certs +$ export SSL_CERT_DIR="$HOME/.guix-profile/etc/ssl/certs" +$ export SSL_CERT_FILE="$HOME/.guix-profile/etc/ssl/certs/ca-certificates.crt" +$ export GIT_SSL_CAINFO="$SSL_CERT_FILE" +@end example @node Name Service Switch @subsection Name Service Switch @@ -10733,6 +10795,7 @@ needed is to review and apply the patch. * Synopses and Descriptions:: Helping users find the right package. * Python Modules:: Taming the snake. * Perl Modules:: Little pearls. +* Java Packages:: Coffee break. * Fonts:: Fond of fonts. @end menu @@ -10974,6 +11037,25 @@ are also prepended by @code{perl-}. Such modules tend to have the word prefix. For instance, @code{libwww-perl} becomes @code{perl-libwww}. +@node Java Packages +@subsection Java Packages + +Java programs standing for themselves are named as any other package, +using the lowercase upstream name. + +To avoid confusion and naming clashes with other programming languages, +it is desirable that the name of a package for a Java package is +prefixed with @code{java-}. If a project already contains the word +@code{java}, we drop this; for instance, the package @code{ngsjava} is +packaged under the name @code{java-ngs}. + +For Java packages containing a single class or a small class hierarchy, +we use the lowercase class name, replace all occurrences of @code{.} by +dashes and prepend the prefix @code{java-}. So the class +@code{apache.commons.cli} becomes package +@code{java-apache-commons-cli}. + + @node Fonts @subsection Fonts @@ -11204,7 +11286,7 @@ to be updated to refer to these binaries on the target platform. That is, the hashes and URLs of the bootstrap tarballs for the new platform must be added alongside those of the currently supported platforms. The bootstrap Guile tarball is treated specially: it is expected to be -available locally, and @file{gnu-system.am} has rules do download it for +available locally, and @file{gnu/local.mk} has rules do download it for the supported architectures; a rule for the new platform must be added as well. diff --git a/emacs/guix-backend.el b/emacs/guix-backend.el index 8afbc9ed48..6341aacae1 100644 --- a/emacs/guix-backend.el +++ b/emacs/guix-backend.el @@ -82,7 +82,7 @@ If you have a slow system, try to increase this time." :type 'string :group 'guix-repl) -(defcustom guix-after-start-repl-hook () +(defcustom guix-after-start-repl-hook '(guix-set-directory) "Hook called after Guix REPL is started." :type 'hook :group 'guix-repl) @@ -337,6 +337,28 @@ additional internal REPL if it exists." (geiser-repl--switch-to-buffer (guix-get-repl-buffer internal))) +;;; Guix directory + +(defvar guix-directory nil + "Default directory with Guix source. +If it is not set by a user, it is set after starting Guile REPL. +This directory is used to define package locations.") + +(defun guix-read-directory () + "Return `guix-directory' or prompt for it. +This function is intended for using in `interactive' forms." + (if current-prefix-arg + (read-directory-name "Directory with Guix modules: " + guix-directory) + guix-directory)) + +(defun guix-set-directory () + "Set `guix-directory' if needed." + (or guix-directory + (setq guix-directory + (guix-eval-read "%guix-dir")))) + + ;;; Evaluating expressions (defvar guix-operation-buffer nil diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 75d19cbfe0..888836428f 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -48,53 +48,7 @@ (when output (concat ":" output)))) -;;; Location of packages, profiles and manifests - -(defvar guix-directory nil - "Default Guix directory. -If it is not set by a user, it is set after starting Guile REPL. -This directory is used to define location of the packages.") - -(defun guix-read-directory () - "Return `guix-directory' or prompt for it. -This function is intended for using in `interactive' forms." - (if current-prefix-arg - (read-directory-name "Directory with Guix modules: " - guix-directory) - guix-directory)) - -(defun guix-set-directory () - "Set `guix-directory' if needed." - (or guix-directory - (setq guix-directory - (guix-eval-read "%guix-dir")))) - -(add-hook 'guix-after-start-repl-hook 'guix-set-directory) - -(defun guix-find-location (location &optional directory) - "Go to LOCATION of a package. -LOCATION is a string of the form: - - \"PATH:LINE:COLUMN\" - -If PATH is relative, it is considered to be relative to -DIRECTORY (`guix-directory' by default)." - (cl-multiple-value-bind (path line col) - (split-string location ":") - (let ((file (expand-file-name path (or directory guix-directory))) - (line (string-to-number line)) - (col (string-to-number col))) - (find-file file) - (goto-char (point-min)) - (forward-line (- line 1)) - (move-to-column col) - (recenter 1)))) - -(defun guix-package-location (id-or-name) - "Return location of a package with ID-OR-NAME. -For the meaning of location, see `guix-find-location'." - (guix-eval-read (guix-make-guile-expression - 'package-location-string id-or-name))) +;;; Location of profiles and manifests (defun guix-generation-file (profile generation) "Return the file name of a PROFILE's GENERATION." @@ -120,20 +74,6 @@ See `guix-packages-profile'." (expand-file-name "manifest" (guix-packages-profile profile generation system?))) -;;;###autoload -(defun guix-edit (id-or-name &optional directory) - "Edit (go to location of) package with ID-OR-NAME. -See `guix-find-location' for the meaning of package location and -DIRECTORY. -Interactively, with prefix argument, prompt for DIRECTORY." - (interactive - (list (guix-read-package-name) - (guix-read-directory))) - (let ((loc (guix-package-location id-or-name))) - (if loc - (guix-find-location loc directory) - (message "Couldn't find package location.")))) - ;;; Actions on packages and generations diff --git a/emacs/guix-config.el.in b/emacs/guix-config.el.in index bd821596c4..d03df9ce63 100644 --- a/emacs/guix-config.el.in +++ b/emacs/guix-config.el.in @@ -24,7 +24,7 @@ (replace-regexp-in-string "${prefix}" "@prefix@" "@emacsuidir@")) (defconst guix-config-state-directory - ;; This must match `NIX_STATE_DIR' as defined in `daemon.am'. + ;; This must match `NIX_STATE_DIR' as defined in `nix/local.mk'. (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix")) (defconst guix-config-guile-program "@GUILE@" diff --git a/emacs/guix-license.el b/emacs/guix-license.el index a99d7af98d..940f5518e2 100644 --- a/emacs/guix-license.el +++ b/emacs/guix-license.el @@ -23,108 +23,22 @@ ;;; Code: -(require 'guix-buffer) -(require 'guix-list) -(require 'guix-info) (require 'guix-read) (require 'guix-backend) (require 'guix-guile) -(guix-define-entry-type license) - (defun guix-lookup-license-url (license) "Return URL of a LICENSE." (or (guix-eval-read (guix-make-guile-expression 'lookup-license-uri license)) (error "Hm, I don't know URL of '%s' license" license))) -(defun guix-license-get-entries (search-type &rest args) - "Receive 'license' entries. -SEARCH-TYPE may be one of the following symbols: `all', `id', `name'." - (guix-eval-read - (apply #'guix-make-guile-expression - 'license-entries search-type args))) - -(defun guix-license-get-display (search-type &rest args) - "Search for licenses and show results." - (apply #'guix-list-get-display-entries - 'license search-type args)) - - -;;; License 'info' - -(guix-info-define-interface license - :buffer-name "*Guix License Info*" - :get-entries-function 'guix-license-get-entries - :format '((name ignore (simple guix-info-heading)) - ignore - guix-license-insert-packages-button - (url ignore (simple guix-url)) - guix-license-insert-comment) - :titles '((url . "URL"))) - -(declare-function guix-packages-by-license "guix-ui-package") - -(defun guix-license-insert-packages-button (entry) - "Insert button to display packages by license ENTRY." - (guix-info-insert-action-button - "Packages" - (lambda (btn) - (guix-packages-by-license (button-get btn 'license))) - "Show packages with this license" - 'license (guix-entry-value entry 'name))) - -(defun guix-license-insert-comment (entry) - "Insert 'comment' of a license ENTRY." - (let ((comment (guix-entry-value entry 'comment))) - (if (and comment - (string-match-p "^http" comment)) - (guix-info-insert-value-simple comment 'guix-url) - (guix-info-insert-title-simple - (guix-info-param-title 'license 'comment)) - (guix-info-insert-value-indent comment)))) - - -;;; License 'list' - -(guix-list-define-interface license - :buffer-name "*Guix Licenses*" - :get-entries-function 'guix-license-get-entries - :describe-function 'guix-license-list-describe - :format '((name nil 40 t) - (url guix-list-get-url 50 t)) - :titles '((name . "License")) - :sort-key '(name)) - -(let ((map guix-license-list-mode-map)) - (define-key map (kbd "RET") 'guix-license-list-show-packages)) - -(defun guix-license-list-describe (ids) - "Describe licenses with IDS (list of identifiers)." - (guix-buffer-display-entries - (guix-entries-by-ids ids (guix-buffer-current-entries)) - 'info 'license (cl-list* 'id ids) 'add)) - -(defun guix-license-list-show-packages () - "Display packages with the license at point." - (interactive) - (guix-packages-by-license (guix-list-current-id))) - - -;;; Interactive commands - ;;;###autoload (defun guix-browse-license-url (license) "Browse URL of a LICENSE." (interactive (list (guix-read-license-name))) (browse-url (guix-lookup-license-url license))) -;;;###autoload -(defun guix-licenses () - "Display licenses of the Guix packages." - (interactive) - (guix-license-get-display 'all)) - (provide 'guix-license) ;;; guix-license.el ends here diff --git a/emacs/guix-location.el b/emacs/guix-location.el new file mode 100644 index 0000000000..81396b4017 --- /dev/null +++ b/emacs/guix-location.el @@ -0,0 +1,79 @@ +;;; guix-location.el --- Package locations + +;; Copyright © 2016 Alex Kost <alezost@gmail.com> + +;; 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 Location as published by +;; the Free Software Foundation, either version 3 of the Location, 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 Location for more details. + +;; You should have received a copy of the GNU General Public Location +;; along with this program. If not, see <http://www.gnu.org/locations/>. + +;;; Commentary: + +;; This file provides the code to work with locations of Guix packages. + +;;; Code: + +(require 'cl-lib) +(require 'guix-backend) +(require 'guix-read) +(require 'guix-guile) + +(defun guix-package-location (id-or-name) + "Return location of a package with ID-OR-NAME. +For the meaning of location, see `guix-find-location'." + (guix-eval-read (guix-make-guile-expression + 'package-location-string id-or-name))) + +;;;###autoload +(defun guix-find-location (location &optional directory) + "Go to LOCATION of a package. +LOCATION is a string of the form: + + \"FILE:LINE:COLUMN\" + +If FILE is relative, it is considered to be relative to +DIRECTORY (`guix-directory' by default). + +Interactively, prompt for LOCATION. With prefix argument, prompt +for DIRECTORY as well." + (interactive + (list (guix-read-package-location) + (guix-read-directory))) + (cl-multiple-value-bind (file line column) + (split-string location ":") + (find-file (expand-file-name file (or directory guix-directory))) + (when (and line column) + (let ((line (string-to-number line)) + (column (string-to-number column))) + (goto-char (point-min)) + (forward-line (- line 1)) + (move-to-column column) + (recenter 1))))) + +;;;###autoload +(defun guix-edit (id-or-name &optional directory) + "Edit (go to location of) package with ID-OR-NAME. +See `guix-find-location' for the meaning of package location and +DIRECTORY. +Interactively, with prefix argument, prompt for DIRECTORY." + (interactive + (list (guix-read-package-name) + (guix-read-directory))) + (let ((loc (guix-package-location id-or-name))) + (if loc + (guix-find-location loc directory) + (message "Couldn't find package location.")))) + +(provide 'guix-location) + +;;; guix-location.el ends here diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index c62044056f..5358f3bfa4 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -684,6 +684,8 @@ ENTRIES is a list of installed manifest entries." (license-proc (lambda (_ license-name) (packages-by-license (lookup-license license-name)))) + (location-proc (lambda (_ location) + (packages-by-location-file location))) (all-proc (lambda _ (all-available-packages))) (newest-proc (lambda _ (newest-available-packages)))) `((package @@ -693,6 +695,7 @@ ENTRIES is a list of installed manifest entries." (obsolete . ,(apply-to-first obsolete-package-patterns)) (regexp . ,regexp-proc) (license . ,license-proc) + (location . ,location-proc) (all-available . ,all-proc) (newest-available . ,newest-proc)) (output @@ -702,6 +705,7 @@ ENTRIES is a list of installed manifest entries." (obsolete . ,(apply-to-first obsolete-output-patterns)) (regexp . ,regexp-proc) (license . ,license-proc) + (location . ,location-proc) (all-available . ,all-proc) (newest-available . ,newest-proc))))) @@ -1097,3 +1101,41 @@ Return #t if the shell command was executed successfully." (define (license-entries search-type . search-values) (map license->sexp (apply find-licenses search-type search-values))) + + +;;; Package locations + +(define-values (packages-by-location-file + package-location-files) + (let* ((table (delay (fold-packages + (lambda (package table) + (let ((file (location-file + (package-location package)))) + (vhash-cons file package table))) + vlist-null))) + (files (delay (vhash-fold + (lambda (file _ result) + (if (member file result) + result + (cons file result))) + '() + (force table))))) + (values + (lambda (file) + "Return the (possibly empty) list of packages defined in location FILE." + (vhash-fold* cons '() file (force table))) + (lambda () + "Return the list of file names of all package locations." + (force files))))) + +(define %package-location-param-alist + `((id . ,identity) + (location . ,identity) + (number-of-packages . ,(lambda (location) + (length (packages-by-location-file location)))))) + +(define package-location->sexp + (object-transformer %package-location-param-alist)) + +(define (package-location-entries) + (map package-location->sexp (package-location-files))) diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el index de0331fff8..7ebe7e8b5c 100644 --- a/emacs/guix-messages.el +++ b/emacs/guix-messages.el @@ -40,6 +40,10 @@ ,(lambda (_ entries licenses) (apply #'guix-message-packages-by-license entries 'package licenses))) + (location + ,(lambda (_ entries locations) + (apply #'guix-message-packages-by-location + entries 'package locations))) (regexp (0 "No packages matching '%s'." val) (1 "A single package matching '%s'." val) @@ -72,6 +76,10 @@ ,(lambda (_ entries licenses) (apply #'guix-message-packages-by-license entries 'output licenses))) + (location + ,(lambda (_ entries locations) + (apply #'guix-message-packages-by-location + entries 'output locations))) (regexp (0 "No package outputs matching '%s'." val) (1 "A single package output matching '%s'." val) @@ -174,6 +182,13 @@ Try \"M-x guix-search-by-name\"." (str-end (format "with license '%s'" license))) (message "%s %s." str-beg str-end))) +(defun guix-message-packages-by-location (entries entry-type location) + "Display a message for packages or outputs searched by LOCATION." + (let* ((count (length entries)) + (str-beg (guix-message-string-entries count entry-type)) + (str-end (format "placed in '%s'" location))) + (message "%s %s." str-beg str-end))) + (defun guix-message-generations-by-time (profile entries times) "Display a message for generations searched by TIMES." (let* ((count (length entries)) diff --git a/emacs/guix-read.el b/emacs/guix-read.el index a1a6b86364..5423c9bcfa 100644 --- a/emacs/guix-read.el +++ b/emacs/guix-read.el @@ -62,6 +62,12 @@ "Return a list of names of available licenses." (guix-eval-read (guix-make-guile-expression 'license-names))) +(guix-memoized-defun guix-package-locations () + "Return a list of available package locations." + (sort (guix-eval-read (guix-make-guile-expression + 'package-location-files)) + #'string<)) + ;;; Readers @@ -131,6 +137,11 @@ :single-reader guix-read-license-name :single-prompt "License: ") +(guix-define-readers + :completions-getter guix-package-locations + :single-reader guix-read-package-location + :single-prompt "Location: ") + (provide 'guix-read) ;;; guix-read.el ends here diff --git a/emacs/guix-ui-license.el b/emacs/guix-ui-license.el new file mode 100644 index 0000000000..ab1d25bfd2 --- /dev/null +++ b/emacs/guix-ui-license.el @@ -0,0 +1,130 @@ +;;; guix-ui-license.el --- Interface for displaying licenses + +;; Copyright © 2016 Alex Kost <alezost@gmail.com> + +;; 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 this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file provides 'list'/'info' interface for displaying licenses of +;; Guix packages. + +;;; Code: + +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-info) +(require 'guix-backend) +(require 'guix-guile) + +(guix-define-entry-type license) + +(defun guix-license-get-entries (search-type &rest args) + "Receive 'license' entries. +SEARCH-TYPE may be one of the following symbols: `all', `id', `name'." + (guix-eval-read + (apply #'guix-make-guile-expression + 'license-entries search-type args))) + +(defun guix-license-get-display (search-type &rest args) + "Search for licenses and show results." + (apply #'guix-list-get-display-entries + 'license search-type args)) + +(defun guix-license-message (entries search-type &rest args) + "Display a message after showing license ENTRIES." + ;; Some objects in (guix licenses) module are procedures (e.g., + ;; 'non-copyleft' or 'x11-style'). Such licenses cannot be "described". + (when (null entries) + (if (cdr args) + (message "Unknown licenses.") + (message "Unknown license.")))) + + +;;; License 'info' + +(guix-info-define-interface license + :buffer-name "*Guix License Info*" + :get-entries-function 'guix-license-get-entries + :message-function 'guix-license-message + :format '((name ignore (simple guix-info-heading)) + ignore + guix-license-insert-packages-button + (url ignore (simple guix-url)) + guix-license-insert-comment) + :titles '((url . "URL"))) + +(declare-function guix-packages-by-license "guix-ui-package") + +(defun guix-license-insert-packages-button (entry) + "Insert button to display packages by license ENTRY." + (let ((license (guix-entry-value entry 'name))) + (guix-info-insert-action-button + "Packages" + (lambda (btn) + (guix-packages-by-license (button-get btn 'license))) + (format "Display packages with license '%s'" license) + 'license license))) + +(defun guix-license-insert-comment (entry) + "Insert 'comment' of a license ENTRY." + (let ((comment (guix-entry-value entry 'comment))) + (if (and comment + (string-match-p "^http" comment)) + (guix-info-insert-value-simple comment 'guix-url) + (guix-info-insert-title-simple + (guix-info-param-title 'license 'comment)) + (guix-info-insert-value-indent comment)))) + + +;;; License 'list' + +(guix-list-define-interface license + :buffer-name "*Guix Licenses*" + :get-entries-function 'guix-license-get-entries + :describe-function 'guix-license-list-describe + :message-function 'guix-license-message + :format '((name nil 40 t) + (url guix-list-get-url 50 t)) + :titles '((name . "License")) + :sort-key '(name)) + +(let ((map guix-license-list-mode-map)) + (define-key map (kbd "RET") 'guix-license-list-show-packages)) + +(defun guix-license-list-describe (ids) + "Describe licenses with IDS (list of identifiers)." + (guix-buffer-display-entries + (guix-entries-by-ids ids (guix-buffer-current-entries)) + 'info 'license (cl-list* 'id ids) 'add)) + +(defun guix-license-list-show-packages () + "Display packages with the license at point." + (interactive) + (guix-packages-by-license (guix-list-current-id))) + + +;;; Interactive commands + +;;;###autoload +(defun guix-licenses () + "Display licenses of the Guix packages." + (interactive) + (guix-license-get-display 'all)) + +(provide 'guix-ui-license) + +;;; guix-ui-license.el ends here diff --git a/emacs/guix-ui-location.el b/emacs/guix-ui-location.el new file mode 100644 index 0000000000..0027c1fba8 --- /dev/null +++ b/emacs/guix-ui-location.el @@ -0,0 +1,83 @@ +;;; guix-ui-location.el --- Interface for displaying package locations + +;; Copyright © 2016 Alex Kost <alezost@gmail.com> + +;; 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 Location as published by +;; the Free Software Foundation, either version 3 of the Location, 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 Location for more details. + +;; You should have received a copy of the GNU General Public Location +;; along with this program. If not, see <http://www.gnu.org/locations/>. + +;;; Commentary: + +;; This file provides a 'list' interface for displaying locations of Guix +;; packages. + +;;; Code: + +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-location) +(require 'guix-backend) + +(guix-define-entry-type location) + +(defun guix-location-get-entries () + "Receive 'package location' entries." + (guix-eval-read "(package-location-entries)")) + + +;;; Location 'list' + +(guix-list-define-interface location + :buffer-name "*Guix Package Locations*" + :get-entries-function 'guix-location-get-entries + :format '((location guix-location-list-file-name-specification 50 t) + (number-of-packages nil 10 guix-list-sort-numerically-1 + :right-align t)) + :sort-key '(location)) + +(let ((map guix-location-list-mode-map)) + (define-key map (kbd "RET") 'guix-location-list-show-packages) + ;; "Location Info" buffer is not defined (it would be useless), so + ;; unbind "i" key (by default, it is used to display Info buffer). + (define-key map (kbd "i") nil)) + +(defun guix-location-list-file-name-specification (location &optional _) + "Return LOCATION button specification for `tabulated-list-entries'." + (list location + 'face 'guix-list-file-name + 'action (lambda (btn) + (guix-find-location (button-get btn 'location))) + 'follow-link t + 'help-echo (concat "Find location: " location) + 'location location)) + +(declare-function guix-packages-by-location "guix-ui-package") + +(defun guix-location-list-show-packages () + "Display packages placed in the location at point." + (interactive) + (guix-packages-by-location (guix-list-current-id))) + + +;;; Interactive commands + +;;;###autoload +(defun guix-locations () + "Display locations of the Guix packages." + (interactive) + (guix-list-get-display-entries 'location)) + +(provide 'guix-ui-location) + +;;; guix-ui-location.el ends here diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el index df5f8d12d1..38f0c08fc7 100644 --- a/emacs/guix-ui-package.el +++ b/emacs/guix-ui-package.el @@ -1,6 +1,6 @@ ;;; guix-ui-package.el --- Interface for displaying packages -*- lexical-binding: t -*- -;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> +;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com> ;; This file is part of GNU Guix. @@ -38,6 +38,7 @@ (require 'guix-hydra-build) (require 'guix-read) (require 'guix-license) +(require 'guix-location) (require 'guix-profiles) (guix-ui-define-entry-type package) @@ -222,7 +223,7 @@ ENTRIES is a list of package entries to get info about packages." ignore (outputs simple guix-package-info-insert-outputs) (source simple guix-package-info-insert-source) - (location format (format guix-package-location)) + (location simple guix-package-info-insert-location) (home-url format (format guix-url)) (license format (format guix-package-license)) (systems format guix-package-info-insert-systems) @@ -345,9 +346,13 @@ formatted with this string, an action button is inserted.") (define-button-type 'guix-package-license :supertype 'guix 'face 'guix-package-info-license - 'help-echo "Browse license URL" + 'help-echo "Display license info" 'action (lambda (btn) - (guix-browse-license-url (button-label btn)))) + (require 'guix-ui-license) + (guix-buffer-get-display-entries + 'info 'license + (list 'name (button-label btn)) + 'add))) (define-button-type 'guix-package-name :supertype 'guix @@ -382,6 +387,22 @@ formatted with this string, an action button is inserted.") 'guix-package-heading 'spec (guix-package-entry->name-specification entry))) +(defun guix-package-info-insert-location (location &optional _) + "Insert package LOCATION at point." + (if (null location) + (guix-format-insert nil) + (let ((location-file (car (split-string location ":")))) + (guix-info-insert-value-indent location 'guix-package-location) + (guix-info-insert-indent) + (guix-info-insert-action-button + "Packages" + (lambda (btn) + (guix-package-get-display (guix-ui-current-profile) + 'location + (button-get btn 'location))) + (format "Display packages from location '%s'" location-file) + 'location location-file)))) + (defun guix-package-info-insert-systems (systems entry) "Insert supported package SYSTEMS at point." (guix-info-insert-value-format @@ -797,7 +818,7 @@ for all ARGS." (source simple guix-package-info-insert-source) (path simple (indent guix-file)) (dependencies simple (indent guix-file)) - (location format (format guix-package-location)) + (location simple guix-package-info-insert-location) (home-url format (format guix-url)) (license format (format guix-package-license)) (systems format guix-package-info-insert-systems) @@ -970,6 +991,16 @@ Interactively with prefix, prompt for PROFILE." (guix-package-get-display profile 'license license)) ;;;###autoload +(defun guix-packages-by-location (location &optional profile) + "Display Guix packages placed in LOCATION file. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (guix-read-package-location) + (guix-ui-read-profile))) + (guix-package-get-display profile 'location location)) + +;;;###autoload (defun guix-search-by-regexp (regexp &optional params profile) "Search for Guix packages by REGEXP. PARAMS are package parameters that should be searched. diff --git a/emacs.am b/emacs/local.mk index 1897e2e956..62e33e4fd2 100644 --- a/emacs.am +++ b/emacs/local.mk @@ -40,6 +40,7 @@ ELFILES = \ emacs/guix-init.el \ emacs/guix-license.el \ emacs/guix-list.el \ + emacs/guix-location.el \ emacs/guix-messages.el \ emacs/guix-pcomplete.el \ emacs/guix-popup.el \ @@ -47,6 +48,8 @@ ELFILES = \ emacs/guix-profiles.el \ emacs/guix-read.el \ emacs/guix-ui.el \ + emacs/guix-ui-license.el \ + emacs/guix-ui-location.el \ emacs/guix-ui-package.el \ emacs/guix-ui-generation.el \ emacs/guix-ui-system-generation.el \ @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io> ;;; ;;; This file is part of GNU Guix. @@ -32,6 +32,7 @@ (begin (define %public-modules '((gnu system) + (gnu system mapped-devices) (gnu system file-systems) (gnu system grub) ; 'grub-configuration' (gnu system pam) diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index 58ccf599d6..f277cbfa34 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -32,8 +32,10 @@ #:export (disk-partitions partition-label-predicate partition-uuid-predicate + partition-luks-uuid-predicate find-partition-by-label find-partition-by-uuid + find-partition-by-luks-uuid canonicalize-device-spec uuid->string @@ -79,6 +81,11 @@ "Bind-mount SOURCE at TARGET." (mount source target "" MS_BIND)) + +;;; +;;; Ext2 file systems. +;;; + (define-syntax %ext2-endianness ;; Endianness of ext2 file systems. (identifier-syntax (endianness little))) @@ -136,6 +143,63 @@ if DEVICE does not contain an ext2 file system." #f (list->string (map integer->char bytes)))))) + +;;; +;;; LUKS encrypted devices. +;;; + +;; The LUKS header format is described in "LUKS On-Disk Format Specification": +;; <http://wiki.cryptsetup.googlecode.com/git/LUKS-standard/>. We follow +;; version 1.2.1 of this document. + +(define-syntax %luks-endianness + ;; Endianness of LUKS headers. + (identifier-syntax (endianness big))) + +(define-syntax %luks-header-size + ;; Size in bytes of the LUKS header, including key slots. + (identifier-syntax 592)) + +(define %luks-magic + ;; The 'LUKS_MAGIC' constant. + (u8-list->bytevector (append (map char->integer (string->list "LUKS")) + (list #xba #xbe)))) + +(define (sub-bytevector bv start size) + "Return a copy of the SIZE bytes of BV starting from offset START." + (let ((result (make-bytevector size))) + (bytevector-copy! bv start result 0 size) + result)) + +(define (read-luks-header file) + "Read a LUKS header from FILE. Return the raw header on success, and #f if +not valid header was found." + (call-with-input-file file + (lambda (port) + (let ((header (make-bytevector %luks-header-size))) + (match (get-bytevector-n! port header 0 (bytevector-length header)) + ((? eof-object?) + #f) + ((? number? len) + (and (= len (bytevector-length header)) + (let ((magic (sub-bytevector header 0 6)) ;XXX: inefficient + (version (bytevector-u16-ref header 6 %luks-endianness))) + (and (bytevector=? magic %luks-magic) + (= version 1) + header))))))))) + +(define (luks-header-uuid header) + "Return the LUKS UUID from HEADER, as a 16-byte bytevector." + ;; 40 bytes are reserved for the UUID, but in practice, it contains the 36 + ;; bytes of its ASCII representation. + (let ((uuid (sub-bytevector header 168 36))) + (string->uuid (utf8->string uuid)))) + + +;;; +;;; Partition lookup. +;;; + (define (disk-partitions) "Return the list of device names corresponding to valid disk partitions." (define (partition? major minor) @@ -167,42 +231,53 @@ if DEVICE does not contain an ext2 file system." (loop (cons name parts)) (loop parts)))))))))) -(define (read-ext2-superblock* device) - "Like 'read-ext2-superblock', but return #f when DEVICE does not exist -instead of throwing an exception." - (catch 'system-error - (lambda () - (read-ext2-superblock device)) - (lambda args - ;; When running on the hand-made /dev, - ;; 'disk-partitions' could return partitions for which - ;; we have no /dev node. Handle that gracefully. - (if (= ENOENT (system-error-errno args)) - (begin - (format (current-error-port) - "warning: device '~a' not found~%" device) - #f) - (apply throw args))))) - -(define (partition-predicate field =) - "Return a predicate that returns true if the FIELD of an ext2 superblock is -= to the given value." - (lambda (expected) - "Return a procedure that, when applied to a partition name such as \"sda1\", +(define (ENOENT-safe proc) + "Wrap the one-argument PROC such that ENOENT errors are caught and lead to a +warning and #f as the result." + (lambda (device) + (catch 'system-error + (lambda () + (proc device)) + (lambda args + ;; When running on the hand-made /dev, + ;; 'disk-partitions' could return partitions for which + ;; we have no /dev node. Handle that gracefully. + (if (= ENOENT (system-error-errno args)) + (begin + (format (current-error-port) + "warning: device '~a' not found~%" device) + #f) + (apply throw args)))))) + +(define (partition-predicate read field =) + "Return a predicate that returns true if the FIELD of partition header that +was READ is = to the given value." + (let ((read (ENOENT-safe read))) + (lambda (expected) + "Return a procedure that, when applied to a partition name such as \"sda1\", returns #t if that partition's volume name is LABEL." - (lambda (part) - (let* ((device (string-append "/dev/" part)) - (sblock (read-ext2-superblock* device))) - (and sblock - (let ((actual (field sblock))) - (and actual - (= actual expected)))))))) + (lambda (part) + (let* ((device (string-append "/dev/" part)) + (sblock (read device))) + (and sblock + (let ((actual (field sblock))) + (and actual + (= actual expected))))))))) (define partition-label-predicate - (partition-predicate ext2-superblock-volume-name string=?)) + (partition-predicate read-ext2-superblock + ext2-superblock-volume-name + string=?)) (define partition-uuid-predicate - (partition-predicate ext2-superblock-uuid bytevector=?)) + (partition-predicate read-ext2-superblock + ext2-superblock-uuid + bytevector=?)) + +(define partition-luks-uuid-predicate + (partition-predicate read-luks-header + luks-header-uuid + bytevector=?)) (define (find-partition-by-label label) "Return the first partition found whose volume name is LABEL, or #f if none @@ -218,6 +293,13 @@ or #f if none was found." (disk-partitions)) (cut string-append "/dev/" <>))) +(define (find-partition-by-luks-uuid uuid) + "Return the first LUKS partition whose unique identifier is UUID (a bytevector), +or #f if none was found." + (and=> (find (partition-luks-uuid-predicate uuid) + (disk-partitions)) + (cut string-append "/dev/" <>))) + ;;; ;;; UUIDs. diff --git a/gnu-system.am b/gnu/local.mk index 02c7374569..1b54b3a855 100644 --- a/gnu-system.am +++ b/gnu/local.mk @@ -4,6 +4,7 @@ # Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> # Copyright © 2013, 2014, 2015, 2016 Mark H Weaver <mhw@netris.org> # Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> +# Copyright © 2016 Kei Yamashita <kei@openmailbox.org> # # This file is part of GNU Guix. # @@ -90,6 +91,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/dejagnu.scm \ gnu/packages/dico.scm \ gnu/packages/dictionaries.scm \ + gnu/packages/dillo.scm \ gnu/packages/disk.scm \ gnu/packages/djvu.scm \ gnu/packages/dns.scm \ @@ -220,6 +222,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/mail.scm \ gnu/packages/make-bootstrap.scm \ gnu/packages/markdown.scm \ + gnu/packages/marst.scm \ gnu/packages/mate.scm \ gnu/packages/maths.scm \ gnu/packages/mc.scm \ @@ -382,6 +385,7 @@ GNU_SYSTEM_MODULES = \ gnu/system/linux-container.scm \ gnu/system/linux-initrd.scm \ gnu/system/locale.scm \ + gnu/system/mapped-devices.scm \ gnu/system/nss.scm \ gnu/system/pam.scm \ gnu/system/shadow.scm \ @@ -629,6 +633,7 @@ dist_patch_DATA = \ gnu/packages/patches/openimageio-boost-1.60.patch \ gnu/packages/patches/openjpeg-CVE-2015-6581.patch \ gnu/packages/patches/openjpeg-use-after-free-fix.patch \ + gnu/packages/patches/openssh-CVE-2015-8325.patch \ gnu/packages/patches/openssl-runpath.patch \ gnu/packages/patches/openssl-c-rehash-in.patch \ gnu/packages/patches/orpheus-cast-errors-and-includes.patch \ @@ -685,6 +690,7 @@ dist_patch_DATA = \ gnu/packages/patches/python-paste-remove-website-test.patch \ gnu/packages/patches/python-paste-remove-timing-test.patch \ gnu/packages/patches/python2-pygobject-2-gi-info-type-error-domain.patch \ + gnu/packages/patches/python-pandas-fix-tslib-test-failure.patch \ gnu/packages/patches/qemu-CVE-2015-8558.patch \ gnu/packages/patches/qemu-CVE-2015-8567.patch \ gnu/packages/patches/qemu-CVE-2015-8613.patch \ diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index b76aadc6a2..c49b0a9e17 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -922,6 +922,75 @@ also includes an interface for tabix.") (define-public python2-pysam (package-with-python2 python-pysam)) +(define-public python-twobitreader + (package + (name "python-twobitreader") + (version "3.1.2") + (source (origin + (method url-fetch) + (uri (pypi-uri "twobitreader" version)) + (sha256 + (base32 + "0y408fp6psqzwxpcpqn0wp7fr41dwz8d54wpj6j261fj5q8vs169")))) + (properties `((python2-variant . ,(delay python2-twobitreader)))) + (build-system python-build-system) + (native-inputs + `(("python-sphinx" ,python-sphinx))) + (home-page "https://github.com/benjschiller/twobitreader") + (synopsis "Python library for reading .2bit files") + (description + "twobitreader is a Python library for reading .2bit files as used by the +UCSC genome browser.") + (license license:artistic2.0))) + +(define-public python2-twobitreader + (let ((base (package-with-python2 (strip-python2-variant python-twobitreader)))) + (package + (inherit base) + (native-inputs `(("python2-setuptools" ,python2-setuptools) + ,@(package-native-inputs base)))))) + +(define-public python-plastid + (package + (name "python-plastid") + (version "0.4.5") + (source (origin + (method url-fetch) + (uri (pypi-uri "plastid" version)) + (sha256 + (base32 + "1nhxw8a5gn9as58i2ih52c5cjwj48ik418pzsjwph3s66mmy9yvq")))) + (properties `((python2-variant . ,(delay python2-plastid)))) + (build-system python-build-system) + (arguments + ;; Some test files are not included. + `(#:tests? #f)) + (propagated-inputs + `(("python-numpy" ,python-numpy) + ("python-scipy" ,python-scipy) + ("python-pandas" ,python-pandas) + ("python-pysam" ,python-pysam) + ("python-matplotlib" ,python-matplotlib) + ("python-biopython" ,python-biopython) + ("python-twobitreader" ,python-twobitreader))) + (native-inputs + `(("python-cython" ,python-cython) + ("python-nose" ,python-nose))) + (home-page "https://github.com/joshuagryphon/plastid") + (synopsis "Python library for genomic analysis") + (description + "plastid is a Python library for genomic analysis – in particular, +high-throughput sequencing data – with an emphasis on simplicity.") + (license license:bsd-3))) + +(define-public python2-plastid + (let ((base (package-with-python2 (strip-python2-variant python-plastid)))) + (package + (inherit base) + ;; setuptools is required at runtime + (propagated-inputs `(("python2-setuptools" ,python2-setuptools) + ,@(package-propagated-inputs base)))))) + (define-public cd-hit (package (name "cd-hit") @@ -2075,9 +2144,9 @@ HMMs).") from high-throughput sequencing assays.") (license license:gpl3+))) -(define-public htsjdk +(define-public java-htsjdk (package - (name "htsjdk") + (name "java-htsjdk") (version "1.129") (source (origin (method url-fetch) @@ -3012,9 +3081,9 @@ any particular back-end implementation, and supports use of multiple back-ends simultaneously.") (license license:public-domain))) -(define-public ngs-java +(define-public java-ngs (package (inherit ngs-sdk) - (name "ngs-java") + (name "java-ngs") (arguments `(,@(substitute-keyword-arguments `(#:modules ((guix build gnu-build-system) @@ -3077,7 +3146,7 @@ simultaneously.") (string-append "--with-ngs-sdk-prefix=" (assoc-ref inputs "ngs-sdk")) (string-append "--with-ngs-java-prefix=" - (assoc-ref inputs "ngs-java")) + (assoc-ref inputs "java-ngs")) (string-append "--with-hdf5-prefix=" (assoc-ref inputs "hdf5")))))) (alist-cons-after @@ -3103,7 +3172,7 @@ simultaneously.") (inputs `(("libxml2" ,libxml2) ("ngs-sdk" ,ngs-sdk) - ("ngs-java" ,ngs-java) + ("java-ngs" ,java-ngs) ("libmagic" ,file) ("hdf5" ,hdf5))) (native-inputs `(("perl" ,perl))) diff --git a/gnu/packages/bittorrent.scm b/gnu/packages/bittorrent.scm index 26b0fc6fdc..d8252c8b37 100644 --- a/gnu/packages/bittorrent.scm +++ b/gnu/packages/bittorrent.scm @@ -207,7 +207,7 @@ interface, for the Transmission BitTorrent daemon.") (define-public aria2 (package (name "aria2") - (version "1.21.0") + (version "1.22.0") (source (origin (method url-fetch) (uri (string-append "https://github.com/tatsuhiro-t/aria2/" @@ -215,7 +215,7 @@ interface, for the Transmission BitTorrent daemon.") name "-" version ".tar.xz")) (sha256 (base32 - "1035rzx9y7qv4p7cv04f461343dxha7ikprch059x2fci8n5yp12")))) + "12agwdvvkr34wqhyyfp418dj0k7nbr297qmcd3wj5kkn7brv6gxc")))) (build-system gnu-build-system) (arguments `(#:configure-flags '("--enable-libaria2") diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm index f5bf069c20..1ada01c904 100644 --- a/gnu/packages/bootstrap.scm +++ b/gnu/packages/bootstrap.scm @@ -166,6 +166,7 @@ successful, or false to signal an error." ((string=? system "mips64el-linux") "/lib/ld.so.1") ((string=? system "i586-gnu") "/lib/ld.so.1") ((string=? system "i686-gnu") "/lib/ld.so.1") + ((string=? system "aarch64-linux") "/lib/ld-linux-aarch64.so.1") ;; XXX: This one is used bare-bones, without a libc, so add a case ;; here just so we can keep going. diff --git a/gnu/packages/compression.scm b/gnu/packages/compression.scm index de5d03af22..8043422f8b 100644 --- a/gnu/packages/compression.scm +++ b/gnu/packages/compression.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2015 Jeff Mickey <j@codemac.net> ;;; Copyright © 2015, 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> +;;; Copyright © 2016 Danny Milosavljevic <dannym@scratchpost.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -731,3 +732,26 @@ similar in speed to deflate but offers denser compression. This package provides encoder and a decoder libraries: libbrotlienc and libbrotlidec, respectively, based on the reference implementation from Google.") (license license:expat)))) + +(define-public cabextract + (package + (name "cabextract") + (version "1.6") + (source (origin + (method url-fetch) + (uri (string-append + "http://cabextract.org.uk/cabextract-" version ".tar.gz")) + (sha256 + (base32 + "1ysmmz25fjghq7mxb2anyyvr1ljxqxzi4piwjhk0sdamcnsn3rnf")))) + (build-system gnu-build-system) + (arguments '(#:configure-flags '("--with-external-libmspack"))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (inputs + `(("libmspack" ,libmspack))) + (home-page "http://www.cabextract.org.uk/") + (synopsis "Tool to unpack Cabinet archives") + (description "Extracts files out of Microsoft Cabinet (.cab) archives") + ;; Some source files specify gpl2+, lgpl2+, however COPYING is gpl3. + (license license:gpl3+))) diff --git a/gnu/packages/dillo.scm b/gnu/packages/dillo.scm new file mode 100644 index 0000000000..0fd84d9177 --- /dev/null +++ b/gnu/packages/dillo.scm @@ -0,0 +1,63 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Kei Yamashita <kei@openmailbox.org> +;;; +;;; 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 (gnu packages dillo) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix packages) + #:use-module (gnu packages) + #:use-module (gnu packages compression) + #:use-module (gnu packages fltk) + #:use-module (gnu packages fontutils) + #:use-module (gnu packages perl) + #:use-module (gnu packages pkg-config) + #:use-module (gnu packages image) + #:use-module (gnu packages tls) + #:use-module (gnu packages xorg) + #:use-module (guix download) + #:use-module (guix build-system gnu)) + +(define-public dillo + (package + (name "dillo") + (version "3.0.5") + (source (origin + (method url-fetch) + (uri (string-append "http://www.dillo.org/download/" + name "-" version ".tar.bz2")) + (sha256 + (base32 + "12ql8n1lypv3k5zqgwjxlw1md90ixz3ag6j1gghfnhjq3inf26yv")))) + (build-system gnu-build-system) + (arguments `(#:configure-flags '("--enable-ssl" "--enable-ipv6"))) + (native-inputs `(("pkg-config" ,pkg-config))) + (inputs `(("fltk" ,fltk) + ("fontconfig" ,fontconfig) + ("libjpeg" ,libjpeg) + ("libpng" ,libpng) + ("libxcursor" ,libxcursor) + ("libxft" ,libxft) + ("libxi" ,libxi) + ("libxinerama" ,libxinerama) + ("openssl" ,openssl) + ("perl" ,perl) + ("zlib" ,zlib))) + (synopsis "Very small and fast graphical web browser") + (description "Dillo is a minimalistic web browser particularly intended for +older or slower computers and embedded systems.") + (home-page "http://www.dillo.org") + (license license:gpl3+))) diff --git a/gnu/packages/fltk.scm b/gnu/packages/fltk.scm index 4dec9bc288..a0180c0432 100644 --- a/gnu/packages/fltk.scm +++ b/gnu/packages/fltk.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 John Darrington <jmd@gnu.org> ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2016 Kei Yamashita <kei@openmailbox.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -52,6 +53,7 @@ `(("libjpeg" ,libjpeg-8) ;jpeg_read_header argument error in libjpeg-9 ("libpng" ,libpng) ("libx11" ,libx11) + ("libxft" ,libxft) ("mesa" ,mesa) ("zlib" ,zlib))) (arguments diff --git a/gnu/packages/java.scm b/gnu/packages/java.scm index 9b6a647f25..02131f10d0 100644 --- a/gnu/packages/java.scm +++ b/gnu/packages/java.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Leo Famulari <leo@famulari.name> ;;; ;;; This file is part of GNU Guix. @@ -51,9 +51,9 @@ #:use-module (gnu packages texinfo) #:use-module ((srfi srfi-1) #:select (fold alist-delete))) -(define-public swt +(define-public java-swt (package - (name "swt") + (name "java-swt") (version "4.4.2") (source (origin (method url-fetch) @@ -577,7 +577,7 @@ build process and its dependencies, whereas Make uses Makefile format.") (license license:gpl2+))) (define-public icedtea-7 - (let* ((version "2.6.4") + (let* ((version "2.6.5") (drop (lambda (name hash) (origin (method url-fetch) @@ -594,7 +594,7 @@ build process and its dependencies, whereas Make uses Makefile format.") version ".tar.xz")) (sha256 (base32 - "0r31h8nlsrbfdkgbjbb7phwgcwglc9siznzrr40lqnm9xrgkc2nj")) + "1xskigsa1i8hycbagb0f6idyb16x8dkixcdyaacsw4dvjr230lp7")) (modules '((guix build utils))) (snippet '(substitute* "Makefile.in" @@ -669,6 +669,8 @@ build process and its dependencies, whereas Make uses Makefile format.") (setenv "CC" "gcc") (setenv "CPATH" (string-append gcjinclude ":" + (assoc-ref inputs "libxcomposite") + "/include/X11/extensions" ":" (assoc-ref inputs "libxrender") "/include/X11/extensions" ":" (assoc-ref inputs "libxtst") @@ -719,26 +721,111 @@ build process and its dependencies, whereas Make uses Makefile format.") (native-inputs `(("openjdk-src" ,(drop "openjdk" - "1qjjf71nq80ac2d08hbaa8589d31vk313z3rkirnwq5df8cyf0mv")) + "1nxb8b0p1v57ix8gp22ifg9vg0p0lhr59g5vi74f7abg3almcvy6")) ("corba-drop" ,(drop "corba" - "025warxhjal3nr7w1xyd16k0f32fwkchifpaslzyidsga3hgmfr6")) + "0zz7gz8fq7qnifzm2jgir2i6rcp0d2h32lcxvlfs24w5szynjya2")) ("jaxp-drop" ,(drop "jaxp" - "0qiz6swb78w9c0mf88pf0gflgm5rp9k0l6fv6sdl7dki691b0z09")) + "0ym3bcril6507bpbw5mkkw0zmfg3s1nkbsvs2lg0c1q8kyyf3dbv")) ("jaxws-drop" ,(drop "jaxws" - "18fz4gl4fdlcmqvh1mlpd9h0gj0qizpfa7njkax97aysmsm08xns")) + "1l16x4dwhgfpnk32xbigb1kzkvgj0b6zzhdg4rpkywa7gvg9lxaf")) ("jdk-drop" ,(drop "jdk" - "0qsx5d9pgwlz9vbpapw4jwpajqc6rwk1150cjb33i4n3z709jccx")) + "1fi18ji83d0dqzg35kcm4bksg2z3fbg772p05wgw4rhh7dai0f6d")) ("langtools-drop" ,(drop "langtools" - "1k6plx96smf86z303gb30hncssa8f40qdryzsdv349iwqwacxc7r")) + "1nbqg8sw7z7f3bhxng0xdp8vl2nc5wqz0xii1j566qdgc1n6fv3c")) ("hotspot-drop" ,(drop "hotspot" - "0r9ffzyf5vxs8wg732szqcil0ksc8lcxzihdv3viz7d67dy42irp")) + "1z0w8h1jjvxlqzlrwasy323fygx90if09rvqjk4ymaqhzcr35623")) ,@(fold alist-delete (package-native-inputs icedtea-6) - '("openjdk6-src"))))))) + '("openjdk6-src")))) + (inputs + `(("libxcomposite" ,libxcomposite) + ,@(package-inputs icedtea-6)))))) + +(define-public icedtea-8 + (let* ((version "3.0.0") + (drop (lambda (name hash) + (origin + (method url-fetch) + (uri (string-append + "http://icedtea.classpath.org/download/drops/" + "/icedtea8/" version "/" name ".tar.xz")) + (sha256 (base32 hash)))))) + (package (inherit icedtea-7) + (version "3.0.0") + (source (origin + (method url-fetch) + (uri (string-append + "http://icedtea.wildebeest.org/download/source/icedtea-" + version ".tar.xz")) + (sha256 + (base32 + "1a99hvx5d0dcinlixgy0wzv2f7jnzi8jp7hcrf2pd7dqndlxsyll")) + (modules '((guix build utils))) + (snippet + '(substitute* "Makefile.am" + ;; do not leak information about the build host + (("DISTRIBUTION_ID=\"\\$\\(DIST_ID\\)\"") + "DISTRIBUTION_ID=\"\\\"guix\\\"\""))))) + (arguments + (substitute-keyword-arguments (package-arguments icedtea-7) + ((#:configure-flags flags) + `(let ((jdk (assoc-ref %build-inputs "jdk"))) + `(;;"--disable-bootstrap" + "--enable-bootstrap" + "--enable-nss" + "--disable-downloading" + "--disable-tests" ;they are run in the check phase instead + "--with-openjdk-src-dir=./openjdk.src" + ,(string-append "--with-jdk-home=" jdk)))) + ((#:phases phases) + `(modify-phases ,phases + (delete 'fix-x11-extension-include-path) + (delete 'patch-paths) + (delete 'set-additional-paths) + (delete 'patch-patches) + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let ((doc (string-append (assoc-ref outputs "doc") + "/share/doc/icedtea")) + (jre (assoc-ref outputs "out")) + (jdk (assoc-ref outputs "jdk"))) + (copy-recursively "openjdk.build/docs" doc) + (copy-recursively "openjdk.build/images/j2re-image" jre) + (copy-recursively "openjdk.build/images/j2sdk-image" jdk) + #t))))))) + (native-inputs + `(("jdk" ,icedtea-7 "jdk") + ("openjdk-src" + ,(drop "openjdk" + "0cchcrkj3pbjw3r6w08d8fkcjp98fyqp15bv88ljakjcsxrjc0sv")) + ("corba-drop" + ,(drop "corba" + "1k5khy8g0bk8yas81infh4l8rradpslzs0bblri0aqn9s3aq0x6p")) + ("jaxp-drop" + ,(drop "jaxp" + "1s167lwh1bxkjmbcyk1pb9r919hfbjgh2shig3d1qmj24r2fbk2c")) + ("jaxws-drop" + ,(drop "jaxws" + "0xphl8127in0634401f8v3b42mh14v1zdzd7ar10h9m5m84hcmgg")) + ("jdk-drop" + ,(drop "jdk" + "1kdi5v0vf7swkh2r4isdibw8zzsp34d1aa1sbxl5ljc9lfmbhx7s")) + ("langtools-drop" + ,(drop "langtools" + "11pa0sr4yi0nnfwhz25410zimc3jm367cvrhg5jm0xc5rykydq70")) + ("hotspot-drop" + ,(drop "hotspot" + "1my0g9snpd6619y82b4m96wc7ncvf1hw5yqrbh3n1pjgm2k7ywbn")) + ("nashorn-drop" + ,(drop "nashorn" + "1h12a61q3bw8zabhpp6aawfg3pwixjcya64595rj07sid619vidl")) + ,@(fold alist-delete (package-native-inputs icedtea-7) + '("gcj" "openjdk-src" "corba-drop" "jaxp-drop" "jaxws-drop" + "jdk-drop" "langtools-drop" "hotspot-drop"))))))) (define-public icedtea icedtea-7) diff --git a/gnu/packages/libusb.scm b/gnu/packages/libusb.scm index 61136791d3..1e72442c73 100644 --- a/gnu/packages/libusb.scm +++ b/gnu/packages/libusb.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com> -;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; ;;; This file is part of GNU Guix. @@ -28,11 +28,13 @@ #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module (guix build-system glib-or-gtk) + #:use-module (guix build-system python) #:use-module (gnu packages gnupg) #:use-module (gnu packages gtk) #:use-module (gnu packages linux) #:use-module (gnu packages mp3) #:use-module (gnu packages pkg-config) + #:use-module (gnu packages python) #:use-module (gnu packages xiph)) (define-public libusb @@ -87,6 +89,49 @@ devices on various operating systems.") version of libusb to run with newer libusb.") (license lgpl2.1+))) +(define-public python-pyusb + (package + (name "python-pyusb") + (version "1.0.0rc1") + (source + (origin + (method url-fetch) + (uri (pypi-uri "pyusb" version)) + (sha256 + (base32 + "07cjq11qhngzjd746k7688s6y2x7lpj669fxqfsiy985rg0jsn7j")))) + (build-system python-build-system) + (arguments + `(#:tests? #f ;no tests + #:modules ((srfi srfi-26) + (guix build utils) + (guix build python-build-system)) + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'fix-libusb-reference + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "usb/libloader.py" + (("lib = locate_library\\(candidates, find_library\\)") + (string-append + "lib = \"" + (car (find-files (assoc-ref inputs "libusb") + (lambda (file stat) + (and ((file-name-predicate + "^libusb-.*\\.so\\..*") file stat) + (not (symbolic-link? file)))))) + "\""))) + #t))))) + (inputs + `(("libusb" ,libusb))) + (home-page "http://walac.github.io/pyusb/") + (synopsis "Python bindings to the libusb library") + (description + "PyUSB aims to be an easy to use Python module to access USB devices.") + (license bsd-3))) + +(define-public python2-pyusb + (package-with-python2 python-pyusb)) + (define-public libmtp (package (name "libmtp") diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index e1a12045df..a26e641342 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -10,6 +10,7 @@ ;;; Copyright © 2016 Tobias Geerinckx-Rice <tobias.geerinckx.rice@gmail.com> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Raymond Nicholson <rain1@openmailbox.org> +;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -81,6 +82,7 @@ (cond ((string=? arch "i686") "i386") ((string-prefix? "mips" arch) "mips") ((string-prefix? "arm" arch) "arm") + ((string-prefix? "aarch64" arch) "arm64") (else arch)))) (define (linux-libre-urls version) @@ -220,7 +222,7 @@ for SYSTEM and optionally VARIANT, or #f if there is no such configuration." (search-path %load-path file))) (define-public linux-libre - (let* ((version "4.5.1") + (let* ((version "4.5.2") (build-phase '(lambda* (#:key system inputs #:allow-other-keys #:rest args) ;; Avoid introducing timestamps @@ -298,7 +300,7 @@ for SYSTEM and optionally VARIANT, or #f if there is no such configuration." (uri (linux-libre-urls version)) (sha256 (base32 - "1x621kvaf842bzpgglfl31zi74ny9w9jgvmkz3z6m3708n8clrdh")))) + "0mw8n5pms33k3m3aamlryahrcbhfnqbzvkglgw3j4dhaja3hwr7n")))) (build-system gnu-build-system) (supported-systems '("x86_64-linux" "i686-linux")) (native-inputs `(("perl" ,perl) @@ -335,13 +337,13 @@ It has been modified to remove all non-free binary blobs.") (define-public linux-libre-4.4 (package (inherit linux-libre) - (version "4.4.7") + (version "4.4.8") (source (origin (method url-fetch) (uri (linux-libre-urls version)) (sha256 (base32 - "031wh2k204zvshira28bf33sk1bbk19ilgqmkvkwjp6spk5wmvpq")))) + "0zyhdy01gjglgmlrmpqa1sdnm0z91mzwspbksj6zvcamczb8ml53")))) (native-inputs (let ((conf (kernel-config (or (%current-target-system) (%current-system)) @@ -352,13 +354,13 @@ It has been modified to remove all non-free binary blobs.") (define-public linux-libre-4.1 (package (inherit linux-libre) - (version "4.1.21") + (version "4.1.22") (source (origin (method url-fetch) (uri (linux-libre-urls version)) (sha256 (base32 - "1gfzwiinpxzhqb5xi7b1iv7ay96nrjlhia6bvcyq8ffkx7a2r715")))) + "0bn6qba7q4i3yn3zx2p56gawnb2gczrf4vyrjggirj4d60gvng7y")))) (native-inputs (let ((conf (kernel-config (or (%current-target-system) (%current-system)) @@ -1463,14 +1465,14 @@ system.") (define-public kbd (package (name "kbd") - (version "2.0.2") + (version "2.0.3") (source (origin (method url-fetch) (uri (string-append "mirror://kernel.org/linux/utils/kbd/kbd-" version ".tar.xz")) (sha256 (base32 - "04mrms12nm5sas0nxs94yrr3hz7gmqhnmfgb9ff34bh1jszxmzcx")) + "0ppv953gn2zylcagr4z6zg5y2x93dxrml29plypg6xgbq3hrv2bs")) (modules '((guix build utils))) (snippet '(begin @@ -1484,27 +1486,26 @@ system.") "tty")))))) (build-system gnu-build-system) (arguments - '(#:phases (alist-cons-before - 'build 'pre-build - (lambda* (#:key inputs #:allow-other-keys) - (let ((gzip (assoc-ref %build-inputs "gzip")) - (bzip2 (assoc-ref %build-inputs "bzip2"))) - (substitute* "src/libkeymap/findfile.c" - (("gzip") - (string-append gzip "/bin/gzip")) - (("bzip2") - (string-append bzip2 "/bin/bzip2"))))) - (alist-cons-after - 'install 'post-install - (lambda* (#:key outputs #:allow-other-keys) - ;; Make sure these programs find their comrades. - (let* ((out (assoc-ref outputs "out")) - (bin (string-append out "/bin"))) - (for-each (lambda (prog) - (wrap-program (string-append bin "/" prog) - `("PATH" ":" prefix (,bin)))) - '("unicode_start" "unicode_stop")))) - %standard-phases)))) + '(#:phases + (modify-phases %standard-phases + (add-before 'build 'pre-build + (lambda* (#:key inputs #:allow-other-keys) + (let ((gzip (assoc-ref %build-inputs "gzip")) + (bzip2 (assoc-ref %build-inputs "bzip2"))) + (substitute* "src/libkeymap/findfile.c" + (("gzip") + (string-append gzip "/bin/gzip")) + (("bzip2") + (string-append bzip2 "/bin/bzip2")))))) + (add-after 'install 'post-install + (lambda* (#:key outputs #:allow-other-keys) + ;; Make sure these programs find their comrades. + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin"))) + (for-each (lambda (prog) + (wrap-program (string-append bin "/" prog) + `("PATH" ":" prefix (,bin)))) + '("unicode_start" "unicode_stop")))))))) (inputs `(("check" ,check) ("gzip" ,gzip) ("bzip2" ,bzip2) @@ -2104,6 +2105,26 @@ WLAN, Bluetooth and mobile broadband.") (license (license:non-copyleft "file://COPYING" "See COPYING in the distribution.")))) +(define-public acpi + (package + (name "acpi") + (version "1.7") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/acpiclient/" + name "-" version ".tar.gz")) + (sha256 + (base32 + "01ahldvf0gc29dmbd5zi4rrnrw2i1ajnf30sx2vyaski3jv099fp")))) + (build-system gnu-build-system) + (home-page "http://acpiclient.sourceforge.net") + (synopsis "Display information on ACPI devices") + (description "@code{acpi} attempts to replicate the functionality of the +\"old\" @code{apm} command on ACPI systems, including battery and thermal +information. It does not support ACPI suspending, only displays information +about ACPI devices.") + (license license:gpl2+))) + (define-public acpid (package (name "acpid") diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index fd379b7968..56e85712db 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -1164,13 +1164,13 @@ maintained.") (define-public khard (package (name "khard") - (version "0.8.1") + (version "0.9.0") (source (origin (method url-fetch) (uri (pypi-uri name version)) (sha256 (base32 - "098gs94qmnspdfn6ar8lycx7dbsz9bcff90aps0cmn47mw7llch0")))) + "0y83rji4f270hbb41m4jpr0z3yzvpvbsl32mpg9d38hlydw8fk1s")))) (build-system python-build-system) (arguments `(#:python ,python-2 ; only python-2 is supported. diff --git a/gnu/packages/marst.scm b/gnu/packages/marst.scm new file mode 100644 index 0000000000..7d4a4f364d --- /dev/null +++ b/gnu/packages/marst.scm @@ -0,0 +1,43 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright 2016 John Darrington <jmd@gnu.org> +;;; +;;; 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 (gnu packages marst) + #:use-module (guix packages) + #:use-module (guix licenses) + #:use-module (guix download) + #:use-module (gnu packages compression) + #:use-module (guix build-system gnu)) + +(define-public marst + (package + (name "marst") + (version "2.7") + (source + (origin + (method url-fetch) + (uri (string-append + "mirror://gnu/" name "/" name "-" version + ".tar.gz")) + (sha256 + (base32 "0l6swjy8fjrqw89ghc1vvakg21jmpfkpsw92yssrzkg3rg8vkrry")))) + (build-system gnu-build-system) + (home-page "http://www.gnu.org/software/marst") + (synopsis "Algol to C translator") + (description "MARST is an Algol-to-C translator. It automatically translates programs +written on the algorithmic language Algol 60 to the C programming language.") + (license gpl3+))) diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index d009905346..7ea4ca3066 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2014 Mathieu Lirzin <mathieu.lirzin@openmailbox.org> -;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015, 2016 Efraim Flashner <efraim@flashner.co.il> @@ -1484,14 +1484,14 @@ full text searching.") (define-public armadillo (package (name "armadillo") - (version "6.400.3") + (version "6.700.4") (source (origin (method url-fetch) (uri (string-append "mirror://sourceforge/arma/armadillo-" version ".tar.gz")) (sha256 (base32 - "0bsgrmldlx77w5x26n3axj1hg6iw6csyw0dwl1flrbdwl51f9701")))) + "0dsdjcps5l2nhg0455rrc708inffarzj7n435vj4sm9lxwf21wg9")))) (build-system cmake-build-system) (arguments `(#:tests? #f)) ;no test target (inputs diff --git a/gnu/packages/music.scm b/gnu/packages/music.scm index 280f3840bb..8f971f3614 100644 --- a/gnu/packages/music.scm +++ b/gnu/packages/music.scm @@ -775,7 +775,7 @@ is subjective.") (string-append "PREFIX=" (assoc-ref %outputs "out")) (string-append "SWT_PATH=" - (assoc-ref %build-inputs "swt") + (assoc-ref %build-inputs "java-swt") "/share/java/swt.jar")) #:tests? #f ;no "check" target #:parallel-build? #f ;not supported @@ -790,11 +790,11 @@ is subjective.") (string-append "GCJFLAGS=-fsource=1.4 -fPIC " rest)) (("PROPERTIES\\?=") (string-append "PROPERTIES?= -Dswt.library.path=" - (assoc-ref inputs "swt") "/lib")) + (assoc-ref inputs "java-swt") "/lib")) (("\\$\\(GCJ\\) -o") "$(GCJ) $(LDFLAGS) -o")) #t))))) (inputs - `(("swt" ,swt))) + `(("java-swt" ,java-swt))) (native-inputs `(("gcj" ,gcj) ("pkg-config" ,pkg-config))) diff --git a/gnu/packages/openstack.scm b/gnu/packages/openstack.scm index 947abf31a4..780fb7f252 100644 --- a/gnu/packages/openstack.scm +++ b/gnu/packages/openstack.scm @@ -137,16 +137,16 @@ guidelines}.") (define-public python-mox3 (package (name "python-mox3") - (version "0.13.0") + (version "0.14.0") (source (origin (method url-fetch) (uri (pypi-uri "mox3" version)) (sha256 (base32 - "0hj57374r239cj1zbzpxw7mj0yfblz55jdfrc2p1h8j7xng0319j")))) + "0njmh40i1lg5mzn9hc2ax83adj6dli455j6xifilrw27c4wlkjzx")))) (build-system python-build-system) - (inputs + (native-inputs `(("python-fixtures" ,python-fixtures) ("python-pbr" ,python-pbr) ("python-setuptools" ,python-setuptools) @@ -156,11 +156,14 @@ guidelines}.") (synopsis "Mock object framework for Python") (description "Mox3 is an unofficial port of the Google mox framework -(http://code.google.com/p/pymox/) to Python 3. It was meant to be as compatible -with mox as possible, but small enhancements have been made. The library was +(http://code.google.com/p/pymox/) to Python 3. It was meant to be as compatible +with mox as possible, but small enhancements have been made. The library was tested on Python version 3.2, 2.7 and 2.6.") (license asl2.0))) +(define-public python2-mox3 + (package-with-python2 python-mox3)) + (define-public python-os-client-config (package (name "python-os-client-config") @@ -197,9 +200,6 @@ tested on Python version 3.2, 2.7 and 2.6.") (define-public python2-os-client-config (package-with-python2 python-os-client-config)) -(define-public python2-mox3 - (package-with-python2 python-mox3)) - (define-public python-os-testr (package (name "python-os-testr") @@ -266,20 +266,21 @@ portions of your testing code.") (define-public python-stevedore (package (name "python-stevedore") - (version "1.10.0") + (version "1.12.0") (source (origin (method url-fetch) (uri (pypi-uri "stevedore" version)) (sha256 (base32 - "17vpffcnk56sj86d2n3vz5bprcc9bswilgd0awnm7jp073pqkmpm")))) + "0999zvawaapzg6givjhn7vjscdwblcs73wf28wq1wb4g5mbb5phv")))) (build-system python-build-system) (propagated-inputs `(("python-six" ,python-six))) (inputs - `(("python-pbr" ,python-pbr) - ("python-setuptools" ,python-setuptools) + `(("python-pbr" ,python-pbr))) + (native-inputs + `(("python-setuptools" ,python-setuptools) ;; Tests ("python-docutils" ,python-docutils) ("python-mock" ,python-mock) @@ -289,9 +290,9 @@ portions of your testing code.") (synopsis "Manage dynamic plugins for Python applications") (description "Python makes loading code dynamically easy, allowing you to configure -and extend your application by discovering and loading extensions (“plugins”) +and extend your application by discovering and loading extensions (\"plugins\") at runtime. Many applications implement their own library for doing this, -using __import__ or importlib. stevedore avoids creating yet another extension +using __import__ or importlib. Stevedore avoids creating yet another extension mechanism by building on top of setuptools entry points. The code for managing entry points tends to be repetitive, though, so stevedore provides manager classes for implementing common patterns for using dynamically loaded diff --git a/gnu/packages/patches/openssh-CVE-2015-8325.patch b/gnu/packages/patches/openssh-CVE-2015-8325.patch new file mode 100644 index 0000000000..8063e64ea7 --- /dev/null +++ b/gnu/packages/patches/openssh-CVE-2015-8325.patch @@ -0,0 +1,31 @@ +From 85bdcd7c92fe7ff133bbc4e10a65c91810f88755 Mon Sep 17 00:00:00 2001 +From: Damien Miller <djm@mindrot.org> +Date: Wed, 13 Apr 2016 10:39:57 +1000 +Subject: ignore PAM environment vars when UseLogin=yes + +If PAM is configured to read user-specified environment variables +and UseLogin=yes in sshd_config, then a hostile local user may +attack /bin/login via LD_PRELOAD or similar environment variables +set via PAM. + +CVE-2015-8325, found by Shayan Sadigh, via Colin Watson +--- + session.c | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/session.c b/session.c +index 4859245..4653b09 100644 +--- a/session.c ++++ b/session.c +@@ -1322,7 +1322,7 @@ do_setup_env(Session *s, const char *shell) + * Pull in any environment variables that may have + * been set by PAM. + */ +- if (options.use_pam) { ++ if (options.use_pam && !options.use_login) { + char **p; + + p = fetch_pam_child_environment(); +-- +cgit v0.11.2 + diff --git a/gnu/packages/patches/python-pandas-fix-tslib-test-failure.patch b/gnu/packages/patches/python-pandas-fix-tslib-test-failure.patch new file mode 100644 index 0000000000..62d6a38086 --- /dev/null +++ b/gnu/packages/patches/python-pandas-fix-tslib-test-failure.patch @@ -0,0 +1,141 @@ +This patch is required to fix a test failure when python-dateutil version +2.5.2 or later is used. It is derived from the following commits: + +80ef4e06526b9b60cf24268454c9456585a790a3 +845ff974af6f7c3b3067cce8a7149b771c2be87 + +diff --git a/pandas/tseries/tests/test_tslib.py b/pandas/tseries/tests/test_tslib.py +index f0d5bf7..863bc6f 100644 +--- a/pandas/tseries/tests/test_tslib.py ++++ b/pandas/tseries/tests/test_tslib.py +@@ -474,6 +474,11 @@ def test_does_not_convert_mixed_integer(self): + good_date_string)) + + def test_parsers(self): ++ ++ # https://github.com/dateutil/dateutil/issues/217 ++ import dateutil ++ yearfirst = dateutil.__version__ >= LooseVersion('2.5.0') ++ + cases = {'2011-01-01': datetime.datetime(2011, 1, 1), + '2Q2005': datetime.datetime(2005, 4, 1), + '2Q05': datetime.datetime(2005, 4, 1), +@@ -527,20 +532,26 @@ def test_parsers(self): + } + + for date_str, expected in compat.iteritems(cases): +- result1, _, _ = tools.parse_time_string(date_str) +- result2 = to_datetime(date_str) +- result3 = to_datetime([date_str]) +- result4 = to_datetime(np.array([date_str], dtype=object)) +- result5 = Timestamp(date_str) +- result6 = DatetimeIndex([date_str])[0] +- result7 = date_range(date_str, freq='S', periods=1) ++ result1, _, _ = tools.parse_time_string(date_str, ++ yearfirst=yearfirst) ++ result2 = to_datetime(date_str, yearfirst=yearfirst) ++ result3 = to_datetime([date_str], yearfirst=yearfirst) ++ result4 = to_datetime(np.array([date_str], dtype=object), ++ yearfirst=yearfirst) ++ result6 = DatetimeIndex([date_str], yearfirst=yearfirst)[0] + self.assertEqual(result1, expected) + self.assertEqual(result2, expected) + self.assertEqual(result3, expected) + self.assertEqual(result4, expected) +- self.assertEqual(result5, expected) + self.assertEqual(result6, expected) +- self.assertEqual(result7, expected) ++ ++ # these really need to have yearfist, but we don't support ++ if not yearfirst: ++ result5 = Timestamp(date_str) ++ self.assertEqual(result5, expected) ++ result7 = date_range(date_str, freq='S', periods=1, ++ yearfirst=yearfirst) ++ self.assertEqual(result7, expected) + + # NaT + result1, _, _ = tools.parse_time_string('NaT') +@@ -589,23 +589,62 @@ def test_parsers_quarter_invalid(self): + self.assertRaises(ValueError, tools.parse_time_string, case) + + def test_parsers_dayfirst_yearfirst(self): ++ ++ # https://github.com/dateutil/dateutil/issues/217 ++ # this issue was closed ++ import dateutil ++ is_compat_version = dateutil.__version__ >= LooseVersion('2.5.2') ++ if is_compat_version: ++ dayfirst_yearfirst1 = datetime.datetime(2010, 12, 11) ++ dayfirst_yearfirst2 = datetime.datetime(2020, 12, 21) ++ else: ++ dayfirst_yearfirst1 = datetime.datetime(2010, 11, 12) ++ dayfirst_yearfirst2 = datetime.datetime(2020, 12, 21) ++ + # str : dayfirst, yearfirst, expected +- cases = {'10-11-12': [(False, False, datetime.datetime(2012, 10, 11)), +- (True, False, datetime.datetime(2012, 11, 10)), +- (False, True, datetime.datetime(2010, 11, 12)), +- (True, True, datetime.datetime(2010, 11, 12))], +- '20/12/21': [(False, False, datetime.datetime(2021, 12, 20)), +- (True, False, datetime.datetime(2021, 12, 20)), +- (False, True, datetime.datetime(2020, 12, 21)), +- (True, True, datetime.datetime(2020, 12, 21))]} ++ cases = {'10-11-12': [(False, False, False, ++ datetime.datetime(2012, 10, 11)), ++ (True, False, False, ++ datetime.datetime(2012, 11, 10)), ++ (False, True, False, ++ datetime.datetime(2010, 11, 12)), ++ (True, True, False, dayfirst_yearfirst1)], ++ '20/12/21': [(False, False, False, ++ datetime.datetime(2021, 12, 20)), ++ (True, False, False, ++ datetime.datetime(2021, 12, 20)), ++ (False, True, False, ++ datetime.datetime(2020, 12, 21)), ++ (True, True, True, dayfirst_yearfirst2)]} + + tm._skip_if_no_dateutil() + from dateutil.parser import parse + for date_str, values in compat.iteritems(cases): +- for dayfirst, yearfirst, expected in values: +- result1, _, _ = tools.parse_time_string(date_str, +- dayfirst=dayfirst, +- yearfirst=yearfirst) ++ for dayfirst, yearfirst, is_compat, expected in values: ++ ++ f = lambda x: tools.parse_time_string(x, ++ dayfirst=dayfirst, ++ yearfirst=yearfirst) ++ ++ # we now have an invalid parse ++ if is_compat and is_compat_version: ++ self.assertRaises(tslib.DateParseError, f, date_str) ++ ++ def f(date_str): ++ return to_datetime(date_str, dayfirst=dayfirst, ++ yearfirst=yearfirst) ++ ++ self.assertRaises(ValueError, f, date_str) ++ ++ def f(date_str): ++ return DatetimeIndex([date_str], dayfirst=dayfirst, ++ yearfirst=yearfirst)[0] ++ ++ self.assertRaises(ValueError, f, date_str) ++ ++ continue ++ ++ result1, _, _ = f(date_str) + + result2 = to_datetime(date_str, dayfirst=dayfirst, + yearfirst=yearfirst) +@@ -614,7 +653,6 @@ def test_parsers_dayfirst_yearfirst(self): + yearfirst=yearfirst)[0] + + # Timestamp doesn't support dayfirst and yearfirst +- + self.assertEqual(result1, expected) + self.assertEqual(result2, expected) + self.assertEqual(result3, expected) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 4238965fd0..0379352f76 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -7,7 +7,7 @@ ;;; Copyright © 2014, 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015 Omar Radwan <toxemicsquire4@gmail.com> ;;; Copyright © 2015 Pierre-Antoine Rault <par@rigelk.eu> -;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016 Christopher Allan Webber <cwebber@dustycloud.org> ;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr> ;;; Copyright © 2015, 2016 David Thompson <davet@gnu.org> @@ -987,7 +987,9 @@ datetime module, available in Python 2.3+.") (method url-fetch) (uri (pypi-uri "pandas" version)) (sha256 - (base32 "050qw0ap5bhyv5flp78x3lcq1dlminl3xaj6kbrm0jqmx0672xf9")))) + (base32 "050qw0ap5bhyv5flp78x3lcq1dlminl3xaj6kbrm0jqmx0672xf9")) + (patches (search-patches + "python-pandas-fix-tslib-test-failure.patch")))) (build-system python-build-system) (propagated-inputs `(("python-numpy" ,python-numpy) @@ -8256,13 +8258,13 @@ introspection of @code{zope.interface} instances in code.") (define-public python-vobject (package (name "python-vobject") - (version "0.9.1") + (version "0.9.2") (source (origin (method url-fetch) (uri (pypi-uri "vobject" version)) (sha256 (base32 - "1cwzjnrdr9yg2x21wbf3kf59ibnchvj33mygd69yzi178a9gs9gz")))) + "1qfnwlx8qwkgr6nf5wvl6ff1r3kll53dh3z6nyp173nmlhhhqccb")))) (build-system python-build-system) (inputs `(("python-dateutil-2" ,python-dateutil-2) diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index 0ca3415a9f..8531b9cf00 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -3528,14 +3528,14 @@ subprocess.") (define-public ruby-bio-commandeer (package (name "ruby-bio-commandeer") - (version "0.1.2") + (version "0.1.3") (source (origin (method url-fetch) (uri (rubygems-uri "bio-commandeer" version)) (sha256 (base32 - "061jxa6km92qfwzl058r2gp8gfcsbyr7m643nw1pxvmjdswaf6ly")))) + "0lin6l99ldqqjc90l9ihcrv882c4xgbgqm16jqkdy6jf955jd9a8")))) (build-system ruby-build-system) (arguments `(#:phases diff --git a/gnu/packages/ssh.scm b/gnu/packages/ssh.scm index eaf57acb3d..b8f107b111 100644 --- a/gnu/packages/ssh.scm +++ b/gnu/packages/ssh.scm @@ -126,7 +126,8 @@ a server that supports the SSH-2 protocol.") (string-append "http://ftp2.fr.openbsd.org/pub/OpenBSD/OpenSSH/portable/" tail)))) (sha256 (base32 - "132lh9aanb0wkisji1d6cmsxi520m8nh7c7i9wi6m1s3l38q29x7")))) + "132lh9aanb0wkisji1d6cmsxi520m8nh7c7i9wi6m1s3l38q29x7")) + (patches (search-patches "openssh-CVE-2015-8325.patch")))) (build-system gnu-build-system) (inputs `(("groff" ,groff) ("openssl" ,openssl) diff --git a/gnu/packages/statistics.scm b/gnu/packages/statistics.scm index d820b08eb4..b02ab560c3 100644 --- a/gnu/packages/statistics.scm +++ b/gnu/packages/statistics.scm @@ -98,7 +98,7 @@ be output in text, PostScript, PDF or HTML.") (define-public r (package (name "r") - (version "3.2.3") + (version "3.2.5") (source (origin (method url-fetch) (uri (string-append "mirror://cran/src/base/R-" @@ -106,7 +106,7 @@ be output in text, PostScript, PDF or HTML.") version ".tar.gz")) (sha256 (base32 - "1hdnv77ralzcx5k5b88jq1r8l6zqnywpq00g2qs949rqh63psfxr")))) + "1dc0iybjk9kr1nghz3fpir6mb9hb9rnrz9bgh00w5pg5vir5cx30")))) (build-system gnu-build-system) (arguments `(#:make-flags diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 3be89ce06e..117d01d5d0 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -113,14 +113,14 @@ as well as the classic centralized workflow.") ;; Keep in sync with 'git-manpages'! (package (name "git") - (version "2.7.3") + (version "2.7.4") (source (origin (method url-fetch) (uri (string-append "mirror://kernel.org/software/scm/git/git-" version ".tar.xz")) (sha256 (base32 - "1di96q86fq3pdn5d5v4fw9vf58gha5i9b3r880mxlh275n8ngi49")))) + "0ys55v2xrhzj74jrrqx75xpr458klnyxshh8d8swfpp0zgg79rfy")))) (build-system gnu-build-system) (native-inputs `(("native-perl" ,perl) @@ -292,7 +292,7 @@ everything from small to very large projects with speed and efficiency.") version ".tar.xz")) (sha256 (base32 - "0va9j0q9h44jqih38h4cmhvbmjppqq7zbiq70220m7hsqqkq824z")))) + "09ffk5c0dl1xg7xcvr0kadhspx4fr2spmlmcajzfycmap0ddhkyh")))) (build-system trivial-build-system) (arguments '(#:modules ((guix build utils)) diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm index 7673636b15..6060702022 100644 --- a/gnu/packages/video.scm +++ b/gnu/packages/video.scm @@ -62,6 +62,7 @@ #:use-module (gnu packages ocr) #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) + #:use-module (gnu packages popt) #:use-module (gnu packages pulseaudio) #:use-module (gnu packages python) #:use-module (gnu packages qt) @@ -535,6 +536,26 @@ convert and stream audio and video. It includes the libavcodec audio/video codec library.") (license license:gpl2+))) +(define-public ffmpeg-2.8 + (package + (inherit ffmpeg) + (version "2.8.6") + (source (origin + (method url-fetch) + (uri (string-append "https://ffmpeg.org/releases/ffmpeg-" + version ".tar.xz")) + (sha256 + (base32 + "1yh7dvm7zwdlsspdaq524s5qaggma5md9h95qc4kvb5dmyyyvg15")))) + (arguments + (substitute-keyword-arguments (package-arguments ffmpeg) + ((#:configure-flags flags) + `(map (lambda (flag) + (if (string=? flag "--disable-mipsdsp") + "--disable-mipsdspr1" + flag)) + ,flags)))))) + (define-public vlc (package (name "vlc") @@ -546,7 +567,14 @@ audio/video codec library.") version "/vlc-" version ".tar.xz")) (sha256 (base32 - "1jqzrzrpw6932lbkf863xk8cfmn4z2ngbxz7w8ggmh4f6xz9sgal")))) + "1jqzrzrpw6932lbkf863xk8cfmn4z2ngbxz7w8ggmh4f6xz9sgal")) + (modules '((guix build utils))) + (snippet + ;; There are two occurrences where __DATE__ and __TIME__ are + ;; used to capture the build time and show it to the user. + '(substitute* (find-files "." "help\\.c(pp)?$") + (("__DATE__") "\"2016\"") + (("__TIME__") "\"00:00\""))))) (build-system gnu-build-system) (native-inputs `(("git" ,git) ; needed for a test @@ -557,7 +585,7 @@ audio/video codec library.") ("avahi" ,avahi) ("dbus" ,dbus) ("flac" ,flac) - ("ffmpeg" ,ffmpeg) + ("ffmpeg" ,ffmpeg-2.8) ;fails to build against ffmpeg 3.0 ("fontconfig" ,fontconfig) ("freetype" ,freetype) ("gnutls" ,gnutls) @@ -591,7 +619,30 @@ audio/video codec library.") `("--disable-a52" ; FIXME: reenable once available ,(string-append "LDFLAGS=-Wl,-rpath -Wl," (assoc-ref %build-inputs "ffmpeg") - "/lib")))) ; needed for the tests + "/lib")) ;needed for the tests + + #:phases + (modify-phases %standard-phases + (add-after 'install 'regenerate-plugin-cache + (lambda* (#:key outputs #:allow-other-keys) + ;; The 'install-exec-hook' rule in the top-level Makefile.am + ;; generates 'lib/vlc/plugins/plugins.dat', a plugin cache, using + ;; 'vlc-cache-gen'. This file includes the mtime of the plugins + ;; it references. Thus, we first reset the timestamps of all + ;; these files, and then regenerate the cache such that the + ;; mtimes it includes are always zero instead of being dependent + ;; on the build time. + (let* ((out (assoc-ref outputs "out")) + (pkglibdir (string-append out "/lib/vlc")) + (plugindir (string-append pkglibdir "/plugins")) + (cachegen (string-append pkglibdir "/vlc-cache-gen"))) + ;; TODO: Factorize 'reset-timestamps'. + (for-each (lambda (file) + (let ((s (lstat file))) + (unless (eq? (stat:type s) 'symlink) + (utime file 0 0 0 0)))) + (find-files plugindir)) + (zero? (system* cachegen plugindir)))))))) (home-page "https://www.videolan.org/") (synopsis "Audio and video framework") (description "VLC is a cross-platform multimedia player and framework @@ -696,7 +747,7 @@ SVCD, DVD, 3ivx, DivX 3/4/5, WMV and H.264 movies.") (define-public mpv (package (name "mpv") - (version "0.16.0") + (version "0.17.0") (source (origin (method url-fetch) (uri (string-append @@ -704,7 +755,7 @@ SVCD, DVD, 3ivx, DivX 3/4/5, WMV and H.264 movies.") ".tar.gz")) (sha256 (base32 - "1fiqxx85s418qynq2fp0v7cpzrz8j285hwmc4fqgn5ny1vg1jdpw")) + "0vms3viwqcwl1mrgmf2yy4c69fvv7xpbkyrl693l6zpwynqd4b30")) (file-name (string-append name "-" version ".tar.gz")))) (build-system waf-build-system) (native-inputs @@ -1382,3 +1433,33 @@ present in modern GPUs.") (description "Vdpauinfo is a tool to query the capabilities of a VDPAU implementation.") (license (license:x11-style "file://COPYING")))) + +(define-public recordmydesktop + (package + (name "recordmydesktop") + (version "0.3.8.1") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/" name "/" name "/" + version "/recordmydesktop-" version ".tar.gz")) + (sha256 + (base32 + "133kkl5j0r877d41bzj7kj0vf3xm8x80yyx2n8nqxrva304f58ik")))) + (build-system gnu-build-system) + (inputs `(("popt" ,popt) + ("zlib" ,zlib) + ("libx11" ,libx11) + ("libice" ,libice) + ("libsm" ,libsm) + ("libxfixes" ,libxfixes) + ("libxdamage" ,libxdamage) + ("libxext" ,libxext) + ("libvorbis" ,libvorbis) + ("libtheora" ,libtheora))) + (home-page "http://recordmydesktop.sourceforge.net/") + (synopsis "Desktop session video recorder") + (description + "recordMyDesktop is a command-line tool that captures the activity in +your graphical desktop and encodes it as a video. This is a useful tool for +making @dfn{screencasts}.") + (license license:gpl2+))) diff --git a/gnu/packages/webkit.scm b/gnu/packages/webkit.scm index 473d2e7cdc..67384b8fed 100644 --- a/gnu/packages/webkit.scm +++ b/gnu/packages/webkit.scm @@ -53,14 +53,14 @@ (define-public webkitgtk (package (name "webkitgtk") - (version "2.12.0") + (version "2.12.1") (source (origin (method url-fetch) (uri (string-append "http://www.webkitgtk.org/releases/" name "-" version ".tar.xz")) (sha256 (base32 - "19jyvyw8ss4bacq3f7ybdb0r16r84q12j2bpciyj9jqvzpw091m6")))) + "15p8dbxf8psmzddc21rcgds3b4jg725wcn5jppn3qgsm4x92s6jv")))) (build-system cmake-build-system) (arguments '(#:tests? #f ; no tests @@ -136,14 +136,14 @@ HTML/CSS applications to full-fledged web browsers.") (define-public webkitgtk-2.4 (package (inherit webkitgtk) (name "webkitgtk") - (version "2.4.10") + (version "2.4.11") (source (origin (method url-fetch) (uri (string-append "http://www.webkitgtk.org/releases/" name "-" version ".tar.xz")) (sha256 (base32 - "0566yx5lxi40g0wpvmwbc8y76akd7zph7flrjdp2vv3z1nra9z9k")))) + "1xsvnvyvlywwyf6m9ainpsg87jkxjmd37q6zgz9cxb7v3c2ym2jq")))) (build-system gnu-build-system) (arguments '(#:tests? #f ; no tests diff --git a/gnu/services/base.scm b/gnu/services/base.scm index b168543a65..96bf8da02a 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -27,6 +27,7 @@ #:use-module (gnu system pam) #:use-module (gnu system shadow) ; 'user-account', etc. #:use-module (gnu system file-systems) ; 'file-system', etc. + #:use-module (gnu system mapped-devices) #:use-module (gnu packages admin) #:use-module ((gnu packages linux) #:select (eudev kbd e2fsprogs lvm2 fuse alsa-utils crda gpm)) @@ -47,7 +48,6 @@ root-file-system-service file-system-service user-unmount-service - device-mapping-service swap-service user-processes-service session-environment-service @@ -494,18 +494,18 @@ strings or string-valued gexps." (define console-keymap-service-type (shepherd-service-type 'console-keymap - (lambda (file) + (lambda (files) (shepherd-service (documentation (string-append "Load console keymap (loadkeys).")) (provision '(console-keymap)) (start #~(lambda _ (zero? (system* (string-append #$kbd "/bin/loadkeys") - #$file)))) + #$@files)))) (respawn? #f))))) -(define (console-keymap-service file) - "Return a service to load console keymap from @var{file}." - (service console-keymap-service-type file)) +(define (console-keymap-service . files) + "Return a service to load console keymaps from @var{files}." + (service console-keymap-service-type files)) (define console-font-service-type (shepherd-service-type @@ -1174,26 +1174,6 @@ extra rules from the packages listed in @var{rules}." (service udev-service-type (udev-configuration (udev udev) (rules rules)))) -(define device-mapping-service-type - (shepherd-service-type - 'device-mapping - (match-lambda - ((target open close) - (shepherd-service - (provision (list (symbol-append 'device-mapping- (string->symbol target)))) - (requirement '(udev)) - (documentation "Map a device node using Linux's device mapper.") - (start #~(lambda () #$open)) - (stop #~(lambda _ (not #$close))) - (respawn? #f)))))) - -(define (device-mapping-service target open close) - "Return a service that maps device @var{target}, a string such as -@code{\"home\"} (meaning @code{/dev/mapper/home}). Evaluate @var{open}, a -gexp, to open it, and evaluate @var{close} to close it." - (service device-mapping-service-type - (list target open close))) - (define swap-service-type (shepherd-service-type 'swap diff --git a/gnu/system.scm b/gnu/system.scm index a4259fb61b..768ca9cab2 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -43,7 +43,6 @@ #:use-module (gnu packages texinfo) #:use-module (gnu packages compression) #:use-module (gnu packages firmware) - #:autoload (gnu packages cryptsetup) (cryptsetup) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu services base) @@ -54,6 +53,7 @@ #:use-module (gnu system pam) #:use-module (gnu system linux-initrd) #:use-module (gnu system file-systems) + #:use-module (gnu system mapped-devices) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -101,9 +101,7 @@ local-host-aliases %setuid-programs %base-packages - %base-firmware - - luks-device-mapping)) + %base-firmware)) ;;; Commentary: ;;; @@ -176,24 +174,6 @@ ;;; Services. ;;; -(define (open-luks-device source target) - "Return a gexp that maps SOURCE to TARGET as a LUKS device, using -'cryptsetup'." - #~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") - "open" "--type" "luks" - #$source #$target))) - -(define (close-luks-device source target) - "Return a gexp that closes TARGET, a LUKS device." - #~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") - "close" #$target))) - -(define luks-device-mapping - ;; The type of LUKS mapped devices. - (mapped-device-kind - (open open-luks-device) - (close close-luks-device))) - (define (other-file-system-services os) "Return file system services for the file systems of OS that are not marked as 'needed-for-boot'." @@ -253,15 +233,7 @@ from the initrd." (define (device-mapping-services os) "Return the list of device-mapping services for OS as a list." - (map (lambda (md) - (let* ((source (mapped-device-source md)) - (target (mapped-device-target md)) - (type (mapped-device-type md)) - (open (mapped-device-kind-open type)) - (close (mapped-device-kind-close type))) - (device-mapping-service target - (open source target) - (close source target)))) + (map device-mapping-service (operating-system-user-mapped-devices os))) (define (swap-services os) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index d0726d2b61..7e8c4489dd 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -54,17 +54,6 @@ %base-file-systems %container-file-systems - mapped-device - mapped-device? - mapped-device-source - mapped-device-target - mapped-device-type - - mapped-device-kind - mapped-device-kind? - mapped-device-kind-open - mapped-device-kind-close - <file-system-mapping> file-system-mapping file-system-mapping? @@ -293,26 +282,6 @@ initrd code." (create-mount-point? #t) (check? #f)))) - - -;;; -;;; Mapped devices, for Linux's device-mapper. -;;; - -(define-record-type* <mapped-device> mapped-device - make-mapped-device - mapped-device? - (source mapped-device-source) ;string - (target mapped-device-target) ;string - (type mapped-device-type)) ;<mapped-device-kind> - -(define-record-type* <mapped-device-type> mapped-device-kind - make-mapped-device-kind - mapped-device-kind? - (open mapped-device-kind-open) ;source target -> gexp - (close mapped-device-kind-close ;source target -> gexp - (default (const #~(const #f))))) - ;;; ;;; Shared file systems, for VMs/containers. diff --git a/gnu/system/install.scm b/gnu/system/install.scm index a94e3ab2d5..07ad3cbcb2 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -255,7 +255,7 @@ Welcome to the installation of the Guix System Distribution! There is NO WARRANTY, to the extent permitted by law. In particular, you may LOSE ALL YOUR DATA as a side effect of the installation process. Furthermore, -it is alpha software, so it may BREAK IN UNEXPECTED WAYS. +it is 'beta' software, so it may contain bugs. You have been warned. Thanks for being so brave. "))) diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 8ca74104fb..484bce71c4 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -32,6 +32,7 @@ #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) #:use-module (gnu system file-systems) + #:use-module (gnu system mapped-devices) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) @@ -228,7 +229,14 @@ loaded at boot time in the order in which they appear." (use-modules (gnu build linux-boot) (guix build utils) (guix build bournish) ;add the 'bournish' meta-command - (srfi srfi-26)) + (srfi srfi-26) + + ;; FIXME: The following modules are for + ;; LUKS-DEVICE-MAPPING. We should instead propagate + ;; this info via gexps. + ((gnu build file-systems) + #:select (find-partition-by-luks-uuid)) + (rnrs bytevectors)) (with-output-to-port (%make-void-port "w") (lambda () diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm new file mode 100644 index 0000000000..450b4737ac --- /dev/null +++ b/gnu/system/mapped-devices.scm @@ -0,0 +1,130 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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 (gnu system mapped-devices) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:autoload (gnu packages cryptsetup) (cryptsetup) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:export (mapped-device + mapped-device? + mapped-device-source + mapped-device-target + mapped-device-type + + mapped-device-kind + mapped-device-kind? + mapped-device-kind-open + mapped-device-kind-close + + device-mapping-service-type + device-mapping-service + + luks-device-mapping)) + +;;; Commentary: +;;; +;;; This module supports "device mapping", a concept implemented by Linux's +;;; device-mapper. +;;; +;;; Code: + +(define-record-type* <mapped-device> mapped-device + make-mapped-device + mapped-device? + (source mapped-device-source) ;string + (target mapped-device-target) ;string + (type mapped-device-type)) ;<mapped-device-kind> + +(define-record-type* <mapped-device-type> mapped-device-kind + make-mapped-device-kind + mapped-device-kind? + (open mapped-device-kind-open) ;source target -> gexp + (close mapped-device-kind-close ;source target -> gexp + (default (const #~(const #f))))) + + +;;; +;;; Device mapping as a Shepherd service. +;;; + +(define device-mapping-service-type + (shepherd-service-type + 'device-mapping + (match-lambda + (($ <mapped-device> source target + ($ <mapped-device-type> open close)) + (shepherd-service + (provision (list (symbol-append 'device-mapping- (string->symbol target)))) + (requirement '(udev)) + (documentation "Map a device node using Linux's device mapper.") + (start #~(lambda () #$(open source target))) + (stop #~(lambda _ (not #$(close source target)))) + (respawn? #f) + + ;; Add the modules needed by LUKS-DEVICE-MAPPING. + ;; FIXME: This info should be propagated via gexps. + (modules `((rnrs bytevectors) ;bytevector? + ((gnu build file-systems) + #:select (find-partition-by-luks-uuid)) + ,@%default-modules)) + (imported-modules `((gnu build file-systems) + ,@%default-imported-modules))))))) + +(define (device-mapping-service mapped-device) + "Return a service that sets up @var{mapped-device}." + (service device-mapping-service-type mapped-device)) + + +;;; +;;; Common device mappings. +;;; + +(define (open-luks-device source target) + "Return a gexp that maps SOURCE to TARGET as a LUKS device, using +'cryptsetup'." + #~(let ((source #$source)) + (zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") + "open" "--type" "luks" + + ;; Note: We cannot use the "UUID=source" syntax here + ;; because 'cryptsetup' implements it by searching the + ;; udev-populated /dev/disk/by-id directory but udev may + ;; be unavailable at the time we run this. + (if (bytevector? source) + (or (find-partition-by-luks-uuid source) + (error "LUKS partition not found" source)) + source) + + #$target)))) + +(define (close-luks-device source target) + "Return a gexp that closes TARGET, a LUKS device." + #~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") + "close" #$target))) + +(define luks-device-mapping + ;; The type of LUKS mapped devices. + (mapped-device-kind + (open open-luks-device) + (close close-luks-device))) + +;;; mapped-devices.scm ends here diff --git a/guix/build/download.scm b/guix/build/download.scm index bd354a6985..fec4cec3e8 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -42,6 +42,7 @@ current-terminal-columns progress-proc uri-abbreviation + nar-uri-abbreviation store-path-abbreviation)) ;;; Commentary: @@ -202,13 +203,18 @@ abbreviation of URI showing the scheme, host, and basename of the file." (uri->string uri)) (define (elide-path) - (let ((path (uri-path uri))) - (string-append (symbol->string (uri-scheme uri)) "://" + (let* ((path (uri-path uri)) + (base (basename path)) + (prefix (string-append (symbol->string (uri-scheme uri)) "://" - ;; `file' URIs have no host part. - (or (uri-host uri) "") + ;; `file' URIs have no host part. + (or (uri-host uri) "") - (string-append "/.../" (basename path))))) + (string-append "/" (ellipsis) "/")))) + (if (> (+ (string-length prefix) (string-length base)) max-length) + (string-append prefix (ellipsis) + (string-drop base (quotient (string-length base) 2))) + (string-append prefix base)))) (if (> (string-length uri-as-string) max-length) (let ((short (elide-path))) @@ -217,6 +223,17 @@ abbreviation of URI showing the scheme, host, and basename of the file." uri-as-string)) uri-as-string)) +(define (nar-uri-abbreviation uri) + "Abbreviate URI, which is assumed to be the URI of a nar as served by Hydra +and 'guix publish', something like +\"http://example.org/nar/1ldrllwbna0aw5z8kpci4fsvbd2w8cw4-texlive-bin-2015\"." + (let* ((uri (if (string? uri) (string->uri uri) uri)) + (path (basename (uri-path uri)))) + (if (and (> (string-length path) 33) + (char=? (string-ref path 32) #\-)) + (string-drop path 33) + path))) + (define (ftp-fetch uri file) "Fetch data from URI and write it to FILE. Return FILE on success." (let* ((conn (ftp-open (uri-host uri))) @@ -274,6 +291,13 @@ host name without trailing dot." (set-session-transport-fd! session (fileno port)) (set-session-default-priority! session) + + ;; The "%COMPAT" bit allows us to work around firewall issues (info + ;; "(gnutls) Priority Strings"); see <http://bugs.gnu.org/23311>. + ;; Explicitly disable SSLv3, which is insecure: + ;; <https://tools.ietf.org/html/rfc7568>. + (set-session-priorities! session "NORMAL:%COMPAT:-VERS-SSL3.0") + (set-session-credentials! session (make-certificate-credentials)) ;; Uncomment the following lines in case of debugging emergency. diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 5ce0abbb48..04fc3ef5fe 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -145,6 +146,19 @@ "Evaluate EXPR and restart upon EINTR. Return the value of EXPR." (call-with-restart-on-EINTR (lambda () expr))) +(define (syscall->procedure return-type name argument-types) + "Return a procedure that wraps the C function NAME using the dynamic FFI. +If an error occurs while creating the binding, defer the error report until +the returned procedure is called." + (catch #t + (lambda () + (let ((ptr (dynamic-func name (dynamic-link)))) + (pointer->procedure return-type ptr argument-types))) + (lambda args + (lambda _ + (error (format #f "~a: syscall->procedure failed: ~s" + name args)))))) + (define (augment-mtab source target type options) "Augment /etc/mtab with information about the given mount point." (let ((port (open-file "/etc/mtab" "a"))) @@ -193,8 +207,7 @@ (define UMOUNT_NOFOLLOW 8) (define mount - (let* ((ptr (dynamic-func "mount" (dynamic-link))) - (proc (pointer->procedure int ptr `(* * * ,unsigned-long *)))) + (let ((proc (syscall->procedure int "mount" `(* * * ,unsigned-long *)))) (lambda* (source target type #:optional (flags 0) options #:key (update-mtab? #f)) "Mount device SOURCE on TARGET as a file system TYPE. Optionally, FLAGS @@ -222,8 +235,7 @@ error." (augment-mtab source target type options)))))) (define umount - (let* ((ptr (dynamic-func "umount2" (dynamic-link))) - (proc (pointer->procedure int ptr `(* ,int)))) + (let ((proc (syscall->procedure int "umount2" `(* ,int)))) (lambda* (target #:optional (flags 0) #:key (update-mtab? #f)) "Unmount TARGET. Optionally FLAGS may be one of the MNT_* or UMOUNT_* @@ -250,8 +262,7 @@ constants from <sys/mount.h>." (loop (cons mount-point result)))))))))) (define swapon - (let* ((ptr (dynamic-func "swapon" (dynamic-link))) - (proc (pointer->procedure int ptr (list '* int)))) + (let ((proc (syscall->procedure int "swapon" (list '* int)))) (lambda* (device #:optional (flags 0)) "Use the block special device at DEVICE for swapping." (let ((ret (proc (string->pointer device) flags)) @@ -262,8 +273,7 @@ constants from <sys/mount.h>." (list err))))))) (define swapoff - (let* ((ptr (dynamic-func "swapoff" (dynamic-link))) - (proc (pointer->procedure int ptr '(*)))) + (let ((proc (syscall->procedure int "swapoff" '(*)))) (lambda (device) "Stop using block special device DEVICE for swapping." (let ((ret (proc (string->pointer device))) @@ -327,18 +337,18 @@ string TMPL and return its file name. TMPL must end with 'XXXXXX'." ;; declared in <unistd.h> as a variadic function; in practice, it expects 6 ;; pointer-sized arguments, as shown in, e.g., x86_64/syscall.S. (define clone - (let* ((ptr (dynamic-func "syscall" (dynamic-link))) - (proc (pointer->procedure long ptr - (list long ;sysno - unsigned-long ;flags - '* '* '* - '*))) + (let* ((proc (syscall->procedure int "syscall" + (list long ;sysno + unsigned-long ;flags + '* '* '* + '*))) ;; TODO: Don't do this. (syscall-id (match (utsname:machine (uname)) ("i686" 120) ("x86_64" 56) ("mips64" 5055) - ("armv7l" 120)))) + ("armv7l" 120) + (_ #f)))) (lambda (flags) "Create a new child process by duplicating the current parent process. Unlike the fork system call, clone accepts FLAGS that specify which resources @@ -373,8 +383,7 @@ there is no such limitation." (list err)))))))) (define pivot-root - (let* ((ptr (dynamic-func "pivot_root" (dynamic-link))) - (proc (pointer->procedure int ptr (list '* '*)))) + (let ((proc (syscall->procedure int "pivot_root" (list '* '*)))) (lambda (new-root put-old) "Change the root file system to NEW-ROOT and move the current root file system to PUT-OLD." diff --git a/guix/config.scm.in b/guix/config.scm.in index 764e466bc5..d7df9f7d2b 100644 --- a/guix/config.scm.in +++ b/guix/config.scm.in @@ -55,11 +55,11 @@ "@storedir@")) (define %state-directory - ;; This must match `NIX_STATE_DIR' as defined in `daemon.am'. + ;; This must match `NIX_STATE_DIR' as defined in `nix/local.mk'. (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix")) (define %config-directory - ;; This must match `NIX_CONF_DIR' as defined in `daemon.am'. + ;; This must match `NIX_CONF_DIR' as defined in `nix/local.mk'. (or (getenv "NIX_CONF_DIR") "@guix_sysconfdir@/guix")) (define %guix-register-program diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index db0416b0c0..1cfab81dbd 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -32,7 +32,7 @@ #:use-module ((guix build utils) #:select (mkdir-p dump-port)) #:use-module ((guix build download) #:select (current-terminal-columns - progress-proc uri-abbreviation + progress-proc uri-abbreviation nar-uri-abbreviation open-connection-for-uri close-connection store-path-abbreviation byte-count->string)) @@ -400,8 +400,10 @@ or is signed by an unauthorized key." (when verbose? ;; Visually separate substitutions with a newline. (format (current-error-port) - "~%Found valid signature for ~a~%From ~a~%" - (narinfo-path narinfo) + (_ "~%Found valid signature for ~a~%") + (narinfo-path narinfo)) + (format (current-error-port) + (_ "From ~a~%") (uri->string (narinfo-uri narinfo))))) narinfo)))) @@ -896,11 +898,11 @@ DESTINATION as a nar file. Verify the substitute against ACL." (dl-size (or download-size (and (equal? comp "none") (narinfo-size narinfo)))) - (progress (progress-proc (uri-abbreviation uri) + (progress (progress-proc (uri->string uri) dl-size (current-error-port) #:abbreviation - store-path-abbreviation))) + nar-uri-abbreviation))) (progress-report-port progress raw))) ((input pids) (decompressed-port (and=> (narinfo-compression narinfo) @@ -979,7 +981,9 @@ found." default value." (or (and=> (or (find-daemon-option "untrusted-terminal-columns") (find-daemon-option "terminal-columns")) - string->number) + (lambda (str) + (let ((number (string->number str))) + (and number (max 20 (- number 1)))))) 80)) (define (guix-substitute . args) @@ -998,6 +1002,13 @@ default value." (newline) (force-output (current-output-port)) + ;; Attempt to install the client's locale, mostly so that messages are + ;; suitably translated. + (match (or (find-daemon-option "untrusted-locale") + (find-daemon-option "locale")) + (#f #f) + (locale (false-if-exception (setlocale LC_ALL locale)))) + (with-networking (with-error-handling ; for signature errors (match args diff --git a/guix/store.scm b/guix/store.scm index af311a0ebd..8d1099dab2 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -534,7 +534,10 @@ encoding conversion errors." (substitute-urls #f) ;; Number of columns in the client's terminal. - (terminal-columns (terminal-columns))) + (terminal-columns (terminal-columns)) + + ;; Locale of the client. + (locale (false-if-exception (setlocale LC_ALL)))) ;; Must be called after `open-connection'. (define socket @@ -573,6 +576,9 @@ encoding conversion errors." ,@(if terminal-columns `(("terminal-columns" . ,(number->string terminal-columns))) + '()) + ,@(if locale + `(("locale" . ,locale)) '())))) (send (string-pairs pairs)))) (let loop ((done? (process-stderr server))) diff --git a/guix/utils.scm b/guix/utils.scm index a0e9439dd3..6c01edde21 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -808,7 +808,8 @@ elements after E." (define (cache-directory) "Return the cache directory for Guix, by default ~/.cache/guix." (or (getenv "XDG_CONFIG_HOME") - (and=> (getenv "HOME") + (and=> (or (getenv "HOME") + (passwd:dir (getpwuid (getuid)))) (cut string-append <> "/.cache/guix")))) (define (readlink* file) diff --git a/daemon.am b/nix/local.mk index 3c15531f54..3c15531f54 100644 --- a/daemon.am +++ b/nix/local.mk |