diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2016-01-03 14:53:03 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2016-01-03 14:53:03 +0100 |
| commit | 53334dd6e9e296e17110ebcd2b1f93f117ffe36a (patch) | |
| tree | 2653db2eab9a204dab892ea8b6812cadf7209e84 | |
| parent | 1575dcd134f4fae7255787293f4988bbd043de95 (diff) | |
| parent | 51385362f76e2f823ac8d8cf720d06c386504069 (diff) | |
| download | guix-patches-53334dd6e9e296e17110ebcd2b1f93f117ffe36a.tar guix-patches-53334dd6e9e296e17110ebcd2b1f93f117ffe36a.tar.gz | |
Merge branch 'master' into core-updates
128 files changed, 12007 insertions, 4688 deletions
@@ -10,6 +10,37 @@ Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> Please send Guix bug reports to bug-guix@gnu.org. +* Changes in 0.9.1 (since 0.9.0) + +** Package management + +*** Emacs interface for hydra.gnu.org +*** Changes in Emacs interface variables +In the following names, BUFFER-TYPE means "info" or "list"; +ENTRY-TYPE means "package", "output" or "generation". + +**** Removed +- guix-info-fill-column +- guix-info-insert-ENTRY-TYPE-function + +**** Renamed +- guix-info-ignore-empty-vals -> guix-info-ignore-empty-values +- guix-output-name-width -> guix-generation-output-name-width +- guix-buffer-name-function -> guix-ui-buffer-name-function +- guix-update-after-operation -> guix-ui-update-after-operation +- guix-search-params -> guix-package-search-params + +**** Replaced +- guix-list-column-format, guix-list-column-value-methods -> + guix-ENTRY-TYPE-list-format +- guix-info-displayed-params, guix-info-insert-methods, + guix-package-info-heading-params -> guix-ENTRY-TYPE-info-format +- guix-param-titles, guix-list-column-titles -> + guix-ENTRY-TYPE-BUFFER-TYPE-titles +- guix-list-describe-warning-count -> + guix-ENTRY-TYPE-list-describe-warning-count +- guix-package-info-fill-heading -> guix-info-fill + * Changes in 0.9.0 (since 0.8.3) ** Package management @@ -85,7 +85,6 @@ libstore_a_SOURCES = \ nix/libstore/store-api.cc \ nix/libstore/optimise-store.cc \ nix/libstore/local-store.cc \ - nix/libstore/remote-store.cc \ nix/libstore/build.cc \ nix/libstore/pathlocks.cc \ nix/libstore/derivations.cc @@ -95,7 +94,6 @@ libstore_headers = \ nix/libstore/pathlocks.hh \ nix/libstore/globals.hh \ nix/libstore/worker-protocol.hh \ - nix/libstore/remote-store.hh \ nix/libstore/derivations.hh \ nix/libstore/misc.hh \ nix/libstore/local-store.hh \ diff --git a/doc/emacs.texi b/doc/emacs.texi index e4608f09ef..ea340b19fe 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -14,6 +14,7 @@ Guix convenient and fun. * Build Log Mode: Emacs Build Log. Highlighting Guix build logs. * Completions: Emacs Completions. Completing @command{guix} shell command. * Development: Emacs Development. Tools for Guix developers. +* Hydra: Emacs Hydra. Interface for Guix build farm. @end menu @@ -160,7 +161,7 @@ Display package(s) with the specified 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 -can be changed by modifying @code{guix-search-params} variable. +can be changed by modifying @code{guix-package-search-params} variable. @end table @@ -287,6 +288,8 @@ similar to @command{guix edit} command (@pxref{Invoking guix edit}), but for opening a package recipe in the current Emacs instance. @item x Execute actions on the marked packages. +@item B +Display latest builds of the current package (@pxref{Emacs Hydra}). @end table A ``generation-list'' buffer additionally provides the following @@ -414,7 +417,7 @@ changed with the following variables: By default, the name of a profile is also displayed in a ``list'' or ``info'' buffer name. To change this behavior, use -@code{guix-buffer-name-function} variable. +@code{guix-ui-buffer-name-function} variable. For example, if you want to display all types of results in a single buffer (in such case you will probably use a history (@kbd{l}/@kbd{r}) @@ -428,8 +431,7 @@ extensively), you may do it like this: guix-generation-list-buffer-name name guix-package-info-buffer-name name guix-output-info-buffer-name name - guix-generation-info-buffer-name name - guix-buffer-name-function #'guix-buffer-name-simple)) + guix-generation-info-buffer-name name)) @end example @node Emacs Keymaps @@ -439,8 +441,12 @@ If you want to change default key bindings, use the following keymaps (@pxref{Init Rebinding,,, emacs, The GNU Emacs Manual}): @table @code -@item guix-root-map -Parent keymap with general keys for all guix modes. +@item guix-buffer-map +Parent keymap with general keys for any buffer type. + +@item guix-ui-map +Parent keymap with general keys for buffers used for Guix package +management (for packages, outputs and generations). @item guix-list-mode-map Parent keymap with general keys for ``list'' buffers. @@ -475,22 +481,22 @@ Keymap with keys available when a point is placed on a button. @subsubsection Appearance You can change almost any aspect of ``list'' / ``info'' buffers using -the following variables: +the following variables (@dfn{ENTRY-TYPE} means @code{package}, +@code{output} or @code{generation}): @table @code -@item guix-list-column-format -@itemx guix-list-column-titles -@itemx guix-list-column-value-methods +@item guix-ENTRY-TYPE-list-format +@itemx guix-ENTRY-TYPE-list-titles Specify the columns, their names, what and how is displayed in ``list'' buffers. -@item guix-info-displayed-params -@itemx guix-info-insert-methods -@itemx guix-info-ignore-empty-vals +@item guix-ENTRY-TYPE-info-format +@itemx guix-ENTRY-TYPE-info-titles +@itemx guix-info-ignore-empty-values @itemx guix-info-param-title-format @itemx guix-info-multiline-prefix @itemx guix-info-indent -@itemx guix-info-fill-column +@itemx guix-info-fill @itemx guix-info-delimiter Various settings for ``info'' buffers. @@ -738,3 +744,41 @@ evaluation will be finished in the REPL. Alternatively, to avoid this limitation, you may just run another Geiser REPL, and while something is being evaluated in the previous REPL, you can continue editing a scheme file with the help of the current one. + + +@node Emacs Hydra +@section Hydra + +The continuous integration server at @code{hydra.gnu.org} builds all +the distribution packages on the supported architectures and serves +them as substitutes (@pxref{Substitutes}). Continuous integration is +currently orchestrated by @uref{https://nixos.org/hydra/, Hydra}. + +This section describes an Emacs interface to query Hydra to know the +build status of specific packages, discover recent and ongoing builds, +view build logs, and so on. This interface is mostly the same as the +``list''/``info'' interface for displaying packages and generations +(@pxref{Emacs Package Management}). + +The following commands are available: + +@table @kbd + +@item M-x guix-hydra-latest-builds +Display latest failed or successful builds (you will be prompted for a +number of builds). With @kbd{C-u}, you will also be prompted for other +parameters (project, jobset, job and system). + +@item M-x guix-hydra-queued-builds +Display scheduled or currently running builds (you will be prompted for +a number of builds). + +@item M-x guix-hydra-jobsets +Display available jobsets (you will be prompted for a project). + +@end table + +In a list of builds you can press @kbd{L} key to display a build log of +the current build. Also both a list of builds and a list of jobsets +provide @kbd{B} key to display latest builds of the current job or +jobset (don't forget about @kbd{C-u}). diff --git a/doc/guix.texi b/doc/guix.texi index 4b06b32232..f155fbe818 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -16,6 +16,7 @@ Copyright @copyright{} 2013 Nikita Karetnikov@* Copyright @copyright{} 2015 Mathieu Lirzin@* Copyright @copyright{} 2014 Pierre-Antoine Rault@* Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer +Copyright @copyright{} 2015 Leo Famulari Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -115,6 +116,7 @@ Emacs Interface * Build Log Mode: Emacs Build Log. Highlighting Guix build logs. * Completions: Emacs Completions. Completing @command{guix} shell command. * Development: Emacs Development. Tools for Guix developers. +* Hydra: Emacs Hydra. Interface for Guix build farm. Programming Interface @@ -181,6 +183,7 @@ Services * X Window:: Graphical display. * Desktop Services:: D-Bus and desktop services. * Database Services:: SQL databases. +* Mail Services:: IMAP, POP3, SMTP, and all that. * Web Services:: Web servers. * Various Services:: Other services. @@ -310,11 +313,27 @@ Installing goes along these lines: @enumerate @item Download the binary tarball from -@indicateurl{ftp://alpha.gnu.org/gnu/guix/guix-binary-@value{VERSION}.@var{system}.tar.xz}@footnote{As -usual, make sure to download the associated @file{.sig} file and to -verify the authenticity of the tarball against it!}, where @var{system} -is @code{x86_64-linux} for an @code{x86_64} machine already running the -kernel Linux, and so on. +@indicateurl{ftp://alpha.gnu.org/gnu/guix/guix-binary-@value{VERSION}.@var{system}.tar.xz}, +where @var{system} is @code{x86_64-linux} for an @code{x86_64} machine +already running the kernel Linux, and so on. + +Make sure to download the associated @file{.sig} file and to verify the +authenticity of the tarball against it, along these lines: + +@example +$ wget ftp://alpha.gnu.org/gnu/guix/guix-binary-@value{VERSION}.@var{system}.tar.xz.sig +$ gpg --verify guix-binary-@value{VERSION}.@var{system}.tar.xz.sig +@end example + +If that command fails because you don't have the required public key, +then run this command to import it: + +@example +$ gpg --keyserver keys.gnupg.net --recv-keys 3D9AEBB5 +@end example + +@noindent +and rerun the @code{gpg --verify} command. @item As @code{root}, run: @@ -602,7 +621,7 @@ a writable @file{/tmp} directory. You can influence the directory where the daemon stores build trees @i{via} the @code{TMPDIR} environment variable. However, the build tree -within the chroot is always @file{/tmp/nix-build-@var{name}.drv-0}, +within the chroot is always @file{/tmp/guix-build-@var{name}.drv-0}, where @var{name} is the derivation name---e.g., @code{coreutils-8.24}. This way, the value of @code{TMPDIR} does not leak inside build environments, which avoids discrepancies in cases where build processes @@ -864,6 +883,12 @@ Allow at most @var{n} build jobs in parallel. The default value is locally; instead, the daemon will offload builds (@pxref{Daemon Offload Setup}), or simply fail. +@item --rounds=@var{N} +Build each derivation @var{n} times in a row, and raise an error if +consecutive build results are not bit-for-bit identical. Note that this +setting can be overridden by clients such as @command{guix build} +(@pxref{Invoking guix build}). + @item --debug Produce debugging output. @@ -1561,7 +1586,9 @@ also result from derivation builds, can be available as substitutes. The @code{hydra.gnu.org} server is a front-end to a build farm that builds packages from the GNU distribution continuously for some -architectures, and makes them available as substitutes. This is the +architectures, and makes them available as substitutes (@pxref{Emacs +Hydra}, for information on how to query the continuous integration +server). This is the default source of substitutes; it can be overridden by passing the @option{--substitute-urls} option either to @command{guix-daemon} (@pxref{daemon-substitute-urls,, @code{guix-daemon --substitute-urls}}) @@ -2263,33 +2290,52 @@ The arguments that should be passed to the build system. This is a list, typically containing sequential keyword-value pairs. @item @code{inputs} (default: @code{'()}) -Package or derivation inputs to the build. This is a list of lists, -where each list has the name of the input (a string) as its first -element, a package or derivation object as its second element, and -optionally the name of the output of the package or derivation that -should be used, which defaults to @code{"out"}. - -@item @anchor{package-propagated-inputs}@code{propagated-inputs} (default: @code{'()}) -@cindex propagated inputs -This field is like @code{inputs}, but the specified packages will be -force-installed alongside the package they belong to -(@pxref{package-cmd-propagated-inputs, @command{guix package}}, for -information on how @command{guix package} deals with propagated inputs.) - -For example this is necessary when a library needs headers of another -library to compile, or needs another shared library to be linked -alongside itself when a program wants to link to it. - -@item @code{native-inputs} (default: @code{'()}) -This field is like @code{inputs}, but in case of a cross-compilation it -will be ensured that packages for the architecture of the build machine -are present, such that executables from them can be used during the -build. - -This is typically where you would list tools needed at build time but -not at run time, such as Autoconf, Automake, pkg-config, Gettext, or -Bison. @command{guix lint} can report likely mistakes in this area -(@pxref{Invoking guix lint}). +@itemx @code{native-inputs} (default: @code{'()}) +@itemx @code{propagated-inputs} (default: @code{'()}) +@cindex inputs, of packages +These fields list dependencies of the package. Each one is a list of +tuples, where each tuple has a label for the input (a string) as its +first element, a package, origin, or derivation as its second element, +and optionally the name of the output thereof that should be used, which +defaults to @code{"out"} (@pxref{Packages with Multiple Outputs}, for +more on package outputs). For example, the list below specifies 3 +inputs: + +@example +`(("libffi" ,libffi) + ("libunistring" ,libunistring) + ("glib:bin" ,glib "bin")) ;the "bin" output of Glib +@end example + +@cindex cross compilation, package dependencies +The distinction between @code{native-inputs} and @code{inputs} is +necessary when considering cross-compilation. When cross-compiling, +dependencies listed in @code{inputs} are built for the @emph{target} +architecture; conversely, dependencies listed in @code{native-inputs} +are built for the architecture of the @emph{build} machine. + +@code{native-inputs} is typically where you would list tools needed at +build time but not at run time, such as Autoconf, Automake, pkg-config, +Gettext, or Bison. @command{guix lint} can report likely mistakes in +this area (@pxref{Invoking guix lint}). + +@anchor{package-propagated-inputs} +Lastly, @code{propagated-inputs} is similar to @code{inputs}, but the +specified packages will be force-installed alongside the package they +belong to (@pxref{package-cmd-propagated-inputs, @command{guix +package}}, for information on how @command{guix package} deals with +propagated inputs.) + +For example this is necessary when a C/C++ library needs headers of +another library to compile, or when a pkg-config file refers to another +one @i{via} its @code{Requires} field. + +Another example where @code{propagated-inputs} is useful is for +languages that lack a facility to record the run-time search path akin +to ELF's @code{RUNPATH}; this includes Guile, Python, Perl, GHC, and +more. To ensure that libraries written in those languages can find +library code they depend on at run time, run-time dependencies must be +listed in @code{propagated-inputs} rather than @code{inputs}. @item @code{self-native-input?} (default: @code{#f}) This is a Boolean field telling whether the package should use itself as @@ -3471,8 +3517,9 @@ content is directly passed as a string. @deffn {Scheme Procedure} local-file @var{file} [@var{name}] @ [#:recursive? #t] Return an object representing local file @var{file} to add to the store; this -object can be used in a gexp. @var{file} will be added to the store under @var{name}--by -default the base name of @var{file}. +object can be used in a gexp. If @var{file} is a relative file name, it is looked +up relative to the source file where this form appears. @var{file} will be added to +the store under @var{name}--by default the base name of @var{file}. When @var{recursive?} is true, the contents of @var{file} are added recursively; if @var{file} designates a flat file and @var{recursive?} is true, its contents are added, and its @@ -4179,7 +4226,7 @@ Import meta-data from @uref{http://cran.r-project.org/, CRAN}, the central repository for the @uref{http://r-project.org, GNU@tie{}R statistical and graphical environment}. -Information is extracted from the HTML package description. +Information is extracted from the package's DESCRIPTION file. The command command below imports meta-data for the @code{Cairo} R package: @@ -5429,6 +5476,13 @@ reliably refer to them in @code{file-system} declarations (@pxref{File Systems}). This is typically done using the @code{-L} option of @command{mkfs.ext4} and related commands. +Be sure that your partition labels match the value of their respective +@code{device} fields in your @code{file-system} configuration, if your +@code{file-system} configuration sets the value of @code{title} to +@code{'label}, as do the example configurations found on the USB +installation image under @file{/etc/configuration} (@pxref{Using the +Configuration System}). + @c FIXME: Uncomment this once GRUB fully supports encrypted roots. @c A typical command sequence may be: @c @@ -5901,6 +5955,12 @@ bits), and @code{no-exec} (disallow program execution.) @item @code{options} (default: @code{#f}) This is either @code{#f}, or a string denoting mount options. +@item @code{mount?} (default: @code{#t}) +This value indicates whether to automatically mount the file system when +the system is brought up. When set to @code{#f}, the file system gets +an entry in @file{/etc/fstab} (read by the @command{mount} command) but +is not automatically mounted. + @item @code{needed-for-boot?} (default: @code{#f}) This Boolean value indicates whether the file system is needed when booting. If that is true, then the file system is mounted when the @@ -6351,6 +6411,7 @@ declaration. * X Window:: Graphical display. * Desktop Services:: D-Bus and desktop services. * Database Services:: SQL databases. +* Mail Services:: IMAP, POP3, SMTP, and all that. * Web Services:: Web servers. * Various Services:: Other services. @end menu @@ -7074,6 +7135,1375 @@ The PostgreSQL daemon loads its runtime configuration from @var{data-directory}. @end deffn +@node Mail Services +@subsubsection Mail Services + +The @code{(gnu services mail)} module provides Guix service definitions +for mail services. Currently the only implemented service is Dovecot, +an IMAP, POP3, and LMTP server. + +Guix does not yet have a mail transfer agent (MTA), although for some +lightweight purposes the @code{esmtp} relay-only MTA may suffice. Help +is needed to properly integrate a full MTA, such as Postfix. Patches +welcome! + +To add an IMAP/POP3 server to a GuixSD system, add a +@code{dovecot-service} to the operating system definition: + +@deffn {Scheme Procedure} dovecot-service [#:config (dovecot-configuration)] +Return a service that runs the Dovecot IMAP/POP3/LMTP mail server. +@end deffn + +By default, Dovecot doesn't need much configuration; the default +configuration object created by @code{(dovecot-configuration)} will +suffice if your mail is delivered to @code{~/Maildir}. A self-signed +certificate will be generated for TLS-protected connections, though +Dovecot will also listen on cleartext ports by default. There are a +number of options though which mail administrators might need to change, +and as is the case with other services, Guix allows the system +administrator to specify these parameters via a uniform Scheme interface. + +For example, to specify that mail is located at @code{maildir~/.mail}, +one would instantiate the Dovecot service like this: + +@example +(dovecot-service #:config + (dovecot-configuration + (mail-location "maildir:~/.mail"))) +@end example + +The available configuration parameters follow. Each parameter +definition is preceded by its type; for example, @samp{string-list foo} +indicates that the @code{foo} parameter should be specified as a list of +strings. There is also a way to specify the configuration as a string, +if you have an old @code{dovecot.conf} file that you want to port over +from some other system; see the end for more details. + +@c The following documentation was initially generated by +@c (generate-documentation) in (gnu services mail). Manually maintained +@c documentation is better, so we shouldn't hesitate to edit below as +@c needed. However if the change you want to make to this documentation +@c can be done in an automated way, it's probably easier to change +@c (generate-documentation) than to make it below and have to deal with +@c the churn as dovecot updates. + +Available @code{dovecot-configuration} fields are: + +@deftypevr {@code{dovecot-configuration} parameter} package dovecot +The dovecot package. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} comma-separated-string-list listen +A list of IPs or hosts where to listen in for connections. @samp{*} +listens in all IPv4 interfaces, @samp{::} listens in all IPv6 +interfaces. If you want to specify non-default ports or anything more +complex, customize the address and port fields of the +@samp{inet-listener} of the specific services you are interested in. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} protocol-configuration-list protocols +List of protocols we want to serve. Available protocols include +@samp{imap}, @samp{pop3}, and @samp{lmtp}. + +Available @code{protocol-configuration} fields are: + +@deftypevr {@code{protocol-configuration} parameter} string name +The name of the protocol. +@end deftypevr + +@deftypevr {@code{protocol-configuration} parameter} string auth-socket-path +UNIX socket path to master authentication server to find users. +This is used by imap (for shared users) and lda. +Defaults to @samp{"/var/run/dovecot/auth-userdb"}. +@end deftypevr + +@deftypevr {@code{protocol-configuration} parameter} space-separated-string-list mail-plugins +Space separated list of plugins to load. +@end deftypevr + +@deftypevr {@code{protocol-configuration} parameter} non-negative-integer mail-max-userip-connections +Maximum number of IMAP connections allowed for a user from each IP +address. NOTE: The username is compared case-sensitively. +Defaults to @samp{10}. +@end deftypevr + +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} service-configuration-list services +List of services to enable. Available services include @samp{imap}, +@samp{imap-login}, @samp{pop3}, @samp{pop3-login}, @samp{auth}, and +@samp{lmtp}. + +Available @code{service-configuration} fields are: + +@deftypevr {@code{service-configuration} parameter} string kind +The service kind. Valid values include @code{director}, +@code{imap-login}, @code{pop3-login}, @code{lmtp}, @code{imap}, +@code{pop3}, @code{auth}, @code{auth-worker}, @code{dict}, +@code{tcpwrap}, @code{quota-warning}, or anything else. +@end deftypevr + +@deftypevr {@code{service-configuration} parameter} listener-configuration-list listeners +Listeners for the service. A listener is either an +@code{unix-listener-configuration}, a @code{fifo-listener-configuration}, or +an @code{inet-listener-configuration}. +Defaults to @samp{()}. + +Available @code{unix-listener-configuration} fields are: + +@deftypevr {@code{unix-listener-configuration} parameter} file-name path +The file name on which to listen. +@end deftypevr + +@deftypevr {@code{unix-listener-configuration} parameter} string mode +The access mode for the socket. +Defaults to @samp{"0600"}. +@end deftypevr + +@deftypevr {@code{unix-listener-configuration} parameter} string user +The user to own the the socket. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{unix-listener-configuration} parameter} string group +The group to own the socket. +Defaults to @samp{""}. +@end deftypevr + + +Available @code{fifo-listener-configuration} fields are: + +@deftypevr {@code{fifo-listener-configuration} parameter} file-name path +The file name on which to listen. +@end deftypevr + +@deftypevr {@code{fifo-listener-configuration} parameter} string mode +The access mode for the socket. +Defaults to @samp{"0600"}. +@end deftypevr + +@deftypevr {@code{fifo-listener-configuration} parameter} string user +The user to own the the socket. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{fifo-listener-configuration} parameter} string group +The group to own the socket. +Defaults to @samp{""}. +@end deftypevr + + +Available @code{inet-listener-configuration} fields are: + +@deftypevr {@code{inet-listener-configuration} parameter} string protocol +The protocol to listen for. +@end deftypevr + +@deftypevr {@code{inet-listener-configuration} parameter} string address +The address on which to listen, or empty for all addresses. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{inet-listener-configuration} parameter} non-negative-integer port +The port on which to listen. +@end deftypevr + +@deftypevr {@code{inet-listener-configuration} parameter} boolean ssl? +Whether to use SSL for this service; @samp{yes}, @samp{no}, or +@samp{required}. +Defaults to @samp{#t}. +@end deftypevr + +@end deftypevr + +@deftypevr {@code{service-configuration} parameter} non-negative-integer service-count +Number of connections to handle before starting a new process. +Typically the only useful values are 0 (unlimited) or 1. 1 is more +secure, but 0 is faster. <doc/wiki/LoginProcess.txt>. +Defaults to @samp{1}. +@end deftypevr + +@deftypevr {@code{service-configuration} parameter} non-negative-integer process-min-avail +Number of processes to always keep waiting for more connections. +Defaults to @samp{0}. +@end deftypevr + +@deftypevr {@code{service-configuration} parameter} non-negative-integer vsz-limit +If you set @samp{service-count 0}, you probably need to grow +this. +Defaults to @samp{256000000}. +@end deftypevr + +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} dict-configuration dict +Dict configuration, as created by the @code{dict-configuration} +constructor. + +Available @code{dict-configuration} fields are: + +@deftypevr {@code{dict-configuration} parameter} free-form-fields entries +A list of key-value pairs that this dict should hold. +Defaults to @samp{()}. +@end deftypevr + +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} passdb-configuration-list passdbs +List of passdb configurations, each one created by the +@code{passdb-configuration} constructor. + +Available @code{passdb-configuration} fields are: + +@deftypevr {@code{passdb-configuration} parameter} string driver +The driver that the passdb should use. Valid values include +@samp{pam}, @samp{passwd}, @samp{shadow}, @samp{bsdauth}, and +@samp{static}. +Defaults to @samp{"pam"}. +@end deftypevr + +@deftypevr {@code{passdb-configuration} parameter} free-form-args args +A list of key-value args to the passdb driver. +Defaults to @samp{()}. +@end deftypevr + +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} userdb-configuration-list userdbs +List of userdb configurations, each one created by the +@code{userdb-configuration} constructor. + +Available @code{userdb-configuration} fields are: + +@deftypevr {@code{userdb-configuration} parameter} string driver +The driver that the userdb should use. Valid values include +@samp{passwd} and @samp{static}. +Defaults to @samp{"passwd"}. +@end deftypevr + +@deftypevr {@code{userdb-configuration} parameter} free-form-args args +A list of key-value args to the userdb driver. +Defaults to @samp{()}. +@end deftypevr + +@deftypevr {@code{userdb-configuration} parameter} free-form-args override-fields +Override fields from passwd. +Defaults to @samp{()}. +@end deftypevr + +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} plugin-configuration plugin-configuration +Plug-in configuration, created by the @code{plugin-configuration} +constructor. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} list-of-namespace-configuration namespaces +List of namespaces. Each item in the list is created by the +@code{namespace-configuration} constructor. + +Available @code{namespace-configuration} fields are: + +@deftypevr {@code{namespace-configuration} parameter} string name +Name for this namespace. +@end deftypevr + +@deftypevr {@code{namespace-configuration} parameter} string type +Namespace type: @samp{private}, @samp{shared} or @samp{public}. +Defaults to @samp{"private"}. +@end deftypevr + +@deftypevr {@code{namespace-configuration} parameter} string separator +Hierarchy separator to use. You should use the same separator for +all namespaces or some clients get confused. @samp{/} is usually a good +one. The default however depends on the underlying mail storage +format. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{namespace-configuration} parameter} string prefix +Prefix required to access this namespace. This needs to be +different for all namespaces. For example @samp{Public/}. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{namespace-configuration} parameter} string location +Physical location of the mailbox. This is in same format as +mail_location, which is also the default for it. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{namespace-configuration} parameter} boolean inbox? +There can be only one INBOX, and this setting defines which +namespace has it. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{namespace-configuration} parameter} boolean hidden? +If namespace is hidden, it's not advertised to clients via NAMESPACE +extension. You'll most likely also want to set @samp{list? #f}. This is mostly +useful when converting from another server with different namespaces +which you want to deprecate but still keep working. For example you can +create hidden namespaces with prefixes @samp{~/mail/}, @samp{~%u/mail/} +and @samp{mail/}. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{namespace-configuration} parameter} boolean list? +Show the mailboxes under this namespace with LIST command. This +makes the namespace visible for clients that don't support NAMESPACE +extension. The special @code{children} value lists child mailboxes, but +hides the namespace prefix. +Defaults to @samp{#t}. +@end deftypevr + +@deftypevr {@code{namespace-configuration} parameter} boolean subscriptions? +Namespace handles its own subscriptions. If set to @code{#f}, the +parent namespace handles them. The empty prefix should always have this +as @code{#t}.) +Defaults to @samp{#t}. +@end deftypevr + +@deftypevr {@code{namespace-configuration} parameter} mailbox-configuration-list mailboxes +List of predefined mailboxes in this namespace. +Defaults to @samp{()}. + +Available @code{mailbox-configuration} fields are: + +@deftypevr {@code{mailbox-configuration} parameter} string name +Name for this mailbox. +@end deftypevr + +@deftypevr {@code{mailbox-configuration} parameter} string auto +@samp{create} will automatically create this mailbox. +@samp{subscribe} will both create and subscribe to the mailbox. +Defaults to @samp{"no"}. +@end deftypevr + +@deftypevr {@code{mailbox-configuration} parameter} space-separated-string-list special-use +List of IMAP @code{SPECIAL-USE} attributes as specified by RFC 6154. +Valid values are @code{\All}, @code{\Archive}, @code{\Drafts}, +@code{\Flagged}, @code{\Junk}, @code{\Sent}, and @code{\Trash}. +Defaults to @samp{()}. +@end deftypevr + +@end deftypevr + +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} file-name base-dir +Base directory where to store runtime data. +Defaults to @samp{"/var/run/dovecot/"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string login-greeting +Greeting message for clients. +Defaults to @samp{"Dovecot ready."}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} space-separated-string-list login-trusted-networks +List of trusted network ranges. Connections from these IPs are +allowed to override their IP addresses and ports (for logging and for +authentication checks). @samp{disable-plaintext-auth} is also ignored +for these networks. Typically you'd specify your IMAP proxy servers +here. +Defaults to @samp{()}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} space-separated-string-list login-access-sockets +List of login access check sockets (e.g. tcpwrap). +Defaults to @samp{()}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean verbose-proctitle? +Show more verbose process titles (in ps). Currently shows user name +and IP address. Useful for seeing who are actually using the IMAP +processes (e.g. shared mailboxes or if same uid is used for multiple +accounts). +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean shutdown-clients? +Should all processes be killed when Dovecot master process shuts down. +Setting this to @code{#f} means that Dovecot can be upgraded without +forcing existing client connections to close (although that could also +be a problem if the upgrade is e.g. because of a security fix). +Defaults to @samp{#t}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer doveadm-worker-count +If non-zero, run mail commands via this many connections to doveadm +server, instead of running them directly in the same process. +Defaults to @samp{0}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string doveadm-socket-path +UNIX socket or host:port used for connecting to doveadm server. +Defaults to @samp{"doveadm-server"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} space-separated-string-list import-environment +List of environment variables that are preserved on Dovecot startup +and passed down to all of its child processes. You can also give +key=value pairs to always set specific settings. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean disable-plaintext-auth? +Disable LOGIN command and all other plaintext authentications unless +SSL/TLS is used (LOGINDISABLED capability). Note that if the remote IP +matches the local IP (i.e. you're connecting from the same computer), +the connection is considered secure and plaintext authentication is +allowed. See also ssl=required setting. +Defaults to @samp{#t}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer auth-cache-size +Authentication cache size (e.g. @samp{#e10e6}). 0 means it's disabled. +Note that bsdauth, PAM and vpopmail require @samp{cache-key} to be set +for caching to be used. +Defaults to @samp{0}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string auth-cache-ttl +Time to live for cached data. After TTL expires the cached record +is no longer used, *except* if the main database lookup returns internal +failure. We also try to handle password changes automatically: If +user's previous authentication was successful, but this one wasn't, the +cache isn't used. For now this works only with plaintext +authentication. +Defaults to @samp{"1 hour"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string auth-cache-negative-ttl +TTL for negative hits (user not found, password mismatch). +0 disables caching them completely. +Defaults to @samp{"1 hour"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} space-separated-string-list auth-realms +List of realms for SASL authentication mechanisms that need them. +You can leave it empty if you don't want to support multiple realms. +Many clients simply use the first one listed here, so keep the default +realm first. +Defaults to @samp{()}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string auth-default-realm +Default realm/domain to use if none was specified. This is used for +both SASL realms and appending @@domain to username in plaintext +logins. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string auth-username-chars +List of allowed characters in username. If the user-given username +contains a character not listed in here, the login automatically fails. +This is just an extra check to make sure user can't exploit any +potential quote escaping vulnerabilities with SQL/LDAP databases. If +you want to allow all characters, set this value to empty. +Defaults to @samp{"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ01234567890.-_@@"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string auth-username-translation +Username character translations before it's looked up from +databases. The value contains series of from -> to characters. For +example @samp{#@@/@@} means that @samp{#} and @samp{/} characters are +translated to @samp{@@}. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string auth-username-format +Username formatting before it's looked up from databases. You can +use the standard variables here, e.g. %Lu would lowercase the username, +%n would drop away the domain if it was given, or @samp{%n-AT-%d} would +change the @samp{@@} into @samp{-AT-}. This translation is done after +@samp{auth-username-translation} changes. +Defaults to @samp{"%Lu"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string auth-master-user-separator +If you want to allow master users to log in by specifying the master +username within the normal username string (i.e. not using SASL +mechanism's support for it), you can specify the separator character +here. The format is then <username><separator><master username>. +UW-IMAP uses @samp{*} as the separator, so that could be a good +choice. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string auth-anonymous-username +Username to use for users logging in with ANONYMOUS SASL +mechanism. +Defaults to @samp{"anonymous"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer auth-worker-max-count +Maximum number of dovecot-auth worker processes. They're used to +execute blocking passdb and userdb queries (e.g. MySQL and PAM). +They're automatically created and destroyed as needed. +Defaults to @samp{30}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string auth-gssapi-hostname +Host name to use in GSSAPI principal names. The default is to use +the name returned by gethostname(). Use @samp{$ALL} (with quotes) to +allow all keytab entries. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string auth-krb5-keytab +Kerberos keytab to use for the GSSAPI mechanism. Will use the +system default (usually /etc/krb5.keytab) if not specified. You may +need to change the auth service to run as root to be able to read this +file. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean auth-use-winbind? +Do NTLM and GSS-SPNEGO authentication using Samba's winbind daemon +and @samp{ntlm-auth} helper. +<doc/wiki/Authentication/Mechanisms/Winbind.txt>. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} file-name auth-winbind-helper-path +Path for Samba's @samp{ntlm-auth} helper binary. +Defaults to @samp{"/usr/bin/ntlm_auth"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string auth-failure-delay +Time to delay before replying to failed authentications. +Defaults to @samp{"2 secs"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean auth-ssl-require-client-cert? +Require a valid SSL client certificate or the authentication +fails. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean auth-ssl-username-from-cert? +Take the username from client's SSL certificate, using +@code{X509_NAME_get_text_by_NID()} which returns the subject's DN's +CommonName. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} space-separated-string-list auth-mechanisms +List of wanted authentication mechanisms. Supported mechanisms are: +@samp{plain}, @samp{login}, @samp{digest-md5}, @samp{cram-md5}, +@samp{ntlm}, @samp{rpa}, @samp{apop}, @samp{anonymous}, @samp{gssapi}, +@samp{otp}, @samp{skey}, and @samp{gss-spnego}. NOTE: See also +@samp{disable-plaintext-auth} setting. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} space-separated-string-list director-servers +List of IPs or hostnames to all director servers, including ourself. +Ports can be specified as ip:port. The default port is the same as what +director service's @samp{inet-listener} is using. +Defaults to @samp{()}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} space-separated-string-list director-mail-servers +List of IPs or hostnames to all backend mail servers. Ranges are +allowed too, like 10.0.0.10-10.0.0.30. +Defaults to @samp{()}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string director-user-expire +How long to redirect users to a specific server after it no longer +has any connections. +Defaults to @samp{"15 min"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer director-doveadm-port +TCP/IP port that accepts doveadm connections (instead of director +connections) If you enable this, you'll also need to add +@samp{inet-listener} for the port. +Defaults to @samp{0}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string director-username-hash +How the username is translated before being hashed. Useful values +include %Ln if user can log in with or without @@domain, %Ld if mailboxes +are shared within domain. +Defaults to @samp{"%Lu"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string log-path +Log file to use for error messages. @samp{syslog} logs to syslog, +@samp{/dev/stderr} logs to stderr. +Defaults to @samp{"syslog"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string info-log-path +Log file to use for informational messages. Defaults to +@samp{log-path}. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string debug-log-path +Log file to use for debug messages. Defaults to +@samp{info-log-path}. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string syslog-facility +Syslog facility to use if you're logging to syslog. Usually if you +don't want to use @samp{mail}, you'll use local0..local7. Also other +standard facilities are supported. +Defaults to @samp{"mail"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean auth-verbose? +Log unsuccessful authentication attempts and the reasons why they +failed. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean auth-verbose-passwords? +In case of password mismatches, log the attempted password. Valid +values are no, plain and sha1. sha1 can be useful for detecting brute +force password attempts vs. user simply trying the same password over +and over again. You can also truncate the value to n chars by appending +":n" (e.g. sha1:6). +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean auth-debug? +Even more verbose logging for debugging purposes. Shows for example +SQL queries. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean auth-debug-passwords? +In case of password mismatches, log the passwords and used scheme so +the problem can be debugged. Enabling this also enables +@samp{auth-debug}. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean mail-debug? +Enable mail process debugging. This can help you figure out why +Dovecot isn't finding your mails. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean verbose-ssl? +Show protocol level SSL errors. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string log-timestamp +Prefix for each line written to log file. % codes are in +strftime(3) format. +Defaults to @samp{"\"%b %d %H:%M:%S \""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} space-separated-string-list login-log-format-elements +List of elements we want to log. The elements which have a +non-empty variable value are joined together to form a comma-separated +string. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string login-log-format +Login log format. %s contains @samp{login-log-format-elements} +string, %$ contains the data we want to log. +Defaults to @samp{"%$: %s"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mail-log-prefix +Log prefix for mail processes. See doc/wiki/Variables.txt for list +of possible variables you can use. +Defaults to @samp{"\"%s(%u): \""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string deliver-log-format +Format to use for logging mail deliveries. You can use variables: +@table @code +@item %$ +Delivery status message (e.g. @samp{saved to INBOX}) +@item %m +Message-ID +@item %s +Subject +@item %f +From address +@item %p +Physical size +@item %w +Virtual size. +@end table +Defaults to @samp{"msgid=%m: %$"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mail-location +Location for users' mailboxes. The default is empty, which means +that Dovecot tries to find the mailboxes automatically. This won't work +if the user doesn't yet have any mail, so you should explicitly tell +Dovecot the full location. + +If you're using mbox, giving a path to the INBOX +file (e.g. /var/mail/%u) isn't enough. You'll also need to tell Dovecot +where the other mailboxes are kept. This is called the "root mail +directory", and it must be the first path given in the +@samp{mail-location} setting. + +There are a few special variables you can use, eg.: + +@table @samp +@item %u +username +@item %n +user part in user@@domain, same as %u if there's no domain +@item %d +domain part in user@@domain, empty if there's no domain +@item %h +home director +@end table + +See doc/wiki/Variables.txt for full list. Some examples: +@table @samp +@item maildir:~/Maildir +@item mbox:~/mail:INBOX=/var/mail/%u +@item mbox:/var/mail/%d/%1n/%n:INDEX=/var/indexes/%d/%1n/% +@end table +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mail-uid +System user and group used to access mails. If you use multiple, +userdb can override these by returning uid or gid fields. You can use +either numbers or names. <doc/wiki/UserIds.txt>. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mail-gid + +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mail-privileged-group +Group to enable temporarily for privileged operations. Currently +this is used only with INBOX when either its initial creation or +dotlocking fails. Typically this is set to "mail" to give access to +/var/mail. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mail-access-groups +Grant access to these supplementary groups for mail processes. +Typically these are used to set up access to shared mailboxes. Note +that it may be dangerous to set these if users can create +symlinks (e.g. if "mail" group is set here, ln -s /var/mail ~/mail/var +could allow a user to delete others' mailboxes, or ln -s +/secret/shared/box ~/mail/mybox would allow reading it). +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean mail-full-filesystem-access? +Allow full filesystem access to clients. There's no access checks +other than what the operating system does for the active UID/GID. It +works with both maildir and mboxes, allowing you to prefix mailboxes +names with e.g. /path/ or ~user/. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean mmap-disable? +Don't use mmap() at all. This is required if you store indexes to +shared filesystems (NFS or clustered filesystem). +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean dotlock-use-excl? +Rely on @samp{O_EXCL} to work when creating dotlock files. NFS +supports @samp{O_EXCL} since version 3, so this should be safe to use +nowadays by default. +Defaults to @samp{#t}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mail-fsync +When to use fsync() or fdatasync() calls: +@table @code +@item optimized +Whenever necessary to avoid losing important data +@item always +Useful with e.g. NFS when write()s are delayed +@item never +Never use it (best performance, but crashes can lose data). +@end table +Defaults to @samp{"optimized"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean mail-nfs-storage? +Mail storage exists in NFS. Set this to yes to make Dovecot flush +NFS caches whenever needed. If you're using only a single mail server +this isn't needed. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean mail-nfs-index? +Mail index files also exist in NFS. Setting this to yes requires +@samp{mmap-disable? #t} and @samp{fsync-disable? #f}. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string lock-method +Locking method for index files. Alternatives are fcntl, flock and +dotlock. Dotlocking uses some tricks which may create more disk I/O +than other locking methods. NFS users: flock doesn't work, remember to +change @samp{mmap-disable}. +Defaults to @samp{"fcntl"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} file-name mail-temp-dir +Directory in which LDA/LMTP temporarily stores incoming mails >128 +kB. +Defaults to @samp{"/tmp"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer first-valid-uid +Valid UID range for users. This is mostly to make sure that users can't +log in as daemons or other system users. Note that denying root logins is +hardcoded to dovecot binary and can't be done even if @samp{first-valid-uid} +is set to 0. +Defaults to @samp{500}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer last-valid-uid + +Defaults to @samp{0}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer first-valid-gid +Valid GID range for users. Users having non-valid GID as primary group ID +aren't allowed to log in. If user belongs to supplementary groups with +non-valid GIDs, those groups are not set. +Defaults to @samp{1}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer last-valid-gid + +Defaults to @samp{0}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer mail-max-keyword-length +Maximum allowed length for mail keyword name. It's only forced when +trying to create new keywords. +Defaults to @samp{50}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} colon-separated-file-name-list valid-chroot-dirs +List of directories under which chrooting is allowed for mail +processes (i.e. /var/mail will allow chrooting to /var/mail/foo/bar +too). This setting doesn't affect @samp{login-chroot} +@samp{mail-chroot} or auth chroot settings. If this setting is empty, +"/./" in home dirs are ignored. WARNING: Never add directories here +which local users can modify, that may lead to root exploit. Usually +this should be done only if you don't allow shell access for users. +<doc/wiki/Chrooting.txt>. +Defaults to @samp{()}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mail-chroot +Default chroot directory for mail processes. This can be overridden +for specific users in user database by giving /./ in user's home +directory (e.g. /home/./user chroots into /home). Note that usually +there is no real need to do chrooting, Dovecot doesn't allow users to +access files outside their mail directory anyway. If your home +directories are prefixed with the chroot directory, append "/." to +@samp{mail-chroot}. <doc/wiki/Chrooting.txt>. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} file-name auth-socket-path +UNIX socket path to master authentication server to find users. +This is used by imap (for shared users) and lda. +Defaults to @samp{"/var/run/dovecot/auth-userdb"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} file-name mail-plugin-dir +Directory where to look up mail plugins. +Defaults to @samp{"/usr/lib/dovecot"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} space-separated-string-list mail-plugins +List of plugins to load for all services. Plugins specific to IMAP, +LDA, etc. are added to this list in their own .conf files. +Defaults to @samp{()}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer mail-cache-min-mail-count +The minimum number of mails in a mailbox before updates are done to +cache file. This allows optimizing Dovecot's behavior to do less disk +writes at the cost of more disk reads. +Defaults to @samp{0}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mailbox-idle-check-interval +When IDLE command is running, mailbox is checked once in a while to +see if there are any new mails or other changes. This setting defines +the minimum time to wait between those checks. Dovecot can also use +dnotify, inotify and kqueue to find out immediately when changes +occur. +Defaults to @samp{"30 secs"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean mail-save-crlf? +Save mails with CR+LF instead of plain LF. This makes sending those +mails take less CPU, especially with sendfile() syscall with Linux and +FreeBSD. But it also creates a bit more disk I/O which may just make it +slower. Also note that if other software reads the mboxes/maildirs, +they may handle the extra CRs wrong and cause problems. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean maildir-stat-dirs? +By default LIST command returns all entries in maildir beginning +with a dot. Enabling this option makes Dovecot return only entries +which are directories. This is done by stat()ing each entry, so it +causes more disk I/O. + (For systems setting struct @samp{dirent->d_type} this check is free +and it's done always regardless of this setting). +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean maildir-copy-with-hardlinks? +When copying a message, do it with hard links whenever possible. +This makes the performance much better, and it's unlikely to have any +side effects. +Defaults to @samp{#t}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean maildir-very-dirty-syncs? +Assume Dovecot is the only MUA accessing Maildir: Scan cur/ +directory only when its mtime changes unexpectedly or when we can't find +the mail otherwise. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} space-separated-string-list mbox-read-locks +Which locking methods to use for locking mbox. There are four +available: + +@table @code +@item dotlock +Create <mailbox>.lock file. This is the oldest and most NFS-safe +solution. If you want to use /var/mail/ like directory, the users will +need write access to that directory. +@item dotlock-try +Same as dotlock, but if it fails because of permissions or because there +isn't enough disk space, just skip it. +@item fcntl +Use this if possible. Works with NFS too if lockd is used. +@item flock +May not exist in all systems. Doesn't work with NFS. +@item lockf +May not exist in all systems. Doesn't work with NFS. +@end table + +You can use multiple locking methods; if you do the order they're declared +in is important to avoid deadlocks if other MTAs/MUAs are using multiple +locking methods as well. Some operating systems don't allow using some of +them simultaneously. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} space-separated-string-list mbox-write-locks + +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mbox-lock-timeout +Maximum time to wait for lock (all of them) before aborting. +Defaults to @samp{"5 mins"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mbox-dotlock-change-timeout +If dotlock exists but the mailbox isn't modified in any way, +override the lock file after this much time. +Defaults to @samp{"2 mins"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean mbox-dirty-syncs? +When mbox changes unexpectedly we have to fully read it to find out +what changed. If the mbox is large this can take a long time. Since +the change is usually just a newly appended mail, it'd be faster to +simply read the new mails. If this setting is enabled, Dovecot does +this but still safely fallbacks to re-reading the whole mbox file +whenever something in mbox isn't how it's expected to be. The only real +downside to this setting is that if some other MUA changes message +flags, Dovecot doesn't notice it immediately. Note that a full sync is +done with SELECT, EXAMINE, EXPUNGE and CHECK commands. +Defaults to @samp{#t}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean mbox-very-dirty-syncs? +Like @samp{mbox-dirty-syncs}, but don't do full syncs even with SELECT, +EXAMINE, EXPUNGE or CHECK commands. If this is set, +@samp{mbox-dirty-syncs} is ignored. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean mbox-lazy-writes? +Delay writing mbox headers until doing a full write sync (EXPUNGE +and CHECK commands and when closing the mailbox). This is especially +useful for POP3 where clients often delete all mails. The downside is +that our changes aren't immediately visible to other MUAs. +Defaults to @samp{#t}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer mbox-min-index-size +If mbox size is smaller than this (e.g. 100k), don't write index +files. If an index file already exists it's still read, just not +updated. +Defaults to @samp{0}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer mdbox-rotate-size +Maximum dbox file size until it's rotated. +Defaults to @samp{2000000}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mdbox-rotate-interval +Maximum dbox file age until it's rotated. Typically in days. Day +begins from midnight, so 1d = today, 2d = yesterday, etc. 0 = check +disabled. +Defaults to @samp{"1d"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean mdbox-preallocate-space? +When creating new mdbox files, immediately preallocate their size to +@samp{mdbox-rotate-size}. This setting currently works only in Linux +with some filesystems (ext4, xfs). +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mail-attachment-dir +sdbox and mdbox support saving mail attachments to external files, +which also allows single instance storage for them. Other backends +don't support this for now. + +WARNING: This feature hasn't been tested much yet. Use at your own risk. + +Directory root where to store mail attachments. Disabled, if empty. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer mail-attachment-min-size +Attachments smaller than this aren't saved externally. It's also +possible to write a plugin to disable saving specific attachments +externally. +Defaults to @samp{128000}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mail-attachment-fs +Filesystem backend to use for saving attachments: +@table @code +@item posix +No SiS done by Dovecot (but this might help FS's own deduplication) +@item sis posix +SiS with immediate byte-by-byte comparison during saving +@item sis-queue posix +SiS with delayed comparison and deduplication. +@end table +Defaults to @samp{"sis posix"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string mail-attachment-hash +Hash format to use in attachment filenames. You can add any text and +variables: @code{%@{md4@}}, @code{%@{md5@}}, @code{%@{sha1@}}, +@code{%@{sha256@}}, @code{%@{sha512@}}, @code{%@{size@}}. Variables can be +truncated, e.g. @code{%@{sha256:80@}} returns only first 80 bits. +Defaults to @samp{"%@{sha1@}"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer default-process-limit + +Defaults to @samp{100}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer default-client-limit + +Defaults to @samp{1000}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer default-vsz-limit +Default VSZ (virtual memory size) limit for service processes. +This is mainly intended to catch and kill processes that leak memory +before they eat up everything. +Defaults to @samp{256000000}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string default-login-user +Login user is internally used by login processes. This is the most +untrusted user in Dovecot system. It shouldn't have access to anything +at all. +Defaults to @samp{"dovenull"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string default-internal-user +Internal user is used by unprivileged processes. It should be +separate from login user, so that login processes can't disturb other +processes. +Defaults to @samp{"dovecot"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string ssl? +SSL/TLS support: yes, no, required. <doc/wiki/SSL.txt>. +Defaults to @samp{"required"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string ssl-cert +PEM encoded X.509 SSL/TLS certificate (public key). +Defaults to @samp{"</etc/dovecot/default.pem"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string ssl-key +PEM encoded SSL/TLS private key. The key is opened before +dropping root privileges, so keep the key file unreadable by anyone but +root. +Defaults to @samp{"</etc/dovecot/private/default.pem"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string ssl-key-password +If key file is password protected, give the password here. +Alternatively give it when starting dovecot with -p parameter. Since +this file is often world-readable, you may want to place this setting +instead to a different. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string ssl-ca +PEM encoded trusted certificate authority. Set this only if you +intend to use @samp{ssl-verify-client-cert? #t}. The file should +contain the CA certificate(s) followed by the matching +CRL(s). (e.g. @samp{ssl-ca </etc/ssl/certs/ca.pem}). +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean ssl-require-crl? +Require that CRL check succeeds for client certificates. +Defaults to @samp{#t}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean ssl-verify-client-cert? +Request client to send a certificate. If you also want to require +it, set @samp{auth-ssl-require-client-cert? #t} in auth section. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string ssl-cert-username-field +Which field from certificate to use for username. commonName and +x500UniqueIdentifier are the usual choices. You'll also need to set +@samp{auth-ssl-username-from-cert? #t}. +Defaults to @samp{"commonName"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} hours ssl-parameters-regenerate +How often to regenerate the SSL parameters file. Generation is +quite CPU intensive operation. The value is in hours, 0 disables +regeneration entirely. +Defaults to @samp{168}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string ssl-protocols +SSL protocols to use. +Defaults to @samp{"!SSLv2"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string ssl-cipher-list +SSL ciphers to use. +Defaults to @samp{"ALL:!LOW:!SSLv2:!EXP:!aNULL"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string ssl-crypto-device +SSL crypto device to use, for valid values run "openssl engine". +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string postmaster-address +Address to use when sending rejection mails. +Default is postmaster@@<your domain>. %d expands to recipient domain. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string hostname +Hostname to use in various parts of sent mails (e.g. in Message-Id) +and in LMTP replies. Default is the system's real hostname@@domain. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean quota-full-tempfail? +If user is over quota, return with temporary failure instead of +bouncing the mail. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} file-name sendmail-path +Binary to use for sending mails. +Defaults to @samp{"/usr/sbin/sendmail"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string submission-host +If non-empty, send mails via this SMTP host[:port] instead of +sendmail. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string rejection-subject +Subject: header to use for rejection mails. You can use the same +variables as for @samp{rejection-reason} below. +Defaults to @samp{"Rejected: %s"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string rejection-reason +Human readable error message for rejection mails. You can use +variables: + +@table @code +@item %n +CRLF +@item %r +reason +@item %s +original subject +@item %t +recipient +@end table +Defaults to @samp{"Your message to <%t> was automatically rejected:%n%r"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string recipient-delimiter +Delimiter character between local-part and detail in email +address. +Defaults to @samp{"+"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string lda-original-recipient-header +Header where the original recipient address (SMTP's RCPT TO: +address) is taken from if not available elsewhere. With dovecot-lda -a +parameter overrides this. A commonly used header for this is +X-Original-To. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean lda-mailbox-autocreate? +Should saving a mail to a nonexistent mailbox automatically create +it?. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} boolean lda-mailbox-autosubscribe? +Should automatically created mailboxes be also automatically +subscribed?. +Defaults to @samp{#f}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} non-negative-integer imap-max-line-length +Maximum IMAP command line length. Some clients generate very long +command lines with huge mailboxes, so you may need to raise this if you +get "Too long argument" or "IMAP command line too large" errors +often. +Defaults to @samp{64000}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string imap-logout-format +IMAP logout format string: +@table @code +@item %i +total number of bytes read from client +@item %o +total number of bytes sent to client. +@end table +Defaults to @samp{"in=%i out=%o"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string imap-capability +Override the IMAP CAPABILITY response. If the value begins with '+', +add the given capabilities on top of the defaults (e.g. +XFOO XBAR). +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string imap-idle-notify-interval +How long to wait between "OK Still here" notifications when client +is IDLEing. +Defaults to @samp{"2 mins"}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string imap-id-send +ID field names and values to send to clients. Using * as the value +makes Dovecot use the default value. The following fields have default +values currently: name, version, os, os-version, support-url, +support-email. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string imap-id-log +ID fields sent by client to log. * means everything. +Defaults to @samp{""}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} space-separated-string-list imap-client-workarounds +Workarounds for various client bugs: + +@table @code +@item delay-newmail +Send EXISTS/RECENT new mail notifications only when replying to NOOP and +CHECK commands. Some clients ignore them otherwise, for example OSX +Mail (<v2.1). Outlook Express breaks more badly though, without this it +may show user "Message no longer in server" errors. Note that OE6 +still breaks even with this workaround if synchronization is set to +"Headers Only". + +@item tb-extra-mailbox-sep +Thunderbird gets somehow confused with LAYOUT=fs (mbox and dbox) and +adds extra @samp{/} suffixes to mailbox names. This option causes Dovecot to +ignore the extra @samp{/} instead of treating it as invalid mailbox name. + +@item tb-lsub-flags +Show \Noselect flags for LSUB replies with LAYOUT=fs (e.g. mbox). +This makes Thunderbird realize they aren't selectable and show them +greyed out, instead of only later giving "not selectable" popup error. +@end table +Defaults to @samp{()}. +@end deftypevr + +@deftypevr {@code{dovecot-configuration} parameter} string imap-urlauth-host +Host allowed in URLAUTH URLs sent by client. "*" allows all. +Defaults to @samp{""}. +@end deftypevr + + +Whew! Lots of configuration options. The nice thing about it though is +that GuixSD has a complete interface to Dovecot's configuration +language. This allows not only a nice way to declare configurations, +but also offers reflective capabilities as well: users can write code to +inspect and transform configurations from within Scheme. + +However, it could be that you just want to get a @code{dovecot.conf} up +and running. In that case, you can pass an +@code{opaque-dovecot-configuration} as the @code{#:config} paramter to +@code{dovecot-service}. As its name indicates, an opaque configuration +does not have easy reflective capabilities. + +Available @code{opaque-dovecot-configuration} fields are: + +@deftypevr {@code{opaque-dovecot-configuration} parameter} package dovecot +The dovecot package. +@end deftypevr + +@deftypevr {@code{opaque-dovecot-configuration} parameter} string string +The contents of the @code{dovecot.conf}, as a string. +@end deftypevr + +For example, if your @code{dovecot.conf} is just the empty string, you +could instantiate a dovecot service like this: + +@example +(dovecot-service #:config + (opaque-dovecot-configuration + (string ""))) +@end example + @node Web Services @subsubsection Web Services @@ -7126,7 +8556,7 @@ password, and which needs to access the @file{/etc/passwd} and obvious security reasons. To address that, these executables are @dfn{setuid-root}, meaning that they always run with root privileges (@pxref{How Change Persona,,, libc, The GNU C Library Reference Manual}, -for more info about the setuid mechanisms.) +for more info about the setuid mechanism.) The store itself @emph{cannot} contain setuid programs: that would be a security issue since any user on the system can write derivations that @@ -22,14 +22,19 @@ ELFILES = \ emacs/guix-backend.el \ emacs/guix-base.el \ emacs/guix-build-log.el \ + emacs/guix-buffer.el \ emacs/guix-command.el \ emacs/guix-devel.el \ emacs/guix-emacs.el \ + emacs/guix-entry.el \ emacs/guix-external.el \ emacs/guix-geiser.el \ emacs/guix-guile.el \ emacs/guix-help-vars.el \ emacs/guix-history.el \ + emacs/guix-hydra.el \ + emacs/guix-hydra-build.el \ + emacs/guix-hydra-jobset.el \ emacs/guix-info.el \ emacs/guix-init.el \ emacs/guix-list.el \ @@ -39,8 +44,10 @@ ELFILES = \ emacs/guix-prettify.el \ emacs/guix-profiles.el \ emacs/guix-read.el \ - emacs/guix-utils.el \ - emacs/guix.el + emacs/guix-ui.el \ + emacs/guix-ui-package.el \ + emacs/guix-ui-generation.el \ + emacs/guix-utils.el if HAVE_EMACS diff --git a/emacs/guix-backend.el b/emacs/guix-backend.el index 82383e48ff..0736f85ec8 100644 --- a/emacs/guix-backend.el +++ b/emacs/guix-backend.el @@ -36,18 +36,13 @@ ;; running code in the REPL (see ;; <https://github.com/jaor/geiser/issues/28>). ;; -;; If you need to use "guix.el" in another Emacs (i.e. when there is -;; a runnig "guile --listen..." REPL somewhere), you can either change -;; `guix-default-port' in that Emacs instance or set -;; `guix-use-guile-server' to t. -;; ;; Guix REPLs (unlike the usual Geiser REPLs) are not added to ;; `geiser-repl--repls' variable, and thus cannot be used for evaluating ;; while editing scm-files. The only purpose of Guix REPLs is to be an ;; intermediate between "Guix/Guile level" and "Emacs interface level". ;; That being said you can still want to use a Guix REPL while hacking -;; auxiliary scheme-files for "guix.el". You can just use "M-x -;; connect-to-guile" (connect to "localhost" and `guix-default-port') to +;; auxiliary scheme-files for "guix.el". You can just use +;; `geiser-connect-local' command with `guix-repl-current-socket' to ;; have a usual Geiser REPL with all stuff defined by "guix.el" package. ;;; Code: @@ -98,11 +93,17 @@ REPL while some packages are being installed/removed in the main REPL." :type 'boolean :group 'guix-repl) -(defcustom guix-default-port 37246 - "Default port used if `guix-use-guile-server' is non-nil." - :type 'integer +(defcustom guix-repl-socket-file-name-function + #'guix-repl-socket-file-name + "Function used to define a socket file name used by Guix REPL. +The function is called without arguments." + :type '(choice (function-item guix-repl-socket-file-name) + (function :tag "Other function")) :group 'guix-repl) +(defvar guix-repl-current-socket nil + "Name of a socket file used by the current Guix REPL.") + (defvar guix-repl-buffer nil "Main Geiser REPL buffer used for communicating with Guix. This REPL is used for processing package actions and for @@ -139,17 +140,28 @@ See `guix-eval-in-repl' for details.") "Message telling about successful Guix operation." (message "Guix operation has been performed.")) -(defun guix-get-guile-program (&optional internal) +(defun guix-get-guile-program (&optional socket) "Return a value suitable for `geiser-guile-binary'." - (if (or internal - (not guix-use-guile-server)) + (if (null socket) guix-guile-program (append (if (listp guix-guile-program) guix-guile-program (list guix-guile-program)) - ;; Guile understands "--listen=..." but not "--listen ..." - (list (concat "--listen=" - (number-to-string guix-default-port)))))) + (list (concat "--listen=" socket))))) + +(defun guix-repl-socket-file-name () + "Return a name of a socket file used by Guix REPL." + (make-temp-name + (concat (file-name-as-directory temporary-file-directory) + "guix-repl-"))) + +(defun guix-repl-delete-socket-maybe () + "Delete `guix-repl-current-socket' file if it exists." + (and guix-repl-current-socket + (file-exists-p guix-repl-current-socket) + (delete-file guix-repl-current-socket))) + +(add-hook 'kill-emacs-hook 'guix-repl-delete-socket-maybe) (defun guix-start-process-maybe (&optional start-msg end-msg) "Start Geiser REPL configured for Guix if needed. @@ -176,19 +188,21 @@ display messages." (get-buffer-process repl)) (and start-msg (message start-msg)) (setq guix-repl-operation-p nil) - (let ((geiser-guile-binary (guix-get-guile-program internal)) - (geiser-guile-init-file (or internal guix-helper-file)) + (unless internal + ;; Guile leaves socket file after exit, so remove it if it + ;; exists (after the REPL restart). + (guix-repl-delete-socket-maybe) + (setq guix-repl-current-socket + (and guix-use-guile-server + (or guix-repl-current-socket + (funcall guix-repl-socket-file-name-function))))) + (let ((geiser-guile-binary (guix-get-guile-program + (unless internal + guix-repl-current-socket))) + (geiser-guile-init-file (unless internal guix-helper-file)) (repl (get-buffer-create (guix-get-repl-buffer-name internal)))) - (condition-case err - (guix-start-repl repl - (and internal - (geiser-repl--read-address - "localhost" guix-default-port))) - (text-read-only - (error (concat "Couldn't start Guix REPL. Perhaps the port %s is busy.\n" - "See buffer '%s' for details") - guix-default-port (buffer-name repl)))) + (guix-start-repl repl (and internal guix-repl-current-socket)) (set repl-var repl) (and end-msg (message end-msg)) (unless internal diff --git a/emacs/guix-base.el b/emacs/guix-base.el index d9c70aae9e..dae658ebfa 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -22,124 +22,32 @@ ;; This file provides some base and common definitions for guix.el ;; package. -;; List and info buffers have many common patterns that are defined -;; using `guix-define-buffer-type' macro from this file. - ;;; Code: (require 'cl-lib) -(require 'guix-profiles) (require 'guix-backend) (require 'guix-guile) +(require 'guix-read) (require 'guix-utils) -(require 'guix-history) -(require 'guix-messages) - - -;;; Parameters of the entries - -(defvar guix-param-titles - '((package - (id . "ID") - (name . "Name") - (version . "Version") - (source . "Source") - (license . "License") - (synopsis . "Synopsis") - (description . "Description") - (home-url . "Home page") - (outputs . "Outputs") - (inputs . "Inputs") - (native-inputs . "Native inputs") - (propagated-inputs . "Propagated inputs") - (location . "Location") - (installed . "Installed")) - (installed - (path . "Installed path") - (dependencies . "Dependencies") - (output . "Output")) - (output - (id . "ID") - (name . "Name") - (version . "Version") - (source . "Source") - (license . "License") - (synopsis . "Synopsis") - (description . "Description") - (home-url . "Home page") - (output . "Output") - (inputs . "Inputs") - (native-inputs . "Native inputs") - (propagated-inputs . "Propagated inputs") - (location . "Location") - (installed . "Installed") - (path . "Installed path") - (dependencies . "Dependencies")) - (generation - (id . "ID") - (number . "Number") - (prev-number . "Previous number") - (current . "Current") - (path . "Path") - (time . "Time"))) - "List for defining titles of entry parameters. -Titles are used for displaying information about entries. -Each element of the list has a form: +(require 'guix-ui) - (ENTRY-TYPE . ((PARAM . TITLE) ...))") +(defgroup guix nil + "Settings for Guix package manager and friends." + :prefix "guix-" + :group 'external) -(defun guix-get-param-title (entry-type param) - "Return title of an ENTRY-TYPE entry parameter PARAM." - (or (guix-assq-value guix-param-titles - entry-type param) - (prog1 (symbol-name param) - (message "Couldn't find title for '%S %S'." - entry-type param)))) +(defgroup guix-faces nil + "Guix faces." + :group 'guix + :group 'faces) -(defun guix-get-name-spec (name version &optional output) +(defun guix-package-name-specification (name version &optional output) "Return Guix package specification by its NAME, VERSION and OUTPUT." (concat name "-" version (when output (concat ":" output)))) -(defun guix-get-full-name (entry &optional output) - "Return name specification of the package ENTRY and OUTPUT." - (guix-get-name-spec (guix-assq-value entry 'name) - (guix-assq-value entry 'version) - output)) - -(defun guix-entry-to-specification (entry) - "Return name specification by the package or output ENTRY." - (guix-get-name-spec (guix-assq-value entry 'name) - (guix-assq-value entry 'version) - (guix-assq-value entry 'output))) - -(defun guix-entries-to-specifications (entries) - "Return name specifications by the package or output ENTRIES." - (cl-remove-duplicates (mapcar #'guix-entry-to-specification entries) - :test #'string=)) - -(defun guix-get-installed-outputs (entry) - "Return list of installed outputs for the package ENTRY." - (mapcar (lambda (installed-entry) - (guix-assq-value installed-entry 'output)) - (guix-assq-value entry 'installed))) - -(defun guix-get-entry-by-id (id entries) - "Return entry from ENTRIES by entry ID." - (cl-find-if (lambda (entry) - (equal id (guix-assq-value entry 'id))) - entries)) - -(defun guix-get-package-id-and-output-by-output-id (oid) - "Return list (PACKAGE-ID OUTPUT) by output id OID." - (cl-multiple-value-bind (pid-str output) - (split-string oid ":") - (let ((pid (string-to-number pid-str))) - (list (if (= 0 pid) pid-str pid) - output)))) - -;;; Location of the packages +;;; Location of packages, profiles and manifests (defvar guix-directory nil "Default Guix directory. @@ -179,538 +87,6 @@ For the meaning of location, see `guix-find-location'." (guix-eval-read (guix-make-guile-expression 'package-location-string id-or-name))) - -;;; Receivable lists of packages, lint checkers, etc. - -(guix-memoized-defun guix-graph-type-names () - "Return a list of names of available graph node types." - (guix-eval-read (guix-make-guile-expression 'graph-type-names))) - -(guix-memoized-defun guix-refresh-updater-names () - "Return a list of names of available refresh updater types." - (guix-eval-read (guix-make-guile-expression 'refresh-updater-names))) - -(guix-memoized-defun guix-lint-checker-names () - "Return a list of names of available lint checkers." - (guix-eval-read (guix-make-guile-expression 'lint-checker-names))) - -(guix-memoized-defun guix-package-names () - "Return a list of names of available packages." - (sort - ;; Work around <https://github.com/jaor/geiser/issues/64>: - ;; list of strings is parsed much slower than list of lists, - ;; so we use 'package-names-lists' instead of 'package-names'. - - ;; (guix-eval-read (guix-make-guile-expression 'package-names)) - - (mapcar #'car - (guix-eval-read (guix-make-guile-expression - 'package-names-lists))) - #'string<)) - - -;;; Buffers and auto updating. - -(defcustom guix-update-after-operation 'current - "Define what information to update after executing an operation. - -After successful executing an operation in the Guix REPL (for -example after installing a package), information in Guix buffers -will or will not be automatically updated depending on a value of -this variable. - -If nil, update nothing (do not revert any buffer). -If `current', update the buffer from which an operation was performed. -If `all', update all Guix buffers (not recommended)." - :type '(choice (const :tag "Do nothing" nil) - (const :tag "Update operation buffer" current) - (const :tag "Update all Guix buffers" all)) - :group 'guix) - -(defcustom guix-buffer-name-function #'guix-buffer-name-default - "Function used to define name of a buffer for displaying information. -The function is called with 4 arguments: PROFILE, BUFFER-TYPE, -ENTRY-TYPE, SEARCH-TYPE. See `guix-get-entries' for the meaning -of the arguments." - :type '(choice (function-item guix-buffer-name-default) - (function-item guix-buffer-name-simple) - (function :tag "Other function")) - :group 'guix) - -(defun guix-buffer-name-simple (_profile buffer-type entry-type - &optional _search-type) - "Return name of a buffer used for displaying information. -The name is defined by `guix-ENTRY-TYPE-BUFFER-TYPE-buffer-name' -variable." - (symbol-value - (guix-get-symbol "buffer-name" buffer-type entry-type))) - -(defun guix-buffer-name-default (profile buffer-type entry-type - &optional _search-type) - "Return name of a buffer used for displaying information. -The name is almost the same as the one defined by -`guix-buffer-name-simple' except the PROFILE name is added to it." - (let ((simple-name (guix-buffer-name-simple - profile buffer-type entry-type)) - (profile-name (file-name-base (directory-file-name profile))) - (re (rx string-start - (group (? "*")) - (group (*? any)) - (group (? "*")) - string-end))) - (or (string-match re simple-name) - (error "Unexpected error in defining guix buffer name")) - (let ((first* (match-string 1 simple-name)) - (name-body (match-string 2 simple-name)) - (last* (match-string 3 simple-name))) - ;; Handle the case when buffer name is wrapped by '*'. - (if (and (string= "*" first*) - (string= "*" last*)) - (concat "*" name-body ": " profile-name "*") - (concat simple-name ": " profile-name))))) - -(defun guix-buffer-name (profile buffer-type entry-type search-type) - "Return name of a buffer used for displaying information. -See `guix-buffer-name-function' for details." - (let ((fun (if (functionp guix-buffer-name-function) - guix-buffer-name-function - #'guix-buffer-name-default))) - (funcall fun profile buffer-type entry-type search-type))) - -(defun guix-switch-to-buffer (buffer) - "Switch to a 'list' or 'info' BUFFER." - (pop-to-buffer buffer - '((display-buffer-reuse-window - display-buffer-same-window)))) - -(defun guix-buffer-p (&optional buffer modes) - "Return non-nil if BUFFER mode is derived from any of the MODES. -If BUFFER is nil, check current buffer. -If MODES is nil, use `guix-list-mode' and `guix-info-mode'." - (with-current-buffer (or buffer (current-buffer)) - (apply #'derived-mode-p - (or modes - '(guix-list-mode guix-info-mode))))) - -(defun guix-buffers (&optional modes) - "Return list of all buffers with major modes derived from MODES. -If MODES is nil, return list of all Guix 'list' and 'info' buffers." - (cl-remove-if-not (lambda (buf) - (guix-buffer-p buf modes)) - (buffer-list))) - -(defun guix-update-buffer (buffer) - "Update information in a 'list' or 'info' BUFFER." - (with-current-buffer buffer - (guix-revert-buffer nil t))) - -(defun guix-update-buffers-maybe-after-operation () - "Update buffers after Guix operation if needed. -See `guix-update-after-operation' for details." - (let ((to-update - (and guix-operation-buffer - (cl-case guix-update-after-operation - (current (and (buffer-live-p guix-operation-buffer) - (guix-buffer-p guix-operation-buffer) - (list guix-operation-buffer))) - (all (guix-buffers)))))) - (setq guix-operation-buffer nil) - (mapc #'guix-update-buffer to-update))) - -(add-hook 'guix-after-repl-operation-hook - 'guix-update-buffers-maybe-after-operation) - - -;;; Common definitions for buffer types - -(defvar guix-root-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "l") 'guix-history-back) - (define-key map (kbd "r") 'guix-history-forward) - (define-key map (kbd "g") 'revert-buffer) - (define-key map (kbd "R") 'guix-redisplay-buffer) - (define-key map (kbd "M") 'guix-apply-manifest) - (define-key map (kbd "C-c C-z") 'guix-switch-to-repl) - map) - "Parent keymap for all guix modes.") - -(defvar-local guix-profile nil - "Profile used for the current buffer.") -(put 'guix-profile 'permanent-local t) - -(defvar-local guix-entries nil - "List of the currently displayed entries. -Each element of the list is alist with entry info of the -following form: - - ((PARAM . VAL) ...) - -PARAM is a name of the entry parameter. -VAL is a value of this parameter.") -(put 'guix-entries 'permanent-local t) - -(defvar-local guix-buffer-type nil - "Type of the current buffer.") -(put 'guix-buffer-type 'permanent-local t) - -(defvar-local guix-entry-type nil - "Type of the current entry.") -(put 'guix-entry-type 'permanent-local t) - -(defvar-local guix-search-type nil - "Type of the current search.") -(put 'guix-search-type 'permanent-local t) - -(defvar-local guix-search-vals nil - "Values of the current search.") -(put 'guix-search-vals 'permanent-local t) - -(defsubst guix-set-vars (profile entries buffer-type entry-type - search-type search-vals) - "Set local variables for the current Guix buffer." - (setq default-directory profile - guix-profile profile - guix-entries entries - guix-buffer-type buffer-type - guix-entry-type entry-type - guix-search-type search-type - guix-search-vals search-vals)) - -(defun guix-get-symbol (postfix buffer-type &optional entry-type) - (intern (concat "guix-" - (when entry-type - (concat (symbol-name entry-type) "-")) - (symbol-name buffer-type) "-" postfix))) - -(defmacro guix-define-buffer-type (buf-type entry-type &rest args) - "Define common for BUF-TYPE buffers for displaying ENTRY-TYPE entries. - -In the text below TYPE means ENTRY-TYPE-BUF-TYPE. - -This macro defines `guix-TYPE-mode', a custom group and several -user variables. - -The following stuff should be defined outside this macro: - - - `guix-BUF-TYPE-mode' - parent mode for the defined mode. - - - `guix-TYPE-mode-initialize' (optional) - function for - additional mode settings; it is called without arguments. - -Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The -following keywords are available: - - - `:buffer-name' - default value for the defined - `guix-TYPE-buffer-name' variable. - - - `:required' - default value for the defined - `guix-TYPE-required-params' variable. - - - `:history-size' - default value for the defined - `guix-TYPE-history-size' variable. - - - `:revert' - default value for the defined - `guix-TYPE-revert-no-confirm' variable." - (let* ((entry-type-str (symbol-name entry-type)) - (buf-type-str (symbol-name buf-type)) - (Entry-type-str (capitalize entry-type-str)) - (Buf-type-str (capitalize buf-type-str)) - (entry-str (concat entry-type-str " entries")) - (buf-str (concat buf-type-str " buffer")) - (prefix (concat "guix-" entry-type-str "-" buf-type-str)) - (group (intern prefix)) - (faces-group (intern (concat prefix "-faces"))) - (mode-map-str (concat prefix "-mode-map")) - (parent-mode (intern (concat "guix-" buf-type-str "-mode"))) - (mode (intern (concat prefix "-mode"))) - (mode-init-fun (intern (concat prefix "-mode-initialize"))) - (buf-name-var (intern (concat prefix "-buffer-name"))) - (revert-var (intern (concat prefix "-revert-no-confirm"))) - (history-var (intern (concat prefix "-history-size"))) - (params-var (intern (concat prefix "-required-params"))) - (buf-name-val (format "*Guix %s %s*" Entry-type-str Buf-type-str)) - (revert-val nil) - (history-val 20) - (params-val '(id))) - - ;; Process the keyword args. - (while (keywordp (car args)) - (pcase (pop args) - (`:required (setq params-val (pop args))) - (`:history-size (setq history-val (pop args))) - (`:revert (setq revert-val (pop args))) - (`:buffer-name (setq buf-name-val (pop args))) - (_ (pop args)))) - - `(progn - (defgroup ,group nil - ,(concat Buf-type-str " buffer with " entry-str ".") - :prefix ,(concat prefix "-") - :group ',(intern (concat "guix-" buf-type-str))) - - (defgroup ,faces-group nil - ,(concat "Faces for " buf-type-str " buffer with " entry-str ".") - :group ',(intern (concat "guix-" buf-type-str "-faces"))) - - (defcustom ,buf-name-var ,buf-name-val - ,(concat "Default name of the " buf-str " for displaying " entry-str ".") - :type 'string - :group ',group) - - (defcustom ,history-var ,history-val - ,(concat "Maximum number of items saved in the history of the " buf-str ".\n" - "If 0, the history is disabled.") - :type 'integer - :group ',group) - - (defcustom ,revert-var ,revert-val - ,(concat "If non-nil, do not ask to confirm for reverting the " buf-str ".") - :type 'boolean - :group ',group) - - (defvar ,params-var ',params-val - ,(concat "List of required " entry-type-str " parameters.\n\n" - "Displayed parameters and parameters from this list are received\n" - "for each " entry-type-str ".\n\n" - "May be a special value `all', in which case all supported\n" - "parameters are received (this may be very slow for a big number\n" - "of entries).\n\n" - "Do not remove `id' from this list as it is required for\n" - "identifying an entry.")) - - (define-derived-mode ,mode ,parent-mode ,(concat "Guix-" Buf-type-str) - ,(concat "Major mode for displaying information about " entry-str ".\n\n" - "\\{" mode-map-str "}") - (setq-local revert-buffer-function 'guix-revert-buffer) - (setq-local guix-history-size ,history-var) - (and (fboundp ',mode-init-fun) (,mode-init-fun)))))) - -(put 'guix-define-buffer-type 'lisp-indent-function 'defun) - - -;;; Getting and displaying info about packages and generations - -(defcustom guix-package-list-type 'output - "Define how to display packages in a list buffer. -May be a symbol `package' or `output' (if `output', display each -output on a separate line; if `package', display each package on -a separate line)." - :type '(choice (const :tag "List of packages" package) - (const :tag "List of outputs" output)) - :group 'guix) - -(defcustom guix-package-info-type 'package - "Define how to display packages in an info buffer. -May be a symbol `package' or `output' (if `output', display each -output separately; if `package', display outputs inside a package -information)." - :type '(choice (const :tag "Display packages" package) - (const :tag "Display outputs" output)) - :group 'guix) - -(defun guix-get-entries (profile entry-type search-type search-vals - &optional params) - "Search for entries of ENTRY-TYPE. - -Call an appropriate scheme function and return a list of the -form of `guix-entries'. - -ENTRY-TYPE should be one of the following symbols: `package', -`output' or `generation'. - -SEARCH-TYPE may be one of the following symbols: - -- If ENTRY-TYPE is `package' or `output': `id', `name', `regexp', - `all-available', `newest-available', `installed', `obsolete', - `generation'. - -- If ENTRY-TYPE is `generation': `id', `last', `all', `time'. - -PARAMS is a list of parameters for receiving. If nil, get -information with all available parameters." - (guix-eval-read (guix-make-guile-expression - 'entries - profile params entry-type search-type search-vals))) - -(defun guix-get-show-entries (profile buffer-type entry-type search-type - &rest search-vals) - "Search for ENTRY-TYPE entries and show results in BUFFER-TYPE buffer. -See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS." - (let ((entries (guix-get-entries profile entry-type search-type search-vals - (guix-get-params-for-receiving - buffer-type entry-type)))) - (guix-set-buffer profile entries buffer-type entry-type - search-type search-vals))) - -(defun guix-set-buffer (profile entries buffer-type entry-type search-type - search-vals &optional history-replace no-display) - "Set up BUFFER-TYPE buffer for displaying ENTRY-TYPE ENTRIES. - -Insert ENTRIES in buffer, set variables and make history item. -ENTRIES should have a form of `guix-entries'. - -See `guix-get-entries' for the meaning of SEARCH-TYPE and SEARCH-VALS. - -If HISTORY-REPLACE is non-nil, replace current history item, -otherwise add the new one. - -If NO-DISPLAY is non-nil, do not switch to the buffer." - (when entries - (let ((buf (if (and (eq major-mode - (guix-get-symbol "mode" buffer-type entry-type)) - (equal guix-profile profile)) - (current-buffer) - (get-buffer-create - (guix-buffer-name profile buffer-type - entry-type search-type))))) - (with-current-buffer buf - (guix-show-entries entries buffer-type entry-type) - (guix-set-vars profile entries buffer-type entry-type - search-type search-vals) - (funcall (if history-replace - #'guix-history-replace - #'guix-history-add) - (guix-make-history-item))) - (or no-display - (guix-switch-to-buffer buf)))) - (guix-result-message profile entries entry-type - search-type search-vals)) - -(defun guix-show-entries (entries buffer-type entry-type) - "Display ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." - (let ((inhibit-read-only t)) - (erase-buffer) - (funcall (symbol-function (guix-get-symbol - "mode" buffer-type entry-type))) - (funcall (guix-get-symbol "insert-entries" buffer-type) - entries entry-type) - (goto-char (point-min)))) - -(defun guix-history-call (profile entries buffer-type entry-type - search-type search-vals) - "Function called for moving by history." - (guix-show-entries entries buffer-type entry-type) - (guix-set-vars profile entries buffer-type entry-type - search-type search-vals) - (guix-result-message profile entries entry-type - search-type search-vals)) - -(defun guix-make-history-item () - "Make and return a history item for the current buffer." - (list #'guix-history-call - guix-profile guix-entries guix-buffer-type guix-entry-type - guix-search-type guix-search-vals)) - -(defun guix-get-params-for-receiving (buffer-type entry-type) - "Return parameters that should be received for BUFFER-TYPE, ENTRY-TYPE." - (let* ((required-var (guix-get-symbol "required-params" - buffer-type entry-type)) - (required (symbol-value required-var))) - (unless (equal required 'all) - (cl-union required - (funcall (guix-get-symbol "get-displayed-params" - buffer-type) - entry-type))))) - -(defun guix-revert-buffer (_ignore-auto noconfirm) - "Update information in the current buffer. -The function is suitable for `revert-buffer-function'. -See `revert-buffer' for the meaning of NOCONFIRM." - (when (or noconfirm - (symbol-value - (guix-get-symbol "revert-no-confirm" - guix-buffer-type guix-entry-type)) - (y-or-n-p "Update current information? ")) - (let* ((search-type guix-search-type) - (search-vals guix-search-vals) - (params (guix-get-params-for-receiving guix-buffer-type - guix-entry-type)) - (entries (guix-get-entries - guix-profile guix-entry-type - guix-search-type guix-search-vals params)) - ;; If a REPL was restarted, package/output IDs are not actual - ;; anymore, because 'object-address'-es died with the REPL, so if a - ;; search by ID didn't give results, search again by name. - (entries (if (and (null entries) - (eq guix-search-type 'id) - (or (eq guix-entry-type 'package) - (eq guix-entry-type 'output))) - (progn - (setq search-type 'name - search-vals (guix-entries-to-specifications - guix-entries)) - (guix-get-entries - guix-profile guix-entry-type - search-type search-vals params)) - entries))) - (guix-set-buffer guix-profile entries guix-buffer-type guix-entry-type - search-type search-vals t t)))) - -(cl-defun guix-redisplay-buffer (&key buffer profile entries buffer-type - entry-type search-type search-vals) - "Redisplay a Guix BUFFER. -Restore the point and window positions after redisplaying if possible. - -This function will not update the information, use -\"\\[revert-buffer]\" if you want the full update. - -If BUFFER is nil, use the current buffer. For the meaning of the -rest arguments, see `guix-set-buffer'." - (interactive) - (or buffer (setq buffer (current-buffer))) - (with-current-buffer buffer - (or (derived-mode-p 'guix-info-mode 'guix-list-mode) - (error "%S is not a Guix buffer" buffer)) - (let* ((point (point)) - (was-at-button (button-at point)) - ;; For simplicity, ignore an unlikely case when multiple - ;; windows display the same BUFFER. - (window (car (get-buffer-window-list buffer nil t))) - (window-start (and window (window-start window)))) - (guix-set-buffer (or profile guix-profile) - (or entries guix-entries) - (or buffer-type guix-buffer-type) - (or entry-type guix-entry-type) - (or search-type guix-search-type) - (or search-vals guix-search-vals) - t t) - (goto-char point) - (and was-at-button - (not (button-at (point))) - (forward-button 1)) - (when window - (set-window-point window (point)) - (set-window-start window window-start))))) - - -;;; Generations - -(defcustom guix-generation-packages-buffer-name-function - #'guix-generation-packages-buffer-name-default - "Function used to define name of a buffer with generation packages. -This function is called with 2 arguments: PROFILE (string) and -GENERATION (number)." - :type '(choice (function-item guix-generation-packages-buffer-name-default) - (function-item guix-generation-packages-buffer-name-long) - (function :tag "Other function")) - :group 'guix) - -(defcustom guix-generation-packages-update-buffer t - "If non-nil, always update list of packages during comparing generations. -If nil, generation packages are received only once. So when you -compare generation 1 and generation 2, the packages for both -generations will be received. Then if you compare generation 1 -and generation 3, only the packages for generation 3 will be -received. Thus if you use comparing of different generations a -lot, you may set this variable to nil to improve the -performance." - :type 'boolean - :group 'guix) - -(defvar guix-output-name-width 30 - "Width of an output name \"column\". -This variable is used in auxiliary buffers for comparing generations.") - (defun guix-generation-file (profile generation) "Return the file name of a PROFILE's GENERATION." (format "%s-%s-link" profile generation)) @@ -724,74 +100,14 @@ this generation." (guix-generation-file profile generation) profile))) -(defun guix-generation-packages (profile generation) - "Return a list of sorted packages installed in PROFILE's GENERATION. -Each element of the list is a list of the package specification and its path." - (let ((names+paths (guix-eval-read - (guix-make-guile-expression - 'generation-package-specifications+paths - profile generation)))) - (sort names+paths - (lambda (a b) - (string< (car a) (car b)))))) - -(defun guix-generation-packages-buffer-name-default (profile generation) - "Return name of a buffer for displaying GENERATION's package outputs. -Use base name of PROFILE path." - (let ((profile-name (file-name-base (directory-file-name profile)))) - (format "*Guix %s: generation %s*" - profile-name generation))) - -(defun guix-generation-packages-buffer-name-long (profile generation) - "Return name of a buffer for displaying GENERATION's package outputs. -Use the full PROFILE path." - (format "*Guix generation %s (%s)*" - generation profile)) - -(defun guix-generation-packages-buffer-name (profile generation) - "Return name of a buffer for displaying GENERATION's package outputs." - (let ((fun (if (functionp guix-generation-packages-buffer-name-function) - guix-generation-packages-buffer-name-function - #'guix-generation-packages-buffer-name-default))) - (funcall fun profile generation))) - -(defun guix-generation-insert-package (name path) - "Insert package output NAME and PATH at point." - (insert name) - (indent-to guix-output-name-width 2) - (insert path "\n")) - -(defun guix-generation-insert-packages (buffer profile generation) - "Insert package outputs installed in PROFILE's GENERATION in BUFFER." - (with-current-buffer buffer - (setq buffer-read-only nil - indent-tabs-mode nil) - (erase-buffer) - (mapc (lambda (name+path) - (guix-generation-insert-package - (car name+path) (cadr name+path))) - (guix-generation-packages profile generation)))) - -(defun guix-generation-packages-buffer (profile generation) - "Return buffer with package outputs installed in PROFILE's GENERATION. -Create the buffer if needed." - (let ((buf-name (guix-generation-packages-buffer-name - profile generation))) - (or (and (null guix-generation-packages-update-buffer) - (get-buffer buf-name)) - (let ((buf (get-buffer-create buf-name))) - (guix-generation-insert-packages buf profile generation) - buf)))) - -(defun guix-profile-generation-manifest-file (generation) - "Return the file name of a GENERATION's manifest. -GENERATION is a generation number of `guix-profile' profile." - (guix-manifest-file guix-profile generation)) - -(defun guix-profile-generation-packages-buffer (generation) - "Insert GENERATION's package outputs in a buffer and return it. -GENERATION is a generation number of `guix-profile' profile." - (guix-generation-packages-buffer guix-profile generation)) +;;;###autoload +(defun guix-edit (id-or-name) + "Edit (go to location of) package with ID-OR-NAME." + (interactive (list (guix-read-package-name))) + (let ((loc (guix-package-location id-or-name))) + (if loc + (guix-find-location loc) + (message "Couldn't find package location.")))) ;;; Actions on packages and generations @@ -865,101 +181,6 @@ VARIABLE is a name of an option variable.") guix-operation-option-true-string guix-operation-option-false-string)) -(defun guix-process-package-actions (profile actions - &optional operation-buffer) - "Process package ACTIONS on PROFILE. -Each action is a list of the form: - - (ACTION-TYPE PACKAGE-SPEC ...) - -ACTION-TYPE is one of the following symbols: `install', -`upgrade', `remove'/`delete'. -PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)." - (let (install upgrade remove) - (mapc (lambda (action) - (let ((action-type (car action)) - (specs (cdr action))) - (cl-case action-type - (install (setq install (append install specs))) - (upgrade (setq upgrade (append upgrade specs))) - ((remove delete) (setq remove (append remove specs)))))) - actions) - (when (guix-continue-package-operation-p - profile - :install install :upgrade upgrade :remove remove) - (guix-eval-in-repl - (guix-make-guile-expression - 'process-package-actions profile - :install install :upgrade upgrade :remove remove - :use-substitutes? (or guix-use-substitutes 'f) - :dry-run? (or guix-dry-run 'f)) - (and (not guix-dry-run) operation-buffer))))) - -(cl-defun guix-continue-package-operation-p (profile - &key install upgrade remove) - "Return non-nil if a package operation should be continued. -Ask a user if needed (see `guix-operation-confirm'). -INSTALL, UPGRADE, REMOVE are 'package action specifications'. -See `guix-process-package-actions' for details." - (or (null guix-operation-confirm) - (let* ((entries (guix-get-entries - profile 'package 'id - (append (mapcar #'car install) - (mapcar #'car upgrade) - (mapcar #'car remove)) - '(id name version location))) - (install-strings (guix-get-package-strings install entries)) - (upgrade-strings (guix-get-package-strings upgrade entries)) - (remove-strings (guix-get-package-strings remove entries))) - (if (or install-strings upgrade-strings remove-strings) - (let ((buf (get-buffer-create guix-temp-buffer-name))) - (with-current-buffer buf - (setq-local cursor-type nil) - (setq buffer-read-only nil) - (erase-buffer) - (insert "Profile: " profile "\n\n") - (guix-insert-package-strings install-strings "install") - (guix-insert-package-strings upgrade-strings "upgrade") - (guix-insert-package-strings remove-strings "remove") - (let ((win (temp-buffer-window-show - buf - '((display-buffer-reuse-window - display-buffer-at-bottom) - (window-height . fit-window-to-buffer))))) - (prog1 (guix-operation-prompt) - (quit-window nil win))))) - (message "Nothing to be done. If the REPL was restarted, information is not up-to-date.") - nil)))) - -(defun guix-get-package-strings (specs entries) - "Return short package descriptions for performing package actions. -See `guix-process-package-actions' for the meaning of SPECS. -ENTRIES is a list of package entries to get info about packages." - (delq nil - (mapcar - (lambda (spec) - (let* ((id (car spec)) - (outputs (cdr spec)) - (entry (guix-get-entry-by-id id entries))) - (when entry - (let ((location (guix-assq-value entry 'location))) - (concat (guix-get-full-name entry) - (when outputs - (concat ":" - (guix-concat-strings outputs ","))) - (when location - (concat "\t(" location ")"))))))) - specs))) - -(defun guix-insert-package-strings (strings action) - "Insert information STRINGS at point for performing package ACTION." - (when strings - (insert "Package(s) to " (propertize action 'face 'bold) ":\n") - (mapc (lambda (str) - (insert " " str "\n")) - strings) - (insert "\n"))) - (defun guix-operation-prompt (&optional prompt) "Prompt a user for continuing the current operation. Return non-nil, if the operation should be continued; nil otherwise. @@ -1014,34 +235,6 @@ Ask a user with PROMPT for continuing an operation." guix-operation-option-separator))) (force-mode-line-update)) -(defun guix-delete-generations (profile generations - &optional operation-buffer) - "Delete GENERATIONS from PROFILE. -Each element from GENERATIONS is a generation number." - (when (or (not guix-operation-confirm) - (y-or-n-p - (let ((count (length generations))) - (if (> count 1) - (format "Delete %d generations from profile '%s'? " - count profile) - (format "Delete generation %d from profile '%s'? " - (car generations) profile))))) - (guix-eval-in-repl - (guix-make-guile-expression - 'delete-generations* profile generations) - operation-buffer))) - -(defun guix-switch-to-generation (profile generation - &optional operation-buffer) - "Switch PROFILE to GENERATION." - (when (or (not guix-operation-confirm) - (y-or-n-p (format "Switch profile '%s' to generation %d? " - profile generation))) - (guix-eval-in-repl - (guix-make-guile-expression - 'switch-to-generation* profile generation) - operation-buffer))) - (defun guix-package-source-path (package-id) "Return a store file path to a source of a package PACKAGE-ID." (message "Calculating the source derivation ...") @@ -1075,12 +268,12 @@ See Info node `(guix) Invoking guix package' for details. Interactively, use the current profile and prompt for manifest FILE. With a prefix argument, also prompt for PROFILE." (interactive - (let* ((default-profile (or guix-profile guix-current-profile)) + (let* ((current-profile (guix-ui-current-profile)) (profile (if current-prefix-arg (guix-profile-prompt) - default-profile)) + (or current-profile guix-current-profile))) (file (read-file-name "File with manifest: ")) - (buffer (and guix-profile (current-buffer)))) + (buffer (and current-profile (current-buffer)))) (list profile file buffer))) (when (or (not guix-operation-confirm) (y-or-n-p (format "Apply manifest from '%s' to profile '%s'? " @@ -1174,12 +367,12 @@ The function is called with a single argument - a command line string." (defun guix-update-buffers-maybe-after-pull () "Update buffers depending on `guix-update-after-pull'." (when guix-update-after-pull - (mapc #'guix-update-buffer + (mapc #'guix-ui-update-buffer ;; No need to update "generation" buffers. - (guix-buffers '(guix-package-list-mode - guix-package-info-mode - guix-output-list-mode - guix-output-info-mode))) + (guix-ui-buffers '(guix-package-list-mode + guix-package-info-mode + guix-output-list-mode + guix-output-info-mode))) (message "Guix buffers have been updated."))) ;;;###autoload diff --git a/emacs/guix-buffer.el b/emacs/guix-buffer.el new file mode 100644 index 0000000000..af76e638b6 --- /dev/null +++ b/emacs/guix-buffer.el @@ -0,0 +1,622 @@ +;;; guix-buffer.el --- Buffer interface for displaying data -*- lexical-binding: t -*- + +;; Copyright © 2014, 2015 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 a general 'buffer' interface for displaying an +;; arbitrary data. + +;;; Code: + +(require 'cl-lib) +(require 'guix-history) +(require 'guix-utils) + +(defvar guix-buffer-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "l") 'guix-history-back) + (define-key map (kbd "r") 'guix-history-forward) + (define-key map (kbd "g") 'revert-buffer) + (define-key map (kbd "R") 'guix-buffer-redisplay) + map) + "Parent keymap for Guix buffer modes.") + + +;;; Buffer item + +(cl-defstruct (guix-buffer-item + (:constructor nil) + (:constructor guix-buffer-make-item + (entries buffer-type entry-type args)) + (:copier nil)) + entries buffer-type entry-type args) + +(defvar-local guix-buffer-item nil + "Data (structure) for the current Guix buffer. +The structure consists of the following elements: + +- `entries': list of the currently displayed entries. + + Each element of the list is an alist with an entry data of the + following form: + + ((PARAM . VAL) ...) + + PARAM is a name of the entry parameter. + VAL is a value of this parameter. + +- `entry-type': type of the currently displayed entries. + +- `buffer-type': type of the current buffer. + +- `args': search arguments used to get the current entries.") +(put 'guix-buffer-item 'permanent-local t) + +(defmacro guix-buffer-with-item (item &rest body) + "Evaluate BODY using buffer ITEM. +The following local variables are available inside BODY: +`%entries', `%buffer-type', `%entry-type', `%args'. +See `guix-buffer-item' for details." + (declare (indent 1) (debug t)) + (let ((item-var (make-symbol "item"))) + `(let ((,item-var ,item)) + (let ((%entries (guix-buffer-item-entries ,item-var)) + (%buffer-type (guix-buffer-item-buffer-type ,item-var)) + (%entry-type (guix-buffer-item-entry-type ,item-var)) + (%args (guix-buffer-item-args ,item-var))) + ,@body)))) + +(defmacro guix-buffer-with-current-item (&rest body) + "Evaluate BODY using `guix-buffer-item'. +See `guix-buffer-with-item' for details." + (declare (indent 0) (debug t)) + `(guix-buffer-with-item guix-buffer-item + ,@body)) + +(defmacro guix-buffer-define-current-item-accessor (name) + "Define `guix-buffer-current-NAME' function to access NAME +element of `guix-buffer-item' structure. +NAME should be a symbol." + (let* ((name-str (symbol-name name)) + (accessor (intern (concat "guix-buffer-item-" name-str))) + (fun-name (intern (concat "guix-buffer-current-" name-str))) + (doc (format "\ +Return '%s' of the current Guix buffer. +See `guix-buffer-item' for details." + name-str))) + `(defun ,fun-name () + ,doc + (and guix-buffer-item + (,accessor guix-buffer-item))))) + +(defmacro guix-buffer-define-current-item-accessors (&rest names) + "Define `guix-buffer-current-NAME' functions for NAMES. +See `guix-buffer-define-current-item-accessor' for details." + `(progn + ,@(mapcar (lambda (name) + `(guix-buffer-define-current-item-accessor ,name)) + names))) + +(guix-buffer-define-current-item-accessors + entries entry-type buffer-type args) + +(defmacro guix-buffer-define-current-args-accessor (n prefix name) + "Define `PREFIX-NAME' function to access Nth element of 'args' +field of `guix-buffer-item' structure. +PREFIX and NAME should be strings." + (let ((fun-name (intern (concat prefix "-" name))) + (doc (format "\ +Return '%s' of the current Guix buffer. +'%s' is the element number %d in 'args' of `guix-buffer-item'." + name name n))) + `(defun ,fun-name () + ,doc + (nth ,n (guix-buffer-current-args))))) + +(defmacro guix-buffer-define-current-args-accessors (prefix &rest names) + "Define `PREFIX-NAME' functions for NAMES. +See `guix-buffer-define-current-args-accessor' for details." + `(progn + ,@(cl-loop for name in names + for i from 0 + collect `(guix-buffer-define-current-args-accessor + ,i ,prefix ,name)))) + + +;;; Wrappers for defined variables + +(defvar guix-buffer-data nil + "Alist with 'buffer' data. +This alist is filled by `guix-buffer-define-interface' macro.") + +(defun guix-buffer-value (buffer-type entry-type symbol) + "Return SYMBOL's value for BUFFER-TYPE/ENTRY-TYPE from `guix-buffer-data'." + (symbol-value + (guix-assq-value guix-buffer-data buffer-type entry-type symbol))) + +(defun guix-buffer-get-entries (buffer-type entry-type args) + "Return ENTRY-TYPE entries. +Call an appropriate 'get-entries' function from `guix-buffer' +using ARGS as its arguments." + (apply (guix-buffer-value buffer-type entry-type 'get-entries) + args)) + +(defun guix-buffer-mode-enable (buffer-type entry-type) + "Turn on major mode to display ENTRY-TYPE ENTRIES in BUFFER-TYPE buffer." + (funcall (guix-buffer-value buffer-type entry-type 'mode))) + +(defun guix-buffer-mode-initialize (buffer-type entry-type) + "Set up the current BUFFER-TYPE buffer to display ENTRY-TYPE entries." + (let ((fun (guix-buffer-value buffer-type entry-type 'mode-init))) + (when fun + (funcall fun)))) + +(defun guix-buffer-insert-entries (entries buffer-type entry-type) + "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." + (funcall (guix-buffer-value buffer-type entry-type 'insert-entries) + entries)) + +(defun guix-buffer-show-entries-default (entries buffer-type entry-type) + "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." + (let ((inhibit-read-only t)) + (erase-buffer) + (guix-buffer-mode-enable buffer-type entry-type) + (guix-buffer-insert-entries entries buffer-type entry-type) + (goto-char (point-min)))) + +(defun guix-buffer-show-entries (entries buffer-type entry-type) + "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer." + (funcall (guix-buffer-value buffer-type entry-type 'show-entries) + entries)) + +(defun guix-buffer-message (entries buffer-type entry-type args) + "Display a message for BUFFER-ITEM after showing entries." + (let ((fun (guix-buffer-value buffer-type entry-type 'message))) + (when fun + (apply fun entries args)))) + +(defun guix-buffer-name (buffer-type entry-type args) + "Return name of BUFFER-TYPE buffer for displaying ENTRY-TYPE entries." + (let ((str-or-fun (guix-buffer-value buffer-type entry-type + 'buffer-name))) + (if (stringp str-or-fun) + str-or-fun + (apply str-or-fun args)))) + +(defun guix-buffer-param-title (buffer-type entry-type param) + "Return PARAM title for BUFFER-TYPE/ENTRY-TYPE." + (or (guix-assq-value (guix-buffer-value buffer-type entry-type 'titles) + param) + ;; Fallback to a title defined in 'info' interface. + (unless (eq buffer-type 'info) + (guix-assq-value (guix-buffer-value 'info entry-type 'titles) + param)) + (guix-symbol-title param))) + +(defun guix-buffer-history-size (buffer-type entry-type) + "Return history size for BUFFER-TYPE/ENTRY-TYPE." + (guix-buffer-value buffer-type entry-type 'history-size)) + +(defun guix-buffer-revert-confirm? (buffer-type entry-type) + "Return 'revert-confirm' value for BUFFER-TYPE/ENTRY-TYPE." + (guix-buffer-value buffer-type entry-type 'revert-confirm)) + + +;;; Displaying entries + +(defun guix-buffer-display (buffer) + "Switch to a Guix BUFFER." + (pop-to-buffer buffer + '((display-buffer-reuse-window + display-buffer-same-window)))) + +(defun guix-buffer-history-item (buffer-item) + "Make and return a history item for displaying BUFFER-ITEM." + (list #'guix-buffer-set buffer-item)) + +(defun guix-buffer-set (buffer-item &optional history) + "Set up the current buffer for displaying BUFFER-ITEM. +HISTORY should be one of the following: + + `nil' - do not save BUFFER-ITEM in history, + + `add' - add it to history, + + `replace' - replace the current history item." + (guix-buffer-with-item buffer-item + (when %entries + (guix-buffer-show-entries %entries %buffer-type %entry-type) + (setq guix-buffer-item buffer-item) + (when history + (funcall (cl-ecase history + (add #'guix-history-add) + (replace #'guix-history-replace)) + (guix-buffer-history-item buffer-item)))) + (guix-buffer-message %entries %buffer-type %entry-type %args))) + +(defun guix-buffer-display-entries-current + (entries buffer-type entry-type args &optional history) + "Show ENTRIES in the current Guix buffer. +See `guix-buffer-item' for the meaning of BUFFER-TYPE, ENTRY-TYPE +and ARGS, and `guix-buffer-set' for the meaning of HISTORY." + (let ((item (guix-buffer-make-item entries buffer-type + entry-type args))) + (guix-buffer-set item history))) + +(defun guix-buffer-get-display-entries-current + (buffer-type entry-type args &optional history) + "Search for entries and show them in the current Guix buffer. +See `guix-buffer-display-entries-current' for details." + (guix-buffer-display-entries-current + (guix-buffer-get-entries buffer-type entry-type args) + buffer-type entry-type args history)) + +(defun guix-buffer-display-entries + (entries buffer-type entry-type args &optional history) + "Show ENTRIES in a BUFFER-TYPE buffer. +See `guix-buffer-display-entries-current' for details." + (let ((buffer (get-buffer-create + (guix-buffer-name buffer-type entry-type args)))) + (with-current-buffer buffer + (guix-buffer-display-entries-current + entries buffer-type entry-type args history)) + (when entries + (guix-buffer-display buffer)))) + +(defun guix-buffer-get-display-entries + (buffer-type entry-type args &optional history) + "Search for entries and show them in a BUFFER-TYPE buffer. +See `guix-buffer-display-entries-current' for details." + (guix-buffer-display-entries + (guix-buffer-get-entries buffer-type entry-type args) + buffer-type entry-type args history)) + +(defun guix-buffer-revert (_ignore-auto noconfirm) + "Update the data in the current Guix buffer. +This function is suitable for `revert-buffer-function'. +See `revert-buffer' for the meaning of NOCONFIRM." + (guix-buffer-with-current-item + (when (or noconfirm + (not (guix-buffer-revert-confirm? %buffer-type %entry-type)) + (y-or-n-p "Update the current buffer? ")) + (guix-buffer-get-display-entries-current + %buffer-type %entry-type %args 'replace)))) + +(defvar guix-buffer-after-redisplay-hook nil + "Hook run by `guix-buffer-redisplay'. +This hook is called before seting up a window position.") + +(defun guix-buffer-redisplay () + "Redisplay the current Guix buffer. +Restore the point and window positions after redisplaying. + +This function does not update the buffer data, use +'\\[revert-buffer]' if you want the full update." + (interactive) + (let* ((old-point (point)) + ;; For simplicity, ignore an unlikely case when multiple + ;; windows display the same buffer. + (window (car (get-buffer-window-list (current-buffer) nil t))) + (window-start (and window (window-start window)))) + (guix-buffer-set guix-buffer-item) + (goto-char old-point) + (run-hooks 'guix-buffer-after-redisplay-hook) + (when window + (set-window-point window (point)) + (set-window-start window window-start)))) + +(defun guix-buffer-redisplay-goto-button () + "Redisplay the current buffer and go to the next button, if needed." + (let ((guix-buffer-after-redisplay-hook + (cons (lambda () + (unless (button-at (point)) + (forward-button 1))) + guix-buffer-after-redisplay-hook))) + (guix-buffer-redisplay))) + + +;;; Interface definers + +(defmacro guix-define-groups (type &rest args) + "Define `guix-TYPE' and `guix-TYPE-faces' custom groups. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... + +Optional keywords: + + - `:parent-group' - name of a parent custom group. + + - `:parent-faces-group' - name of a parent custom faces group. + + - `:group-doc' - docstring of a `guix-TYPE' group. + + - `:faces-group-doc' - docstring of a `guix-TYPE-faces' group." + (declare (indent 1)) + (let* ((type-str (symbol-name type)) + (prefix (concat "guix-" type-str)) + (group (intern prefix)) + (faces-group (intern (concat prefix "-faces")))) + (guix-keyword-args-let args + ((parent-group :parent-group 'guix) + (parent-faces-group :parent-faces-group 'guix-faces) + (group-doc :group-doc + (format "Settings for '%s' buffers." + type-str)) + (faces-group-doc :faces-group-doc + (format "Faces for '%s' buffers." + type-str))) + `(progn + (defgroup ,group nil + ,group-doc + :group ',parent-group) + + (defgroup ,faces-group nil + ,faces-group-doc + :group ',group + :group ',parent-faces-group))))) + +(defmacro guix-define-entry-type (entry-type &rest args) + "Define general code for ENTRY-TYPE. +See `guix-define-groups'." + (declare (indent 1)) + `(guix-define-groups ,entry-type + ,@args)) + +(defmacro guix-define-buffer-type (buffer-type &rest args) + "Define general code for BUFFER-TYPE. +See `guix-define-groups'." + (declare (indent 1)) + `(guix-define-groups ,buffer-type + ,@args)) + +(defmacro guix-buffer-define-interface (buffer-type entry-type &rest args) + "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... +In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE. + +Required keywords: + + - `:buffer-name' - default value of the generated + `guix-TYPE-buffer-name' variable. + + - `:get-entries-function' - default value of the generated + `guix-TYPE-get-function' variable. + + - `:show-entries-function' - default value of the generated + `guix-TYPE-show-function' variable. + + Alternatively, if `:show-entries-function' is not specified, a + default `guix-TYPE-show-entries' will be generated, and the + following keyword should be specified instead: + + - `:insert-entries-function' - default value of the generated + `guix-TYPE-insert-function' variable. + +Optional keywords: + + - `:message-function' - default value of the generated + `guix-TYPE-message-function' variable. + + - `:titles' - default value of the generated + `guix-TYPE-titles' variable. + + - `:history-size' - default value of the generated + `guix-TYPE-history-size' variable. + + - `:revert-confirm?' - default value of the generated + `guix-TYPE-revert-confirm' variable. + + - `:mode-name' - name (a string appeared in the mode-line) of + the generated `guix-TYPE-mode'. + + - `:mode-init-function' - default value of the generated + `guix-TYPE-mode-initialize-function' variable. + + - `:reduced?' - if non-nil, generate only group, faces group + and titles variable (if specified); all keywords become + optional." + (declare (indent 2)) + (let* ((entry-type-str (symbol-name entry-type)) + (buffer-type-str (symbol-name buffer-type)) + (prefix (concat "guix-" entry-type-str "-" + buffer-type-str)) + (group (intern prefix)) + (faces-group (intern (concat prefix "-faces"))) + (get-entries-var (intern (concat prefix "-get-function"))) + (show-entries-var (intern (concat prefix "-show-function"))) + (show-entries-fun (intern (concat prefix "-show-entries"))) + (message-var (intern (concat prefix "-message-function"))) + (buffer-name-var (intern (concat prefix "-buffer-name"))) + (titles-var (intern (concat prefix "-titles"))) + (history-size-var (intern (concat prefix "-history-size"))) + (revert-confirm-var (intern (concat prefix "-revert-confirm")))) + (guix-keyword-args-let args + ((get-entries-val :get-entries-function) + (show-entries-val :show-entries-function) + (insert-entries-val :insert-entries-function) + (mode-name :mode-name (capitalize prefix)) + (mode-init-val :mode-init-function) + (message-val :message-function) + (buffer-name-val :buffer-name) + (titles-val :titles) + (history-size-val :history-size 20) + (revert-confirm-val :revert-confirm? t) + (reduced? :reduced?)) + `(progn + (defgroup ,group nil + ,(format "Displaying '%s' entries in '%s' buffer." + entry-type-str buffer-type-str) + :group ',(intern (concat "guix-" entry-type-str)) + :group ',(intern (concat "guix-" buffer-type-str))) + + (defgroup ,faces-group nil + ,(format "Faces for displaying '%s' entries in '%s' buffer." + entry-type-str buffer-type-str) + :group ',group + :group ',(intern (concat "guix-" entry-type-str "-faces")) + :group ',(intern (concat "guix-" buffer-type-str "-faces"))) + + (defcustom ,titles-var ,titles-val + ,(format "Alist of titles of '%s' parameters." + entry-type-str) + :type '(alist :key-type symbol :value-type string) + :group ',group) + + ,(unless reduced? + `(progn + (defvar ,get-entries-var ,get-entries-val + ,(format "\ +Function used to receive '%s' entries for '%s' buffer." + entry-type-str buffer-type-str)) + + (defvar ,show-entries-var + ,(or show-entries-val `',show-entries-fun) + ,(format "\ +Function used to show '%s' entries in '%s' buffer." + entry-type-str buffer-type-str)) + + (defvar ,message-var ,message-val + ,(format "\ +Function used to display a message after showing '%s' entries. +If nil, do not display messages." + entry-type-str)) + + (defcustom ,buffer-name-var ,buffer-name-val + ,(format "\ +Default name of '%s' buffer for displaying '%s' entries. +May be a string or a function returning a string. The function +is called with the same arguments as `%S'." + buffer-type-str entry-type-str get-entries-var) + :type '(choice string function) + :group ',group) + + (defcustom ,history-size-var ,history-size-val + ,(format "\ +Maximum number of items saved in history of `%S' buffer. +If 0, the history is disabled." + buffer-name-var) + :type 'integer + :group ',group) + + (defcustom ,revert-confirm-var ,revert-confirm-val + ,(format "\ +If non-nil, ask to confirm for reverting `%S' buffer." + buffer-name-var) + :type 'boolean + :group ',group) + + (guix-alist-put! + '((get-entries . ,get-entries-var) + (show-entries . ,show-entries-var) + (message . ,message-var) + (buffer-name . ,buffer-name-var) + (history-size . ,history-size-var) + (revert-confirm . ,revert-confirm-var)) + 'guix-buffer-data ',buffer-type ',entry-type) + + ,(unless show-entries-val + `(defun ,show-entries-fun (entries) + ,(format "\ +Show '%s' ENTRIES in the current '%s' buffer." + entry-type-str buffer-type-str) + (guix-buffer-show-entries-default + entries ',buffer-type ',entry-type))) + + ,(when (or insert-entries-val + (null show-entries-val)) + (let ((insert-entries-var + (intern (concat prefix "-insert-function")))) + `(progn + (defvar ,insert-entries-var ,insert-entries-val + ,(format "\ +Function used to print '%s' entries in '%s' buffer." + entry-type-str buffer-type-str)) + + (guix-alist-put! + ',insert-entries-var 'guix-buffer-data + ',buffer-type ',entry-type + 'insert-entries)))) + + ,(when (or mode-name + mode-init-val + (null show-entries-val)) + (let* ((mode-str (concat prefix "-mode")) + (mode-map-str (concat mode-str "-map")) + (mode (intern mode-str)) + (parent-mode (intern + (concat "guix-" buffer-type-str + "-mode"))) + (mode-var (intern + (concat mode-str "-function"))) + (mode-init-var (intern + (concat mode-str + "-initialize-function")))) + `(progn + (defvar ,mode-var ',mode + ,(format "\ +Major mode for displaying '%s' entries in '%s' buffer." + entry-type-str buffer-type-str)) + + (defvar ,mode-init-var ,mode-init-val + ,(format "\ +Function used to set up '%s' buffer for displaying '%s' entries." + buffer-type-str entry-type-str)) + + (define-derived-mode ,mode ,parent-mode ,mode-name + ,(format "\ +Major mode for displaying '%s' entries in '%s' buffer. + +\\{%s}" + entry-type-str buffer-type-str mode-map-str) + (setq-local revert-buffer-function + 'guix-buffer-revert) + (setq-local guix-history-size + (guix-buffer-history-size + ',buffer-type ',entry-type)) + (guix-buffer-mode-initialize + ',buffer-type ',entry-type)) + + (guix-alist-put! + ',mode-var 'guix-buffer-data + ',buffer-type ',entry-type 'mode) + (guix-alist-put! + ',mode-init-var 'guix-buffer-data + ',buffer-type ',entry-type + 'mode-init)))))) + + (guix-alist-put! + ',titles-var 'guix-buffer-data + ',buffer-type ',entry-type 'titles))))) + + +(defvar guix-buffer-font-lock-keywords + (eval-when-compile + `((,(rx "(" (group (or "guix-buffer-with-item" + "guix-buffer-with-current-item" + "guix-buffer-define-interface" + "guix-define-groups" + "guix-define-entry-type" + "guix-define-buffer-type")) + symbol-end) + . 1)))) + +(font-lock-add-keywords 'emacs-lisp-mode guix-buffer-font-lock-keywords) + +(provide 'guix-buffer) + +;;; guix-buffer.el ends here diff --git a/emacs/guix-command.el b/emacs/guix-command.el index ccd85d25b9..9cb7032abc 100644 --- a/emacs/guix-command.el +++ b/emacs/guix-command.el @@ -690,7 +690,7 @@ Perform pull-specific actions after operation, see open the log file(s)." (let* ((args (if (member "--log-file" args) args - (apply #'list (car args) "--log-file" (cdr args)))) + (cl-list* (car args) "--log-file" (cdr args)))) (output (guix-command-output args)) (files (split-string output "\n" t))) (dolist (file files) @@ -715,10 +715,9 @@ open the log file(s)." (map-file (or wished-map-file (guix-png-file-name))) (args (if wished-map-file args - (apply #'list - (car args) - (concat "--map-file=" map-file) - (cdr args))))) + (cl-list* (car args) + (concat "--map-file=" map-file) + (cdr args))))) (guix-command-output args) (guix-find-file map-file))) diff --git a/emacs/guix-entry.el b/emacs/guix-entry.el new file mode 100644 index 0000000000..5eed2ed015 --- /dev/null +++ b/emacs/guix-entry.el @@ -0,0 +1,59 @@ +;;; guix-entry.el --- 'Entry' type -*- lexical-binding: t -*- + +;; Copyright © 2015 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 an API for 'entry' type which is just an alist of +;; KEY/VALUE pairs (KEY should be a symbol) with the required 'id' KEY. + +;;; Code: + +(require 'cl-lib) +(require 'guix-utils) + +(defalias 'guix-entry-value #'guix-assq-value) + +(defun guix-entry-id (entry) + "Return ENTRY ID." + (guix-entry-value entry 'id)) + +(defun guix-entry-by-id (id entries) + "Return an entry from ENTRIES by its ID." + (cl-find-if (lambda (entry) + (equal (guix-entry-id entry) id)) + entries)) + +(defun guix-entries-by-ids (ids entries) + "Return entries with IDS (a list of identifiers) from ENTRIES." + (cl-remove-if-not (lambda (entry) + (member (guix-entry-id entry) ids)) + entries)) + +(defun guix-replace-entry (id new-entry entries) + "Replace an entry with ID from ENTRIES by NEW-ENTRY. +Return a list of entries with the replaced entry." + (cl-substitute-if new-entry + (lambda (entry) + (equal id (guix-entry-id entry))) + entries + :count 1)) + +(provide 'guix-entry) + +;;; guix-entry.el ends here diff --git a/emacs/guix-external.el b/emacs/guix-external.el index c80b36343d..f571ffd845 100644 --- a/emacs/guix-external.el +++ b/emacs/guix-external.el @@ -23,6 +23,7 @@ ;;; Code: +(require 'cl-lib) (require 'guix-config) (defgroup guix-external nil @@ -67,10 +68,9 @@ If ARGS is nil, use `guix-dot-default-arguments'." (or guix-dot-program (error (concat "Couldn't find 'dot'.\n" "Set guix-dot-program to a proper value"))) - (apply #'list - guix-dot-program - (concat "-o" output-file) - (or args guix-dot-default-arguments))) + (cl-list* guix-dot-program + (concat "-o" output-file) + (or args guix-dot-default-arguments))) (defun guix-dot-file-name () "Call `guix-dot-file-name-function'." diff --git a/emacs/guix-hydra-build.el b/emacs/guix-hydra-build.el new file mode 100644 index 0000000000..232221e773 --- /dev/null +++ b/emacs/guix-hydra-build.el @@ -0,0 +1,362 @@ +;;; guix-hydra-build.el --- Interface for Hydra builds -*- lexical-binding: t -*- + +;; Copyright © 2015 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 an interface for displaying Hydra builds in +;; 'list' and 'info' buffers. + +;;; Code: + +(require 'cl-lib) +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-info) +(require 'guix-hydra) +(require 'guix-build-log) +(require 'guix-utils) + +(guix-hydra-define-entry-type hydra-build + :search-types '((latest . guix-hydra-build-latest-api-url) + (queue . guix-hydra-build-queue-api-url)) + :filters '(guix-hydra-build-filter-status) + :filter-names '((nixname . name) + (buildstatus . build-status) + (timestamp . time)) + :filter-boolean-params '(finished busy)) + +(defun guix-hydra-build-get-display (search-type &rest args) + "Search for Hydra builds and show results." + (apply #'guix-list-get-display-entries + 'hydra-build search-type args)) + +(cl-defun guix-hydra-build-latest-prompt-args (&key project jobset + job system) + "Prompt for and return a list of 'latest builds' arguments." + (let* ((number (read-number "Number of latest builds: ")) + (project (if current-prefix-arg + (guix-hydra-read-project nil project) + project)) + (jobset (if current-prefix-arg + (guix-hydra-read-jobset nil jobset) + jobset)) + (job-or-name (if current-prefix-arg + (guix-hydra-read-job nil job) + job)) + (job (and job-or-name + (string-match-p guix-hydra-job-regexp + job-or-name) + job-or-name)) + (system (if (and (not job) + (or current-prefix-arg + (and job-or-name (not system)))) + (if job-or-name + (guix-while-null + (guix-hydra-read-system + (concat job-or-name ".") system)) + (guix-hydra-read-system nil system)) + system)) + (job (or job + (and job-or-name + (concat job-or-name "." system))))) + (list number + :project project + :jobset jobset + :job job + :system system))) + +(defun guix-hydra-build-view-log (id) + "View build log of a hydra build ID." + (guix-build-log-find-file (guix-hydra-build-log-url id))) + + +;;; Defining URLs + +(defun guix-hydra-build-url (id) + "Return Hydra URL of a build ID." + (guix-hydra-url "build/" (number-to-string id))) + +(defun guix-hydra-build-log-url (id) + "Return Hydra URL of the log file of a build ID." + (concat (guix-hydra-build-url id) "/log/raw")) + +(cl-defun guix-hydra-build-latest-api-url + (number &key project jobset job system) + "Return Hydra API URL to receive latest NUMBER of builds." + (guix-hydra-api-url "latestbuilds" + `(("nr" . ,number) + ("project" . ,project) + ("jobset" . ,jobset) + ("job" . ,job) + ("system" . ,system)))) + +(defun guix-hydra-build-queue-api-url (number) + "Return Hydra API URL to receive the NUMBER of queued builds." + (guix-hydra-api-url "queue" + `(("nr" . ,number)))) + + +;;; Filters for processing raw entries + +(defun guix-hydra-build-filter-status (entry) + "Add 'status' parameter to 'hydra-build' ENTRY." + (let ((status (if (guix-entry-value entry 'finished) + (guix-hydra-build-status-number->name + (guix-entry-value entry 'build-status)) + (if (guix-entry-value entry 'busy) + 'running + 'scheduled)))) + (cons `(status . ,status) + entry))) + + +;;; Build status + +(defface guix-hydra-build-status-running + '((t :inherit bold)) + "Face used if hydra build is not finished." + :group 'guix-hydra-build-faces) + +(defface guix-hydra-build-status-scheduled + '((t)) + "Face used if hydra build is scheduled." + :group 'guix-hydra-build-faces) + +(defface guix-hydra-build-status-succeeded + '((t :inherit success)) + "Face used if hydra build succeeded." + :group 'guix-hydra-build-faces) + +(defface guix-hydra-build-status-cancelled + '((t :inherit warning)) + "Face used if hydra build was cancelled." + :group 'guix-hydra-build-faces) + +(defface guix-hydra-build-status-failed + '((t :inherit error)) + "Face used if hydra build failed." + :group 'guix-hydra-build-faces) + +(defvar guix-hydra-build-status-alist + '((0 . succeeded) + (1 . failed-build) + (2 . failed-dependency) + (3 . failed-other) + (4 . cancelled)) + "Alist of hydra build status numbers and status names. +Status numbers are returned by Hydra API, names (symbols) are +used internally by the elisp code of this package.") + +(defun guix-hydra-build-status-number->name (number) + "Convert build status number to a name. +See `guix-hydra-build-status-alist'." + (guix-assq-value guix-hydra-build-status-alist number)) + +(defun guix-hydra-build-status-string (status) + "Return a human readable string for build STATUS." + (cl-case status + (scheduled + (guix-get-string "Scheduled" 'guix-hydra-build-status-scheduled)) + (running + (guix-get-string "Running" 'guix-hydra-build-status-running)) + (succeeded + (guix-get-string "Succeeded" 'guix-hydra-build-status-succeeded)) + (cancelled + (guix-get-string "Cancelled" 'guix-hydra-build-status-cancelled)) + (failed-build + (guix-hydra-build-status-fail-string)) + (failed-dependency + (guix-hydra-build-status-fail-string "dependency")) + (failed-other + (guix-hydra-build-status-fail-string "other")))) + +(defun guix-hydra-build-status-fail-string (&optional reason) + "Return a string for a failed build." + (let ((base (guix-get-string "Failed" 'guix-hydra-build-status-failed))) + (if reason + (concat base " (" reason ")") + base))) + +(defun guix-hydra-build-finished? (entry) + "Return non-nil, if hydra build was finished." + (guix-entry-value entry 'finished)) + +(defun guix-hydra-build-running? (entry) + "Return non-nil, if hydra build is running." + (eq (guix-entry-value entry 'status) + 'running)) + +(defun guix-hydra-build-scheduled? (entry) + "Return non-nil, if hydra build is scheduled." + (eq (guix-entry-value entry 'status) + 'scheduled)) + +(defun guix-hydra-build-succeeded? (entry) + "Return non-nil, if hydra build succeeded." + (eq (guix-entry-value entry 'status) + 'succeeded)) + +(defun guix-hydra-build-cancelled? (entry) + "Return non-nil, if hydra build was cancelled." + (eq (guix-entry-value entry 'status) + 'cancelled)) + +(defun guix-hydra-build-failed? (entry) + "Return non-nil, if hydra build failed." + (memq (guix-entry-value entry 'status) + '(failed-build failed-dependency failed-other))) + + +;;; Hydra build 'info' + +(guix-hydra-info-define-interface hydra-build + :mode-name "Hydra-Build-Info" + :buffer-name "*Guix Hydra Build Info*" + :format '((name ignore (simple guix-info-heading)) + ignore + guix-hydra-build-info-insert-url + (time format (time)) + (status format guix-hydra-build-info-insert-status) + (project format (format guix-hydra-build-project)) + (jobset format (format guix-hydra-build-jobset)) + (job format (format guix-hydra-build-job)) + (system format (format guix-hydra-build-system)) + (priority format (format)))) + +(defface guix-hydra-build-info-project + '((t :inherit link)) + "Face for project names." + :group 'guix-hydra-build-info-faces) + +(defface guix-hydra-build-info-jobset + '((t :inherit link)) + "Face for jobsets." + :group 'guix-hydra-build-info-faces) + +(defface guix-hydra-build-info-job + '((t :inherit link)) + "Face for jobs." + :group 'guix-hydra-build-info-faces) + +(defface guix-hydra-build-info-system + '((t :inherit link)) + "Face for system names." + :group 'guix-hydra-build-info-faces) + +(defmacro guix-hydra-build-define-button (name) + "Define `guix-hydra-build-NAME' button." + (let* ((name-str (symbol-name name)) + (button-name (intern (concat "guix-hydra-build-" name-str))) + (face-name (intern (concat "guix-hydra-build-info-" name-str))) + (keyword (intern (concat ":" name-str)))) + `(define-button-type ',button-name + :supertype 'guix + 'face ',face-name + 'help-echo ,(format "\ +Show latest builds for this %s (with prefix, prompt for all parameters)" + name-str) + 'action (lambda (btn) + (let ((args (guix-hydra-build-latest-prompt-args + ,keyword (button-label btn)))) + (apply #'guix-hydra-build-get-display + 'latest args)))))) + +(guix-hydra-build-define-button project) +(guix-hydra-build-define-button jobset) +(guix-hydra-build-define-button job) +(guix-hydra-build-define-button system) + +(defun guix-hydra-build-info-insert-url (entry) + "Insert Hydra URL for the build ENTRY." + (guix-insert-button (guix-hydra-build-url (guix-entry-id entry)) + 'guix-url) + (when (guix-hydra-build-finished? entry) + (guix-info-insert-indent) + (guix-info-insert-action-button + "Build log" + (lambda (btn) + (guix-hydra-build-view-log (button-get btn 'id))) + "View build log" + 'id (guix-entry-id entry)))) + +(defun guix-hydra-build-info-insert-status (status &optional _) + "Insert a string with build STATUS." + (insert (guix-hydra-build-status-string status))) + + +;;; Hydra build 'list' + +(guix-hydra-list-define-interface hydra-build + :mode-name "Hydra-Build-List" + :buffer-name "*Guix Hydra Build List*" + :format '((name nil 30 t) + (system nil 16 t) + (status guix-hydra-build-list-get-status 20 t) + (project nil 10 t) + (jobset nil 17 t) + (time guix-list-get-time 20 t))) + +(let ((map guix-hydra-build-list-mode-map)) + (define-key map (kbd "B") 'guix-hydra-build-list-latest-builds) + (define-key map (kbd "L") 'guix-hydra-build-list-view-log)) + +(defun guix-hydra-build-list-get-status (status &optional _) + "Return a string for build STATUS." + (guix-hydra-build-status-string status)) + +(defun guix-hydra-build-list-latest-builds (number &rest args) + "Display latest NUMBER of Hydra builds of the current job. +Interactively, prompt for NUMBER. With prefix argument, prompt +for all ARGS." + (interactive + (let ((entry (guix-list-current-entry))) + (guix-hydra-build-latest-prompt-args + :project (guix-entry-value entry 'project) + :jobset (guix-entry-value entry 'name) + :job (guix-entry-value entry 'job) + :system (guix-entry-value entry 'system)))) + (apply #'guix-hydra-latest-builds number args)) + +(defun guix-hydra-build-list-view-log () + "View build log of the current Hydra build." + (interactive) + (guix-hydra-build-view-log (guix-list-current-id))) + + +;;; Interactive commands + +;;;###autoload +(defun guix-hydra-latest-builds (number &rest args) + "Display latest NUMBER of Hydra builds. +ARGS are the same arguments as for `guix-hydra-build-latest-api-url'. +Interactively, prompt for NUMBER. With prefix argument, prompt +for all ARGS." + (interactive (guix-hydra-build-latest-prompt-args)) + (apply #'guix-hydra-build-get-display + 'latest number args)) + +;;;###autoload +(defun guix-hydra-queued-builds (number) + "Display the NUMBER of queued Hydra builds." + (interactive "NNumber of queued builds: ") + (guix-hydra-build-get-display 'queue number)) + +(provide 'guix-hydra-build) + +;;; guix-hydra-build.el ends here diff --git a/emacs/guix-hydra-jobset.el b/emacs/guix-hydra-jobset.el new file mode 100644 index 0000000000..a4a55a36f2 --- /dev/null +++ b/emacs/guix-hydra-jobset.el @@ -0,0 +1,162 @@ +;;; guix-hydra-jobset.el --- Interface for Hydra jobsets -*- lexical-binding: t -*- + +;; Copyright © 2015 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 an interface for displaying Hydra jobsets in +;; 'list' and 'info' buffers. + +;;; Code: + +(require 'cl-lib) +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-info) +(require 'guix-hydra) +(require 'guix-hydra-build) +(require 'guix-utils) + +(guix-hydra-define-entry-type hydra-jobset + :search-types '((project . guix-hydra-jobset-api-url)) + :filters '(guix-hydra-jobset-filter-id) + :filter-names '((nrscheduled . scheduled) + (nrsucceeded . succeeded) + (nrfailed . failed) + (nrtotal . total))) + +(defun guix-hydra-jobset-get-display (search-type &rest args) + "Search for Hydra builds and show results." + (apply #'guix-list-get-display-entries + 'hydra-jobset search-type args)) + + +;;; Defining URLs + +(defun guix-hydra-jobset-url (project jobset) + "Return Hydra URL of a PROJECT's JOBSET." + (guix-hydra-url "jobset/" project "/" jobset)) + +(defun guix-hydra-jobset-api-url (project) + "Return Hydra API URL for jobsets by PROJECT." + (guix-hydra-api-url "jobsets" + `(("project" . ,project)))) + + +;;; Filters for processing raw entries + +(defun guix-hydra-jobset-filter-id (entry) + "Add 'ID' parameter to 'hydra-jobset' ENTRY." + (cons `(id . ,(guix-entry-value entry 'name)) + entry)) + + +;;; Hydra jobset 'info' + +(guix-hydra-info-define-interface hydra-jobset + :mode-name "Hydra-Jobset-Info" + :buffer-name "*Guix Hydra Jobset Info*" + :format '((name ignore (simple guix-info-heading)) + ignore + guix-hydra-jobset-info-insert-url + (project format guix-hydra-jobset-info-insert-project) + (scheduled format (format guix-hydra-jobset-info-scheduled)) + (succeeded format (format guix-hydra-jobset-info-succeeded)) + (failed format (format guix-hydra-jobset-info-failed)) + (total format (format guix-hydra-jobset-info-total)))) + +(defface guix-hydra-jobset-info-scheduled + '((t)) + "Face used for the number of scheduled builds." + :group 'guix-hydra-jobset-info-faces) + +(defface guix-hydra-jobset-info-succeeded + '((t :inherit guix-hydra-build-status-succeeded)) + "Face used for the number of succeeded builds." + :group 'guix-hydra-jobset-info-faces) + +(defface guix-hydra-jobset-info-failed + '((t :inherit guix-hydra-build-status-failed)) + "Face used for the number of failed builds." + :group 'guix-hydra-jobset-info-faces) + +(defface guix-hydra-jobset-info-total + '((t)) + "Face used for the total number of builds." + :group 'guix-hydra-jobset-info-faces) + +(defun guix-hydra-jobset-info-insert-project (project entry) + "Insert PROJECT button for the jobset ENTRY." + (let ((jobset (guix-entry-value entry 'name))) + (guix-insert-button + project 'guix-hydra-build-project + 'action (lambda (btn) + (let ((args (guix-hydra-build-latest-prompt-args + :project (button-get btn 'project) + :jobset (button-get btn 'jobset)))) + (apply #'guix-hydra-build-get-display + 'latest args))) + 'project project + 'jobset jobset))) + +(defun guix-hydra-jobset-info-insert-url (entry) + "Insert Hydra URL for the jobset ENTRY." + (guix-insert-button (guix-hydra-jobset-url + (guix-entry-value entry 'project) + (guix-entry-value entry 'name)) + 'guix-url)) + + +;;; Hydra jobset 'list' + +(guix-hydra-list-define-interface hydra-jobset + :mode-name "Hydra-Jobset-List" + :buffer-name "*Guix Hydra Jobset List*" + :format '((name nil 25 t) + (project nil 10 t) + (scheduled nil 12 t) + (succeeded nil 12 t) + (failed nil 9 t) + (total nil 10 t))) + +(let ((map guix-hydra-jobset-list-mode-map)) + (define-key map (kbd "B") 'guix-hydra-jobset-list-latest-builds)) + +(defun guix-hydra-jobset-list-latest-builds (number &rest args) + "Display latest NUMBER of Hydra builds of the current jobset. +Interactively, prompt for NUMBER. With prefix argument, prompt +for all ARGS." + (interactive + (let ((entry (guix-list-current-entry))) + (guix-hydra-build-latest-prompt-args + :project (guix-entry-value entry 'project) + :jobset (guix-entry-value entry 'name)))) + (apply #'guix-hydra-latest-builds number args)) + + +;;; Interactive commands + +;;;###autoload +(defun guix-hydra-jobsets (project) + "Display jobsets of PROJECT." + (interactive (list (guix-hydra-read-project))) + (guix-hydra-jobset-get-display 'project project)) + +(provide 'guix-hydra-jobset) + +;;; guix-hydra-jobset.el ends here diff --git a/emacs/guix-hydra.el b/emacs/guix-hydra.el new file mode 100644 index 0000000000..429483946b --- /dev/null +++ b/emacs/guix-hydra.el @@ -0,0 +1,363 @@ +;;; guix-hydra.el --- Common code for interacting with Hydra -*- lexical-binding: t -*- + +;; Copyright © 2015 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 some general code for 'list'/'info' interfaces for +;; Hydra (Guix build farm). + +;;; Code: + +(require 'json) +(require 'guix-buffer) +(require 'guix-entry) +(require 'guix-utils) +(require 'guix-help-vars) + +(guix-define-groups hydra) + +(defvar guix-hydra-job-regexp + (concat ".*\\." (regexp-opt guix-help-system-types) "\\'") + "Regexp matching a full name of Hydra job (including system).") + +(defun guix-hydra-message (entries search-type &rest _) + "Display a message after showing Hydra ENTRIES." + ;; XXX Add more messages maybe. + (when (null entries) + (if (eq search-type 'fake) + (message "The update is impossible due to lack of Hydra API.") + (message "Hydra has returned no results.")))) + +(defun guix-hydra-list-describe (ids) + "Describe 'hydra' entries with IDS (list of identifiers)." + (guix-buffer-display-entries + (guix-entries-by-ids ids (guix-buffer-current-entries)) + 'info (guix-buffer-current-entry-type) + ;; Hydra does not provide an API to receive builds/jobsets by + ;; IDs/names, so we use a 'fake' search type. + '(fake) + 'add)) + + +;;; Readers + +(defvar guix-hydra-projects + '("gnu" "guix") + "List of available Hydra projects.") + +(guix-define-readers + :completions-var guix-hydra-projects + :single-reader guix-hydra-read-project + :single-prompt "Project: ") + +(guix-define-readers + :single-reader guix-hydra-read-jobset + :single-prompt "Jobset: ") + +(guix-define-readers + :single-reader guix-hydra-read-job + :single-prompt "Job: ") + +(guix-define-readers + :completions-var guix-help-system-types + :single-reader guix-hydra-read-system + :single-prompt "System: ") + + +;;; Defining URLs + +(defvar guix-hydra-url "http://hydra.gnu.org" + "URL of the Hydra build farm.") + +(defun guix-hydra-url (&rest url-parts) + "Return Hydra URL." + (apply #'concat guix-hydra-url "/" url-parts)) + +(defun guix-hydra-api-url (type args) + "Return URL for receiving data using Hydra API. +TYPE is the name of an allowed method. +ARGS is alist of (KEY . VALUE) pairs. +Skip ARG, if VALUE is nil or an empty string." + (declare (indent 1)) + (let* ((fields (mapcar + (lambda (arg) + (pcase arg + (`(,key . ,value) + (unless (or (null value) + (equal "" value)) + (concat (guix-hexify key) "=" + (guix-hexify value)))) + (_ (error "Wrong argument '%s'" arg)))) + args)) + (fields (mapconcat #'identity (delq nil fields) "&"))) + (guix-hydra-url "api/" type "?" fields))) + + +;;; Receiving data from Hydra + +(defun guix-hydra-receive-data (url) + "Return output received from URL and processed with `json-read'." + (with-temp-buffer + (url-insert-file-contents url) + (goto-char (point-min)) + (let ((json-key-type 'symbol) + (json-array-type 'list) + (json-object-type 'alist)) + (json-read)))) + +(defun guix-hydra-get-entries (entry-type search-type &rest args) + "Receive ENTRY-TYPE entries from Hydra. +SEARCH-TYPE is one of the types defined by `guix-hydra-define-interface'." + (unless (eq search-type 'fake) + (let* ((url (apply #'guix-hydra-search-url + entry-type search-type args)) + (raw-entries (guix-hydra-receive-data url)) + (entries (guix-hydra-filter-entries + raw-entries + (guix-hydra-filters entry-type)))) + entries))) + + +;;; Filters for processing raw entries + +(defun guix-hydra-filter-entries (entries filters) + "Filter ENTRIES using FILTERS. +Call `guix-modify' on each entry from ENTRIES." + (mapcar (lambda (entry) + (guix-modify entry filters)) + entries)) + +(defun guix-hydra-filter-names (entry name-alist) + "Replace names of ENTRY parameters using NAME-ALIST. +Each element of NAME-ALIST is (OLD-NAME . NEW-NAME) pair." + (mapcar (lambda (param) + (pcase param + (`(,name . ,val) + (let ((new-name (guix-assq-value name-alist name))) + (if new-name + (cons new-name val) + param))))) + entry)) + +(defun guix-hydra-filter-boolean (entry params) + "Convert number PARAMS (0/1) of ENTRY to boolean values (nil/t)." + (mapcar (lambda (param) + (pcase param + (`(,name . ,val) + (if (memq name params) + (cons name (guix-number->bool val)) + param)))) + entry)) + + +;;; Wrappers for defined variables + +(defvar guix-hydra-entry-type-data nil + "Alist with hydra entry type data. +This alist is filled by `guix-hydra-define-entry-type' macro.") + +(defun guix-hydra-entry-type-value (entry-type symbol) + "Return SYMBOL's value for ENTRY-TYPE from `guix-hydra'." + (symbol-value (guix-assq-value guix-hydra-entry-type-data + entry-type symbol))) + +(defun guix-hydra-search-url (entry-type search-type &rest args) + "Return URL to receive ENTRY-TYPE entries from Hydra." + (apply (guix-assq-value (guix-hydra-entry-type-value + entry-type 'search-types) + search-type) + args)) + +(defun guix-hydra-filters (entry-type) + "Return a list of filters for ENTRY-TYPE." + (guix-hydra-entry-type-value entry-type 'filters)) + + +;;; Interface definers + +(defmacro guix-hydra-define-entry-type (entry-type &rest args) + "Define general code for ENTRY-TYPE. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... + +Required keywords: + + - `:search-types' - default value of the generated + `guix-ENTRY-TYPE-search-types' variable. + +Optional keywords: + + - `:filters' - default value of the generated + `guix-ENTRY-TYPE-filters' variable. + + - `:filter-names' - if specified, a generated + `guix-ENTRY-TYPE-filter-names' function for filtering these + names will be added to `guix-ENTRY-TYPE-filters' variable. + + - `:filter-boolean-params' - if specified, a generated + `guix-ENTRY-TYPE-filter-boolean' function for filtering these + names will be added to `guix-ENTRY-TYPE-filters' variable. + +The rest keyword arguments are passed to +`guix-define-entry-type' macro." + (declare (indent 1)) + (let* ((entry-type-str (symbol-name entry-type)) + (prefix (concat "guix-" entry-type-str)) + (search-types-var (intern (concat prefix "-search-types"))) + (filters-var (intern (concat prefix "-filters"))) + (get-fun (intern (concat prefix "-get-entries")))) + (guix-keyword-args-let args + ((search-types-val :search-types) + (filters-val :filters) + (filter-names-val :filter-names) + (filter-bool-val :filter-boolean-params)) + `(progn + (defvar ,search-types-var ,search-types-val + ,(format "\ +Alist of search types and according URL functions. +Functions are used to define URL to receive '%s' entries." + entry-type-str)) + + (defvar ,filters-var ,filters-val + ,(format "\ +List of filters for '%s' parameters. +Each filter is a function that should take an entry as a single +argument, and should also return an entry." + entry-type-str)) + + ,(when filter-bool-val + (let ((filter-bool-var (intern (concat prefix + "-filter-boolean-params"))) + (filter-bool-fun (intern (concat prefix + "-filter-boolean")))) + `(progn + (defvar ,filter-bool-var ,filter-bool-val + ,(format "\ +List of '%s' parameters that should be transformed to boolean values." + entry-type-str)) + + (defun ,filter-bool-fun (entry) + ,(format "\ +Run `guix-hydra-filter-boolean' with `%S' variable." + filter-bool-var) + (guix-hydra-filter-boolean entry ,filter-bool-var)) + + (setq ,filters-var + (cons ',filter-bool-fun ,filters-var))))) + + ;; Do not move this clause up!: name filtering should be + ;; performed before any other filtering, so this filter should + ;; be consed after the boolean filter. + ,(when filter-names-val + (let* ((filter-names-var (intern (concat prefix + "-filter-names"))) + (filter-names-fun filter-names-var)) + `(progn + (defvar ,filter-names-var ,filter-names-val + ,(format "\ +Alist of '%s' parameter names returned by Hydra API and names +used internally by the elisp code of this package." + entry-type-str)) + + (defun ,filter-names-fun (entry) + ,(format "\ +Run `guix-hydra-filter-names' with `%S' variable." + filter-names-var) + (guix-hydra-filter-names entry ,filter-names-var)) + + (setq ,filters-var + (cons ',filter-names-fun ,filters-var))))) + + (defun ,get-fun (search-type &rest args) + ,(format "\ +Receive '%s' entries. +See `guix-hydra-get-entries' for details." + entry-type-str) + (apply #'guix-hydra-get-entries + ',entry-type search-type args)) + + (guix-alist-put! + '((search-types . ,search-types-var) + (filters . ,filters-var)) + 'guix-hydra-entry-type-data ',entry-type) + + (guix-define-entry-type ,entry-type + :parent-group guix-hydra + :parent-faces-group guix-hydra-faces + ,@%foreign-args))))) + +(defmacro guix-hydra-define-interface (buffer-type entry-type &rest args) + "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries. + +This macro should be called after calling +`guix-hydra-define-entry-type' with the same ENTRY-TYPE. + +ARGS are passed to `guix-BUFFER-TYPE-define-interface' macro." + (declare (indent 2)) + (let* ((entry-type-str (symbol-name entry-type)) + (buffer-type-str (symbol-name buffer-type)) + (get-fun (intern (concat "guix-" entry-type-str + "-get-entries"))) + (definer (intern (concat "guix-" buffer-type-str + "-define-interface")))) + `(,definer ,entry-type + :get-entries-function ',get-fun + :message-function 'guix-hydra-message + ,@args))) + +(defmacro guix-hydra-info-define-interface (entry-type &rest args) + "Define 'info' interface for displaying ENTRY-TYPE entries. +See `guix-hydra-define-interface'." + (declare (indent 1)) + `(guix-hydra-define-interface info ,entry-type + ,@args)) + +(defmacro guix-hydra-list-define-interface (entry-type &rest args) + "Define 'list' interface for displaying ENTRY-TYPE entries. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... + +Optional keywords: + + - `:describe-function' - default value of the generated + `guix-ENTRY-TYPE-list-describe-function' variable (if not + specified, use `guix-hydra-list-describe'). + +The rest keyword arguments are passed to +`guix-hydra-define-interface' macro." + (declare (indent 1)) + (guix-keyword-args-let args + ((describe-val :describe-function)) + `(guix-hydra-define-interface list ,entry-type + :describe-function ,(or describe-val ''guix-hydra-list-describe) + ,@args))) + + +(defvar guix-hydra-font-lock-keywords + (eval-when-compile + `((,(rx "(" (group (or "guix-hydra-define-entry-type" + "guix-hydra-define-interface" + "guix-hydra-info-define-interface" + "guix-hydra-list-define-interface")) + symbol-end) + . 1)))) + +(font-lock-add-keywords 'emacs-lisp-mode guix-hydra-font-lock-keywords) + +(provide 'guix-hydra) + +;;; guix-hydra.el ends here diff --git a/emacs/guix-info.el b/emacs/guix-info.el index 1c7e79b954..644533eb29 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -1,4 +1,4 @@ -;;; guix-info.el --- Info buffers for displaying entries -*- lexical-binding: t -*- +;;; guix-info.el --- 'Info' buffer interface for displaying data -*- lexical-binding: t -*- ;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> ;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> @@ -20,23 +20,16 @@ ;;; Commentary: -;; This file provides a help-like buffer for displaying information -;; about Guix packages and generations. +;; This file provides 'info' (help-like) buffer interface for displaying +;; an arbitrary data. ;;; Code: -(require 'guix-base) +(require 'guix-buffer) +(require 'guix-entry) (require 'guix-utils) -(defgroup guix-info nil - "General settings for info buffers." - :prefix "guix-info-" - :group 'guix) - -(defgroup guix-info-faces nil - "Faces for info buffers." - :group 'guix-info - :group 'guix-faces) +(guix-define-buffer-type info) (defface guix-info-heading '((((type tty pc) (class color)) :weight bold) @@ -80,122 +73,115 @@ "Mouse face used for action buttons." :group 'guix-info-faces) -(defcustom guix-info-ignore-empty-vals nil +(defcustom guix-info-ignore-empty-values nil "If non-nil, do not display parameters with nil values." :type 'boolean :group 'guix-info) +(defcustom guix-info-fill t + "If non-nil, fill string parameters to fit the window. +If nil, insert text parameters (like synopsis or description) in +a raw form." + :type 'boolean + :group 'guix-info) + (defvar guix-info-param-title-format "%-18s: " "String used to format a title of a parameter. It should be a '%s'-sequence. After inserting a title formatted with this string, a value of the parameter is inserted. -This string is used by `guix-info-insert-title-default'.") +This string is used by `guix-info-insert-title-format'.") -(defvar guix-info-multiline-prefix (make-string 20 ?\s) +(defvar guix-info-multiline-prefix + (make-string (length (format guix-info-param-title-format " ")) + ?\s) "String used to format multi-line parameter values. If a value occupies more than one line, this string is inserted in the beginning of each line after the first one. -This string is used by `guix-info-insert-val-default'.") +This string is used by `guix-info-insert-value-format'.") (defvar guix-info-indent 2 "Number of spaces used to indent various parts of inserted text.") -(defvar guix-info-fill-column 60 - "Column used for filling (word wrapping) parameters with long lines. -If a value is not multi-line and it occupies more than this -number of characters, it will be split into several lines.") - (defvar guix-info-delimiter "\n\f\n" "String used to separate entries.") -(defvar guix-info-insert-methods - '((package - (name guix-package-info-name) - (version guix-package-info-version) - (license guix-package-info-license) - (synopsis guix-package-info-synopsis) - (description guix-package-info-insert-description - guix-info-insert-title-simple) - (outputs guix-package-info-insert-outputs - guix-info-insert-title-simple) - (source guix-package-info-insert-source - guix-info-insert-title-simple) - (home-url guix-info-insert-url) - (inputs guix-package-info-insert-inputs) - (native-inputs guix-package-info-insert-native-inputs) - (propagated-inputs guix-package-info-insert-propagated-inputs) - (location guix-package-info-insert-location)) - (installed - (path guix-package-info-insert-output-path - guix-info-insert-title-simple) - (dependencies guix-package-info-insert-output-dependencies - guix-info-insert-title-simple)) - (output - (name guix-package-info-name) - (version guix-output-info-insert-version) - (output guix-output-info-insert-output) - (source guix-package-info-insert-source - guix-info-insert-title-simple) - (path guix-package-info-insert-output-path - guix-info-insert-title-simple) - (dependencies guix-package-info-insert-output-dependencies - guix-info-insert-title-simple) - (license guix-package-info-license) - (synopsis guix-package-info-synopsis) - (description guix-package-info-insert-description - guix-info-insert-title-simple) - (home-url guix-info-insert-url) - (inputs guix-package-info-insert-inputs) - (native-inputs guix-package-info-insert-native-inputs) - (propagated-inputs guix-package-info-insert-propagated-inputs) - (location guix-package-info-insert-location)) - (generation - (number guix-generation-info-insert-number) - (current guix-generation-info-insert-current) - (path guix-info-insert-file-path) - (time guix-info-insert-time))) - "Methods for inserting parameter values. -Each element of the list should have a form: - - (ENTRY-TYPE . ((PARAM INSERT-VALUE [INSERT-TITLE]) ...)) - -INSERT-VALUE may be either nil, a face name or a function. If it -is nil or a face, `guix-info-insert-val-default' function is -called with parameter value and INSERT-VALUE as arguments. If it -is a function, this function is called with parameter value and -entry info (alist of parameters and their values) as arguments. - -INSERT-TITLE may be either nil, a face name or a function. If it -is nil or a face, `guix-info-insert-title-default' function is -called with parameter title and INSERT-TITLE as arguments. If it -is a function, this function is called with parameter title as -argument.") - -(defvar guix-info-displayed-params - '((package name version synopsis outputs source location home-url - license inputs native-inputs propagated-inputs description) - (output name version output synopsis source path dependencies location - home-url license inputs native-inputs propagated-inputs - description) - (installed path dependencies) - (generation number prev-number current time path)) - "List of displayed entry parameters. -Each element of the list should have a form: - - (ENTRY-TYPE . (PARAM ...)) - -The order of displayed parameters is the same as in this list.") - -(defun guix-info-get-insert-methods (entry-type param) - "Return list of insert methods for parameter PARAM of ENTRY-TYPE. -See `guix-info-insert-methods' for details." - (guix-assq-value guix-info-insert-methods - entry-type param)) - -(defun guix-info-get-displayed-params (entry-type) - "Return parameters of ENTRY-TYPE that should be displayed." - (guix-assq-value guix-info-displayed-params - entry-type)) + +;;; Wrappers for 'info' variables + +(defvar guix-info-data nil + "Alist with 'info' data. +This alist is filled by `guix-info-define-interface' macro.") + +(defun guix-info-value (entry-type symbol) + "Return SYMBOL's value for ENTRY-TYPE from `guix-info-data'." + (symbol-value (guix-assq-value guix-info-data entry-type symbol))) + +(defun guix-info-param-title (entry-type param) + "Return a title of an ENTRY-TYPE parameter PARAM." + (guix-buffer-param-title 'info entry-type param)) + +(defun guix-info-format (entry-type) + "Return 'info' format for ENTRY-TYPE." + (guix-info-value entry-type 'format)) + +(defun guix-info-displayed-params (entry-type) + "Return a list of ENTRY-TYPE parameters that should be displayed." + (delq nil + (mapcar (lambda (spec) + (pcase spec + (`(,param . ,_) param))) + (guix-info-format entry-type)))) + + +;;; Inserting entries + +(defvar guix-info-title-aliases + '((format . guix-info-insert-title-format) + (simple . guix-info-insert-title-simple)) + "Alist of aliases and functions to insert titles.") + +(defvar guix-info-value-aliases + '((format . guix-info-insert-value-format) + (indent . guix-info-insert-value-indent) + (simple . guix-info-insert-value-simple) + (time . guix-info-insert-time)) + "Alist of aliases and functions to insert values.") + +(defun guix-info-title-function (fun-or-alias) + "Convert FUN-OR-ALIAS into a function to insert a title." + (or (guix-assq-value guix-info-title-aliases fun-or-alias) + fun-or-alias)) + +(defun guix-info-value-function (fun-or-alias) + "Convert FUN-OR-ALIAS into a function to insert a value." + (or (guix-assq-value guix-info-value-aliases fun-or-alias) + fun-or-alias)) + +(defun guix-info-title-method->function (method) + "Convert title METHOD into a function to insert a title." + (pcase method + ((pred null) #'ignore) + ((pred symbolp) (guix-info-title-function method)) + (`(,fun-or-alias . ,rest-args) + (lambda (title) + (apply (guix-info-title-function fun-or-alias) + title rest-args))) + (_ (error "Unknown title method '%S'" method)))) + +(defun guix-info-value-method->function (method) + "Convert value METHOD into a function to insert a value." + (pcase method + ((pred null) #'ignore) + ((pred functionp) method) + (`(,fun-or-alias . ,rest-args) + (lambda (value _) + (apply (guix-info-value-function fun-or-alias) + value rest-args))) + (_ (error "Unknown value method '%S'" method)))) + +(defun guix-info-fill-column () + "Return fill column for the current window." + (min (window-width) fill-column)) (defun guix-info-get-indent (&optional level) "Return `guix-info-indent' \"multiplied\" by LEVEL spaces. @@ -207,124 +193,128 @@ LEVEL is 1 by default." (insert (guix-info-get-indent level))) (defun guix-info-insert-entries (entries entry-type) - "Display ENTRIES of ENTRY-TYPE in the current info buffer. -ENTRIES should have a form of `guix-entries'." + "Display ENTRY-TYPE ENTRIES in the current info buffer." (guix-mapinsert (lambda (entry) (guix-info-insert-entry entry entry-type)) entries guix-info-delimiter)) -(defun guix-info-insert-entry-default (entry entry-type - &optional indent-level) - "Insert ENTRY of ENTRY-TYPE into the current info buffer. -If INDENT-LEVEL is non-nil, indent displayed information by this -number of `guix-info-indent' spaces." - (let ((region-beg (point))) - (mapc (lambda (param) - (guix-info-insert-param param entry entry-type)) - (guix-info-get-displayed-params entry-type)) - (when indent-level - (indent-rigidly region-beg (point) - (* indent-level guix-info-indent))))) - (defun guix-info-insert-entry (entry entry-type &optional indent-level) "Insert ENTRY of ENTRY-TYPE into the current info buffer. -Use `guix-info-insert-ENTRY-TYPE-function' or -`guix-info-insert-entry-default' if it is nil." - (let* ((var (intern (concat "guix-info-insert-" - (symbol-name entry-type) - "-function"))) - (fun (symbol-value var))) - (if (functionp fun) - (funcall fun entry) - (guix-info-insert-entry-default entry entry-type indent-level)))) - -(defun guix-info-insert-param (param entry entry-type) +If INDENT-LEVEL is non-nil, indent displayed data by this number +of `guix-info-indent' spaces." + (guix-with-indent (* (or indent-level 0) + guix-info-indent) + (dolist (spec (guix-info-format entry-type)) + (guix-info-insert-entry-unit spec entry entry-type)))) + +(defun guix-info-insert-entry-unit (format-spec entry entry-type) "Insert title and value of a PARAM at point. ENTRY is alist with parameters and their values. ENTRY-TYPE is a type of ENTRY." - (let ((val (guix-assq-value entry param))) - (unless (and guix-info-ignore-empty-vals (null val)) - (let* ((title (guix-get-param-title entry-type param)) - (insert-methods (guix-info-get-insert-methods entry-type param)) - (val-method (car insert-methods)) - (title-method (cadr insert-methods))) - (guix-info-method-funcall title title-method - #'guix-info-insert-title-default) - (guix-info-method-funcall val val-method - #'guix-info-insert-val-default - entry) - (insert "\n"))))) - -(defun guix-info-method-funcall (val method default-fun &rest args) - "Call METHOD or DEFAULT-FUN. - -If METHOD is a function and VAL is non-nil, call this -function by applying it to VAL and ARGS. - -If METHOD is a face, propertize inserted VAL with this face." - (cond ((or (null method) - (facep method)) - (funcall default-fun val method)) - ((functionp method) - (apply method val args)) - (t (error "Unknown method '%S'" method)))) - -(defun guix-info-insert-title-default (title &optional face format) - "Insert TITLE formatted with `guix-info-param-title-format' at point." + (pcase format-spec + ((pred functionp) + (funcall format-spec entry) + (insert "\n")) + (`(,param ,title-method ,value-method) + (let ((value (guix-entry-value entry param))) + (unless (and guix-info-ignore-empty-values (null value)) + (let ((title (guix-info-param-title entry-type param)) + (insert-title (guix-info-title-method->function title-method)) + (insert-value (guix-info-value-method->function value-method))) + (funcall insert-title title) + (funcall insert-value value entry) + (insert "\n"))))) + (_ (error "Unknown format specification '%S'" format-spec)))) + +(defun guix-info-insert-title-simple (title &optional face) + "Insert \"TITLE: \" string at point. +If FACE is nil, use `guix-info-param-title'." (guix-format-insert title (or face 'guix-info-param-title) - (or format guix-info-param-title-format))) + "%s: ")) -(defun guix-info-insert-title-simple (title &optional face) - "Insert TITLE at point." - (guix-info-insert-title-default title face "%s:")) - -(defun guix-info-insert-val-default (val &optional face) - "Format and insert parameter value VAL at point. - -This function is intended to be called after -`guix-info-insert-title-default'. - -If VAL is a one-line string longer than `guix-info-fill-column', -split it into several short lines. See also -`guix-info-multiline-prefix'. - -If FACE is non-nil, propertize inserted line(s) with this FACE." - (guix-split-insert val face - guix-info-fill-column - (concat "\n" guix-info-multiline-prefix))) - -(defun guix-info-insert-val-simple (val &optional face-or-fun) - "Format and insert parameter value VAL at point. - -This function is intended to be called after -`guix-info-insert-title-simple'. - -If VAL is a one-line string longer than `guix-info-fill-column', -split it into several short lines and indent each line with -`guix-info-indent' spaces. - -If FACE-OR-FUN is a face, propertize inserted line(s) with this FACE. - -If FACE-OR-FUN is a function, call it with VAL as argument. If -VAL is a list, call the function on each element of this list." - (if (null val) - (progn (guix-info-insert-indent) - (guix-format-insert nil)) - (let ((prefix (concat "\n" (guix-info-get-indent)))) - (insert prefix) - (if (functionp face-or-fun) - (guix-mapinsert face-or-fun - (if (listp val) val (list val)) - prefix) - (guix-split-insert val face-or-fun - guix-info-fill-column prefix))))) - -(defun guix-info-insert-time (seconds &optional _) +(defun guix-info-insert-title-format (title &optional face) + "Insert TITLE using `guix-info-param-title-format' at point. +If FACE is nil, use `guix-info-param-title'." + (guix-format-insert title + (or face 'guix-info-param-title) + guix-info-param-title-format)) + +(defun guix-info-insert-value-simple (value &optional button-or-face indent) + "Format and insert parameter VALUE at point. + +VALUE may be split into several short lines to fit the current +window, depending on `guix-info-fill', and each line is indented +with INDENT number of spaces. + +If BUTTON-OR-FACE is a button type symbol, transform VALUE into +this (these) button(s) and insert each one on a new line. If it +is a face symbol, propertize inserted line(s) with this face." + (or indent (setq indent 0)) + (guix-with-indent indent + (let* ((button? (guix-button-type? button-or-face)) + (face (unless button? button-or-face)) + (fill-col (unless (or button? + (and (stringp value) + (not guix-info-fill))) + (- (guix-info-fill-column) indent))) + (value (if (and value button?) + (guix-buttonize value button-or-face "\n") + value))) + (guix-split-insert value face fill-col "\n")))) + +(defun guix-info-insert-value-indent (value &optional button-or-face) + "Format and insert parameter VALUE at point. + +This function is intended to be called after inserting a title +with `guix-info-insert-title-simple'. + +VALUE may be split into several short lines to fit the current +window, depending on `guix-info-fill', and each line is indented +with `guix-info-indent'. + +For the meaning of BUTTON-OR-FACE, see `guix-info-insert-value-simple'." + (when value (insert "\n")) + (guix-info-insert-value-simple value button-or-face guix-info-indent)) + +(defun guix-info-insert-value-format (value &optional button-or-face + &rest button-properties) + "Format and insert parameter VALUE at point. + +This function is intended to be called after inserting a title +with `guix-info-insert-title-format'. + +VALUE may be split into several short lines to fit the current +window, depending on `guix-info-fill' and +`guix-info-multiline-prefix'. If VALUE is a list, its elements +will be separated with `guix-list-separator'. + +If BUTTON-OR-FACE is a button type symbol, transform VALUE into +this (these) button(s). If it is a face symbol, propertize +inserted line(s) with this face. + +BUTTON-PROPERTIES are passed to `guix-buttonize' (only if +BUTTON-OR-FACE is a button type)." + (let* ((button? (guix-button-type? button-or-face)) + (face (unless button? button-or-face)) + (fill-col (when (or button? + guix-info-fill + (not (stringp value))) + (- (guix-info-fill-column) + (length guix-info-multiline-prefix)))) + (value (if (and value button?) + (apply #'guix-buttonize + value button-or-face guix-list-separator + button-properties) + value))) + (guix-split-insert value face fill-col + (concat "\n" guix-info-multiline-prefix)))) + +(defun guix-info-insert-time (seconds &optional face) "Insert formatted time string using SECONDS at point." - (guix-info-insert-val-default (guix-get-time-string seconds) - 'guix-info-time)) + (guix-format-insert (guix-get-time-string seconds) + (or face 'guix-info-time))) ;;; Buttons @@ -359,21 +349,6 @@ VAL is a list, call the function on each element of this list." 'action (lambda (btn) (browse-url (button-label btn)))) -(define-button-type 'guix-package-location - :supertype 'guix - 'face 'guix-package-info-location - 'help-echo "Find location of this package" - 'action (lambda (btn) - (guix-find-location (button-label btn)))) - -(define-button-type 'guix-package-name - :supertype 'guix - 'face 'guix-package-info-name-button - 'help-echo "Describe this package" - 'action (lambda (btn) - (guix-get-show-entries guix-profile 'info guix-package-info-type - 'name (button-label btn)))) - (defun guix-info-button-copy-label (&optional pos) "Copy a label of the button at POS into kill ring. If POS is nil, use the current point position." @@ -395,496 +370,112 @@ See `insert-text-button' for the meaning of PROPERTIES." 'help-echo message properties)) -(defun guix-info-insert-file-path (path &optional _) - "Make button from file PATH and insert it at point." - (guix-insert-button path 'guix-file)) - -(defun guix-info-insert-url (url &optional _) - "Make button from URL and insert it at point." - (guix-insert-button url 'guix-url)) - +;;; Major mode and interface definer + (defvar guix-info-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent - map (make-composed-keymap (list guix-root-map button-buffer-map) + map (make-composed-keymap (list guix-buffer-map button-buffer-map) special-mode-map)) map) - "Parent keymap for info buffers.") + "Keymap for `guix-info-mode' buffers.") (define-derived-mode guix-info-mode special-mode "Guix-Info" - "Parent mode for displaying information in info buffers.") + "Parent mode for displaying data in 'info' form." + (setq-local revert-buffer-function 'guix-buffer-revert)) + +(defun guix-info-mode-initialize () + "Set up the current 'info' buffer." + ;; Without this, syntactic fontification is performed, and it may + ;; break our highlighting. For example, description of "emacs-typo" + ;; package contains a single " (double-quote) character, so the + ;; default syntactic fontification highlights the rest text after it + ;; as a string. See (info "(elisp) Font Lock Basics") for details. + (setq font-lock-defaults '(nil t))) + +(defmacro guix-info-define-interface (entry-type &rest args) + "Define 'info' interface for displaying ENTRY-TYPE entries. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... + +Required keywords: + + - `:format' - default value of the generated + `guix-ENTRY-TYPE-info-format' variable. + +The rest keyword arguments are passed to +`guix-buffer-define-interface' macro." + (declare (indent 1)) + (let* ((entry-type-str (symbol-name entry-type)) + (prefix (concat "guix-" entry-type-str "-info")) + (group (intern prefix)) + (format-var (intern (concat prefix "-format")))) + (guix-keyword-args-let args + ((show-entries-val :show-entries-function) + (format-val :format)) + `(progn + (defcustom ,format-var ,format-val + ,(format "\ +List of methods for inserting '%s' entry. +Each METHOD should be either a function or should have the +following form: + + (PARAM INSERT-TITLE INSERT-VALUE) + +If METHOD is a function, it is called with an entry as argument. + +PARAM is a name of '%s' entry parameter. + +INSERT-TITLE may be either a symbol or a list. If it is a +symbol, it should be a function or an alias from +`guix-info-title-aliases', in which case it is called with title +as argument. If it is a list, it should have a +form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is +called with title and ARGS as arguments. + +INSERT-VALUE may be either a symbol or a list. If it is a +symbol, it should be a function or an alias from +`guix-info-value-aliases', in which case it is called with value +and entry as arguments. If it is a list, it should have a +form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is +called with value and ARGS as arguments. + +Parameters are inserted in the same order as defined by this list. +After calling each METHOD, a new line is inserted." + entry-type-str entry-type-str) + :type 'sexp + :group ',group) + + (guix-alist-put! + '((format . ,format-var)) + 'guix-info-data ',entry-type) + + ,(if show-entries-val + `(guix-buffer-define-interface info ,entry-type + :show-entries-function ,show-entries-val + ,@%foreign-args) + + (let ((insert-fun (intern (concat prefix "-insert-entries")))) + `(progn + (defun ,insert-fun (entries) + ,(format "\ +Print '%s' ENTRIES in the current 'info' buffer." + entry-type-str) + (guix-info-insert-entries entries ',entry-type)) + + (guix-buffer-define-interface info ,entry-type + :insert-entries-function ',insert-fun + :mode-init-function 'guix-info-mode-initialize + ,@%foreign-args)))))))) -;;; Displaying packages - -(guix-define-buffer-type info package - :required (id installed non-unique)) - -(defface guix-package-info-heading - '((t :inherit guix-info-heading)) - "Face for package name and version headings." - :group 'guix-package-info-faces) - -(defface guix-package-info-name - '((t :inherit font-lock-keyword-face)) - "Face used for a name of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-name-button - '((t :inherit button)) - "Face used for a full name that can be used to describe a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-version - '((t :inherit font-lock-builtin-face)) - "Face used for a version of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-synopsis - '((((type tty pc) (class color)) :weight bold) - (t :height 1.1 :weight bold :inherit variable-pitch)) - "Face used for a synopsis of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-description - '((t)) - "Face used for a description of a package." - :group 'guix-package-info-faces) +(defvar guix-info-font-lock-keywords + (eval-when-compile + `((,(rx "(" (group "guix-info-define-interface") + symbol-end) + . 1)))) -(defface guix-package-info-license - '((t :inherit font-lock-string-face)) - "Face used for a license of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-location - '((t :inherit link)) - "Face used for a location of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-installed-outputs - '((default :weight bold) - (((class color) (min-colors 88) (background light)) - :foreground "ForestGreen") - (((class color) (min-colors 88) (background dark)) - :foreground "PaleGreen") - (((class color) (min-colors 8)) - :foreground "green") - (t :underline t)) - "Face used for installed outputs of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-uninstalled-outputs - '((t :weight bold)) - "Face used for uninstalled outputs of a package." - :group 'guix-package-info-faces) - -(defface guix-package-info-obsolete - '((t :inherit error)) - "Face used if a package is obsolete." - :group 'guix-package-info-faces) - -(defvar guix-info-insert-package-function - #'guix-package-info-insert-with-heading - "Function used to insert a package information. -It is called with a single argument - alist of package parameters. -If nil, insert package in a default way.") - -(defvar guix-package-info-heading-params '(synopsis description) - "List of parameters displayed in a heading along with name and version.") - -(defcustom guix-package-info-fill-heading t - "If nil, insert heading parameters in a raw form, without -filling them to fit the window." - :type 'boolean - :group 'guix-package-info) - -(defun guix-package-info-insert-heading (entry) - "Insert the heading for package ENTRY. -Show package name, version, and `guix-package-info-heading-params'." - (guix-format-insert (concat (guix-assq-value entry 'name) " " - (guix-assq-value entry 'version)) - 'guix-package-info-heading) - (insert "\n\n") - (mapc (lambda (param) - (let ((val (guix-assq-value entry param)) - (face (guix-get-symbol (symbol-name param) - 'info 'package))) - (when val - (let* ((col (min (window-width) fill-column)) - (val (if guix-package-info-fill-heading - (guix-get-filled-string val col) - val))) - (guix-format-insert val (and (facep face) face)) - (insert "\n\n"))))) - guix-package-info-heading-params)) - -(defun guix-package-info-insert-with-heading (entry) - "Insert package ENTRY with its heading at point." - (guix-package-info-insert-heading entry) - (mapc (lambda (param) - (unless (or (memq param '(name version)) - (memq param guix-package-info-heading-params)) - (guix-info-insert-param param entry 'package))) - (guix-info-get-displayed-params 'package))) - -(defun guix-package-info-insert-description (desc &optional _) - "Insert description DESC at point." - (guix-info-insert-val-simple desc 'guix-package-info-description)) - -(defun guix-package-info-insert-location (location &optional _) - "Make button from file LOCATION and insert it at point." - (guix-insert-button location 'guix-package-location)) - -(defmacro guix-package-info-define-insert-inputs (&optional type) - "Define a face and a function for inserting package inputs. -TYPE is a type of inputs. -Function name is `guix-package-info-insert-TYPE-inputs'. -Face name is `guix-package-info-TYPE-inputs'." - (let* ((type-str (symbol-name type)) - (type-name (and type (concat type-str "-"))) - (type-desc (and type (concat type-str " "))) - (face (intern (concat "guix-package-info-" type-name "inputs"))) - (btn (intern (concat "guix-package-" type-name "input"))) - (fun (intern (concat "guix-package-info-insert-" type-name "inputs")))) - `(progn - (defface ,face - '((t :inherit guix-package-info-name-button)) - ,(concat "Face used for " type-desc "inputs of a package.") - :group 'guix-package-info-faces) - - (define-button-type ',btn - :supertype 'guix-package-name - 'face ',face) - - (defun ,fun (inputs &optional _) - ,(concat "Make buttons from " type-desc "INPUTS and insert them at point.") - (guix-package-info-insert-full-names inputs ',btn))))) - -(guix-package-info-define-insert-inputs) -(guix-package-info-define-insert-inputs native) -(guix-package-info-define-insert-inputs propagated) - -(defun guix-package-info-insert-full-names (names button-type) - "Make BUTTON-TYPE buttons from package NAMES and insert them at point. -NAMES is a list of strings." - (if names - (guix-info-insert-val-default - (with-temp-buffer - (guix-mapinsert (lambda (name) - (guix-insert-button name button-type)) - names - guix-list-separator) - (buffer-substring (point-min) (point-max)))) - (guix-format-insert nil))) - - -;;; Inserting outputs and installed parameters - -(defvar guix-package-info-output-format "%-10s" - "String used to format output names of the packages. -It should be a '%s'-sequence. After inserting an output name -formatted with this string, an action button is inserted.") - -(defvar guix-package-info-obsolete-string "(This package is obsolete)" - "String used if a package is obsolete.") - -(defvar guix-info-insert-installed-function nil - "Function used to insert an installed information. -It is called with a single argument - alist of installed -parameters (`output', `path', `dependencies'). -If nil, insert installed info in a default way.") - -(defun guix-package-info-insert-outputs (outputs entry) - "Insert OUTPUTS from package ENTRY at point." - (and (guix-assq-value entry 'obsolete) - (guix-package-info-insert-obsolete-text)) - (and (guix-assq-value entry 'non-unique) - (guix-assq-value entry 'installed) - (guix-package-info-insert-non-unique-text - (guix-get-full-name entry))) - (insert "\n") - (mapc (lambda (output) - (guix-package-info-insert-output output entry)) - outputs)) - -(defun guix-package-info-insert-obsolete-text () - "Insert a message about obsolete package at point." - (guix-info-insert-indent) - (guix-format-insert guix-package-info-obsolete-string - 'guix-package-info-obsolete)) - -(defun guix-package-info-insert-non-unique-text (full-name) - "Insert a message about non-unique package with FULL-NAME at point." - (insert "\n") - (guix-info-insert-indent) - (insert "Installed outputs are displayed for a non-unique ") - (guix-insert-button full-name 'guix-package-name) - (insert " package.")) - -(defun guix-package-info-insert-output (output entry) - "Insert OUTPUT at point. -Make some fancy text with buttons and additional stuff if the -current OUTPUT is installed (if there is such output in -`installed' parameter of a package ENTRY)." - (let* ((installed (guix-assq-value entry 'installed)) - (obsolete (guix-assq-value entry 'obsolete)) - (installed-entry (cl-find-if - (lambda (entry) - (string= (guix-assq-value entry 'output) - output)) - installed)) - (action-type (if installed-entry 'delete 'install))) - (guix-info-insert-indent) - (guix-format-insert output - (if installed-entry - 'guix-package-info-installed-outputs - 'guix-package-info-uninstalled-outputs) - guix-package-info-output-format) - (guix-package-info-insert-action-button action-type entry output) - (when obsolete - (guix-info-insert-indent) - (guix-package-info-insert-action-button 'upgrade entry output)) - (insert "\n") - (when installed-entry - (guix-info-insert-entry installed-entry 'installed 2)))) - -(defun guix-package-info-insert-action-button (type entry output) - "Insert button to process an action on a package OUTPUT at point. -TYPE is one of the following symbols: `install', `delete', `upgrade'. -ENTRY is an alist with package info." - (let ((type-str (capitalize (symbol-name type))) - (full-name (guix-get-full-name entry output))) - (guix-info-insert-action-button - type-str - (lambda (btn) - (guix-process-package-actions - guix-profile - `((,(button-get btn 'action-type) (,(button-get btn 'id) - ,(button-get btn 'output)))) - (current-buffer))) - (concat type-str " '" full-name "'") - 'action-type type - 'id (or (guix-assq-value entry 'package-id) - (guix-assq-value entry 'id)) - 'output output))) - -(defun guix-package-info-insert-output-path (path &optional _) - "Insert PATH of the installed output." - (guix-info-insert-val-simple path #'guix-info-insert-file-path)) - -(defalias 'guix-package-info-insert-output-dependencies - 'guix-package-info-insert-output-path) - - -;;; Inserting a source - -(defface guix-package-info-source - '((t :inherit link :underline nil)) - "Face used for a source URL of a package." - :group 'guix-package-info-faces) - -(defcustom guix-package-info-auto-find-source nil - "If non-nil, find a source file after pressing a \"Show\" button. -If nil, just display the source file path without finding." - :type 'boolean - :group 'guix-package-info) - -(defcustom guix-package-info-auto-download-source t - "If nil, do not automatically download a source file if it doesn't exist. -After pressing a \"Show\" button, a derivation of the package -source is calculated and a store file path is displayed. If this -variable is non-nil and the source file does not exist in the -store, it will be automatically downloaded (with a possible -prompt depending on `guix-operation-confirm' variable)." - :type 'boolean - :group 'guix-package-info) - -(defvar guix-package-info-download-buffer nil - "Buffer from which a current download operation was performed.") - -(define-button-type 'guix-package-source - :supertype 'guix - 'face 'guix-package-info-source - 'help-echo "" - 'action (lambda (_) - ;; As a source may not be a real URL (e.g., "mirror://..."), - ;; no action is bound to a source button. - (message "Yes, this is the source URL. What did you expect?"))) - -(defun guix-package-info-insert-source-url (url &optional _) - "Make button from source URL and insert it at point." - (guix-insert-button url 'guix-package-source)) - -(defun guix-package-info-show-source (entry-id package-id) - "Show file name of a package source in the current info buffer. -Find the file if needed (see `guix-package-info-auto-find-source'). -ENTRY-ID is an ID of the current entry (package or output). -PACKAGE-ID is an ID of the package which source to show." - (let* ((entry (guix-get-entry-by-id entry-id guix-entries)) - (file (guix-package-source-path package-id))) - (or file - (error "Couldn't define file path of the package source")) - (let* ((new-entry (cons (cons 'source-file file) - entry)) - (entries (cl-substitute-if - new-entry - (lambda (entry) - (equal (guix-assq-value entry 'id) - entry-id)) - guix-entries - :count 1))) - (guix-redisplay-buffer :entries entries) - (if (file-exists-p file) - (if guix-package-info-auto-find-source - (guix-find-file file) - (message "The source store path is displayed.")) - (if guix-package-info-auto-download-source - (guix-package-info-download-source package-id) - (message "The source does not exist in the store.")))))) - -(defun guix-package-info-download-source (package-id) - "Download a source of the package PACKAGE-ID." - (setq guix-package-info-download-buffer (current-buffer)) - (guix-package-source-build-derivation - package-id - "The source does not exist in the store. Download it?")) - -(defun guix-package-info-insert-source (source entry) - "Insert SOURCE from package ENTRY at point. -SOURCE is a list of URLs." - (guix-info-insert-indent) - (if (null source) - (guix-format-insert nil) - (let* ((source-file (guix-assq-value entry 'source-file)) - (entry-id (guix-assq-value entry 'id)) - (package-id (or (guix-assq-value entry 'package-id) - entry-id))) - (if (null source-file) - (guix-info-insert-action-button - "Show" - (lambda (btn) - (guix-package-info-show-source (button-get btn 'entry-id) - (button-get btn 'package-id))) - "Show the source store path of the current package" - 'entry-id entry-id - 'package-id package-id) - (unless (file-exists-p source-file) - (guix-info-insert-action-button - "Download" - (lambda (btn) - (guix-package-info-download-source - (button-get btn 'package-id))) - "Download the source into the store" - 'package-id package-id)) - (guix-info-insert-val-simple source-file - #'guix-info-insert-file-path)) - (guix-info-insert-val-simple source - #'guix-package-info-insert-source-url)))) - -(defun guix-package-info-redisplay-after-download () - "Redisplay an 'info' buffer after downloading the package source. -This function is used to hide a \"Download\" button if needed." - (when (buffer-live-p guix-package-info-download-buffer) - (guix-redisplay-buffer :buffer guix-package-info-download-buffer) - (setq guix-package-info-download-buffer nil))) - -(add-hook 'guix-after-source-download-hook - 'guix-package-info-redisplay-after-download) - - -;;; Displaying outputs - -(guix-define-buffer-type info output - :buffer-name "*Guix Package Info*" - :required (id package-id installed non-unique)) - -(defvar guix-info-insert-output-function nil - "Function used to insert an output information. -It is called with a single argument - alist of output parameters. -If nil, insert output in a default way.") - -(defun guix-output-info-insert-version (version entry) - "Insert output VERSION and obsolete text if needed at point." - (guix-info-insert-val-default version - 'guix-package-info-version) - (and (guix-assq-value entry 'obsolete) - (guix-package-info-insert-obsolete-text))) - -(defun guix-output-info-insert-output (output entry) - "Insert OUTPUT and action buttons at point." - (let* ((installed (guix-assq-value entry 'installed)) - (obsolete (guix-assq-value entry 'obsolete)) - (action-type (if installed 'delete 'install))) - (guix-info-insert-val-default - output - (if installed - 'guix-package-info-installed-outputs - 'guix-package-info-uninstalled-outputs)) - (guix-info-insert-indent) - (guix-package-info-insert-action-button action-type entry output) - (when obsolete - (guix-info-insert-indent) - (guix-package-info-insert-action-button 'upgrade entry output)))) - - -;;; Displaying generations - -(guix-define-buffer-type info generation) - -(defface guix-generation-info-number - '((t :inherit font-lock-keyword-face)) - "Face used for a number of a generation." - :group 'guix-generation-info-faces) - -(defface guix-generation-info-current - '((t :inherit guix-package-info-installed-outputs)) - "Face used if a generation is the current one." - :group 'guix-generation-info-faces) - -(defface guix-generation-info-not-current - '((t nil)) - "Face used if a generation is not the current one." - :group 'guix-generation-info-faces) - -(defvar guix-info-insert-generation-function nil - "Function used to insert a generation information. -It is called with a single argument - alist of generation parameters. -If nil, insert generation in a default way.") - -(defun guix-generation-info-insert-number (number &optional _) - "Insert generation NUMBER and action buttons." - (guix-info-insert-val-default number 'guix-generation-info-number) - (guix-info-insert-indent) - (guix-info-insert-action-button - "Packages" - (lambda (btn) - (guix-get-show-entries guix-profile 'list guix-package-list-type - 'generation (button-get btn 'number))) - "Show installed packages for this generation" - 'number number) - (guix-info-insert-indent) - (guix-info-insert-action-button - "Delete" - (lambda (btn) - (guix-delete-generations guix-profile (list (button-get btn 'number)) - (current-buffer))) - "Delete this generation" - 'number number)) - -(defun guix-generation-info-insert-current (val entry) - "Insert boolean value VAL showing whether this generation is current." - (if val - (guix-info-insert-val-default "Yes" 'guix-generation-info-current) - (guix-info-insert-val-default "No" 'guix-generation-info-not-current) - (guix-info-insert-indent) - (guix-info-insert-action-button - "Switch" - (lambda (btn) - (guix-switch-to-generation guix-profile (button-get btn 'number) - (current-buffer))) - "Switch to this generation (make it the current one)" - 'number (guix-assq-value entry 'number)))) +(font-lock-add-keywords 'emacs-lisp-mode guix-info-font-lock-keywords) (provide 'guix-info) diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 560ae6a86f..7e57f42cb2 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -1,4 +1,4 @@ -;;; guix-list.el --- List buffers for displaying entries -*- lexical-binding: t -*- +;;; guix-list.el --- 'List' buffer interface for displaying data -*- lexical-binding: t -*- ;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> @@ -19,26 +19,19 @@ ;;; Commentary: -;; This file provides a list-like buffer for displaying information -;; about Guix packages and generations. +;; This file provides 'list' buffer interface for displaying an arbitrary +;; data. ;;; Code: (require 'cl-lib) (require 'tabulated-list) +(require 'guix-buffer) (require 'guix-info) -(require 'guix-base) +(require 'guix-entry) (require 'guix-utils) -(defgroup guix-list nil - "General settings for list buffers." - :prefix "guix-list-" - :group 'guix) - -(defgroup guix-list-faces nil - "Faces for list buffers." - :group 'guix-list - :group 'guix-faces) +(guix-define-buffer-type list) (defface guix-list-file-path '((t :inherit guix-info-file-path)) @@ -50,153 +43,165 @@ "Face used for time stamps." :group 'guix-list-faces) -(defcustom guix-list-describe-warning-count 10 - "The maximum number of entries for describing without a warning. -If a user wants to describe more than this number of marked -entries, he will be prompted for confirmation." - :type 'integer - :group 'guix-list) - -(defvar guix-list-column-format - `((package - (name 20 t) - (version 10 nil) - (outputs 13 t) - (installed 13 t) - (synopsis 30 nil)) - (output - (name 20 t) - (version 10 nil) - (output 9 t) - (installed 12 t) - (synopsis 30 nil)) - (generation - (number 5 - ,(lambda (a b) (guix-list-sort-numerically 0 a b)) - :right-align t) - (current 10 t) - (time 20 t) - (path 30 t))) - "Columns displayed in list buffers. -Each element of the list has a form: - - (ENTRY-TYPE . ((PARAM WIDTH SORT . PROPS) ...)) - -PARAM is the name of an entry parameter of ENTRY-TYPE. For the -meaning of WIDTH, SORT and PROPS, see `tabulated-list-format'.") - -(defvar guix-list-column-titles - '((generation - (number . "N."))) - "Column titles for list buffers. -Has the same structure as `guix-param-titles', but titles from -this list have a priority.") - -(defvar guix-list-column-value-methods - '((package - (name . guix-package-list-get-name) - (synopsis . guix-list-get-one-line) - (description . guix-list-get-one-line) - (installed . guix-package-list-get-installed-outputs)) - (output - (name . guix-package-list-get-name) - (synopsis . guix-list-get-one-line) - (description . guix-list-get-one-line)) - (generation - (current . guix-generation-list-get-current) - (time . guix-list-get-time) - (path . guix-list-get-file-path))) - "Methods for inserting parameter values in columns. -Each element of the list has a form: +(defun guix-list-describe (&optional mark-names) + "Describe entries marked with a general mark. +'Describe' means display entries in 'info' buffer. +If no entries are marked, describe the current entry. +With prefix argument, describe entries marked with any mark." + (interactive (list (unless current-prefix-arg '(general)))) + (let* ((ids (or (apply #'guix-list-get-marked-id-list mark-names) + (list (guix-list-current-id)))) + (count (length ids)) + (entry-type (guix-buffer-current-entry-type))) + (when (or (<= count (guix-list-describe-warning-count entry-type)) + (y-or-n-p (format "Do you really want to describe %d entries? " + count))) + (guix-list-describe-entries entry-type ids)))) - (ENTRY-TYPE . ((PARAM . FUN) ...)) + +;;; Wrappers for 'list' variables -PARAM is the name of an entry parameter of ENTRY-TYPE. +(defvar guix-list-data nil + "Alist with 'list' data. +This alist is filled by `guix-list-define-interface' macro.") -FUN is a function returning a value that will be inserted. The -function is called with 2 arguments: the first one is the value -of the parameter; the second argument is an entry info (alist of -parameters and their values).") +(defun guix-list-value (entry-type symbol) + "Return SYMBOL's value for ENTRY-TYPE from `guix-list-data'." + (symbol-value (guix-assq-value guix-list-data entry-type symbol))) -(defun guix-list-get-param-title (entry-type param) - "Return title of an ENTRY-TYPE entry parameter PARAM." - (or (guix-assq-value guix-list-column-titles - entry-type param) - (guix-get-param-title entry-type param))) +(defun guix-list-param-title (entry-type param) + "Return column title of an ENTRY-TYPE parameter PARAM." + (guix-buffer-param-title 'list entry-type param)) -(defun guix-list-get-column-format (entry-type) +(defun guix-list-format (entry-type) "Return column format for ENTRY-TYPE." - (guix-assq-value guix-list-column-format entry-type)) + (guix-list-value entry-type 'format)) + +(defun guix-list-displayed-params (entry-type) + "Return a list of ENTRY-TYPE parameters that should be displayed." + (mapcar #'car (guix-list-format entry-type))) -(defun guix-list-get-displayed-params (entry-type) - "Return list of parameters of ENTRY-TYPE that should be displayed." - (mapcar #'car - (guix-list-get-column-format entry-type))) +(defun guix-list-sort-key (entry-type) + "Return sort key for ENTRY-TYPE." + (guix-list-value entry-type 'sort-key)) -(defun guix-list-get-sort-key (entry-type param &optional invert) - "Return suitable sort key for `tabulated-list-sort-key'. -Define column title by ENTRY-TYPE and PARAM. If INVERT is -non-nil, invert the sort." - (when (memq param (guix-list-get-displayed-params entry-type)) - (cons (guix-list-get-param-title entry-type param) invert))) +(defun guix-list-additional-marks (entry-type) + "Return alist of additional marks for ENTRY-TYPE." + (guix-list-value entry-type 'marks)) + +(defun guix-list-single-entry? (entry-type) + "Return non-nil, if a single entry of ENTRY-TYPE should be listed." + (guix-list-value entry-type 'list-single)) + +(defun guix-list-describe-warning-count (entry-type) + "Return the maximum number of ENTRY-TYPE entries to describe." + (guix-list-value entry-type 'describe-count)) + +(defun guix-list-describe-entries (entry-type ids) + "Describe ENTRY-TYPE entries with IDS in 'info' buffer" + (funcall (guix-list-value entry-type 'describe) + ids)) + + +;;; Tabulated list internals (defun guix-list-sort-numerically (column a b) "Compare COLUMN of tabulated entries A and B numerically. -It is a sort predicate for `tabulated-list-format'. +This function is used for sort predicates for `tabulated-list-format'. Return non-nil, if B is bigger than A." (cl-flet ((num (entry) (string-to-number (aref (cadr entry) column)))) (> (num b) (num a)))) -(defun guix-list-make-tabulated-vector (entry-type fun) +(defmacro guix-list-define-numerical-sorter (column) + "Define numerical sort predicate for COLUMN. +See `guix-list-sort-numerically' for details." + (let ((name (intern (format "guix-list-sort-numerically-%d" column))) + (doc (format "\ +Predicate to sort tabulated list by column %d numerically. +See `guix-list-sort-numerically' for details." + column))) + `(defun ,name (a b) + ,doc + (guix-list-sort-numerically ,column a b)))) + +(defmacro guix-list-define-numerical-sorters (n) + "Define numerical sort predicates for columns from 0 to N. +See `guix-list-define-numerical-sorter' for details." + `(progn + ,@(mapcar (lambda (i) + `(guix-list-define-numerical-sorter ,i)) + (number-sequence 0 n)))) + +(guix-list-define-numerical-sorters 9) + +(defun guix-list-tabulated-sort-key (entry-type) + "Return ENTRY-TYPE sort key for `tabulated-list-sort-key'." + (let ((sort-key (guix-list-sort-key entry-type))) + (and sort-key + (cons (guix-list-param-title entry-type (car sort-key)) + (cdr sort-key))))) + +(defun guix-list-tabulated-vector (entry-type fun) "Call FUN on each column specification for ENTRY-TYPE. -FUN is called with 2 argument: parameter name and column -specification (see `guix-list-column-format'). +FUN is applied to column specification as arguments (see +`guix-list-format'). Return a vector made of values of FUN calls." (apply #'vector (mapcar (lambda (col-spec) - (funcall fun (car col-spec) (cdr col-spec))) - (guix-list-get-column-format entry-type)))) + (apply fun col-spec)) + (guix-list-format entry-type)))) -(defun guix-list-get-list-format (entry-type) +(defun guix-list-tabulated-format (entry-type) "Return ENTRY-TYPE list specification for `tabulated-list-format'." - (guix-list-make-tabulated-vector + (guix-list-tabulated-vector entry-type - (lambda (param spec) - (cons (guix-list-get-param-title entry-type param) - spec)))) + (lambda (param _ &rest rest-spec) + (cons (guix-list-param-title entry-type param) + rest-spec)))) -(defun guix-list-insert-entries (entries entry-type) - "Display ENTRIES of ENTRY-TYPE in the current list buffer. -ENTRIES should have a form of `guix-entries'." - (setq tabulated-list-entries - (guix-list-get-tabulated-entries entries entry-type)) - (tabulated-list-print)) - -(defun guix-list-get-tabulated-entries (entries entry-type) - "Return list of values of ENTRY-TYPE for `tabulated-list-entries'. -Values are taken from ENTRIES which should have the form of -`guix-entries'." +(defun guix-list-tabulated-entries (entries entry-type) + "Return a list of ENTRY-TYPE values for `tabulated-list-entries'." (mapcar (lambda (entry) - (list (guix-assq-value entry 'id) - (guix-list-get-tabulated-entry entry entry-type))) + (list (guix-entry-id entry) + (guix-list-tabulated-entry entry entry-type))) entries)) -(defun guix-list-get-tabulated-entry (entry entry-type) +(defun guix-list-tabulated-entry (entry entry-type) "Return array of values for `tabulated-list-entries'. -Parameters are taken from ENTRY of ENTRY-TYPE." - (guix-list-make-tabulated-vector +Parameters are taken from ENTRY-TYPE ENTRY." + (guix-list-tabulated-vector entry-type - (lambda (param _) - (let ((val (guix-assq-value entry param)) - (fun (guix-assq-value guix-list-column-value-methods - entry-type param))) + (lambda (param fun &rest _) + (let ((val (guix-entry-value entry param))) (if fun (funcall fun val entry) (guix-get-string val)))))) + +;;; Displaying entries + +(defun guix-list-get-display-entries (entry-type &rest args) + "Search for entries and show them in a 'list' buffer preferably." + (let ((entries (guix-buffer-get-entries 'list entry-type args))) + (if (or (null entries) ; = 0 + (cdr entries) ; > 1 + (guix-list-single-entry? entry-type) + (null (guix-buffer-value 'info entry-type 'show-entries))) + (guix-buffer-display-entries entries 'list entry-type args 'add) + (if (equal (guix-buffer-value 'info entry-type 'get-entries) + (guix-buffer-value 'list entry-type 'get-entries)) + (guix-buffer-display-entries entries 'info entry-type args 'add) + (guix-buffer-get-display-entries 'info entry-type args 'add))))) + +(defun guix-list-insert-entries (entries entry-type) + "Print ENTRY-TYPE ENTRIES in the current buffer." + (setq tabulated-list-entries + (guix-list-tabulated-entries entries entry-type)) + (tabulated-list-print)) + (defun guix-list-get-one-line (val &optional _) "Return one-line string from a multi-line string VAL. VAL may be nil." @@ -217,22 +222,18 @@ VAL may be nil." 'follow-link t 'help-echo "Find file")) + +;;; 'List' lines + (defun guix-list-current-id () - "Return ID of the current entry." + "Return ID of the entry at point." (or (tabulated-list-get-id) (user-error "No entry here"))) (defun guix-list-current-entry () - "Return alist of the current entry info." - (guix-get-entry-by-id (guix-list-current-id) guix-entries)) - -(defun guix-list-current-package-id () - "Return ID of the current package." - (cl-ecase major-mode - (guix-package-list-mode - (guix-list-current-id)) - (guix-output-list-mode - (guix-assq-value (guix-list-current-entry) 'package-id)))) + "Return entry at point." + (guix-entry-by-id (guix-list-current-id) + (guix-buffer-current-entries))) (defun guix-list-for-each-line (fun &rest args) "Call FUN with ARGS for each entry line." @@ -263,20 +264,28 @@ Each element of the list has a form: (ID MARK-NAME . ARGS) ID is an entry ID. -MARK-NAME is a symbol from `guix-list-mark-alist'. +MARK-NAME is a symbol from `guix-list-marks'. ARGS is a list of additional values.") -(defvar guix-list-mark-alist +(defvar-local guix-list-marks nil + "Alist of available mark names and mark characters.") + +(defvar guix-list-default-marks '((empty . ?\s) (general . ?*)) - "Alist of available mark names and mark characters.") + "Alist of default mark names and mark characters.") + +(defun guix-list-marks (entry-type) + "Return alist of available marks for ENTRY-TYPE." + (append guix-list-default-marks + (guix-list-additional-marks entry-type))) -(defsubst guix-list-get-mark (name) +(defun guix-list-get-mark (name) "Return mark character by its NAME." - (or (guix-assq-value guix-list-mark-alist name) + (or (guix-assq-value guix-list-marks name) (error "Mark '%S' not found" name))) -(defsubst guix-list-get-mark-string (name) +(defun guix-list-get-mark-string (name) "Return mark string by its NAME." (string (guix-list-get-mark name))) @@ -288,11 +297,11 @@ ARGS is a list of additional values.") "Return list of specs of entries marked with any mark from MARK-NAMES. Entry specs are elements from `guix-list-marked' list. If MARK-NAMES are not specified, use all marks from -`guix-list-mark-alist' except the `empty' one." +`guix-list-marks' except the `empty' one." (or mark-names (setq mark-names (delq 'empty - (mapcar #'car guix-list-mark-alist)))) + (mapcar #'car guix-list-marks)))) (cl-remove-if-not (lambda (assoc) (memq (cadr assoc) mark-names)) guix-list-marked)) @@ -314,7 +323,7 @@ See `guix-list-get-marked' for details." (defun guix-list--mark (mark-name &optional advance &rest args) "Put a mark on the current line. Also add the current entry to `guix-list-marked' using its ID and ARGS. -MARK-NAME is a symbol from `guix-list-mark-alist'. +MARK-NAME is a symbol from `guix-list-marks'. If ADVANCE is non-nil, move forward by one line after marking." (let ((id (guix-list-current-id))) (if (eq mark-name 'empty) @@ -337,7 +346,7 @@ With ARG, mark all lines." (defun guix-list-mark-all (&optional mark-name) "Mark all lines with MARK-NAME mark. -MARK-NAME is a symbol from `guix-list-mark-alist'. +MARK-NAME is a symbol from `guix-list-marks'. Interactively, put a general mark on all lines." (interactive) (or mark-name (setq mark-name 'general)) @@ -363,7 +372,7 @@ With ARG, unmark all lines." (guix-list-mark-all 'empty)) (defun guix-list-restore-marks () - "Put marks according to `guix-list-mark-alist'." + "Put marks according to `guix-list-marked'." (guix-list-for-each-line (lambda () (let ((mark-name (car (guix-assq-value guix-list-marked @@ -380,520 +389,183 @@ Same as `tabulated-list-sort', but also restore marks after sorting." (guix-list-restore-marks)) +;;; Major mode and interface definer + (defvar guix-list-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent - map (make-composed-keymap guix-root-map + map (make-composed-keymap guix-buffer-map tabulated-list-mode-map)) (define-key map (kbd "RET") 'guix-list-describe) + (define-key map (kbd "i") 'guix-list-describe) (define-key map (kbd "m") 'guix-list-mark) (define-key map (kbd "*") 'guix-list-mark) (define-key map (kbd "u") 'guix-list-unmark) (define-key map (kbd "DEL") 'guix-list-unmark-backward) (define-key map [remap tabulated-list-sort] 'guix-list-sort) map) - "Parent keymap for list buffers.") + "Keymap for `guix-list-mode' buffers.") (define-derived-mode guix-list-mode tabulated-list-mode "Guix-List" - "Parent mode for displaying information in list buffers." - (setq tabulated-list-padding 2)) - -(defmacro guix-list-define-entry-type (entry-type &rest args) - "Define common stuff for displaying ENTRY-TYPE entries in list buffers. - -Remaining argument (ARGS) should have a form [KEYWORD VALUE] ... The -following keywords are available: - - - `:sort-key' - default sort key for the tabulated list buffer. - - - `:invert-sort' - if non-nil, invert initial sort. - - - `:marks' - default value for the defined - `guix-ENTRY-TYPE-mark-alist' variable. - -This macro defines the following functions: - - - `guix-ENTRY-TYPE-mark-MARK-NAME' functions for each mark - specified in `:marks' argument." - (let* ((entry-type-str (symbol-name entry-type)) - (prefix (concat "guix-" entry-type-str "-list")) - (mode-str (concat prefix "-mode")) - (init-fun (intern (concat prefix "-mode-initialize"))) - (marks-var (intern (concat prefix "-mark-alist"))) - (marks-val nil) - (sort-key nil) - (invert-sort nil)) - - ;; Process the keyword args. - (while (keywordp (car args)) - (pcase (pop args) - (`:sort-key (setq sort-key (pop args))) - (`:invert-sort (setq invert-sort (pop args))) - (`:marks (setq marks-val (pop args))) - (_ (pop args)))) - - `(progn - (defvar ,marks-var ',marks-val - ,(concat "Alist of additional marks for `" mode-str "'.\n" - "Marks from this list are added to `guix-list-mark-alist'.")) - - ,@(mapcar (lambda (mark-spec) - (let* ((mark-name (car mark-spec)) - (mark-name-str (symbol-name mark-name))) - `(defun ,(intern (concat prefix "-mark-" mark-name-str "-simple")) () - ,(concat "Put '" mark-name-str "' mark and move to the next line.\n" - "Also add the current entry to `guix-list-marked'.") - (interactive) - (guix-list--mark ',mark-name t)))) - marks-val) - - (defun ,init-fun () - ,(concat "Initial settings for `" mode-str "'.") - ,(when sort-key - `(setq tabulated-list-sort-key - (guix-list-get-sort-key - ',entry-type ',sort-key ,invert-sort))) - (setq tabulated-list-format - (guix-list-get-list-format ',entry-type)) - (setq-local guix-list-mark-alist - (append guix-list-mark-alist ,marks-var)) - (tabulated-list-init-header))))) - -(put 'guix-list-define-entry-type 'lisp-indent-function 'defun) - -(defun guix-list-describe-maybe (entry-type ids) - "Describe ENTRY-TYPE entries in info buffer using list of IDS." - (let ((count (length ids))) - (when (or (<= count guix-list-describe-warning-count) - (y-or-n-p (format "Do you really want to describe %d entries? " - count))) - (apply #'guix-get-show-entries - guix-profile 'info entry-type 'id ids)))) - -(defun guix-list-describe (&optional arg) - "Describe entries marked with a general mark. -If no entries are marked, describe the current entry. -With prefix (if ARG is non-nil), describe entries marked with any mark." - (interactive "P") - (let ((ids (or (apply #'guix-list-get-marked-id-list - (unless arg '(general))) - (list (guix-list-current-id))))) - (guix-list-describe-maybe guix-entry-type ids))) - -(defun guix-list-edit-package () - "Go to the location of the current package." - (interactive) - (guix-edit (guix-list-current-package-id))) - - -;;; Displaying packages - -(guix-define-buffer-type list package) - -(guix-list-define-entry-type package - :sort-key name - :marks ((install . ?I) - (upgrade . ?U) - (delete . ?D))) - -(defface guix-package-list-installed - '((t :inherit guix-package-info-installed-outputs)) - "Face used if there are installed outputs for the current package." - :group 'guix-package-list-faces) - -(defface guix-package-list-obsolete - '((t :inherit guix-package-info-obsolete)) - "Face used if a package is obsolete." - :group 'guix-package-list-faces) - -(defcustom guix-package-list-generation-marking-enabled nil - "If non-nil, allow putting marks in a list with 'generation packages'. - -By default this is disabled, because it may be confusing. For -example a package is installed in some generation, so a user can -mark it for deletion in the list of packages from this -generation, but the package may not be installed in the latest -generation, so actually it cannot be deleted. - -If you managed to understand the explanation above or if you -really know what you do or if you just don't care, you can set -this variable to t. It should not do much harm anyway (most -likely)." - :type 'boolean - :group 'guix-package-list) - -(let ((map guix-package-list-mode-map)) - (define-key map (kbd "e") 'guix-list-edit-package) - (define-key map (kbd "x") 'guix-package-list-execute) - (define-key map (kbd "i") 'guix-package-list-mark-install) - (define-key map (kbd "d") 'guix-package-list-mark-delete) - (define-key map (kbd "U") 'guix-package-list-mark-upgrade) - (define-key map (kbd "^") 'guix-package-list-mark-upgrades)) - -(defun guix-package-list-get-name (name entry) - "Return NAME of the package ENTRY. -Colorize it with `guix-package-list-installed' or -`guix-package-list-obsolete' if needed." - (guix-get-string name - (cond ((guix-assq-value entry 'obsolete) - 'guix-package-list-obsolete) - ((guix-assq-value entry 'installed) - 'guix-package-list-installed)))) - -(defun guix-package-list-get-installed-outputs (installed &optional _) - "Return string with outputs from INSTALLED entries." - (guix-get-string - (mapcar (lambda (entry) - (guix-assq-value entry 'output)) - installed))) - -(defun guix-package-list-marking-check () - "Signal an error if marking is disabled for the current buffer." - (when (and (not guix-package-list-generation-marking-enabled) - (or (derived-mode-p 'guix-package-list-mode) - (derived-mode-p 'guix-output-list-mode)) - (eq guix-search-type 'generation)) - (error "Action marks are disabled for lists of 'generation packages'"))) - -(defun guix-package-list-mark-outputs (mark default - &optional prompt available) - "Mark the current package with MARK and move to the next line. -If PROMPT is non-nil, use it to ask a user for outputs from -AVAILABLE list, otherwise mark all DEFAULT outputs." - (let ((outputs (if prompt - (guix-completing-read-multiple - prompt available nil t) - default))) - (apply #'guix-list--mark mark t outputs))) - -(defun guix-package-list-mark-install (&optional arg) - "Mark the current package for installation and move to the next line. -With ARG, prompt for the outputs to install (several outputs may -be separated with \",\")." - (interactive "P") - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (all (guix-assq-value entry 'outputs)) - (installed (guix-get-installed-outputs entry)) - (available (cl-set-difference all installed :test #'string=))) - (or available - (user-error "This package is already installed")) - (guix-package-list-mark-outputs - 'install '("out") - (and arg "Output(s) to install: ") - available))) - -(defun guix-package-list-mark-delete (&optional arg) - "Mark the current package for deletion and move to the next line. -With ARG, prompt for the outputs to delete (several outputs may -be separated with \",\")." - (interactive "P") - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (installed (guix-get-installed-outputs entry))) - (or installed - (user-error "This package is not installed")) - (guix-package-list-mark-outputs - 'delete installed - (and arg "Output(s) to delete: ") - installed))) - -(defun guix-package-list-mark-upgrade (&optional arg) - "Mark the current package for upgrading and move to the next line. -With ARG, prompt for the outputs to upgrade (several outputs may -be separated with \",\")." - (interactive "P") - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (installed (guix-get-installed-outputs entry))) - (or installed - (user-error "This package is not installed")) - (when (or (guix-assq-value entry 'obsolete) - (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? ")) - (guix-package-list-mark-outputs - 'upgrade installed - (and arg "Output(s) to upgrade: ") - installed)))) - -(defun guix-list-mark-package-upgrades (fun) - "Mark all obsolete packages for upgrading. -Use FUN to perform marking of the current line. FUN should -accept an entry as argument." - (guix-package-list-marking-check) - (let ((obsolete (cl-remove-if-not - (lambda (entry) - (guix-assq-value entry 'obsolete)) - guix-entries))) - (guix-list-for-each-line - (lambda () - (let* ((id (guix-list-current-id)) - (entry (cl-find-if - (lambda (entry) - (equal id (guix-assq-value entry 'id))) - obsolete))) - (when entry - (funcall fun entry))))))) - -(defun guix-package-list-mark-upgrades () - "Mark all obsolete packages for upgrading." - (interactive) - (guix-list-mark-package-upgrades - (lambda (entry) - (apply #'guix-list--mark - 'upgrade nil - (guix-get-installed-outputs entry))))) - -(defun guix-list-execute-package-actions (fun) - "Perform actions on the marked packages. -Use FUN to define actions suitable for `guix-process-package-actions'. -FUN should accept action-type as argument." - (let ((actions (delq nil - (mapcar fun '(install delete upgrade))))) - (if actions - (guix-process-package-actions - guix-profile actions (current-buffer)) - (user-error "No operations specified")))) - -(defun guix-package-list-execute () - "Perform actions on the marked packages." - (interactive) - (guix-list-execute-package-actions #'guix-package-list-make-action)) + "Parent mode for displaying data in 'list' form.") + +(defun guix-list-mode-initialize (entry-type) + "Set up the current 'list' buffer for displaying ENTRY-TYPE entries." + (setq tabulated-list-padding 2 + tabulated-list-format (guix-list-tabulated-format entry-type) + tabulated-list-sort-key (guix-list-tabulated-sort-key entry-type)) + (setq-local guix-list-marks (guix-list-marks entry-type)) + (tabulated-list-init-header)) + +(defmacro guix-list-define-interface (entry-type &rest args) + "Define 'list' interface for displaying ENTRY-TYPE entries. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... + +Required keywords: + + - `:format' - default value of the generated + `guix-ENTRY-TYPE-list-format' variable. + +Optional keywords: + + - `:sort-key' - default value of the generated + `guix-ENTRY-TYPE-list-sort-key' variable. + + - `:describe-function' - default value of the generated + `guix-ENTRY-TYPE-describe-function' variable. + + - `:list-single?' - default value of the generated + `guix-ENTRY-TYPE-list-single' variable. + + - `:marks' - default value of the generated + `guix-ENTRY-TYPE-list-marks' variable. + +The rest keyword arguments are passed to +`guix-buffer-define-interface' macro." + (declare (indent 1)) + (let* ((entry-type-str (symbol-name entry-type)) + (prefix (concat "guix-" entry-type-str "-list")) + (group (intern prefix)) + (describe-var (intern (concat prefix "-describe-function"))) + (describe-count-var (intern (concat prefix + "-describe-warning-count"))) + (format-var (intern (concat prefix "-format"))) + (sort-key-var (intern (concat prefix "-sort-key"))) + (list-single-var (intern (concat prefix "-single"))) + (marks-var (intern (concat prefix "-marks")))) + (guix-keyword-args-let args + ((show-entries-val :show-entries-function) + (describe-val :describe-function) + (describe-count-val :describe-count 10) + (format-val :format) + (sort-key-val :sort-key) + (list-single-val :list-single?) + (marks-val :marks)) + `(progn + (defcustom ,format-var ,format-val + ,(format "\ +List of format values of the displayed columns. +Each element of the list has a form: -(defun guix-package-list-make-action (action-type) - "Return action specification for the packages marked with ACTION-TYPE. -Return nil, if there are no packages marked with ACTION-TYPE. -The specification is suitable for `guix-process-package-actions'." - (let ((specs (guix-list-get-marked-args action-type))) - (and specs (cons action-type specs)))) + (PARAM VALUE-FUN WIDTH SORT . PROPS) + +PARAM is a name of '%s' entry parameter. + +VALUE-FUN may be either nil or a function returning a value that +will be inserted. The function is called with 2 arguments: the +first one is the value of the parameter; the second one is an +entry (alist of parameter names and values). + +For the meaning of WIDTH, SORT and PROPS, see +`tabulated-list-format'." + entry-type-str) + :type 'sexp + :group ',group) + + (defcustom ,sort-key-var ,sort-key-val + ,(format "\ +Default sort key for 'list' buffer with '%s' entries. +Should be nil (no sort) or have a form: + + (PARAM . FLIP) + +PARAM is the name of '%s' entry parameter. For the meaning of +FLIP, see `tabulated-list-sort-key'." + entry-type-str entry-type-str) + :type '(choice (const :tag "No sort" nil) + (cons symbol boolean)) + :group ',group) + + (defvar ,marks-var ,marks-val + ,(format "\ +Alist of additional marks for 'list' buffer with '%s' entries. +Marks from this list are used along with `guix-list-default-marks'." + entry-type-str)) + + (defcustom ,list-single-var ,list-single-val + ,(format "\ +If non-nil, list '%s' entry even if it is the only matching result. +If nil, show a single '%s' entry in the 'info' buffer." + entry-type-str entry-type-str) + :type 'boolean + :group ',group) + + (defcustom ,describe-count-var ,describe-count-val + ,(format "\ +The maximum number of '%s' entries to describe without a warning. +If a user wants to describe more than this number of marked +entries, he will be prompted for confirmation. +See also `guix-list-describe'." + entry-type-str) + :type 'integer + :group ',group) + + (defvar ,describe-var ,describe-val + ,(format "Function used to describe '%s' entries." + entry-type-str)) + + (guix-alist-put! + '((describe . ,describe-var) + (describe-count . ,describe-count-var) + (format . ,format-var) + (sort-key . ,sort-key-var) + (list-single . ,list-single-var) + (marks . ,marks-var)) + 'guix-list-data ',entry-type) + + ,(if show-entries-val + `(guix-buffer-define-interface list ,entry-type + :show-entries-function ,show-entries-val + ,@%foreign-args) + + (let ((insert-fun (intern (concat prefix "-insert-entries"))) + (mode-init-fun (intern (concat prefix "-mode-initialize")))) + `(progn + (defun ,insert-fun (entries) + ,(format "\ +Print '%s' ENTRIES in the current 'list' buffer." + entry-type-str) + (guix-list-insert-entries entries ',entry-type)) + + (defun ,mode-init-fun () + ,(format "\ +Set up the current 'list' buffer for displaying '%s' entries." + entry-type-str) + (guix-list-mode-initialize ',entry-type)) + + (guix-buffer-define-interface list ,entry-type + :insert-entries-function ',insert-fun + :mode-init-function ',mode-init-fun + ,@%foreign-args)))))))) -;;; Displaying outputs - -(guix-define-buffer-type list output - :buffer-name "*Guix Package List*" - :required (package-id)) - -(guix-list-define-entry-type output - :sort-key name - :marks ((install . ?I) - (upgrade . ?U) - (delete . ?D))) - -(let ((map guix-output-list-mode-map)) - (define-key map (kbd "RET") 'guix-output-list-describe) - (define-key map (kbd "e") 'guix-list-edit-package) - (define-key map (kbd "x") 'guix-output-list-execute) - (define-key map (kbd "i") 'guix-output-list-mark-install) - (define-key map (kbd "d") 'guix-output-list-mark-delete) - (define-key map (kbd "U") 'guix-output-list-mark-upgrade) - (define-key map (kbd "^") 'guix-output-list-mark-upgrades)) - -(defun guix-output-list-mark-install () - "Mark the current output for installation and move to the next line." - (interactive) - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (installed (guix-assq-value entry 'installed))) - (if installed - (user-error "This output is already installed") - (guix-list--mark 'install t)))) - -(defun guix-output-list-mark-delete () - "Mark the current output for deletion and move to the next line." - (interactive) - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (installed (guix-assq-value entry 'installed))) - (if installed - (guix-list--mark 'delete t) - (user-error "This output is not installed")))) - -(defun guix-output-list-mark-upgrade () - "Mark the current output for deletion and move to the next line." - (interactive) - (guix-package-list-marking-check) - (let* ((entry (guix-list-current-entry)) - (installed (guix-assq-value entry 'installed))) - (or installed - (user-error "This output is not installed")) - (when (or (guix-assq-value entry 'obsolete) - (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? ")) - (guix-list--mark 'upgrade t)))) - -(defun guix-output-list-mark-upgrades () - "Mark all obsolete package outputs for upgrading." - (interactive) - (guix-list-mark-package-upgrades - (lambda (_) (guix-list--mark 'upgrade)))) - -(defun guix-output-list-execute () - "Perform actions on the marked outputs." - (interactive) - (guix-list-execute-package-actions #'guix-output-list-make-action)) - -(defun guix-output-list-make-action (action-type) - "Return action specification for the outputs marked with ACTION-TYPE. -Return nil, if there are no outputs marked with ACTION-TYPE. -The specification is suitable for `guix-process-output-actions'." - (let ((ids (guix-list-get-marked-id-list action-type))) - (and ids (cons action-type - (mapcar #'guix-get-package-id-and-output-by-output-id - ids))))) - -(defun guix-output-list-describe (&optional arg) - "Describe outputs or packages marked with a general mark. -If no entries are marked, describe the current output or package. -With prefix (if ARG is non-nil), describe entries marked with any mark. -Also see `guix-package-info-type'." - (interactive "P") - (if (eq guix-package-info-type 'output) - (guix-list-describe arg) - (let* ((oids (or (apply #'guix-list-get-marked-id-list - (unless arg '(general))) - (list (guix-list-current-id)))) - (pids (mapcar (lambda (oid) - (car (guix-get-package-id-and-output-by-output-id - oid))) - oids))) - (guix-list-describe-maybe 'package (cl-remove-duplicates pids))))) +(defvar guix-list-font-lock-keywords + (eval-when-compile + `((,(rx "(" (group "guix-list-define-interface") + symbol-end) + . 1)))) - -;;; Displaying generations - -(guix-define-buffer-type list generation) - -(guix-list-define-entry-type generation - :sort-key number - :invert-sort t - :marks ((delete . ?D))) - -(let ((map guix-generation-list-mode-map)) - (define-key map (kbd "RET") 'guix-generation-list-show-packages) - (define-key map (kbd "+") 'guix-generation-list-show-added-packages) - (define-key map (kbd "-") 'guix-generation-list-show-removed-packages) - (define-key map (kbd "=") 'guix-generation-list-diff) - (define-key map (kbd "D") 'guix-generation-list-diff) - (define-key map (kbd "e") 'guix-generation-list-ediff) - (define-key map (kbd "x") 'guix-generation-list-execute) - (define-key map (kbd "i") 'guix-list-describe) - (define-key map (kbd "s") 'guix-generation-list-switch) - (define-key map (kbd "d") 'guix-generation-list-mark-delete)) - -(defun guix-generation-list-get-current (val &optional _) - "Return string from VAL showing whether this generation is current. -VAL is a boolean value." - (if val "(current)" "")) - -(defun guix-generation-list-switch () - "Switch current profile to the generation at point." - (interactive) - (let* ((entry (guix-list-current-entry)) - (current (guix-assq-value entry 'current)) - (number (guix-assq-value entry 'number))) - (if current - (user-error "This generation is already the current one") - (guix-switch-to-generation guix-profile number (current-buffer))))) - -(defun guix-generation-list-show-packages () - "List installed packages for the generation at point." - (interactive) - (guix-get-show-entries guix-profile 'list guix-package-list-type - 'generation (guix-list-current-id))) - -(defun guix-generation-list-generations-to-compare () - "Return a sorted list of 2 marked generations for comparing." - (let ((numbers (guix-list-get-marked-id-list 'general))) - (if (/= (length numbers) 2) - (user-error "2 generations should be marked for comparing") - (sort numbers #'<)))) - -(defun guix-generation-list-show-added-packages () - "List package outputs added to the latest marked generation. -If 2 generations are marked with \\[guix-list-mark], display -outputs installed in the latest marked generation that were not -installed in the other one." - (interactive) - (apply #'guix-get-show-entries - guix-profile 'list 'output 'generation-diff - (reverse (guix-generation-list-generations-to-compare)))) - -(defun guix-generation-list-show-removed-packages () - "List package outputs removed from the latest marked generation. -If 2 generations are marked with \\[guix-list-mark], display -outputs not installed in the latest marked generation that were -installed in the other one." - (interactive) - (apply #'guix-get-show-entries - guix-profile 'list 'output 'generation-diff - (guix-generation-list-generations-to-compare))) - -(defun guix-generation-list-compare (diff-fun gen-fun) - "Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results." - (cl-multiple-value-bind (gen1 gen2) - (guix-generation-list-generations-to-compare) - (funcall diff-fun - (funcall gen-fun gen1) - (funcall gen-fun gen2)))) - -(defun guix-generation-list-ediff-manifests () - "Run Ediff on manifests of the 2 marked generations." - (interactive) - (guix-generation-list-compare - #'ediff-files - #'guix-profile-generation-manifest-file)) - -(defun guix-generation-list-diff-manifests () - "Run Diff on manifests of the 2 marked generations." - (interactive) - (guix-generation-list-compare - #'guix-diff - #'guix-profile-generation-manifest-file)) - -(defun guix-generation-list-ediff-packages () - "Run Ediff on package outputs installed in the 2 marked generations." - (interactive) - (guix-generation-list-compare - #'ediff-buffers - #'guix-profile-generation-packages-buffer)) - -(defun guix-generation-list-diff-packages () - "Run Diff on package outputs installed in the 2 marked generations." - (interactive) - (guix-generation-list-compare - #'guix-diff - #'guix-profile-generation-packages-buffer)) - -(defun guix-generation-list-ediff (arg) - "Run Ediff on package outputs installed in the 2 marked generations. -With ARG, run Ediff on manifests of the marked generations." - (interactive "P") - (if arg - (guix-generation-list-ediff-manifests) - (guix-generation-list-ediff-packages))) - -(defun guix-generation-list-diff (arg) - "Run Diff on package outputs installed in the 2 marked generations. -With ARG, run Diff on manifests of the marked generations." - (interactive "P") - (if arg - (guix-generation-list-diff-manifests) - (guix-generation-list-diff-packages))) - -(defun guix-generation-list-mark-delete (&optional arg) - "Mark the current generation for deletion and move to the next line. -With ARG, mark all generations for deletion." - (interactive "P") - (if arg - (guix-list-mark-all 'delete) - (guix-list--mark 'delete t))) - -(defun guix-generation-list-execute () - "Delete marked generations." - (interactive) - (let ((marked (guix-list-get-marked-id-list 'delete))) - (or marked - (user-error "No generations marked for deletion")) - (guix-delete-generations guix-profile marked (current-buffer)))) +(font-lock-add-keywords 'emacs-lisp-mode guix-list-font-lock-keywords) (provide 'guix-list) diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index 7175b103da..6f9eb422e0 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -58,7 +58,6 @@ (guix licenses) (guix utils) (guix ui) - (guix scripts graph) (guix scripts lint) (guix scripts package) (guix scripts pull) @@ -989,7 +988,8 @@ Return #t if the shell command was executed successfully." (define (graph-type-names) "Return a list of names of available graph node types." - (map node-type-name %node-types)) + (map (@ (guix graph) node-type-name) + (@ (guix scripts graph) %node-types))) (define (refresh-updater-names) "Return a list of names of available refresh updater types." diff --git a/emacs/guix-messages.el b/emacs/guix-messages.el index 2bf99de6fa..eb2a76e216 100644 --- a/emacs/guix-messages.el +++ b/emacs/guix-messages.el @@ -31,9 +31,8 @@ (defvar guix-messages `((package (id - (0 "Packages not found.") - (1 "") - (many "%d packages." count)) + ,(lambda (_ entries ids) + (guix-message-packages-by-id entries 'package ids))) (name ,(lambda (_ entries names) (guix-message-packages-by-name entries 'package names))) @@ -67,9 +66,8 @@ (output (id - (0 "Package outputs not found.") - (1 "") - (many "%d package outputs." count)) + ,(lambda (_ entries ids) + (guix-message-packages-by-id entries 'output ids))) (name ,(lambda (_ entries names) (guix-message-packages-by-name entries 'output names))) @@ -147,6 +145,22 @@ (guix-message-string-entry-type entry-type 'plural))))) +(defun guix-message-packages-by-id (entries entry-type ids) + "Display a message for packages or outputs searched by IDS." + (let* ((count (length entries)) + (str-beg (guix-message-string-entries count entry-type)) + (str-end (if (> count 1) + (concat "with the following IDs: " + (mapconcat #'guix-get-string ids ", ")) + (concat "with ID " (guix-get-string (car ids)))))) + (if (zerop count) + (message "%s %s. +Most likely, Guix REPL was restarted, so IDs are not actual +anymore, because they live only during the REPL process. +Try \"M-x guix-search-by-name\"." + str-beg str-end) + (message "%s %s." str-beg str-end)))) + (defun guix-message-packages-by-name (entries entry-type names) "Display a message for packages or outputs searched by NAMES." (let* ((count (length entries)) diff --git a/emacs/guix-read.el b/emacs/guix-read.el index e60af9c2f7..3bc7b16587 100644 --- a/emacs/guix-read.el +++ b/emacs/guix-read.el @@ -26,95 +26,40 @@ (require 'guix-help-vars) (require 'guix-utils) -(require 'guix-base) - -(defun guix-read-file-name (prompt &optional dir default-filename - mustmatch initial predicate) - "Read file name. -This function is similar to `read-file-name' except it also -expands the file name." - (expand-file-name (read-file-name prompt dir default-filename - mustmatch initial predicate))) - -(defmacro guix-define-reader (name read-fun completions prompt) - "Define NAME function to read from minibuffer. -READ-FUN may be `completing-read', `completing-read-multiple' or -another function with the same arguments." - `(defun ,name (&optional prompt initial-contents) - (,read-fun ,(if prompt - `(or prompt ,prompt) - 'prompt) - ,completions nil nil initial-contents))) - -(defmacro guix-define-readers (&rest args) - "Define reader functions. - -ARGS should have a form [KEYWORD VALUE] ... The following -keywords are available: - - - `completions-var' - variable used to get completions. - - - `completions-getter' - function used to get completions. - - - `single-reader', `single-prompt' - name of a function to read - a single value, and a prompt for it. - - - `multiple-reader', `multiple-prompt' - name of a function to - read multiple values, and a prompt for it. - - - `multiple-separator' - if specified, another - `<multiple-reader-name>-string' function returning a string - of multiple values separated the specified separator will be - defined." - (let (completions-var - completions-getter - single-reader - single-prompt - multiple-reader - multiple-prompt - multiple-separator) - - ;; Process the keyword args. - (while (keywordp (car args)) - (pcase (pop args) - (`:completions-var (setq completions-var (pop args))) - (`:completions-getter (setq completions-getter (pop args))) - (`:single-reader (setq single-reader (pop args))) - (`:single-prompt (setq single-prompt (pop args))) - (`:multiple-reader (setq multiple-reader (pop args))) - (`:multiple-prompt (setq multiple-prompt (pop args))) - (`:multiple-separator (setq multiple-separator (pop args))) - (_ (pop args)))) - - (let ((completions - (cond ((and completions-var completions-getter) - `(or ,completions-var - (setq ,completions-var - (funcall ',completions-getter)))) - (completions-var - completions-var) - (completions-getter - `(funcall ',completions-getter))))) - `(progn - ,(when (and completions-var - (not (boundp completions-var))) - `(defvar ,completions-var nil)) - - ,(when single-reader - `(guix-define-reader ,single-reader completing-read - ,completions ,single-prompt)) - - ,(when multiple-reader - `(guix-define-reader ,multiple-reader completing-read-multiple - ,completions ,multiple-prompt)) - - ,(when (and multiple-reader multiple-separator) - (let ((name (intern (concat (symbol-name multiple-reader) - "-string")))) - `(defun ,name (&optional prompt initial-contents) - (guix-concat-strings - (,multiple-reader prompt initial-contents) - ,multiple-separator)))))))) +(require 'guix-backend) +(require 'guix-guile) + + +;;; Receivable lists of packages, lint checkers, etc. + +(guix-memoized-defun guix-graph-type-names () + "Return a list of names of available graph node types." + (guix-eval-read (guix-make-guile-expression 'graph-type-names))) + +(guix-memoized-defun guix-refresh-updater-names () + "Return a list of names of available refresh updater types." + (guix-eval-read (guix-make-guile-expression 'refresh-updater-names))) + +(guix-memoized-defun guix-lint-checker-names () + "Return a list of names of available lint checkers." + (guix-eval-read (guix-make-guile-expression 'lint-checker-names))) + +(guix-memoized-defun guix-package-names () + "Return a list of names of available packages." + (sort + ;; Work around <https://github.com/jaor/geiser/issues/64>: + ;; list of strings is parsed much slower than list of lists, + ;; so we use 'package-names-lists' instead of 'package-names'. + + ;; (guix-eval-read (guix-make-guile-expression 'package-names)) + + (mapcar #'car + (guix-eval-read (guix-make-guile-expression + 'package-names-lists))) + #'string<)) + + +;;; Readers (guix-define-readers :completions-var guix-help-system-types diff --git a/emacs/guix-ui-generation.el b/emacs/guix-ui-generation.el new file mode 100644 index 0000000000..aa71645b4e --- /dev/null +++ b/emacs/guix-ui-generation.el @@ -0,0 +1,433 @@ +;;; guix-ui-generation.el --- Interface for displaying generations -*- lexical-binding: t -*- + +;; Copyright © 2014, 2015 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 an interface for displaying profile generations in +;; 'list' and 'info' buffers, and commands for working with them. + +;;; Code: + +(require 'cl-lib) +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-info) +(require 'guix-ui) +(require 'guix-ui-package) +(require 'guix-base) +(require 'guix-backend) +(require 'guix-guile) +(require 'guix-entry) +(require 'guix-utils) + +(guix-ui-define-entry-type generation) + +(defun guix-generation-get-display (profile search-type &rest search-values) + "Search for generations and show results. + +If PROFILE is nil, use `guix-current-profile'. + +See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and +SEARCH-VALUES." + (apply #'guix-list-get-display-entries + 'generation + (or profile guix-current-profile) + search-type search-values)) + +(defun guix-delete-generations (profile generations + &optional operation-buffer) + "Delete GENERATIONS from PROFILE. +Each element from GENERATIONS is a generation number." + (when (or (not guix-operation-confirm) + (y-or-n-p + (let ((count (length generations))) + (if (> count 1) + (format "Delete %d generations from profile '%s'? " + count profile) + (format "Delete generation %d from profile '%s'? " + (car generations) profile))))) + (guix-eval-in-repl + (guix-make-guile-expression + 'delete-generations* profile generations) + operation-buffer))) + +(defun guix-switch-to-generation (profile generation + &optional operation-buffer) + "Switch PROFILE to GENERATION." + (when (or (not guix-operation-confirm) + (y-or-n-p (format "Switch profile '%s' to generation %d? " + profile generation))) + (guix-eval-in-repl + (guix-make-guile-expression + 'switch-to-generation* profile generation) + operation-buffer))) + + +;;; Generation 'info' + +(guix-ui-info-define-interface generation + :buffer-name "*Guix Generation Info*" + :format '((number format guix-generation-info-insert-number) + (prev-number format (format)) + (current format guix-generation-info-insert-current) + (path simple (indent guix-file)) + (time format (time))) + :titles '((path . "File name") + (prev-number . "Previous number"))) + +(defface guix-generation-info-number + '((t :inherit font-lock-keyword-face)) + "Face used for a number of a generation." + :group 'guix-generation-info-faces) + +(defface guix-generation-info-current + '((t :inherit guix-package-info-installed-outputs)) + "Face used if a generation is the current one." + :group 'guix-generation-info-faces) + +(defface guix-generation-info-not-current + '((t nil)) + "Face used if a generation is not the current one." + :group 'guix-generation-info-faces) + +(defun guix-generation-info-insert-number (number &optional _) + "Insert generation NUMBER and action buttons." + (guix-info-insert-value-format number 'guix-generation-info-number) + (guix-info-insert-indent) + (guix-info-insert-action-button + "Packages" + (lambda (btn) + (guix-buffer-get-display-entries + 'list guix-package-list-type + (list (guix-ui-current-profile) + 'generation (button-get btn 'number)) + 'add)) + "Show installed packages for this generation" + 'number number) + (guix-info-insert-indent) + (guix-info-insert-action-button + "Delete" + (lambda (btn) + (guix-delete-generations (guix-ui-current-profile) + (list (button-get btn 'number)) + (current-buffer))) + "Delete this generation" + 'number number)) + +(defun guix-generation-info-insert-current (val entry) + "Insert boolean value VAL showing whether this generation is current." + (if val + (guix-info-insert-value-format "Yes" 'guix-generation-info-current) + (guix-info-insert-value-format "No" 'guix-generation-info-not-current) + (guix-info-insert-indent) + (guix-info-insert-action-button + "Switch" + (lambda (btn) + (guix-switch-to-generation (guix-ui-current-profile) + (button-get btn 'number) + (current-buffer))) + "Switch to this generation (make it the current one)" + 'number (guix-entry-value entry 'number)))) + + +;;; Generation 'list' + +(guix-ui-list-define-interface generation + :buffer-name "*Guix Generation List*" + :format '((number nil 5 guix-list-sort-numerically-0 :right-align t) + (current guix-generation-list-get-current 10 t) + (time guix-list-get-time 20 t) + (path guix-list-get-file-path 30 t)) + :titles '((number . "N.")) + :sort-key '(number . t) + :marks '((delete . ?D))) + +(let ((map guix-generation-list-mode-map)) + (define-key map (kbd "RET") 'guix-generation-list-show-packages) + (define-key map (kbd "+") 'guix-generation-list-show-added-packages) + (define-key map (kbd "-") 'guix-generation-list-show-removed-packages) + (define-key map (kbd "=") 'guix-generation-list-diff) + (define-key map (kbd "D") 'guix-generation-list-diff) + (define-key map (kbd "e") 'guix-generation-list-ediff) + (define-key map (kbd "x") 'guix-generation-list-execute) + (define-key map (kbd "s") 'guix-generation-list-switch) + (define-key map (kbd "c") 'guix-generation-list-switch) + (define-key map (kbd "d") 'guix-generation-list-mark-delete)) + +(defun guix-generation-list-get-current (val &optional _) + "Return string from VAL showing whether this generation is current. +VAL is a boolean value." + (if val "(current)" "")) + +(defun guix-generation-list-switch () + "Switch current profile to the generation at point." + (interactive) + (let* ((entry (guix-list-current-entry)) + (current (guix-entry-value entry 'current)) + (number (guix-entry-value entry 'number))) + (if current + (user-error "This generation is already the current one") + (guix-switch-to-generation (guix-ui-current-profile) + number (current-buffer))))) + +(defun guix-generation-list-show-packages () + "List installed packages for the generation at point." + (interactive) + (guix-package-get-display + (guix-ui-current-profile) + 'generation (guix-list-current-id))) + +(defun guix-generation-list-generations-to-compare () + "Return a sorted list of 2 marked generations for comparing." + (let ((numbers (guix-list-get-marked-id-list 'general))) + (if (/= (length numbers) 2) + (user-error "2 generations should be marked for comparing") + (sort numbers #'<)))) + +(defun guix-generation-list-show-added-packages () + "List package outputs added to the latest marked generation. +If 2 generations are marked with \\[guix-list-mark], display +outputs installed in the latest marked generation that were not +installed in the other one." + (interactive) + (guix-buffer-get-display-entries + 'list 'output + (cl-list* (guix-ui-current-profile) + 'generation-diff + (reverse (guix-generation-list-generations-to-compare))) + 'add)) + +(defun guix-generation-list-show-removed-packages () + "List package outputs removed from the latest marked generation. +If 2 generations are marked with \\[guix-list-mark], display +outputs not installed in the latest marked generation that were +installed in the other one." + (interactive) + (guix-buffer-get-display-entries + 'list 'output + (cl-list* (guix-ui-current-profile) + 'generation-diff + (guix-generation-list-generations-to-compare)) + 'add)) + +(defun guix-generation-list-compare (diff-fun gen-fun) + "Run GEN-FUN on the 2 marked generations and run DIFF-FUN on the results." + (cl-multiple-value-bind (gen1 gen2) + (guix-generation-list-generations-to-compare) + (funcall diff-fun + (funcall gen-fun gen1) + (funcall gen-fun gen2)))) + +(defun guix-generation-list-ediff-manifests () + "Run Ediff on manifests of the 2 marked generations." + (interactive) + (guix-generation-list-compare + #'ediff-files + #'guix-profile-generation-manifest-file)) + +(defun guix-generation-list-diff-manifests () + "Run Diff on manifests of the 2 marked generations." + (interactive) + (guix-generation-list-compare + #'guix-diff + #'guix-profile-generation-manifest-file)) + +(defun guix-generation-list-ediff-packages () + "Run Ediff on package outputs installed in the 2 marked generations." + (interactive) + (guix-generation-list-compare + #'ediff-buffers + #'guix-profile-generation-packages-buffer)) + +(defun guix-generation-list-diff-packages () + "Run Diff on package outputs installed in the 2 marked generations." + (interactive) + (guix-generation-list-compare + #'guix-diff + #'guix-profile-generation-packages-buffer)) + +(defun guix-generation-list-ediff (arg) + "Run Ediff on package outputs installed in the 2 marked generations. +With ARG, run Ediff on manifests of the marked generations." + (interactive "P") + (if arg + (guix-generation-list-ediff-manifests) + (guix-generation-list-ediff-packages))) + +(defun guix-generation-list-diff (arg) + "Run Diff on package outputs installed in the 2 marked generations. +With ARG, run Diff on manifests of the marked generations." + (interactive "P") + (if arg + (guix-generation-list-diff-manifests) + (guix-generation-list-diff-packages))) + +(defun guix-generation-list-mark-delete (&optional arg) + "Mark the current generation for deletion and move to the next line. +With ARG, mark all generations for deletion." + (interactive "P") + (if arg + (guix-list-mark-all 'delete) + (guix-list--mark 'delete t))) + +(defun guix-generation-list-execute () + "Delete marked generations." + (interactive) + (let ((marked (guix-list-get-marked-id-list 'delete))) + (or marked + (user-error "No generations marked for deletion")) + (guix-delete-generations (guix-ui-current-profile) + marked (current-buffer)))) + + +;;; Inserting packages to compare generations + +(defcustom guix-generation-packages-buffer-name-function + #'guix-generation-packages-buffer-name-default + "Function used to define name of a buffer with generation packages. +This function is called with 2 arguments: PROFILE (string) and +GENERATION (number)." + :type '(choice (function-item guix-generation-packages-buffer-name-default) + (function-item guix-generation-packages-buffer-name-long) + (function :tag "Other function")) + :group 'guix-generation) + +(defcustom guix-generation-packages-update-buffer t + "If non-nil, always update list of packages during comparing generations. +If nil, generation packages are received only once. So when you +compare generation 1 and generation 2, the packages for both +generations will be received. Then if you compare generation 1 +and generation 3, only the packages for generation 3 will be +received. Thus if you use comparing of different generations a +lot, you may set this variable to nil to improve the +performance." + :type 'boolean + :group 'guix-generation) + +(defvar guix-generation-output-name-width 30 + "Width of an output name \"column\". +This variable is used in auxiliary buffers for comparing generations.") + +(defun guix-generation-packages (profile generation) + "Return a list of sorted packages installed in PROFILE's GENERATION. +Each element of the list is a list of the package specification +and its store path." + (let ((names+paths (guix-eval-read + (guix-make-guile-expression + 'generation-package-specifications+paths + profile generation)))) + (sort names+paths + (lambda (a b) + (string< (car a) (car b)))))) + +(defun guix-generation-packages-buffer-name-default (profile generation) + "Return name of a buffer for displaying GENERATION's package outputs. +Use base name of PROFILE file name." + (let ((profile-name (file-name-base (directory-file-name profile)))) + (format "*Guix %s: generation %s*" + profile-name generation))) + +(defun guix-generation-packages-buffer-name-long (profile generation) + "Return name of a buffer for displaying GENERATION's package outputs. +Use the full PROFILE file name." + (format "*Guix generation %s (%s)*" + generation profile)) + +(defun guix-generation-packages-buffer-name (profile generation) + "Return name of a buffer for displaying GENERATION's package outputs." + (funcall guix-generation-packages-buffer-name-function + profile generation)) + +(defun guix-generation-insert-package (name path) + "Insert package output NAME and store PATH at point." + (insert name) + (indent-to guix-generation-output-name-width 2) + (insert path "\n")) + +(defun guix-generation-insert-packages (buffer profile generation) + "Insert package outputs installed in PROFILE's GENERATION in BUFFER." + (with-current-buffer buffer + (setq buffer-read-only nil + indent-tabs-mode nil) + (erase-buffer) + (mapc (lambda (name+path) + (guix-generation-insert-package + (car name+path) (cadr name+path))) + (guix-generation-packages profile generation)))) + +(defun guix-generation-packages-buffer (profile generation) + "Return buffer with package outputs installed in PROFILE's GENERATION. +Create the buffer if needed." + (let ((buf-name (guix-generation-packages-buffer-name + profile generation))) + (or (and (null guix-generation-packages-update-buffer) + (get-buffer buf-name)) + (let ((buf (get-buffer-create buf-name))) + (guix-generation-insert-packages buf profile generation) + buf)))) + +(defun guix-profile-generation-manifest-file (generation) + "Return the file name of a GENERATION's manifest. +GENERATION is a generation number of the current profile." + (guix-manifest-file (guix-ui-current-profile) generation)) + +(defun guix-profile-generation-packages-buffer (generation) + "Insert GENERATION's package outputs in a buffer and return it. +GENERATION is a generation number of the current profile." + (guix-generation-packages-buffer (guix-ui-current-profile) + generation)) + + +;;; Interactive commands + +;;;###autoload +(defun guix-generations (&optional profile) + "Display information about all generations. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive (list (guix-ui-read-profile))) + (guix-generation-get-display profile 'all)) + +;;;###autoload +(defun guix-last-generations (number &optional profile) + "Display information about last NUMBER generations. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (read-number "The number of last generations: ") + (guix-ui-read-profile))) + (guix-generation-get-display profile 'last number)) + +;;;###autoload +(defun guix-generations-by-time (from to &optional profile) + "Display information about generations created between FROM and TO. +FROM and TO should be time values. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (guix-read-date "Find generations (from): ") + (guix-read-date "Find generations (to): ") + (guix-ui-read-profile))) + (guix-generation-get-display profile 'time + (float-time from) + (float-time to))) + +(provide 'guix-ui-generation) + +;;; guix-ui-generation.el ends here diff --git a/emacs/guix-ui-package.el b/emacs/guix-ui-package.el new file mode 100644 index 0000000000..e0c98eaed6 --- /dev/null +++ b/emacs/guix-ui-package.el @@ -0,0 +1,955 @@ +;;; guix-ui-package.el --- Interface for displaying packages -*- lexical-binding: t -*- + +;; Copyright © 2014, 2015 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 an interface for displaying packages and outputs +;; in 'list' and 'info' buffers, and commands for working with them. + +;;; Code: + +(require 'cl-lib) +(require 'guix-buffer) +(require 'guix-list) +(require 'guix-info) +(require 'guix-ui) +(require 'guix-base) +(require 'guix-backend) +(require 'guix-guile) +(require 'guix-entry) +(require 'guix-utils) +(require 'guix-hydra-build) + +(guix-ui-define-entry-type package) +(guix-ui-define-entry-type output) + +(defcustom guix-package-list-type 'output + "Define how to display packages in 'list' buffer. +Should be a symbol `package' or `output' (if `output', display each +output on a separate line; if `package', display each package on +a separate line)." + :type '(choice (const :tag "List of packages" package) + (const :tag "List of outputs" output)) + :group 'guix-package) + +(defcustom guix-package-info-type 'package + "Define how to display packages in 'info' buffer. +Should be a symbol `package' or `output' (if `output', display +each output separately; if `package', display outputs inside +package data)." + :type '(choice (const :tag "Display packages" package) + (const :tag "Display outputs" output)) + :group 'guix-package) + +(defun guix-package-get-display (profile search-type &rest search-values) + "Search for packages/outputs and show results. + +If PROFILE is nil, use `guix-current-profile'. + +See `guix-ui-get-entries' for the meaning of SEARCH-TYPE and +SEARCH-VALUES. + +Results are displayed in the list buffer, unless a single package +is found and `guix-package-list-single' is nil." + (let* ((args (cl-list* (or profile guix-current-profile) + search-type search-values)) + (entries (guix-buffer-get-entries + 'list guix-package-list-type args))) + (if (or guix-package-list-single + (null entries) + (cdr entries)) + (guix-buffer-display-entries + entries 'list guix-package-list-type args 'add) + (guix-buffer-get-display-entries + 'info guix-package-info-type args 'add)))) + +(defun guix-package-entry->name-specification (entry &optional output) + "Return name specification of the package ENTRY and OUTPUT." + (guix-package-name-specification + (guix-entry-value entry 'name) + (guix-entry-value entry 'version) + (or output (guix-entry-value entry 'output)))) + +(defun guix-package-entries->name-specifications (entries) + "Return name specifications by the package or output ENTRIES." + (cl-remove-duplicates (mapcar #'guix-package-entry->name-specification + entries) + :test #'string=)) + +(defun guix-package-installed-outputs (entry) + "Return a list of installed outputs for the package ENTRY." + (mapcar (lambda (installed-entry) + (guix-entry-value installed-entry 'output)) + (guix-entry-value entry 'installed))) + +(defun guix-package-id-and-output-by-output-id (output-id) + "Return a list (PACKAGE-ID OUTPUT) by OUTPUT-ID." + (cl-multiple-value-bind (package-id-str output) + (split-string output-id ":") + (let ((package-id (string-to-number package-id-str))) + (list (if (= 0 package-id) package-id-str package-id) + output)))) + + +;;; Processing package actions + +(defun guix-process-package-actions (profile actions + &optional operation-buffer) + "Process package ACTIONS on PROFILE. +Each action is a list of the form: + + (ACTION-TYPE PACKAGE-SPEC ...) + +ACTION-TYPE is one of the following symbols: `install', +`upgrade', `remove'/`delete'. +PACKAGE-SPEC should have the following form: (ID [OUTPUT] ...)." + (let (install upgrade remove) + (mapc (lambda (action) + (let ((action-type (car action)) + (specs (cdr action))) + (cl-case action-type + (install (setq install (append install specs))) + (upgrade (setq upgrade (append upgrade specs))) + ((remove delete) (setq remove (append remove specs)))))) + actions) + (when (guix-continue-package-operation-p + profile + :install install :upgrade upgrade :remove remove) + (guix-eval-in-repl + (guix-make-guile-expression + 'process-package-actions profile + :install install :upgrade upgrade :remove remove + :use-substitutes? (or guix-use-substitutes 'f) + :dry-run? (or guix-dry-run 'f)) + (and (not guix-dry-run) operation-buffer))))) + +(cl-defun guix-continue-package-operation-p (profile + &key install upgrade remove) + "Return non-nil if a package operation should be continued. +Ask a user if needed (see `guix-operation-confirm'). +INSTALL, UPGRADE, REMOVE are 'package action specifications'. +See `guix-process-package-actions' for details." + (or (null guix-operation-confirm) + (let* ((entries (guix-ui-get-entries + profile 'package 'id + (append (mapcar #'car install) + (mapcar #'car upgrade) + (mapcar #'car remove)) + '(id name version location))) + (install-strings (guix-get-package-strings install entries)) + (upgrade-strings (guix-get-package-strings upgrade entries)) + (remove-strings (guix-get-package-strings remove entries))) + (if (or install-strings upgrade-strings remove-strings) + (let ((buf (get-buffer-create guix-temp-buffer-name))) + (with-current-buffer buf + (setq-local cursor-type nil) + (setq buffer-read-only nil) + (erase-buffer) + (insert "Profile: " profile "\n\n") + (guix-insert-package-strings install-strings "install") + (guix-insert-package-strings upgrade-strings "upgrade") + (guix-insert-package-strings remove-strings "remove") + (let ((win (temp-buffer-window-show + buf + '((display-buffer-reuse-window + display-buffer-at-bottom) + (window-height . fit-window-to-buffer))))) + (prog1 (guix-operation-prompt) + (quit-window nil win))))) + (message "Nothing to be done. +If Guix REPL was restarted, the data is not up-to-date.") + nil)))) + +(defun guix-get-package-strings (specs entries) + "Return short package descriptions for performing package actions. +See `guix-process-package-actions' for the meaning of SPECS. +ENTRIES is a list of package entries to get info about packages." + (delq nil + (mapcar + (lambda (spec) + (let* ((id (car spec)) + (outputs (cdr spec)) + (entry (guix-entry-by-id id entries))) + (when entry + (let ((location (guix-entry-value entry 'location))) + (concat (guix-package-entry->name-specification entry) + (when outputs + (concat ":" + (guix-concat-strings outputs ","))) + (when location + (concat "\t(" location ")"))))))) + specs))) + +(defun guix-insert-package-strings (strings action) + "Insert information STRINGS at point for performing package ACTION." + (when strings + (insert "Package(s) to " (propertize action 'face 'bold) ":\n") + (mapc (lambda (str) + (insert " " str "\n")) + strings) + (insert "\n"))) + + +;;; Package 'info' + +(guix-ui-info-define-interface package + :buffer-name "*Guix Package Info*" + :format '(guix-package-info-insert-heading + ignore + (synopsis ignore (simple guix-package-info-synopsis)) + ignore + (description ignore (simple guix-package-info-description)) + ignore + (outputs simple guix-package-info-insert-outputs) + (source simple guix-package-info-insert-source) + (location format (format guix-package-location)) + (home-url format (format guix-url)) + (license format (format guix-package-info-license)) + (inputs format (format guix-package-input)) + (native-inputs format (format guix-package-native-input)) + (propagated-inputs format + (format guix-package-propagated-input))) + :titles '((home-url . "Home page")) + :required '(id name version installed non-unique)) + +(guix-info-define-interface installed-output + :format '((path simple (indent guix-file)) + (dependencies simple (indent guix-file))) + :titles '((path . "Store directory")) + :reduced? t) + +(defface guix-package-info-heading + '((t :inherit guix-info-heading)) + "Face for package name and version headings." + :group 'guix-package-info-faces) + +(defface guix-package-info-name + '((t :inherit font-lock-keyword-face)) + "Face used for a name of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-name-button + '((t :inherit button)) + "Face used for a full name that can be used to describe a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-version + '((t :inherit font-lock-builtin-face)) + "Face used for a version of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-synopsis + '((((type tty pc) (class color)) :weight bold) + (t :height 1.1 :weight bold :inherit variable-pitch)) + "Face used for a synopsis of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-description + '((t)) + "Face used for a description of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-license + '((t :inherit font-lock-string-face)) + "Face used for a license of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-location + '((t :inherit link)) + "Face used for a location of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-source + '((t :inherit link :underline nil)) + "Face used for a source URL of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-installed-outputs + '((default :weight bold) + (((class color) (min-colors 88) (background light)) + :foreground "ForestGreen") + (((class color) (min-colors 88) (background dark)) + :foreground "PaleGreen") + (((class color) (min-colors 8)) + :foreground "green") + (t :underline t)) + "Face used for installed outputs of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-uninstalled-outputs + '((t :weight bold)) + "Face used for uninstalled outputs of a package." + :group 'guix-package-info-faces) + +(defface guix-package-info-obsolete + '((t :inherit error)) + "Face used if a package is obsolete." + :group 'guix-package-info-faces) + +(defcustom guix-package-info-auto-find-source nil + "If non-nil, find a source file after pressing a \"Show\" button. +If nil, just display the source file path without finding." + :type 'boolean + :group 'guix-package-info) + +(defcustom guix-package-info-auto-download-source t + "If nil, do not automatically download a source file if it doesn't exist. +After pressing a \"Show\" button, a derivation of the package +source is calculated and a store file path is displayed. If this +variable is non-nil and the source file does not exist in the +store, it will be automatically downloaded (with a possible +prompt depending on `guix-operation-confirm' variable)." + :type 'boolean + :group 'guix-package-info) + +(defvar guix-package-info-download-buffer nil + "Buffer from which a current download operation was performed.") + +(defvar guix-package-info-output-format "%-10s" + "String used to format output names of the packages. +It should be a '%s'-sequence. After inserting an output name +formatted with this string, an action button is inserted.") + +(defvar guix-package-info-obsolete-string "(This package is obsolete)" + "String used if a package is obsolete.") + +(define-button-type 'guix-package-location + :supertype 'guix + 'face 'guix-package-info-location + 'help-echo "Find location of this package" + 'action (lambda (btn) + (guix-find-location (button-label btn)))) + +(define-button-type 'guix-package-name + :supertype 'guix + 'face 'guix-package-info-name-button + 'help-echo "Describe this package" + 'action (lambda (btn) + (guix-buffer-get-display-entries-current + 'info guix-package-info-type + (list (guix-ui-current-profile) + 'name (button-label btn)) + 'add))) + +(define-button-type 'guix-package-source + :supertype 'guix + 'face 'guix-package-info-source + 'help-echo "" + 'action (lambda (_) + ;; As a source may not be a real URL (e.g., "mirror://..."), + ;; no action is bound to a source button. + (message "Yes, this is the source URL. What did you expect?"))) + +(defun guix-package-info-insert-heading (entry) + "Insert package ENTRY heading (name specification) at point." + (guix-insert-button + (guix-package-entry->name-specification entry) + 'guix-package-name + 'face 'guix-package-info-heading)) + +(defmacro guix-package-info-define-insert-inputs (&optional type) + "Define a face and a function for inserting package inputs. +TYPE is a type of inputs. +Function name is `guix-package-info-insert-TYPE-inputs'. +Face name is `guix-package-info-TYPE-inputs'." + (let* ((type-str (symbol-name type)) + (type-name (and type (concat type-str "-"))) + (type-desc (and type (concat type-str " "))) + (face (intern (concat "guix-package-info-" type-name "inputs"))) + (btn (intern (concat "guix-package-" type-name "input")))) + `(progn + (defface ,face + '((t :inherit guix-package-info-name-button)) + ,(concat "Face used for " type-desc "inputs of a package.") + :group 'guix-package-info-faces) + + (define-button-type ',btn + :supertype 'guix-package-name + 'face ',face)))) + +(guix-package-info-define-insert-inputs) +(guix-package-info-define-insert-inputs native) +(guix-package-info-define-insert-inputs propagated) + +(defun guix-package-info-insert-outputs (outputs entry) + "Insert OUTPUTS from package ENTRY at point." + (and (guix-entry-value entry 'obsolete) + (guix-package-info-insert-obsolete-text)) + (and (guix-entry-value entry 'non-unique) + (guix-entry-value entry 'installed) + (guix-package-info-insert-non-unique-text + (guix-package-entry->name-specification entry))) + (insert "\n") + (dolist (output outputs) + (guix-package-info-insert-output output entry))) + +(defun guix-package-info-insert-obsolete-text () + "Insert a message about obsolete package at point." + (guix-info-insert-indent) + (guix-format-insert guix-package-info-obsolete-string + 'guix-package-info-obsolete)) + +(defun guix-package-info-insert-non-unique-text (full-name) + "Insert a message about non-unique package with FULL-NAME at point." + (insert "\n") + (guix-info-insert-indent) + (insert "Installed outputs are displayed for a non-unique ") + (guix-insert-button full-name 'guix-package-name) + (insert " package.")) + +(defun guix-package-info-insert-output (output entry) + "Insert OUTPUT at point. +Make some fancy text with buttons and additional stuff if the +current OUTPUT is installed (if there is such output in +`installed' parameter of a package ENTRY)." + (let* ((installed (guix-entry-value entry 'installed)) + (obsolete (guix-entry-value entry 'obsolete)) + (installed-entry (cl-find-if + (lambda (entry) + (string= (guix-entry-value entry 'output) + output)) + installed)) + (action-type (if installed-entry 'delete 'install))) + (guix-info-insert-indent) + (guix-format-insert output + (if installed-entry + 'guix-package-info-installed-outputs + 'guix-package-info-uninstalled-outputs) + guix-package-info-output-format) + (guix-package-info-insert-action-button action-type entry output) + (when obsolete + (guix-info-insert-indent) + (guix-package-info-insert-action-button 'upgrade entry output)) + (insert "\n") + (when installed-entry + (guix-info-insert-entry installed-entry 'installed-output 2)))) + +(defun guix-package-info-insert-action-button (type entry output) + "Insert button to process an action on a package OUTPUT at point. +TYPE is one of the following symbols: `install', `delete', `upgrade'. +ENTRY is an alist with package info." + (let ((type-str (capitalize (symbol-name type))) + (full-name (guix-package-entry->name-specification entry output))) + (guix-info-insert-action-button + type-str + (lambda (btn) + (guix-process-package-actions + (guix-ui-current-profile) + `((,(button-get btn 'action-type) (,(button-get btn 'id) + ,(button-get btn 'output)))) + (current-buffer))) + (concat type-str " '" full-name "'") + 'action-type type + 'id (or (guix-entry-value entry 'package-id) + (guix-entry-id entry)) + 'output output))) + +(defun guix-package-info-show-source (entry-id package-id) + "Show file name of a package source in the current info buffer. +Find the file if needed (see `guix-package-info-auto-find-source'). +ENTRY-ID is an ID of the current entry (package or output). +PACKAGE-ID is an ID of the package which source to show." + (let* ((entries (guix-buffer-current-entries)) + (entry (guix-entry-by-id entry-id entries)) + (file (guix-package-source-path package-id))) + (or file + (error "Couldn't define file name of the package source")) + (let* ((new-entry (cons (cons 'source-file file) + entry)) + (new-entries (guix-replace-entry entry-id new-entry entries))) + (setf (guix-buffer-item-entries guix-buffer-item) + new-entries) + (guix-buffer-redisplay-goto-button) + (if (file-exists-p file) + (if guix-package-info-auto-find-source + (guix-find-file file) + (message "The source store path is displayed.")) + (if guix-package-info-auto-download-source + (guix-package-info-download-source package-id) + (message "The source does not exist in the store.")))))) + +(defun guix-package-info-download-source (package-id) + "Download a source of the package PACKAGE-ID." + (setq guix-package-info-download-buffer (current-buffer)) + (guix-package-source-build-derivation + package-id + "The source does not exist in the store. Download it?")) + +(defun guix-package-info-insert-source (source entry) + "Insert SOURCE from package ENTRY at point. +SOURCE is a list of URLs." + (if (null source) + (guix-format-insert nil) + (let* ((source-file (guix-entry-value entry 'source-file)) + (entry-id (guix-entry-id entry)) + (package-id (or (guix-entry-value entry 'package-id) + entry-id))) + (if (null source-file) + (guix-info-insert-action-button + "Show" + (lambda (btn) + (guix-package-info-show-source (button-get btn 'entry-id) + (button-get btn 'package-id))) + "Show the source store directory of the current package" + 'entry-id entry-id + 'package-id package-id) + (unless (file-exists-p source-file) + (guix-info-insert-action-button + "Download" + (lambda (btn) + (guix-package-info-download-source + (button-get btn 'package-id))) + "Download the source into the store" + 'package-id package-id)) + (guix-info-insert-value-indent source-file 'guix-file)) + (guix-info-insert-value-indent source 'guix-package-source)))) + +(defun guix-package-info-redisplay-after-download () + "Redisplay an 'info' buffer after downloading the package source. +This function is used to hide a \"Download\" button if needed." + (when (buffer-live-p guix-package-info-download-buffer) + (with-current-buffer guix-package-info-download-buffer + (guix-buffer-redisplay-goto-button)) + (setq guix-package-info-download-buffer nil))) + +(add-hook 'guix-after-source-download-hook + 'guix-package-info-redisplay-after-download) + + +;;; Package 'list' + +(guix-ui-list-define-interface package + :buffer-name "*Guix Package List*" + :format '((name guix-package-list-get-name 20 t) + (version nil 10 nil) + (outputs nil 13 t) + (installed guix-package-list-get-installed-outputs 13 t) + (synopsis guix-list-get-one-line 30 nil)) + :sort-key '(name) + :marks '((install . ?I) + (upgrade . ?U) + (delete . ?D))) + +(let ((map guix-package-list-mode-map)) + (define-key map (kbd "B") 'guix-package-list-latest-builds) + (define-key map (kbd "e") 'guix-package-list-edit) + (define-key map (kbd "x") 'guix-package-list-execute) + (define-key map (kbd "i") 'guix-package-list-mark-install) + (define-key map (kbd "d") 'guix-package-list-mark-delete) + (define-key map (kbd "U") 'guix-package-list-mark-upgrade) + (define-key map (kbd "^") 'guix-package-list-mark-upgrades)) + +(defface guix-package-list-installed + '((t :inherit guix-package-info-installed-outputs)) + "Face used if there are installed outputs for the current package." + :group 'guix-package-list-faces) + +(defface guix-package-list-obsolete + '((t :inherit guix-package-info-obsolete)) + "Face used if a package is obsolete." + :group 'guix-package-list-faces) + +(defcustom guix-package-list-generation-marking-enabled nil + "If non-nil, allow putting marks in a list with 'generation packages'. + +By default this is disabled, because it may be confusing. For +example, a package is installed in some generation, so a user can +mark it for deletion in the list of packages from this +generation, but the package may not be installed in the latest +generation, so actually it cannot be deleted. + +If you managed to understand the explanation above or if you +really know what you do or if you just don't care, you can set +this variable to t. It should not do much harm anyway (most +likely)." + :type 'boolean + :group 'guix-package-list) + +(defun guix-package-list-get-name (name entry) + "Return NAME of the package ENTRY. +Colorize it with `guix-package-list-installed' or +`guix-package-list-obsolete' if needed." + (guix-get-string name + (cond ((guix-entry-value entry 'obsolete) + 'guix-package-list-obsolete) + ((guix-entry-value entry 'installed) + 'guix-package-list-installed)))) + +(defun guix-package-list-get-installed-outputs (installed &optional _) + "Return string with outputs from INSTALLED entries." + (guix-get-string + (mapcar (lambda (entry) + (guix-entry-value entry 'output)) + installed))) + +(defun guix-package-list-marking-check () + "Signal an error if marking is disabled for the current buffer." + (when (and (not guix-package-list-generation-marking-enabled) + (or (derived-mode-p 'guix-package-list-mode) + (derived-mode-p 'guix-output-list-mode)) + (eq (guix-ui-current-search-type) 'generation)) + (error "Action marks are disabled for lists of 'generation packages'"))) + +(defun guix-package-list-mark-outputs (mark default + &optional prompt available) + "Mark the current package with MARK and move to the next line. +If PROMPT is non-nil, use it to ask a user for outputs from +AVAILABLE list, otherwise mark all DEFAULT outputs." + (let ((outputs (if prompt + (guix-completing-read-multiple + prompt available nil t) + default))) + (apply #'guix-list--mark mark t outputs))) + +(defun guix-package-list-mark-install (&optional arg) + "Mark the current package for installation and move to the next line. +With ARG, prompt for the outputs to install (several outputs may +be separated with \",\")." + (interactive "P") + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (all (guix-entry-value entry 'outputs)) + (installed (guix-package-installed-outputs entry)) + (available (cl-set-difference all installed :test #'string=))) + (or available + (user-error "This package is already installed")) + (guix-package-list-mark-outputs + 'install '("out") + (and arg "Output(s) to install: ") + available))) + +(defun guix-package-list-mark-delete (&optional arg) + "Mark the current package for deletion and move to the next line. +With ARG, prompt for the outputs to delete (several outputs may +be separated with \",\")." + (interactive "P") + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-package-installed-outputs entry))) + (or installed + (user-error "This package is not installed")) + (guix-package-list-mark-outputs + 'delete installed + (and arg "Output(s) to delete: ") + installed))) + +(defun guix-package-list-mark-upgrade (&optional arg) + "Mark the current package for upgrading and move to the next line. +With ARG, prompt for the outputs to upgrade (several outputs may +be separated with \",\")." + (interactive "P") + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-package-installed-outputs entry))) + (or installed + (user-error "This package is not installed")) + (when (or (guix-entry-value entry 'obsolete) + (y-or-n-p "This package is not obsolete. Try to upgrade it anyway? ")) + (guix-package-list-mark-outputs + 'upgrade installed + (and arg "Output(s) to upgrade: ") + installed)))) + +(defun guix-package-mark-upgrades (fun) + "Mark all obsolete packages for upgrading. +Use FUN to perform marking of the current line. FUN should +take an entry as argument." + (guix-package-list-marking-check) + (let ((obsolete (cl-remove-if-not + (lambda (entry) + (guix-entry-value entry 'obsolete)) + (guix-buffer-current-entries)))) + (guix-list-for-each-line + (lambda () + (let* ((id (guix-list-current-id)) + (entry (cl-find-if + (lambda (entry) + (equal id (guix-entry-id entry))) + obsolete))) + (when entry + (funcall fun entry))))))) + +(defun guix-package-list-mark-upgrades () + "Mark all obsolete packages for upgrading." + (interactive) + (guix-package-mark-upgrades + (lambda (entry) + (apply #'guix-list--mark + 'upgrade nil + (guix-package-installed-outputs entry))))) + +(defun guix-package-execute-actions (fun) + "Perform actions on the marked packages. +Use FUN to define actions suitable for `guix-process-package-actions'. +FUN should take action-type as argument." + (let ((actions (delq nil + (mapcar fun '(install delete upgrade))))) + (if actions + (guix-process-package-actions (guix-ui-current-profile) + actions (current-buffer)) + (user-error "No operations specified")))) + +(defun guix-package-list-execute () + "Perform actions on the marked packages." + (interactive) + (guix-package-execute-actions #'guix-package-list-make-action)) + +(defun guix-package-list-make-action (action-type) + "Return action specification for the packages marked with ACTION-TYPE. +Return nil, if there are no packages marked with ACTION-TYPE. +The specification is suitable for `guix-process-package-actions'." + (let ((specs (guix-list-get-marked-args action-type))) + (and specs (cons action-type specs)))) + +(defun guix-package-list-edit () + "Go to the location of the current package." + (interactive) + (guix-edit (guix-list-current-id))) + +(defun guix-package-list-latest-builds (number &rest args) + "Display latest NUMBER of Hydra builds of the current package. +Interactively, prompt for NUMBER. With prefix argument, prompt +for all ARGS." + (interactive + (let ((entry (guix-list-current-entry))) + (guix-hydra-build-latest-prompt-args + :job (guix-package-name-specification + (guix-entry-value entry 'name) + (guix-entry-value entry 'version))))) + (apply #'guix-hydra-latest-builds number args)) + + +;;; Output 'info' + +(guix-ui-info-define-interface output + :buffer-name "*Guix Package Info*" + :format '((name format (format guix-package-info-name)) + (version format guix-output-info-insert-version) + (output format guix-output-info-insert-output) + (synopsis simple (indent guix-package-info-synopsis)) + (source simple guix-package-info-insert-source) + (path simple (indent guix-file)) + (dependencies simple (indent guix-file)) + (location format (format guix-package-location)) + (home-url format (format guix-url)) + (license format (format guix-package-info-license)) + (inputs format (format guix-package-input)) + (native-inputs format (format guix-package-native-input)) + (propagated-inputs format + (format guix-package-propagated-input)) + (description simple (indent guix-package-info-description))) + :titles guix-package-info-titles + :required '(id package-id installed non-unique)) + +(defun guix-output-info-insert-version (version entry) + "Insert output VERSION and obsolete text if needed at point." + (guix-info-insert-value-format version + 'guix-package-info-version) + (and (guix-entry-value entry 'obsolete) + (guix-package-info-insert-obsolete-text))) + +(defun guix-output-info-insert-output (output entry) + "Insert OUTPUT and action buttons at point." + (let* ((installed (guix-entry-value entry 'installed)) + (obsolete (guix-entry-value entry 'obsolete)) + (action-type (if installed 'delete 'install))) + (guix-info-insert-value-format + output + (if installed + 'guix-package-info-installed-outputs + 'guix-package-info-uninstalled-outputs)) + (guix-info-insert-indent) + (guix-package-info-insert-action-button action-type entry output) + (when obsolete + (guix-info-insert-indent) + (guix-package-info-insert-action-button 'upgrade entry output)))) + + +;;; Output 'list' + +(guix-ui-list-define-interface output + :buffer-name "*Guix Package List*" + :describe-function 'guix-output-list-describe + :format '((name guix-package-list-get-name 20 t) + (version nil 10 nil) + (output nil 9 t) + (installed nil 12 t) + (synopsis guix-list-get-one-line 30 nil)) + :required '(id package-id) + :sort-key '(name) + :marks '((install . ?I) + (upgrade . ?U) + (delete . ?D))) + +(let ((map guix-output-list-mode-map)) + (define-key map (kbd "B") 'guix-package-list-latest-builds) + (define-key map (kbd "e") 'guix-output-list-edit) + (define-key map (kbd "x") 'guix-output-list-execute) + (define-key map (kbd "i") 'guix-output-list-mark-install) + (define-key map (kbd "d") 'guix-output-list-mark-delete) + (define-key map (kbd "U") 'guix-output-list-mark-upgrade) + (define-key map (kbd "^") 'guix-output-list-mark-upgrades)) + +(defun guix-output-list-mark-install () + "Mark the current output for installation and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-entry-value entry 'installed))) + (if installed + (user-error "This output is already installed") + (guix-list--mark 'install t)))) + +(defun guix-output-list-mark-delete () + "Mark the current output for deletion and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-entry-value entry 'installed))) + (if installed + (guix-list--mark 'delete t) + (user-error "This output is not installed")))) + +(defun guix-output-list-mark-upgrade () + "Mark the current output for upgrading and move to the next line." + (interactive) + (guix-package-list-marking-check) + (let* ((entry (guix-list-current-entry)) + (installed (guix-entry-value entry 'installed))) + (or installed + (user-error "This output is not installed")) + (when (or (guix-entry-value entry 'obsolete) + (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? ")) + (guix-list--mark 'upgrade t)))) + +(defun guix-output-list-mark-upgrades () + "Mark all obsolete package outputs for upgrading." + (interactive) + (guix-package-mark-upgrades + (lambda (_) (guix-list--mark 'upgrade)))) + +(defun guix-output-list-execute () + "Perform actions on the marked outputs." + (interactive) + (guix-package-execute-actions #'guix-output-list-make-action)) + +(defun guix-output-list-make-action (action-type) + "Return action specification for the outputs marked with ACTION-TYPE. +Return nil, if there are no outputs marked with ACTION-TYPE. +The specification is suitable for `guix-process-output-actions'." + (let ((ids (guix-list-get-marked-id-list action-type))) + (and ids (cons action-type + (mapcar #'guix-package-id-and-output-by-output-id + ids))))) + +(defun guix-output-list-describe (ids) + "Describe outputs with IDS (list of output identifiers). +See `guix-package-info-type'." + (if (eq guix-package-info-type 'output) + (guix-buffer-get-display-entries + 'info 'output + (cl-list* (guix-ui-current-profile) 'id ids) + 'add) + (let ((pids (mapcar (lambda (oid) + (car (guix-package-id-and-output-by-output-id + oid))) + ids))) + (guix-buffer-get-display-entries + 'info 'package + (cl-list* (guix-ui-current-profile) + 'id (cl-remove-duplicates pids)) + 'add)))) + +(defun guix-output-list-edit () + "Go to the location of the current package." + (interactive) + (guix-edit (guix-entry-value (guix-list-current-entry) + 'package-id))) + + +;;; Interactive commands + +(defvar guix-package-search-params '(name synopsis description) + "Default list of package parameters for searching by regexp.") + +(defvar guix-package-search-history nil + "A history of minibuffer prompts.") + +;;;###autoload +(defun guix-search-by-name (name &optional profile) + "Search for Guix packages by NAME. +NAME is a string with name specification. It may optionally contain +a version number. Examples: \"guile\", \"guile-2.0.11\". + +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (read-string "Package name: " nil 'guix-package-search-history) + (guix-ui-read-profile))) + (guix-package-get-display profile 'name name)) + +;;;###autoload +(defun guix-search-by-regexp (regexp &optional params profile) + "Search for Guix packages by REGEXP. +PARAMS are package parameters that should be searched. +If PARAMS are not specified, use `guix-package-search-params'. + +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive + (list (read-regexp "Regexp: " nil 'guix-package-search-history) + nil (guix-ui-read-profile))) + (guix-package-get-display profile 'regexp regexp + (or params guix-package-search-params))) + +;;;###autoload +(defun guix-installed-packages (&optional profile) + "Display information about installed Guix packages. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive (list (guix-ui-read-profile))) + (guix-package-get-display profile 'installed)) + +;;;###autoload +(defun guix-obsolete-packages (&optional profile) + "Display information about obsolete Guix packages. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive (list (guix-ui-read-profile))) + (guix-package-get-display profile 'obsolete)) + +;;;###autoload +(defun guix-all-available-packages (&optional profile) + "Display information about all available Guix packages. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive (list (guix-ui-read-profile))) + (guix-package-get-display profile 'all-available)) + +;;;###autoload +(defun guix-newest-available-packages (&optional profile) + "Display information about the newest available Guix packages. +If PROFILE is nil, use `guix-current-profile'. +Interactively with prefix, prompt for PROFILE." + (interactive (list (guix-ui-read-profile))) + (guix-package-get-display profile 'newest-available)) + +(provide 'guix-ui-package) + +;;; guix-ui-package.el ends here diff --git a/emacs/guix-ui.el b/emacs/guix-ui.el new file mode 100644 index 0000000000..7fef7c355c --- /dev/null +++ b/emacs/guix-ui.el @@ -0,0 +1,333 @@ +;;; guix-ui.el --- Common code for Guix package management interface -*- lexical-binding: t -*- + +;; Copyright © 2014, 2015 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 some general code for 'list'/'info' interfaces for +;; packages and generations. + +;;; Code: + +(require 'cl-lib) +(require 'guix-backend) +(require 'guix-buffer) +(require 'guix-guile) +(require 'guix-utils) +(require 'guix-messages) + +(guix-define-groups ui + :group-doc "\ +Settings for 'ui' (Guix package management) buffers. +This group includes settings for displaying packages, outputs and +generations in 'list' and 'info' buffers.") + +(defvar guix-ui-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "M") 'guix-apply-manifest) + (define-key map (kbd "C-c C-z") 'guix-switch-to-repl) + map) + "Parent keymap for Guix package/generation buffers.") + +(guix-buffer-define-current-args-accessors + "guix-ui-current" "profile" "search-type" "search-values") + +(defun guix-ui-read-profile () + "Return `guix-current-profile' or prompt for it. +This function is intended for using in `interactive' forms." + (if current-prefix-arg + (guix-profile-prompt) + guix-current-profile)) + +(defun guix-ui-get-entries (profile entry-type search-type search-values + &optional params) + "Receive ENTRY-TYPE entries for PROFILE. +Call an appropriate scheme procedure and return a list of entries. + +ENTRY-TYPE should be one of the following symbols: `package', +`output' or `generation'. + +SEARCH-TYPE may be one of the following symbols: + +- If ENTRY-TYPE is `package' or `output': `id', `name', `regexp', + `all-available', `newest-available', `installed', `obsolete', + `generation'. + +- If ENTRY-TYPE is `generation': `id', `last', `all', `time'. + +PARAMS is a list of parameters for receiving. If nil, get data +with all available parameters." + (guix-eval-read + (guix-make-guile-expression + 'entries + profile params entry-type search-type search-values))) + +(defun guix-ui-list-describe (ids) + "Describe 'ui' entries with IDS (list of identifiers)." + (guix-buffer-get-display-entries + 'info (guix-buffer-current-entry-type) + (cl-list* (guix-ui-current-profile) 'id ids) + 'add)) + + +;;; Buffers and auto updating + +(defcustom guix-ui-update-after-operation 'current + "Define what kind of data to update after executing an operation. + +After successful executing an operation in the Guix REPL (for +example after installing a package), the data in Guix buffers +will or will not be automatically updated depending on a value of +this variable. + +If nil, update nothing (do not revert any buffer). +If `current', update the buffer from which an operation was performed. +If `all', update all Guix buffers (not recommended)." + :type '(choice (const :tag "Do nothing" nil) + (const :tag "Update operation buffer" current) + (const :tag "Update all Guix buffers" all)) + :group 'guix-ui) + +(defcustom guix-ui-buffer-name-function + #'guix-ui-buffer-name-default + "Function used to define a name of a Guix buffer. +The function is called with 2 arguments: BASE-NAME and PROFILE." + :type '(choice (function-item guix-ui-buffer-name-default) + (function-item guix-ui-buffer-name-simple) + (function :tag "Other function")) + :group 'guix-ui) + +(defun guix-ui-buffer-name-simple (base-name &rest _) + "Return BASE-NAME." + base-name) + +;; TODO separate '*...*' logic from the real profile appending. Also add +;; another function to return '*Guix ...: /full/path/to/profile*' name. +(defun guix-ui-buffer-name-default (base-name profile) + "Return buffer name by appending BASE-NAME and PROFILE's base file name." + (let ((profile-name (file-name-base (directory-file-name profile))) + (re (rx string-start + (group (? "*")) + (group (*? any)) + (group (? "*")) + string-end))) + (or (string-match re base-name) + (error "Unexpected error in defining guix buffer name")) + (let ((first* (match-string 1 base-name)) + (name-body (match-string 2 base-name)) + (last* (match-string 3 base-name))) + ;; Handle the case when buffer name is wrapped by '*'. + (if (and (string= "*" first*) + (string= "*" last*)) + (concat "*" name-body ": " profile-name "*") + (concat base-name ": " profile-name))))) + +(defun guix-ui-buffer-name (base-name profile) + "Return Guix buffer name based on BASE-NAME and profile. +See `guix-ui-buffer-name-function' for details." + (funcall guix-ui-buffer-name-function + base-name profile)) + +(defun guix-ui-buffer? (&optional buffer modes) + "Return non-nil if BUFFER mode is derived from any of the MODES. +If BUFFER is nil, check current buffer. +If MODES is nil, use `guix-list-mode' and `guix-info-mode'." + (with-current-buffer (or buffer (current-buffer)) + (apply #'derived-mode-p + (or modes '(guix-list-mode guix-info-mode))))) + +(defun guix-ui-buffers (&optional modes) + "Return a list of all buffers with major modes derived from MODES. +If MODES is nil, return list of all Guix 'list' and 'info' buffers." + (cl-remove-if-not (lambda (buf) + (guix-ui-buffer? buf modes)) + (buffer-list))) + +(defun guix-ui-update-buffer (buffer) + "Update data in a 'list' or 'info' BUFFER." + (with-current-buffer buffer + (guix-buffer-revert nil t))) + +(defun guix-ui-update-buffers-after-operation () + "Update buffers after Guix operation if needed. +See `guix-ui-update-after-operation' for details." + (let ((to-update + (and guix-operation-buffer + (cl-case guix-ui-update-after-operation + (current (and (buffer-live-p guix-operation-buffer) + (guix-ui-buffer? guix-operation-buffer) + (list guix-operation-buffer))) + (all (guix-ui-buffers)))))) + (setq guix-operation-buffer nil) + (mapc #'guix-ui-update-buffer to-update))) + +(add-hook 'guix-after-repl-operation-hook + 'guix-ui-update-buffers-after-operation) + + +;;; Interface definers + +(defmacro guix-ui-define-entry-type (entry-type &rest args) + "Define general code for ENTRY-TYPE. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... + +The rest keyword arguments are passed to +`guix-define-entry-type' macro." + (declare (indent 1)) + `(guix-define-entry-type ,entry-type + :parent-group guix-ui + :parent-faces-group guix-ui-faces + ,@args)) + +(defmacro guix-ui-define-interface (buffer-type entry-type &rest args) + "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... +In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE. + +Required keywords: + + - `:buffer-name' - base part of a buffer name. It is used in a + generated `guix-TYPE-buffer-name' function; see + `guix-ui-buffer-name' for details. + +Optional keywords: + + - `:required' - default value of the generated + `guix-TYPE-required-params' variable. + +The rest keyword arguments are passed to +`guix-BUFFER-TYPE-define-interface' macro. + +Along with the mentioned definitions, this macro also defines: + + - `guix-TYPE-mode-map' - keymap based on `guix-ui-map' and + `guix-BUFFER-TYPE-mode-map'. + + - `guix-TYPE-get-entries' - a wrapper around `guix-ui-get-entries'. + + - `guix-TYPE-message' - a wrapper around `guix-result-message'." + (declare (indent 2)) + (let* ((entry-type-str (symbol-name entry-type)) + (buffer-type-str (symbol-name buffer-type)) + (prefix (concat "guix-" entry-type-str "-" + buffer-type-str)) + (mode-str (concat prefix "-mode")) + (mode-map (intern (concat mode-str "-map"))) + (parent-map (intern (format "guix-%s-mode-map" + buffer-type-str))) + (required-var (intern (concat prefix "-required-params"))) + (buffer-name-fun (intern (concat prefix "-buffer-name"))) + (get-fun (intern (concat prefix "-get-entries"))) + (message-fun (intern (concat prefix "-message"))) + (displayed-fun (intern (format "guix-%s-displayed-params" + buffer-type-str))) + (definer (intern (format "guix-%s-define-interface" + buffer-type-str)))) + (guix-keyword-args-let args + ((buffer-name-val :buffer-name) + (required-val :required ''(id))) + `(progn + (defvar ,mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent + map (make-composed-keymap ,parent-map guix-ui-map)) + map) + ,(format "Keymap for `%s' buffers." mode-str)) + + (defvar ,required-var ,required-val + ,(format "\ +List of the required '%s' parameters. +These parameters are received by `%S' +along with the displayed parameters. + +Do not remove `id' from this list as it is required for +identifying an entry." + entry-type-str get-fun)) + + (defun ,buffer-name-fun (profile &rest _) + ,(format "\ +Return a name of '%s' buffer for displaying '%s' entries. +See `guix-ui-buffer-name' for details." + buffer-type-str entry-type-str) + (guix-ui-buffer-name ,buffer-name-val profile)) + + (defun ,get-fun (profile search-type &rest search-values) + ,(format "\ +Receive '%s' entries for displaying them in '%s' buffer. +See `guix-ui-get-entries' for details." + entry-type-str buffer-type-str) + (guix-ui-get-entries + profile ',entry-type search-type search-values + (cl-union ,required-var + (,displayed-fun ',entry-type)))) + + (defun ,message-fun (entries profile search-type + &rest search-values) + ,(format "\ +Display a message after showing '%s' entries." + entry-type-str) + (guix-result-message + profile entries ',entry-type search-type search-values)) + + (,definer ,entry-type + :get-entries-function ',get-fun + :message-function ',message-fun + :buffer-name ',buffer-name-fun + ,@%foreign-args))))) + +(defmacro guix-ui-info-define-interface (entry-type &rest args) + "Define 'info' interface for displaying ENTRY-TYPE entries. +See `guix-ui-define-interface'." + (declare (indent 1)) + `(guix-ui-define-interface info ,entry-type + ,@args)) + +(defmacro guix-ui-list-define-interface (entry-type &rest args) + "Define 'list' interface for displaying ENTRY-TYPE entries. +Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... + +Optional keywords: + + - `:describe-function' - default value of the generated + `guix-ENTRY-TYPE-list-describe-function' variable (if not + specified, use `guix-ui-list-describe'). + +The rest keyword arguments are passed to +`guix-ui-define-interface' macro." + (declare (indent 1)) + (guix-keyword-args-let args + ((describe-val :describe-function)) + `(guix-ui-define-interface list ,entry-type + :describe-function ,(or describe-val ''guix-ui-list-describe) + ,@args))) + + +(defvar guix-ui-font-lock-keywords + (eval-when-compile + `((,(rx "(" (group (or "guix-ui-define-entry-type" + "guix-ui-define-interface" + "guix-ui-info-define-interface" + "guix-ui-list-define-interface")) + symbol-end) + . 1)))) + +(font-lock-add-keywords 'emacs-lisp-mode guix-ui-font-lock-keywords) + +(provide 'guix-ui) + +;;; guix-ui.el ends here diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el index 5f3f3ecc10..8c1a5b42de 100644 --- a/emacs/guix-utils.el +++ b/emacs/guix-utils.el @@ -64,6 +64,17 @@ Use `guix-time-format'." "Return one-line string from a multi-line STR." (replace-regexp-in-string "\n" " " str)) +(defmacro guix-with-indent (indent &rest body) + "Evaluate BODY and indent inserted text by INDENT number of spaces." + (declare (indent 1) (debug t)) + (let ((region-beg-var (make-symbol "region-beg")) + (indent-var (make-symbol "indent"))) + `(let ((,region-beg-var (point)) + (,indent-var ,indent)) + ,@body + (unless (zerop ,indent-var) + (indent-rigidly ,region-beg-var (point) ,indent-var))))) + (defun guix-format-insert (val &optional face format) "Convert VAL into a string and insert it at point. If FACE is non-nil, propertize VAL with FACE. @@ -93,6 +104,28 @@ See `insert-text-button' for the meaning of PROPERTIES." :type (or type 'button) properties))) +(defun guix-buttonize (value button-type separator &rest properties) + "Make BUTTON-TYPE button(s) from VALUE. +Return a string with button(s). + +VALUE should be a string or a list of strings. If it is a list +of strings, buttons are separated with SEPARATOR string. + +PROPERTIES are passed to `guix-insert-button'." + (with-temp-buffer + (let ((labels (if (listp value) value (list value)))) + (guix-mapinsert (lambda (label) + (apply #'guix-insert-button + label button-type properties)) + labels + separator)) + (buffer-substring (point-min) (point-max)))) + +(defun guix-button-type? (symbol) + "Return non-nil, if SYMBOL is a button type." + (and symbol + (get symbol 'button-category-symbol))) + (defun guix-split-insert (val &optional face col separator) "Convert VAL into a string, split it and insert at point. @@ -111,14 +144,11 @@ Separate inserted lines with SEPARATOR." (defun guix-split-string (str &optional col) "Split string STR by lines and return list of result strings. -If COL is non-nil and STR is a one-line string longer than COL, -split it into several short lines." - (let ((strings (split-string str "\n *"))) - (if (and col - (null (cdr strings)) ; if not multi-line - (> (length str) col)) - (split-string (guix-get-filled-string str col) "\n") - strings))) +If COL is non-nil, fill STR to this column." + (let ((str (if col + (guix-get-filled-string str col) + str))) + (split-string str "\n *" t))) (defun guix-get-filled-string (str col) "Return string by filling STR to column COL." @@ -144,6 +174,15 @@ add both to the end and to the beginning." (t (concat separator str separator))))) +(defun guix-hexify (value) + "Convert VALUE to string and hexify it." + (url-hexify-string (guix-get-string value))) + +(defun guix-number->bool (number) + "Convert NUMBER to boolean value. +Return nil, if NUMBER is 0; return t otherwise." + (not (zerop number))) + (defun guix-shell-quote-argument (argument) "Quote shell command ARGUMENT. This function is similar to `shell-quote-argument', but less strict." @@ -154,6 +193,15 @@ This function is similar to `shell-quote-argument', but less strict." (replace-regexp-in-string (rx (not (any alnum "-=,./\n"))) "\\\\\\&" argument)))) +(defun guix-symbol-title (symbol) + "Return SYMBOL's name, a string. +This is like `symbol-name', but fancier." + (if (eq symbol 'id) + "ID" + (let ((str (replace-regexp-in-string "-" " " (symbol-name symbol)))) + (concat (capitalize (substring str 0 1)) + (substring str 1))))) + (defun guix-command-symbol (&optional args) "Return symbol by concatenating 'guix' and ARGS (strings)." (intern (guix-concat-strings (cons "guix" args) "-"))) @@ -175,6 +223,15 @@ If NO-MESSAGE? is non-nil, do not display a message about it." See also `guix-copy-as-kill'." (guix-copy-as-kill (guix-command-string args) no-message?)) +(defun guix-completing-read (prompt table &optional predicate + require-match initial-input + hist def inherit-input-method) + "Same as `completing-read' but return nil instead of an empty string." + (let ((res (completing-read prompt table predicate + require-match initial-input + hist def inherit-input-method))) + (unless (string= "" res) res))) + (defun guix-completing-read-multiple (prompt table &optional predicate require-match initial-input hist def inherit-input-method) @@ -193,6 +250,14 @@ Return time value." (require 'org) (org-read-date nil t nil prompt)) +(defun guix-read-file-name (prompt &optional dir default-filename + mustmatch initial predicate) + "Read file name. +This function is similar to `read-file-name' except it also +expands the file name." + (expand-file-name (read-file-name prompt dir default-filename + mustmatch initial predicate))) + (defcustom guix-find-file-function #'find-file "Function used to find a file. The function is called by `guix-find-file' with a file name as a @@ -226,6 +291,15 @@ single argument." (while (re-search-forward ,regexp nil t) ,@body))) +(defmacro guix-while-null (&rest body) + "Evaluate BODY until its result becomes non-nil." + (declare (indent 0) (debug t)) + (let ((result-var (make-symbol "result"))) + `(let (,result-var) + (while (null ,result-var) + (setq ,result-var ,@body)) + ,result-var))) + (defun guix-modify (object modifiers) "Apply MODIFIERS to OBJECT. OBJECT is passed as an argument to the first function from @@ -237,8 +311,57 @@ modifier call." (guix-modify (funcall (car modifiers) object) (cdr modifiers)))) +(defmacro guix-keyword-args-let (args varlist &rest body) + "Parse ARGS, bind variables from VARLIST and eval BODY. + +Find keyword values in ARGS, bind them to variables according to +VARLIST, then evaluate BODY. + +ARGS is a keyword/value property list. + +Each element of VARLIST has a form: + + (SYMBOL KEYWORD [DEFAULT-VALUE]) + +SYMBOL is a varible name. KEYWORD is a symbol that will be +searched in ARGS for an according value. If the value of KEYWORD +does not exist, bind SYMBOL to DEFAULT-VALUE or nil. + +The rest arguments (that present in ARGS but not in VARLIST) will +be bound to `%foreign-args' variable. + +Example: + + (guix-keyword-args-let '(:two 8 :great ! :guix is) + ((one :one 1) + (two :two 2) + (foo :smth)) + (list one two foo %foreign-args)) + + => (1 8 nil (:guix is :great !))" + (declare (indent 2)) + (let ((args-var (make-symbol "args"))) + `(let (,@(mapcar (lambda (spec) + (pcase-let ((`(,name ,_ ,val) spec)) + (list name val))) + varlist) + (,args-var ,args) + %foreign-args) + (while ,args-var + (pcase ,args-var + (`(,key ,val . ,rest-args) + (cl-case key + ,@(mapcar (lambda (spec) + (pcase-let ((`(,name ,key ,_) spec)) + `(,key (setq ,name val)))) + varlist) + (t (setq %foreign-args + (cl-list* key val %foreign-args)))) + (setq ,args-var rest-args)))) + ,@body))) + -;;; Alist accessors +;;; Alist procedures (defmacro guix-define-alist-accessor (name assoc-fun) "Define NAME function to access alist values using ASSOC-FUN." @@ -256,6 +379,48 @@ accessed with KEYS." (guix-define-alist-accessor guix-assq-value assq) (guix-define-alist-accessor guix-assoc-value assoc) +(defun guix-alist-put (value alist &rest keys) + "Put (add or replace if exists) VALUE to ALIST using KEYS. +Return the new alist. + +ALIST is alist of alists of alists ... which can be consecutively +accessed with KEYS. + +Example: + + (guix-alist-put + 'foo + '((one (a . 1) (b . 2)) + (two (m . 7) (n . 8))) + 'one 'b) + + => ((one (a . 1) (b . foo)) + (two (m . 7) (n . 8)))" + (or keys (error "Keys should be specified")) + (guix-alist-put-1 value alist keys)) + +(defun guix-alist-put-1 (value alist keys) + "Subroutine of `guix-alist-put'." + (cond + ((null keys) + value) + ((null alist) + (list (cons (car keys) + (guix-alist-put-1 value nil (cdr keys))))) + ((eq (car keys) (caar alist)) + (cons (cons (car keys) + (guix-alist-put-1 value (cdar alist) (cdr keys))) + (cdr alist))) + (t + (cons (car alist) + (guix-alist-put-1 value (cdr alist) keys))))) + +(defun guix-alist-put! (value variable &rest keys) + "Modify alist VARIABLE (symbol) by putting VALUE using KEYS. +See `guix-alist-put' for details." + (set variable + (apply #'guix-alist-put value (symbol-value variable) keys))) + ;;; Diff @@ -267,6 +432,77 @@ accessed with KEYS." (diff old new (or switches guix-diff-switches) no-async)) +;;; Completing readers definers + +(defmacro guix-define-reader (name read-fun completions prompt) + "Define NAME function to read from minibuffer. +READ-FUN may be `completing-read', `completing-read-multiple' or +another function with the same arguments." + `(defun ,name (&optional prompt initial-contents) + (,read-fun ,(if prompt + `(or prompt ,prompt) + 'prompt) + ,completions nil nil initial-contents))) + +(defmacro guix-define-readers (&rest args) + "Define reader functions. + +ARGS should have a form [KEYWORD VALUE] ... The following +keywords are available: + + - `completions-var' - variable used to get completions. + + - `completions-getter' - function used to get completions. + + - `single-reader', `single-prompt' - name of a function to read + a single value, and a prompt for it. + + - `multiple-reader', `multiple-prompt' - name of a function to + read multiple values, and a prompt for it. + + - `multiple-separator' - if specified, another + `<multiple-reader-name>-string' function returning a string + of multiple values separated the specified separator will be + defined." + (guix-keyword-args-let args + ((completions-var :completions-var) + (completions-getter :completions-getter) + (single-reader :single-reader) + (single-prompt :single-prompt) + (multiple-reader :multiple-reader) + (multiple-prompt :multiple-prompt) + (multiple-separator :multiple-separator)) + (let ((completions + (cond ((and completions-var completions-getter) + `(or ,completions-var + (setq ,completions-var + (funcall ',completions-getter)))) + (completions-var + completions-var) + (completions-getter + `(funcall ',completions-getter))))) + `(progn + ,(when (and completions-var + (not (boundp completions-var))) + `(defvar ,completions-var nil)) + + ,(when single-reader + `(guix-define-reader ,single-reader guix-completing-read + ,completions ,single-prompt)) + + ,(when multiple-reader + `(guix-define-reader ,multiple-reader completing-read-multiple + ,completions ,multiple-prompt)) + + ,(when (and multiple-reader multiple-separator) + (let ((name (intern (concat (symbol-name multiple-reader) + "-string")))) + `(defun ,name (&optional prompt initial-contents) + (guix-concat-strings + (,multiple-reader prompt initial-contents) + ,multiple-separator)))))))) + + ;;; Memoizing (defun guix-memoize (function) @@ -303,9 +539,18 @@ See `defun' for the meaning of arguments." ,(or docstring (format "Memoized version of `%S'." definition)))) -(defvar guix-memoized-font-lock-keywords + +(defvar guix-utils-font-lock-keywords (eval-when-compile - `((,(rx "(" + `((,(rx "(" (group (or "guix-define-reader" + "guix-define-readers" + "guix-keyword-args-let" + "guix-while-null" + "guix-while-search" + "guix-with-indent")) + symbol-end) + . 1) + (,(rx "(" (group "guix-memoized-" (or "defun" "defalias")) symbol-end (zero-or-more blank) @@ -314,7 +559,7 @@ See `defun' for the meaning of arguments." (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))))) -(font-lock-add-keywords 'emacs-lisp-mode guix-memoized-font-lock-keywords) +(font-lock-add-keywords 'emacs-lisp-mode guix-utils-font-lock-keywords) (provide 'guix-utils) diff --git a/emacs/guix.el b/emacs/guix.el deleted file mode 100644 index ac6efbb475..0000000000 --- a/emacs/guix.el +++ /dev/null @@ -1,213 +0,0 @@ -;;; guix.el --- Interface for GNU Guix package manager - -;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> - -;; Package-Requires: ((geiser "0.3")) -;; Keywords: tools - -;; 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 package provides an interface for searching, listing and getting -;; information about Guix packages and generations; and for -;; installing/upgrading/removing packages. - -;;; Code: - -(require 'guix-base) -(require 'guix-list) -(require 'guix-info) -(require 'guix-utils) -(require 'guix-read) - -(defgroup guix nil - "Interface for Guix package manager." - :prefix "guix-" - :group 'external) - -(defgroup guix-faces nil - "Guix faces." - :group 'guix - :group 'faces) - -(defcustom guix-list-single-package nil - "If non-nil, list a package even if it is the only matching result. -If nil, show a single package in the info buffer." - :type 'boolean - :group 'guix) - -(defvar guix-search-params '(name synopsis description) - "Default list of package parameters for searching by regexp.") - -(defvar guix-search-history nil - "A history of minibuffer prompts.") - -(defun guix-get-show-packages (profile search-type &rest search-vals) - "Search for packages and show results. - -If PROFILE is nil, use `guix-current-profile'. - -See `guix-get-entries' for the meaning of SEARCH-TYPE and -SEARCH-VALS. - -Results are displayed in the list buffer, unless a single package -is found and `guix-list-single-package' is nil." - (or profile (setq profile guix-current-profile)) - (let ((packages (guix-get-entries profile guix-package-list-type - search-type search-vals - (guix-get-params-for-receiving - 'list guix-package-list-type)))) - (if (or guix-list-single-package - (cdr packages)) - (guix-set-buffer profile packages 'list guix-package-list-type - search-type search-vals) - (let ((packages (guix-get-entries profile guix-package-info-type - search-type search-vals - (guix-get-params-for-receiving - 'info guix-package-info-type)))) - (guix-set-buffer profile packages 'info guix-package-info-type - search-type search-vals))))) - -(defun guix-get-show-generations (profile search-type &rest search-vals) - "Search for generations and show results. - -If PROFILE is nil, use `guix-current-profile'. - -See `guix-get-entries' for the meaning of SEARCH-TYPE and -SEARCH-VALS." - (apply #'guix-get-show-entries - (or profile guix-current-profile) - 'list 'generation search-type search-vals)) - -;;;###autoload -(defun guix-search-by-name (name &optional profile) - "Search for Guix packages by NAME. -NAME is a string with name specification. It may optionally contain -a version number. Examples: \"guile\", \"guile-2.0.11\". - -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (read-string "Package name: " nil 'guix-search-history) - (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'name name)) - -;;;###autoload -(defun guix-search-by-regexp (regexp &optional params profile) - "Search for Guix packages by REGEXP. -PARAMS are package parameters that should be searched. -If PARAMS are not specified, use `guix-search-params'. - -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (read-regexp "Regexp: " nil 'guix-search-history) - nil - (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'regexp regexp - (or params guix-search-params))) - -;;;###autoload -(defun guix-installed-packages (&optional profile) - "Display information about installed Guix packages. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'installed)) - -;;;###autoload -(defun guix-obsolete-packages (&optional profile) - "Display information about obsolete Guix packages. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'obsolete)) - -;;;###autoload -(defun guix-all-available-packages (&optional profile) - "Display information about all available Guix packages. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'all-available)) - -;;;###autoload -(defun guix-newest-available-packages (&optional profile) - "Display information about the newest available Guix packages. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-packages profile 'newest-available)) - -;;;###autoload -(defun guix-generations (&optional profile) - "Display information about all generations. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-generations profile 'all)) - -;;;###autoload -(defun guix-last-generations (number &optional profile) - "Display information about last NUMBER generations. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (read-number "The number of last generations: ") - (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-generations profile 'last number)) - -;;;###autoload -(defun guix-generations-by-time (from to &optional profile) - "Display information about generations created between FROM and TO. -FROM and TO should be time values. -If PROFILE is nil, use `guix-current-profile'. -Interactively with prefix, prompt for PROFILE." - (interactive - (list (guix-read-date "Find generations (from): ") - (guix-read-date "Find generations (to): ") - (and current-prefix-arg - (guix-profile-prompt)))) - (guix-get-show-generations profile 'time - (float-time from) - (float-time to))) - -;;;###autoload -(defun guix-edit (id-or-name) - "Edit (go to location of) package with ID-OR-NAME." - (interactive (list (guix-read-package-name))) - (let ((loc (guix-package-location id-or-name))) - (if loc - (guix-find-location loc) - (message "Couldn't find package location.")))) - -(provide 'guix) - -;;; guix.el ends here diff --git a/gnu-system.am b/gnu-system.am index ce7b908b0a..8bace7d423 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -76,7 +76,6 @@ GNU_SYSTEM_MODULES = \ gnu/packages/cryptsetup.scm \ gnu/packages/cups.scm \ gnu/packages/curl.scm \ - gnu/packages/cursynth.scm \ gnu/packages/cyrus-sasl.scm \ gnu/packages/databases.scm \ gnu/packages/datamash.scm \ @@ -361,6 +360,7 @@ GNU_SYSTEM_MODULES = \ gnu/services/desktop.scm \ gnu/services/dmd.scm \ gnu/services/lirc.scm \ + gnu/services/mail.scm \ gnu/services/networking.scm \ gnu/services/ssh.scm \ gnu/services/web.scm \ @@ -420,7 +420,6 @@ dist_patch_DATA = \ gnu/packages/patches/binutils-ld-new-dtags.patch \ gnu/packages/patches/binutils-loongson-workaround.patch \ gnu/packages/patches/bitlbee-configure-doc-fix.patch \ - gnu/packages/patches/bluez-tests.patch \ gnu/packages/patches/boost-mips-avoid-m32.patch \ gnu/packages/patches/byobu-writable-status.patch \ gnu/packages/patches/calibre-drop-unrar.patch \ @@ -468,7 +467,6 @@ dist_patch_DATA = \ gnu/packages/patches/flint-ldconfig.patch \ gnu/packages/patches/fltk-shared-lib-defines.patch \ gnu/packages/patches/freeimage-CVE-2015-0852.patch \ - gnu/packages/patches/fuse-CVE-2015-3202.patch \ gnu/packages/patches/gawk-shell.patch \ gnu/packages/patches/gcc-arm-link-spec-fix.patch \ gnu/packages/patches/gcc-cross-environment-variables.patch \ @@ -499,6 +497,7 @@ dist_patch_DATA = \ gnu/packages/patches/gobject-introspection-cc.patch \ gnu/packages/patches/gobject-introspection-girepository.patch \ gnu/packages/patches/grep-timing-sensitive-test.patch \ + gnu/packages/patches/grub-CVE-2015-8370.patch \ gnu/packages/patches/grub-gets-undeclared.patch \ gnu/packages/patches/grub-freetype.patch \ gnu/packages/patches/guile-1.8-cpp-4.5.patch \ @@ -514,7 +513,6 @@ dist_patch_DATA = \ gnu/packages/patches/hydra-automake-1.15.patch \ gnu/packages/patches/hydra-disable-darcs-test.patch \ gnu/packages/patches/icecat-avoid-bundled-includes.patch \ - gnu/packages/patches/icecat-freetype-2.6.patch \ gnu/packages/patches/icu4c-CVE-2014-6585.patch \ gnu/packages/patches/icu4c-CVE-2015-1270.patch \ gnu/packages/patches/icu4c-CVE-2015-4760.patch \ @@ -646,6 +644,7 @@ dist_patch_DATA = \ gnu/packages/patches/python-3-search-paths.patch \ gnu/packages/patches/python-disable-ssl-test.patch \ gnu/packages/patches/python-fix-tests.patch \ + gnu/packages/patches/python-ipython-inputhook-ctype.patch \ gnu/packages/patches/python2-rdflib-drop-sparqlwrapper.patch \ gnu/packages/patches/python-configobj-setuptools.patch \ gnu/packages/patches/python2-pygobject-2-gi-info-type-error-domain.patch \ diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index 00af35d3df..f8b8697b46 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -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> ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +23,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 rdelim) #:use-module (ice-9 format) + #:use-module (ice-9 regex) #:use-module (system foreign) #:autoload (system repl repl) (start-repl) #:use-module (srfi srfi-1) @@ -34,6 +35,9 @@ find-partition-by-uuid canonicalize-device-spec + uuid->string + string->uuid + MS_RDONLY MS_NOSUID MS_NODEV @@ -213,6 +217,11 @@ or #f if none was found." (disk-partitions)) (cut string-append "/dev/" <>))) + +;;; +;;; UUIDs. +;;; + (define-syntax %network-byte-order (identifier-syntax (endianness big))) @@ -228,6 +237,41 @@ like \"6b700d61-5550-48a1-874c-a3d86998990e\"." (format #f "~8,'0x-~4,'0x-~4,'0x-~4,'0x-~12,'0x" time-low time-mid time-hi clock-seq node))) +(define %uuid-rx + ;; The regexp of a UUID. + (make-regexp "^([[:xdigit:]]{8})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{12})$")) + +(define (string->uuid str) + "Parse STR as a DCE UUID (see <https://tools.ietf.org/html/rfc4122>) and +return its contents as a 16-byte bytevector. Return #f if STR is not a valid +UUID representation." + (and=> (regexp-exec %uuid-rx str) + (lambda (match) + (letrec-syntax ((hex->number + (syntax-rules () + ((_ index) + (string->number (match:substring match index) + 16)))) + (put! + (syntax-rules () + ((_ bv index (number len) rest ...) + (begin + (bytevector-uint-set! bv index number + (endianness big) len) + (put! bv (+ index len) rest ...))) + ((_ bv index) + bv)))) + (let ((time-low (hex->number 1)) + (time-mid (hex->number 2)) + (time-hi (hex->number 3)) + (clock-seq (hex->number 4)) + (node (hex->number 5)) + (uuid (make-bytevector 16))) + (put! uuid 0 + (time-low 4) (time-mid 2) (time-hi 2) + (clock-seq 2) (node 6))))))) + + (define* (canonicalize-device-spec spec #:optional (title 'any)) "Return the device name corresponding to SPEC. TITLE is a symbol, one of the following: @@ -251,9 +295,12 @@ the following: ;; The realm of canonicalization. (if (eq? title 'any) (if (string? spec) - (if (string-prefix? "/" spec) - 'device - 'label) + ;; The "--root=SPEC" kernel command-line option always provides a + ;; string, but the string can represent a device, a UUID, or a + ;; label. So check for all three. + (cond ((string-prefix? "/" spec) 'device) + ((string->uuid spec) 'uuid) + (else 'label)) 'uuid) title)) @@ -279,7 +326,11 @@ the following: ;; Resolve the label. (resolve find-partition-by-label spec identity)) ((uuid) - (resolve find-partition-by-uuid spec uuid->string)) + (resolve find-partition-by-uuid + (if (string? spec) + (string->uuid spec) + spec) + uuid->string)) (else (error "unknown device title" title)))) diff --git a/gnu/packages.scm b/gnu/packages.scm index fb277389c7..b309a7806d 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -46,10 +46,6 @@ find-best-packages-by-name find-newest-available-packages - package-direct-dependents - package-transitive-dependents - package-covering-dependents - check-package-freshness specification->package @@ -263,63 +259,6 @@ VERSION." (#f '())))) -(define* (vhash-refq vhash key #:optional (dflt #f)) - "Look up KEY in the vhash VHASH, and return the value (if any) associated -with it. If KEY is not found, return DFLT (or `#f' if no DFLT argument is -supplied). Uses `eq?' for equality testing." - (or (and=> (vhash-assq key vhash) cdr) - dflt)) - -(define package-dependencies - (memoize - (lambda () - "Return a vhash keyed by package, and with associated values that are a -list of packages that depend on that package." - (fold-packages - (lambda (package dag) - (fold - (lambda (in d) - ;; Insert a graph edge from each of package's inputs to package. - (vhash-consq in - (cons package (vhash-refq d in '())) - (vhash-delq in d))) - dag - (match (package-direct-inputs package) - (((labels packages . _) ...) - packages) ))) - vlist-null)))) - -(define (package-direct-dependents packages) - "Return a list of packages from the distribution that directly depend on the -packages in PACKAGES." - (delete-duplicates - (concatenate - (map (lambda (p) - (vhash-refq (package-dependencies) p '())) - packages)))) - -(define (package-transitive-dependents packages) - "Return the transitive dependent packages of the distribution packages in -PACKAGES---i.e. the dependents of those packages, plus their dependents, -recursively." - (let ((dependency-dag (package-dependencies))) - (fold-tree - cons '() - (lambda (node) (vhash-refq dependency-dag node)) - ;; Start with the dependents to avoid including PACKAGES in the result. - (package-direct-dependents packages)))) - -(define (package-covering-dependents packages) - "Return a minimal list of packages from the distribution whose dependencies -include all of PACKAGES and all packages that depend on PACKAGES." - (let ((dependency-dag (package-dependencies))) - (fold-tree-leaves - cons '() - (lambda (node) (vhash-refq dependency-dag node)) - ;; Start with the dependents to avoid including PACKAGES in the result. - (package-direct-dependents packages)))) - - (define %sigint-prompt ;; The prompt to jump to upon SIGINT. (make-prompt-tag "interruptible")) diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index 5b9f5d1650..4f335a27d4 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> -;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> +;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com> ;;; Copyright © 2015 Alex Sassmannshausen <alex.sassmannshausen@gmail.com> ;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr> @@ -388,99 +388,142 @@ connection alive.") (license license:gpl3+))) (define-public isc-dhcp - (package - (name "isc-dhcp") - (version "4.3.1") - (source (origin - (method url-fetch) - (uri (string-append "http://ftp.isc.org/isc/dhcp/" - version "/dhcp-" version ".tar.gz")) - (sha256 - (base32 - "1w4s7sni1m9223ya8m2a64lr62845c6xlraprjf8zfx6lylbqv16")))) - (build-system gnu-build-system) - (arguments - '(#:phases (alist-cons-after - 'configure 'post-configure - (lambda* (#:key outputs #:allow-other-keys) - ;; Point to the right client script, which will be - ;; installed in a later phase. - (substitute* "includes/dhcpd.h" - (("#define[[:blank:]]+_PATH_DHCLIENT_SCRIPT.*") - (let ((out (assoc-ref outputs "out"))) - (string-append "#define _PATH_DHCLIENT_SCRIPT \"" - out "/libexec/dhclient-script" - "\"\n")))) - - ;; During the 'build' phase, 'bind.tar.gz' is extracted, so - ;; we must patch shebangs in there and make sure the right - ;; shell is used. - (with-directory-excursion "bind" - (substitute* "Makefile" - (("\\./configure") - (let ((sh (which "sh"))) - (string-append "./configure CONFIG_SHELL=" - sh " SHELL=" sh)))) - - (system* "tar" "xf" "bind.tar.gz") - (for-each patch-shebang - (find-files "bind-9.9.5-P1" ".*")) - (zero? (system* "tar" "cf" "bind.tar.gz" - "bind-9.9.5-P1" - ;; avoid non-determinism in the archive - "--sort=name" - "--mtime=@0" - "--owner=root:0" - "--group=root:0")))) - (alist-cons-after - 'install 'post-install - (lambda* (#:key inputs outputs #:allow-other-keys) - ;; Install the dhclient script for GNU/Linux and make sure - ;; if finds all the programs it needs. - (let* ((out (assoc-ref outputs "out")) - (libexec (string-append out "/libexec")) - (coreutils (assoc-ref inputs "coreutils")) - (inetutils (assoc-ref inputs "inetutils")) - (net-tools (assoc-ref inputs "net-tools")) - (sed (assoc-ref inputs "sed"))) - (substitute* "client/scripts/linux" - (("/sbin/ip") - (string-append (assoc-ref inputs "iproute") - "/sbin/ip"))) - - (mkdir-p libexec) - (copy-file "client/scripts/linux" - (string-append libexec "/dhclient-script")) - - (wrap-program - (string-append libexec "/dhclient-script") - `("PATH" ":" prefix - ,(map (lambda (dir) - (string-append dir "/bin:" - dir "/sbin")) - (list inetutils net-tools coreutils sed)))))) - %standard-phases)))) + (let* ((bind-major-version "9") + (bind-minor-version "9") + (bind-patch-version "8") + (bind-release-type "-P") + (bind-release-version "2") + (bind-version (string-append bind-major-version + "." + bind-minor-version + "." + bind-patch-version + bind-release-type + bind-release-version))) + (package + (name "isc-dhcp") + (version "4.3.3") + (source (origin + (method url-fetch) + (uri (string-append "http://ftp.isc.org/isc/dhcp/" + version "/dhcp-" version ".tar.gz")) + (sha256 + (base32 + "1pjy4lylx7dww1fp2mk5ikya5vxaf97z70279j81n74vn12ljg2m")))) + (build-system gnu-build-system) + (arguments + `(#:parallel-build? #f + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'replace-bundled-bind + (lambda* (#:key inputs #:allow-other-keys) + (delete-file "bind/bind.tar.gz") + (copy-file (assoc-ref inputs "bind-source-tarball") + "bind/bind.tar.gz") + (chmod "bind/bind.tar.gz" #o644) + (substitute* "bind/version.tmp" + (("^MAJORVER=.*") + (format #f "MAJORVER=~a\n" ,bind-major-version)) + (("^MINORVER=.*") + (format #f "MINORVER=~a\n" ,bind-minor-version)) + (("^PATCHVER=.*") + (format #f "PATCHVER=~a\n" ,bind-patch-version)) + (("^RELEASETYPE=.*") + (format #f "RELEASETYPE=~a\n" ,bind-release-type)) + (("^RELEASEVER=.*") + (format #f "RELEASEVER=~a\n" ,bind-release-version))) + #t)) + (add-after 'configure 'post-configure + (lambda* (#:key outputs #:allow-other-keys) + ;; Point to the right client script, which will be + ;; installed in a later phase. + (substitute* "includes/dhcpd.h" + (("#define[[:blank:]]+_PATH_DHCLIENT_SCRIPT.*") + (let ((out (assoc-ref outputs "out"))) + (string-append "#define _PATH_DHCLIENT_SCRIPT \"" + out "/libexec/dhclient-script" + "\"\n")))) - (native-inputs `(("perl" ,perl))) + ;; During the 'build' phase, 'bind.tar.gz' is extracted, so + ;; we must patch shebangs in there and make sure the right + ;; shell is used. + (with-directory-excursion "bind" + (substitute* "Makefile" + (("\\./configure") + (let ((sh (which "sh"))) + (string-append "./configure CONFIG_SHELL=" + sh " SHELL=" sh)))) - (inputs `(("inetutils" ,inetutils) - ("net-tools" ,net-tools) - ("iproute" ,iproute) + (let ((bind-directory (string-append "bind-" ,bind-version))) + (system* "tar" "xf" "bind.tar.gz") + (for-each patch-shebang + (find-files bind-directory ".*")) + (zero? (system* "tar" "cf" "bind.tar.gz" + bind-directory + ;; avoid non-determinism in the archive + "--sort=name" + "--mtime=@0" + "--owner=root:0" + "--group=root:0")))))) + (add-after 'install 'post-install + (lambda* (#:key inputs outputs #:allow-other-keys) + ;; Install the dhclient script for GNU/Linux and make sure + ;; if finds all the programs it needs. + (let* ((out (assoc-ref outputs "out")) + (libexec (string-append out "/libexec")) + (coreutils (assoc-ref inputs "coreutils")) + (inetutils (assoc-ref inputs "inetutils")) + (net-tools (assoc-ref inputs "net-tools")) + (sed (assoc-ref inputs "sed"))) + (substitute* "client/scripts/linux" + (("/sbin/ip") + (string-append (assoc-ref inputs "iproute") + "/sbin/ip"))) - ;; When cross-compiling, we need the cross Coreutils and sed. - ;; Otherwise just use those from %FINAL-INPUTS. - ,@(if (%current-target-system) - `(("coreutils" ,coreutils) - ("sed" ,sed)) - '()))) + (mkdir-p libexec) + (copy-file "client/scripts/linux" + (string-append libexec "/dhclient-script")) - (home-page "http://www.isc.org/products/DHCP/") - (synopsis "Dynamic Host Configuration Protocol (DHCP) tools") - (description - "ISC's Dynamic Host Configuration Protocol (DHCP) distribution provides a + (wrap-program + (string-append libexec "/dhclient-script") + `("PATH" ":" prefix + ,(map (lambda (dir) + (string-append dir "/bin:" + dir "/sbin")) + (list inetutils net-tools coreutils sed)))))))))) + + (native-inputs `(("perl" ,perl))) + + (inputs `(("inetutils" ,inetutils) + ("net-tools" ,net-tools) + ("iproute" ,iproute) + + ;; XXX isc-dhcp bundles a copy of bind that has security + ;; flaws, so we use a newer version. + ("bind-source-tarball" + ,(origin + (method url-fetch) + (uri (string-append "http://ftp.isc.org/isc/bind9/" + bind-version + "/bind-" bind-version ".tar.gz")) + (sha256 + (base32 + "0agkpmpna7s67la13krn4xlhwhdjpazmljxlq0zbjdwnw4k1k17m")))) + + ;; When cross-compiling, we need the cross Coreutils and sed. + ;; Otherwise just use those from %FINAL-INPUTS. + ,@(if (%current-target-system) + `(("coreutils" ,coreutils) + ("sed" ,sed)) + '()))) + + (home-page "http://www.isc.org/products/DHCP/") + (synopsis "Dynamic Host Configuration Protocol (DHCP) tools") + (description + "ISC's Dynamic Host Configuration Protocol (DHCP) distribution provides a reference implementation of all aspects of DHCP, through a suite of DHCP tools: server, client, and relay agent.") - (license license:isc))) + (license license:isc)))) (define-public libpcap (package @@ -1233,3 +1276,44 @@ handles configuration-management, application deployment, cloud provisioning, ad-hoc task-execution, and multinode orchestration - including trivializing things like zero downtime rolling updates with load balancers.") (license license:gpl3+))) + +(define-public cpulimit + (package + (name "cpulimit") + (version "0.2") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/opsengine/cpulimit/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1nn2w849xd5bw4y5sqnll29nxdwl5h0cv4smc7dwmpb9qnd2ycb4")))) + (build-system gnu-build-system) + (arguments + `(#:phases (modify-phases %standard-phases + (delete 'configure) + (replace + 'build + (lambda _ + (zero? (system* "make" "CC=gcc" "-Csrc")))) + (replace + 'check + (lambda _ + (zero? (system* "make" "CC=gcc" "-Ctests")))) + (replace + 'install + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin"))) + (install-file "src/cpulimit" bin))))))) + (home-page "https://github.com/opsengine/cpulimit") + (synopsis "Limit CPU usage") + (description + "Cpulimit limits the CPU usage of a process. It does not change the nice +value or other scheduling priority settings, but the real CPU usage, and is +able to adapt itself dynamically to the overall system load. Children +processes and threads of the specified process may optionally share the same +limits.") + (license license:gpl2+))) diff --git a/gnu/packages/audio.scm b/gnu/packages/audio.scm index 6a8347af05..df1f67bddd 100644 --- a/gnu/packages/audio.scm +++ b/gnu/packages/audio.scm @@ -817,15 +817,20 @@ plugin function as a JACK application.") (package (name "ladspa") (version "1.13") - (source (origin - (method url-fetch) - (uri (string-append - "http://www.ladspa.org/download/ladspa_sdk_" - version - ".tgz")) - (sha256 - (base32 - "0srh5n2l63354bc0srcrv58rzjkn4gv8qjqzg8dnq3rs4m7kzvdm")))) + (source + (origin + (method url-fetch) + ;; Since the official link is dead, + ;; we download the tarball from Debian or Internet Archive. + (uri (list (string-append "http://http.debian.net" + "/debian/pool/main/l/ladspa-sdk/ladspa-sdk_" + version ".orig.tar.gz") + (string-append "https://web.archive.org/web/20140717172251/" + "http://www.ladspa.org/download/ladspa_sdk_" + version ".tgz"))) + (sha256 + (base32 + "0srh5n2l63354bc0srcrv58rzjkn4gv8qjqzg8dnq3rs4m7kzvdm")))) (build-system gnu-build-system) (arguments `(#:tests? #f ; the "test" target is a listening test only @@ -843,7 +848,9 @@ plugin function as a JACK application.") (("^CC.*") "CC = gcc\n") (("^CPP.*") "CPP = g++\n")))) (alist-delete 'build %standard-phases)))) - (home-page "http://ladspa.org") + ;; Since the home page is gone, we provide a link to the archived version. + (home-page + "https://web.archive.org/web/20140729190945/http://www.ladspa.org/") (synopsis "Linux Audio Developer's Simple Plugin API (LADSPA)") (description "LADSPA is a standard that allows software audio processors and effects @@ -1953,3 +1960,56 @@ access to ALSA PCM devices, taking care of the many functions required to open, initialise and use a hw: device in mmap mode, and providing floating point audio data.") (license license:gpl3+))) + +(define-public cuetools + (package + (name "cuetools") + (version "1.4.1") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/svend/cuetools/archive/" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "01xi3rvdmil9nawsha04iagjylqr1l9v9vlzk99scs8c207l58i4")))) + (build-system gnu-build-system) + ;; The source tarball is not bootstrapped. + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'bootstrap + (lambda _ (zero? (system* "autoreconf" "-vfi"))))))) + ;; Bootstrapping tools + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("flex" ,flex) + ("bison" ,bison))) + (synopsis "Cue and toc file parsers and utilities") + (description "Cuetools is a set of programs that are useful for manipulating +and using CUE sheet (cue) files and Table of Contents (toc) files. CUE and TOC +files are a way to represent the layout of a data or audio CD in a +machine-readable ASCII format.") + (home-page "https://github.com/svend/cuetools") + (license license:gpl2+))) + +(define-public shntool + (package + (name "shntool") + (version "3.0.10") + (source (origin + (method url-fetch) + (uri (string-append "http://etree.org/shnutils/shntool/dist/src/" + "shntool-" version ".tar.gz")) + (sha256 + (base32 + "00i1rbjaaws3drkhiczaign3lnbhr161b7rbnjr8z83w8yn2wc3l")))) + (build-system gnu-build-system) + (synopsis "WAVE audio data processing tool") + (description "shntool is a multi-purpose WAVE data processing and reporting +utility. File formats are abstracted from its core, so it can process any file +that contains WAVE data, compressed or not---provided there exists a format +module to handle that particular file type.") + (home-page "http://etree.org/shnutils/shntool/") + (license license:gpl3+))) diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index 7c573e1626..76a1c17737 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -40,6 +40,7 @@ #:use-module (gnu packages compression) #:use-module (gnu packages cpio) #:use-module (gnu packages file) + #:use-module (gnu packages gawk) #:use-module (gnu packages java) #:use-module (gnu packages linux) #:use-module (gnu packages machine-learning) @@ -1354,6 +1355,87 @@ supports next-generation sequencing data in fasta/q and csfasta/q format from Illumina, Roche 454, and the SOLiD platform.") (license license:gpl3))) +(define-public fraggenescan + (package + (name "fraggenescan") + (version "1.20") + (source + (origin + (method url-fetch) + (uri + (string-append "mirror://sourceforge/fraggenescan/" + "FragGeneScan" version ".tar.gz")) + (sha256 + (base32 "1zzigqmvqvjyqv4945kv6nc5ah2xxm1nxgrlsnbzav3f5c0n0pyj")))) + (build-system gnu-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (delete 'configure) + (add-before 'build 'patch-paths + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (string-append (assoc-ref outputs "out"))) + (share (string-append out "/share/fraggenescan/"))) + (substitute* "run_FragGeneScan.pl" + (("system\\(\"rm") + (string-append "system(\"" (which "rm"))) + (("system\\(\"mv") + (string-append "system(\"" (which "mv"))) + ;; This script and other programs expect the training files + ;; to be in the non-standard location bin/train/XXX. Change + ;; this to be share/fraggenescan/train/XXX instead. + (("^\\$train.file = \\$dir.*") + (string-append "$train_file = \"" + share + "train/\".$FGS_train_file;"))) + (substitute* "run_hmm.c" + (("^ strcat\\(train_dir, \\\"train/\\\"\\);") + (string-append " strcpy(train_dir, \"" share "/train/\");"))) + (substitute* "post_process.pl" + (("^my \\$dir = substr.*") + (string-append "my $dir = \"" share "\";")))) + #t)) + (replace 'build + (lambda _ (and (zero? (system* "make" "clean")) + (zero? (system* "make" "fgs"))))) + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (string-append (assoc-ref outputs "out"))) + (bin (string-append out "/bin/")) + (share (string-append out "/share/fraggenescan/train"))) + (install-file "run_FragGeneScan.pl" bin) + (install-file "FragGeneScan" bin) + (install-file "FGS_gff.py" bin) + (install-file "post_process.pl" bin) + (copy-recursively "train" share)))) + (delete 'check) + (add-after 'install 'post-install-check + ;; In lieu of 'make check', run one of the examples and check the + ;; output files gets created. + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (string-append (assoc-ref outputs "out"))) + (bin (string-append out "/bin/"))) + (and (zero? (system* (string-append bin "run_FragGeneScan.pl") + "-genome=./example/NC_000913.fna" + "-out=./test2" + "-complete=1" + "-train=complete")) + (file-exists? "test2.faa") + (file-exists? "test2.ffn") + (file-exists? "test2.gff") + (file-exists? "test2.out")))))))) + (inputs + `(("perl" ,perl) + ("python" ,python-2))) ;not compatible with python 3. + (home-page "https://sourceforge.net/projects/fraggenescan/") + (synopsis "Finds potentially fragmented genes in short reads") + (description + "FragGeneScan is a program for predicting bacterial and archaeal genes in +short and error-prone DNA sequencing reads. It can also be applied to predict +genes in incomplete assemblies or complete genomes.") + ;; GPL3+ according to private correspondense with the authors. + (license license:gpl3+))) + (define-public grit (package (name "grit") @@ -1690,7 +1772,7 @@ sequencing tag position and orientation.") (define-public mafft (package (name "mafft") - (version "7.221") + (version "7.267") (source (origin (method url-fetch) (uri (string-append @@ -1699,7 +1781,7 @@ sequencing tag position and orientation.") (file-name (string-append name "-" version ".tgz")) (sha256 (base32 - "0xi7klbsgi049vsrk6jiwh9wfj3b770gz3c8c7zwij448v0dr73d")))) + "1xl6xq1rfxkws0svrlhyqxhhwbv6r77jwblsdpcyiwzsscw6wlk0")))) (build-system gnu-build-system) (arguments `(#:tests? #f ; no automated tests, though there are tests in the read me @@ -1720,6 +1802,9 @@ sequencing tag position and orientation.") ;; remove mafft-homologs.rb from SCRIPTS (("^SCRIPTS = mafft mafft-homologs.rb") "SCRIPTS = mafft") + ;; remove mafft-homologs from MANPAGES + (("^MANPAGES = mafft.1 mafft-homologs.1") + "MANPAGES = mafft.1") ;; remove mafft-distance from PROGS (("^PROGS = dvtditr dndfast7 dndblast sextet5 mafft-distance") "PROGS = dvtditr dndfast7 dndblast sextet5") @@ -1732,9 +1817,22 @@ sequencing tag position and orientation.") (("^\t\\$\\(INSTALL\\) -m 644 \\$\\(MANPAGES\\) \ \\$\\(DESTDIR\\)\\$\\(LIBDIR\\)") "#")) #t)) + (add-after 'enter-dir 'patch-paths + (lambda* (#:key inputs #:allow-other-keys) + (substitute* '("pairash.c" + "mafft.tmpl") + (("perl") (which "perl")) + (("([\"`| ])awk" _ prefix) + (string-append prefix (which "awk"))) + (("grep") (which "grep"))) + #t)) (delete 'configure)))) (inputs - `(("perl" ,perl))) + `(("perl" ,perl) + ("gawk" ,gawk) + ("grep" ,grep))) + (propagated-inputs + `(("coreutils" ,coreutils))) (home-page "http://mafft.cbrc.jp/alignment/software/") (synopsis "Multiple sequence alignment program") (description @@ -3123,6 +3221,203 @@ BLAST, KEGG, GenBank, MEDLINE and GO.") ;; (LGPLv2.1+) and scripts in samples (which have GPL2 and GPL2+) (license (list license:ruby license:lgpl2.1+ license:gpl2+ )))) +(define-public r-acsnminer + (package + (name "r-acsnminer") + (version "0.15.11") + (source (origin + (method url-fetch) + (uri (cran-uri "ACSNMineR" version)) + (sha256 + (base32 + "1dl4drhjyazwm9wxlm8yfppwvvj4h6jxwmz8kfw5bxpb3jdnsqvy")))) + (properties `((upstream-name . "ACSNMineR"))) + (build-system r-build-system) + (propagated-inputs + `(("r-ggplot2" ,r-ggplot2) + ("r-gridextra" ,r-gridextra))) + (home-page "http://cran.r-project.org/web/packages/ACSNMineR") + (synopsis "Gene enrichment analysis") + (description + "This package provides tools to compute and represent gene set enrichment +or depletion from your data based on pre-saved maps from the @dfn{Atlas of +Cancer Signalling Networks} (ACSN) or user imported maps. The gene set +enrichment can be run with hypergeometric test or Fisher exact test, and can +use multiple corrections. Visualization of data can be done either by +barplots or heatmaps.") + (license license:gpl2+))) + +(define-public r-biocgenerics + (package + (name "r-biocgenerics") + (version "0.16.1") + (source (origin + (method url-fetch) + (uri (bioconductor-uri "BiocGenerics" version)) + (sha256 + (base32 + "0f16ryy5f012hvksrwlmm33bcl7lw97i2jvhbnwfwl03j4w7nhc1")))) + (properties + `((upstream-name . "BiocGenerics") + (r-repository . bioconductor))) + (build-system r-build-system) + (home-page "http://bioconductor.org/packages/BiocGenerics") + (synopsis "S4 generic functions for Bioconductor") + (description + "This package provides S4 generic functions needed by many Bioconductor +packages.") + (license license:artistic2.0))) + +(define-public r-s4vectors + (package + (name "r-s4vectors") + (version "0.8.5") + (source (origin + (method url-fetch) + (uri (bioconductor-uri "S4Vectors" version)) + (sha256 + (base32 + "10f4jxwlwsiy7zhb3kgp6anid0d7wkvrrljl80r3nhx38yr24l5k")))) + (properties + `((upstream-name . "S4Vectors") + (r-repository . bioconductor))) + (build-system r-build-system) + (propagated-inputs + `(("r-biocgenerics" ,r-biocgenerics))) + (home-page "http://bioconductor.org/packages/S4Vectors") + (synopsis "S4 implementation of vectors and lists") + (description + "The S4Vectors package defines the @code{Vector} and @code{List} virtual +classes and a set of generic functions that extend the semantic of ordinary +vectors and lists in R. Package developers can easily implement vector-like +or list-like objects as concrete subclasses of @code{Vector} or @code{List}. +In addition, a few low-level concrete subclasses of general interest (e.g. +@code{DataFrame}, @code{Rle}, and @code{Hits}) are implemented in the +S4Vectors package itself.") + (license license:artistic2.0))) + +(define-public r-iranges + (package + (name "r-iranges") + (version "2.4.6") + (source (origin + (method url-fetch) + (uri (bioconductor-uri "IRanges" version)) + (sha256 + (base32 + "00x0266sys1fc5ipa639y84p6m6mgspk2xb099vcwmd3w4hypj9d")))) + (properties + `((upstream-name . "IRanges") + (r-repository . bioconductor))) + (build-system r-build-system) + (propagated-inputs + `(("r-biocgenerics" ,r-biocgenerics) + ("r-s4vectors" ,r-s4vectors))) + (home-page "http://bioconductor.org/packages/IRanges") + (synopsis "Infrastructure for manipulating intervals on sequences") + (description + "This package provides efficient low-level and highly reusable S4 classes +for storing ranges of integers, RLE vectors (Run-Length Encoding), and, more +generally, data that can be organized sequentially (formally defined as +@code{Vector} objects), as well as views on these @code{Vector} objects. +Efficient list-like classes are also provided for storing big collections of +instances of the basic classes. All classes in the package use consistent +naming and share the same rich and consistent \"Vector API\" as much as +possible.") + (license license:artistic2.0))) + +(define-public r-genomeinfodb + (package + (name "r-genomeinfodb") + (version "1.6.1") + (source (origin + (method url-fetch) + (uri (bioconductor-uri "GenomeInfoDb" version)) + (sha256 + (base32 + "1j2n1v1mrw1fxn7cyffz112pm76wd6gy9q9qwlsfv3brbsqbvdbf")))) + (properties + `((upstream-name . "GenomeInfoDb") + (r-repository . bioconductor))) + (build-system r-build-system) + (propagated-inputs + `(("r-biocgenerics" ,r-biocgenerics) + ("r-iranges" ,r-iranges) + ("r-s4vectors" ,r-s4vectors))) + (home-page "http://bioconductor.org/packages/GenomeInfoDb") + (synopsis "Utilities for manipulating chromosome identifiers") + (description + "This package contains data and functions that define and allow +translation between different chromosome sequence naming conventions (e.g., +\"chr1\" versus \"1\"), including a function that attempts to place sequence +names in their natural, rather than lexicographic, order.") + (license license:artistic2.0))) + +(define-public r-xvector + (package + (name "r-xvector") + (version "0.10.0") + (source (origin + (method url-fetch) + (uri (bioconductor-uri "XVector" version)) + (sha256 + (base32 + "0havwyr6xqk7w0rmbwfj9jq1djz7wzdz7w39adhklwzwz9l4ih3a")))) + (properties + `((upstream-name . "XVector") + (r-repository . bioconductor))) + (build-system r-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'use-system-zlib + (lambda _ + (substitute* "DESCRIPTION" + (("zlibbioc, ") "")) + (substitute* "NAMESPACE" + (("import\\(zlibbioc\\)") "")) + #t))))) + (inputs + `(("zlib" ,zlib))) + (propagated-inputs + `(("r-biocgenerics" ,r-biocgenerics) + ("r-iranges" ,r-iranges) + ("r-s4vectors" ,r-s4vectors))) + (home-page "http://bioconductor.org/packages/XVector") + (synopsis "Representation and manpulation of external sequences") + (description + "This package provides memory efficient S4 classes for storing sequences +\"externally\" (behind an R external pointer, or on disk).") + (license license:artistic2.0))) + +(define-public r-genomicranges + (package + (name "r-genomicranges") + (version "1.22.2") + (source (origin + (method url-fetch) + (uri (bioconductor-uri "GenomicRanges" version)) + (sha256 + (base32 + "1jffvcs0jsi7q4l3pvjj6r73vll80csgkljvhqp0g2ixc43jjng9")))) + (properties + `((upstream-name . "GenomicRanges") + (r-repository . bioconductor))) + (build-system r-build-system) + (propagated-inputs + `(("r-biocgenerics" ,r-biocgenerics) + ("r-genomeinfodb" ,r-genomeinfodb) + ("r-xvector" ,r-xvector))) + (home-page "http://bioconductor.org/packages/GenomicRanges") + (synopsis "Representation and manipulation of genomic intervals") + (description + "This package provides tools to efficiently represent and manipulate +genomic annotations and alignments is playing a central role when it comes to +analyzing high-throughput sequencing data (a.k.a. NGS data). The +GenomicRanges package defines general purpose containers for storing and +manipulating genomic intervals and variables defined along a genome.") + (license license:artistic2.0))) + (define-public r-qtl (package (name "r-qtl") diff --git a/gnu/packages/bittorrent.scm b/gnu/packages/bittorrent.scm index 2410647818..967580d158 100644 --- a/gnu/packages/bittorrent.scm +++ b/gnu/packages/bittorrent.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com> -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,8 +28,7 @@ #:use-module (gnu packages pkg-config) #:use-module (gnu packages file) #:use-module (gnu packages linux) - #:use-module ((gnu packages compression) - #:select (zlib)) + #:use-module (gnu packages compression) #:use-module (gnu packages glib) #:use-module (gnu packages gtk) #:use-module (gnu packages check) diff --git a/gnu/packages/cdrom.scm b/gnu/packages/cdrom.scm index fec1fc9632..f9a1b677b9 100644 --- a/gnu/packages/cdrom.scm +++ b/gnu/packages/cdrom.scm @@ -240,8 +240,9 @@ capacity is user-selectable.") (version "1.4.0") (source (origin (method url-fetch) - (uri (string-append "mirror://sourceforge/libcue/libcue-" - version ".tar.bz2")) + (uri (string-append "https://github.com/lipnitsk/libcue/releases" + "/download/v" version + "/libcue-" version ".tar.bz2")) (sha256 (base32 "17kjd7rjz1bvfn44n3n2bjb7a1ywd0yc0g4sqp5ihf9b5bn7cwlb")))) diff --git a/gnu/packages/code.scm b/gnu/packages/code.scm index 86b131a3e8..e8c936849a 100644 --- a/gnu/packages/code.scm +++ b/gnu/packages/code.scm @@ -280,3 +280,35 @@ stack traces.") ;; Sources are released under Expat license, but since BFD is licensed ;; under the GPLv3+ the combined work is GPLv3+ as well. (license license:gpl3+))) + +(define-public lcov + (package + (name "lcov") + (version "1.10") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/ltp/lcov-" + version ".tar.gz")) + (sha256 + (base32 + "13xq2ln4jjasslqzzhr5g11q1c19gwpng1jphzbzmylmrjz62ila")))) + (build-system gnu-build-system) + (arguments + '(#:make-flags (let ((out (assoc-ref %outputs "out"))) + (list (string-append "PREFIX=" out) + (string-append "BIN_DIR=" out "/bin") + (string-append "MAN_DIR=" out "/share/man"))) + #:phases (modify-phases %standard-phases + (delete 'configure)) + #:tests? #f)) ;no 'check' target + (inputs `(("perl" ,perl))) + (home-page "http://ltp.sourceforge.net/coverage/lcov.php") + (synopsis "Code coverage tool that enhances GNU gcov") + (description + "LCOV is an extension of @command{gcov}, a tool part of the +GNU@tie{}Binutils, which provides information about what parts of a program +are actually executed (i.e., \"covered\") while running a particular test +case. The extension consists of a set of Perl scripts which build on the +textual @command{gcov} output to implement the following enhanced +functionality such as HTML output.") + (license license:gpl2+))) diff --git a/gnu/packages/crypto.scm b/gnu/packages/crypto.scm index d4742ca0e4..a8d675be4c 100644 --- a/gnu/packages/crypto.scm +++ b/gnu/packages/crypto.scm @@ -30,9 +30,12 @@ (version "1.0.0") (source (origin (method url-fetch) - (uri (string-append - "http://download.libsodium.org/libsodium/releases/libsodium-" - version ".tar.gz")) + (uri (list (string-append + "http://download.libsodium.org/libsodium/" + "releases/libsodium-" version ".tar.gz") + (string-append + "https://download.libsodium.org/libsodium/" + "releases/old/libsodium-" version ".tar.gz"))) (sha256 (base32 "19f9vf0shfp4rc4l791r6xjg06z4i8psj1zkjkm3z5b640yzxlff")))) diff --git a/gnu/packages/cups.scm b/gnu/packages/cups.scm index 9dcb75ad91..ff3d1528c6 100644 --- a/gnu/packages/cups.scm +++ b/gnu/packages/cups.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il> ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,7 +38,7 @@ (define-public cups-filters (package (name "cups-filters") - (version "1.0.75") + (version "1.4.0") (source (origin (method url-fetch) (uri @@ -45,7 +46,7 @@ "cups-filters-" version ".tar.xz")) (sha256 (base32 - "0wrh9jmd2rm4z8c8nb50llb10shj1hik9vwqnr0djcvf63mfqsbw")) + "16jpqqlixlv2dxqv8gak5qg4qnsnw4p745xr6rhw9dgylf13z9ha")) (modules '((guix build utils))) (snippet ;; install backends, banners and filters to cups-filters output diff --git a/gnu/packages/cursynth.scm b/gnu/packages/cursynth.scm deleted file mode 100644 index 80f86da241..0000000000 --- a/gnu/packages/cursynth.scm +++ /dev/null @@ -1,53 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.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 cursynth) - #:use-module (guix packages) - #:use-module (guix licenses) - #:use-module (guix download) - #:use-module (guix build-system gnu) - #:use-module (gnu packages) - #:use-module (gnu packages pkg-config) - #:use-module (gnu packages ncurses) - #:use-module (gnu packages linux)) - -(define-public cursynth - (package - (name "cursynth") - (version "1.5") - (source - (origin - (method url-fetch) - (uri (string-append "mirror://gnu/cursynth/cursynth-" - version ".tar.gz")) - (sha256 - (base32 "1dhphsya41rv8z6yqcv9l6fwbslsds4zh1y56zizi39nd996d40v")) - (patches (list (search-patch "cursynth-wave-rand.patch"))))) - (build-system gnu-build-system) - (native-inputs `(("pkg-config" ,pkg-config))) - ;; TODO: See https://github.com/iyoko/cursynth/issues/4 which currently - ;; prevents us from using pulseaudio - (inputs `(("ncurses" ,ncurses) - ("alsa" ,alsa-lib))) - (home-page "http://www.gnu.org/software/cursynth") - (synopsis "Polyphonic and MIDI subtractive music synthesizer using curses") - (description "GNU cursynth is a polyphonic synthesizer that runs -graphically in the terminal. It is built on a full-featured subtractive -synthesis engine. Notes and parameter changes may be entered via MIDI or the -computer's keyboard.") - (license gpl3+))) diff --git a/gnu/packages/databases.scm b/gnu/packages/databases.scm index f45e3a5f1b..b0f973b6aa 100644 --- a/gnu/packages/databases.scm +++ b/gnu/packages/databases.scm @@ -390,14 +390,14 @@ is in the public domain.") (define-public tdb (package (name "tdb") - (version "1.3.0") + (version "1.3.8") (source (origin (method url-fetch) - (uri (string-append "http://samba.org/ftp/tdb/tdb-" + (uri (string-append "https://www.samba.org/ftp/tdb/tdb-" version ".tar.gz")) (sha256 (base32 - "085sd2kii72fr0c4pdc7c7m0xk34nc66wnjp21c83dss826y9gh4")))) + "1cg6gmpgn36dd4bsp3j9k3hyrm87d8hdigqyyqxw5jga4w2aq186")))) (build-system gnu-build-system) (arguments '(#:phases (alist-replace diff --git a/gnu/packages/dictionaries.scm b/gnu/packages/dictionaries.scm index 345d0a26c1..1ecfc3f674 100644 --- a/gnu/packages/dictionaries.scm +++ b/gnu/packages/dictionaries.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,8 +23,7 @@ #:use-module (guix build-system trivial) #:use-module (gnu packages base) #:use-module (gnu packages texinfo) - #:use-module ((gnu packages compression) - #:select (gzip))) + #:use-module (gnu packages compression)) (define-public vera (package diff --git a/gnu/packages/disk.scm b/gnu/packages/disk.scm index 9d3e2f9e32..d806e0c1cd 100644 --- a/gnu/packages/disk.scm +++ b/gnu/packages/disk.scm @@ -29,8 +29,7 @@ #:use-module (gnu packages python) #:use-module (gnu packages readline) #:use-module (gnu packages guile) - #:use-module ((gnu packages compression) - #:select (lzip))) + #:use-module (gnu packages compression)) (define-public parted (package diff --git a/gnu/packages/dns.scm b/gnu/packages/dns.scm index 7d28617f42..8357dad21e 100644 --- a/gnu/packages/dns.scm +++ b/gnu/packages/dns.scm @@ -63,14 +63,14 @@ and BOOTP/TFTP for network booting of diskless machines.") (define-public bind-utils (package (name "bind-utils") - (version "9.10.2-P2") + (version "9.10.3-P2") (source (origin (method url-fetch) - (uri (string-append "ftp://ftp.isc.org/isc/bind9/" version + (uri (string-append "http://ftp.isc.org/isc/bind9/" version "/bind-" version ".tar.gz")) (sha256 (base32 - "0pvcnwd4rzfk3l35ys72p14ly9k857wbn1lxzd4ayjk3i2pz1rmi")))) + "1kbfzml37sx4r2xi4gq48ji8w5kckd1f6gdn6pk6njqdmh8ijv2a")))) (build-system gnu-build-system) (inputs ;; it would be nice to add GeoIP and gssapi once there is package diff --git a/gnu/packages/engineering.scm b/gnu/packages/engineering.scm index 554399b049..ba11f528cb 100644 --- a/gnu/packages/engineering.scm +++ b/gnu/packages/engineering.scm @@ -376,6 +376,57 @@ multipole-accelerated algorithm.") multipole-accelerated algorithm.") (license (license:non-copyleft #f "See induct.c.")))) +(define-public fritzing + (package + (name "fritzing") + (version "0.9.2b") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/fritzing/" + "fritzing-app/archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0pvk57z2pxz89pcwwm61lkpvj4w9qxqz8mi0zkpj6pnaljabp7bf")))) + (build-system gnu-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'configure + (lambda* (#:key inputs outputs #:allow-other-keys) + (and (zero? (system* "tar" + "-xvf" (assoc-ref inputs "fritzing-parts-db") + "-C" "parts")) + (zero? (system* "qmake" + (string-append "PREFIX=" + (assoc-ref outputs "out")) + "phoenix.pro")))))))) + (inputs + `(("qt" ,qt) + ("boost" ,boost) + ("zlib" ,zlib) + ("fritzing-parts-db" + ,(origin + (method url-fetch) + (uri (string-append "https://github.com/fritzing/" + "fritzing-parts/archive/" version ".tar.gz")) + (file-name (string-append "fritzing-parts-" version ".tar.gz")) + (sha256 + (base32 + "0jqr8yjg7177f3pk1fcns584r0qavwpr280nggsi2ff3pwk5wpsz")))))) + (home-page "http://fritzing.org") + (synopsis "Electronic circuit design") + (description + "The Fritzing application is @dfn{Electronic Design Automation} (EDA) +software with a low entry barrier, suited for the needs of makers and +hobbyists. It offers a unique real-life \"breadboard\" view, and a parts +library with many commonly used high-level components. Fritzing makes it very +easy to communicate about circuits, as well as to turn them into PCB layouts +ready for production.") + ;; Documentation and parts are released under CC-BY-SA 3.0; source code is + ;; released under GPLv3+. + (license (list license:gpl3+ license:cc-by-sa3.0)))) + (define-public gerbv (package (name "gerbv") diff --git a/gnu/packages/enlightenment.scm b/gnu/packages/enlightenment.scm index 6224a2a527..9fdcd42a27 100644 --- a/gnu/packages/enlightenment.scm +++ b/gnu/packages/enlightenment.scm @@ -52,7 +52,7 @@ (define-public efl (package (name "efl") - (version "1.16.0") + (version "1.16.1") (source (origin (method url-fetch) (uri (string-append @@ -60,7 +60,7 @@ version ".tar.xz")) (sha256 (base32 - "08w3hrjyz1yjqjq77px86fljxxi5xz5yfy79qwssypafjvcvpzky")))) + "116s4lcfj5lrfhyvvka3np9glqyrh21cyl9rhw7al0wgb60vw0gg")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) @@ -135,7 +135,7 @@ removable devices or support for multimedia.") (define-public elementary (package (name "elementary") - (version "1.16.0") + (version "1.16.1") (source (origin (method url-fetch) (uri @@ -143,7 +143,7 @@ removable devices or support for multimedia.") "elementary/elementary-" version ".tar.xz")) (sha256 (base32 - "1546b7pdpw6nx1hjxy674zr8dgpzwl7lq3hvnv4axkpd4zwkqgs8")))) + "0q58imh7s35q6cq5hsa6gqj84rkckh8s61iass8zyvcw19j66f3y")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) @@ -271,7 +271,7 @@ Libraries with some extra bells and whistles.") (define-public enlightenment (package (name "enlightenment") - (version "0.20.0") + (version "0.20.2") (source (origin (method url-fetch) (uri @@ -279,7 +279,7 @@ Libraries with some extra bells and whistles.") name "/" name "-" version ".tar.xz")) (sha256 (base32 - "0mwiim0nv640v3af7qxc5ajfk702qkl5c1cnqlhz6rqzr5yjapxv")))) + "0faxky7lqd133jjjkr4c40kwwjhqc51ww10l3yy63671rfjhj424")))) (build-system gnu-build-system) (arguments `(#:configure-flags '("--enable-mount-eeze"))) diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm index 3db7ff7835..b8eb75eddd 100644 --- a/gnu/packages/freedesktop.scm +++ b/gnu/packages/freedesktop.scm @@ -35,6 +35,7 @@ #:use-module (gnu packages autotools) #:use-module (gnu packages gettext) #:use-module (gnu packages gperf) + #:use-module (gnu packages gtk) #:use-module (gnu packages xml) #:use-module (gnu packages docbook) #:use-module (gnu packages glib) ;intltool @@ -47,7 +48,8 @@ #:use-module (gnu packages libffi) #:use-module (gnu packages acl) #:use-module (gnu packages admin) - #:use-module (gnu packages polkit)) + #:use-module (gnu packages polkit) + #:use-module (gnu packages databases)) (define-public xdg-utils (package @@ -427,3 +429,173 @@ message bus.") and manipulating user account information and an implementation of these interfaces, based on the useradd, usermod and userdel commands.") (license license:gpl3+))) + +(define-public libmbim + (package + (name "libmbim") + (version "1.12.2") + (source (origin + (method url-fetch) + (uri (string-append + "http://www.freedesktop.org/software/" name "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "0abv0h9c3kbw4bq1b9270sg189jcjj3x3wa91bj836ynwg9m34wl")))) + (build-system gnu-build-system) + (native-inputs + `(("glib:bin" ,glib "bin") ; for glib-mkenums + ("pkg-config" ,pkg-config) + ("python" ,python-wrapper))) + (propagated-inputs + `(("glib" ,glib))) ; required by mbim-glib.pc + (inputs + `(("libgudev" ,libgudev))) + (synopsis "Library to communicate with MBIM-powered modems") + (home-page "http://www.freedesktop.org/wiki/Software/libmbim/") + (description + "Libmbim is a GLib-based library for talking to WWAN modems and devices +which speak the Mobile Interface Broadband Model (MBIM) protocol.") + (license + ;; The libmbim-glib library is released under the LGPLv2+ license. + ;; The mbimcli tool is released under the GPLv2+ license. + (list license:lgpl2.0+ license:gpl2+)))) + +(define-public libqmi + (package + (name "libqmi") + (version "1.12.6") + (source (origin + (method url-fetch) + (uri (string-append + "http://www.freedesktop.org/software/" name "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "101ppan2q1h4pyp2zbn9b8sdwy2c7fk9rp91yykxz3afrvzbymq8")))) + (build-system gnu-build-system) + (native-inputs + `(("glib:bin" ,glib "bin") ; for glib-mkenums + ("pkg-config" ,pkg-config) + ("python" ,python-wrapper))) + (propagated-inputs + `(("glib" ,glib))) ; required by qmi-glib.pc + (synopsis "Library to communicate with QMI-powered modems") + (home-page "http://www.freedesktop.org/wiki/Software/libqmi/") + (description + "Libqmi is a GLib-based library for talking to WWAN modems and devices +which speak the Qualcomm MSM Interface (QMI) protocol.") + (license + ;; The libqmi-glib library is released under the LGPLv2+ license. + ;; The qmicli tool is released under the GPLv2+ license. + (list license:lgpl2.0+ license:gpl2+)))) + +(define-public modem-manager + (package + (name "modem-manager") + (version "1.4.12") + (source (origin + (method url-fetch) + (uri (string-append + "http://www.freedesktop.org/software/ModemManager/" + "ModemManager-" version ".tar.xz")) + (sha256 + (base32 + "1cvhpkbdch9a77sdir0wcks45m2zlvq1sna2ly2v4lx9fm9h7xby")))) + (build-system gnu-build-system) + (arguments + '(#:configure-flags + `(,(string-append "--with-udev-base-dir=" %output "/lib/udev")))) + (native-inputs + `(("glib:bin" ,glib "bin") ; for glib-mkenums + ("gobject-introspection" ,gobject-introspection) + ("intltool" ,intltool) + ("pkg-config" ,pkg-config) + ("vala" ,vala) + ;; For testing. + ("dbus" ,dbus))) + (propagated-inputs + `(("glib" ,glib))) ; required by mm-glib.pc + (inputs + `(("libgudev" ,libgudev) + ("libmbim" ,libmbim) + ("libqmi" ,libqmi) + ("polkit" ,polkit))) + (synopsis "Mobile broadband modems manager") + (home-page "http://www.freedesktop.org/wiki/Software/ModemManager/") + (description + "ModemManager is a DBus-activated daemon which controls mobile +broadband (2G/3G/4G) devices and connections. Whether built-in devices, USB +dongles, bluetooth-paired telephones, or professional RS232/USB devices with +external power supplies, ModemManager is able to prepare and configure the +modems and setup connections with them.") + (license license:gpl2+))) + +(define-public telepathy-logger + (package + (name "telepathy-logger") + (version "0.8.2") + (source (origin + (method url-fetch) + (uri (string-append "http://telepathy.freedesktop.org/releases/" + name "/" name "-" version ".tar.bz2")) + (sha256 + (base32 + "1bjx85k7jyfi5pvl765fzc7q2iz9va51anrc2djv7caksqsdbjlg")))) + (build-system gnu-build-system) + (arguments + '(#:phases + (modify-phases %standard-phases + (add-before 'check 'pre-check + (lambda _ + (setenv "HOME" (getenv "TMPDIR")) + #t))))) + (native-inputs + `(("glib:bin" ,glib "bin") ; for glib-genmarshal, etc. + ("gobject-introspection" ,gobject-introspection) + ("intltool" ,intltool) + ("pkg-config" ,pkg-config) + ("python" ,python-2) + ("xsltproc" ,libxslt))) + (propagated-inputs + ;; telepathy-logger-0.2.pc refers to all these. + `(("libxml2" ,libxml2) + ("sqlite" ,sqlite) + ("telepathy-glib" ,telepathy-glib))) + (synopsis "Telepathy logger library") + (home-page "http://telepathy.freedesktop.org/") + (description + "Telepathy logger is a headless observer client that logs information +received by the Telepathy framework. It features pluggable backends to log +different sorts of messages in different formats.") + (license license:lgpl2.1+))) + +(define-public colord-gtk + (package + (name "colord-gtk") + (version "0.1.26") + (source (origin + (method url-fetch) + (uri (string-append "http://www.freedesktop.org/software/colord" + "/releases/" name "-" version ".tar.xz")) + (sha256 + (base32 + "0i9y3bb5apj6a0f8cx36l6mjzs7xc0k7nf0magmf58vy2mzhpl18")))) + (build-system gnu-build-system) + (arguments '(#:tests? #f)) ; require the colord system service + (native-inputs + `(("gobject-introspection" ,gobject-introspection) + ("intltool" ,intltool) + ("pkg-config" ,pkg-config) + ("vala" ,vala))) + (propagated-inputs + ;; colord-gtk.pc refers to all these. + `(("colord" ,colord) + ("gtk+" ,gtk+))) + (synopsis "GTK integration for libcolord") + (home-page "http://www.freedesktop.org/software/colord/") + (description + "This is a GTK+ convenience library for interacting with colord. It is +useful for both applications which need colour management and applications that +wish to perform colour calibration.") + (license license:lgpl2.1+))) diff --git a/gnu/packages/game-development.scm b/gnu/packages/game-development.scm index 1e3854aab1..0274904197 100644 --- a/gnu/packages/game-development.scm +++ b/gnu/packages/game-development.scm @@ -266,14 +266,14 @@ archive on a per-file basis.") (define-public love (package (name "love") - (version "0.9.2") + (version "0.10.0") (source (origin (method url-fetch) (uri (string-append "https://bitbucket.org/rude/love/downloads/" "love-" version "-linux-src.tar.gz")) (sha256 (base32 - "0wn1npr5gal5b1idh4a5fwc3f5c36lsbjd4r4d699rqlviid15d9")))) + "1r2n1nrw3hcdvy14fjbwz3l9swcy65v3lqwpj2frnkkcwncdz94p")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) @@ -281,6 +281,7 @@ archive on a per-file basis.") `(("devil" ,devil) ("freetype" ,freetype) ("libmodplug" ,libmodplug) + ("libtheora" ,libtheora) ("libvorbis" ,libvorbis) ("luajit" ,luajit) ("mesa" ,mesa) diff --git a/gnu/packages/gcc.scm b/gnu/packages/gcc.scm index ed7bb5d682..832e57bc77 100644 --- a/gnu/packages/gcc.scm +++ b/gnu/packages/gcc.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014, 2015 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> +;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il> ;;; ;;; This file is part of GNU Guix. ;;; @@ -343,14 +344,14 @@ Go. It also includes runtime support libraries for these languages.") (define-public gcc-5 (package (inherit gcc-4.9) - (version "5.2.0") + (version "5.3.0") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/gcc/gcc-" version "/gcc-" version ".tar.bz2")) (sha256 (base32 - "1bccp8a106xwz3wkixn65ngxif112vn90qf95m6lzpgpnl25p0sz")) + "1ny4smkp5bzs3cp8ss7pl6lk8yss0d9m4av1mvdp72r1x695akxq")) (patches (list (search-patch "gcc-5.0-libvtv-runpath.patch"))))))) (define-public gcc gcc-4.9) diff --git a/gnu/packages/gimp.scm b/gnu/packages/gimp.scm index ebf66d478e..00feb1c131 100644 --- a/gnu/packages/gimp.scm +++ b/gnu/packages/gimp.scm @@ -27,8 +27,7 @@ #:use-module (gnu packages gtk) #:use-module (gnu packages gnome) #:use-module (gnu packages image) - #:use-module ((gnu packages ghostscript) - #:select (lcms)) + #:use-module (gnu packages ghostscript) #:use-module (gnu packages compression) #:use-module (gnu packages xml) #:use-module (gnu packages photo) @@ -128,6 +127,12 @@ buffers.") (base32 "0bdj0l7a94jqhjnj40m9rqaf622wj905iximivb55iy98639aanq")))) (build-system gnu-build-system) + (outputs '("out" + "doc")) ;8 MiB of gtk-doc HTML + (arguments + '(#:configure-flags (list (string-append "--with-html-dir=" + (assoc-ref %outputs "doc") + "/share/gtk-doc/html")))) (inputs `(("babl" ,babl) ("glib" ,glib) diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index c17dd19802..aa9fb6fded 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -42,6 +42,7 @@ #:use-module (gnu packages base) #:use-module (gnu packages bison) #:use-module (gnu packages calendar) + #:use-module (gnu packages check) #:use-module (gnu packages cups) #:use-module (gnu packages curl) #:use-module (gnu packages databases) @@ -58,10 +59,12 @@ #:use-module (gnu packages gtk) #:use-module (gnu packages gperf) #:use-module (gnu packages guile) + #:use-module (gnu packages openldap) #:use-module (gnu packages pdf) #:use-module (gnu packages polkit) #:use-module (gnu packages popt) #:use-module (gnu packages ghostscript) + #:use-module (gnu packages ibus) #:use-module (gnu packages iso-codes) #:use-module (gnu packages libcanberra) #:use-module (gnu packages linux) @@ -71,6 +74,7 @@ #:use-module (gnu packages m4) #:use-module (gnu packages image) #:use-module (gnu packages networking) + #:use-module (gnu packages password-utils) #:use-module (gnu packages perl) #:use-module (gnu packages photo) #:use-module (gnu packages pkg-config) @@ -91,6 +95,7 @@ #:use-module (gnu packages xdisorg) #:use-module (gnu packages freedesktop) #:use-module (gnu packages mail) + #:use-module (gnu packages mit-krb5) #:use-module (gnu packages backup) #:use-module (gnu packages nettle) #:use-module (gnu packages ncurses) @@ -152,7 +157,7 @@ features to enable users to create their discs easily and quickly.") (define-public gnome-common (package (name "gnome-common") - (version "3.14.0") + (version "3.18.0") (source (origin (method url-fetch) @@ -161,7 +166,7 @@ features to enable users to create their discs easily and quickly.") name "-" version ".tar.xz")) (sha256 (base32 - "0b1676g4q44ah73c5gwl1kg88pc93pnq1pa9kwl43d0vg0pj802c")))) + "1kzqi8qvh5p1zncj8msazlmvcwsczjz2hqxp4x2y0mg718vrwmi2")))) (build-system gnu-build-system) (home-page "https://www.gnome.org/") (synopsis "Bootstrap GNOME modules built from Git") @@ -328,7 +333,7 @@ GNOME Desktop.") (define-public gnome-keyring (package (name "gnome-keyring") - (version "3.16.0") + (version "3.18.3") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -336,7 +341,7 @@ GNOME Desktop.") name "-" version ".tar.xz")) (sha256 (base32 - "1xg1xha3x3hzlmvdq2zm90hc61pj7pnf9yxxvgq4ynl5af6bp8qm")))) + "167dq1yvm080g5s38hqjl0xx5cgpkcl1xqy9p5sxmgc92zb0srrz")))) (build-system gnu-build-system) (arguments `(#:tests? #f ;48 of 603 tests fail because /var/lib/dbus/machine-id does @@ -368,6 +373,7 @@ GNOME Desktop.") "/xml/dtd/docbook/catalog.xml"))))))) (inputs `(("libgcrypt" ,libgcrypt) + ("linux-pam" ,linux-pam) ("dbus" ,dbus) ("gcr" ,gcr))) (native-inputs @@ -584,7 +590,7 @@ update-desktop-database: updates the database containing a cache of MIME types (define-public adwaita-icon-theme (package (inherit gnome-icon-theme) (name "adwaita-icon-theme") - (version "3.16.2") + (version "3.18.0") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -592,7 +598,7 @@ update-desktop-database: updates the database containing a cache of MIME types name "-" version ".tar.xz")) (sha256 (base32 - "1hmlw7kvhr7c2asc5y77adpymi9ka17gaf76zz835nwwffnn4rlw")))))) + "0n0fqlg55krw8pgn4z2vxnxh65lyvcydqkrr7klqxp8z00kfg72y")))))) (define-public shared-mime-info (package @@ -1467,6 +1473,12 @@ Hints specification (EWMH).") (sha256 (base32 "0nmghi26dpjcw7knkviq031crhm0zjy4k650pv1jj3hb1fmhx9yd")))) (build-system gnu-build-system) + (outputs '("out" + "doc")) ;4.1 MiB of gtk-doc + (arguments + '(#:configure-flags (list (string-append "--with-html-dir=" + (assoc-ref %outputs "doc") + "/share/gtk-doc/html")))) (inputs `(("gtk+" ,gtk+) ("libgsf" ,libgsf) @@ -1504,7 +1516,9 @@ Hints specification (EWMH).") ;; https://bugzilla.gnome.org/show_bug.cgi?id=670316 (substitute* "configure" (("glib/gregex\\.h") "glib.h")) #t) - %standard-phases))) + %standard-phases) + + ,@(package-arguments goffice))) (propagated-inputs ;; libgoffice-0.8.pc mentions libgsf-1 `(("libgsf" ,libgsf))) @@ -1615,7 +1629,7 @@ engineering.") (define-public seahorse (package (name "seahorse") - (version "3.16.0") + (version "3.18.0") (source (origin (method url-fetch) @@ -1624,15 +1638,17 @@ engineering.") version ".tar.xz")) (sha256 (base32 - "0cg1grgpwbfkiny5148n17rzpc8kswyr5yff0kpm8l3lp01my2kp")))) + "0rxnq47xcagmpqb63g49ay3lfiyjjnmmiay9yifx5jn406d8h32k")))) (build-system glib-or-gtk-build-system) (inputs `(("gtk+" ,gtk+) ("gcr" ,gcr) - ("gnupg" ,gnupg-1) + ("gnupg" ,gnupg) ("gpgme" ,gpgme) + ("openldap" ,openldap) ("openssh" ,openssh) - ("libsecret" ,libsecret))) + ("libsecret" ,libsecret) + ("libsoup" ,libsoup))) (native-inputs `(("intltool" ,intltool) ("glib:bin" ,glib "bin") @@ -1765,7 +1781,7 @@ editors, IDEs, etc.") (define-public dconf (package (name "dconf") - (version "0.22.0") + (version "0.24.0") (source (origin (method url-fetch) (uri (string-append @@ -1773,7 +1789,8 @@ editors, IDEs, etc.") (version-major+minor version) "/" name "-" version ".tar.xz")) (sha256 - (base32 "13jb49504bir814v8n8vjip5sazwfwsrnniw87cpg7phqfq7q9qa")))) + (base32 + "1hpy6336f0pbkyranywm4872i5in0xn7jf40a66xdmzls77f0ws3")))) (build-system glib-or-gtk-build-system) (inputs `(("gtk+" ,gtk+) @@ -2125,7 +2142,7 @@ and other secrets. It communicates with the \"Secret Service\" using DBus.") (define-public gnome-mines (package (name "gnome-mines") - (version "3.16.0") + (version "3.18.2") (source (origin (method url-fetch) @@ -2134,7 +2151,7 @@ and other secrets. It communicates with the \"Secret Service\" using DBus.") name "-" version ".tar.xz")) (sha256 (base32 - "0wfvqyryc1093l4dr75zv9h0jyn28z6wirdq03lm5w24qf9lvjjx")))) + "0izkcf81rji4dj9k0k93ij4lp5iza2bh6jwlcdhbjfv2xdw0f7ky")))) (build-system glib-or-gtk-build-system) (arguments '(#:phases @@ -2171,7 +2188,7 @@ floating in an ocean using only your brain and a little bit of luck.") (define-public gnome-terminal (package (name "gnome-terminal") - (version "3.16.0") + (version "3.18.2") (source (origin (method url-fetch) @@ -2180,7 +2197,7 @@ floating in an ocean using only your brain and a little bit of luck.") name "-" version ".tar.xz")) (sha256 (base32 - "1s3zwqxs4crlqmh6l7s7n87pbmh2nnjdvhxlkalh58pbl0bk0qrd")))) + "1ylyv0mla2ypms7iyxndbdjvha0q9jzglb4mhfmqn9cm2gxc0day")))) (build-system glib-or-gtk-build-system) (arguments '(#:configure-flags @@ -2330,7 +2347,7 @@ permission from user.") (define-public geocode-glib (package (name "geocode-glib") - (version "3.16.0") + (version "3.18.0") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/geocode-glib/" @@ -2338,7 +2355,7 @@ permission from user.") name "-" version ".tar.xz")) (sha256 (base32 - "1cbfv0kds6b6k0cl7q47xpj3x1scwcd7m68zl1rf7i4hmhw4hpqj")))) + "0pa9cgndycynipc6z8wzbvn2fi89ndf2gpqzm9m6krp3d7az1dwg")))) (build-system gnu-build-system) (arguments `(;; The tests want to write to $HOME/.cache/geocode-glib, which doesn't @@ -2466,7 +2483,7 @@ services for numerous locations.") (define-public gnome-settings-daemon (package (name "gnome-settings-daemon") - (version "3.16.0") + (version "3.18.2") (source (origin (method url-fetch) @@ -2475,7 +2492,7 @@ services for numerous locations.") name "-" version ".tar.xz")) (sha256 (base32 - "1w29x2izq59125ga5ncmmaklc8kw7x7rdn6swn26bs23mah1r1g3")))) + "0vzwf875csyqx04fnra6zicmzcjc3s13bxxpcizlys12iwjwfw9h")))) (build-system glib-or-gtk-build-system) (arguments `(;; Network manager not yet packaged. @@ -2557,7 +2574,7 @@ playlists in a variety of formats.") (define-public aisleriot (package (name "aisleriot") - (version "3.16.1") + (version "3.18.2") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -2565,7 +2582,7 @@ playlists in a variety of formats.") name "-" version ".tar.xz")) (sha256 (base32 - "19k483x9dkq8vjbq8f333pk9qil64clpsfg20q8xk9bgmk38aj8h")))) + "1qrgcj30hl0fgssspkwrad10lqy1bbsp7lfwxmxlwzp33jhqpb0b")))) (build-system glib-or-gtk-build-system) (arguments '(#:configure-flags @@ -2593,7 +2610,7 @@ which are easy to play with the aid of a mouse.") (define-public devhelp (package (name "devhelp") - (version "3.16.1") + (version "3.18.1") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -2601,7 +2618,7 @@ which are easy to play with the aid of a mouse.") name "-" version ".tar.xz")) (sha256 (base32 - "0i8kyh86hzwxs8dm047ivghl2b92vigdxa3x4pk4ha0whpk38g37")))) + "1vqsqpc51cir5qf801ibh6ljlpfw0qd513l9hjcnzp4ls8m1cfih")))) (build-system glib-or-gtk-build-system) (native-inputs `(("intltool" ,intltool) @@ -2740,7 +2757,7 @@ presentations, kiosk style applications and so on.") (define-public clutter-gtk (package (name "clutter-gtk") - (version "1.6.0") + (version "1.6.6") (source (origin (method url-fetch) @@ -2749,12 +2766,13 @@ presentations, kiosk style applications and so on.") name "-" version ".tar.xz")) (sha256 (base32 - "0k93hbf5d1970hs7vjddr3nnngygc7mxqbj474r3cdm0fjsm0dc8")))) + "0a2a8ci6in82l43zak3zj3cyms23i5rq6lzk1bz013gm023ach4l")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config) ("gobject-introspection" ,gobject-introspection))) - (inputs + (propagated-inputs + ;; clutter-gtk.pc refers to all these. `(("clutter" ,clutter) ("gtk+" ,gtk+))) (home-page "http://www.clutter-project.org") @@ -2768,7 +2786,7 @@ presentations, kiosk style applications and so on.") (define-public clutter-gst (package (name "clutter-gst") - (version "3.0.6") + (version "3.0.14") (source (origin (method url-fetch) @@ -2777,7 +2795,7 @@ presentations, kiosk style applications and so on.") name "-" version ".tar.xz")) (sha256 (base32 - "0xnzfdzawl1kdx715gp31nwjp7a1kib094s7xvg7bhbwwlx4kmfn")))) + "1qidm0q28q6w8gjd0gpqnk8fzqxv39dcp0vlzzawlncp8zfagj7p")))) (build-system gnu-build-system) (native-inputs `(("glib:bin" ,glib "bin") ; for glib-mkenums @@ -2799,7 +2817,7 @@ GL based interactive canvas library.") (define-public libchamplain (package (name "libchamplain") - (version "0.12.10") + (version "0.12.12") (source (origin (method url-fetch) (uri (string-append @@ -2807,7 +2825,7 @@ GL based interactive canvas library.") version ".tar.xz")) (sha256 (base32 - "019b8scnx7d3wdylmpk9ihzh06w25b63x9cn8nhj6kjx82rcwlxz")))) + "19jlhbgfn9c9g40b3fa2x373s6rfcwx5i9lbpl3vl7d901r7kpp7")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) (propagated-inputs @@ -2863,7 +2881,7 @@ queries upon that data.") (define-public gnome-klotski (package (name "gnome-klotski") - (version "3.16.1") + (version "3.18.2") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -2871,7 +2889,7 @@ queries upon that data.") name "-" version ".tar.xz")) (sha256 (base32 - "0a64935c7pp51jhaf29q9zlx3lamj7zrhyff7clvv0w8v1w6gpax")))) + "14l1fji0860yam41x2cy72nd9bljph385ynfm6k1lsv4qhv72az2")))) (build-system glib-or-gtk-build-system) (native-inputs `(("desktop-file-utils" ,desktop-file-utils) @@ -2894,7 +2912,7 @@ as possible!") (define-public grilo (package (name "grilo") - (version "0.2.12") + (version "0.2.14") (source (origin (method url-fetch) @@ -2903,7 +2921,7 @@ as possible!") name "-" version ".tar.xz")) (sha256 (base32 - "11bvc7rsrjjwz8hp67p3fn8zmywrpawrcbi3vgw8b0dwa0sndd2m")))) + "1k8wj8f7xfaw5hxypnmwd34li3fq8h76dacach547rvsfjhjxj3r")))) (build-system gnu-build-system) (native-inputs `(("glib:bin" ,glib "bin") ; for glib-mkenums and glib-genmarshal @@ -2945,7 +2963,7 @@ for application developers.") (define-public grilo-plugins (package (name "grilo-plugins") - (version "0.2.14") + (version "0.2.16") (source (origin (method url-fetch) @@ -2954,7 +2972,7 @@ for application developers.") name "-" version ".tar.xz")) (sha256 (base32 - "1aykhc679pwn2qxsg19g8nh9hffpsqkgxcbqq7lcfn2hcwb83wfh")))) + "00sjmkzxc8w4qn4lp5yj65c4y83mwhp0zlvk11ghvpxnklgmgd40")))) (build-system gnu-build-system) (native-inputs `(("glib:bin" ,glib "bin") ; for glib-mkenums and glib-genmarshal @@ -2997,7 +3015,7 @@ for application developers.") (define-public totem (package (name "totem") - (version "3.16.1") + (version "3.18.1") (source (origin (method url-fetch) @@ -3006,7 +3024,7 @@ for application developers.") name "-" version ".tar.xz")) (sha256 (base32 - "1nkm2i271ivq40hryrl6px39gbbvhmlx4vmvwvw4h3z8xh3013f9")))) + "18h784c77m4h359j3xnlwqlfvnhbw7m052ahzm26r106jsp6x0fp")))) (build-system glib-or-gtk-build-system) (native-inputs `(("pkg-config" ,pkg-config) @@ -3163,7 +3181,7 @@ supports playlists, song ratings, and any codecs installed through gstreamer.") (define-public eog (package (name "eog") - (version "3.16.2") + (version "3.18.1") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -3171,7 +3189,7 @@ supports playlists, song ratings, and any codecs installed through gstreamer.") name "-" version ".tar.xz")) (sha256 (base32 - "0frw1b5jix9pffznav5s7ajjx91a8rv5lf4sjvjv3fw65mbnhbw0")))) + "19wkawrcwjjcvlmizkj57qycnbgizhr8ck3j5qg70605d1xb8yvv")))) (build-system glib-or-gtk-build-system) (arguments `(#:phases @@ -3327,7 +3345,7 @@ DAV, and others.") (lambda _ (and (zero? (system* "gtkdocize")) (zero? (system* "autoreconf" "-vif")))))))) - (home-page "https://github/hughsie/libgusb") + (home-page "https://github.com/hughsie/libgusb") (synopsis "GLib binding for libusb1") (description "GUsb is a GObject wrapper for libusb1 that makes it easy to do @@ -3484,7 +3502,7 @@ of running programs and invoke methods on those interfaces.") (define-public yelp-xsl (package (name "yelp-xsl") - (version "3.16.1") + (version "3.18.1") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -3492,7 +3510,7 @@ of running programs and invoke methods on those interfaces.") name "-" version ".tar.xz")) (sha256 (base32 - "0jhpni4mmfvj3xf57rjm61nc8d0x66hz9gd1ywws5lh39g6fx59j")))) + "0qmsq7qkc06gmnkvbs84qj3jjzlihriy3z45nfbpgg51b6z0z1q0")))) (build-system gnu-build-system) (native-inputs `(("intltool" ,intltool) @@ -3543,7 +3561,7 @@ freedesktop.org help system specification.") (define-public yelp-tools (package (name "yelp-tools") - (version "3.16.1") + (version "3.18.0") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -3551,7 +3569,7 @@ freedesktop.org help system specification.") name "-" version ".tar.xz")) (sha256 (base32 - "177qzvj5w019isdp41qxqcys2kc4sq2x6dqhqn6l9ipib8a6rxml")))) + "0ck9f78c1xka8a823bd7w1k0gdn4k19zvaj7viy2d5r3h1gxdhf6")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) @@ -3696,7 +3714,7 @@ share them with others via social networking and more.") (define-public file-roller (package (name "file-roller") - (version "3.10.0") + (version "3.16.4") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -3704,7 +3722,7 @@ share them with others via social networking and more.") name "-" version ".tar.xz")) (sha256 (base32 - "04sg4yzz4c3hzgxhbgx2dc36lq5hjrnrmal2q0amfvhl0jcvp2fq")))) + "11a1g8f2700n2mz998wf40dz1rxjgap60mfns9iv0zlw5h5rhmal")))) (build-system glib-or-gtk-build-system) (native-inputs `(("intltool" ,intltool) @@ -3738,7 +3756,7 @@ such as gzip tarballs.") (sha256 (base32 "0icajbzqf5llvp5s8nafwkhwz6a6jmwn4hhs81bk0bpzawyq4zdk")))) - (build-system gnu-build-system) + (build-system glib-or-gtk-build-system) (native-inputs `(("glib:bin" ,glib "bin") ; for glib-compile-schemas, etc. ("pkg-config" ,pkg-config) @@ -3746,6 +3764,7 @@ such as gzip tarballs.") ("xsltproc" ,libxslt))) (inputs `(("gnome-desktop" ,gnome-desktop) + ("gsettings-desktop-schemas" ,gsettings-desktop-schemas) ("gtk+" ,gtk+) ("json-glib" ,json-glib) ("libsm" ,libsm) @@ -4259,3 +4278,275 @@ the available networks and allows users to easily switch between them.") "This package provides a C++ wrapper for the XML parser library libxml2.") (license license:lgpl2.1+))) + +(define-public gdm + (package + (name "gdm") + (version "3.18.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/" + (version-major+minor version) "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "08pqhslwd487nh9w0jp4d0s4s2imm4ds0jjsbl6lzmqifqj3b4jl")))) + (build-system gnu-build-system) + (arguments + '(#:configure-flags + '("--without-plymouth") + #:phases + (modify-phases %standard-phases + (add-before + 'configure 'pre-configure + (lambda _ + ;; We don't have <systemd/sd-daemon.h>. + (substitute* '("common/gdm-log.c" + "daemon/gdm-server.c" + "daemon/gdm-session-worker.c" + "daemon/gdm-session-worker-job.c") + (("#include <systemd/sd-daemon\\.h>") "")) + ;; Use elogind for sd-login. + (substitute* '("common/gdm-common.c" + "daemon/gdm-manager.c" + "libgdm/gdm-user-switching.c") + (("#include <systemd/sd-login\\.h>") + "#include <elogind/sd-login.h>")) + ;; Avoid checking SYSTEMD using pkg-config. + (setenv "SYSTEMD_CFLAGS" " ") + (setenv "SYSTEMD_LIBS" "-lelogind") + #t))))) + (native-inputs + `(("dconf" ,dconf) + ("glib:bin" ,glib "bin") ; for glib-compile-schemas, etc. + ("gobject-introspection" ,gobject-introspection) + ("intltool" ,intltool) + ("itstool" ,itstool) + ("pkg-config" ,pkg-config) + ("xmllint" ,libxml2))) + (inputs + `(("accountsservice" ,accountsservice) + ("check" ,check) ; for testing + ("elogind" ,elogind) + ("gtk+" ,gtk+) + ("iso-codes" ,iso-codes) + ("libcanberra" ,libcanberra) + ("linux-pam" ,linux-pam))) + (synopsis "Display manager for GNOME") + (home-page "http://wiki.gnome.org/Projects/GDM/") + (description + "GNOME Display Manager is a system service that is responsible for +providing graphical log-ins and managing local and remote displays.") + (license license:gpl2+))) + +(define-public libgtop + (package + (name "libgtop") + (version "2.32.0") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/" + (version-major+minor version) "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "13hpml2vfm23816qggr5fvxj75ndb1dq4rgmi7ik6azj69ij8hw4")))) + (build-system gnu-build-system) + (native-inputs + `(("gobject-introspection" ,gobject-introspection) + ("intltool" ,intltool) + ("perl" ,perl) + ("pkg-config" ,pkg-config))) + (propagated-inputs + `(("glib" ,glib))) ; required by libgtop-2.0.pc + (synopsis "Portable system access library") + (home-page "https://www.gnome.org/") + (description + "LibGTop is a library to get system specific data such as CPU and memory +usage and information about running processes.") + (license license:gpl2+))) + +(define-public gnome-bluetooth + (package + (name "gnome-bluetooth") + (version "3.18.1") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/" + (version-major+minor version) "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "0jaa9nbygdvcqp9k4p4iy2g8x3684s4x9k5nbcmmm11jdn4mn7f5")))) + (build-system glib-or-gtk-build-system) + (native-inputs + `(("glib:bin" ,glib "bin") ; for gdbus-codegen, etc. + ("gobject-introspection" ,gobject-introspection) + ("intltool" ,intltool) + ("pkg-config" ,pkg-config) + ("xmllint" ,libxml2))) + (propagated-inputs + ;; gnome-bluetooth-1.0.pc refers to all these. + `(("gtk+" ,gtk+) + ("udev" ,eudev))) + (inputs + `(("libcanberra" ,libcanberra) + ("libnotify" ,libnotify))) + (synopsis "GNOME Bluetooth subsystem") + (home-page "https://wiki.gnome.org/Projects/GnomeBluetooth") + (description + "This package contains tools for managing and manipulating Bluetooth +devices using the GNOME desktop.") + (license license:lgpl2.1+))) + +(define-public gnome-control-center + (package + (name "gnome-control-center") + (version "3.18.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/" + (version-major+minor version) "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "1bgqg1sl3cp2azrwrjgwx3jzk9n3w76xpcyvk257qavx4ibn3zin")))) + (build-system glib-or-gtk-build-system) + (arguments + '(#:phases + (modify-phases %standard-phases + (add-before 'configure 'patch-paths + (lambda* (#:key inputs #:allow-other-keys) + (let ((libc (assoc-ref inputs "libc")) + (tzdata (assoc-ref inputs "tzdata"))) + (substitute* "panels/datetime/tz.h" + (("/usr/share/zoneinfo/zone.tab") + (string-append tzdata "/share/zoneinfo/zone.tab"))) + (substitute* "panels/datetime/test-endianess.c" + (("/usr/share/locale") + (string-append libc "/share/locale"))) + #t)))))) + (native-inputs + `(("glib:bin" ,glib "bin") ; for glib-mkenums, etc. + ("intltool" ,intltool) + ("pkg-config" ,pkg-config) + ("xsltproc" ,libxslt))) + (inputs + `(("accountsservice" ,accountsservice) + ("clutter-gtk" ,clutter-gtk) + ("colord-gtk" ,colord-gtk) + ("cups" ,cups) + ("dconf" ,dconf) + ("docbook-xsl" ,docbook-xsl) + ("gnome-bluetooth" ,gnome-bluetooth) + ("gnome-desktop" ,gnome-desktop) + ("gnome-online-accounts" ,gnome-online-accounts) + ("gnome-settings-daemon" ,gnome-settings-daemon) + ("grilo" ,grilo) + ("ibus" ,ibus) + ("libcanberra" ,libcanberra) + ("libgudev" ,libgudev) + ("libgtop" ,libgtop) + ("libpwquality" ,libpwquality) + ("libsoup" ,libsoup) + ("libxml2" ,libxml2) + ("libwacom" ,libwacom) + ("mesa" ,mesa) + ("mit-krb5" ,mit-krb5) + ("modem-manager" ,modem-manager) + ("network-manager-applet" ,network-manager-applet) + ("polkit" ,polkit) + ("pulseaudio" ,pulseaudio) + ("smbclient" ,samba) + ("tzdata" ,tzdata) + ("upower" ,upower))) + (synopsis "Utilities to configure the GNOME desktop") + (home-page "https://www.gnome.org/") + (description + "This package contains configuration applets for the GNOME desktop, +allowing to set accessibility configuration, desktop fonts, keyboard and mouse +properties, sound setup, desktop theme and background, user interface +properties, screen resolution, and other GNOME parameters.") + (license license:gpl2+))) + +(define-public gnome-shell + (package + (name "gnome-shell") + (version "3.18.3") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/" + (version-major+minor version) "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "16sicxdp08yfaj4hiyzvbspb5jk3fpmi291272zhx5vgc3wbl5w5")))) + (build-system glib-or-gtk-build-system) + (arguments + '(#:phases + (modify-phases %standard-phases + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (keysdir (string-append + out "/share/gnome-control-center/keybindings"))) + (zero? (system* "make" + (string-append "keysdir=" keysdir) + "install"))))) + (add-after + 'install 'wrap-programs + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out")) + (gi-typelib-path (getenv "GI_TYPELIB_PATH")) + (python-path (getenv "PYTHONPATH"))) + (wrap-program (string-append out "/bin/gnome-shell") + `("GI_TYPELIB_PATH" ":" prefix (,gi-typelib-path))) + (for-each + (lambda (prog) + (wrap-program (string-append out "/bin/" prog) + `("PYTHONPATH" ":" prefix (,python-path)) + `("GI_TYPELIB_PATH" ":" prefix (,gi-typelib-path)))) + '("gnome-shell-extension-tool" "gnome-shell-perf-tool")) + #t)))))) + (native-inputs + `(("glib:bin" ,glib "bin") ; for glib-compile-schemas, etc. + ("gobject-introspection" ,gobject-introspection) + ("intltool" ,intltool) + ("pkg-config" ,pkg-config) + ("python" ,python) + ("xsltproc" ,libxslt))) + (inputs + `(("accountsservice" ,accountsservice) + ("caribou" ,caribou) + ("docbook-xsl" ,docbook-xsl) + ("evolution-data-server" ,evolution-data-server) + ("gcr" ,gcr) + ("gdm" ,gdm) + ("gjs" ,gjs) + ("gnome-bluetooth" ,gnome-bluetooth) + ("gnome-control-center" ,gnome-control-center) + ("gnome-desktop" ,gnome-desktop) + ("gnome-settings-daemon" ,gnome-settings-daemon) + ("gst-plugins-base" ,gst-plugins-base) + ("ibus" ,ibus) + ("libcanberra" ,libcanberra) + ("libcroco" ,libcroco) + ("libgweather" ,libgweather) + ("libsoup" ,libsoup) + ("mesa-headers" ,mesa-headers) + ("mutter" ,mutter) + ("network-manager-applet" ,network-manager-applet) + ("polkit" ,polkit) + ("pulseaudio" ,pulseaudio) + ("python-pygobject" ,python-pygobject) + ("startup-notification" ,startup-notification) + ("telepathy-logger" ,telepathy-logger) + ("upower" ,upower) + ;; XXX: required by libgjs.la. + ("readline" ,readline))) + (synopsis "Desktop shell for GNOME") + (home-page "https://wiki.gnome.org/Projects/GnomeShell") + (description + "GNOME Shell provides core user interface functions for the GNOME desktop, +like switching to windows and launching applications.") + (license license:gpl2+))) diff --git a/gnu/packages/gnunet.scm b/gnu/packages/gnunet.scm index 2a4c5cfeed..11e5aa8733 100644 --- a/gnu/packages/gnunet.scm +++ b/gnu/packages/gnunet.scm @@ -114,14 +114,14 @@ tool to extract metadata from a file and print the results.") (define-public libmicrohttpd (package (name "libmicrohttpd") - (version "0.9.47") + (version "0.9.48") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/libmicrohttpd/libmicrohttpd-" version ".tar.gz")) (sha256 (base32 - "1335kznai5ih3kmavl1707sr4sakk0cc0srl5aax77x0a91spgcn")))) + "1952z36lf31jy0x19r4y389d9188wgzmdqh2l28wdy1biwapwrl7")))) (build-system gnu-build-system) (inputs `(("curl" ,curl) diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index af01749545..aeee440b7e 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -273,14 +273,14 @@ libskba (working with X.509 certificates and CMS data).") (define-public gnupg-1 (package (inherit gnupg) - (version "1.4.19") + (version "1.4.20") (source (origin (method url-fetch) (uri (string-append "mirror://gnupg/gnupg/gnupg-" version ".tar.bz2")) (sha256 (base32 - "11pxx26sfilh0vswylh9mhiifw5yffw7nn733zknw3sb0jfk22bz")))) + "1k7d6zi0zznqsmcjic0yrgfhqklqz3qgd3yac7wxsa7s6088p604")))) (native-inputs '()) (inputs `(("zlib" ,zlib) diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm index 6d134a89c7..40a13e7939 100644 --- a/gnu/packages/gnuzilla.scm +++ b/gnu/packages/gnuzilla.scm @@ -167,7 +167,7 @@ in the Mozilla clients.") (define-public nss (package (name "nss") - (version "3.20.1") + (version "3.20.2") (source (origin (method url-fetch) (uri (let ((version-with-underscores @@ -178,7 +178,7 @@ in the Mozilla clients.") "nss-" version ".tar.gz"))) (sha256 (base32 - "15wcbqd2b911hxafbjfn63zd1gf2yxg0s5560hnhqmyrvw8qyg5d")) + "11pjjcp0mvcyx0ildyz20s9jlqzxsb6a9jlvcq5x1g3zsmckl6hl")) ;; Create nss.pc and nss-config. (patches (list (search-patch "nss-pkgconfig.patch"))))) (build-system gnu-build-system) @@ -266,7 +266,7 @@ standards.") (define-public icecat (package (name "icecat") - (version "38.4.0-gnu1") + (version "38.5.0-gnu1") (source (origin (method url-fetch) @@ -275,9 +275,8 @@ standards.") name "-" version ".tar.bz2")) (sha256 (base32 - "0rcaa19rfgclwd2qvcz8798m57jjzra6kaxg5dniysajvx7qndfp")) - (patches (map search-patch '("icecat-avoid-bundled-includes.patch" - "icecat-freetype-2.6.patch"))) + "1bf20mpvx84jsa0dan2hhfc49f30v0wasikv7sh3cg8mwp62faj6")) + (patches (map search-patch '("icecat-avoid-bundled-includes.patch"))) (modules '((guix build utils))) (snippet '(begin diff --git a/gnu/packages/graphics.scm b/gnu/packages/graphics.scm index 02e65d3276..4e15b814c8 100644 --- a/gnu/packages/graphics.scm +++ b/gnu/packages/graphics.scm @@ -271,8 +271,16 @@ and understanding different BRDFs (and other component functions).") (version "2.5") (source (origin (method url-fetch) - (uri (string-append "http://www.antigrain.com/agg-" - version ".tar.gz")) + (uri (list (string-append + "ftp://ftp.fau.de/gentoo/distfiles/agg-" + version ".tar.gz") + (string-append + "ftp://ftp.ula.ve/gentoo/distfiles/agg-" + version ".tar.gz") + + ;; Site was discontinued. + (string-append "http://www.antigrain.com/agg-" + version ".tar.gz"))) (sha256 (base32 "07wii4i824vy9qsvjsgqxppgqmfdxq0xa87i5yk53fijriadq7mb")) (patches (list (search-patch "agg-am_c_prototype.patch"))))) @@ -301,7 +309,9 @@ and understanding different BRDFs (and other component functions).") `(("libx11" ,libx11) ("freetype" ,freetype) ("sdl" ,sdl))) - (home-page "http://antigrain.com") + + ;; Antigrain.com was discontinued. + (home-page "http://agg.sourceforge.net/antigrain.com/index.html") (synopsis "High-quality 2D graphics rendering engine for C++") (description "Anti-Grain Geometry is a high quality rendering engine written in C++. diff --git a/gnu/packages/grub.scm b/gnu/packages/grub.scm index 79fc2f0aca..96d284c108 100644 --- a/gnu/packages/grub.scm +++ b/gnu/packages/grub.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> +;;; Copyright © 2015 Leo Famulari <leo@famulari.name> ;;; ;;; This file is part of GNU Guix. ;;; @@ -83,7 +84,8 @@ (base32 "0n64hpmsccvicagvr0c6v0kgp2yw0kgnd3jvsyd26cnwgs7c6kkq")) (patches (list (search-patch "grub-gets-undeclared.patch") - (search-patch "grub-freetype.patch"))))) + (search-patch "grub-freetype.patch") + (search-patch "grub-CVE-2015-8370.patch"))))) (build-system gnu-build-system) (arguments '(#:configure-flags '("--disable-werror") diff --git a/gnu/packages/gtk.scm b/gnu/packages/gtk.scm index c0c0794f4a..f85ea1970a 100644 --- a/gnu/packages/gtk.scm +++ b/gnu/packages/gtk.scm @@ -385,7 +385,7 @@ highlighting and other features typical of a source code editor.") (define-public gdk-pixbuf (package (name "gdk-pixbuf") - (version "2.32.1") + (version "2.32.3") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -393,7 +393,7 @@ highlighting and other features typical of a source code editor.") name "-" version ".tar.xz")) (sha256 (base32 - "1g7kjxv67jcdasi14n7jan4icrnnppd1m99wrdmpv32k4m7vfcj4")))) + "0cfh87aqyqbfcwpbv1ihgmgfcn66il5q2n8yjyl8gxkjmkqp2rrb")))) (build-system gnu-build-system) (arguments '(#:configure-flags '("--with-x11") @@ -403,9 +403,9 @@ highlighting and other features typical of a source code editor.") 'unpack 'disable-failing-tests (lambda _ (substitute* "tests/Makefile.in" - ;; XXX FIXME: This test fails on some machines with: - ;; GLib-FATAL-ERROR: gmem.c:103: failed to allocate - ;; 6039798016 bytes + ;; XXX FIXME: This test fails on armhf machines with: + ;; SKIP Not enough memory to load bitmap image + ;; ERROR: cve-2015-4491 - too few tests run (expected 4, got 2) (("cve-2015-4491\\$\\(EXEEXT\\) ") "") ;; XXX FIXME: This test fails with: ;; ERROR:pixbuf-jpeg.c:74:test_type9_rotation_exif_tag: @@ -994,6 +994,8 @@ extensive documentation, including API reference and a tutorial.") (base32 "04k942gn8vl95kwf0qskkv6npclfm31d78ljkrkgyqxxcni1w76d")))) (build-system gnu-build-system) + (outputs '("out" + "doc")) ;13 MiB of gtk-doc HTML (native-inputs `(("pkg-config" ,pkg-config))) (inputs @@ -1005,29 +1007,35 @@ extensive documentation, including API reference and a tutorial.") ("gtk+" ,gtk+-2))) (arguments `(#:tests? #f - #:phases (alist-cons-after - 'configure 'fix-codegen - (lambda* (#:key inputs #:allow-other-keys) - (substitute* "pygtk-codegen-2.0" - (("^prefix=.*$") - (string-append - "prefix=" - (assoc-ref inputs "python-pygobject") "\n")))) - (alist-cons-after - 'install 'install-pth - (lambda* (#:key inputs outputs #:allow-other-keys) - ;; pygtk's modules are stored in a subdirectory of python's - ;; site-packages directory. Add a .pth file so that python - ;; will add that subdirectory to its module search path. - (let* ((out (assoc-ref outputs "out")) - (site (string-append out "/lib/python" - ,(version-major+minor - (package-version python-2)) - "/site-packages"))) - (call-with-output-file (string-append site "/pygtk.pth") - (lambda (port) - (format port "gtk-2.0~%"))))) - %standard-phases)))) + #:phases (modify-phases %standard-phases + (add-before 'configure 'set-gtk-doc-directory + (lambda* (#:key outputs #:allow-other-keys) + ;; Install documentation to "doc". + (let ((doc (assoc-ref outputs "doc"))) + (substitute* "docs/Makefile.in" + (("TARGET_DIR = \\$\\(datadir\\)") + (string-append "TARGET_DIR = " doc)))))) + (add-after 'configure 'fix-codegen + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "pygtk-codegen-2.0" + (("^prefix=.*$") + (string-append + "prefix=" + (assoc-ref inputs "python-pygobject") "\n"))))) + (add-after 'install 'install-pth + (lambda* (#:key inputs outputs #:allow-other-keys) + ;; pygtk's modules are stored in a subdirectory of + ;; python's site-packages directory. Add a .pth file so + ;; that python will add that subdirectory to its module + ;; search path. + (let* ((out (assoc-ref outputs "out")) + (site (string-append out "/lib/python" + ,(version-major+minor + (package-version python-2)) + "/site-packages"))) + (call-with-output-file (string-append site "/pygtk.pth") + (lambda (port) + (format port "gtk-2.0~%"))))))))) (home-page "http://www.pygtk.org/") (synopsis "Python bindings for GTK+") (description diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index 8208a2ce78..861a18fce8 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -842,4 +842,32 @@ capabilities.") (home-page "http://dthompson.us/pages/software/sly.html") (license gpl3+))) +(define-public g-wrap + (package + (name "g-wrap") + (version "1.9.15") + (source (origin + (method url-fetch) + (uri (string-append "mirror://savannah/g-wrap/g-wrap-" + version ".tar.gz")) + (sha256 + (base32 + "0ak0bha37dfpj9kmyw1r8fj8nva639aw5xr66wr5gd3l1rqf5xhg")))) + (build-system gnu-build-system) + (native-inputs + `(("pkg-config" ,pkg-config))) + (propagated-inputs + `(("guile" ,guile-2.0) + ("guile-lib" ,guile-lib))) + (inputs + `(("libffi" ,libffi))) + (synopsis "Generate C bindings for Guile") + (description "G-Wrap is a tool and Guile library for generating function +wrappers for inter-language calls. It currently only supports generating Guile +wrappers for C functions. Given a definition of the types and prototypes for +a given C interface, G-Wrap will automatically generate the C code that +provides access to that interface and its types from the Scheme level.") + (home-page "http://www.nongnu.org/g-wrap/index.html") + (license lgpl2.1+))) + ;;; guile.scm ends here diff --git a/gnu/packages/haskell.scm b/gnu/packages/haskell.scm index c0e968ba38..c3e0a6100b 100644 --- a/gnu/packages/haskell.scm +++ b/gnu/packages/haskell.scm @@ -21,10 +21,7 @@ (define-module (gnu packages haskell) #:use-module (ice-9 regex) - #:use-module ((guix licenses) #:select (bsd-3 - lgpl2.1 lgpl2.1+ gpl2+ gpl3+ - public-domain - expat)) + #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix utils) @@ -47,7 +44,7 @@ #:use-module (gnu packages ncurses) #:use-module (gnu packages python) #:use-module (gnu packages pcre) - #:use-module ((gnu packages xml) #:select (libxml2)) + #:use-module (gnu packages xml) #:use-module (gnu packages xorg)) (define ghc-bootstrap-x86_64-7.8.4 @@ -257,7 +254,7 @@ (description "The Glasgow Haskell Compiler (GHC) is a state-of-the-art compiler and interactive environment for the functional language Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-hostname (package @@ -276,7 +273,7 @@ interactive environment for the functional language Haskell.") (synopsis "Hostname in Haskell") (description "Network.HostName is a simple package providing a means to determine the hostname.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-libxml (package @@ -303,7 +300,7 @@ determine the hostname.") (synopsis "Haskell bindings to libxml2") (description "This library provides minimal Haskell binding to libxml2.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-prelude-extras (package @@ -325,7 +322,7 @@ determine the hostname.") (description "This library provides higher order versions of @code{Prelude} classes to ease programming with polymorphic recursion and reduce @code{UndecidableInstances}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-data-default (package @@ -358,7 +355,7 @@ reduce @code{UndecidableInstances}.") "This package defines a class for types with a default value, and provides instances for types from the base, containers, dlist and old-locale packages.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-data-default-class (package @@ -377,7 +374,7 @@ packages.") (synopsis "Types with default values") (description "This package defines a class for types with default values.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-data-default-instances-base (package @@ -400,7 +397,7 @@ packages.") (description "This package provides default instances for types from the base package.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-data-default-instances-containers (package @@ -422,7 +419,7 @@ package.") (synopsis "Default instances for types in containers") (description "Provides default instances for types from the containers package.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-data-default-instances-dlist (package @@ -445,7 +442,7 @@ package.") (synopsis "Default instances for types in dlist") (description "Provides default instances for types from the dlist package.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-haddock-library (package @@ -475,7 +472,7 @@ modules expose some functionality of it without pulling in the GHC dependency. Please note that the API is likely to change so specify upper bounds in your project if you can't release often. For interacting with Haddock itself, see the ‘haddock’ package.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-haddock-api (package @@ -499,7 +496,7 @@ the ‘haddock’ package.") (synopsis "API for documentation-generation tool Haddock") (description "This package provides an API to Haddock, the documentation-generation tool for Haskell libraries.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-haddock (package @@ -525,7 +522,7 @@ documentation-generation tool for Haskell libraries.") "Documentation-generation tool for Haskell libraries") (description "Haddock is a documentation-generation tool for Haskell libraries.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-simple-reflect (package @@ -552,7 +549,7 @@ variables. Reflection here means that a Haskell expression is turned into a string. The primary aim of this package is teaching and understanding; there are no options for manipulating the reflected expressions beyond showing them.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-multipart (package @@ -576,7 +573,7 @@ them.") "HTTP multipart library") (description "HTTP multipart split out of the cgi package, for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-html (package @@ -599,7 +596,7 @@ them.") (description "This package contains a combinator library for constructing HTML documents.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-xhtml (package @@ -621,7 +618,7 @@ documents.") (description "This package provides combinators for producing XHTML 1.0, including the Strict, Transitional and Frameset variants.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-haskell-src (package @@ -650,7 +647,7 @@ Strict, Transitional and Frameset variants.") source code. The package provides a lexer, parser and pretty-printer, and a definition of a Haskell abstract syntax tree (AST). Common uses of this package are to parse or generate Haskell 98 code.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-alex (package @@ -679,7 +676,7 @@ package are to parse or generate Haskell 98 code.") description of tokens based on regular expressions and generates a Haskell module containing code for scanning text efficiently. It is similar to the tool lex or flex for C/C++.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-cgi (package @@ -710,7 +707,7 @@ tool lex or flex for C/C++.") (synopsis "Library for writing CGI programs") (description "This is a Haskell library for writing CGI programs.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-cmdargs (package @@ -732,7 +729,7 @@ tool lex or flex for C/C++.") (synopsis "Command line argument processing") (description "This library provides an easy way to define command line parsers.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-happy (package @@ -758,7 +755,7 @@ tool lex or flex for C/C++.") (description "Happy is a parser generator for Haskell. Given a grammar specification in BNF, Happy generates Haskell code to parse the grammar. Happy works in a similar way to the yacc tool for C.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-haskell-src-exts (package @@ -792,7 +789,7 @@ extension of the standard @code{haskell-src} package, and handles most registered syntactic extensions to Haskell. All extensions implemented in GHC are supported. Apart from these standard extensions, it also handles regular patterns as per the HaRP extension as well as HSX-style embedded XML syntax.") - (license bsd-3))) + (license license:bsd-3))) (define-public hlint (package @@ -821,7 +818,7 @@ patterns as per the HaRP extension as well as HSX-style embedded XML syntax.") (description "HLint reads Haskell programs and suggests changes that hopefully make them easier to read. HLint also makes it easy to disable unwanted suggestions, and to add your own custom suggestions.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-resourcet (package @@ -852,7 +849,7 @@ unwanted suggestions, and to add your own custom suggestions.") (synopsis "Deterministic allocation and freeing of scarce resources") (description "ResourceT is a monad transformer which creates a region of code where you can safely allocate resources.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-xss-sanitize (package @@ -884,7 +881,7 @@ code where you can safely allocate resources.") (description "This library provides @code{sanitizeXSS}. Run untrusted HTML through @code{Text.HTML.SanitizeXSS.sanitizeXSS} to prevent XSS attacks.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-objectname (package @@ -907,7 +904,7 @@ attacks.") corresponds to the general notion of explicitly handled identifiers for API objects, e.g. a texture object name in OpenGL or a buffer object name in OpenAL.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-sdl (package @@ -933,7 +930,7 @@ multimedia library designed to provide low level access to audio, keyboard, mouse, joystick, 3D hardware via OpenGL, and 2D video framebuffer. It is used by MPEG playback software, emulators, and many popular games, including the award winning Linux port of \"Civilization: Call To Power.\"") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-sdl-mixer (package @@ -965,7 +962,7 @@ award winning Linux port of \"Civilization: Call To Power.\"") supports any number of simultaneously playing channels of 16 bit stereo audio, plus a single channel of music, mixed by the popular MikMod MOD, Timidity MIDI, Ogg Vorbis, and SMPEG MP3 libraries.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-sdl-image (package @@ -996,7 +993,7 @@ MIDI, Ogg Vorbis, and SMPEG MP3 libraries.") (description "SDL_image is an image file loading library. It loads images as SDL surfaces, and supports the following formats: BMP, GIF, JPEG, LBM, PCX, PNG, PNM, TGA, TIFF, XCF, XPM, XV.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-half (package @@ -1017,7 +1014,7 @@ PNG, PNM, TGA, TIFF, XCF, XPM, XV.") (synopsis "Half-precision floating-point computations") (description "This library provides a half-precision floating-point computation library for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-openglraw (package @@ -1049,7 +1046,7 @@ the naming structure of the OpenGL extensions, making it easy to find the right module to import. All API entries are loaded dynamically, so no special C header files are needed for building this package. If an API entry is not found at runtime, a userError is thrown.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-glut (package @@ -1077,7 +1074,7 @@ found at runtime, a userError is thrown.") (description "This library provides Haskell bindings for the OpenGL Utility Toolkit, a window system-independent toolkit for writing OpenGL programs.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-gluraw (package @@ -1101,7 +1098,7 @@ programs.") (description "GLURaw is a raw Haskell binding for the GLU 1.3 OpenGL utility library. It is basically a 1:1 mapping of GLU's C API, intended as a basis for a nicer interface.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-opengl (package @@ -1129,7 +1126,7 @@ basis for a nicer interface.") (description "This package provides Haskell bindings for the OpenGL graphics system (GL, version 4.5) and its accompanying utility library (GLU, version 1.3).") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-streaming-commons (package @@ -1162,7 +1159,7 @@ version 1.3).") (description "Provides low-dependency functionality commonly needed by various Haskell streaming data libraries, such as @code{conduit} and @code{pipe}s.") - (license bsd-3))) + (license license:bsd-3))) (define-public cpphs (package @@ -1190,7 +1187,7 @@ can be distributed with compilers. This version of the C pre-processor is pretty-much feature-complete and compatible with traditional (K&R) pre-processors. Additional features include: a plain-text mode; an option to unlit literate code files; and an option to turn off macro-expansion.") - (license (list lgpl2.1+ gpl3+)))) + (license (list license:lgpl2.1+ license:gpl3+)))) (define-public ghc-reflection (package @@ -1215,7 +1212,7 @@ into terms") propogating configurations that are available at run-time, allowing multiple configurations to coexist without resorting to mutable global variables or @code{System.IO.Unsafe.unsafePerformIO}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-old-locale (package @@ -1236,7 +1233,7 @@ configurations to coexist without resorting to mutable global variables or (description "This package provides the ability to adapt to locale conventions such as date and time formats.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-old-time (package @@ -1260,7 +1257,7 @@ date and time formats.") (description "Old-time is a package for backwards compatibility with the old @code{time} library. For new projects, the newer @uref{http://hackage.haskell.org/package/time, time library} is recommended.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-data-default-instances-old-locale (package @@ -1284,7 +1281,7 @@ old @code{time} library. For new projects, the newer (synopsis "Default instances for types in old-locale") (description "Provides Default instances for types from the old-locale package.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-dlist (package @@ -1308,7 +1305,7 @@ old @code{time} library. For new projects, the newer "Difference lists are a list-like type supporting O(1) append. This is particularly useful for efficient logging and pretty printing (e.g. with the Writer monad), where list append quickly becomes too expensive.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-extensible-exceptions (package @@ -1328,7 +1325,7 @@ Writer monad), where list append quickly becomes too expensive.") (description "This package provides extensible exceptions for both new and old versions of GHC (i.e., < 6.10).") - (license bsd-3))) + (license license:bsd-3))) (define-public cabal-install (package @@ -1359,7 +1356,7 @@ versions of GHC (i.e., < 6.10).") "The cabal command-line program simplifies the process of managing Haskell software by automating the fetching, configuration, compilation and installation of Haskell libraries and programs.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-mtl (package @@ -1385,7 +1382,7 @@ for various monad transformers, inspired by the paper 'Functional Programming with Overloading and Higher-Order Polymorphism', by Mark P Jones, in 'Advanced School of Functional Programming', 1995. See @uref{http://web.cecs.pdx.edu/~mpj/pubs/springschool.html, the paper}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-paths (package @@ -1408,7 +1405,7 @@ School of Functional Programming', 1995. See "Knowledge of GHC's installation directories") (description "Knowledge of GHC's installation directories.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-utf8-string (package @@ -1430,7 +1427,7 @@ School of Functional Programming', 1995. See "A UTF8 layer for Strings. The utf8-string package provides operations for encoding UTF8 strings to Word8 lists and back, and for reading and writing UTF8 without truncation.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-setenv (package @@ -1451,7 +1448,7 @@ UTF8 without truncation.") (synopsis "Library for setting environment variables") (description "This package provides a Haskell library for setting environment variables.") - (license expat))) + (license license:expat))) (define-public ghc-x11 (package @@ -1477,7 +1474,7 @@ environment variables.") (description "This package provides Haskell bindings to the X11 graphics library. The bindings are a direct translation of the C bindings.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-x11-xft (package @@ -1505,7 +1502,7 @@ bindings are a direct translation of the C bindings.") (description "Bindings to the Xft, X Free Type interface library, and some Xrender parts.") - (license lgpl2.1))) + (license license:lgpl2.1))) (define-public ghc-stringbuilder (package @@ -1528,7 +1525,7 @@ parts.") (synopsis "Writer monad for multi-line string literals") (description "This package provides a writer monad for multi-line string literals.") - (license expat))) + (license license:expat))) (define-public ghc-zlib (package @@ -1557,7 +1554,7 @@ so it has high performance. It supports the 'zlib', 'gzip' and 'raw' compression formats. It provides a convenient high level API suitable for most tasks and for the few cases where more control is needed it provides access to the full zlib feature set.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-stm (package @@ -1579,7 +1576,7 @@ access to the full zlib feature set.") (synopsis "Software Transactional Memory") (description "A modular composable concurrency abstraction.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-parallel (package @@ -1601,7 +1598,7 @@ access to the full zlib feature set.") (synopsis "Parallel programming library") (description "This package provides a library for parallel programming.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-text (package @@ -1631,7 +1628,7 @@ The 'Text' type represents Unicode character strings, in a time and space-efficient manner. This package provides text processing capabilities that are optimized for performance critical use, both in terms of large data quantities and high speed.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-hashable (package @@ -1662,7 +1659,7 @@ in terms of large data quantities and high speed.") converted to a hash value. This class exists for the benefit of hashing-based data structures. The package provides instances for basic types and a way to combine hash values.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-hunit (package @@ -1685,7 +1682,7 @@ combine hash values.") (description "HUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-random (package @@ -1706,7 +1703,7 @@ JUnit tool for Java.") (synopsis "Random number library") (description "This package provides a basic random number generation library, including the ability to split random number generators.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-primitive (package @@ -1729,7 +1726,7 @@ library, including the ability to split random number generators.") (synopsis "Primitive memory-related operations") (description "This package provides various primitive memory-related operations.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-test-framework (package @@ -1764,7 +1761,7 @@ cases to be assembled into test groups, run in parallel (but reported in deterministic order, to aid diff interpretation) and filtered and controlled by command line options. All of this comes with colored test output, progress reporting and test statistics output.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-test-framework-hunit (package @@ -1788,7 +1785,7 @@ reporting and test statistics output.") (synopsis "HUnit support for test-framework") (description "This package provides HUnit support for the test-framework package.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-test-framework-quickcheck2 (package @@ -1821,7 +1818,7 @@ reporting and test statistics output.") (description "This packages provides QuickCheck2 support for the test-framework package.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-tf-random (package @@ -1849,7 +1846,7 @@ splittable pseudorandom number generator. The generator is based on a cryptographic hash function built on top of the ThreeFish block cipher. See the paper \"Splittable Pseudorandom Number Generators Using Cryptographic Hashing\" by Claessen, Pałka for details and the rationale of the design.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-transformers-base (package @@ -1878,7 +1875,7 @@ Hashing\" by Claessen, Pałka for details and the rationale of the design.") "Backported versions of types that were added to transformers in transformers 0.3 and 0.4 for users who need strict transformers 0.2 or 0.3 compatibility to run on old versions of the platform.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-transformers-compat (package @@ -1900,7 +1897,7 @@ compatibility to run on old versions of the platform.") added to transformers in transformers 0.3 and 0.4 for users who need strict transformers 0.2 or 0.3 compatibility to run on old versions of the platform, but also need those types.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-unix-time (package @@ -1927,7 +1924,7 @@ but also need those types.") (synopsis "Unix time parser/formatter and utilities") (description "This library provides fast parsing and formatting utilities for Unix time in Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-unix-compat (package @@ -1951,7 +1948,7 @@ for Unix time in Haskell.") "This package provides portable implementations of parts of the unix package. This package re-exports the unix package when available. When it isn't available, portable implementations are used.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-http-types (package @@ -1980,7 +1977,7 @@ isn't available, portable implementations are used.") (synopsis "Generic HTTP types for Haskell") (description "This package provides generic HTTP types for Haskell (for both client and server code).") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-iproute (package @@ -2010,7 +2007,7 @@ both client and server code).") (description "IP Routing Table is a tree of IP ranges to search one of them on the longest match base. It is a kind of TRIE with one way branching removed. Both IPv4 and IPv6 are supported.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-regex-base (package @@ -2034,7 +2031,7 @@ removed. Both IPv4 and IPv6 are supported.") (synopsis "Replaces/Enhances Text.Regex") (description "@code{Text.Regex.Base} provides the interface API for regex-posix, regex-pcre, regex-parsec, regex-tdfa, regex-dfa.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-regex-posix (package @@ -2057,7 +2054,7 @@ regex-posix, regex-pcre, regex-parsec, regex-tdfa, regex-dfa.") (synopsis "POSIX regular expressions for Haskell") (description "This library provides the POSIX regex backend used by the Haskell library @code{regex-base}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-regex-compat (package @@ -2081,7 +2078,7 @@ Haskell library @code{regex-base}.") (synopsis "Replaces/Enhances Text.Regex") (description "This library provides one module layer over @code{regex-posix} to replace @code{Text.Regex}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-regex-tdfa-rc (package @@ -2108,7 +2105,7 @@ Haskell library @code{regex-base}.") (synopsis "Tagged DFA regex engine for Haskell") (description "A new all-Haskell \"tagged\" DFA regex engine, inspired by @code{libtre} (fork by Roman Cheplyaka).") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-parsers (package @@ -2143,7 +2140,7 @@ with and building parsing combinator libraries. Given a few simple instances, you get access to a large number of canned definitions. Instances exist for the parsers provided by @code{parsec}, @code{attoparsec} and @code{base}'s @code{Text.Read}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-trifecta (package @@ -2185,7 +2182,7 @@ the parsers provided by @code{parsec}, @code{attoparsec} and @code{base}'s (synopsis "Parser combinator library with convenient diagnostics") (description "Trifecta is a modern parser combinator library for Haskell, with slicing and Clang-style colored diagnostics.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-attoparsec (package @@ -2216,7 +2213,7 @@ with slicing and Clang-style colored diagnostics.") (description "This library provides a fast parser combinator library, aimed particularly at dealing efficiently with network protocols and complicated text/binary file formats.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-css-text (package @@ -2242,7 +2239,7 @@ complicated text/binary file formats.") (synopsis "CSS parser and renderer") (description "This package provides a CSS parser and renderer for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-zip-archive (package @@ -2272,7 +2269,7 @@ Haskell.") (synopsis "Zip archive library for Haskell") (description "The zip-archive library provides functions for creating, modifying, and extracting files from zip archives in Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-distributive (package @@ -2298,7 +2295,7 @@ modifying, and extracting files from zip archives in Haskell.") (synopsis "Distributive functors for Haskell") (description "This package provides distributive functors for Haskell. Dual to @code{Traversable}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-cereal (package @@ -2320,7 +2317,7 @@ Dual to @code{Traversable}.") (description "This package provides a binary serialization library, similar to @code{binary}, that introduces an @code{isolate} primitive for parser isolation, and labeled blocks for better error messages.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-comonad (package @@ -2350,7 +2347,7 @@ parser isolation, and labeled blocks for better error messages.") (home-page "http://github.com/ekmett/comonad/") (synopsis "Comonads for Haskell") (description "This library provides @code{Comonad}s for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public hscolour (package @@ -2374,7 +2371,7 @@ code. It currently has six output formats: ANSI terminal codes (optionally XTerm-256colour codes), HTML 3.2 with font tags, HTML 4.01 with CSS, HTML 4.01 with CSS and mouseover annotations, XHTML 1.0 with inline CSS styling, LaTeX, and mIRC chat codes.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-polyparse (package @@ -2404,7 +2401,7 @@ features like good error reporting, arbitrary token type, running state, lazy parsing, and so on. Finally, Text.Parse is a proposed replacement for the standard Read class, for better deserialisation of Haskell values from Strings.") - (license lgpl2.1))) + (license license:lgpl2.1))) (define-public ghc-extra (package @@ -2428,7 +2425,7 @@ Strings.") Haskell libraries. Most functions are simple additions, filling out missing functionality. A few functions are available in later versions of GHC, but this package makes them available back to GHC 7.2.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-profunctors (package @@ -2453,7 +2450,7 @@ this package makes them available back to GHC 7.2.") (home-page "http://github.com/ekmett/profunctors/") (synopsis "Profunctors for Haskell") (description "This library provides profunctors for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-reducers (package @@ -2482,7 +2479,7 @@ this package makes them available back to GHC 7.2.") (synopsis "Semigroups, specialized containers and a general map/reduce framework") (description "This library provides various semigroups, specialized containers and a general map/reduce framework for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-appar (package @@ -2504,7 +2501,7 @@ containers and a general map/reduce framework for Haskell.") (synopsis "Simple applicative parser") (description "This package provides a simple applicative parser in Parsec style.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-safe (package @@ -2526,7 +2523,7 @@ style.") (description "This library provides wrappers around @code{Prelude} and @code{Data.List} functions, such as @code{head} and @code{!!}, that can throw exceptions.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-generic-deriving (package @@ -2547,7 +2544,7 @@ exceptions.") (synopsis "Generalise the deriving mechanism to arbitrary classes") (description "This package provides functionality for generalising the deriving mechanism in Haskell to arbitrary classes.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-pcre-light (package @@ -2572,7 +2569,7 @@ deriving mechanism in Haskell to arbitrary classes.") library for Perl 5 compatible regular expressions. The PCRE library is a set of functions that implement regular expression pattern matching using the same syntax and semantics as Perl 5.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-logict (package @@ -2597,7 +2594,7 @@ logic programming monad. An adaptation of the two-continuation implementation found in the paper \"Backtracking, Interleaving, and Terminating Monad Transformers\" available @uref{http://okmij.org/ftp/papers/LogicT.pdf, online}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-xml (package @@ -2619,7 +2616,7 @@ online}.") (home-page "http://code.galois.com") (synopsis "Simple XML library for Haskell") (description "This package provides a simple XML library for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-exceptions (package @@ -2645,7 +2642,7 @@ online}.") (synopsis "Extensible optionally-pure exceptions") (description "This library provides extensible optionally-pure exceptions for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-temporary (package @@ -2670,7 +2667,7 @@ in the Haskelll base library are quite limited. This library just repackages the Cabal implementations of its own temporary file and folder functions so that you can use them without linking against Cabal or depending on it being installed.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-temporary-rc (package @@ -2699,7 +2696,7 @@ they aren't portable to Windows. This library just repackages the Cabal implementations of its own temporary file and folder functions so that you can use them without linking against Cabal or depending on it being installed. This is a better maintained fork of the \"temporary\" package.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-smallcheck (package @@ -2726,7 +2723,7 @@ This is a better maintained fork of the \"temporary\" package.") (description "SmallCheck is a testing library that allows to verify properties for all test cases up to some depth. The test cases are generated automatically by SmallCheck.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-tasty-ant-xml (package @@ -2759,7 +2756,7 @@ automatically by SmallCheck.") "A tasty ingredient to output test results in XML, using the Ant schema. This XML can be consumed by the Jenkins continuous integration framework.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-tasty-smallcheck (package @@ -2785,7 +2782,7 @@ framework.") (synopsis "SmallCheck support for the Tasty test framework") (description "This package provides SmallCheck support for the Tasty Haskell test framework.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-silently (package @@ -2809,7 +2806,7 @@ Haskell test framework.") (synopsis "Prevent writing to stdout") (description "This package provides functions to prevent or capture writing to stdout and other handles.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-quickcheck-instances (package @@ -2838,7 +2835,7 @@ writing to stdout and other handles.") (synopsis "Common quickcheck instances") (description "This package provides QuickCheck instances for types provided by the Haskell Platform.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-quickcheck-unicode (package @@ -2861,7 +2858,7 @@ provided by the Haskell Platform.") (synopsis "Generator functions Unicode-related tests") (description "This package provides generator and shrink functions for testing Unicode-related software.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-quickcheck-io (package @@ -2886,7 +2883,7 @@ testing Unicode-related software.") (synopsis "Use HUnit assertions as QuickCheck properties") (description "This package provides an orphan instance that allows you to use HUnit assertions as QuickCheck properties.") - (license expat))) + (license license:expat))) (define-public ghc-quickcheck (package @@ -2916,7 +2913,7 @@ use HUnit assertions as QuickCheck properties.") "Automatic testing of Haskell programs") (description "QuickCheck is a library for random testing of program properties.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-case-insensitive (package @@ -2950,7 +2947,7 @@ use HUnit assertions as QuickCheck properties.") which can be parameterised by a string-like type like: 'String', 'ByteString', 'Text', etc.. Comparisons of values of the resulting type will be insensitive to cases.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-syb (package @@ -2980,7 +2977,7 @@ to cases.") defines the 'Data' class of types permitting folding and unfolding of constructor applications, instances of this class for primitive types, and a variety of traversals.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-fgl (package @@ -3006,7 +3003,7 @@ variety of traversals.") and function definitions to address graph problems. The basis of the library is an inductive definition of graphs in the style of algebraic data types that encourages inductive, recursive definitions of graph algorithms.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-chasingbottoms (package @@ -3044,7 +3041,7 @@ see the article @uref{http://www.cse.chalmers.se/~nad/publications/danielsson-jansson-mpc2004.html, \"Chasing Bottoms A Case Study in Program Verification in the Presence of Partial and Infinite Values\"}.") - (license expat))) + (license license:expat))) (define-public ghc-unordered-containers (package @@ -3078,7 +3075,7 @@ Partial and Infinite Values\"}.") "Efficient hashing-based container types. The containers have been optimized for performance critical use, both in terms of large data quantities and high speed.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-uniplate (package @@ -3104,7 +3101,7 @@ and high speed.") (description "Uniplate is a library for writing simple and concise generic operations. Uniplate has similar goals to the original Scrap Your Boilerplate work, but is substantially simpler and faster.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-base64-bytestring (package @@ -3126,7 +3123,7 @@ work, but is substantially simpler and faster.") (synopsis "Base64 encoding and decoding for ByteStrings") (description "This library provides fast base64 encoding and decoding for Haskell @code{ByteString}s.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-annotated-wl-pprint (package @@ -3151,7 +3148,7 @@ Haskell @code{ByteString}s.") Wadler's paper \"A Prettier Printer\". This version allows the library user to annotate the text with semantic information, which can later be rendered in a variety of ways.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-ansi-wl-pprint (package @@ -3175,7 +3172,7 @@ a variety of ways.") (description "This is a pretty printing library based on Wadler's paper \"A Prettier Printer\". It has been enhanced with support for ANSI terminal colored output using the ansi-terminal package.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-split (package @@ -3207,7 +3204,7 @@ colored output using the ansi-terminal package.") (description "This package provides a collection of Haskell functions for splitting lists into parts, akin to the @code{split} function found in several mainstream languages.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-parsec (package @@ -3239,7 +3236,7 @@ mainstream languages.") documented, has extensive libraries, good error messages, and is fast. It is defined as a monad transformer that can be stacked on arbitrary monads, and it is also parametric in the input stream type.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-vector (package @@ -3269,7 +3266,7 @@ is also parametric in the input stream type.") (description "This library provides an efficient implementation of Int-indexed arrays (both mutable and immutable), with a powerful loop optimisation framework.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-vector-binary-instances (package @@ -3297,7 +3294,7 @@ types defined in the @code{vector} package, making it easy to serialize vectors to and from disk. We use the generic interface to vectors, so all vector types are supported. Specific instances are provided for unboxed, boxed and storable vectors.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-network (package @@ -3323,7 +3320,7 @@ boxed and storable vectors.") (synopsis "Low-level networking interface") (description "This package provides a low-level networking interface.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-network-uri (package @@ -3354,7 +3351,7 @@ boxed and storable vectors.") (description "This package provides an URI manipulation interface. In 'network-2.6' the 'Network.URI' module was split off from the 'network' package into this package.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-ansi-terminal (package @@ -3376,7 +3373,7 @@ package into this package.") (description "This package provides ANSI terminal support for Haskell. It allows cursor movement, screen clearing, color output showing or hiding the cursor, and changing the title.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-http (package @@ -3410,7 +3407,7 @@ cursor, and changing the title.") "The HTTP package supports client-side web programming in Haskell. It lets you set up HTTP connections, transmitting requests and processing the responses coming back.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-hspec (package @@ -3440,7 +3437,7 @@ responses coming back.") (synopsis "Testing Framework for Haskell") (description "This library provides the Hspec testing framework for Haskell, inspired by the Ruby library RSpec.") - (license expat))) + (license license:expat))) (define-public ghc-hspec-contrib (package @@ -3464,7 +3461,7 @@ Haskell, inspired by the Ruby library RSpec.") (synopsis "Contributed functionality for Hspec") (description "This package provides contributed Hspec extensions.") - (license expat))) + (license license:expat))) (define-public ghc-hspec-expectations (package @@ -3486,7 +3483,7 @@ Haskell, inspired by the Ruby library RSpec.") (synopsis "Catchy combinators for HUnit") (description "This library provides catchy combinators for HUnit, see @uref{https://github.com/sol/hspec-expectations#readme, the README}.") - (license expat))) + (license license:expat))) (define-public hspec-discover (package @@ -3510,7 +3507,7 @@ Haskell, inspired by the Ruby library RSpec.") (synopsis "Automatically discover and run Hspec tests") (description "hspec-discover is a tool which automatically discovers and runs Hspec tests.") - (license expat))) + (license license:expat))) (define-public ghc-hspec-core (package @@ -3542,7 +3539,7 @@ runs Hspec tests.") (synopsis "Testing framework for Haskell") (description "This library exposes internal types and functions that can be used to extend Hspec's functionality.") - (license expat))) + (license license:expat))) (define-public ghc-hspec-meta (package @@ -3572,7 +3569,7 @@ be used to extend Hspec's functionality.") (synopsis "Version of Hspec to test Hspec itself") (description "This library provides a stable version of Hspec which is used to test the in-development version of Hspec.") - (license expat))) + (license license:expat))) (define-public ghc-vault (package @@ -3601,7 +3598,7 @@ access to the storage space behind @code{IORefs}. The data structure is analogous to a bank vault, where you can access different bank boxes with different keys; hence the name. Also provided is a @code{locker} type, representing a store for a single element.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-mmorph (package @@ -3624,7 +3621,7 @@ representing a store for a single element.") (description "This library provides monad morphism utilities, most commonly used for manipulating monad transformer stacks.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-monad-control (package @@ -3650,7 +3647,7 @@ catching") (description "This package defines the type class @code{MonadBaseControl}, a subset of @code{MonadBase} into which generic control operations such as @code{catch} can be lifted from @code{IO} or any other base monad.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-byteorder (package @@ -3674,7 +3671,7 @@ a subset of @code{MonadBase} into which generic control operations such as (description "This package is for working with the native byte-ordering of the system.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-base-compat (package @@ -3699,7 +3696,7 @@ system.") (description "This library provides functions available in later versions of base to a wider range of compilers, without requiring the use of CPP pragmas in your code.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-blaze-builder (package @@ -3727,7 +3724,7 @@ pragmas in your code.") @code{bytestring-0.10.4.0}. This implementation is mostly intended as a bridge to the new builder, so that code that uses the old interface can interoperate with code that uses the new implementation.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-blaze-markup (package @@ -3752,7 +3749,7 @@ interoperate with code that uses the new implementation.") (synopsis "Fast markup combinator library for Haskell") (description "This library provides core modules of a markup combinator library for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-blaze-html (package @@ -3777,7 +3774,7 @@ library for Haskell.") (home-page "http://jaspervdj.be/blaze") (synopsis "Fast HTML combinator library") (description "This library provides HTML combinators for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-easy-file (package @@ -3798,7 +3795,7 @@ library for Haskell.") "http://github.com/kazu-yamamoto/easy-file") (synopsis "File handling library for Haskell") (description "This library provides file handling utilities for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-async (package @@ -3827,7 +3824,7 @@ library for Haskell.") asynchronously, and wait for their results. It is a higher-level interface over threads in Haskell, in which @code{Async a} is a concurrent thread that will eventually deliver a value of type @code{a}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-fingertree (package @@ -3852,7 +3849,7 @@ representation with arbitrary annotations, for use as a base for implementations of various collection types. It includes examples, as described in section 4 of Ralf Hinze and Ross Paterson, \"Finger trees: a simple general-purpose data structure\".") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-optparse-applicative (package @@ -3875,7 +3872,7 @@ simple general-purpose data structure\".") (synopsis "Utilities and combinators for parsing command line options") (description "This package provides utilities and combinators for parsing command line options in Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-base-orphans (package @@ -3899,7 +3896,7 @@ command line options in Haskell.") (synopsis "Orphan instances for backwards compatibility") (description "This package defines orphan instances that mimic instances available in later versions of base to a wider (older) range of compilers.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-auto-update (package @@ -3920,7 +3917,7 @@ available in later versions of base to a wider (older) range of compilers.") (synopsis "Efficiently run periodic, on-demand actions") (description "This library provides mechanisms to efficiently run periodic, on-demand actions in Haskell.") - (license expat))) + (license license:expat))) (define-public ghc-tagged (package @@ -3941,7 +3938,7 @@ periodic, on-demand actions in Haskell.") (synopsis "Haskell phantom types to avoid passing dummy arguments") (description "This library provides phantom types for Haskell 98, to avoid having to unsafely pass dummy arguments.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-unbounded-delays (package @@ -3964,7 +3961,7 @@ having to unsafely pass dummy arguments.") Haskell base library use the bounded @code{Int} type for specifying the delay or timeout period. This package provides alternative functions which use the unbounded @code{Integer} type.") - (license bsd-3))) + (license license:bsd-3))) ;; This package builds `clock` without tests, since the tests rely on tasty ;; and tasty-quickcheck, which in turn require clock to build. When tasty and @@ -3989,7 +3986,7 @@ unbounded @code{Integer} type.") (synopsis "High-resolution clock for Haskell") (description "A package for convenient access to high-resolution clock and timer functions of different operating systems via a unified API.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-clock (package @@ -4012,7 +4009,7 @@ timer functions of different operating systems via a unified API.") (synopsis "High-resolution clock for Haskell") (description "A package for convenient access to high-resolution clock and timer functions of different operating systems via a unified API.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-charset (package @@ -4037,7 +4034,7 @@ timer functions of different operating systems via a unified API.") (synopsis "Fast unicode character sets for Haskell") (description "This package provides fast unicode character sets for Haskell, based on complemented PATRICIA tries.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-bytestring-builder (package @@ -4059,7 +4056,7 @@ Haskell, based on complemented PATRICIA tries.") (description "This package provides the bytestring builder that is debuting in bytestring-0.10.4.0, which should be shipping with GHC 7.8. Compatibility package for older packages.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-nats (package @@ -4082,7 +4079,7 @@ Compatibility package for older packages.") (home-page "https://hackage.haskell.org/package/nats") (synopsis "Natural numbers") (description "This library provides the natural numbers for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-void (package @@ -4109,7 +4106,7 @@ Compatibility package for older packages.") (description "A Haskell 98 logically uninhabited data type, used to indicate that a given term should not exist.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-kan-extensions (package @@ -4140,7 +4137,7 @@ given term should not exist.") (synopsis "Kan extensions library") (description "This library provides Kan extensions, Kan lifts, various forms of the Yoneda lemma, and (co)density (co)monads for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-statevar (package @@ -4163,7 +4160,7 @@ forms of the Yoneda lemma, and (co)density (co)monads for Haskell.") (synopsis "State variables for Haskell") (description "This package provides state variables, which are references in the @code{IO} monad, like @code{IORef}s or parts of the OpenGL state.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-lens (package @@ -4214,7 +4211,7 @@ in the @code{IO} monad, like @code{IORef}s or parts of the OpenGL state.") in @code{Control.Lens} provide a highly generic toolbox for composing families of getters, folds, isomorphisms, traversals, setters and lenses and their indexed variants.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-tagsoup (package @@ -4243,7 +4240,7 @@ specification, and can be used to parse either well-formed XML, or unstructured and malformed HTML from the web. The library also provides useful functions to extract information from an HTML document, making it ideal for screen-scraping.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-digest (package @@ -4270,7 +4267,7 @@ for screen-scraping.") "This package provides efficient cryptographic hash implementations for strict and lazy bytestrings. For now, CRC32 and Adler32 are supported; they are implemented as FFI bindings to efficient code from zlib.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-cheapskate (package @@ -4307,7 +4304,7 @@ Haskell. It aims to process Markdown efficiently and in the most forgiving possible way. It is designed to deal with any input, including garbage, with linear performance. Output is sanitized by default for protection against XSS attacks.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-bifunctors (package @@ -4330,7 +4327,7 @@ attacks.") (home-page "http://github.com/ekmett/bifunctors/") (synopsis "Bifunctors for Haskell") (description "This package provides bifunctors for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-semigroupoids (package @@ -4368,7 +4365,7 @@ Finally, to work with these weaker structures it is beneficial to have containers that can provide stronger guarantees about their contents, so versions of @code{Traversable} and @code{Foldable} that can be folded with just a @code{Semigroup} are added.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-contravariant (package @@ -4395,7 +4392,7 @@ just a @code{Semigroup} are added.") "http://github.com/ekmett/contravariant/") (synopsis "Contravariant functors") (description "Contravariant functors for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-semigroups (package @@ -4428,7 +4425,7 @@ monoid in that there might not exist an identity element. It also (originally) generalized a group (a monoid with all inverses) to a type where every element did not have to have an inverse, thus the name semigroup.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-free (package @@ -4465,7 +4462,7 @@ whose nodes are labeled with the constructors of @code{f}. The word \"free\" is used in the sense of \"unrestricted\" rather than \"zero-cost\": @code{Free f} makes no constraining assumptions beyond those given by @code{f} and the definition of @code{Monad}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-adjunctions (package @@ -4498,7 +4495,7 @@ definition of @code{Monad}.") (synopsis "Adjunctions and representable functors") (description "This library provides adjunctions and representable functors for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-fast-logger (package @@ -4524,7 +4521,7 @@ for Haskell.") (home-page "https://hackage.haskell.org/package/fast-logger") (synopsis "Fast logging system") (description "This library provides a fast logging system for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-doctest (package @@ -4559,7 +4556,7 @@ for Haskell.") (description "The doctest program checks examples in source code comments. It is modeled after doctest for Python, see @uref{http://docs.python.org/library/doctest.html, the Doctest website}.") - (license expat))) + (license license:expat))) (define-public ghc-lifted-base (package @@ -4590,7 +4587,7 @@ library lifted to any instance of @code{MonadBase} or @code{MonadBaseControl}. Note that not all modules from @code{base} are converted yet. The package includes a copy of the @code{monad-peel} test suite written by Anders Kaseorg.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-word8 (package @@ -4612,7 +4609,7 @@ Kaseorg.") (home-page "http://hackage.haskell.org/package/word8") (synopsis "Word8 library for Haskell") (description "Word8 library to be used with @code{Data.ByteString}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-stringsearch (package @@ -4635,7 +4632,7 @@ Kaseorg.") for substrings in strict or lazy @code{ByteStrings}. It also provides functions for breaking or splitting on substrings and replacing all occurrences of a substring (the first in case of overlaps) with another.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-tasty-quickcheck (package @@ -4664,7 +4661,7 @@ occurrences of a substring (the first in case of overlaps) with another.") (synopsis "QuickCheck support for the Tasty test framework") (description "This package provides QuickCheck support for the Tasty Haskell test framework.") - (license expat))) + (license license:expat))) (define-public ghc-tasty-golden (package @@ -4699,7 +4696,7 @@ Haskell test framework.") IO action that writes its result to a file. To pass the test, this output file should be identical to the corresponding 'golden' file, which contains the correct result for the test.") - (license expat))) + (license license:expat))) (define-public ghc-tasty (package @@ -4731,7 +4728,7 @@ the correct result for the test.") (description "Tasty is a modern testing framework for Haskell. It lets you combine your unit tests, golden tests, QuickCheck/SmallCheck properties, and any other types of tests into a single test suite.") - (license expat))) + (license license:expat))) (define-public ghc-tasty-hunit (package @@ -4754,7 +4751,7 @@ and any other types of tests into a single test suite.") (synopsis "HUnit support for the Tasty test framework") (description "This package provides HUnit support for the Tasty Haskell test framework.") - (license expat))) + (license license:expat))) (define-public ghc-cookie (package @@ -4785,7 +4782,7 @@ test framework.") (home-page "http://github.com/snoyberg/cookie") (synopsis "HTTP cookie parsing and rendering") (description "HTTP cookie parsing and rendering library for Haskell.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-scientific (package @@ -4821,7 +4818,7 @@ the number type @code{Scientific}. Scientific numbers are arbitrary precision and space efficient. They are represented using @uref{http://en.wikipedia.org/wiki/Scientific_notation, scientific notation}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-aeson (package @@ -4857,7 +4854,7 @@ notation}.") (description "This package provides a JSON parsing and encoding library for Haskell, optimized for ease of use and high performance. (A note on naming: in Greek mythology, Aeson was the father of Jason.)") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-wai (package @@ -4891,7 +4888,7 @@ naming: in Greek mythology, Aeson was the father of Jason.)") (description "This package provides a Web Application Interface (WAI) library for the Haskell language. It defines a common protocol for communication between web applications and web servers.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-wai-logger (package @@ -4925,7 +4922,7 @@ communication between web applications and web servers.") (home-page "http://hackage.haskell.org/package/wai-logger") (synopsis "Logging system for WAI") (description "This package provides the logging system for WAI.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-wai-extra (package @@ -4973,7 +4970,7 @@ communication between web applications and web servers.") (synopsis "Some basic WAI handlers and middleware") (description "This library provides basic WAI handlers and middleware functionality.") - (license expat))) + (license license:expat))) (define-public ghc-deepseq-generics (package @@ -5006,7 +5003,7 @@ functionality.") "This package provides a @code{GHC.Generics}-based @code{Control.DeepSeq.Generics.genericRnf} function which can be used for providing an 'rnf' implementation.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-pandoc-types (package @@ -5031,7 +5028,7 @@ providing an 'rnf' implementation.") "This module defines the @code{Pandoc} data structure, which is used by pandoc to represent structured documents. It also provides functions for building up, manipulating and serialising @code{Pandoc} structures.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-texmath (package @@ -5064,7 +5061,7 @@ Office). Support is also included for converting math formats to pandoc's native format (allowing conversion, via pandoc, to a variety of different markup formats). The TeX reader supports basic LaTeX and AMS extensions, and it can parse and apply LaTeX macros.") - (license gpl2+))) + (license license:gpl2+))) (define-public ghc-regex-pcre-builtin (package @@ -5087,7 +5084,7 @@ it can parse and apply LaTeX macros.") "This package is an enhancement of the @code{Text.Regex} library, providing the PCRE backend to accompany regex-base, with bundled code from @url{http://www.pcre.org}.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-diff (package @@ -5106,7 +5103,7 @@ providing the PCRE backend to accompany regex-base, with bundled code from (description "This package provides an implementation of the standard diff algorithm, and utilities for pretty printing.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-highlighting-kate (package @@ -5138,7 +5135,7 @@ from @uref{http://kate-editor.org/, Kate syntax descriptions}, so any syntax supported by Kate can be added. An (optional) command-line program is provided, along with a utility for generating new parsers from Kate XML syntax descriptions.") - (license gpl2+))) + (license license:gpl2+))) (define-public ghc-cmark (package @@ -5163,7 +5160,7 @@ descriptions.") @uref{https://github.com/jgm/cmark, libcmark}, the reference parser for CommonMark, a fully specified variant of Markdown. It includes sources for libcmark (0.21.0) and does not require prior installation of the C library.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-executable-path (package @@ -5185,7 +5182,7 @@ libcmark (0.21.0) and does not require prior installation of the C library.") \"However, this is hard-to-impossible to implement on some non-Unix OSes, so instead, for maximum portability, we just return the leafname of the program as invoked.\" This library tries to provide the missing path.") - (license public-domain))) + (license license:public-domain))) (define-public ghc-enclosed-exceptions (package @@ -5214,7 +5211,7 @@ as invoked.\" This library tries to provide the missing path.") "This library implements a technique to catch all exceptions raised within an enclosed computation, while remaining responsive to (external) asynchronous exceptions.") - (license expat))) + (license license:expat))) (define-public ghc-packedstring (package @@ -5243,7 +5240,7 @@ asynchronous exceptions.") (synopsis "Library for packed strings") (description "This deprecated library provides an implementation of packed strings.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-th-lift (package @@ -5264,7 +5261,7 @@ asynchronous exceptions.") (description "This is a Haskell library to derive Template Haskell's Lift class for datatypes.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-th-expand-syns (package @@ -5286,7 +5283,7 @@ datatypes.") (description "This package enables users to expand type synonyms in Template Haskell @dfn{abstract syntax trees} (ASTs).") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-th-reify-many (package @@ -5312,7 +5309,7 @@ datatypes.") declarations. The main intended use case is for enumerating the names of datatypes reachable from an initial datatype, and passing these names to some function which generates instances.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-th-orphans (package @@ -5340,7 +5337,7 @@ function which generates instances.") instances for @code{Ord} and @code{Lift}, as well as a few missing @code{Show} and @code{Eq} instances. These instances used to live in the haskell-src-meta package, and that's where the version number started.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-haskell-src-meta (package @@ -5364,7 +5361,7 @@ package, and that's where the version number started.") (description "This package provides tools to parse Haskell sources to the template-haskell abstract syntax.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-aeson-qq (package @@ -5395,7 +5392,7 @@ template-haskell abstract syntax.") "aeson-qq provides a JSON quasiquoter for Haskell. This package exposes the function @code{aesonQQ} that compile-time converts a string representation of a JSON value into a @code{Data.Aeson.Value}.") - (license expat))) + (license license:expat))) (define-public ghc-conduit (package @@ -5429,7 +5426,7 @@ production, transformation, and consumption of streams of data in constant memory. It is an alternative to lazy I/O which guarantees deterministic resource handling, and fits in the same general solution space as enumerator/iteratee and pipes." ) - (license expat))) + (license license:expat))) (define-public ghc-logging-facade (package @@ -5451,7 +5448,7 @@ enumerator/iteratee and pipes." ) (description "This package provides a simple logging abstraction that allows multiple back-ends.") - (license expat))) + (license license:expat))) (define-public ghc-mockery (package @@ -5474,7 +5471,7 @@ back-ends.") (synopsis "Support functions for automated testing") (description "The mockery package provides support functions for automated testing.") - (license expat))) + (license license:expat))) (define-public ghc-yaml (package @@ -5508,7 +5505,7 @@ back-ends.") (synopsis "Parsing and rendering YAML documents") (description "This package provides a library to parse and render YAML documents.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-filemanip (package @@ -5531,7 +5528,7 @@ back-ends.") "This package provides a Haskell library for working with files and directories. It includes code for pattern matching, finding files, modifying file contents, and more.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-mmap (package @@ -5552,7 +5549,7 @@ file contents, and more.") devices to be lazily loaded into memory as strict or lazy @code{ByteStrings}, @code{ForeignPtrs} or plain @code{Ptrs}, using the virtual memory subsystem to do on-demand loading.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-juicypixels (package @@ -5578,7 +5575,7 @@ do on-demand loading.") (description "This library can load and store images in PNG, Bitmap, JPEG, Radiance, TIFF and GIF formats.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-sha (package @@ -5605,7 +5602,7 @@ SHA-based HMAC routines. The functions have been tested against most of the NIST and RFC test vectors for the various functions. While some attention has been paid to performance, these do not presently reach the speed of well-tuned libraries, like OpenSSL.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-hslua (package @@ -5636,7 +5633,7 @@ libraries, like OpenSSL.") (description "The Scripting.Lua module is a wrapper of the Lua language interpreter as described in @url{http://www.lua.org/}.") - (license expat))) + (license license:expat))) (define-public ghc-mime-types (package @@ -5657,7 +5654,7 @@ described in @url{http://www.lua.org/}.") (synopsis "Basic MIME type handling types and functions") (description "This library provides basic MIME type handling types and functions.") - (license expat))) + (license license:expat))) (define-public ghc-http-client (package @@ -5698,7 +5695,7 @@ described in @url{http://www.lua.org/}.") (description "This package provides an HTTP client engine, intended as a base layer for more user-friendly packages.") - (license expat))) + (license license:expat))) (define-public ghc-byteable (package @@ -5718,7 +5715,7 @@ for more user-friendly packages.") "This package provides an abstract class to manipulate sequence of bytes. The use case of this class is abstracting manipulation of types that are just wrapping a bytestring with stronger and more meaniful name.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-hourglass (package @@ -5747,7 +5744,7 @@ performant API. The backbone of the library are the @code{Timeable} and @code{Time} type classes. Each @code{Timeable} instances can be converted to a type that has a @code{Time} instances, and thus are different representations of current time.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-pem (package @@ -5775,7 +5772,7 @@ representations of current time.") (description "This library provides readers and writers for the @dfn{Privacy Enhanced Mail} (PEM) format.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-asn1-types (package @@ -5798,7 +5795,7 @@ Mail} (PEM) format.") (description "The package provides the standard types for dealing with the ASN.1 format.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-asn1-encoding (package @@ -5826,7 +5823,7 @@ format.") (description "This package provides a reader and writer for ASN1 data in raw form with supports for high level forms of ASN1 (BER, and DER).") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-asn1-parse (package @@ -5849,7 +5846,7 @@ supports for high level forms of ASN1 (BER, and DER).") (description "This package provides a simple monadic parser for ASN1 stream types, when ASN1 pattern matching is not convenient.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-tasty-kat (package @@ -5873,7 +5870,7 @@ when ASN1 pattern matching is not convenient.") (description "This package provides a @dfn{Known Answer Tests} (KAT) framework for tasty.") - (license expat))) + (license license:expat))) (define-public ghc-cryptonite (package @@ -5903,7 +5900,7 @@ tasty.") It supports a wide range of symmetric ciphers, cryptographic hash functions, public key algorithms, key derivation numbers, cryptographic random number generators, and more.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-memory (package @@ -5929,7 +5926,7 @@ polymorphic byte array management and manipulation functions. It contains a polymorphic byte array abstraction and functions similar to strict ByteString, different type of byte array abstraction, raw memory IO operations (memory set, memory copy, ..) and more") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-x509 (package @@ -5959,7 +5956,7 @@ set, memory copy, ..) and more") (synopsis "X509 reader and writer") (description "This library provides functions to read and write X509 certificates.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-x509-store (package @@ -5986,7 +5983,7 @@ set, memory copy, ..) and more") (description "This package provides functions for accessing and storing X.509 collections, certificates, revocation lists, and exception lists.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-x509-validation (package @@ -6018,7 +6015,7 @@ collections, certificates, revocation lists, and exception lists.") (description "This package provides functions for X.509 certificate and revocation list validation.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-x509-system (package @@ -6043,7 +6040,7 @@ list validation.") (description "This package provides a library to handle system accessors and storage for X.509 certificates.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-tls (package @@ -6086,7 +6083,7 @@ type system, high level constructions and common Haskell features. Currently implement the SSL3.0, TLS1.0, TLS1.1 and TLS1.2 protocol, and support RSA and Ephemeral (Elliptic curve and regular) Diffie Hellman key exchanges, and many extensions.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-socks (package @@ -6107,7 +6104,7 @@ extensions.") (synopsis "SOCKS proxy (version 5) implementation.") (description "This library provides a SOCKS proxy (version 5) implementation.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-connection (package @@ -6138,7 +6135,7 @@ extensions.") "This package provides a simple network library for all your connection needs. It provides a very simple API to create sockets to a destination with the choice of SSL/TLS, and SOCKS.") - (license bsd-3))) + (license license:bsd-3))) (define-public ghc-http-client-tls (package @@ -6170,7 +6167,7 @@ the choice of SSL/TLS, and SOCKS.") "This package provides a backend for the http-client package using the connection and TLS libraries. It is intended for use by higher-level libraries, such as http-conduit.") - (license expat))) + (license license:expat))) (define-public ghc-pandoc (package @@ -6243,7 +6240,7 @@ LaTeX, DocBook, and many more. Pandoc extends standard Markdown syntax with footnotes, embedded LaTeX, definition lists, tables, and other features. A compatibility mode is provided for those who need a drop-in replacement for Markdown.pl.") - (license gpl2+))) + (license license:gpl2+))) (define-public idris (package @@ -6304,6 +6301,6 @@ types. It is compiled, with eager evaluation. Dependent types allow types to be predicated on values, meaning that some aspects of a program's behaviour can be specified precisely in the type. The language is closely related to Epigram and Agda.") - (license bsd-3))) + (license license:bsd-3))) ;;; haskell.scm ends here diff --git a/gnu/packages/image.scm b/gnu/packages/image.scm index f3f89f6be6..d3ed92fde8 100644 --- a/gnu/packages/image.scm +++ b/gnu/packages/image.scm @@ -50,7 +50,7 @@ (define-public libpng (package (name "libpng") - (version "1.5.24") + (version "1.5.26") (source (origin (method url-fetch) @@ -61,7 +61,7 @@ "ftp://ftp.simplesystems.org/pub/libpng/png/src" "/libpng15/libpng-" version ".tar.xz"))) (sha256 - (base32 "1qhvfk1ypsaf6q6xkspyqqzmghpbahhq54ms8fa5ssqkyds38bmr")))) + (base32 "0kbissyd7d4ahwdpm968nnzl7q15p6hadg44i9x0vrkrzdgdi93v")))) (build-system gnu-build-system) ;; libpng.la says "-lz", so propagate it. diff --git a/gnu/packages/irssi.scm b/gnu/packages/irssi.scm index 44bc6bd3a2..e5c72186e2 100644 --- a/gnu/packages/irssi.scm +++ b/gnu/packages/irssi.scm @@ -35,7 +35,8 @@ (version "0.8.17") (source (origin (method url-fetch) - (uri (string-append "http://www.irssi.org/files/irssi-" + (uri (string-append "https://github.com/irssi-import/irssi/" + "releases/download/0.8.17/irssi-" version ".tar.bz2")) (sha256 (base32 diff --git a/gnu/packages/java.scm b/gnu/packages/java.scm index f00a3d720c..60439d1534 100644 --- a/gnu/packages/java.scm +++ b/gnu/packages/java.scm @@ -187,7 +187,7 @@ build process and its dependencies, whereas Make uses Makefile format.") (define-public icedtea6 (package (name "icedtea6") - (version "1.13.8") + (version "1.13.9") (source (origin (method url-fetch) (uri (string-append @@ -195,7 +195,7 @@ build process and its dependencies, whereas Make uses Makefile format.") version ".tar.xz")) (sha256 (base32 - "1nqaq2xjz88rfzm94l28c0cc48gdiwl8ijw9c46s14z3awwn5g7w")) + "0rf95gsyr849b0nxhc7i0k5pr2iz8a922kg288x7jbgws0pgpq31")) (modules '((guix build utils))) (snippet '(substitute* "Makefile.in" @@ -557,10 +557,10 @@ build process and its dependencies, whereas Make uses Makefile format.") ("openjdk6-src" ,(origin (method url-fetch) - (uri "https://java.net/downloads/openjdk6/openjdk-6-src-b36-22_jul_2015.tar.gz") + (uri "https://java.net/downloads/openjdk6/openjdk-6-src-b37-11_nov_2015.tar.gz") (sha256 (base32 - "0mdckpazjijf6ggxzah2nq99lgsi0jk9pjbxhfq39b9lawvb45ln")))) + "0iqzvx1zmrfhxrp3z9h7bh95c2rmclrhiszmsqwkjb2gngbs29j5")))) ("lcms" ,lcms) ("zlib" ,zlib) ("gtk" ,gtk+-2) @@ -576,7 +576,7 @@ build process and its dependencies, whereas Make uses Makefile format.") (license license:gpl2+))) (define-public icedtea7 - (let* ((version "2.6.2") + (let* ((version "2.6.3") (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 - "0xi0w8gpxx3r68hyi7fb991hxb3rqfp7895nfsl4wj3sa1f5ds5y")) + "04n6ac7rca98q68ifja1nmf3icigqgs75k4x12p3n3yknh8alf6z")) (modules '((guix build utils))) (snippet '(substitute* "Makefile.in" @@ -728,24 +728,24 @@ build process and its dependencies, whereas Make uses Makefile format.") (native-inputs `(("openjdk-drop" ,(drop "openjdk" - "0jabxc8iw7ciz6f2qshcpla66qniy686vnxnfx3h2yw7syvas4a9")) + "0vflz0hhq4arykvvmsv3yas4yk9i0jm57287iqvs3a4832xjcpcy")) ("corba-drop" ,(drop "corba" - "1bw22djg8mfqqn8kp8mpbj9vi4pl8dk67qwwrny67d0fvirixylj")) + "1ijy8gkvnvzjnk7x7fypggfapdswd0ha7b8q90vs72lhf0yawlhh")) ("jaxp-drop" ,(drop "jaxp" - "1h3g2dwbj8ihicl73qbr4cvvc3i5bs5ckrpja1nx6g5b56xa7kcl")) + "0sw0a49xmzqrffvlg7mvvlicn2yz5r4swv3l19b0269p0yy7isd0")) ("jaxws-drop" ,(drop "jaxws" - "1m1h7455qn4pdhb5yamdl9965iz9260lzwl3njcs35vi14v7fihl")) + "07nwmpji734fnvb4n3g2cj1fl4mskmg26ksdw3rpvb38wf97v2am")) ("jdk-drop" ,(drop "jdk" - "1wcaxf2chnlpk34q04c23im6z32dy8fr6f9giz3ih65nyvah3n3s")) + "1x89l6rj20rzkalizpy74q4nlnskrvr39nvl2i95isajkda9hf2q")) ("langtools-drop" ,(drop "langtools" - "0da3cmm8nwz7dk2sqnywvidaa0kjnyzzi33p2lkdi4415f8yhgx5")) + "0zpjkpl294aw4nai35fh4lcxyv3vx0q0hnxchjcb2iz0hkgicizi")) ("hotspot-drop" ,(drop "hotspot" - "0fn3cjhqsgbkfzychkvvw6whxil2n9dr6q0196ywxzkinny1hjcq")) + "03pggsrhkzpjnj939vhr3b7mcrhfp22b7yg3hkx52kcv8dqkg3yx")) ,@(fold alist-delete (package-native-inputs icedtea6) '("openjdk6-src"))))))) diff --git a/gnu/packages/key-mon.scm b/gnu/packages/key-mon.scm index c890f85f8d..dbfee050a9 100644 --- a/gnu/packages/key-mon.scm +++ b/gnu/packages/key-mon.scm @@ -56,7 +56,7 @@ #:tests? #f)) ;no tests (native-inputs `(("python2-setuptools" ,python2-setuptools))) - (propagated-inputs + (inputs `(("python2-xlib" ,python2-xlib) ("python2-pygtk" ,python2-pygtk) ("librsvg" ,librsvg) diff --git a/gnu/packages/libevent.scm b/gnu/packages/libevent.scm index a193959e60..752963077b 100644 --- a/gnu/packages/libevent.scm +++ b/gnu/packages/libevent.scm @@ -68,7 +68,7 @@ loop.") (version "4.20") (source (origin (method url-fetch) - (uri (string-append "http://dist.schmorp.de/libev/libev-" + (uri (string-append "http://dist.schmorp.de/libev/Attic/libev-" version ".tar.gz")) (sha256 diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index c018956125..798b1e26d8 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com> +;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,8 +23,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu packages linux) - #:use-module ((guix licenses) - #:hide (zlib openssl)) + #:use-module ((guix licenses) #:prefix license:) #:use-module (gnu packages) #:use-module (gnu packages compression) #:use-module (gnu packages gcc) @@ -149,7 +149,7 @@ #:tests? #f)) (synopsis "GNU Linux-Libre kernel headers") (description "Headers of the Linux-Libre kernel.") - (license gpl2) + (license license:gpl2) (home-page "http://www.gnu.org/software/linux-libre/")))) (define-public module-init-tools @@ -183,7 +183,7 @@ (description "Tools for loading and managing Linux kernel modules, such as `modprobe', `insmod', `lsmod', and more.") - (license gpl2+))) + (license license:gpl2+))) (define %boot-logo-patch ;; Linux-Libre boot logo featuring Freedo and a gnu. @@ -211,7 +211,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM." #f))) (define-public linux-libre - (let* ((version "4.3.2") + (let* ((version "4.3.3") (build-phase '(lambda* (#:key system inputs #:allow-other-keys #:rest args) ;; Apply the neat patch. @@ -285,7 +285,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM." (uri (linux-libre-urls version)) (sha256 (base32 - "0d87jbmplv36kxq40k44zh3sj82qp79lf8n4by7jb2wvyk06rvfg")))) + "1z43kzs1pzwq5mkyh7zk8nq38sxlswp65824v54dzwngyc252a18")))) (build-system gnu-build-system) (supported-systems '("x86_64-linux" "i686-linux")) (native-inputs `(("perl" ,perl) @@ -314,7 +314,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM." (description "GNU Linux-Libre is a free (as in freedom) variant of the Linux kernel. It has been modified to remove all non-free binary blobs.") - (license gpl2) + (license license:gpl2) (home-page "http://www.gnu.org/software/linux-libre/")))) @@ -361,7 +361,7 @@ It has been modified to remove all non-free binary blobs.") Pluggable authentication modules are small shared object files that can be used through the PAM API to perform tasks, like authenticating a user at login. Local and dynamic reconfiguration are its key features.") - (license bsd-3))) + (license license:bsd-3))) ;;; @@ -389,7 +389,7 @@ at login. Local and dynamic reconfiguration are its key features.") "This PSmisc package is a set of some small useful utilities that use the proc filesystem. We're not about changing the world, but providing the system administrator with some help in common tasks.") - (license gpl2+))) + (license license:gpl2+))) (define-public util-linux (package @@ -459,8 +459,8 @@ block devices, UUIDs, TTYs, and many other tools.") ;; Note that util-linux doesn't use the same license for all the ;; code. GPLv2+ is the default license for a code without an ;; explicitly defined license. - (license (list gpl3+ gpl2+ gpl2 lgpl2.0+ - bsd-4 public-domain)))) + (license (list license:gpl3+ license:gpl2+ license:gpl2 license:lgpl2.0+ + license:bsd-4 license:public-domain)))) (define-public procps (package @@ -499,7 +499,7 @@ block devices, UUIDs, TTYs, and many other tools.") that give information about processes using the Linux /proc file system. The package includes the programs ps, top, vmstat, w, kill, free, slabtop, and skill.") - (license gpl2))) + (license license:gpl2))) (define-public usbutils (package @@ -523,7 +523,7 @@ slabtop, and skill.") "Tools for working with USB devices, such as lsusb") (description "Tools for working with USB devices, such as lsusb.") - (license gpl2+))) + (license license:gpl2+))) (define-public e2fsprogs (package @@ -599,9 +599,9 @@ slabtop, and skill.") (synopsis "Creating and checking ext2/ext3/ext4 file systems") (description "This package provides tools for manipulating ext2/ext3/ext4 file systems.") - (license (list gpl2 ; programs - lgpl2.0 ; libext2fs - x11)))) ; libuuid + (license (list license:gpl2 ;programs + license:lgpl2.0 ;libext2fs + license:x11)))) ;libuuid (define e2fsprogs/static (static-package @@ -665,7 +665,7 @@ from the e2fsprogs package. It is meant to be used in initrds.") (description "Extundelete is a set of tools that can recover deleted files from an ext3 or ext4 partition.") - (license gpl2))) + (license license:gpl2))) (define-public zerofree (package @@ -700,7 +700,7 @@ ext3 or ext4 partition.") "The zerofree command scans the free blocks in an ext2 file system and fills any non-zero blocks with zeroes. This is a useful way to make disk images more compressible.") - (license gpl2))) + (license license:gpl2))) (define-public strace (package @@ -720,7 +720,7 @@ images more compressible.") (description "strace is a system call tracer, i.e. a debugging tool which prints out a trace of all the system calls made by a another process/program.") - (license bsd-3))) + (license license:bsd-3))) (define-public ltrace (package @@ -744,7 +744,7 @@ trace of all the system calls made by a another process/program.") "ltrace intercepts and records dynamic library calls which are called by an executed process and the signals received by that process. It can also intercept and print the system calls executed by the program.") - (license gpl2+))) + (license license:gpl2+))) (define-public alsa-lib (package @@ -765,7 +765,7 @@ intercept and print the system calls executed by the program.") (description "The Advanced Linux Sound Architecture (ALSA) provides audio and MIDI functionality to the Linux-based operating system.") - (license lgpl2.1+))) + (license license:lgpl2.1+))) (define-public alsa-utils (package @@ -810,7 +810,7 @@ MIDI functionality to the Linux-based operating system.") ;; This is mostly GPLv2+ but a few files such as 'alsactl.c' are ;; GPLv2-only. - (license gpl2))) + (license license:gpl2))) (define-public iptables (package @@ -838,7 +838,7 @@ system administrators. Since Network Address Translation is also configured from the packet filter ruleset, iptables is used for this, too. The iptables package also includes ip6tables. ip6tables is used for configuring the IPv6 packet filter.") - (license gpl2+))) + (license license:gpl2+))) (define-public iproute (package @@ -899,7 +899,7 @@ consists of several tools, of which the most important are ip and tc. ip controls IPv4 and IPv6 configuration and tc stands for traffic control. Both tools print detailed usage messages and are accompanied by a set of manpages.") - (license gpl2+))) + (license license:gpl2+))) (define-public net-tools ;; XXX: This package is basically unmaintained, but it provides a few @@ -997,7 +997,7 @@ subsystem of the Linux kernel. This includes arp, hostname, ifconfig, netstat, rarp and route. Additionally, this package contains utilities relating to particular network hardware types (plipconfig, slattach) and advanced aspects of IP configuration (iptunnel, ipmaddr).") - (license gpl2+))) + (license license:gpl2+))) (define-public libcap (package @@ -1035,7 +1035,7 @@ advanced aspects of IP configuration (iptunnel, ipmaddr).") Linux-based operating systems.") ;; License is BSD-3 or GPLv2, at the user's choice. - (license gpl2))) + (license license:gpl2))) (define-public bridge-utils (package @@ -1081,7 +1081,7 @@ to connect two Ethernet segments together in a protocol independent way. Packets are forwarded based on Ethernet address, rather than IP address (like a router). Since forwarding is done at Layer 2, all protocols can go transparently through a bridge.") - (license gpl2+))) + (license license:gpl2+))) (define-public libnl (package @@ -1108,7 +1108,7 @@ configuration and monitoring interfaces.") ;; Most files are LGPLv2.1-only, but some are GPLv2-only (like ;; 'nl-addr-add.c'), so the result is GPLv2-only. - (license gpl2))) + (license license:gpl2))) (define-public iw (package @@ -1134,12 +1134,12 @@ configuration and monitoring interfaces.") (description "iw is a new nl80211 based CLI configuration utility for wireless devices. It replaces 'iwconfig', which is deprecated.") - (license isc))) + (license license:isc))) (define-public powertop (package (name "powertop") - (version "2.7") + (version "2.8") (source (origin (method url-fetch) @@ -1148,7 +1148,7 @@ devices. It replaces 'iwconfig', which is deprecated.") version ".tar.gz")) (sha256 (base32 - "1jkqqr3l1x98m7rgin1dgfzxqwj4vciw9lyyq1kl9bdswa818jwd")))) + "0nlwazxbnn0k6q5f5b09wdhw0f194lpzkp3l7vxansqhfczmcyx8")))) (build-system gnu-build-system) (inputs `(("zlib" ,zlib) @@ -1156,7 +1156,7 @@ devices. It replaces 'iwconfig', which is deprecated.") ("ncurses" ,ncurses) ("libnl" ,libnl))) (native-inputs - `(("pkg-config" ,pkg-config))) + `(("pkg-config" ,pkg-config))) (home-page "https://01.org/powertop/") (synopsis "Analyze power consumption on Intel-based laptops") (description @@ -1165,7 +1165,7 @@ power management. In addition to being a diagnostic tool, PowerTOP also has an interactive mode where the user can experiment various power management settings for cases where the operating system has not enabled these settings.") - (license gpl2))) + (license license:gpl2))) (define-public aumix (package @@ -1186,7 +1186,7 @@ settings.") (description "Aumix adjusts an audio mixer from X, the console, a terminal, the command line or a script.") - (license gpl2+))) + (license license:gpl2+))) (define-public iotop (package @@ -1212,20 +1212,23 @@ the command line or a script.") (description "Iotop is a Python program with a top like user interface to show the processes currently causing I/O.") - (license gpl2+))) + (license license:gpl2+))) (define-public fuse (package (name "fuse") - (version "2.9.3") + (version "2.9.4") (source (origin (method url-fetch) - (uri (string-append "mirror://sourceforge/fuse/fuse-" - version ".tar.gz")) + (uri (let ((version-with-underscores + (string-join (string-split version #\.) "_"))) + (string-append + "https://github.com/libfuse/libfuse/" + "releases/download/fuse_" version-with-underscores + "/fuse-" version ".tar.gz"))) (sha256 (base32 - "071r6xjgssy8vwdn6m28qq1bqxsd2bphcd2mzhq0grf5ybm87sqb")) - (patches (list (search-patch "fuse-CVE-2015-3202.patch"))))) + "1qbwp63a2bp0bchabkwiyzszi9x5krlk2pwk2is6g35gyszw1sbb")))) (build-system gnu-build-system) (inputs `(("util-linux" ,util-linux))) (arguments @@ -1270,8 +1273,8 @@ but also an impediment to system extensibility. FUSE, for \"file systems in user space\", is a kernel module and user-space library that tries to address part of this problem by allowing users to run file system implementations as user-space processes.") - (license (list lgpl2.1 ; library - gpl2+)))) ; command-line utilities + (license (list license:lgpl2.1 ;library + license:gpl2+)))) ;command-line utilities (define-public unionfs-fuse (package @@ -1295,7 +1298,7 @@ user-space processes.") space, using the FUSE library. Mounting a union file system allows you to \"aggregate\" the contents of several directories into a single mount point. UnionFS-FUSE additionally supports copy-on-write.") - (license bsd-3))) + (license license:bsd-3))) (define fuse-static (package (inherit fuse) @@ -1346,8 +1349,11 @@ UnionFS-FUSE additionally supports copy-on-write.") (version "2.5") (source (origin (method url-fetch) - (uri (string-append "mirror://sourceforge/fuse/sshfs-fuse-" - version ".tar.gz")) + (uri (let ((version-with-underscores + (string-join (string-split version #\.) "_"))) + (string-append "https://github.com/libfuse/sshfs/releases/" + "download/sshfs_" version-with-underscores + "/sshfs-fuse-" version ".tar.gz"))) (sha256 (base32 "0gp6qr33l2p0964j0kds0dfmvyyf5lpgsn11daf0n5fhwm9185z9")))) @@ -1364,7 +1370,7 @@ UnionFS-FUSE additionally supports copy-on-write.") Since most SSH servers already support this protocol it is very easy to set up: on the server side there's nothing to do; on the client side mounting the file system is as easy as logging into the server with an SSH client.") - (license gpl2+))) + (license license:gpl2+))) (define-public numactl (package @@ -1397,8 +1403,8 @@ program. The package contains other commands, such as numademo, numastat and memhog. The numademo command provides a quick overview of NUMA performance on your system.") - (license (list gpl2 ; programs - lgpl2.1)))) ; library + (license (list license:gpl2 ;programs + license:lgpl2.1)))) ;library (define-public kbd (package @@ -1456,7 +1462,7 @@ system.") "This package contains keytable files and keyboard utilities compatible for systems using the Linux kernel. This includes commands such as 'loadkeys', 'setfont', 'kbdinfo', and 'chvt'.") - (license gpl2+))) + (license license:gpl2+))) (define-public inotify-tools (package @@ -1476,7 +1482,7 @@ for systems using the Linux kernel. This includes commands such as (description "The inotify-tools packages provides a C library and command-line tools to use Linux' inotify mechanism, which allows file accesses to be monitored.") - (license gpl2+))) + (license license:gpl2+))) (define-public kmod (package @@ -1520,7 +1526,7 @@ dependencies and aliases. These tools are designed on top of libkmod, a library that is shipped with kmod. The aim is to be compatible with tools, configurations and indices from the module-init-tools project.") - (license gpl2+))) ; library under lgpl2.1+ + (license license:gpl2+))) ; library under lgpl2.1+ (define-public eudev ;; The post-systemd fork, maintained by Gentoo. @@ -1543,12 +1549,12 @@ from the module-init-tools project.") ("gperf" ,gperf))) (inputs `(("kmod" ,kmod))) - (home-page "http://www.gentoo.org/proj/en/eudev/") + (home-page "https://wiki.gentoo.org/wiki/Project:Eudev") (synopsis "Userspace device management") (description "Udev is a daemon which dynamically creates and removes device nodes from /dev/, handles hotplug events and loads drivers at boot time.") - (license gpl2+))) + (license license:gpl2+))) (define-public lvm2 (package @@ -1613,7 +1619,7 @@ mapper. Kernel components are part of Linux-libre.") ;; Libraries (liblvm2, libdevmapper) are LGPLv2.1. ;; Command-line tools are GPLv2. - (license (list gpl2 lgpl2.1)))) + (license (list license:gpl2 license:lgpl2.1)))) (define-public wireless-tools (package @@ -1652,7 +1658,7 @@ interface.") (home-page "http://www.hpl.hp.com/personal/Jean_Tourrilhes/Linux/Tools.html") ;; wireless.21.h and wireless.22.h are distributed under lgpl2.1+, the ;; other files are distributed under gpl2. - (license (list gpl2 lgpl2.1+)))) + (license (list license:gpl2 license:lgpl2.1+)))) (define-public crda (package @@ -1721,7 +1727,7 @@ interface.") "The Central Regulatory Domain Agent (CRDA) acts as the udev helper for communication between the kernel Linux and user space for regulatory compliance.") - (license copyleft-next))) + (license license:copyleft-next))) (define-public wireless-regdb (package @@ -1734,11 +1740,21 @@ compliance.") "wireless-regdb-" version ".tar.xz")) (sha256 (base32 - "0czi83k311fp27z42hxjm8vi88fsbc23mhavv96lkb4pmari0jjc")))) + "0czi83k311fp27z42hxjm8vi88fsbc23mhavv96lkb4pmari0jjc")) + + ;; We're building 'regulatory.bin' by ourselves. + (snippet '(delete-file "regulatory.bin")))) (build-system gnu-build-system) (arguments '(#:phases (modify-phases %standard-phases (delete 'configure)) + + ;; The 'all' target of the makefile depends on $(REGDB_CHANGED), which + ;; is computed and can be equal to 'maintainer-clean'; when that + ;; happens, we can end up deleting the 'regulatory.bin' file that we + ;; just built. Thus, build things sequentially. + #:parallel-build? #f + #:tests? #f ;no tests #:make-flags (let ((out (assoc-ref %outputs "out"))) (list (string-append "PREFIX=" out) @@ -1759,7 +1775,7 @@ compliance.") "This package contains the wireless regulatory database Central Regulatory Database Agent (CRDA) daemon. The database contains information on country-specific regulations for the wireless spectrum.") - (license isc))) + (license license:isc))) (define-public lm-sensors (package @@ -1832,7 +1848,7 @@ country-specific regulations for the wireless spectrum.") "Lm-sensors is a hardware health monitoring package for Linux. It allows you to access information from temperature, voltage, and fan speed sensors. It works with most newer systems.") - (license gpl2+))) + (license license:gpl2+))) (define-public i2c-tools (package @@ -1862,7 +1878,7 @@ It works with most newer systems.") Linux: a bus probing tool, a chip dumper, register-level SMBus access helpers, EEPROM decoding scripts, EEPROM programming tools, and a python module for SMBus access.") - (license gpl2+))) + (license license:gpl2+))) (define-public xsensors (package @@ -1899,7 +1915,7 @@ SMBus access.") "Xsensors reads data from the libsensors library regarding hardware health such as temperature, voltage and fan speed and displays the information in a digital read-out.") - (license gpl2+))) + (license license:gpl2+))) (define-public perf (package @@ -1975,7 +1991,7 @@ containers. It can be used for running a command or even booting an OS inside an isolated container, created with the help of Linux namespaces. It is similar in functionality to chroot, although pflask provides better isolation thanks to the use of namespaces.") - (license bsd-2))) + (license license:bsd-2))) (define-public hdparm (package @@ -2001,7 +2017,7 @@ thanks to the use of namespaces.") (description "Get/set device parameters for Linux SATA/IDE drives. It's primary use is for enabling irq-unmasking and IDE multiple-mode.") - (license (non-copyleft "file://LICENSE.TXT")))) + (license (license:non-copyleft "file://LICENSE.TXT")))) (define-public rfkill (package @@ -2027,8 +2043,8 @@ is for enabling irq-unmasking and IDE multiple-mode.") "rfkill is a simple tool for accessing the rfkill device interface, which is used to enable and disable wireless networking devices, typically WLAN, Bluetooth and mobile broadband.") - (license (non-copyleft "file://COPYING" - "See COPYING in the distribution.")))) + (license (license:non-copyleft "file://COPYING" + "See COPYING in the distribution.")))) (define-public acpid (package @@ -2050,7 +2066,7 @@ Configuration and Power Interface (ACPI) events. acpid should be started during the system boot, and will run as a background process. When an ACPI event is received from the kernel, acpid will examine the list of rules specified in /etc/acpi/events and execute the rules that match the event.") - (license gpl2+))) + (license license:gpl2+))) (define-public sysfsutils (package @@ -2074,7 +2090,7 @@ Linux kernel versions 2.5+ that exposes a system's device tree. The package also contains the libsysfs library.") ;; The library is under lgpl2.1+ (all files say "or any later version"). ;; The rest is mostly gpl2, with a few files indicating gpl2+. - (license (list gpl2 gpl2+ lgpl2.1+)))) + (license (list license:gpl2 license:gpl2+ license:lgpl2.1+)))) (define-public sysfsutils-1 (package @@ -2126,7 +2142,7 @@ also contains the libsysfs library.") "The cpufrequtils suite contains utilities to retrieve CPU frequency information, and set the CPU frequency if supported, using the cpufreq capabilities of the Linux kernel.") - (license gpl2))) + (license license:gpl2))) (define-public libraw1394 (package @@ -2149,7 +2165,7 @@ the Linux IEEE-1394 subsystem, which provides direct access to the connected 1394 buses to user space. Through libraw1394/raw1394, applications can directly send to and receive from other nodes without requiring a kernel driver for the protocol in question.") - (license lgpl2.1+))) + (license license:lgpl2.1+))) (define-public libavc1394 (package @@ -2172,7 +2188,7 @@ protocol in question.") (description "Libavc1394 is a programming interface to the AV/C specification from the 1394 Trade Association. AV/C stands for Audio/Video Control.") - (license lgpl2.1+))) + (license license:lgpl2.1+))) (define-public libiec61883 (package @@ -2196,7 +2212,7 @@ the 1394 Trade Association. AV/C stands for Audio/Video Control.") (description "The libiec61883 library provides a higher level API for streaming DV, MPEG-2 and audio over Linux IEEE 1394.") - (license lgpl2.1+))) + (license license:lgpl2.1+))) (define-public mdadm (package @@ -2239,7 +2255,7 @@ MPEG-2 and audio over Linux IEEE 1394.") "mdadm is a tool for managing Linux Software RAID arrays. It can create, assemble, report on, and monitor arrays. It can also move spares between raid arrays when needed.") - (license gpl2+))) + (license license:gpl2+))) (define-public libaio (package @@ -2268,12 +2284,12 @@ arrays when needed.") "This library enables userspace to use Linux kernel asynchronous I/O system calls, important for the performance of databases and other advanced applications.") - (license lgpl2.1+))) + (license license:lgpl2.1+))) (define-public bluez (package (name "bluez") - (version "5.35") + (version "5.36") (source (origin (method url-fetch) (uri (string-append @@ -2281,9 +2297,7 @@ applications.") version ".tar.xz")) (sha256 (base32 - "1qphz25hganfnd5ipfscbj7s70anv5favmwqmi9ig2saciaf1zhs")) - (patches - (list (search-patch "bluez-tests.patch"))))) + "1wkqwmi5krr37mxcqqlp5m2xnw7vw70v3ww7j09vvlskxcdflhx3")))) (build-system gnu-build-system) (arguments '(#:configure-flags @@ -2307,7 +2321,7 @@ applications.") (description "BlueZ provides support for the core Bluetooth layers and protocols. It is flexible, efficient and uses a modular implementation.") - (license gpl2+))) + (license license:gpl2+))) (define-public fuse-exfat (package @@ -2365,7 +2379,7 @@ id=0B7CLI-REKbE3VTdaa0EzTkhYdU0") (description "This package provides a FUSE-based file system that provides read and write access to exFAT devices.") - (license gpl2+))) + (license license:gpl2+))) (define-public gpm (package @@ -2408,4 +2422,4 @@ write access to exFAT devices.") "The GPM (general-purpose mouse) daemon is a mouse server for applications running on the Linux console. It allows users to select items and copy/paste text in the console and in xterm.") - (license gpl2+))) + (license license:gpl2+))) diff --git a/gnu/packages/lynx.scm b/gnu/packages/lynx.scm index 713f5d5625..3182b3e3f9 100644 --- a/gnu/packages/lynx.scm +++ b/gnu/packages/lynx.scm @@ -37,8 +37,7 @@ (source (origin (method url-fetch) (uri (string-append - "http://lynx.isc.org/lynx" - (substring version 0 (string-index version char-set:letter)) + "http://invisible-mirror.net/archives/lynx/tarballs" "/lynx" version ".tar.bz2")) (sha256 (base32 "1rxysl08acqll5b87368f04kckl8sggy1qhnq59gsxyny1ffg039")))) diff --git a/gnu/packages/machine-learning.scm b/gnu/packages/machine-learning.scm index bfa88ac964..4bc37ad86d 100644 --- a/gnu/packages/machine-learning.scm +++ b/gnu/packages/machine-learning.scm @@ -23,6 +23,7 @@ #:use-module (guix download) #:use-module (guix build-system cmake) #:use-module (guix build-system gnu) + #:use-module (guix build-system r) #:use-module (gnu packages) #:use-module (gnu packages boost) #:use-module (gnu packages compression) @@ -290,3 +291,35 @@ combine multiple data representations, algorithm classes, and general purpose tools. This enables both rapid prototyping of data pipelines and extensibility in terms of new algorithms.") (license license:gpl3+))) + +(define-public r-adaptivesparsity + (package + (name "r-adaptivesparsity") + (version "1.4") + (source (origin + (method url-fetch) + (uri (cran-uri "AdaptiveSparsity" version)) + (sha256 + (base32 + "1az7isvalf3kmdiycrfl6s9k9xqk22k1mc6rh8v0jmcz402qyq8z")))) + (properties + `((upstream-name . "AdaptiveSparsity"))) + (build-system r-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'link-against-armadillo + (lambda _ + (substitute* "src/Makevars" + (("PKG_LIBS=" prefix) + (string-append prefix "-larmadillo")))))))) + (propagated-inputs + `(("r-rcpp" ,r-rcpp) + ("r-rcpparmadillo" ,r-rcpparmadillo))) + (home-page "http://cran.r-project.org/web/packages/AdaptiveSparsity") + (synopsis "Adaptive sparsity models") + (description + "This package implements the Figueiredo machine learning algorithm for +adaptive sparsity and the Wong algorithm for adaptively sparse gaussian +geometric models.") + (license license:lgpl3+))) diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index bf28ec674e..f765728ae4 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -285,7 +285,7 @@ and corrections. It is based on a Bayesian filter.") (define-public offlineimap (package (name "offlineimap") - (version "6.5.7") + (version "6.6.1") (source (origin (method url-fetch) (uri (string-append "https://github.com/OfflineIMAP/offlineimap/" @@ -293,7 +293,7 @@ and corrections. It is based on a Bayesian filter.") (file-name (string-append name "-" version ".tar.gz")) (sha256 (base32 - "18whwc4f8nk8gi3mjw9153c9cvwd3i9i7njmpdbhcplrv33m5pmp")))) + "1c2b03856a78ripkpl9jjzj6yzyfb3rlrdnjx300s647l1xx8gxg")))) (build-system python-build-system) (native-inputs `(("python" ,python-2))) (arguments @@ -302,7 +302,7 @@ and corrections. It is based on a Bayesian filter.") ;; Tests require a modifiable IMAP account. #:tests? #f)) (home-page "http://www.offlineimap.org") - (synopsis "Synch emails between two repositories") + (synopsis "Sync emails between two repositories") (description "OfflineImap synchronizes emails between two repositories, so that you can read the same mailbox from multiple computers. It supports IMAP as REMOTE @@ -372,17 +372,18 @@ attachments, create new maildirs, and so on.") (define-public notmuch (package (name "notmuch") - (version "0.20.2") + (version "0.21") (source (origin (method url-fetch) - (uri (string-append "http://notmuchmail.org/releases/notmuch-" + (uri (string-append "https://notmuchmail.org/releases/notmuch-" version ".tar.gz")) (sha256 (base32 - "1v5dcnlg4km5hfaq0i0qywq5fn66fi0rq4aaibyqkwxz8mis4hgp")))) + "1cr53rbpkcy3pvrmhbg2gq7sjpwb0c8xd7a4zhzxbiv8s7z8yvyh")))) (build-system gnu-build-system) (arguments - '(#:tests? #f ;; FIXME: 637 tests; 70 fail and 98 are skipped + '(#:tests? #f ;; FIXME: 662 tests; 168 fail and 99 are skipped + ;; with perl input: 50 fail and 99 are skipped #:phases (modify-phases %standard-phases (replace 'configure (lambda* (#:key outputs #:allow-other-keys) @@ -449,7 +450,7 @@ and search library.") (define-public getmail (package (name "getmail") - (version "4.46.0") + (version "4.48.0") (source (origin (method url-fetch) @@ -457,7 +458,7 @@ and search library.") name "-" version ".tar.gz")) (sha256 (base32 - "15rqmm25pq6ll8aaqh8h6pfdkpqs7y6yismb3h3w1bz8j292c8zl")))) + "0k5rm5kag14izng2ajcagvli9sns5mzvkyfa65ri4xymxs91wi29")))) (build-system python-build-system) (arguments `(#:tests? #f ; no tests @@ -518,14 +519,15 @@ MailCore 2.") (define-public claws-mail (package (name "claws-mail") - (version "3.13.0") + (version "3.13.1") (source (origin (method url-fetch) (uri (string-append "http://www.claws-mail.org/releases/" name "-" version ".tar.xz")) (sha256 - (base32 "0fpr9gdgrs5yggm61a6135ca06x0cflddsh8dwfqmpb3dj07cl1n")))) + (base32 + "049av7r0xhjjjm1p93l2ns3xisvn125v3ncqar23cqjzgcichg5d")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("bogofilter" ,bogofilter) @@ -563,17 +565,18 @@ which can add many functionalities to the base client.") (define-public msmtp (package (name "msmtp") - (version "1.6.2") + (version "1.6.3") (source (origin (method url-fetch) (uri (string-append "mirror://sourceforge/msmtp/msmtp-" version ".tar.xz")) (sha256 (base32 - "12c7ljahb06pgn8yvvw526xvr11vnr6d4nr0apylixddpxycsvig")))) + "0mbkflxv2swjz4185inis83v6pxcblpmapwjhgpc6wh7kh3bx0pr")))) (build-system gnu-build-system) (inputs `(("libidn" ,libidn) + ("libsecret" ,libsecret) ("gnutls" ,gnutls) ("zlib" ,zlib) ("gsasl" ,gsasl))) @@ -595,14 +598,17 @@ delivery.") (define-public exim (package (name "exim") - (version "4.85") + (version "4.86") (source (origin (method url-fetch) - (uri (string-append - "ftp://ftp.exim.org/pub/exim/exim4/exim-" version ".tar.bz2")) + (uri (list (string-append "ftp://ftp.exim.org/pub/exim/exim4/exim-" + version ".tar.bz2") + (string-append "ftp://ftp.exim.org/pub/exim/exim4/old/exim-" + version ".tar.bz2"))) (sha256 - (base32 "195a3ll5ck9viazf9pvgcyc0sziln5g0ggmlm6ax002lphmiy88k")))) + (base32 + "0mn4bxih9slrmll5262ayhf41ji43pjf1rv0y6xpy6x55v7g5k7i")))) (build-system gnu-build-system) (inputs `(("bdb" ,bdb) @@ -696,7 +702,8 @@ facilities for checking incoming mail.") `(("openssl" ,openssl) ("zlib" ,zlib) ("bzip2" ,bzip2) - ("sqlite" ,sqlite))) + ("sqlite" ,sqlite) + ("linux-pam" ,linux-pam))) (arguments `(#:configure-flags '("--sysconfdir=/etc" "--localstatedir=/var") @@ -723,14 +730,14 @@ It supports mbox/Maildir and its own dbox/mdbox formats.") (define-public isync (package (name "isync") - (version "1.1.2") + (version "1.2.1") (source (origin (method url-fetch) (uri (string-append "mirror://sourceforge/isync/isync/" version "/isync-" version ".tar.gz")) (sha256 (base32 - "1960ah3fmp75cakd06lcx50n5q0yvfsadjh3lffhyvjvj7ava9d2")))) + "1bij6nm06ghkg98n2pdyacam2fyg5y8f7ajw0d5653m0r4ldw5p7")))) (build-system gnu-build-system) (inputs `(("bdb" ,bdb) diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index 0c0f013ca4..e2d5aa1ff4 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il> +;;; Copyright © 2015 Fabian Harfert <fhmgufs@web.de> ;;; ;;; This file is part of GNU Guix. ;;; @@ -53,6 +54,7 @@ #:use-module (gnu packages ghostscript) #:use-module (gnu packages glib) #:use-module (gnu packages gtk) + #:use-module (gnu packages image) #:use-module (gnu packages less) #:use-module (gnu packages lisp) #:use-module (gnu packages gnome) @@ -1422,6 +1424,46 @@ output to TeX, and a browser for Maxima's manual including command index and full text searching.") (license license:gpl2+))) +(define-public armadillo + (package + (name "armadillo") + (version "6.400.3") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/arma/armadillo-" + version ".tar.gz")) + (sha256 + (base32 + "0bsgrmldlx77w5x26n3axj1hg6iw6csyw0dwl1flrbdwl51f9701")))) + (build-system cmake-build-system) + (arguments `(#:tests? #f)) ;no test target + (inputs + `(("openblas" ,openblas) + ("lapack" ,lapack) + ("arpack" ,arpack-ng))) + (home-page "http://arma.sourceforge.net/") + (synopsis "C++ linear algebra library") + (description + "Armadillo is a C++ linear algebra library, aiming towards a good balance +between speed and ease of use. It is useful for algorithm development +directly in C++, or quick conversion of research code into production +environments. It can be used for machine learning, pattern recognition, +signal processing, bioinformatics, statistics, econometrics, etc. The library +provides efficient classes for vectors, matrices and cubes, as well as 150+ +associated functions (eg. contiguous and non-contiguous submatrix views).") + (license license:mpl2.0))) + +(define-public armadillo-for-rcpparmadillo + (package (inherit armadillo) + (version "6.200.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/arma/armadillo-" + version ".tar.gz")) + (sha256 + (base32 + "1f69rlqhnf2wv8khyn2a8vi6gx1i72qgfy8b9b760ssk85dcl763")))))) + (define-public muparser (package (name "muparser") @@ -1991,3 +2033,32 @@ variables, a command history, hex/octal/binary input and output, unit conversions, embedded comments, and an expandable expression entry field. It evaluates expressions using the standard order of operations.") (license license:gpl2+))) + +(define-public xaos + (package + (name "xaos") + (version "3.6") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/xaos/xaos-" + version ".tar.gz")) + (sha256 + (base32 + "15cd1cx1dyygw6g2nhjqq3bsfdj8sj8m4va9n75i0f3ryww3x7wq")))) + (build-system gnu-build-system) + (native-inputs `(("gettext" ,gnu-gettext))) + (inputs `(("libx11" ,libx11) + ("zlib" ,zlib) + ("libpng" ,libpng) + ("gsl" ,gsl))) + (arguments + `(#:tests? #f ;no "check" target + #:make-flags '("LOCALEDIR=$DATAROOTDIR/locale"))) + (synopsis "Real-time fractal zoomer") + (description "GNU XaoS is a graphical program that generates fractal +patterns and allows you to zoom in and out of them infinitely in a fluid, +continuous manner. It also includes tutorials that help to explain how fractals +are built. It can generate many different fractal types such as the Mandelbrot +set.") + (home-page "http://www.gnu.org/software/xaos/") + (license license:gpl2+))) diff --git a/gnu/packages/messaging.scm b/gnu/packages/messaging.scm index 140108987b..956045d420 100644 --- a/gnu/packages/messaging.scm +++ b/gnu/packages/messaging.scm @@ -365,14 +365,14 @@ compromised.") (define-public znc (package (name "znc") - (version "1.6.1") + (version "1.6.2") (source (origin (method url-fetch) - (uri (string-append "http://znc.in/releases/znc-" + (uri (string-append "http://znc.in/releases/archive/znc-" version ".tar.gz")) (sha256 (base32 - "0h61nv5kx9k8prmhsffxhlprf7gjcq8vqhjjmqr6v3glcirkjjds")))) + "14q5dyr5zg99hm6j6g1gilcn1zf7dskhxfpz3bnkyhy6q0kpgwgf")))) (build-system gnu-build-system) (arguments '(#:tests? #f ; tries to download GoogleTest with wget diff --git a/gnu/packages/moreutils.scm b/gnu/packages/moreutils.scm index 4ea6df3dcc..eebb20790d 100644 --- a/gnu/packages/moreutils.scm +++ b/gnu/packages/moreutils.scm @@ -28,7 +28,7 @@ (define-public moreutils (package (name "moreutils") - (version "0.55") + (version "0.57") (source (origin (method url-fetch) (uri (string-append @@ -36,7 +36,7 @@ version ".orig.tar.gz")) (sha256 (base32 - "1dcah2jx8dbznn8966xl7sf1jrld2qfh6l6xcmx9dsnf8p8mr7fs")))) + "078dpkwwwrv8hxnylbc901kib2d1rr3hsja37j6dlpjfcfq58z9s")))) (build-system gnu-build-system) (inputs `(("perl" ,perl) ("libxml2" ,libxml2) diff --git a/gnu/packages/music.scm b/gnu/packages/music.scm index a217a89a19..fd1751e95b 100644 --- a/gnu/packages/music.scm +++ b/gnu/packages/music.scm @@ -1,4 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org> ;;; @@ -39,6 +40,7 @@ #:use-module (gnu packages check) #:use-module (gnu packages compression) #:use-module (gnu packages docbook) + #:use-module (gnu packages doxygen) #:use-module (gnu packages flex) #:use-module (gnu packages fltk) #:use-module (gnu packages fonts) @@ -66,6 +68,7 @@ #:use-module (gnu packages python) #:use-module (gnu packages qt) #:use-module (gnu packages rdf) + #:use-module (gnu packages readline) #:use-module (gnu packages rsync) #:use-module (gnu packages tcl) #:use-module (gnu packages texinfo) @@ -252,7 +255,7 @@ you to define complex tempo maps for entire songs or performances.") (define-public lilypond (package (name "lilypond") - (version "2.19.27") + (version "2.19.33") (source (origin (method url-fetch) (uri (string-append @@ -261,32 +264,39 @@ you to define complex tempo maps for entire songs or performances.") name "-" version ".tar.gz")) (sha256 (base32 - "11v4jr4qj1jpqvjw1ww7riv8pxfyasif8mf16l447f1xq1ifhkhs")))) + "0s4vbbfy4xwq4da4kmlnndalmcyx2jaz7y8praah2146qbnr90xh")))) (build-system gnu-build-system) (arguments `(#:tests? #f ; out-test/collated-files.html fails #:out-of-source? #t + #:make-flags '("conf=www") ;to generate images for info manuals #:configure-flags - (list (string-append "--with-texgyre-dir=" + (list "CONFIGURATION=www" + (string-append "--with-texgyre-dir=" (assoc-ref %build-inputs "font-tex-gyre") "/share/fonts/opentype/")) #:phases (modify-phases %standard-phases - (add-after 'unpack 'hardcode-path-to-gs - (lambda* (#:key inputs #:allow-other-keys) + (add-after 'unpack 'fix-path-references + (lambda _ (substitute* "scm/backend-library.scm" (("\\(search-executable '\\(\"gs\"\\)\\)") - (string-append "\"" - (assoc-ref inputs "ghostscript") - "/bin/gs" - "\"" ))) + (string-append "\"" (which "gs") "\"")) + (("\"/bin/sh\"") + (string-append "\"" (which "sh") "\""))) #t)) (add-before 'configure 'prepare-configuration (lambda _ (substitute* "configure" (("SHELL=/bin/sh") "SHELL=sh")) - (setenv "out" "") - #t))))) + (setenv "out" "www") + (setenv "conf" "www") + #t)) + (add-after 'install 'install-info + (lambda _ + (zero? (system* "make" + "-j" (number->string (parallel-job-count)) + "conf=www" "install-info"))))))) (inputs `(("guile" ,guile-1.8) ("font-dejavu" ,font-dejavu) @@ -636,6 +646,38 @@ modification devices that brought world-wide fame to the names and products of Laurens Hammond and Don Leslie.") (license license:gpl2+))) +(define-public bristol + (package + (name "bristol") + (version "0.60.11") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/bristol/bristol/" + (version-major+minor version) + "/bristol-" version ".tar.gz")) + (sha256 + (base32 + "1fi2m4gmvxdi260821y09lxsimq82yv4k5bbgk3kyc3x1nyhn7vx")))) + (build-system gnu-build-system) + (inputs + `(("alsa-lib" ,alsa-lib) + ("jack" ,jack-1) + ("liblo" ,liblo) + ("libx11" ,libx11))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (home-page "http://bristol.sourceforge.net/") + (synopsis "Synthesizer emulator") + (description + "Bristol is an emulation package for a number of different 'classic' +synthesizers including additive and subtractive and a few organs. The +application consists of the engine, which is called bristol, and its own GUI +library called brighton that represents all the emulations. There are +currently more than twenty different emulations; each does sound different +although the author maintains that the quality and accuracy of each emulation +is subjective.") + (license license:gpl3+))) + (define-public tuxguitar (package (name "tuxguitar") @@ -660,17 +702,19 @@ Laurens Hammond and Don Leslie.") #:tests? #f ;no "check" target #:parallel-build? #f ;not supported #:phases - (alist-cons-before - 'build 'enter-dir-set-path-and-pass-ldflags - (lambda* (#:key inputs #:allow-other-keys) - (chdir "TuxGuitar") - (substitute* "GNUmakefile" - (("PROPERTIES\\?=") - (string-append "PROPERTIES?= -Dswt.library.path=" - (assoc-ref inputs "swt") "/lib")) - (("\\$\\(GCJ\\) -o") "$(GCJ) $(LDFLAGS) -o")) - #t) - (alist-delete 'configure %standard-phases)))) + (modify-phases %standard-phases + (delete 'configure) + (add-before 'build 'enter-dir-and-set-flags + (lambda* (#:key inputs #:allow-other-keys) + (chdir "TuxGuitar") + (substitute* "GNUmakefile" + (("GCJFLAGS\\+=(.*)" _ rest) + (string-append "GCJFLAGS=-fsource=1.4 -fPIC " rest)) + (("PROPERTIES\\?=") + (string-append "PROPERTIES?= -Dswt.library.path=" + (assoc-ref inputs "swt") "/lib")) + (("\\$\\(GCJ\\) -o") "$(GCJ) $(LDFLAGS) -o")) + #t))))) (inputs `(("swt" ,swt))) (native-inputs @@ -771,6 +815,95 @@ ABC files, has a MIDI player for proof-listening, and includes a documentation browser.") (license license:gpl2+))) +(define-public drumstick + (package + (name "drumstick") + (version "1.0.1") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/drumstick/" + version "/drumstick-" version ".tar.bz2")) + (sha256 + (base32 + "0mxgix85b2qqs859z91cxik5x0s60dykqiflbj62px9akvf91qdv")))) + (build-system cmake-build-system) + (arguments + `(#:tests? #f ; no test target + #:configure-flags '("-DLIB_SUFFIX=") + #:phases + (modify-phases %standard-phases + (add-before 'configure 'fix-docbook + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "cmake_admin/CreateManpages.cmake" + (("http://docbook.sourceforge.net/release/xsl/current/manpages/docbook.xsl") + (string-append (assoc-ref inputs "docbook-xsl") + "/xml/xsl/docbook-xsl-" + ,(package-version docbook-xsl) + "/manpages/docbook.xsl"))) + #t))))) + (inputs + `(("qt" ,qt) + ("alsa-lib" ,alsa-lib) + ("fluidsynth" ,fluidsynth))) + (native-inputs + `(("pkg-config" ,pkg-config) + ("libxslt" ,libxslt) ;for xsltproc + ("docbook-xsl" ,docbook-xsl) + ("doxygen" ,doxygen))) + (home-page "http://drumstick.sourceforge.net/") + (synopsis "C++ MIDI library") + (description + "Drumstick is a set of MIDI libraries using C++/Qt5 idioms and style. It +includes a C++ wrapper around the ALSA library sequencer interface. A +complementary library provides classes for processing SMF (Standard MIDI +files: .MID/.KAR), Cakewalk (.WRK), and Overture (.OVE) file formats. A +multiplatform realtime MIDI I/O library is also provided with various output +backends, including ALSA, OSS, Network and FluidSynth.") + (license license:gpl2+))) + +(define-public vmpk + (package + (name "vmpk") + (version "0.6.1") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/vmpk/vmpk/" + version "/vmpk-" version ".tar.bz2")) + (sha256 + (base32 + "0ranldd033bd31m9d2vkbkn9zp1k46xbaysllai2i95rf1nhirqc")))) + (build-system cmake-build-system) + (arguments + `(#:tests? #f ; no test target + #:phases + (modify-phases %standard-phases + (add-before 'configure 'fix-docbook + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "cmake_admin/CreateManpages.cmake" + (("http://docbook.sourceforge.net/release/xsl/current/manpages/docbook.xsl") + (string-append (assoc-ref inputs "docbook-xsl") + "/xml/xsl/docbook-xsl-" + ,(package-version docbook-xsl) + "/manpages/docbook.xsl"))) + #t))))) + (inputs + `(("drumstick" ,drumstick) + ("qt" ,qt))) + (native-inputs + `(("libxslt" ,libxslt) ;for xsltproc + ("docbook-xsl" ,docbook-xsl) + ("pkg-config" ,pkg-config))) + (home-page "http://vmpk.sourceforge.net") + (synopsis "Virtual MIDI piano keyboard") + (description + "Virtual MIDI Piano Keyboard is a MIDI events generator and receiver. It +doesn't produce any sound by itself, but can be used to drive a MIDI +synthesizer (either hardware or software, internal or external). You can use +the computer's keyboard to play MIDI notes, and also the mouse. You can use +the Virtual MIDI Piano Keyboard to display the played MIDI notes from another +instrument or MIDI file player.") + (license license:gpl3+))) + (define-public zynaddsubfx (package (name "zynaddsubfx") @@ -815,3 +948,86 @@ browser.") three synthesizer engines, multitimbral and polyphonic synths, microtonal capabilities, custom envelopes, effects, etc.") (license license:gpl2))) + +(define-public yoshimi + (package + (name "yoshimi") + (version "1.3.7.1") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/yoshimi/" + (version-major+minor version) + "/yoshimi-" version ".tar.bz2")) + (sha256 + (base32 + "13xc1x8jrr2rn26jx4dini692ww3771d5j5xf7f56ixqr7mmdhvz")))) + (build-system cmake-build-system) + (arguments + `(#:tests? #f ; there are no tests + #:configure-flags + (list (string-append "-DCMAKE_INSTALL_DATAROOTDIR=" + (assoc-ref %outputs "out") "/share")) + #:phases + (modify-phases %standard-phases + (add-before 'configure 'enter-dir + (lambda _ (chdir "src") #t)) + ;; Move SSE compiler optimization flags from generic target to + ;; athlon64 and core2 targets, because otherwise the build would fail + ;; on non-Intel machines. + (add-after 'unpack 'remove-sse-flags-from-generic-target + (lambda _ + (substitute* "src/CMakeLists.txt" + (("-msse -msse2 -mfpmath=sse") "") + (("-march=(athlon64|core2)" flag) + (string-append flag " -msse -msse2 -mfpmath=sse"))) + #t))))) + (inputs + `(("boost" ,boost) + ("fftwf" ,fftwf) + ("alsa-lib" ,alsa-lib) + ("jack" ,jack-1) + ("fontconfig" ,fontconfig) + ("minixml" ,minixml) + ("mesa" ,mesa) + ("fltk" ,fltk) + ("lv2" ,lv2) + ("readline" ,readline) + ("ncurses" ,ncurses) + ("cairo" ,cairo) + ("zlib" ,zlib))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (home-page "http://yoshimi.sourceforge.net/") + (synopsis "Multi-paradigm software synthesizer") + (description + "Yoshimi is a fork of ZynAddSubFX, a feature heavy realtime software +synthesizer. It offers three synthesizer engines, multitimbral and polyphonic +synths, microtonal capabilities, custom envelopes, effects, etc. Yoshimi +improves on support for JACK features, such as JACK MIDI.") + (license license:gpl2))) + +(define-public cursynth + (package + (name "cursynth") + (version "1.5") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/cursynth/cursynth-" + version ".tar.gz")) + (sha256 + (base32 "1dhphsya41rv8z6yqcv9l6fwbslsds4zh1y56zizi39nd996d40v")) + (patches (list (search-patch "cursynth-wave-rand.patch"))))) + (build-system gnu-build-system) + (native-inputs `(("pkg-config" ,pkg-config))) + ;; TODO: See https://github.com/iyoko/cursynth/issues/4 which currently + ;; prevents us from using pulseaudio + (inputs `(("ncurses" ,ncurses) + ("alsa" ,alsa-lib))) + (home-page "http://www.gnu.org/software/cursynth") + (synopsis "Polyphonic and MIDI subtractive music synthesizer using curses") + (description "GNU cursynth is a polyphonic synthesizer that runs +graphically in the terminal. It is built on a full-featured subtractive +synthesis engine. Notes and parameter changes may be entered via MIDI or the +computer's keyboard.") + (license license:gpl3+))) diff --git a/gnu/packages/ntp.scm b/gnu/packages/ntp.scm index 9e6db67e3e..4ed2e3cc11 100644 --- a/gnu/packages/ntp.scm +++ b/gnu/packages/ntp.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 John Darrington <jmd@gnu.org> ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com> +;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,6 +23,7 @@ #:use-module (gnu packages) #:use-module (gnu packages base) #:use-module (gnu packages linux) + #:use-module (gnu packages autotools) #:use-module (gnu packages pkg-config) #:use-module (gnu packages tls) #:use-module (gnu packages libevent) @@ -29,6 +31,7 @@ #:use-module (guix packages) #:use-module (guix utils) #:use-module (guix download) + #:use-module (guix git-download) #:use-module (guix build-system gnu) #:use-module (srfi srfi-1)) @@ -108,3 +111,43 @@ secure, easy to configure, and accurate enough for most purposes, so it's more minimalist than ntpd.") ;; A few of the source files are under bsd-3. (license (list l:isc l:bsd-3)))) + +(define-public tlsdate + (package + (name "tlsdate") + (version "0.0.13") + (home-page "https://github.com/ioerror/tlsdate") + (source (origin + (method git-fetch) + (uri (git-reference + (commit (string-append "tlsdate-" version)) + (url home-page))) + (sha256 + (base32 + "0w3v63qmbhpqlxjsvf4k3zp90k6mdzi8cdpgshan9iphy1f44xgl")) + (file-name (string-append name "-" version "-checkout")))) + (build-system gnu-build-system) + (arguments + '(#:phases (modify-phases %standard-phases + (add-after 'unpack 'autogen + (lambda _ + ;; The ancestor of 'SOURCE_DATE_EPOCH'; it contains the + ;; date that is recorded in binaries. It must be a + ;; "recent date" since it is used to detect bogus dates + ;; received from servers. + (setenv "COMPILE_DATE" (number->string 1450563040)) + (zero? (system* "sh" "autogen.sh"))))))) + (inputs `(("openssl" ,openssl) + ("libevent" ,libevent))) + (native-inputs `(("pkg-config" ,pkg-config) + ("autoconf" ,autoconf) + ("automake" ,automake) + ("libtool" ,libtool))) + (synopsis "Extract remote time from TLS handshakes") + (description + "@command{tlsdate} sets the local clock by securely connecting with TLS +to remote servers and extracting the remote time out of the secure handshake. +Unlike ntpdate, @command{tlsdate} uses TCP, for instance connecting to a +remote HTTPS or TLS enabled service, and provides some protection against +adversaries that try to feed you malicious time information.") + (license l:bsd-3))) diff --git a/gnu/packages/ocaml.scm b/gnu/packages/ocaml.scm index 7f80fc8a32..5531867964 100644 --- a/gnu/packages/ocaml.scm +++ b/gnu/packages/ocaml.scm @@ -285,7 +285,7 @@ concrete syntax of the language (Quotations, Syntax Extensions).") (version "2.23") (source (origin (method url-fetch) - (uri (string-append "http://hevea.inria.fr/distri/" + (uri (string-append "http://hevea.inria.fr/old/" name "-" version ".tar.gz")) (sha256 (base32 diff --git a/gnu/packages/openstack.scm b/gnu/packages/openstack.scm index 2578292fd0..48a5c6b7e6 100644 --- a/gnu/packages/openstack.scm +++ b/gnu/packages/openstack.scm @@ -136,14 +136,14 @@ guidelines}.") (define-public python-mox3 (package (name "python-mox3") - (version "0.12.0") + (version "0.13.0") (source (origin (method url-fetch) (uri (pypi-uri "mox3" version)) (sha256 (base32 - "1pwz98q098cb8xxf8yryq21nvklc7hla880bsrq4y3j6bprw3iaj")))) + "0hj57374r239cj1zbzpxw7mj0yfblz55jdfrc2p1h8j7xng0319j")))) (build-system python-build-system) (inputs `(("python-fixtures" ,python-fixtures) @@ -202,14 +202,14 @@ tested on Python version 3.2, 2.7 and 2.6.") (define-public python-os-testr (package (name "python-os-testr") - (version "0.4.2") + (version "0.5.0") (source (origin (method url-fetch) (uri (pypi-uri "os-testr" version)) (sha256 (base32 - "0474z0mxb7y3vfk4s097wf1mzji5d135vh27cvlh9q17rq3x9r3w")))) + "0bv03wnmvxhyi8y08hjh9clxrwqc2251529v4kh5khvca0fsbqdp")))) (build-system python-build-system) (arguments ;; os-testr uses itself to run the tests. It seems like pbr writes the @@ -307,14 +307,14 @@ portions of your testing code.") (define-public python-stevedore (package (name "python-stevedore") - (version "1.9.0") + (version "1.10.0") (source (origin (method url-fetch) (uri (pypi-uri "stevedore" version)) (sha256 (base32 - "01pcrdqsb6ca7hmqwm11b3baj6ml8yz9pxawrgvxb3j9824906fc")))) + "17vpffcnk56sj86d2n3vz5bprcc9bswilgd0awnm7jp073pqkmpm")))) (build-system python-build-system) (propagated-inputs `(("python-six" ,python-six))) @@ -345,14 +345,14 @@ extensions.") (define-public python-tempest-lib (package (name "python-tempest-lib") - (version "0.11.0") + (version "0.12.0") (source (origin (method url-fetch) (uri (pypi-uri "tempest-lib" version)) (sha256 (base32 - "1q4wpqcg0yv99mr5gc43wsfirlqdjz90npyghy3mn5f6lby2yikg")))) + "0f15wxk394cb2kw34krpxq8mvy1rxw0lnl5wfiv14cq1s1fm9cjd")))) (build-system python-build-system) (arguments `(#:phases @@ -532,14 +532,14 @@ handlers and support for context specific logging (like resource id’s etc).") (define-public python-oslo.serialization (package (name "python-oslo.serialization") - (version "2.0.0") + (version "2.2.0") (source (origin (method url-fetch) (uri (pypi-uri "oslo.serialization" version)) (sha256 (base32 - "1hnkc69sa4r1qhx6hdwlrk2ng7wypgwr063iq5r815a0bv0qr1ad")))) + "00s03krhf833gs76aw5ns32w9m1i4hx6x6d9g82m0j5wyqk0sci4")))) (build-system python-build-system) (propagated-inputs `(("python-iso8601" ,python-iso8601) @@ -569,14 +569,14 @@ in transmittable and storable formats, such as JSON and MessagePack.") (define-public python-oslosphinx (package (name "python-oslosphinx") - (version "3.1.0") + (version "4.2.0") (source (origin (method url-fetch) (uri (pypi-uri "oslosphinx" version)) (sha256 (base32 - "0zcshdc9s1f7hnvg0fm2ps5rak3dpnm8kqg4i21lknhmsvb7p5cb")))) + "178svff46pmynpsnw06gpxk0w13p1gwkqbsvyxphblxv9wl09ksz")))) (build-system python-build-system) (propagated-inputs `(("python-requests" ,python-requests))) diff --git a/gnu/packages/owncloud.scm b/gnu/packages/owncloud.scm index 58c2a51ba8..084a0a2863 100644 --- a/gnu/packages/owncloud.scm +++ b/gnu/packages/owncloud.scm @@ -34,14 +34,14 @@ (define-public owncloud-client (package (name "owncloud-client") - (version "2.0.2") + (version "2.1.0") (source (origin (method url-fetch) (uri (string-append "https://download.owncloud.com/desktop/stable/" "owncloudclient-" version ".tar.xz")) (sha256 - (base32 "0a42nqx0gn10n7ikhxwif0lqddmb6gbvr45bqbbl30an9gixq598")))) + (base32 "0gyhll4yfxcpyc5m73zar5f33qgnmpwiggw2adxdiqy55hc3ymbk")))) (build-system cmake-build-system) (arguments `(#:phases @@ -50,9 +50,9 @@ (lambda _ (substitute* '("src/libsync/CMakeLists.txt" "csync/src/CMakeLists.txt") - ;; We store the libs in out/lib and not /usr/lib/appname, so we + ;; We store the libs in out/lib and not /usr/lib/appname, so we ;; need the executable to point to the libraries in /lib and not - ;; in /lib/appname. + ;; in /lib/appname. (("\\/\\$\\{APPLICATION_EXECUTABLE\\}") "")) (substitute* '("src/cmd/CMakeLists.txt" "src/crashreporter/CMakeLists.txt" diff --git a/gnu/packages/parallel.scm b/gnu/packages/parallel.scm index 25e77d8023..8f63bda25c 100644 --- a/gnu/packages/parallel.scm +++ b/gnu/packages/parallel.scm @@ -29,7 +29,7 @@ (define-public parallel (package (name "parallel") - (version "20151122") + (version "20151222") (source (origin (method url-fetch) @@ -37,7 +37,7 @@ version ".tar.bz2")) (sha256 (base32 - "0phn9dlkqlq3cq468ypxbbn78bsjcin743pyvf8ip4qg6jz662jm")))) + "03czpnsj77xxzqxzzr1b39ym9acn94hknzbilbh28v5q1wk7r4mf")))) (build-system gnu-build-system) (inputs `(("perl" ,perl))) (home-page "http://www.gnu.org/software/parallel/") diff --git a/gnu/packages/password-utils.scm b/gnu/packages/password-utils.scm index 1ca327b5c8..7c390e908d 100644 --- a/gnu/packages/password-utils.scm +++ b/gnu/packages/password-utils.scm @@ -135,3 +135,52 @@ session. Two companion utilities enable users to convert CSV files to YAPET and vice versa.") (home-page "http://www.guengel.ch/myapps/yapet/") (license license:gpl3+))) + +(define-public cracklib + (package + (name "cracklib") + (version "2.9.6") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/cracklib/cracklib/" + "releases/download/" name "-" version "/" + name "-" version ".tar.gz")) + (sha256 + (base32 + "0hrkb0prf7n92w6rxgq0ilzkk6rkhpys2cfqkrbzswp27na7dkqp")))) + (build-system gnu-build-system) + (synopsis "Password checking library") + (home-page "https://github.com/cracklib/cracklib") + (description + "CrackLib is a library containing a C function which may be used in a +passwd like program. The idea is simple: try to prevent users from choosing +passwords that could be guessed by crack by filtering them out, at source.") + (license license:lgpl2.1))) + +(define-public libpwquality + (package + (name "libpwquality") + (version "1.3.0") + (source (origin + (method url-fetch) + (uri (list + (string-append "https://fedorahosted.org/releases/l/i/" + name "/" name "-" version ".tar.bz2") + (string-append "https://launchpad.net/libpwquality/trunk/" + version "/+download/" + name "-" version ".tar.bz2"))) + (sha256 + (base32 + "0aidriag6h0syfm33nzdfdsqgrnsgihwjv3a5lgkqch3w68fmlkl")))) + (build-system gnu-build-system) + (arguments + ;; XXX: have RUNPATH issue. + '(#:configure-flags '("--disable-python-bindings"))) + (inputs + `(("cracklib" ,cracklib))) + (synopsis "Password quality checker") + (home-page "https://fedorahosted.org/libpwquality/") + (description + "Libpwquality is a library for password quality checking and generation of +random passwords that pass the checks.") + (license license:gpl2+))) diff --git a/gnu/packages/patches/bluez-tests.patch b/gnu/packages/patches/bluez-tests.patch deleted file mode 100644 index 608ded9be2..0000000000 --- a/gnu/packages/patches/bluez-tests.patch +++ /dev/null @@ -1,25 +0,0 @@ -From 484ad8c9263bb524051a999ce19a994960e69572 Mon Sep 17 00:00:00 2001 -From: =?UTF-8?q?=E5=AE=8B=E6=96=87=E6=AD=A6?= <iyzsong@gmail.com> -Date: Fri, 23 Oct 2015 20:48:57 +0800 -Subject: [PATCH] unit/test-gobex-header: Fix duplicate test names - ---- - unit/test-gobex-header.c | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/unit/test-gobex-header.c b/unit/test-gobex-header.c -index 6f49312..8705892 100644 ---- a/unit/test-gobex-header.c -+++ b/unit/test-gobex-header.c -@@ -554,7 +554,7 @@ int main(int argc, char *argv[]) - test_header_encode_name_umlaut); - g_test_add_func("/gobex/test_header_encode_body", - test_header_encode_body); -- g_test_add_func("/gobex/test_header_encode_connid", -+ g_test_add_func("/gobex/test_header_encode_actionid", - test_header_encode_actionid); - g_test_add_func("/gobex/test_header_encode_apparam", - test_header_encode_apparam); --- -2.5.0 - diff --git a/gnu/packages/patches/fuse-CVE-2015-3202.patch b/gnu/packages/patches/fuse-CVE-2015-3202.patch deleted file mode 100644 index 7c64de7683..0000000000 --- a/gnu/packages/patches/fuse-CVE-2015-3202.patch +++ /dev/null @@ -1,65 +0,0 @@ -The following patch was copied from Debian. - -Description: Fix CVE-2015-3202 - Missing scrubbing of the environment before executing a mount or umount - of a filesystem. -Origin: upstream -Author: Miklos Szeredi <miklos@szeredi.hu> -Last-Update: 2015-05-19 - ---- - lib/mount_util.c | 23 +++++++++++++++++------ - 1 file changed, 17 insertions(+), 6 deletions(-) - ---- a/lib/mount_util.c -+++ b/lib/mount_util.c -@@ -95,10 +95,12 @@ static int add_mount(const char *prognam - goto out_restore; - } - if (res == 0) { -+ char *env = NULL; -+ - sigprocmask(SIG_SETMASK, &oldmask, NULL); - setuid(geteuid()); -- execl("/bin/mount", "/bin/mount", "--no-canonicalize", "-i", -- "-f", "-t", type, "-o", opts, fsname, mnt, NULL); -+ execle("/bin/mount", "/bin/mount", "--no-canonicalize", "-i", -+ "-f", "-t", type, "-o", opts, fsname, mnt, NULL, &env); - fprintf(stderr, "%s: failed to execute /bin/mount: %s\n", - progname, strerror(errno)); - exit(1); -@@ -146,10 +148,17 @@ static int exec_umount(const char *progn - goto out_restore; - } - if (res == 0) { -+ char *env = NULL; -+ - sigprocmask(SIG_SETMASK, &oldmask, NULL); - setuid(geteuid()); -- execl("/bin/umount", "/bin/umount", "-i", rel_mnt, -- lazy ? "-l" : NULL, NULL); -+ if (lazy) { -+ execle("/bin/umount", "/bin/umount", "-i", rel_mnt, -+ "-l", NULL, &env); -+ } else { -+ execle("/bin/umount", "/bin/umount", "-i", rel_mnt, -+ NULL, &env); -+ } - fprintf(stderr, "%s: failed to execute /bin/umount: %s\n", - progname, strerror(errno)); - exit(1); -@@ -205,10 +214,12 @@ static int remove_mount(const char *prog - goto out_restore; - } - if (res == 0) { -+ char *env = NULL; -+ - sigprocmask(SIG_SETMASK, &oldmask, NULL); - setuid(geteuid()); -- execl("/bin/umount", "/bin/umount", "--no-canonicalize", "-i", -- "--fake", mnt, NULL); -+ execle("/bin/umount", "/bin/umount", "--no-canonicalize", "-i", -+ "--fake", mnt, NULL, &env); - fprintf(stderr, "%s: failed to execute /bin/umount: %s\n", - progname, strerror(errno)); - exit(1); diff --git a/gnu/packages/patches/grub-CVE-2015-8370.patch b/gnu/packages/patches/grub-CVE-2015-8370.patch new file mode 100644 index 0000000000..5701b54759 --- /dev/null +++ b/gnu/packages/patches/grub-CVE-2015-8370.patch @@ -0,0 +1,45 @@ +From 88c9657960a6c5d3673a25c266781e876c181add Mon Sep 17 00:00:00 2001 +From: Hector Marco-Gisbert <hecmargi@upv.es> +Date: Fri, 13 Nov 2015 16:21:09 +0100 +Subject: [PATCH] Fix security issue when reading username and password + + This patch fixes two integer underflows at: + * grub-core/lib/crypto.c + * grub-core/normal/auth.c + +Signed-off-by: Hector Marco-Gisbert <hecmargi@upv.es> +Signed-off-by: Ismael Ripoll-Ripoll <iripoll@disca.upv.es> +--- + grub-core/lib/crypto.c | 2 +- + grub-core/normal/auth.c | 2 +- + 2 files changed, 2 insertions(+), 2 deletions(-) + +diff --git a/grub-core/lib/crypto.c b/grub-core/lib/crypto.c +index 010e550..524a3d8 100644 +--- a/grub-core/lib/crypto.c ++++ b/grub-core/lib/crypto.c +@@ -468,7 +468,7 @@ grub_password_get (char buf[], unsigned buf_size) + break; + } + +- if (key == '\b') ++ if (key == '\b' && cur_len) + { + cur_len--; + continue; +diff --git a/grub-core/normal/auth.c b/grub-core/normal/auth.c +index c6bd96e..5782ec5 100644 +--- a/grub-core/normal/auth.c ++++ b/grub-core/normal/auth.c +@@ -172,7 +172,7 @@ grub_username_get (char buf[], unsigned buf_size) + break; + } + +- if (key == '\b') ++ if (key == '\b' && cur_len) + { + cur_len--; + grub_printf ("\b"); +-- +1.9.1 + diff --git a/gnu/packages/patches/icecat-freetype-2.6.patch b/gnu/packages/patches/icecat-freetype-2.6.patch deleted file mode 100644 index ef69f2f715..0000000000 --- a/gnu/packages/patches/icecat-freetype-2.6.patch +++ /dev/null @@ -1,14 +0,0 @@ -Adapt to freetype 2.6. This patch copied from upstream, see: -https://bugzilla.mozilla.org/show_bug.cgi?id=1143411 -https://hg.mozilla.org/mozilla-central/rev/afd840d66e6a - ---- a/config/system-headers -+++ b/config/system-headers -@@ -415,6 +415,7 @@ freetype/ftbitmap.h - freetype/ftxf86.h - freetype.h - ftcache.h -+ftfntfmt.h - ftglyph.h - ftsynth.h - ftoutln.h diff --git a/gnu/packages/patches/python-ipython-inputhook-ctype.patch b/gnu/packages/patches/python-ipython-inputhook-ctype.patch new file mode 100644 index 0000000000..c77e310542 --- /dev/null +++ b/gnu/packages/patches/python-ipython-inputhook-ctype.patch @@ -0,0 +1,41 @@ +From 04c5d358c7ab74d3ddab4f7662e539393d8604c6 Mon Sep 17 00:00:00 2001 +From: Lucretiel <Lucretiel@users.noreply.github.com> +Date: Wed, 13 May 2015 13:12:43 -0400 +Subject: [PATCH] register now checks for missing ctypes + +If ctypes is None, then no input hooks may be registered; `InputHookManager.register` skips registration of input hook classes. Also updated `__init__` to no longer skip creating the instance attributes, to prevent AttributeError exceptions at load time. +--- + IPython/lib/inputhook.py | 13 +++++++------ + 1 file changed, 7 insertions(+), 6 deletions(-) + +diff --git a/IPython/lib/inputhook.py b/IPython/lib/inputhook.py +index 4ae2cb3..6578365 100644 +--- a/IPython/lib/inputhook.py ++++ b/IPython/lib/inputhook.py +@@ -107,8 +107,8 @@ class InputHookManager(object): + def __init__(self): + if ctypes is None: + warn("IPython GUI event loop requires ctypes, %gui will not be available") +- return +- self.PYFUNC = ctypes.PYFUNCTYPE(ctypes.c_int) ++ else: ++ self.PYFUNC = ctypes.PYFUNCTYPE(ctypes.c_int) + self.guihooks = {} + self.aliases = {} + self.apps = {} +@@ -197,10 +197,11 @@ def enable(self, app=None): + ... + """ + def decorator(cls): +- inst = cls(self) +- self.guihooks[toolkitname] = inst +- for a in aliases: +- self.aliases[a] = toolkitname ++ if ctypes is not None: ++ inst = cls(self) ++ self.guihooks[toolkitname] = inst ++ for a in aliases: ++ self.aliases[a] = toolkitname + return cls + return decorator + diff --git a/gnu/packages/patchutils.scm b/gnu/packages/patchutils.scm index 319ccb21c2..31a735fd5d 100644 --- a/gnu/packages/patchutils.scm +++ b/gnu/packages/patchutils.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> +;;; Copyright © 2015 Leo Famulari <leo@famulari.name> ;;; ;;; This file is part of GNU Guix. ;;; @@ -149,14 +150,15 @@ refreshed, and more.") (define-public colordiff (package (name "colordiff") - (version "1.0.13") + (version "1.0.16") (source - (origin - (method url-fetch) - (uri (string-append "http://www.colordiff.org/colordiff-" - version ".tar.gz")) + (origin + (method url-fetch) + (uri (list (string-append "http://www.colordiff.org/archive/colordiff-" + version ".tar.gz"))) (sha256 - (base32 "0akcz1p3klsjnhwcqdfq4grs6paljc5c0jzr3mqla5f862hhaa6f")))) + (base32 + "12qkkw13261dra8pg7mzx4r8p9pb0ajb090bib9j1s6hgphwzwga")))) (build-system gnu-build-system) (arguments `(#:tests? #f diff --git a/gnu/packages/perl.scm b/gnu/packages/perl.scm index 6afe0b73ec..df0a3152a9 100644 --- a/gnu/packages/perl.scm +++ b/gnu/packages/perl.scm @@ -2352,6 +2352,24 @@ files with a simple call. It also has a subroutine for reading the list of file names in a directory.") (license (package-license perl)))) +(define-public perl-file-slurp-tiny + (package + (name "perl-file-slurp-tiny") + (version "0.004") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/L/LE/LEONT/" + "File-Slurp-Tiny-" version ".tar.gz")) + (sha256 + (base32 + "07kzfmibl43dq4c803f022g2rcfv4nkjgipxclz943mzxaz9aaa5")))) + (build-system perl-build-system) + (home-page "http://search.cpan.org/dist/File-Slurp-Tiny") + (synopsis "Simple file reader and writer") + (description + "This module provides functions for fast reading and writing of files.") + (license (package-license perl)))) + (define-public perl-file-temp (package (name "perl-file-temp") @@ -2778,6 +2796,54 @@ either uses the first module it finds or throws an error.") versa.") (license (package-license perl)))) +(define-public perl-log-report-optional + (package + (name "perl-log-report-optional") + (version "1.01") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/" + "Log-Report-Optional-" version ".tar.gz")) + (sha256 + (base32 + "1f4yi4dgzqjc79vrh4f2phdj57xxgk8hd2psx77214i4m5av408f")))) + (build-system perl-build-system) + (propagated-inputs + `(("perl-string-print" ,perl-string-print))) + (home-page "http://search.cpan.org/dist/Log-Report-Optional") + (synopsis "Log::Report in the lightest form") + (description + "This module allows libraries to have a dependency to a small module +instead of the full Log-Report distribution. The full power of +@code{Log::Report} is only released when the main program uses that module. +In that case, the module using the 'Optional' will also use the full +@code{Log::Report}, otherwise the dressed-down @code{Log::Report::Minimal} +version.") + (license (package-license perl)))) + +(define-public perl-log-report + (package + (name "perl-log-report") + (version "1.10") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/" + "Log-Report-" version ".tar.gz")) + (sha256 + (base32 + "1jjx1ari3a7ixsyan91b6n7lmjq6dy5223k3x2ah18qbxvw4caap")))) + (build-system perl-build-system) + (propagated-inputs + `(("perl-devel-globaldestruction" ,perl-devel-globaldestruction) + ("perl-log-report-optional" ,perl-log-report-optional) + ("perl-string-print" ,perl-string-print))) + (home-page "http://search.cpan.org/dist/Log-Report") + (synopsis "Get messages to users and logs") + (description + "@code{Log::Report} combines three tasks which are closely related in +one: logging, exceptions, and translations.") + (license (package-license perl)))) + (define-public perl-list-allutils (package (name "perl-list-allutils") @@ -2847,6 +2913,25 @@ follows LRU semantics, that is, the last n results, where n is specified as the argument to the CACHESIZE parameter, will be cached.") (license (package-license perl)))) +(define-public perl-mime-charset + (package + (name "perl-mime-charset") + (version "1.012") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/N/NE/NEZUMI/" + "MIME-Charset-" version ".tar.gz")) + (sha256 + (base32 + "1kfc5p4g1x9c0ffhg125wvhravcviny3alwrgnhnrm2a33ad3rff")))) + (build-system perl-build-system) + (home-page "http://search.cpan.org/dist/MIME-Charset") + (synopsis "Charset information for MIME messages") + (description + "@code{MIME::Charset} provides information about character sets used for +MIME messages on Internet.") + (license (package-license perl)))) + (define-public perl-mime-types (package (name "perl-mime-types") @@ -4354,6 +4439,28 @@ CamelCase and back again.") known prefixes.") (license (package-license perl)))) +(define-public perl-string-print + (package + (name "perl-string-print") + (version "0.15") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/" + "String-Print-" version ".tar.gz")) + (sha256 + (base32 + "1n9lc5dr66sg89hym47764fyfms7vrxrhwvdps2x8x8gxly7rsdl")))) + (build-system perl-build-system) + (propagated-inputs + `(("perl-unicode-linebreak" ,perl-unicode-linebreak))) + (home-page "http://search.cpan.org/dist/String-Print") + (synopsis "String printing alternatives to printf") + (description + "This module inserts values into (translated) strings. It provides +@code{printf} and @code{sprintf} alternatives via both an object-oriented and +a functional interface.") + (license (package-license perl)))) + (define-public perl-sub-exporter (package (name "perl-sub-exporter") @@ -5827,6 +5934,28 @@ else.") common serialisation formats such as JSON or CBOR.") (license (package-license perl)))) +(define-public perl-unicode-linebreak + (package + (name "perl-unicode-linebreak") + (version "2015.12") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/N/NE/NEZUMI/" + "Unicode-LineBreak-" version ".tar.gz")) + (sha256 + (base32 + "1d0nnc97irfpab4d3b2lvq22hac118k7zbfrj0lnxkbfwx7122cm")))) + (build-system perl-build-system) + (propagated-inputs + `(("perl-mime-charset" ,perl-mime-charset))) + (home-page "http://search.cpan.org/dist/Unicode-LineBreak") + (synopsis "Unicode line breaking algorithm") + (description + "@code{Unicode::LineBreak} implements the line breaking algorithm +described in Unicode Standard Annex #14. The @code{East_Asian_Width} property +defined by Annex #11 is used to determine breaking positions.") + (license (package-license perl)))) + (define-public perl-universal-can (package (name "perl-universal-can") diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 72a3507d1f..a01c99e1eb 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -13,9 +13,10 @@ ;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 Leo Famulari <leo@famulari.name> ;;; Copyright © 2015 Ben Woodcroft <donttrustben@gmail.com> -;;; Copyright © 2015 Erik Edrosa <erik.edrosa@gmail.com> +;;; Copyright © 2015, 2016 Erik Edrosa <erik.edrosa@gmail.com> ;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2015 Kyle Meyer <kyle@kyleam.com> +;;; Copyright © 2015 Chris Marusich <cmmarusich@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -342,16 +343,14 @@ instead of @command{python3}."))) (define-public python-psutil (package (name "python-psutil") - (version "3.0.1") + (version "3.3.0") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/p/psutil/psutil-" - version ".tar.gz")) + (uri (pypi-uri "psutil" version)) (sha256 (base32 - "00c8h1mzqysih99z8pnbmdv117d2naldf11yjy50dhykxsf3n89z")))) + "11bd1555vf2ibjnmqf64im5cp55vcqfq45ccinm9ll3bs68na6s2")))) (build-system python-build-system) (native-inputs `(("python-setuptools" ,python-setuptools))) @@ -373,17 +372,14 @@ pidof, tty, taskset, pmap.") (define-public python-passlib (package (name "python-passlib") - (version "1.6.2") + (version "1.6.5") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/p/passlib/passlib-" - version - ".tar.gz")) + (uri (pypi-uri "passlib" version)) (sha256 (base32 - "0b9rd161b3mmiwd7nx1v599yh9sp07mlfwac65sjy9qn1l0gd1z9")))) + "1z27wdxs5rj5xhhqfzvzn3yg682irkxw6dcs5jj7mcf97psk8gd8")))) (build-system python-build-system) (native-inputs `(("python-nose" ,python-nose) @@ -839,34 +835,23 @@ etc.). The package is structured to make adding new modules easy.") (define-public python-keyring (package (name "python-keyring") - (version "3.8") + (version "5.7.1") (source (origin (method url-fetch) - (uri (string-append "https://pypi.python.org/packages/source/k/" - "keyring/keyring-" version ".zip")) + (uri (pypi-uri "keyring" version)) (sha256 (base32 - "1vxazfbcwggyfyramh55shkxs08skhpqrkm6lrrjnygnm8c1l2zg")))) + "1h7a1r9ick7wdd0xb5p63413nvjadna2xawrsvmklsl5ddhm5wrx")))) (build-system python-build-system) (native-inputs - `(("unzip" ,unzip) - ("python-setuptools" ,python-setuptools) + `(("python-setuptools" ,python-setuptools) + ("python-setuptools-scm" ,python-setuptools-scm) ("python-mock" ,python-mock))) (inputs `(("python-pycrypto" ,python-pycrypto))) (arguments - `(#:tests? #f ;TODO: tests require pytest - #:phases - (alist-replace - 'unpack - (lambda _ - (let ((unzip (string-append (assoc-ref %build-inputs "unzip") - "/bin/unzip")) - (source (assoc-ref %build-inputs "source"))) - (and (zero? (system* unzip source)) - (chdir (string-append "keyring-" ,version))))) - %standard-phases))) + `(#:tests? #f)) ;TODO: tests require pytest (home-page "http://bitbucket.org/kang/python-keyring-lib") (synopsis "Store and access your passwords safely") (description @@ -912,7 +897,7 @@ Python file, so it can be easily copied into your project.") (define-public python-dateutil-2 (package (name "python-dateutil") - (version "2.2") + (version "2.4.2") (source (origin (method url-fetch) @@ -920,7 +905,7 @@ Python file, so it can be easily copied into your project.") name "/" name "-" version ".tar.gz")) (sha256 (base32 - "0s74ad6r789810s10dxgvaf48ni6adac2icrdad34zxygqq6bj7f")))) + "0ggbm2z72p0nwjqgvpw8s5bqzwayqiqv2iws0x2a605m3mf4959y")))) (build-system python-build-system) (inputs `(("python-setuptools" ,python-setuptools) @@ -1507,16 +1492,14 @@ matching them against a list of media-ranges.") (define-public python-nose (package (name "python-nose") - (version "1.3.4") + (version "1.3.7") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/n/nose/nose-" - version ".tar.gz")) + (uri (pypi-uri "nose" version)) (sha256 (base32 - "00qymfgwg4iam4xi0w9bnv7lcb3fypq1hzfafzgs1rfmwaj67g3n")))) + "164a43k7k2wsqqk1s6vavcdamvss4mz0vd6pwzv2h9n8rgwzxgzi")))) (build-system python-build-system) (inputs `(("python-setuptools" ,python-setuptools))) @@ -1576,16 +1559,14 @@ standard library.") (define-public python-py (package (name "python-py") - (version "1.4.23") + (version "1.4.31") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/p/py/py-" - version ".tar.gz")) + (uri (pypi-uri "py" version)) (sha256 (base32 - "1jkhffpai419v5rickm2vz86p9bkg3b3kcm2k4bi5wfajhw2m3xs")))) + "0561gz2w3i825gyl42mcq14y3dcgkapfiv5zv9a2bz15qxiijl56")))) (build-system python-build-system) (inputs `(("python-setuptools" ,python-setuptools))) @@ -1912,16 +1893,14 @@ and sensible default behaviors into your setuptools run.") (define-public python-fixtures (package (name "python-fixtures") - (version "1.3.1") + (version "1.4.0") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/f/fixtures/fixtures-" - version ".tar.gz")) + (uri (pypi-uri "fixtures" version)) (sha256 (base32 - "1khpywdh91ijryhxjxiyyi5rmbimhl8hwbbf8lazhgzq6yxz6g5n")))) + "0djxvdwm8s60dbfn7bhf40x6g818p3b3mlwijm1c3bqg7msn271y")))) (build-system python-build-system) (propagated-inputs `(("python-six" ,python-six) @@ -1977,16 +1956,14 @@ have failed since the last commit or what tests are currently failing.") (define-public python-coverage (package (name "python-coverage") - (version "3.7.1") + (version "4.0.3") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/c/coverage/coverage-" - version ".tar.gz")) + (uri (pypi-uri "coverage" version)) (sha256 (base32 - "0knlbq79g2ww6xzsyknj9rirrgrgc983dpa2d9nkdf31mb2a3bni")))) + "0qjlja8ny4gcfp8abqfwdrvr8qw9kr69lkja0b4cqqbsdmdjgcc5")))) (build-system python-build-system) (inputs `(("python-setuptools" ,python-setuptools))) @@ -2062,16 +2039,13 @@ tests written in a natural language style, backed up by Python code.") (define-public python-exif-read (package (name "python-exif-read") - (version "1.4.2") + (version "2.1.2") (source (origin (method url-fetch) - (uri - (string-append - "https://pypi.python.org/packages/source/E/ExifRead/ExifRead-" - version ".tar.gz")) + (uri (pypi-uri "ExifRead" version)) (sha256 (base32 - "17c627gcdmyc05hz4zk8qs4pjgw6rc68qzjzgz8gh1cmpsd7acf1")))) + "1b90jf6m9vxh9nanhpyvqdq7hmfx5iggw1l8kq10jrs6xgr49qkr")))) (build-system python-build-system) (inputs `(("python-setuptools" ,python-setuptools))) @@ -2089,16 +2063,13 @@ files.") (define-public python-pyld (package (name "python-pyld") - (version "0.6.0") + (version "0.6.8") (source (origin (method url-fetch) - (uri - (string-append - "https://pypi.python.org/packages/source/P/PyLD/PyLD-" - version ".tar.gz")) + (uri (pypi-uri "PyLD" version)) (sha256 (base32 - "1l9ymj85fsvayqplinzpk0kyiq6m74ps9xd3a9fhlxfn1rldf8x8")))) + "0k881ffazpf8q1z8862g4bb3pzwpnz9whrci2mf311mvn1qbyqad")))) (build-system python-build-system) (inputs `(("python-setuptools" ,python-setuptools))) @@ -2139,15 +2110,13 @@ is used by the Requests library to verify HTTPS requests.") (define-public python-click (package (name "python-click") - (version "4.0") + (version "6.2") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/c/click/click-" - version ".tar.gz")) + (uri (pypi-uri "click" version)) (sha256 - (base32 "0294x9g28w6zgswl0rsygkwi0wf6n480gf7fiiw5f9az3xhh77pl")))) + (base32 "10kavbisnk9m93jl2wi34pw7ryr2qbxshh2cysxwxd7bymqgz87v")))) (build-system python-build-system) (native-inputs `(("python-setuptools" ,python-setuptools))) @@ -2246,16 +2215,13 @@ than Python’s urllib2 library.") (define-public python-unidecode (package (name "python-unidecode") - (version "0.04.16") + (version "0.04.18") (source (origin (method url-fetch) - (uri - (string-append - "https://pypi.python.org/packages/source/U/Unidecode/Unidecode-" - version ".tar.gz")) + (uri (pypi-uri "Unidecode" version)) (sha256 (base32 - "0yv56vc49rvippyxgxvcyz7jklc07ky38rcspax7p00sgmriiljc")))) + "12hhblqy1ajvidm38im4171x4arg83pfmziyn53nizp29p3m14gi")))) (build-system python-build-system) (inputs `(("python-setuptools" ,python-setuptools))) @@ -2395,21 +2361,24 @@ object.") (define-public python-virtualenv (package (name "python-virtualenv") - (version "1.11.6") + (version "13.1.2") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/v/virtualenv/virtualenv-" - version ".tar.gz")) + (uri (pypi-uri "virtualenv" version)) (sha256 (base32 - "1xq4prmg25n9cz5zcvbqx68lmc3kl39by582vd8pzs9f3qalqyiy")))) + "1p732accxwqfjbdna39k8w8lp9gyw91vr4kzkhm8mgfxikqqxg5a")))) (build-system python-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'check + (lambda _ (zero? (system* "py.test"))))))) (inputs `(("python-setuptools" ,python-setuptools) ("python-mock" ,python-mock) - ("python-nose" ,python-nose))) + ("python-pytest" ,python-pytest))) (home-page "https://virtualenv.pypa.io/") (synopsis "Virtual Python environment builder") (description @@ -2448,16 +2417,14 @@ for Python.") (define-public python-jinja2 (package (name "python-jinja2") - (version "2.7.3") + (version "2.8") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/J/Jinja2/Jinja2-" - version ".tar.gz")) + (uri (pypi-uri "Jinja2" version)) (sha256 (base32 - "1nwg9yfqgy421lncnm63k1zf9xkd1klc0jm0fr4p3dad01fsq91f")))) + "1x0v41lp5m1pjix3l46zx02b7lqp2hflgpnxwkywxynvi3zz47xw")))) (build-system python-build-system) (inputs `(("python-setuptools" ,python-setuptools) @@ -2556,16 +2523,14 @@ reStructuredText.") (define-public python-pygments (package (name "python-pygments") - (version "1.6") + (version "2.0.2") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/P/Pygments/Pygments-" - version ".tar.gz")) + (uri (pypi-uri "Pygments" version)) (sha256 (base32 - "1h11r6ss8waih51vcksfvzghfxiav2f8svc0812fa5kmyz5d97kr")))) + "0lagrwifsgn0s8bzqahpr87p7gd38xja8f06akscinp6hj89283k")))) (build-system python-build-system) (inputs `(("python-setuptools" ,python-setuptools))) @@ -2681,16 +2646,14 @@ which can produce feeds in RSS 2.0, RSS 0.91, and Atom formats.") (define-public python-blinker (package (name "python-blinker") - (version "1.3") + (version "1.4") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/b/blinker/blinker-" - version ".tar.gz")) + (uri (pypi-uri "blinker" version)) (sha256 (base32 - "0bvfxkmjx6bpa302pv7v2vw5rwr3dlzjzfdp3bj628i6144024b8")))) + "1dpq0vb01p36jjwbhhd08ylvrnyvcc82yxx3mwjx6awrycjyw6j7")))) (build-system python-build-system) (native-inputs `(("python-setuptools" ,python-setuptools))) @@ -2710,16 +2673,14 @@ interested parties to subscribe to events, or \"signals\".") (define-public pelican (package (name "pelican") - (version "3.6.0") + (version "3.6.3") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/p/pelican/pelican-" - version ".tar.gz")) + (uri (pypi-uri "pelican" version)) (sha256 (base32 - "0lbkk902mqxpp452pp76n6qcjv6f99lq2zl204xmqyzcan9zr3ps")))) + "1hn94rb4q3zmcq16in055xikal4dba5hfx3zznq7warllcgc9f8k")))) (build-system python-build-system) (native-inputs `(("python-setuptools" ,python-setuptools))) @@ -2913,15 +2874,14 @@ is designed to have a low barrier to entry.") (define-public python-cython (package (name "python-cython") - (version "0.21.1") + (version "0.23.4") (source (origin (method url-fetch) - (uri (string-append "http://cython.org/release/Cython-" - version ".tar.gz")) + (uri (pypi-uri "Cython" version)) (sha256 (base32 - "0ddz2l2dvcy5hdkxx4xlfiwpccvwia7ixgcy4h0pdv46a4i4vxj3")))) + "13hdffhd37mx3gjby018xl179jaj957fy7kzi01crmimxvn2zi7y")))) (build-system python-build-system) ;; we need the full python package and not just the python-wrapper ;; because we need libpython3.3m.so @@ -3418,15 +3378,14 @@ operators such as union, intersection, and difference.") (define-public python-rpy2 (package (name "python-rpy2") - (version "2.6.0") + (version "2.7.6") (source (origin (method url-fetch) - (uri (string-append "https://pypi.python.org/packages/source/r/rpy2" - "/rpy2-" version ".tar.gz")) + (uri (pypi-uri "rpy2" version)) (sha256 (base32 - "1dp4l8hpv0jpf4crz4wis6in3lvwk86cr5zvpw410y4a07rrbqjk")))) + "0nhan2qvrw7b7gg5zddwa22kybdv3x1g26vkd7q8lvnkgzrs4dga")))) (build-system python-build-system) (inputs `(("python-six" ,python-six) @@ -3722,15 +3681,14 @@ a general image processing tool.") (define-public python-pycparser (package (name "python-pycparser") - (version "2.10") + (version "2.14") (source (origin (method url-fetch) - (uri (string-append "https://pypi.python.org/packages/source/p/" - "pycparser/pycparser-" version ".tar.gz")) + (uri (pypi-uri "pycparser" version)) (sha256 (base32 - "0v5qfq03yvd1pi0dwlgfai0p3dh9bq94pydn19c4pdn0c6v9hzcm")))) + "0wvzyb6rxsfj3xcnpa4ynbh9qc7rrbk2277d5wqpphmx9akv8nbr")))) (outputs '("out" "doc")) (build-system python-build-system) (native-inputs @@ -3770,14 +3728,13 @@ a front-end for C compilers or analysis tools.") (define-public python-cffi (package (name "python-cffi") - (version "1.2.1") + (version "1.4.2") (source (origin (method url-fetch) - (uri (string-append "https://pypi.python.org/packages/source/c/" - "cffi/cffi-" version ".tar.gz")) + (uri (pypi-uri "cffi" version)) (sha256 - (base32 "0g8yfzinry1vsj6d1jlnd19338bh92lhhk207ksy4lm1n3g73dga")))) + (base32 "161rj52rzi3880lij17d6i9kvgkiwjilrqjs8405k8sf6ryif7cg")))) (build-system python-build-system) (outputs '("out" "doc")) (inputs @@ -3914,15 +3871,13 @@ PNG, PostScript, PDF, and SVG file output.") (define-public python-decorator (package (name "python-decorator") - (version "3.4.2") + (version "4.0.6") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/d/decorator/decorator-" - version ".tar.gz")) + (uri (pypi-uri "decorator" version)) (sha256 - (base32 "0i2bnlkh0p9gs76hb28mafandcrig2fmv56w9ai6mshxwqn0083k")))) + (base32 "1710cwsbwr8fkiq59w2min7rwgdz7ly51yz8l8yh1zbpfxcm8qhw")))) (build-system python-build-system) (arguments '(#:tests? #f)) ; no test target (native-inputs @@ -4208,11 +4163,12 @@ without using the configuration machinery.") (version "3.2.1") (source (origin - (method url-fetch) - (uri (string-append "https://pypi.python.org/packages/source/i/" - "ipython/ipython-" version ".tar.gz")) - (sha256 - (base32 "0xwin0sa9n0cabx4cq1ibf5ldsiw5dyimibla82kicz5gbpas4y9")))) + (method url-fetch) + (patches (list (search-patch "python-ipython-inputhook-ctype.patch"))) + (uri (string-append "https://pypi.python.org/packages/source/i/" + "ipython/ipython-" version ".tar.gz")) + (sha256 + (base32 "0xwin0sa9n0cabx4cq1ibf5ldsiw5dyimibla82kicz5gbpas4y9")))) (build-system python-build-system) (outputs '("out" "doc")) (propagated-inputs @@ -4952,15 +4908,13 @@ applications.") (define-public python-pyzmq (package (name "python-pyzmq") - (version "14.6.0") + (version "15.1.0") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/p/pyzmq/pyzmq-" - version ".tar.gz")) + (uri (pypi-uri "pyzmq" version)) (sha256 - (base32 "1frmbjykvhmdg64g7sn20c9fpamrsfxwci1nhhg8q7jgz5pq0ikp")))) + (base32 "13fhwnlvsvxv72kfhqbpn6qi7msh8mc8377mpabv32skk2cjfnxx")))) (build-system python-build-system) (arguments `(#:configure-flags @@ -5013,17 +4967,14 @@ PEP 8.") (define-public python-pyflakes (package (name "python-pyflakes") - (version "0.9.2") + (version "1.0.0") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/p/pyflakes/pyflakes-" - version - ".tar.gz")) + (uri (pypi-uri "pyflakes" version)) (sha256 (base32 - "0pvawddspdq0y22dbraq5gld9qr6rwa7zhmpfhl2b7v9rqiiqs82")))) + "0qs2sgqszq7wcplis8509wk2ygqcrwzbs1ghfj3svvivq2j377pk")))) (build-system python-build-system) (inputs `(("python-setuptools" ,python-setuptools))) @@ -5119,17 +5070,14 @@ complexity of Python source code.") (define-public python-flake8 (package (name "python-flake8") - (version "2.4.1") + (version "2.5.1") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/f/flake8/flake8-" - version - ".tar.gz")) + (uri (pypi-uri "flake8" version)) (sha256 (base32 - "0dvmrpv7x98xkzffjz1z7lqr90sp5zdz16bdwckfd1cckpjvnzif")))) + "00sn2g5ydriv5anbipcrprpv797kh4q8rfa75w3fc7v7n14fv2j4")))) (build-system python-build-system) (inputs `(("python-setuptools" ,python-setuptools) @@ -5199,6 +5147,39 @@ Python.") (define-public python2-mistune (package-with-python2 python-mistune)) +(define-public python-markdown + (package + (name "python-markdown") + (version "2.6.5") + (source + (origin + (method url-fetch) + (uri (pypi-uri "Markdown" version)) + (sha256 + (base32 + "0q758a3fiiawr20b3hhjfs677cwj6xi284yb7xspcvv0fdicz54d")))) + (build-system python-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'check + (lambda _ + (zero? (system* "python" "run-tests.py"))))))) + (native-inputs + `(("python-nose" ,python-nose) + ("python-pyyaml" ,python-pyyaml))) + (home-page "https://pythonhosted.org/Markdown/") + (synopsis "Python implementation of Markdown") + (description + "This package provides a Python implementation of John Gruber's +Markdown. The library features international input, various Markdown +extensions, and several HTML output formats. A command line wrapper +markdown_py is also provided to convert Markdown files to HTML.") + (license bsd-3))) + +(define-public python2-markdown + (package-with-python2 python-markdown)) + (define-public python-ptyprocess (package (name "python-ptyprocess") @@ -5528,16 +5509,14 @@ fractional seconds) of a clock which never goes backwards.") (define-public python-webob (package (name "python-webob") - (version "1.5.0b0") + (version "1.5.1") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/W/WebOb/WebOb-" - version ".tar.gz")) + (uri (pypi-uri "WebOb" version)) (sha256 (base32 - "140b3iczclk1j0405rvw5gxshqfkhcc8254fj520z3m23cwbql4a")))) + "02bhhzijfhv8hmi1i54d4b0v43liwhnywhflvxsv4x3zax9s3afq")))) (build-system python-build-system) (inputs `(("python-nose" ,python-nose) @@ -5878,19 +5857,16 @@ Python Package Index (PyPI).") (define-public python-tlsh (package (name "python-tlsh") - (version "3.4.1") ;according to CMakeLists.txt + (version "3.4.4") (home-page "https://github.com/trendmicro/tlsh") (source (origin - (method git-fetch) - (uri (git-reference - (url home-page) - ;; This is a commit right after 3.4.1; see - ;; <https://github.com/trendmicro/tlsh/issues/9>. - (commit "3ae3f1f"))) + (method url-fetch) + (uri (string-append "https://github.com/trendmicro/tlsh/archive/v" + version ".tar.gz")) (sha256 (base32 - "12cvnr5ndm5cg6i7lch93id90kgwgrigjgrj8f186nh3h4bf9chj")) - (file-name (string-append name "-" version "-checkout")))) + "00bhzjqrlh7v538kbkbn8lgx976j1138al3sdhklaizqjvpwyk4r")) + (file-name (string-append name "-" version ".tar.gz")))) (build-system cmake-build-system) (arguments '(#:out-of-source? #f @@ -5926,15 +5902,13 @@ a hash value.") (define-public python-libarchive-c (package (name "python-libarchive-c") - (version "2.1") + (version "2.2") (source (origin (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/l/libarchive-c/libarchive-c-" - version ".tar.gz")) + (uri (pypi-uri "libarchive-c" version)) (sha256 (base32 - "089lrz6xyrfnk55v35vis6jyqyyl77w093057djyspnd2744wi2n")))) + "0z4r7v3dhd6b3120mav05ff08srih176r2rg5k8kn7mjd9pslm2x")))) (build-system python-build-system) (arguments '(#:phases (modify-phases %standard-phases @@ -6479,15 +6453,14 @@ This allows one to make simple text-mode user interfaces on Unix-like systems") (define-public python-pyrfc3339 (package (name "python-pyrfc3339") - (version "0.2") + (version "1.0") (source (origin (method url-fetch) - (uri (string-append "https://pypi.python.org/packages/source/p/" - "pyRFC3339/pyRFC3339-" version ".tar.gz")) + (uri (pypi-uri "pyRFC3339" version)) (sha256 (base32 - "1pp648xsjaw9h1xq2mgwzda5wis2ypjmzxlksc1a8grnrdmzy155")))) + "0dgm4l9y8jiax5cp6yxjd2i27cq8h33sh81n1wfbmnmqb32cdywd")))) (build-system python-build-system) (propagated-inputs `(("python-pytz" ,python-pytz))) @@ -6618,3 +6591,34 @@ of the SSL peer.") (arguments `(#:python ,python-2)) (propagated-inputs `(("python2-pyopenssl" ,python2-pyopenssl))))) + +(define-public python-contextlib2 + (package + (name "python-contextlib2") + (version "0.4.0") + (source + (origin + (method url-fetch) + (uri (pypi-uri "contextlib2" version)) + (sha256 + (base32 + "0cmp131dlh0d0zvw0aza1zd13glvngzk8lb4avks0hm7yxwdr9am")))) + (build-system python-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'check + (lambda _ (zero? + (system* + "python" "test_contextlib2.py", "-v"))))))) + (home-page "http://contextlib2.readthedocs.org/") + (synopsis "Tools for decorators and context managers") + (description "This module is primarily a backport of the Python +3.2 contextlib to earlier Python versions. Like contextlib, it +provides utilities for common tasks involving decorators and context +managers. It also contains additional features that are not part of +the standard library.") + (license psfl))) + +(define-public python2-contextlib2 + (package-with-python2 python-contextlib2)) diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index c51a5f08e2..47ac392aa6 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -30,6 +30,8 @@ #:use-module (gnu packages autotools) #:use-module (gnu packages java) #:use-module (gnu packages libffi) + #:use-module (gnu packages python) + #:use-module (gnu packages ragel) #:use-module (gnu packages tls) #:use-module (gnu packages version-control) #:use-module (guix packages) @@ -38,12 +40,13 @@ #:use-module (guix utils) #:use-module (guix build-system gnu) #:use-module (gnu packages xml) + #:use-module (gnu packages web) #:use-module (guix build-system ruby)) (define-public ruby (package (name "ruby") - (version "2.2.3") + (version "2.2.4") (source (origin (method url-fetch) @@ -52,7 +55,7 @@ "/ruby-" version ".tar.xz")) (sha256 (base32 - "19x8gs67klgc3ag815jpin83jn2nv1akgjcgayd6v3h1xplr1v66")))) + "0g3ps4q3iz7wj9m45n8xyxzw8nh29ljdqb87b0f6i0p3853gz2yj")))) (build-system gnu-build-system) (arguments `(#:test-target "test" @@ -571,6 +574,32 @@ format.") (home-page "https://github.com/nicksieger/ci_reporter") (license license:expat))) +(define-public ruby-saikuro-treemap + (package + (name "ruby-saikuro-treemap") + (version "0.2.0") + (source (origin + (method url-fetch) + (uri (rubygems-uri "saikuro_treemap" version)) + (sha256 + (base32 + "0w70nmh43mwfbpq20iindl61siqqr8acmf7p3m7n5ipd61c24950")))) + (build-system ruby-build-system) + ;; Some of the tests fail because the generated JSON has keys in a + ;; different order. This is a problem with the test suite rather than any + ;; of the involved libraries. + (arguments `(#:tests? #f)) + (propagated-inputs + `(("ruby-json-pure" ,ruby-json-pure) + ("ruby-atoulme-saikuro" ,ruby-atoulme-saikuro))) + (synopsis "Generate complexity treemap based on saikuro analysis") + (description + "This gem generates a treemap showing the complexity of Ruby code on +which it is run. It uses Saikuro under the covers to analyze Ruby code +complexity.") + (home-page "http://github.com/ThoughtWorksStudios/saikuro_treemap") + (license license:expat))) + (define-public ruby-orderedhash (package (name "ruby-orderedhash") @@ -1432,6 +1461,25 @@ facilities supporting TDD, BDD, mocking, and benchmarking.") (home-page "https://github.com/seattlerb/minitest") (license license:expat))) +;; This is the last release of Minitest 4, which is used by some packages. +(define-public ruby-minitest-4 + (package (inherit ruby-minitest) + (version "4.7.5") + (source (origin + (method url-fetch) + (uri (rubygems-uri "minitest" version)) + (sha256 + (base32 + "03p6iban9gcpcflzp4z901s1hgj9369p6515h967ny6hlqhcf2iy")))) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'remove-unsupported-method + (lambda _ + (substitute* "Rakefile" + (("self\\.rubyforge_name = .*") "")) + #t))))))) + (define-public ruby-minitest-sprint (package (name "ruby-minitest-sprint") @@ -1635,16 +1683,26 @@ to reproduce user environments.") (home-page "http://github.com/flavorjones/mini_portile") (license license:expat))) +(define-public ruby-mini-portile-2 + (package (inherit ruby-mini-portile) + (version "2.0.0") + (source (origin + (method url-fetch) + (uri (rubygems-uri "mini_portile2" version)) + (sha256 + (base32 + "056drbn5m4khdxly1asmiik14nyllswr6sh3wallvsywwdiryz8l")))))) + (define-public ruby-nokogiri (package (name "ruby-nokogiri") - (version "1.6.6.2") + (version "1.6.7.1") (source (origin (method url-fetch) (uri (rubygems-uri "nokogiri" version)) (sha256 (base32 - "1j4qv32qjh67dcrc1yy1h8sqjnny8siyy4s44awla8d6jk361h30")))) + "12nwv3lad5k2k73aa1d1xy4x577c143ixks6rs70yp78sinbglk2")))) (build-system ruby-build-system) (arguments ;; Tests fail because Nokogiri can only test with an installed extension, @@ -1662,7 +1720,7 @@ to reproduce user environments.") ("libxml2" ,libxml2) ("libxslt" ,libxslt))) (propagated-inputs - `(("ruby-mini-portile" ,ruby-mini-portile))) + `(("ruby-mini-portile" ,ruby-mini-portile-2))) (synopsis "HTML, XML, SAX, and Reader parser for Ruby") (description "Nokogiri (鋸) parses and searches XML/HTML, and features both CSS3 selector and XPath 1.0 support.") @@ -1736,6 +1794,54 @@ invocation, and source and documentation browsing.") (home-page "http://pryrepl.org") (license license:expat))) +(define-public ruby-guard + (package + (name "ruby-guard") + (version "2.13.0") + (source (origin + (method url-fetch) + ;; The gem does not include a Rakefile, nor does it contain a + ;; gemspec file, nor does it come with the tests. This is why + ;; we fetch the tarball from Github. + (uri (string-append "https://github.com/guard/guard/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1hwj0yi17k6f5axrm0k2bb7fq71dlp0zfywmd7pij9iimbppcca0")))) + (build-system ruby-build-system) + (arguments + `(#:tests? #f ; tests require cucumber + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'remove-git-ls-files + (lambda* (#:key outputs #:allow-other-keys) + (substitute* "guard.gemspec" + (("git ls-files -z") "find . -type f -print0")) + #t)) + (replace 'build + (lambda _ + (zero? (system* "gem" "build" "guard.gemspec"))))))) + (propagated-inputs + `(("ruby-formatador" ,ruby-formatador) + ("ruby-listen" ,ruby-listen) + ("ruby-lumberjack" ,ruby-lumberjack) + ("ruby-nenv" ,ruby-nenv) + ("ruby-notiffany" ,ruby-notiffany) + ("ruby-pry" ,ruby-pry) + ("ruby-shellany" ,ruby-shellany) + ("ruby-thor" ,ruby-thor))) + (native-inputs + `(("bundler" ,bundler) + ("ruby-rspec" ,ruby-rspec))) + (synopsis "Tool to handle events on file system modifications") + (description + "Guard is a command line tool to easily handle events on file system +modifications. Guard automates various tasks by running custom rules whenever +file or directories are modified.") + (home-page "http://guardgem.org/") + (license license:expat))) + (define-public ruby-thread-safe (package (name "ruby-thread-safe") @@ -1892,6 +1998,165 @@ documentation for Ruby code.") (home-page "https://github.com/flori/tins") (license license:expat))) +(define-public ruby-gem-hadar + (package + (name "ruby-gem-hadar") + (version "1.3.1") + (source (origin + (method url-fetch) + (uri (rubygems-uri "gem_hadar" version)) + (sha256 + (base32 + "1j8qri4m9wf8nbfv0kakrgsv2x8vg10914xgm6f69nw8zi3i39ws")))) + (build-system ruby-build-system) + ;; This gem needs itself at development time. We disable rebuilding of the + ;; gemspec to avoid this loop. + (arguments + `(#:tests? #f ; there are no tests + #:phases + (modify-phases %standard-phases + (replace 'build + (lambda _ + (zero? (system* "gem" "build" "gem_hadar.gemspec"))))))) + (propagated-inputs + `(("git" ,git) + ("ruby-tins" ,ruby-tins) + ("ruby-sdoc" ,ruby-sdoc))) + (native-inputs + `(("bundler" ,bundler))) + (synopsis "Library for the development of Ruby gems") + (description + "This library contains some useful functionality to support the +development of Ruby gems.") + (home-page "https://github.com/flori/gem_hadar") + (license license:expat))) + +(define-public ruby-minitest-tu-shim + (package + (name "ruby-minitest-tu-shim") + (version "1.3.3") + (source (origin + (method url-fetch) + (uri (rubygems-uri "minitest_tu_shim" version)) + (sha256 + (base32 + "0xlyh94iirvssix157ng2akr9nqhdygdd0c6094hhv7dqcfrn9fn")))) + (build-system ruby-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'fix-test-include-path + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "Rakefile" + (("Hoe\\.add_include_dirs .*") + (string-append "Hoe.add_include_dirs \"" + (assoc-ref inputs "ruby-minitest-4") + "/lib/ruby/gems/2.2.0/gems/minitest-" + ,(package-version ruby-minitest-4) + "/lib" "\""))))) + (add-before 'check 'fix-test-assumptions + (lambda _ + ;; The test output includes the file name, so a couple of tests + ;; fail. Changing the regular expressions slightly fixes this + ;; problem. + (substitute* "test/test_mini_test.rb" + (("output.sub!\\(.*, 'FILE:LINE'\\)") + "output.sub!(/\\/.+-[\\w\\/\\.]+:\\d+/, 'FILE:LINE')") + (("gsub\\(/.*, 'FILE:LINE'\\)") + "gsub(/\\/.+-[\\w\\/\\.]+:\\d+/, 'FILE:LINE')")) + #t))))) + (propagated-inputs + `(("ruby-minitest-4" ,ruby-minitest-4))) + (native-inputs + `(("ruby-hoe" ,ruby-hoe))) + (synopsis "Adapter library between minitest and test/unit") + (description + "This library bridges the gap between the small and fast minitest and +Ruby's large and slower test/unit.") + (home-page "https://rubygems.org/gems/minitest_tu_shim") + (license license:expat))) + +(define-public ruby-term-ansicolor + (package + (name "ruby-term-ansicolor") + (version "1.3.2") + (source (origin + (method url-fetch) + (uri (rubygems-uri "term-ansicolor" version)) + (sha256 + (base32 + "0ydbbyjmk5p7fsi55ffnkq79jnfqx65c3nj8d9rpgl6sw85ahyys")))) + (build-system ruby-build-system) + ;; Rebuilding the gemspec seems to require git, even though this is not a + ;; git repository, so we just build the gem from the existing gemspec. + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'build + (lambda _ + (zero? (system* "gem" "build" "term-ansicolor.gemspec"))))))) + (propagated-inputs + `(("ruby-tins" ,ruby-tins))) + (native-inputs + `(("ruby-gem-hadar" ,ruby-gem-hadar) + ("ruby-minitest-tu-shim" ,ruby-minitest-tu-shim))) + (synopsis "Ruby library to control the attributes of terminal output") + (description + "This Ruby library uses ANSI escape sequences to control the attributes +of terminal output.") + (home-page "http://flori.github.io/term-ansicolor/") + ;; There is no mention of the "or later" clause. + (license license:gpl2))) + +(define-public ruby-pstree + (package + (name "ruby-pstree") + (version "0.1.0") + (source (origin + (method url-fetch) + (uri (rubygems-uri "pstree" version)) + (sha256 + (base32 + "1mig1sv5qx1cdyhjaipy8jlh9j8pnja04vprrzihyfr54x0215p1")))) + (build-system ruby-build-system) + (native-inputs + `(("ruby-gem-hadar" ,ruby-gem-hadar) + ("bundler" ,bundler))) + (synopsis "Create a process tree data structure") + (description + "This library uses the output of the @code{ps} command to create a +process tree data structure for the current host.") + (home-page "http://flori.github.com/pstree") + ;; There is no mention of the "or later" clause. + (license license:gpl2))) + +(define-public ruby-utils + (package + (name "ruby-utils") + (version "0.2.4") + (source (origin + (method url-fetch) + (uri (rubygems-uri "utils" version)) + (sha256 + (base32 + "0vycgscxf3s1xn4yyfsq54zlh082581ga8azybmqgc4pij6iz2cd")))) + (build-system ruby-build-system) + (propagated-inputs + `(("ruby-tins" ,ruby-tins) + ("ruby-term-ansicolor" ,ruby-term-ansicolor) + ("ruby-pstree" ,ruby-pstree) + ("ruby-pry-editline" ,ruby-pry-editline))) + (native-inputs + `(("ruby-gem-hadar" ,ruby-gem-hadar) + ("bundler" ,bundler))) + (synopsis "Command line tools for working with Ruby") + (description + "This package provides assorted command line tools that may be useful +when working with Ruby code.") + (home-page "https://github.com/flori/utils") + ;; There is no mention of the "or later" clause. + (license license:gpl2))) + (define-public ruby-json (package (name "ruby-json") @@ -1911,6 +2176,75 @@ a native C extension.") (home-page "http://json-jruby.rubyforge.org/") (license (list license:ruby license:gpl2)))) ; GPL2 only +(define-public ruby-json-pure + (package + (name "ruby-json-pure") + (version "1.8.3") + (source (origin + (method url-fetch) + (uri (rubygems-uri "json_pure" version)) + (sha256 + (base32 + "025aykr360x6dr1jmg8pmsrx7gr30pws4p1q686vnb48zyw1sc94")))) + (build-system ruby-build-system) + (arguments + `(#:modules ((srfi srfi-1) + (ice-9 regex) + (rnrs io ports) + (guix build ruby-build-system) + (guix build utils)) + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'replace-git-ls-files + (lambda _ + ;; The existing gemspec file already contains a nice list of + ;; files that belong to the gem. We extract the list from the + ;; gemspec file and then replace the file list in the Rakefile to + ;; get rid of the call to "git ls-files". + (let* ((contents (call-with-input-file "json.gemspec" get-string-all)) + ;; Guile is unhappy about the #\nul characters in comments. + (filtered (string-filter (lambda (char) + (not (equal? #\nul char))) + contents)) + (files (match:substring + (string-match " s\\.files = ([^]]+\\])" filtered) 1))) + (substitute* "Rakefile" + (("FileList\\[`git ls-files`\\.split\\(/\\\\n/\\)\\]") + (string-append "FileList" files)))) + #t))))) + (native-inputs + `(("ruby-permutation" ,ruby-permutation) + ("ruby-utils" ,ruby-utils) + ("ragel" ,ragel) + ("bundler" ,bundler))) + (synopsis "JSON implementation in pure Ruby") + (description + "This package provides a JSON implementation written in pure Ruby.") + (home-page "http://flori.github.com/json") + (license license:ruby))) + +;; Even though this package only provides bindings for a Mac OSX API it is +;; required by "ruby-listen" at runtime. +(define-public ruby-rb-fsevent + (package + (name "ruby-rb-fsevent") + (version "0.9.6") + (source (origin + (method url-fetch) + (uri (rubygems-uri "rb-fsevent" version)) + (sha256 + (base32 + "1hq57by28iv0ijz8pk9ynih0xdg7vnl1010xjcijfklrcv89a1j2")))) + (build-system ruby-build-system) + ;; Tests need "guard-rspec", which needs "guard". However, "guard" needs + ;; "listen", which needs "rb-fsevent" at runtime. + (arguments `(#:tests? #f)) + (synopsis "FSEvents API with signals catching") + (description + "This library provides Ruby bindings for the Mac OSX FSEvents API.") + (home-page "https://rubygems.org/gems/rb-fsevent") + (license license:expat))) + (define-public ruby-listen (package (name "ruby-listen") @@ -1925,8 +2259,8 @@ a native C extension.") (build-system ruby-build-system) (arguments '(#:tests? #f)) ; no tests (propagated-inputs - ;; FIXME: omitting "ruby-rb-fsevent" which is only for MacOS. - `(("ruby-rb-inotify" ,ruby-rb-inotify))) + `(("ruby-rb-inotify" ,ruby-rb-inotify) + ("ruby-rb-fsevent" ,ruby-rb-fsevent))) (synopsis "Listen to file modifications") (description "The Listen gem listens to file modifications and notifies you about the changes.") @@ -1960,6 +2294,121 @@ multibyte strings, internationalization, time zones, and testing.") (home-page "http://www.rubyonrails.org") (license license:expat))) +(define-public ruby-crass + (package + (name "ruby-crass") + (version "1.0.2") + (source (origin + (method url-fetch) + (uri (rubygems-uri "crass" version)) + (sha256 + (base32 + "1c377r8g7m58y22803iyjgqkkvnnii0pymskda1pardxrzaighj9")))) + (build-system ruby-build-system) + (native-inputs + `(("bundler" ,bundler) + ("ruby-minitest" ,ruby-minitest))) + (synopsis "Pure Ruby CSS parser") + (description + "Crass is a pure Ruby CSS parser based on the CSS Syntax Level 3 spec.") + (home-page "https://github.com/rgrove/crass/") + (license license:expat))) + +(define-public ruby-nokogumbo + (package + (name "ruby-nokogumbo") + (version "1.4.6") + (source (origin + ;; We use the git reference, because there's no Rakefile in the + ;; published gem and the tarball on Github is outdated. + (method git-fetch) + (uri (git-reference + (url "https://github.com/rubys/nokogumbo.git") + (commit "d56f954d20a"))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "0bnppjy96xiadrsrc9dp8y6wvdwnkfa930n7acrp0mqm4qywl2wl")))) + (build-system ruby-build-system) + (arguments + `(#:modules ((guix build ruby-build-system) + (guix build utils) + (ice-9 rdelim)) + #:phases + (modify-phases %standard-phases + (add-before 'build 'build-gemspec + (lambda _ + (substitute* "Rakefile" + ;; Build Makefile even without a copy of gumbo-parser sources + (("'gumbo-parser/src',") "") + ;; We don't bundle gumbo-parser sources + (("'gumbo-parser/src/\\*',") "") + (("'gumbo-parser/visualc/include/\\*',") "") + ;; The definition of SOURCES will be cut in gemspec, and + ;; "FileList" will be undefined. + (("SOURCES \\+ FileList\\[") + "['ext/nokogumboc/extconf.rb', 'ext/nokogumboc/nokogumbo.c', ")) + + ;; Copy the Rakefile and cut out the gemspec. + (copy-file "Rakefile" ".gemspec") + (with-atomic-file-replacement ".gemspec" + (lambda (in out) + (let loop ((line (read-line in 'concat)) + (skipping? #t)) + (if (eof-object? line) + #t + (let ((skip-next? (if skipping? + (not (string-prefix? "SPEC =" line)) + (string-prefix? "end" line)))) + (when (or (not skipping?) + (and skipping? (not skip-next?))) + (format #t "~a" line) + (display line out)) + (loop (read-line in 'concat) skip-next?)))))) + #t))))) + (inputs + `(("gumbo-parser" ,gumbo-parser))) + (propagated-inputs + `(("ruby-nokogiri" ,ruby-nokogiri))) + (synopsis "Ruby bindings to the Gumbo HTML5 parser") + (description + "Nokogumbo allows a Ruby program to invoke the Gumbo HTML5 parser and +access the result as a Nokogiri parsed document.") + (home-page "https://github.com/rubys/nokogumbo/") + (license license:asl2.0))) + +(define-public ruby-sanitize + (package + (name "ruby-sanitize") + (version "4.0.0") + (source (origin + (method url-fetch) + ;; The gem does not include the Rakefile, so we download the + ;; release tarball from Github. + (uri (string-append "https://github.com/rgrove/" + "sanitize/archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "055xnj38l60gxnnng76kpy2l2jbrp0byjdyq17jw79w7l4b40znr")))) + (build-system ruby-build-system) + (propagated-inputs + `(("ruby-crass" ,ruby-crass) + ("ruby-nokogiri" ,ruby-nokogiri) + ("ruby-nokogumbo" ,ruby-nokogumbo))) + (native-inputs + `(("bundler" ,bundler) + ("ruby-minitest" ,ruby-minitest) + ("ruby-redcarpet" ,ruby-redcarpet) + ("ruby-yard" ,ruby-yard))) + (synopsis "Whitelist-based HTML and CSS sanitizer") + (description + "Sanitize is a whitelist-based HTML and CSS sanitizer. Given a list of +acceptable elements, attributes, and CSS properties, Sanitize will remove all +unacceptable HTML and/or CSS from a string.") + (home-page "https://github.com/rgrove/sanitize/") + (license license:expat))) + (define-public ruby-ox (package (name "ruby-ox") @@ -1983,6 +2432,45 @@ alternative to Marshal for Object serialization. ") (home-page "http://www.ohler.com/ox") (license license:expat))) +(define-public ruby-redcloth + (package + (name "ruby-redcloth") + (version "4.2.9") + (source (origin + (method url-fetch) + (uri (rubygems-uri "RedCloth" version)) + (sha256 + (base32 + "06pahxyrckhgb7alsxwhhlx1ib2xsx33793finj01jk8i054bkxl")))) + (build-system ruby-build-system) + (arguments + `(#:tests? #f ; no tests + #:phases + (modify-phases %standard-phases + ;; Redcloth has complicated rake tasks to build various versions for + ;; multiple targets using RVM. We don't want this so we just use the + ;; existing gemspec. + (replace 'build + (lambda _ + (zero? (system* "gem" "build" "redcloth.gemspec")))) + ;; Make sure that the "redcloth" executable finds required Ruby + ;; libraries. + (add-after 'install 'wrap-bin-redcloth + (lambda* (#:key outputs #:allow-other-keys) + (wrap-program (string-append (assoc-ref outputs "out") + "/bin/redcloth") + `("GEM_HOME" ":" prefix (,(getenv "GEM_HOME")))) + #t))))) + (native-inputs + `(("bundler" ,bundler) + ("ruby-diff-lcs" ,ruby-diff-lcs) + ("ruby-rspec-2" ,ruby-rspec-2))) + (synopsis "Textile markup language parser for Ruby") + (description + "RedCloth is a Ruby parser for the Textile markup language.") + (home-page "http://redcloth.org") + (license license:expat))) + (define-public ruby-pg (package (name "ruby-pg") @@ -2032,6 +2520,109 @@ other things and it comes with a command line interface.") (home-page "http://github.com/deivid-rodriguez/byebug") (license license:bsd-2))) +(define-public ruby-netrc + (package + (name "ruby-netrc") + (version "0.11.0") + (source (origin + (method url-fetch) + (uri (rubygems-uri "netrc" version)) + (sha256 + (base32 + "0gzfmcywp1da8nzfqsql2zqi648mfnx6qwkig3cv36n9m0yy676y")))) + (build-system ruby-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'check + ;; There is no Rakefile and minitest can only run one file at once, + ;; so we have to iterate over all test files. + (lambda _ + (and (map (lambda (file) + (zero? (system* "ruby" "-Itest" file))) + (find-files "./test" "test_.*\\.rb")))))))) + (native-inputs + `(("ruby-minitest" ,ruby-minitest))) + (synopsis "Library to read and update netrc files") + (description + "This library can read and update netrc files, preserving formatting +including comments and whitespace.") + (home-page "https://github.com/geemus/netrc") + (license license:expat))) + +(define-public ruby-unf-ext + (package + (name "ruby-unf-ext") + (version "0.0.7.1") + (source (origin + (method url-fetch) + (uri (rubygems-uri "unf_ext" version)) + (sha256 + (base32 + "0ly2ms6c3irmbr1575ldyh52bz2v0lzzr2gagf0p526k12ld2n5b")))) + (build-system ruby-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'build 'build-ext + (lambda _ (zero? (system* "rake" "compile:unf_ext"))))))) + (native-inputs + `(("bundler" ,bundler) + ("ruby-rake-compiler" ,ruby-rake-compiler) + ("ruby-test-unit" ,ruby-test-unit))) + (synopsis "Unicode normalization form support library") + (description + "This package provides unicode normalization form support for Ruby.") + (home-page "https://github.com/knu/ruby-unf_ext") + (license license:expat))) + +(define-public ruby-tdiff + (package + (name "ruby-tdiff") + (version "0.3.3") + (source (origin + (method url-fetch) + (uri (rubygems-uri "tdiff" version)) + (sha256 + (base32 + "0k41jbvn8qq4mgrixnhlk742b971d136i8wpbcv2cczvi22xpc86")))) + (build-system ruby-build-system) + (native-inputs + `(("ruby-rspec-2" ,ruby-rspec-2) + ("ruby-yard" ,ruby-yard) + ("ruby-rubygems-tasks" ,ruby-rubygems-tasks))) + (synopsis "Calculate the differences between two tree-like structures") + (description + "This library provides functions to calculate the differences between two +tree-like structures. It is similar to Ruby's built-in @code{TSort} module.") + (home-page "https://github.com/postmodern/tdiff") + (license license:expat))) + +(define-public ruby-nokogiri-diff + (package + (name "ruby-nokogiri-diff") + (version "0.2.0") + (source (origin + (method url-fetch) + (uri (rubygems-uri "nokogiri-diff" version)) + (sha256 + (base32 + "0njr1s42war0bj1axb2psjvk49l74a8wzr799wckqqdcb6n51lc1")))) + (build-system ruby-build-system) + (propagated-inputs + `(("ruby-tdiff" ,ruby-tdiff) + ("ruby-nokogiri" ,ruby-nokogiri))) + (native-inputs + `(("ruby-rspec-2" ,ruby-rspec-2) + ("ruby-yard" ,ruby-yard) + ("ruby-rubygems-tasks" ,ruby-rubygems-tasks))) + (synopsis "Calculate the differences between two XML/HTML documents") + (description + "@code{Nokogiri::Diff} adds the ability to calculate the +differences (added or removed nodes) between two XML/HTML documents.") + (home-page "https://github.com/postmodern/nokogiri-diff") + (license license:expat))) + (define-public ruby-rack (package (name "ruby-rack") @@ -2200,6 +2791,85 @@ extending for custom Ruby constructs such as custom class level definitions.") (home-page "http://yardoc.org") (license license:expat))) +(define-public ruby-clap + (package + (name "ruby-clap") + (version "1.0.0") + (source (origin + (method url-fetch) + (uri (rubygems-uri "clap" version)) + (sha256 + (base32 + "190m05k3pca72c1h8k0fnvby15m303zi0lpb9c478ad19wqawa5q")))) + (build-system ruby-build-system) + ;; Clap needs cutest for running tests, but cutest needs clap. + (arguments `(#:tests? #f)) + (synopsis "Command line argument parsing for simple applications") + (description + "Clap provides command line argument parsing features. It covers the +simple case of executing code based on the flags or parameters passed.") + (home-page "https://github.com/djanowski/cutest") + (license license:expat))) + +(define-public ruby-cutest + (package + (name "ruby-cutest") + (version "1.2.2") + (source (origin + (method url-fetch) + (uri (rubygems-uri "cutest" version)) + (sha256 + (base32 + "1mldhjn62g53vx4gq2qdqg2lgjvyrqxa8d0khf8347bbfgi16d32")))) + (build-system ruby-build-system) + (propagated-inputs + `(("ruby-clap" ,ruby-clap))) + (synopsis "Run tests in separate processes") + (description + "Cutest runs tests in separate processes to avoid shared state.") + (home-page "https://github.com/djanowski/cutest") + (license license:expat))) + +(define-public ruby-pygmentize + (package + (name "ruby-pygmentize") + (version "0.0.3") + (source (origin + (method url-fetch) + (uri (rubygems-uri "pygmentize" version)) + (sha256 + (base32 + "1pxryhkiwvsz6xzda3bvqwz5z8ggzl1cdglf8qbcf4bb7akirdpb")))) + (build-system ruby-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'fix-pygmentize-path + (lambda _ + (substitute* "lib/pygmentize.rb" + (("\"/usr/bin/env python.*") + (string-append "\"" (which "pygmentize") "\"\n"))) + #t)) + (add-after 'build 'do-not-use-vendor-directory + (lambda _ + ;; Remove bundled pygments sources + ;; FIXME: ruby-build-system does not support snippets. + (delete-file-recursively "vendor") + (substitute* "pygmentize.gemspec" + (("\"vendor/\\*\\*/\\*\",") "")) + #t))))) + (inputs + `(("pygments" ,python-pygments))) + (native-inputs + `(("ruby-cutest" ,ruby-cutest) + ("ruby-nokogiri" ,ruby-nokogiri))) + (synopsis "Thin Ruby wrapper around pygmentize") + (description + "Pygmentize provides a simple way to call pygmentize from within a Ruby +application.") + (home-page "https://github.com/djanowski/pygmentize") + (license license:expat))) + (define-public ruby-eventmachine (package (name "ruby-eventmachine") diff --git a/gnu/packages/samba.scm b/gnu/packages/samba.scm index 484eafb647..ac3a17d512 100644 --- a/gnu/packages/samba.scm +++ b/gnu/packages/samba.scm @@ -24,12 +24,14 @@ #:use-module (guix licenses) #:use-module (gnu packages acl) #:use-module (gnu packages admin) + #:use-module (gnu packages cups) + #:use-module (gnu packages databases) + #:use-module (gnu packages tls) #:use-module (gnu packages popt) + #:use-module (gnu packages pkg-config) #:use-module (gnu packages openldap) #:use-module (gnu packages readline) - #:use-module (gnu packages libunwind) #:use-module (gnu packages linux) - #:use-module (gnu packages elf) #:use-module (gnu packages perl) #:use-module (gnu packages python)) @@ -96,64 +98,57 @@ anywhere.") (define-public samba (package (name "samba") - (version "3.6.25") + (version "4.3.2") (source (origin (method url-fetch) (uri (string-append "https://www.samba.org/samba/ftp/stable/samba-" version ".tar.gz")) (sha256 (base32 - "0l9pz2m67vf398q3c2dwn8jwdxsjb20igncf4byhv6yq5dzqlb4g")))) + "0xcs2bcim421mlk6l9rcrkx4cq9y41gfssyfa7xzdw5draar3631")))) (build-system gnu-build-system) (arguments - `(#:phases (alist-cons-before - 'configure 'chdir - (lambda _ - (chdir "source3")) - (alist-cons-after - 'strip 'add-lib-to-runpath - (lambda* (#:key outputs #:allow-other-keys) - (let* ((out (assoc-ref outputs "out")) - (lib (string-append out "/lib"))) - ;; Add LIB to the RUNPATH of all the executables and - ;; dynamic libraries. - (with-directory-excursion out - (for-each (cut augment-rpath <> lib) - (append (find-files "bin" ".*") - (find-files "sbin" ".*") - (find-files "lib" ".*")))))) - %standard-phases)) - - #:modules ((guix build gnu-build-system) - (guix build utils) - (guix build rpath) - (srfi srfi-26)) - #:imported-modules (,@%gnu-build-system-modules - (guix build rpath)) - - ;; This flag is required to allow for "make test". - #:configure-flags '("--enable-socket-wrapper") - - #:test-target "test" + '(#:phases + (modify-phases %standard-phases + (replace 'configure + ;; samba uses a custom configuration script that runs waf. + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (libdir (string-append out "/lib"))) + (zero? (system* + "./configure" + "--enable-fhs" + ;; XXX: heimdal not packaged. + "--bundled-libraries=com_err" + (string-append "--prefix=" out) + ;; Install public and private libraries into + ;; a single directory to avoid RPATH issues. + (string-append "--libdir=" libdir) + (string-append "--with-privatelibdir=" libdir))))))) ;; XXX: The test infrastructure attempts to set password with ;; smbpasswd, which fails with "smbpasswd -L can only be used by root." ;; So disable tests until there's a workaround. #:tests? #f)) (inputs ; TODO: Add missing dependencies - `(;; ("cups" ,cups) - ("acl" ,acl) + `(("acl" ,acl) + ("cups" ,cups) ;; ("gamin" ,gamin) - ("libunwind" ,libunwind) + ("gnutls" ,gnutls) ("iniparser" ,iniparser) - ("popt" ,popt) - ("openldap" ,openldap) + ("libaio" ,libaio) + ("ldb" ,ldb) ("linux-pam" ,linux-pam) + ("openldap" ,openldap) + ("popt" ,popt) ("readline" ,readline) - ("patchelf" ,patchelf))) ; for (guix build rpath) - (native-inputs ; for the test suite + ("talloc" ,talloc) + ("tevent" ,tevent) + ("tdb" ,tdb))) + (native-inputs `(("perl" ,perl) - ("python" ,python-wrapper))) + ("pkg-config" ,pkg-config) + ("python" ,python-2))) ; incompatible with Python 3 (home-page "http://www.samba.org/") (synopsis "The standard Windows interoperability suite of programs for GNU and Unix") @@ -169,26 +164,31 @@ Desktops into Active Directory environments using the winbind daemon.") (define-public talloc (package (name "talloc") - (version "2.1.2") + (version "2.1.5") (source (origin (method url-fetch) (uri (string-append "https://www.samba.org/ftp/talloc/talloc-" version ".tar.gz")) (sha256 (base32 - "13c365f7y8idjf2v1jxdjpkc3lxdmsxxfxjx1ymianm7zjiph393")))) + "1pfx3kmj973hpacfw46fzfnjd7ms1j03ifkc30wk930brx8ffcrq")))) (build-system gnu-build-system) (arguments - '(#:phases (alist-replace - 'configure - (lambda* (#:key outputs #:allow-other-keys) - ;; talloc uses a custom configuration script that runs a - ;; python script called 'waf'. - (setenv "CONFIG_SHELL" (which "sh")) - (let ((out (assoc-ref outputs "out"))) - (zero? (system* "./configure" - (string-append "--prefix=" out))))) - %standard-phases))) + '(#:phases + (modify-phases %standard-phases + (replace 'configure + (lambda* (#:key outputs #:allow-other-keys) + ;; test_magic_differs.sh has syntax error, and is not in the right + ;; place where wscript expected. + ;; Skip the test. + (substitute* "wscript" + (("magic_ret = .*") "magic_ret = 0\n")) + ;; talloc uses a custom configuration script that runs a + ;; python script called 'waf'. + (setenv "CONFIG_SHELL" (which "sh")) + (let ((out (assoc-ref outputs "out"))) + (zero? (system* "./configure" + (string-append "--prefix=" out))))))))) (inputs `(("python" ,python-2))) (home-page "http://talloc.samba.org") @@ -198,6 +198,84 @@ Desktops into Active Directory environments using the winbind daemon.") destructors. It is the core memory allocator used in Samba.") (license gpl3+))) ;; The bundled "replace" library uses LGPL3. +(define-public tevent + (package + (name "tevent") + (version "0.9.26") + (source (origin + (method url-fetch) + (uri (string-append "https://www.samba.org/ftp/tevent/tevent-" + version ".tar.gz")) + (sha256 + (base32 + "1gbh6d2m49j1v2hkaiyrh8bj02i5wxd4hqayzk2g44yyivbi8b16")))) + (build-system gnu-build-system) + (arguments + '(#:phases + (modify-phases %standard-phases + (replace 'configure + ;; tevent uses a custom configuration script that runs waf. + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (zero? (system* "./configure" + (string-append "--prefix=" out) + "--bundled-libraries=NONE")))))))) + (native-inputs + `(("pkg-config" ,pkg-config) + ("python" ,python-2))) + (propagated-inputs + `(("talloc" ,talloc))) ; required by tevent.pc + (synopsis "Event system library") + (home-page "https://tevent.samba.org/") + (description + "Tevent is an event system based on the talloc memory management library. +It is the core event system used in Samba. The low level tevent has support for +many event types, including timers, signals, and the classic file descriptor events.") + (license lgpl3+))) + +(define-public ldb + (package + (name "ldb") + (version "1.1.23") + (source (origin + (method url-fetch) + (uri (string-append "https://www.samba.org/ftp/ldb/ldb-" + version ".tar.gz")) + (sha256 + (base32 + "0ncmwgga6q9v7maiywgw21w6rb3149m1w2ca11yq8k5j0izjz2wg")))) + (build-system gnu-build-system) + (arguments + '(#:phases + (modify-phases %standard-phases + (replace 'configure + ;; ldb use a custom configuration script that runs waf. + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (zero? (system* "./configure" + (string-append "--prefix=" out) + (string-append "--with-modulesdir=" out + "/lib/ldb/modules") + "--bundled-libraries=NONE")))))))) + (native-inputs + `(("pkg-config" ,pkg-config) + ("python" ,python-2))) + (propagated-inputs + ;; ldb.pc refers to all these. + `(("talloc" ,talloc) + ("tdb" ,tdb))) + (inputs + `(("popt" ,popt) + ("tevent" ,tevent))) + (synopsis "LDAP-like embedded database") + (home-page "https://ldb.samba.org/") + (description + "Ldb is a LDAP-like embedded database built on top of TDB. What ldb does +is provide a fast database with an LDAP-like API designed to be used within an +application. In some ways it can be seen as a intermediate solution between +key-value pair databases and a real LDAP database.") + (license lgpl3+))) + (define-public ppp (package (name "ppp") diff --git a/gnu/packages/sdl.scm b/gnu/packages/sdl.scm index 1b64be024d..825e7db5d9 100644 --- a/gnu/packages/sdl.scm +++ b/gnu/packages/sdl.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 David Thompson <dthompson2@worcester.edu> +;;; Copyright © 2013, 2015 David Thompson <dthompson2@worcester.edu> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2015 Alex Kost <alezost@gmail.com> @@ -20,6 +20,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu packages sdl) + #:use-module (ice-9 match) #:use-module (gnu packages) #:use-module ((guix licenses) #:hide (freetype)) #:use-module (guix packages) @@ -173,8 +174,6 @@ other supporting functions for SDL.") "--disable-tif-shared" "--disable-webp-shared"))) (native-inputs `(("pkg-config" ,pkg-config))) - ;; FIXME: Add webp - ;; ;; libjpeg, libpng, and libtiff are propagated inputs because the ;; SDL_image headers include the headers of these libraries. SDL is a ;; propagated input because the pkg-config file refers to SDL's pkg-config @@ -182,7 +181,8 @@ other supporting functions for SDL.") (propagated-inputs `(("sdl" ,sdl) ("libjpeg" ,libjpeg) ("libpng" ,libpng) - ("libtiff" ,libtiff))) + ("libtiff" ,libtiff) + ("libwebp" ,libwebp))) (synopsis "SDL image loading library") (description "SDL_image is an image file loading library for SDL that supports the following formats: BMP, GIF, JPEG, LBM, PCX, PNG, PNM, TGA, TIFF, @@ -299,6 +299,59 @@ directory.") (home-page (package-home-page sdl)) (license (package-license sdl)))) +(define (propagated-inputs-with-sdl2 package) + "Replace the \"sdl\" propagated input of PACKAGE with SDL2." + (map (match-lambda + (("sdl" _) + `("sdl2" ,sdl2)) + (other other)) + (package-propagated-inputs package))) + +(define-public sdl2-image + (package (inherit sdl-image) + (name "sdl2-image") + (version "2.0.0") + (source (origin + (method url-fetch) + (uri + (string-append "http://www.libsdl.org/projects/SDL_image/release/SDL2_image-" + version ".tar.gz")) + (sha256 + (base32 + "0d3jlhkmr0j5a2dd5h6y29jfcsj7mkl16wghm6n3nqqp7g3ib65j")))) + (propagated-inputs + (propagated-inputs-with-sdl2 sdl-image)))) + +(define-public sdl2-mixer + (package (inherit sdl-mixer) + (name "sdl2-mixer") + (version "2.0.0") + (source (origin + (method url-fetch) + (uri + (string-append "http://www.libsdl.org/projects/SDL_mixer/release/SDL2_mixer-" + version ".tar.gz")) + (sha256 + (base32 + "0nvjdxjchrajrn0jag877hdx9zb788hsd315zzg1lyck2wb0xkm8")))) + (propagated-inputs + (propagated-inputs-with-sdl2 sdl-mixer)))) + +(define-public sdl2-ttf + (package (inherit sdl-ttf) + (name "sdl2-ttf") + (version "2.0.12") + (source (origin + (method url-fetch) + (uri + (string-append "http://www.libsdl.org/projects/SDL_ttf/release/SDL2_ttf-" + version ".tar.gz")) + (sha256 + (base32 + "0vkg6lyj278mdpd52map3rfi65fbq16w67ahmmfcl77a8da60a47")))) + (propagated-inputs + (propagated-inputs-with-sdl2 sdl-ttf)))) + (define-public guile-sdl (package (name "guile-sdl") diff --git a/gnu/packages/ssh.scm b/gnu/packages/ssh.scm index cb8570a74b..76032f9b62 100644 --- a/gnu/packages/ssh.scm +++ b/gnu/packages/ssh.scm @@ -186,7 +186,7 @@ Additionally, various channel-specific options can be negotiated.") (define-public guile-ssh (package (name "guile-ssh") - (version "0.8.0") + (version "0.9.0") (source (origin ;; ftp://memory-heap.org/software/guile-ssh/guile-ssh-VERSION.tar.gz ;; exists, but the server appears to be too slow and unreliable. @@ -197,7 +197,7 @@ Additionally, various channel-specific options can be negotiated.") (file-name (string-append name "-" version "-checkout")) (sha256 (base32 - "1ld2khzylaylhqfsfcvbxs95frvm8pkr7dq40ia1wwn9c349fcdv")))) + "04zs1cykwdyj51ag62ymrkgsja9dbhbaaglkvbfbac0bkxl2ir6d")))) (build-system gnu-build-system) (arguments '(#:phases (alist-cons-after diff --git a/gnu/packages/statistics.scm b/gnu/packages/statistics.scm index 0ffd4955bb..81258d38f5 100644 --- a/gnu/packages/statistics.scm +++ b/gnu/packages/statistics.scm @@ -29,6 +29,7 @@ #:use-module (gnu packages compression) #:use-module (gnu packages gcc) #:use-module (gnu packages gtk) + #:use-module (gnu packages haskell) #:use-module (gnu packages icu4c) #:use-module (gnu packages image) #:use-module (gnu packages java) @@ -1342,3 +1343,157 @@ visualization system inspired by Trellis graphics, with an emphasis on multivariate data. Lattice is sufficient for typical graphics needs, and is also flexible enough to handle most nonstandard requirements.") (license license:gpl2+))) + +(define-public r-rcpparmadillo + (package + (name "r-rcpparmadillo") + (version "0.6.200.2.0") + (source (origin + (method url-fetch) + (uri (cran-uri "RcppArmadillo" version)) + (sha256 + (base32 + "137wqqga776yj6synx5awhrzgkz7mmqnvgmggh9l4k6d99vwp9gj")) + (modules '((guix build utils))) + ;; Remove bundled armadillo sources + (snippet + '(begin + (delete-file-recursively "inst/include/armadillo_bits") + (delete-file "inst/include/armadillo"))))) + (properties `((upstream-name . "RcppArmadillo"))) + (build-system r-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'link-against-armadillo + (lambda _ + (substitute* "src/Makevars" + (("PKG_LIBS=" prefix) + (string-append prefix "-larmadillo")))))))) + (propagated-inputs + `(("r-rcpp" ,r-rcpp) + ("armadillo" ,armadillo-for-rcpparmadillo))) + (home-page "https://github.com/RcppCore/RcppArmadillo") + (synopsis "Rcpp integration for the Armadillo linear algebra library") + (description + "Armadillo is a templated C++ linear algebra library that aims towards a +good balance between speed and ease of use. Integer, floating point and +complex numbers are supported, as well as a subset of trigonometric and +statistics functions. Various matrix decompositions are provided through +optional integration with LAPACK and ATLAS libraries. This package includes +the header files from the templated Armadillo library.") + ;; Armadillo is licensed under the MPL 2.0, while RcppArmadillo (the Rcpp + ;; bindings to Armadillo) is licensed under the GNU GPL version 2 or + ;; later, as is the rest of 'Rcpp'. + (license license:gpl2+))) + +(define-public r-bitops + (package + (name "r-bitops") + (version "1.0-6") + (source (origin + (method url-fetch) + (uri (cran-uri "bitops" version)) + (sha256 + (base32 + "176nr5wpnkavn5z0yy9f7d47l37ndnn2w3gv854xav8nnybi6wwv")))) + (build-system r-build-system) + (home-page "http://cran.r-project.org/web/packages/bitops") + (synopsis "Bitwise operations") + (description + "This package provides functions for bitwise operations on integer +vectors.") + (license license:gpl2+))) + +(define-public r-catools + (package + (name "r-catools") + (version "1.17.1") + (source (origin + (method url-fetch) + (uri (cran-uri "caTools" version)) + (sha256 + (base32 + "1x4szsn2qmbzpyjfdaiz2q7jwhap2gky9wq0riah74q0pzz76ank")))) + (properties `((upstream-name . "caTools"))) + (build-system r-build-system) + (propagated-inputs + `(("r-bitops" ,r-bitops))) + (home-page "http://cran.r-project.org/web/packages/caTools") + (synopsis "Various tools including functions for moving window statistics") + (description + "This package contains several basic utility functions including: +moving (rolling, running) window statistic functions, read/write for GIF and +ENVI binary files, fast calculation of AUC, LogitBoost classifier, base64 +encoder/decoder, round-off-error-free sum and cumsum, etc.") + (license license:gpl3+))) + +(define-public r-rmarkdown + (package + (name "r-rmarkdown") + (version "0.8.1") + (source + (origin + (method url-fetch) + (uri (cran-uri "rmarkdown" version)) + (sha256 + (base32 + "07q5g9dvac5j3vnf4sjc60mnkij1k6y7vnzjz6anf499rwdwbxza")))) + (properties `((upstream-name . "rmarkdown"))) + (build-system r-build-system) + (propagated-inputs + `(("r-catools" ,r-catools) + ("r-htmltools" ,r-htmltools) + ("r-knitr" ,r-knitr) + ("r-yaml" ,r-yaml) + ("ghc-pandoc" ,ghc-pandoc))) + (home-page "http://rmarkdown.rstudio.com") + (synopsis "Convert R Markdown documents into a variety of formats") + (description + "This package provides tools to convert R Markdown documents into a +variety of formats.") + (license license:gpl3+))) + +(define-public r-gtable + (package + (name "r-gtable") + (version "0.1.2") + (source (origin + (method url-fetch) + (uri (cran-uri "gtable" version)) + (sha256 + (base32 + "0k9hfj6r5y238gqh92s3cbdn34biczx3zfh79ix5xq0c5vkai2xh")))) + (properties `((upstream-name . "gtable"))) + (build-system r-build-system) + (home-page "http://cran.r-project.org/web/packages/gtable") + (synopsis "Arrange grobs in tables") + (description + "This package provides tools to make it easier to work with tables of +grobs.") + (license license:gpl2+))) + +(define-public r-gridextra + (package + (name "r-gridextra") + (version "2.0.0") + (source (origin + (method url-fetch) + (uri (cran-uri "gridExtra" version)) + (sha256 + (base32 + "19yyrfd37c5hxlavb9lca9l26wjhc80rlqhgmfj9k3xhbvvpdp17")))) + (properties `((upstream-name . "gridExtra"))) + (build-system r-build-system) + (propagated-inputs + `(("r-gtable" ,r-gtable))) + (native-inputs + `(("r-knitr" ,r-knitr))) ;for building vignettes + (home-page "https://github.com/baptiste/gridextra") + (synopsis "Miscellaneous functions for \"Grid\" graphics") + (description + "This package provides a number of user-level functions to work with +@code{grid} graphics, notably to arrange multiple grid-based plots on a page, +and draw tables.") + (license license:gpl2+))) + diff --git a/gnu/packages/telephony.scm b/gnu/packages/telephony.scm index 5c61604191..3f4ab56091 100644 --- a/gnu/packages/telephony.scm +++ b/gnu/packages/telephony.scm @@ -24,6 +24,7 @@ #:use-module (gnu packages gnupg) #:use-module (gnu packages linux) #:use-module (gnu packages pkg-config) + #:use-module (gnu packages tls) #:use-module (guix licenses) #:use-module (guix packages) #:use-module (guix download) @@ -60,14 +61,15 @@ reimplementation.") (define-public ucommon (package (name "ucommon") - (version "6.6.2") + (version "7.0.0") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/commoncpp/" name "-" version ".tar.gz")) (sha256 (base32 - "16haqzq97axiyhgpca95rhr5y5s7fl8b65if5vil7v4lcqxp3hqn")))) + "1mv080rvrhyxyhgqiqr8r9jdqhg3xhfawjvfj5zgj47h59nggjba")))) (build-system gnu-build-system) + (inputs `(("gnutls" ,gnutls))) (synopsis "Common C++ framework for threaded applications") (description "GNU uCommon C++ is meant as a very light-weight C++ library to facilitate using C++ design patterns even for very deeply embedded @@ -146,13 +148,13 @@ multiplayer games.") (define-public sipwitch (package (name "sipwitch") - (version "1.9.14") + (version "1.9.15") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/sipwitch/sipwitch-" version ".tar.gz")) (sha256 (base32 - "1mrzl5nakiz613v3ch27k5dj2ykm88dlcr22lqny6dnjyfa9n2ki")))) + "10lli9c703d7qbarzc0lgmz963ppncvnrklwrnri0s1zcmmahyia")))) (build-system gnu-build-system) ;; The configure.ac uses pkg-config but in a kludgy way which breaks when ;; cross-compiling. Among other issues there the program name "pkg-config" diff --git a/gnu/packages/terminals.scm b/gnu/packages/terminals.scm index 153c51a346..1a83eda3c0 100644 --- a/gnu/packages/terminals.scm +++ b/gnu/packages/terminals.scm @@ -33,14 +33,14 @@ (define-public tilda (package (name "tilda") - (version "1.3.0") + (version "1.3.1") (source (origin (method url-fetch) (uri (string-append "https://github.com/lanoxx/tilda/archive/" "tilda-" version ".tar.gz")) (sha256 (base32 - "1bbn2fflngx0g18ssvnzgzprvn1w6wc2y03sqzjwvxds488lhndx")))) + "1nh0kw8f6srriglj55gmir1hvakcwrak1wcydz3vpnmwipgy6jib")))) (build-system gnu-build-system) (arguments `(#:phases (modify-phases %standard-phases diff --git a/gnu/packages/texlive.scm b/gnu/packages/texlive.scm index 6480b2561e..b6c996edfa 100644 --- a/gnu/packages/texlive.scm +++ b/gnu/packages/texlive.scm @@ -191,7 +191,8 @@ This package contains the binaries.") (alist-cons-after 'patch-source-shebangs 'texmf-config (lambda* (#:key inputs outputs #:allow-other-keys) - (let* ((share (string-append (assoc-ref outputs "out") "/share")) + (let* ((out (assoc-ref outputs "out")) + (share (string-append out "/share")) (texmfroot (string-append share "/texmf-dist/web2c")) (texmfcnf (string-append texmfroot "/texmf.cnf")) (texlive-bin (assoc-ref inputs "texlive-bin")) @@ -201,6 +202,10 @@ This package contains the binaries.") (substitute* texmfcnf (("TEXMFROOT = \\$SELFAUTOPARENT") (string-append "TEXMFROOT = " share))) + ;; Register paths in texmfcnf.lua, needed for context. + (substitute* (string-append texmfroot "/texmfcnf.lua") + (("selfautodir:") out) + (("selfautoparent:") (string-append share "/"))) ;; Set path to TeXLive Perl modules (setenv "PERL5LIB" (string-append (getenv "PERL5LIB") ":" tlpkg)) diff --git a/gnu/packages/tls.scm b/gnu/packages/tls.scm index e539686199..578953403e 100644 --- a/gnu/packages/tls.scm +++ b/gnu/packages/tls.scm @@ -351,14 +351,13 @@ security, and applying best practice development processes.") (define-public acme (package (name "acme") - (version "0.1.0") + (version "0.1.1") (source (origin (method url-fetch) - (uri (string-append "https://pypi.python.org/packages/source/a/acme/acme-" - version ".tar.gz")) + (uri (pypi-uri "acme" version)) (sha256 (base32 - "0fj0m04zzdxx23vazl00ilqyl3jxqq9c9p4x61pfz1zps7nbzsy3")))) + "1yv0gy8akaqp5p2wjpfj8r5i0da04a9qdmlh06rczdkrmk6q680w")))) (build-system python-build-system) (arguments `(#:python ,python-2)) @@ -384,14 +383,13 @@ security, and applying best practice development processes.") (define-public letsencrypt (package (name "letsencrypt") - (version "0.1.0") + (version "0.1.1") (source (origin (method url-fetch) - (uri (string-append "https://pypi.python.org/packages/source/l/" - "letsencrypt/letsencrypt-" version ".tar.gz")) + (uri (pypi-uri "letsencrypt" version)) (sha256 (base32 - "1zb96xz32k6ai41h5m1l22qi47y71dq69dcmbz7vfm6jfrhjgxl1")))) + "1kia3wk66lxyi2fghp9sd7cqgr5qiwdfayz153hi4wpa3q1q8rwf")))) (build-system python-build-system) (arguments `(#:python ,python-2)) diff --git a/gnu/packages/tmux.scm b/gnu/packages/tmux.scm index 69757a3162..48d50ccafc 100644 --- a/gnu/packages/tmux.scm +++ b/gnu/packages/tmux.scm @@ -28,7 +28,7 @@ (define-public tmux (package (name "tmux") - (version "2.0") + (version "2.1") (source (origin (method url-fetch) (uri (string-append @@ -36,7 +36,7 @@ version "/tmux-" version ".tar.gz")) (sha256 (base32 - "0qnkda8kb747vmbldjpb23ksv9pq3s65xhh1ja5rdsmh8r24npvr")))) + "0xk1mylsb08sf0w597mdgj9s6hxxjvjvjd6bngpjvvxwyixlwmii")))) (build-system gnu-build-system) (inputs `(("libevent" ,libevent) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 6861e35bec..c24c4683c7 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2015 Kyle Meyer <kyle@kyleam.com> +;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,6 +33,7 @@ #:use-module (guix packages) #:use-module (guix download) #:use-module (guix git-download) + #:use-module (guix build-system cmake) #:use-module (guix build-system gnu) #:use-module (guix build-system python) #:use-module (guix build-system trivial) @@ -311,6 +313,49 @@ everything from small to very large projects with speed and efficiency.") This is the documentation displayed when using the '--help' option of a 'git' command."))) +(define-public libgit2 + (package + (name "libgit2") + (version "0.23.3") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/libgit2/libgit2/" + "archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1bhyzw9b7xr1vj24hgbwbfjw2wiaigiklccsdvd8r4kmcr180p1d")))) + (build-system cmake-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after 'unpack 'fix-hardcoded-paths + (lambda _ + (substitute* "tests/repo/init.c" + (("#!/bin/sh") (string-append "#!" (which "sh")))) + (substitute* "tests/clar/fs.h" + (("/bin/cp") (which "cp")) + (("/bin/rm") (which "rm"))) + #t)) + ;; Run checks more verbosely. + (replace 'check + (lambda _ (zero? (system* "./libgit2_clar" "-v" "-Q"))))))) + (inputs + `(("libssh2" ,libssh2) + ("libcurl" ,curl) + ("python" ,python) + ("openssl" ,openssl))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (home-page "http://libgit2.github.com/") + (synopsis "Library providing Git core methods") + (description + "Libgit2 is a portable, pure C implementation of the Git core methods +provided as a re-entrant linkable library with a solid API, allowing you to +write native speed custom Git applications in any language with bindings.") + ;; GPLv2 with linking exception + (license gpl2))) + (define-public shflags (package (name "shflags") @@ -570,14 +615,14 @@ property manipulation.") (define-public subversion (package (name "subversion") - (version "1.8.14") + (version "1.8.15") (source (origin (method url-fetch) (uri (string-append "http://archive.apache.org/dist/subversion/" "subversion-" version ".tar.bz2")) (sha256 (base32 - "07ws4bspdgi4r5hbxvk86a15c669iqz6wkfrdph78hddzk6q6f3z")))) + "0b68rjy1sjd66nqcswrm1bhda3vk2ngkgs6drcanmzbcd3vs366g")))) (build-system gnu-build-system) (arguments '(#:phases (alist-cons-after diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm index 76374e2ac6..f1089f76ca 100644 --- a/gnu/packages/video.scm +++ b/gnu/packages/video.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2015 Andy Patterson <ajpatter@uwaterloo.ca> ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015 Alex Vong <alexvong1995@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -41,6 +42,7 @@ #:use-module (gnu packages base) #:use-module (gnu packages cdrom) #:use-module (gnu packages compression) + #:use-module (gnu packages curl) #:use-module (gnu packages databases) #:use-module (gnu packages doxygen) #:use-module (gnu packages elf) @@ -373,14 +375,14 @@ standards (MPEG-2, MPEG-4 ASP/H.263, MPEG-4 AVC/H.264, and VC-1/VMW3).") (define-public ffmpeg (package (name "ffmpeg") - (version "2.8.3") + (version "2.8.4") (source (origin (method url-fetch) (uri (string-append "https://ffmpeg.org/releases/ffmpeg-" version ".tar.xz")) (sha256 (base32 - "0jkhyv68aa7h3hf905ganwqbrflams3hs74in7ygxdfkcqw2xqhq")))) + "07wmvp05zanmg3rm539dd0j7h1fi2fk0mcvmv01hjbpy92kq0qwb")))) (build-system gnu-build-system) (inputs `(("fontconfig" ,fontconfig) @@ -691,7 +693,7 @@ SVCD, DVD, 3ivx, DivX 3/4/5, WMV and H.264 movies.") (define-public mpv (package (name "mpv") - (version "0.13.0") + (version "0.14.0") (source (origin (method url-fetch) (uri (string-append @@ -699,7 +701,7 @@ SVCD, DVD, 3ivx, DivX 3/4/5, WMV and H.264 movies.") ".tar.gz")) (sha256 (base32 - "1nqjd64p4pj1lks9n9s8y4zf4dp5bz8pyd0gsvviww7mv17p0whk")) + "0cqjwl0xyg0sv1jflipfkvqjg32y0kqfh4gc3lyhqgv0hgs3fa84")) (file-name (string-append name "-" version ".tar.gz")))) (build-system waf-build-system) (native-inputs @@ -753,14 +755,7 @@ SVCD, DVD, 3ivx, DivX 3/4/5, WMV and H.264 movies.") 'configure 'setup-waf (lambda* (#:key inputs #:allow-other-keys) (copy-file (assoc-ref inputs "waf") "waf") - (setenv "CC" "gcc"))) - (add-before - 'configure 'patch-wscript - (lambda* (#:key inputs #:allow-other-keys) - (substitute* "wscript" - ;; XXX Remove this when our Samba package provides a .pc file. - (("check_pkg_config\\('smbclient'\\)") - "check_cc(lib='smbclient')"))))) + (setenv "CC" "gcc")))) ;; No check function defined. #:tests? #f)) (home-page "http://mpv.io/") @@ -810,7 +805,7 @@ projects while introducing many more.") (define-public youtube-dl (package (name "youtube-dl") - (version "2015.12.09") + (version "2015.12.29") (source (origin (method url-fetch) (uri (string-append "http://youtube-dl.org/downloads/" @@ -818,10 +813,31 @@ projects while introducing many more.") version ".tar.gz")) (sha256 (base32 - "11rzb30ik4all43r7bnsnm35mvs37y7xj3g9r7ig9jr7qlbhllwk")))) + "0232wiq8mjs5ngmlcvf0292icrhvzr9mkwy2km0g0djznsf7rxjg")))) (build-system python-build-system) (native-inputs `(("python-setuptools" ,python-setuptools))) (home-page "http://youtube-dl.org") + (arguments + ;; The problem here is that the directory for the man page and completion + ;; files is relative, and for some reason, setup.py uses the + ;; auto-detected sys.prefix instead of the user-defined "--prefix=FOO". + ;; So, we need pass the prefix directly. In addition, make sure the Bash + ;; completion file is called 'youtube-dl' rather than + ;; 'youtube-dl.bash-completion'. + `(#:phases (modify-phases %standard-phases + (add-before 'install 'fix-the-data-directories + (lambda* (#:key outputs #:allow-other-keys) + (let ((prefix (assoc-ref outputs "out"))) + (mkdir "bash-completion") + (rename-file "youtube-dl.bash-completion" + "bash-completion/youtube-dl") + (substitute* "setup.py" + (("youtube-dl\\.bash-completion") + "bash-completion/youtube-dl") + (("'etc/") + (string-append "'" prefix "/etc/")) + (("'share/") + (string-append "'" prefix "/share/"))))))))) (synopsis "Download videos from YouTube.com and other sites") (description "Youtube-dl is a small command-line program to download videos from @@ -1248,3 +1264,40 @@ players, transcoders, web streamers and many more types of applications. The functionality of the system is provided via an assortment of ready to use tools, XML authoring components, and an extensible plug-in based API.") (license license:lgpl2.1+))) + +(define-public obs + (package + (name "obs") + (version "0.12.4") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/jp9000/obs-studio" + "/archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0b1xb5vd3g4h7m1hsjzsq3bbbnqb2n6mpmq6ix4yyy72g087rjk1")))) + (build-system cmake-build-system) + (arguments '(#:tests? #f)) ; no tests + (native-inputs + `(("pkg-config" ,pkg-config))) + (inputs + `(("curl" ,curl) + ("eudev" ,eudev) + ("ffmpeg" ,ffmpeg) + ("freetype" ,freetype) + ("jack" ,jack-1) + ("jansson" ,jansson) + ("libx264" ,libx264) + ("libxcomposite" ,libxcomposite) + ("mesa" ,mesa) + ("pulseaudio" ,pulseaudio) + ("qt" ,qt) + ("zlib" ,zlib))) + (synopsis "Live streaming software") + (description "Open Broadcaster Software provides a graphical interface for +video recording and live streaming. OBS supports capturing audio and video +from many input sources such as webcams, X11 (for screencasting), PulseAudio, +and JACK.") + (home-page "https://obsproject.com") + (license license:gpl2+))) diff --git a/gnu/packages/web.scm b/gnu/packages/web.scm index 6c3329ffb6..52c5740388 100644 --- a/gnu/packages/web.scm +++ b/gnu/packages/web.scm @@ -30,6 +30,7 @@ #:use-module (guix download) #:use-module (guix git-download) #:use-module (guix cvs-download) + #:use-module (guix utils) #:use-module (guix build-system gnu) #:use-module (guix build-system perl) #:use-module (guix build-system cmake) @@ -435,11 +436,12 @@ used to validate and fix HTML data.") (source (origin (method url-fetch) (uri (string-append - "http://www.samba.org/~obnox/" name "/download/" - name "-" version ".tar.bz2")) + "https://download.banu.com/tinyproxy/" + (version-major+minor version) + "/tinyproxy-" version ".tar.gz")) (sha256 (base32 - "0vl9igw7vm924rs6d6bkib7zfclxnlf9s8rmml1sfwj7xda9nmdy")))) + "05y0y2q9j10x72y1fipya6bmc8hjcdf3kfw7dh8ahczpy341c938")))) (build-system gnu-build-system) (arguments `(#:configure-flags @@ -1894,6 +1896,30 @@ are invoked.") kinds of HTML parsing operations.") (home-page "http://search.cpan.org/dist/HTML-Tagset/"))) +(define-public perl-html-template + (package + (name "perl-html-template") + (version "2.95") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/W/WO/WONKO/" + "HTML-Template-" version ".tar.gz")) + (sha256 + (base32 + "07ahpfgidxsw2yb7y8i7bbr8s64aq6qgq832h9jswmksxbd0l43q")))) + (build-system perl-build-system) + (home-page "http://search.cpan.org/dist/HTML-Template") + (synopsis "HTML-like templates") + (description + "This module attempts to make using HTML templates simple and natural. +It extends standard HTML with a few new HTML-esque tags: @code{<TMPL_VAR>}, +@code{<TMPL_LOOP>}, @code{<TMPL_INCLUDE>}, @code{<TMPL_IF>}, +@code{<TMPL_ELSE>} and @code{<TMPL_UNLESS>}. The file written with HTML and +these new tags is called a template. Using this module you fill in the values +for the variables, loops and branches declared in the template. This allows +you to separate design from the data.") + (license (package-license perl)))) + (define-public perl-http-body (package (name "perl-http-body") @@ -3003,3 +3029,34 @@ the package implements a framework for performing fully customized requests where data can be processed either in memory, on disk, or streaming via the callback or connection interfaces.") (license l:expat))) + +(define-public gumbo-parser + (package + (name "gumbo-parser") + (version "0.10.1") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/google/" + "gumbo-parser/archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1bgg2kbj311pqdzw2v33za7k66g1rv44kkvvnz2gnpaasi9k0ii8")))) + (build-system gnu-build-system) + (arguments + `(#:tests? #f ; tests require bundling googletest sources + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'bootstrap + (lambda _ (zero? (system* "sh" "autogen.sh"))))))) + ;; The release tarball lacks the generated files. + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("libtool" ,libtool))) + (home-page "https://github.com/google/gumbo-parser") + (synopsis "HTML5 parsing library") + (description + "Gumbo is an implementation of the HTML5 parsing algorithm implemented as +a pure C99 library.") + (license l:asl2.0))) diff --git a/gnu/packages/xdisorg.scm b/gnu/packages/xdisorg.scm index 4b5308c665..dc01637e4f 100644 --- a/gnu/packages/xdisorg.scm +++ b/gnu/packages/xdisorg.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2015 Alexander I.Grafov <grafov@gmail.com> ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com> ;;; Copyright © 2015 xd1le <elisp.vim@gmail.com> +;;; Copyright © 2015 Florian Paul Schmidt <mista.tapas@gmx.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -40,6 +41,7 @@ #:use-module (gnu packages gettext) #:use-module (gnu packages glib) #:use-module (gnu packages gnome) ;for libgudev + #:use-module (gnu packages ncurses) #:use-module (gnu packages perl) #:use-module (gnu packages python) #:use-module (gnu packages linux) @@ -288,7 +290,7 @@ System style license, and has no special dependencies.") (source (origin (method url-fetch) (uri (string-append - "http://tomas.styblo.name/wmctrl/dist/wmctrl-" + "https://sites.google.com/site/tstyblo/wmctrl/wmctrl-" version ".tar.gz")) (sha256 (base32 @@ -406,14 +408,19 @@ things less distracting.") (define-public xlockmore (package (name "xlockmore") - (version "5.45") + (version "5.46") (source (origin (method url-fetch) - (uri (string-append "http://www.tux.org/~bagleyd/xlock/xlockmore-" - version "/xlockmore-" version ".tar.bz2")) + (uri (list (string-append + "http://www.tux.org/~bagleyd/xlock/xlockmore-" + version ".tar.xz") + (string-append + "http://www.tux.org/~bagleyd/xlock/xlockmore-old" + "/xlockmore-" version + "/xlockmore-" version ".tar.bz2"))) (sha256 (base32 - "1xqm61bbfn5q056w57vp16gvai8nqpcw570ysxlm5h46nh6ai0bz")))) + "1ps0dmnh912x8mwns94y2607xk90rjxrjn5s1pkmmpjg5h9bxcrj")))) (build-system gnu-build-system) (arguments '(#:configure-flags (list (string-append "--enable-appdefaultdir=" @@ -529,24 +536,34 @@ compact configuration syntax.") (package (name "rxvt-unicode") (version "9.21") - (source - (origin - (method url-fetch) - (uri (string-append - "http://dist.schmorp.de/rxvt-unicode/" - name "-" - version - ".tar.bz2")) - (sha256 - (base32 - "0swmi308v5yxsddrdhvi4cch88k2bbs2nffpl5j5m2f55gbhw9vm")))) + (source (origin + (method url-fetch) + (uri (string-append "http://dist.schmorp.de/rxvt-unicode/" + name "-" version ".tar.bz2")) + (sha256 + (base32 + "0swmi308v5yxsddrdhvi4cch88k2bbs2nffpl5j5m2f55gbhw9vm")))) (build-system gnu-build-system) + (arguments + ;; This sets the destination when installing the necessary terminal + ;; capability data, which are not provided by 'ncurses'. See + ;; https://lists.gnu.org/archive/html/bug-ncurses/2009-10/msg00031.html + '(#:make-flags (list (string-append "TERMINFO=" + (assoc-ref %outputs "out") + "/share/terminfo")))) (inputs `(("libXft" ,libxft) ("libX11" ,libx11))) (native-inputs - `(("perl" ,perl) + `(("ncurses" ,ncurses) ;trigger the installation of terminfo data + ("perl" ,perl) ("pkg-config" ,pkg-config))) + ;; FIXME: This should only be located in 'ncurses'. Nonetheless it is + ;; provided for usability reasons. See <https://bugs.gnu.org/22138>. + (native-search-paths + (list (search-path-specification + (variable "TERMINFO_DIRS") + (files '("share/terminfo"))))) (home-page "http://software.schmorp.de/pkg/rxvt-unicode.html") (synopsis "Rxvt clone with XFT and unicode support") (description "Rxvt-unicode (urxvt) is a colour vt102 terminal emulator @@ -655,3 +672,37 @@ use it as well.") "The xf86-input-wacom driver is the wacom-specific X11 input driver for the X.Org X Server version 1.7 and later (X11R7.5 or later).") (license license:x11))) + +(define-public redshift + (package + (name "redshift") + (version "1.10") + (source + (origin + (method url-fetch) + (uri + (string-append "https://github.com/jonls/redshift/" + "releases/download/v" version + "/redshift-" version ".tar.xz")) + (sha256 + (base32 + "19pfk9il5x2g2ivqix4a555psz8mj3m0cvjwnjpjvx0llh5fghjv")))) + (build-system gnu-build-system) + (native-inputs + `(("pkg-config" ,pkg-config) + ("intltool" ,intltool))) + (inputs + `(("libdrm" ,libdrm) + ("libx11" ,libx11) + ("libxcb" ,libxcb) + ("libxxf86vm", libxxf86vm) + ("glib" ,glib))) ;for Geoclue2 support + (home-page "https://github.com/jonls/redshift") + (synopsis "Adjust the color temperature of your screen") + (description + "Redshift adjusts the color temperature according to the position of the +sun. A different color temperature is set during night and daytime. During +twilight and early morning, the color temperature transitions smoothly from +night to daytime temperature to allow your eyes to slowly adapt. At night the +color temperature should be set to match the lamps in your room.") + (license license:gpl3+))) diff --git a/gnu/packages/xiph.scm b/gnu/packages/xiph.scm index 3e4d6687ea..bc2294e58c 100644 --- a/gnu/packages/xiph.scm +++ b/gnu/packages/xiph.scm @@ -320,7 +320,7 @@ incorporated technology from Skype's SILK codec and Xiph.Org's CELT codec.") (source (origin (method url-fetch) (uri (string-append - "ftp://ftp.mozilla.org/pub/mozilla.org/opus/opus-tools-" + "http://downloads.xiph.org/releases/opus/opus-tools-" version ".tar.gz")) (sha256 (base32 diff --git a/gnu/packages/xml.scm b/gnu/packages/xml.scm index 4e76cbc3c8..8288869a9f 100644 --- a/gnu/packages/xml.scm +++ b/gnu/packages/xml.scm @@ -223,6 +223,28 @@ module allows Perl programmers to make use of the highly capable validating XML parser and the high performance DOM implementation.") (license (package-license perl)))) +(define-public perl-xml-libxml-simple + (package + (name "perl-xml-libxml-simple") + (version "0.95") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/" + "XML-LibXML-Simple-" version ".tar.gz")) + (sha256 + (base32 + "0qqfqj5bgqmh1j4iv8dwl3g00nsmcvf2b7w1d09k9d77rrb249xi")))) + (build-system perl-build-system) + (propagated-inputs + `(("perl-file-slurp-tiny" ,perl-file-slurp-tiny) + ("perl-xml-libxml" ,perl-xml-libxml))) + (home-page "http://search.cpan.org/dist/XML-LibXML-Simple") + (synopsis "XML::LibXML based XML::Simple clone") + (description + "This package provides the same API as @code{XML::Simple} but is based on +@code{XML::LibXML}.") + (license (package-license perl)))) + (define-public perl-xml-namespacesupport (package (name "perl-xml-namespacesupport") @@ -374,6 +396,131 @@ from XML::Parser. It parses XML strings or files and builds a data structure that conforms to the API of the Document Object Model.") (home-page "http://search.cpan.org/~tjmather/XML-DOM-1.44/lib/XML/DOM.pm"))) +(define-public perl-xml-compile-tester + (package + (name "perl-xml-compile-tester") + (version "0.90") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/" + "XML-Compile-Tester-" version ".tar.gz")) + (sha256 + (base32 + "1bcl8x8cyacqv9yjp97aq9qq85sy8wv78kd8c16yd9yw3by4cpp1")))) + (build-system perl-build-system) + (propagated-inputs + `(("perl-log-report" ,perl-log-report) + ("perl-test-deep" ,perl-test-deep))) + (home-page "http://search.cpan.org/dist/XML-Compile-Tester") + (synopsis "XML::Compile related regression testing") + (description + "The @code{XML::Compile} module suite has extensive regression testing. +This module provide functions which simplify writing tests for +@code{XML::Compile} related distributions.") + (license (package-license perl)))) + +(define-public perl-xml-compile + (package + (name "perl-xml-compile") + (version "1.51") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/" + "XML-Compile-" version ".tar.gz")) + (sha256 + (base32 + "06fj4zf0yh4kf3kx4bhwrmrjr6al40nasasbgfhn8f1zxwkmm8f2")))) + (build-system perl-build-system) + (propagated-inputs + `(("perl-log-report" ,perl-log-report) + ("perl-xml-compile-tester" ,perl-xml-compile-tester) + ("perl-xml-libxml" ,perl-xml-libxml) + ("perl-test-deep" ,perl-test-deep))) + (home-page "http://search.cpan.org/dist/XML-Compile") + (synopsis "Compilation-based XML processing") + (description + "@code{XML::Compile} can be used to translate a Perl data-structure into +XML or XML into a Perl data-structure, both directions under rigid control by +a schema.") + (license (package-license perl)))) + +(define-public perl-xml-compile-cache + (package + (name "perl-xml-compile-cache") + (version "1.04") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/" + "XML-Compile-Cache-" version ".tar.gz")) + (sha256 + (base32 + "1689dm54n7wb0n0cl9n77vk0kvg0mcckn2hz9ahigjhvazah8740")))) + (build-system perl-build-system) + (propagated-inputs + `(("perl-log-report" ,perl-log-report) + ("perl-xml-compile" ,perl-xml-compile) + ("perl-xml-compile-tester" ,perl-xml-compile-tester) + ("perl-xml-libxml-simple" ,perl-xml-libxml-simple))) + (home-page "http://search.cpan.org/dist/XML-Compile-Cache") + (synopsis "Cache compiled XML translators") + (description + "This package provides methods to cache compiled XML translators.") + (license (package-license perl)))) + +(define-public perl-xml-compile-soap + (package + (name "perl-xml-compile-soap") + (version "3.13") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/" + "XML-Compile-SOAP-" version ".tar.gz")) + (sha256 + (base32 + "08qw63l78040nh37xzapbqp43g6s5l67bvskf3dyyizlarjx5mi4")))) + (build-system perl-build-system) + (propagated-inputs + `(("perl-file-slurp-tiny" ,perl-file-slurp-tiny) + ("perl-libwww" ,perl-libwww) + ("perl-log-report" ,perl-log-report) + ("perl-xml-compile" ,perl-xml-compile) + ("perl-xml-compile-cache" ,perl-xml-compile-cache) + ("perl-xml-compile-tester" ,perl-xml-compile-tester))) + (home-page "http://search.cpan.org/dist/XML-Compile-SOAP") + (synopsis "Base-class for SOAP implementations") + (description + "This module provides a class to handle the SOAP protocol. The first +implementation is @url{SOAP1.1, +http://www.w3.org/TR/2000/NOTE-SOAP-20000508/}, which is still most often +used.") + (license (package-license perl)))) + +(define-public perl-xml-compile-wsdl11 + (package + (name "perl-xml-compile-wsdl11") + (version "3.04") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/" + "XML-Compile-WSDL11-" version ".tar.gz")) + (sha256 + (base32 + "0pyikwnfwpangvnkf5dbdagy4z93ag9824f1ax5qaibc3ghca8kv")))) + (build-system perl-build-system) + (propagated-inputs + `(("perl-log-report" ,perl-log-report) + ("perl-xml-compile" ,perl-xml-compile) + ("perl-xml-compile-cache" ,perl-xml-compile-cache) + ("perl-xml-compile-soap" ,perl-xml-compile-soap))) + (home-page "http://search.cpan.org/dist/XML-Compile-WSDL11") + (synopsis "Create SOAP messages defined by WSDL 1.1") + (description + "This module understands WSDL version 1.1. A WSDL file defines a set of +messages to be send and received over SOAP connections. This involves +encoding of the message to be send into XML, sending the message to the +server, collect the answer, and finally decoding the XML to Perl.") + (license (package-license perl)))) + (define-public pugixml (package (name "pugixml") diff --git a/gnu/packages/zsh.scm b/gnu/packages/zsh.scm index c2f09226bd..6d25fd4671 100644 --- a/gnu/packages/zsh.scm +++ b/gnu/packages/zsh.scm @@ -32,8 +32,12 @@ (version "5.1.1") (source (origin (method url-fetch) - (uri (string-append "http://www.zsh.org/pub/zsh-" version - ".tar.gz")) + (uri (list (string-append + "http://www.zsh.org/pub/zsh-" version + ".tar.gz") + (string-append + "http://www.zsh.org/pub/old/zsh-" version + ".tar.gz"))) (sha256 (base32 "11shllzhq53fg8ngy3bgbmpf09fn2czifg7hsb41nxi3410mpvcl")))) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index a86e8e04c7..25143c80a6 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -43,7 +43,8 @@ #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:use-module (ice-9 format) - #:export (root-file-system-service + #:export (fstab-service-type + root-file-system-service file-system-service user-unmount-service device-mapping-service @@ -105,6 +106,48 @@ ;;; File systems. ;;; +(define (file-system->fstab-entry file-system) + "Return a @file{/etc/fstab} entry for @var{file-system}." + (string-append (case (file-system-title file-system) + ((label) + (string-append "LABEL=" (file-system-device file-system))) + ((uuid) + (string-append + "UUID=" + (uuid->string (file-system-device file-system)))) + (else + (file-system-device file-system))) + "\t" + (file-system-mount-point file-system) "\t" + (file-system-type file-system) "\t" + (or (file-system-options file-system) "defaults") "\t" + + ;; XXX: Omit the 'fs_freq' and 'fs_passno' fields because we + ;; don't have anything sensible to put in there. + )) + +(define (file-systems->fstab file-systems) + "Return a @file{/etc} entry for an @file{fstab} describing +@var{file-systems}." + `(("fstab" ,(plain-file "fstab" + (string-append + "\ +# This file was generated from your GuixSD configuration. Any changes +# will be lost upon reboot or reconfiguration.\n\n" + (string-join (map file-system->fstab-entry + file-systems) + "\n") + "\n"))))) + +(define fstab-service-type + ;; The /etc/fstab service. + (service-type (name 'fstab) + (extensions + (list (service-extension etc-service-type + file-systems->fstab))) + (compose identity) + (extend append))) + (define %root-file-system-dmd-service (dmd-service (documentation "Take care of the root file system.") @@ -170,70 +213,79 @@ FILE-SYSTEM." ((? file-system? fs) (file-system->dmd-service-name fs)))) +(define (file-system-dmd-service file-system) + "Return a list containing the dmd service for @var{file-system}." + (let ((target (file-system-mount-point file-system)) + (device (file-system-device file-system)) + (type (file-system-type file-system)) + (title (file-system-title file-system)) + (check? (file-system-check? file-system)) + (create? (file-system-create-mount-point? file-system)) + (dependencies (file-system-dependencies file-system))) + (if (file-system-mount? file-system) + (list + (dmd-service + (provision (list (file-system->dmd-service-name file-system))) + (requirement `(root-file-system + ,@(map dependency->dmd-service-name dependencies))) + (documentation "Check, mount, and unmount the given file system.") + (start #~(lambda args + ;; FIXME: Use or factorize with 'mount-file-system'. + (let ((device (canonicalize-device-spec #$device '#$title)) + (flags #$(mount-flags->bit-mask + (file-system-flags file-system)))) + #$(if create? + #~(mkdir-p #$target) + #~#t) + #$(if check? + #~(begin + ;; Make sure fsck.ext2 & co. can be found. + (setenv "PATH" + (string-append + #$e2fsprogs "/sbin:" + "/run/current-system/profile/sbin:" + (getenv "PATH"))) + (check-file-system device #$type)) + #~#t) + + (mount device #$target #$type flags + #$(file-system-options file-system)) + + ;; For read-only bind mounts, an extra remount is + ;; needed, as per <http://lwn.net/Articles/281157/>, + ;; which still applies to Linux 4.0. + (when (and (= MS_BIND (logand flags MS_BIND)) + (= MS_RDONLY (logand flags MS_RDONLY))) + (mount device #$target #$type + (logior MS_BIND MS_REMOUNT MS_RDONLY)))) + #t)) + (stop #~(lambda args + ;; Normally there are no processes left at this point, so + ;; TARGET can be safely unmounted. + + ;; Make sure PID 1 doesn't keep TARGET busy. + (chdir "/") + + (umount #$target) + #f)) + + ;; We need an additional module. + (modules `(((gnu build file-systems) + #:select (check-file-system canonicalize-device-spec)) + ,@%default-modules)) + (imported-modules `((gnu build file-systems) + ,@%default-imported-modules)))) + '()))) + (define file-system-service-type ;; TODO(?): Make this an extensible service that takes <file-system> objects ;; and returns a list of <dmd-service>. - (dmd-service-type - 'file-system - (lambda (file-system) - (let ((target (file-system-mount-point file-system)) - (device (file-system-device file-system)) - (type (file-system-type file-system)) - (title (file-system-title file-system)) - (check? (file-system-check? file-system)) - (create? (file-system-create-mount-point? file-system)) - (dependencies (file-system-dependencies file-system))) - (dmd-service - (provision (list (file-system->dmd-service-name file-system))) - (requirement `(root-file-system - ,@(map dependency->dmd-service-name dependencies))) - (documentation "Check, mount, and unmount the given file system.") - (start #~(lambda args - ;; FIXME: Use or factorize with 'mount-file-system'. - (let ((device (canonicalize-device-spec #$device '#$title)) - (flags #$(mount-flags->bit-mask - (file-system-flags file-system)))) - #$(if create? - #~(mkdir-p #$target) - #~#t) - #$(if check? - #~(begin - ;; Make sure fsck.ext2 & co. can be found. - (setenv "PATH" - (string-append - #$e2fsprogs "/sbin:" - "/run/current-system/profile/sbin:" - (getenv "PATH"))) - (check-file-system device #$type)) - #~#t) - - (mount device #$target #$type flags - #$(file-system-options file-system)) - - ;; For read-only bind mounts, an extra remount is needed, - ;; as per <http://lwn.net/Articles/281157/>, which still - ;; applies to Linux 4.0. - (when (and (= MS_BIND (logand flags MS_BIND)) - (= MS_RDONLY (logand flags MS_RDONLY))) - (mount device #$target #$type - (logior MS_BIND MS_REMOUNT MS_RDONLY)))) - #t)) - (stop #~(lambda args - ;; Normally there are no processes left at this point, so - ;; TARGET can be safely unmounted. - - ;; Make sure PID 1 doesn't keep TARGET busy. - (chdir "/") - - (umount #$target) - #f)) - - ;; We need an additional module. - (modules `(((gnu build file-systems) - #:select (check-file-system canonicalize-device-spec)) - ,@%default-modules)) - (imported-modules `((gnu build file-systems) - ,@%default-imported-modules))))))) + (service-type (name 'file-system) + (extensions + (list (service-extension dmd-root-service-type + file-system-dmd-service) + (service-extension fstab-service-type + identity))))) (define* (file-system-service file-system) "Return a service that mounts @var{file-system}, a @code{<file-system>} @@ -367,7 +419,7 @@ services corresponding to FILE-SYSTEMS. All the services that spawn processes must depend on this one so that they are stopped before 'kill' is called." (service user-processes-service-type - (list file-systems grace-delay))) + (list (filter file-system-mount? file-systems) grace-delay))) ;;; diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm new file mode 100644 index 0000000000..f49a4a4341 --- /dev/null +++ b/gnu/services/mail.scm @@ -0,0 +1,1692 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Andy Wingo <wingo@igalia.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 GNU Guix. If not, see <http://www.gnu.org/licenses/>. +;;; +;;; Some of the help text was taken from the default dovecot.conf files. + +(define-module (gnu services mail) + #:use-module (gnu services) + #:use-module (gnu services base) + #:use-module (gnu services dmd) + #:use-module (gnu system pam) + #:use-module (gnu system shadow) + #:use-module (gnu packages mail) + #:use-module (gnu packages admin) + #:use-module (gnu packages tls) + #:use-module (guix records) + #:use-module (guix packages) + #:use-module (guix gexp) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (ice-9 match) + #:export (&dovecot-configuation-error + dovecot-configuration-error? + + dovecot-service + dovecot-configuration + opaque-dovecot-configuration + + dict-configuration + passdb-configuration + userdb-configuration + unix-listener-configuration + fifo-listener-configuration + inet-listener-configuration + service-configuration + protocol-configuration + plugin-configuration + mailbox-configuration + namespace-configuration)) + +;;; Commentary: +;;; +;;; This module provides service definitions for the Dovecot POP3 and IMAP +;;; mail server. +;;; +;;; Code: + +(define-condition-type &dovecot-configuration-error &error + dovecot-configuration-error?) + +(define (dovecot-error message) + (raise (condition (&message (message message)) + (&dovecot-configuration-error)))) +(define (dovecot-configuration-field-error field val) + (dovecot-error + (format #f "Invalid value for field ~a: ~s" field val))) +(define (dovecot-configuration-missing-field kind field) + (dovecot-error + (format #f "~a configuration missing required field ~a" kind field))) + +(define-record-type* <configuration-field> + configuration-field make-configuration-field configuration-field? + (name configuration-field-name) + (type configuration-field-type) + (getter configuration-field-getter) + (predicate configuration-field-predicate) + (serializer configuration-field-serializer) + (default-value-thunk configuration-field-default-value-thunk) + (documentation configuration-field-documentation)) + +(define-syntax define-configuration + (lambda (stx) + (define (id ctx part . parts) + (let ((part (syntax->datum part))) + (datum->syntax + ctx + (match parts + (() part) + (parts (symbol-append part + (syntax->datum (apply id ctx parts)))))))) + (syntax-case stx () + ((_ stem (field (field-type def) doc) ...) + (with-syntax (((field-getter ...) + (map (lambda (field) + (id #'stem #'stem #'- field)) + #'(field ...))) + ((field-predicate ...) + (map (lambda (type) + (id #'stem type #'?)) + #'(field-type ...))) + ((field-serializer ...) + (map (lambda (type) + (id #'stem #'serialize- type)) + #'(field-type ...)))) + #`(begin + (define-record-type* #,(id #'stem #'< #'stem #'>) + stem #,(id #'stem #'make- #'stem) #,(id #'stem #'stem #'?) + (field field-getter (default def)) + ...) + (define #,(id #'stem #'stem #'-fields) + (list (configuration-field + (name 'field) + (type 'field-type) + (getter field-getter) + (predicate field-predicate) + (serializer field-serializer) + (default-value-thunk (lambda () def)) + (documentation doc)) + ...)))))))) + +(define (serialize-configuration config fields) + (for-each (lambda (field) + ((configuration-field-serializer field) + (configuration-field-name field) + ((configuration-field-getter field) config))) + fields)) + +(define (validate-configuration config fields) + (for-each (lambda (field) + (let ((val ((configuration-field-getter field) config))) + (unless ((configuration-field-predicate field) val) + (dovecot-configuration-field-error + (configuration-field-name field) val)))) + fields)) + +(define (validate-package field-name package) + (unless (package? package) + (dovecot-configuration-field-error field-name package))) + +(define (uglify-field-name field-name) + (let ((str (symbol->string field-name))) + (string-join (string-split (if (string-suffix? "?" str) + (substring str 0 (1- (string-length str))) + str) + #\-) + "_"))) + +(define (serialize-package field-name val) + #f) + +(define (serialize-field field-name val) + (format #t "~a=~a\n" (uglify-field-name field-name) val)) + +(define (serialize-string field-name val) + (serialize-field field-name val)) + +(define (space-separated-string-list? val) + (and (list? val) + (and-map (lambda (x) + (and (string? x) (not (string-index x #\space)))) + val))) +(define (serialize-space-separated-string-list field-name val) + (serialize-field field-name (string-join val " "))) + +(define (comma-separated-string-list? val) + (and (list? val) + (and-map (lambda (x) + (and (string? x) (not (string-index x #\,)))) + val))) +(define (serialize-comma-separated-string-list field-name val) + (serialize-field field-name (string-join val ","))) + +(define (file-name? val) + (and (string? val) + (string-prefix? "/" val))) +(define (serialize-file-name field-name val) + (serialize-string field-name val)) + +(define (colon-separated-file-name-list? val) + (and (list? val) + ;; Trailing slashes not needed and not + (and-map file-name? val))) +(define (serialize-colon-separated-file-name-list field-name val) + (serialize-field field-name (string-join val ":"))) + +(define (serialize-boolean field-name val) + (serialize-string field-name (if val "yes" "no"))) + +(define (non-negative-integer? val) + (and (exact-integer? val) (not (negative? val)))) +(define (serialize-non-negative-integer field-name val) + (serialize-field field-name val)) + +(define (hours? val) (non-negative-integer? val)) +(define (serialize-hours field-name val) + (serialize-field field-name (format #f "~a hours" val))) + +(define (free-form-fields? val) + (match val + (() #t) + ((((? symbol?) . (? string)) . val) (free-form-fields? val)) + (_ #f))) +(define (serialize-free-form-fields field-name val) + (for-each (match-lambda ((k . v) (serialize-field k v))) val)) + +(define (free-form-args? val) + (match val + (() #t) + ((((? symbol?) . (? string)) . val) (free-form-args? val)) + (_ #f))) +(define (serialize-free-form-args field-name val) + (serialize-field field-name + (string-join + (map (match-lambda ((k . v) (format #t "~a=~a" k v))) val) + " "))) + +(define-configuration dict-configuration + (entries + (free-form-fields '()) + "A list of key-value pairs that this dict should hold.")) + +(define (serialize-dict-configuration field-name val) + (format #t "dict {\n") + (serialize-configuration val dict-configuration-fields) + (format #t "}\n")) + +(define-configuration passdb-configuration + (driver + (string "pam") + "The driver that the passdb should use. Valid values include +@samp{pam}, @samp{passwd}, @samp{shadow}, @samp{bsdauth}, and +@samp{static}.") + (args + (free-form-args '()) + "A list of key-value args to the passdb driver.")) + +(define (serialize-passdb-configuration field-name val) + (format #t "passdb {\n") + (serialize-configuration val passdb-configuration-fields) + (format #t "}\n")) +(define (passdb-configuration-list? val) + (and (list? val) (and-map passdb-configuration? val))) +(define (serialize-passdb-configuration-list field-name val) + (for-each (lambda (val) (serialize-passdb-configuration field-name val)) val)) + +(define-configuration userdb-configuration + (driver + (string "passwd") + "The driver that the userdb should use. Valid values include +@samp{passwd} and @samp{static}.") + (args + (free-form-args '()) + "A list of key-value args to the userdb driver.") + (override-fields + (free-form-args '()) + "Override fields from passwd.")) + +(define (serialize-userdb-configuration field-name val) + (format #t "userdb {\n") + (serialize-configuration val userdb-configuration-fields) + (format #t "}\n")) +(define (userdb-configuration-list? val) + (and (list? val) (and-map userdb-configuration? val))) +(define (serialize-userdb-configuration-list field-name val) + (for-each (lambda (val) (serialize-userdb-configuration field-name val)) val)) + +(define-configuration unix-listener-configuration + (path + (file-name (dovecot-configuration-missing-field 'unix-listener 'path)) + "The file name on which to listen.") + (mode + (string "0600") + "The access mode for the socket.") + (user + (string "") + "The user to own the the socket.") + (group + (string "") + "The group to own the socket.")) + +(define (serialize-unix-listener-configuration field-name val) + (format #t "unix_listener ~a {\n" (unix-listener-configuration-path val)) + (serialize-configuration val (cdr unix-listener-configuration-fields)) + (format #t "}\n")) + +(define-configuration fifo-listener-configuration + (path + (file-name (dovecot-configuration-missing-field 'fifo-listener 'path)) + "The file name on which to listen.") + (mode + (string "0600") + "The access mode for the socket.") + (user + (string "") + "The user to own the the socket.") + (group + (string "") + "The group to own the socket.")) + +(define (serialize-fifo-listener-configuration field-name val) + (format #t "fifo_listener ~a {\n" (fifo-listener-configuration-path val)) + (serialize-configuration val (cdr fifo-listener-configuration-fields)) + (format #t "}\n")) + +(define-configuration inet-listener-configuration + (protocol + (string (dovecot-configuration-missing-field 'inet-listener 'protocol)) + "The protocol to listen for.") + (address + (string "") + "The address on which to listen, or empty for all addresses.") + (port + (non-negative-integer + (dovecot-configuration-missing-field 'inet-listener 'port)) + "The port on which to listen.") + (ssl? + (boolean #t) + "Whether to use SSL for this service; @samp{yes}, @samp{no}, or +@samp{required}.")) + +(define (serialize-inet-listener-configuration field-name val) + (format #t "inet_listener ~a {\n" (inet-listener-configuration-protocol val)) + (serialize-configuration val (cdr inet-listener-configuration-fields)) + (format #t "}\n")) + +(define (listener-configuration? val) + (or (unix-listener-configuration? val) + (fifo-listener-configuration? val) + (inet-listener-configuration? val))) +(define (serialize-listener-configuration field-name val) + (cond + ((unix-listener-configuration? val) + (serialize-unix-listener-configuration field-name val)) + ((fifo-listener-configuration? val) + (serialize-fifo-listener-configuration field-name val)) + ((inet-listener-configuration? val) + (serialize-inet-listener-configuration field-name val)) + (else (dovecot-configuration-field-error field-name val)))) +(define (listener-configuration-list? val) + (and (list? val) (and-map listener-configuration? val))) +(define (serialize-listener-configuration-list field-name val) + (for-each (lambda (val) + (serialize-listener-configuration field-name val)) + val)) + +(define-configuration service-configuration + (kind + (string (dovecot-configuration-missing-field 'service 'kind)) + "The service kind. Valid values include @code{director}, +@code{imap-login}, @code{pop3-login}, @code{lmtp}, @code{imap}, +@code{pop3}, @code{auth}, @code{auth-worker}, @code{dict}, +@code{tcpwrap}, @code{quota-warning}, or anything else.") + (listeners + (listener-configuration-list '()) + "Listeners for the service. A listener is either an +@code{unix-listener-configuration}, a @code{fifo-listener-configuration}, or +an @code{inet-listener-configuration}.") + (service-count + (non-negative-integer 1) + "Number of connections to handle before starting a new process. +Typically the only useful values are 0 (unlimited) or 1. 1 is more +secure, but 0 is faster. <doc/wiki/LoginProcess.txt>.") + (process-min-avail + (non-negative-integer 0) + "Number of processes to always keep waiting for more connections.") + ;; FIXME: Need to be able to take the default for this value from other + ;; parts of the config. + (vsz-limit + (non-negative-integer #e256e6) + "If you set @samp{service-count 0}, you probably need to grow +this.")) + +(define (serialize-service-configuration field-name val) + (format #t "service ~a {\n" (service-configuration-kind val)) + (serialize-configuration val (cdr service-configuration-fields)) + (format #t "}\n")) +(define (service-configuration-list? val) + (and (list? val) (and-map service-configuration? val))) +(define (serialize-service-configuration-list field-name val) + (for-each (lambda (val) + (serialize-service-configuration field-name val)) + val)) + +(define-configuration protocol-configuration + (name + (string (dovecot-configuration-missing-field 'protocol 'name)) + "The name of the protocol.") + (auth-socket-path + (string "/var/run/dovecot/auth-userdb") + "UNIX socket path to master authentication server to find users. +This is used by imap (for shared users) and lda.") + (mail-plugins + (space-separated-string-list '("$mail_plugins")) + "Space separated list of plugins to load.") + (mail-max-userip-connections + (non-negative-integer 10) + "Maximum number of IMAP connections allowed for a user from each IP +address. NOTE: The username is compared case-sensitively.")) + +(define (serialize-protocol-configuration field-name val) + (format #t "protocol ~a {\n" (protocol-configuration-name val)) + (serialize-configuration val (cdr protocol-configuration-fields)) + (format #t "}\n")) +(define (protocol-configuration-list? val) + (and (list? val) (and-map protocol-configuration? val))) +(define (serialize-protocol-configuration-list field-name val) + (serialize-field 'protocols + (string-join (map protocol-configuration-name val) " ")) + (for-each (lambda (val) + (serialize-protocol-configuration field-name val)) + val)) + +(define-configuration plugin-configuration + (entries + (free-form-fields '()) + "A list of key-value pairs that this dict should hold.")) + +(define (serialize-plugin-configuration field-name val) + (format #t "plugin {\n") + (serialize-configuration val plugin-configuration-fields) + (format #t "}\n")) + +(define-configuration mailbox-configuration + (name + (string (error "mailbox name is required")) + "Name for this mailbox.") + + (auto + (string "no") + "@samp{create} will automatically create this mailbox. +@samp{subscribe} will both create and subscribe to the mailbox.") + + (special-use + (space-separated-string-list '()) + "List of IMAP @code{SPECIAL-USE} attributes as specified by RFC 6154. +Valid values are @code{\\All}, @code{\\Archive}, @code{\\Drafts}, +@code{\\Flagged}, @code{\\Junk}, @code{\\Sent}, and @code{\\Trash}.")) + +(define (serialize-mailbox-configuration field-name val) + (format #t "mailbox \"~a\" {\n" (mailbox-configuration-name val)) + (serialize-configuration val (cdr mailbox-configuration-fields)) + (format #t "}\n")) +(define (mailbox-configuration-list? val) + (and (list? val) (and-map mailbox-configuration? val))) +(define (serialize-mailbox-configuration-list field-name val) + (for-each (lambda (val) + (serialize-mailbox-configuration field-name val)) + val)) + +(define-configuration namespace-configuration + (name + (string (error "namespace name is required")) + "Name for this namespace.") + + (type + (string "private") + "Namespace type: @samp{private}, @samp{shared} or @samp{public}.") + + (separator + (string "") + "Hierarchy separator to use. You should use the same separator for +all namespaces or some clients get confused. @samp{/} is usually a good +one. The default however depends on the underlying mail storage +format.") + + (prefix + (string "") + "Prefix required to access this namespace. This needs to be +different for all namespaces. For example @samp{Public/}.") + + (location + (string "") + "Physical location of the mailbox. This is in same format as +mail_location, which is also the default for it.") + + (inbox? + (boolean #f) + "There can be only one INBOX, and this setting defines which +namespace has it.") + + (hidden? + (boolean #f) + "If namespace is hidden, it's not advertised to clients via NAMESPACE +extension. You'll most likely also want to set @samp{list? #f}. This is mostly +useful when converting from another server with different namespaces +which you want to deprecate but still keep working. For example you can +create hidden namespaces with prefixes @samp{~/mail/}, @samp{~%u/mail/} +and @samp{mail/}.") + + (list? + (boolean #t) + "Show the mailboxes under this namespace with LIST command. This +makes the namespace visible for clients that don't support NAMESPACE +extension. The special @code{children} value lists child mailboxes, but +hides the namespace prefix.") + + (subscriptions? + (boolean #t) + "Namespace handles its own subscriptions. If set to @code{#f}, the +parent namespace handles them. The empty prefix should always have this +as @code{#t}.)") + + (mailboxes + (mailbox-configuration-list '()) + "List of predefined mailboxes in this namespace.")) + +(define (serialize-namespace-configuration field-name val) + (format #t "namespace ~a {\n" (namespace-configuration-name val)) + (serialize-configuration val (cdr namespace-configuration-fields)) + (format #t "}\n")) +(define (list-of-namespace-configuration? val) + (and (list? val) (and-map namespace-configuration? val))) +(define (serialize-list-of-namespace-configuration field-name val) + (for-each (lambda (val) + (serialize-namespace-configuration field-name val)) + val)) + +(define-configuration dovecot-configuration + (dovecot + (package dovecot) + "The dovecot package.") + + (listen + (comma-separated-string-list '("*" "::")) + "A list of IPs or hosts where to listen in for connections. @samp{*} +listens in all IPv4 interfaces, @samp{::} listens in all IPv6 +interfaces. If you want to specify non-default ports or anything more +complex, customize the address and port fields of the +@samp{inet-listener} of the specific services you are interested in.") + + (protocols + (protocol-configuration-list + (list (protocol-configuration + (name "imap")))) + "List of protocols we want to serve. Available protocols include +@samp{imap}, @samp{pop3}, and @samp{lmtp}.") + + (services + (service-configuration-list + (list + (service-configuration + (kind "imap-login") + (listeners + (list + (inet-listener-configuration (protocol "imap") (port 143) (ssl? #f)) + (inet-listener-configuration (protocol "imaps") (port 993) (ssl? #t))))) + (service-configuration + (kind "pop3-login") + (listeners + (list + (inet-listener-configuration (protocol "pop3") (port 110) (ssl? #f)) + (inet-listener-configuration (protocol "pop3s") (port 995) (ssl? #t))))) + (service-configuration + (kind "lmtp") + (listeners + (list (unix-listener-configuration (path "lmtp") (mode "0666"))))) + (service-configuration (kind "imap")) + (service-configuration (kind "pop3")) + (service-configuration (kind "auth") + ;; In what could be taken to be a bug, the default value of 1 for + ;; service-count makes it so that a PAM auth worker can't fork off + ;; subprocesses for making blocking queries. The result is that nobody + ;; can log in -- very secure, but not very useful! If we simply omit + ;; the service-count, it will default to the value of + ;; auth-worker-max-count, which is 30, instead of defaulting to 1, which + ;; is the default for all other services. As a hack, bump this value to + ;; 30. + (service-count 30) + (listeners + (list (unix-listener-configuration (path "auth-userdb"))))) + (service-configuration (kind "auth-worker")) + (service-configuration (kind "dict") + (listeners (list (unix-listener-configuration (path "dict"))))))) + "List of services to enable. Available services include @samp{imap}, +@samp{imap-login}, @samp{pop3}, @samp{pop3-login}, @samp{auth}, and +@samp{lmtp}.") + + (dict + (dict-configuration (dict-configuration)) + "Dict configuration, as created by the @code{dict-configuration} +constructor.") + + (passdbs + (passdb-configuration-list (list (passdb-configuration (driver "pam")))) + "List of passdb configurations, each one created by the +@code{passdb-configuration} constructor.") + + (userdbs + (userdb-configuration-list (list (userdb-configuration (driver "passwd")))) + "List of userdb configurations, each one created by the +@code{userdb-configuration} constructor.") + + (plugin-configuration + (plugin-configuration (plugin-configuration)) + "Plug-in configuration, created by the @code{plugin-configuration} +constructor.") + + (namespaces + (list-of-namespace-configuration + (list + (namespace-configuration + (name "inbox") + (prefix "") + (inbox? #t) + (mailboxes + (list + (mailbox-configuration (name "Drafts") (special-use '("\\Drafts"))) + (mailbox-configuration (name "Junk") (special-use '("\\Junk"))) + (mailbox-configuration (name "Trash") (special-use '("\\Trash"))) + (mailbox-configuration (name "Sent") (special-use '("\\Sent"))) + (mailbox-configuration (name "Sent Messages") (special-use '("\\Sent"))) + (mailbox-configuration (name "Drafts") (special-use '("\\Drafts")))))))) + "List of namespaces. Each item in the list is created by the +@code{namespace-configuration} constructor.") + + (base-dir + (file-name "/var/run/dovecot/") + "Base directory where to store runtime data.") + + (login-greeting + (string "Dovecot ready.") + "Greeting message for clients.") + + (login-trusted-networks + (space-separated-string-list '()) + "List of trusted network ranges. Connections from these IPs are +allowed to override their IP addresses and ports (for logging and for +authentication checks). @samp{disable-plaintext-auth} is also ignored +for these networks. Typically you'd specify your IMAP proxy servers +here.") + + (login-access-sockets + (space-separated-string-list '()) + "List of login access check sockets (e.g. tcpwrap).") + + (verbose-proctitle? + (boolean #f) + "Show more verbose process titles (in ps). Currently shows user name +and IP address. Useful for seeing who are actually using the IMAP +processes (e.g. shared mailboxes or if same uid is used for multiple +accounts).") + + (shutdown-clients? + (boolean #t) + "Should all processes be killed when Dovecot master process shuts down. +Setting this to @code{#f} means that Dovecot can be upgraded without +forcing existing client connections to close (although that could also +be a problem if the upgrade is e.g. because of a security fix).") + + (doveadm-worker-count + (non-negative-integer 0) + "If non-zero, run mail commands via this many connections to doveadm +server, instead of running them directly in the same process.") + + (doveadm-socket-path + (string "doveadm-server") + "UNIX socket or host:port used for connecting to doveadm server.") + + (import-environment + (space-separated-string-list '("TZ")) + "List of environment variables that are preserved on Dovecot startup +and passed down to all of its child processes. You can also give +key=value pairs to always set specific settings.") + +;;; Authentication processes + + (disable-plaintext-auth? + (boolean #t) + "Disable LOGIN command and all other plaintext authentications unless +SSL/TLS is used (LOGINDISABLED capability). Note that if the remote IP +matches the local IP (i.e. you're connecting from the same computer), +the connection is considered secure and plaintext authentication is +allowed. See also ssl=required setting.") + + (auth-cache-size + (non-negative-integer 0) + "Authentication cache size (e.g. @samp{#e10e6}). 0 means it's disabled. +Note that bsdauth, PAM and vpopmail require @samp{cache-key} to be set +for caching to be used.") + + (auth-cache-ttl + (string "1 hour") + "Time to live for cached data. After TTL expires the cached record +is no longer used, *except* if the main database lookup returns internal +failure. We also try to handle password changes automatically: If +user's previous authentication was successful, but this one wasn't, the +cache isn't used. For now this works only with plaintext +authentication.") + + (auth-cache-negative-ttl + (string "1 hour") + "TTL for negative hits (user not found, password mismatch). +0 disables caching them completely.") + + (auth-realms + (space-separated-string-list '()) + "List of realms for SASL authentication mechanisms that need them. +You can leave it empty if you don't want to support multiple realms. +Many clients simply use the first one listed here, so keep the default +realm first.") + + (auth-default-realm + (string "") + "Default realm/domain to use if none was specified. This is used for +both SASL realms and appending @@domain to username in plaintext +logins.") + + (auth-username-chars + (string + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ01234567890.-_@") + "List of allowed characters in username. If the user-given username +contains a character not listed in here, the login automatically fails. +This is just an extra check to make sure user can't exploit any +potential quote escaping vulnerabilities with SQL/LDAP databases. If +you want to allow all characters, set this value to empty.") + + (auth-username-translation + (string "") + "Username character translations before it's looked up from +databases. The value contains series of from -> to characters. For +example @samp{#@@/@@} means that @samp{#} and @samp{/} characters are +translated to @samp{@@}.") + + (auth-username-format + (string "%Lu") + "Username formatting before it's looked up from databases. You can +use the standard variables here, e.g. %Lu would lowercase the username, +%n would drop away the domain if it was given, or @samp{%n-AT-%d} would +change the @samp{@@} into @samp{-AT-}. This translation is done after +@samp{auth-username-translation} changes.") + + (auth-master-user-separator + (string "") + "If you want to allow master users to log in by specifying the master +username within the normal username string (i.e. not using SASL +mechanism's support for it), you can specify the separator character +here. The format is then <username><separator><master username>. +UW-IMAP uses @samp{*} as the separator, so that could be a good +choice.") + + (auth-anonymous-username + (string "anonymous") + "Username to use for users logging in with ANONYMOUS SASL +mechanism.") + + (auth-worker-max-count + (non-negative-integer 30) + "Maximum number of dovecot-auth worker processes. They're used to +execute blocking passdb and userdb queries (e.g. MySQL and PAM). +They're automatically created and destroyed as needed.") + + (auth-gssapi-hostname + (string "") + "Host name to use in GSSAPI principal names. The default is to use +the name returned by gethostname(). Use @samp{$ALL} (with quotes) to +allow all keytab entries.") + + (auth-krb5-keytab + (string "") + "Kerberos keytab to use for the GSSAPI mechanism. Will use the +system default (usually /etc/krb5.keytab) if not specified. You may +need to change the auth service to run as root to be able to read this +file.") + + (auth-use-winbind? + (boolean #f) + "Do NTLM and GSS-SPNEGO authentication using Samba's winbind daemon +and @samp{ntlm-auth} helper. +<doc/wiki/Authentication/Mechanisms/Winbind.txt>.") + + (auth-winbind-helper-path + (file-name "/usr/bin/ntlm_auth") + "Path for Samba's @samp{ntlm-auth} helper binary.") + + (auth-failure-delay + (string "2 secs") + "Time to delay before replying to failed authentications.") + + (auth-ssl-require-client-cert? + (boolean #f) + "Require a valid SSL client certificate or the authentication +fails.") + + (auth-ssl-username-from-cert? + (boolean #f) + "Take the username from client's SSL certificate, using +@code{X509_NAME_get_text_by_NID()} which returns the subject's DN's +CommonName.") + + (auth-mechanisms + (space-separated-string-list '("plain")) + "List of wanted authentication mechanisms. Supported mechanisms are: +@samp{plain}, @samp{login}, @samp{digest-md5}, @samp{cram-md5}, +@samp{ntlm}, @samp{rpa}, @samp{apop}, @samp{anonymous}, @samp{gssapi}, +@samp{otp}, @samp{skey}, and @samp{gss-spnego}. NOTE: See also +@samp{disable-plaintext-auth} setting.") + + (director-servers + (space-separated-string-list '()) + "List of IPs or hostnames to all director servers, including ourself. +Ports can be specified as ip:port. The default port is the same as what +director service's @samp{inet-listener} is using.") + + (director-mail-servers + (space-separated-string-list '()) + "List of IPs or hostnames to all backend mail servers. Ranges are +allowed too, like 10.0.0.10-10.0.0.30.") + + (director-user-expire + (string "15 min") + "How long to redirect users to a specific server after it no longer +has any connections.") + + (director-doveadm-port + (non-negative-integer 0) + "TCP/IP port that accepts doveadm connections (instead of director +connections) If you enable this, you'll also need to add +@samp{inet-listener} for the port.") + + (director-username-hash + (string "%Lu") + "How the username is translated before being hashed. Useful values +include %Ln if user can log in with or without @@domain, %Ld if mailboxes +are shared within domain.") + +;;; Log destination. + + (log-path + (string "syslog") + "Log file to use for error messages. @samp{syslog} logs to syslog, +@samp{/dev/stderr} logs to stderr.") + + (info-log-path + (string "") + "Log file to use for informational messages. Defaults to +@samp{log-path}.") + + (debug-log-path + (string "") + "Log file to use for debug messages. Defaults to +@samp{info-log-path}.") + + (syslog-facility + (string "mail") + "Syslog facility to use if you're logging to syslog. Usually if you +don't want to use @samp{mail}, you'll use local0..local7. Also other +standard facilities are supported.") + + (auth-verbose? + (boolean #f) + "Log unsuccessful authentication attempts and the reasons why they +failed.") + + (auth-verbose-passwords? + (boolean #f) + "In case of password mismatches, log the attempted password. Valid +values are no, plain and sha1. sha1 can be useful for detecting brute +force password attempts vs. user simply trying the same password over +and over again. You can also truncate the value to n chars by appending +\":n\" (e.g. sha1:6).") + + (auth-debug? + (boolean #f) + "Even more verbose logging for debugging purposes. Shows for example +SQL queries.") + + (auth-debug-passwords? + (boolean #f) + "In case of password mismatches, log the passwords and used scheme so +the problem can be debugged. Enabling this also enables +@samp{auth-debug}.") + + (mail-debug? + (boolean #f) + "Enable mail process debugging. This can help you figure out why +Dovecot isn't finding your mails.") + + (verbose-ssl? + (boolean #f) + "Show protocol level SSL errors.") + + (log-timestamp + (string "\"%b %d %H:%M:%S \"") + "Prefix for each line written to log file. % codes are in +strftime(3) format.") + + (login-log-format-elements + (space-separated-string-list + '("user=<%u>" "method=%m" "rip=%r" "lip=%l" "mpid=%e" "%c")) + "List of elements we want to log. The elements which have a +non-empty variable value are joined together to form a comma-separated +string.") + + (login-log-format + (string "%$: %s") + "Login log format. %s contains @samp{login-log-format-elements} +string, %$ contains the data we want to log.") + + (mail-log-prefix + (string "\"%s(%u): \"") + "Log prefix for mail processes. See doc/wiki/Variables.txt for list +of possible variables you can use.") + + (deliver-log-format + (string "msgid=%m: %$") + "Format to use for logging mail deliveries. You can use variables: +@table @code +@item %$ +Delivery status message (e.g. @samp{saved to INBOX}) +@item %m +Message-ID +@item %s +Subject +@item %f +From address +@item %p +Physical size +@item %w +Virtual size. +@end table") + +;;; Mailbox locations and namespaces + + (mail-location + (string "") + "Location for users' mailboxes. The default is empty, which means +that Dovecot tries to find the mailboxes automatically. This won't work +if the user doesn't yet have any mail, so you should explicitly tell +Dovecot the full location. + +If you're using mbox, giving a path to the INBOX +file (e.g. /var/mail/%u) isn't enough. You'll also need to tell Dovecot +where the other mailboxes are kept. This is called the \"root mail +directory\", and it must be the first path given in the +@samp{mail-location} setting. + +There are a few special variables you can use, eg.: + +@table @samp +@item %u +username +@item %n +user part in user@@domain, same as %u if there's no domain +@item %d +domain part in user@@domain, empty if there's no domain +@item %h +home director +@end table + +See doc/wiki/Variables.txt for full list. Some examples: +@table @samp +@item maildir:~/Maildir +@item mbox:~/mail:INBOX=/var/mail/%u +@item mbox:/var/mail/%d/%1n/%n:INDEX=/var/indexes/%d/%1n/% +@end table") + + (mail-uid + (string "") + "System user and group used to access mails. If you use multiple, +userdb can override these by returning uid or gid fields. You can use +either numbers or names. <doc/wiki/UserIds.txt>.") + + (mail-gid + (string "") + "") + + (mail-privileged-group + (string "") + "Group to enable temporarily for privileged operations. Currently +this is used only with INBOX when either its initial creation or +dotlocking fails. Typically this is set to \"mail\" to give access to +/var/mail.") + + (mail-access-groups + (string "") + "Grant access to these supplementary groups for mail processes. +Typically these are used to set up access to shared mailboxes. Note +that it may be dangerous to set these if users can create +symlinks (e.g. if \"mail\" group is set here, ln -s /var/mail ~/mail/var +could allow a user to delete others' mailboxes, or ln -s +/secret/shared/box ~/mail/mybox would allow reading it).") + + (mail-full-filesystem-access? + (boolean #f) + "Allow full filesystem access to clients. There's no access checks +other than what the operating system does for the active UID/GID. It +works with both maildir and mboxes, allowing you to prefix mailboxes +names with e.g. /path/ or ~user/.") + +;;; Mail processes + + (mmap-disable? + (boolean #f) + "Don't use mmap() at all. This is required if you store indexes to +shared filesystems (NFS or clustered filesystem).") + + (dotlock-use-excl? + (boolean #t) + "Rely on @samp{O_EXCL} to work when creating dotlock files. NFS +supports @samp{O_EXCL} since version 3, so this should be safe to use +nowadays by default.") + + (mail-fsync + (string "optimized") + "When to use fsync() or fdatasync() calls: +@table @code +@item optimized +Whenever necessary to avoid losing important data +@item always +Useful with e.g. NFS when write()s are delayed +@item never +Never use it (best performance, but crashes can lose data). +@end table") + + (mail-nfs-storage? + (boolean #f) + "Mail storage exists in NFS. Set this to yes to make Dovecot flush +NFS caches whenever needed. If you're using only a single mail server +this isn't needed.") + + (mail-nfs-index? + (boolean #f) + "Mail index files also exist in NFS. Setting this to yes requires +@samp{mmap-disable? #t} and @samp{fsync-disable? #f}.") + + (lock-method + (string "fcntl") + "Locking method for index files. Alternatives are fcntl, flock and +dotlock. Dotlocking uses some tricks which may create more disk I/O +than other locking methods. NFS users: flock doesn't work, remember to +change @samp{mmap-disable}.") + + (mail-temp-dir + (file-name "/tmp") + "Directory in which LDA/LMTP temporarily stores incoming mails >128 +kB.") + + (first-valid-uid + (non-negative-integer 500) + "Valid UID range for users. This is mostly to make sure that users can't +log in as daemons or other system users. Note that denying root logins is +hardcoded to dovecot binary and can't be done even if @samp{first-valid-uid} +is set to 0.") + + (last-valid-uid + (non-negative-integer 0) + "") + + (first-valid-gid + (non-negative-integer 1) + "Valid GID range for users. Users having non-valid GID as primary group ID +aren't allowed to log in. If user belongs to supplementary groups with +non-valid GIDs, those groups are not set.") + + (last-valid-gid + (non-negative-integer 0) + "") + + (mail-max-keyword-length + (non-negative-integer 50) + "Maximum allowed length for mail keyword name. It's only forced when +trying to create new keywords.") + + (valid-chroot-dirs + (colon-separated-file-name-list '()) + "List of directories under which chrooting is allowed for mail +processes (i.e. /var/mail will allow chrooting to /var/mail/foo/bar +too). This setting doesn't affect @samp{login-chroot} +@samp{mail-chroot} or auth chroot settings. If this setting is empty, +\"/./\" in home dirs are ignored. WARNING: Never add directories here +which local users can modify, that may lead to root exploit. Usually +this should be done only if you don't allow shell access for users. +<doc/wiki/Chrooting.txt>.") + + (mail-chroot + (string "") + "Default chroot directory for mail processes. This can be overridden +for specific users in user database by giving /./ in user's home +directory (e.g. /home/./user chroots into /home). Note that usually +there is no real need to do chrooting, Dovecot doesn't allow users to +access files outside their mail directory anyway. If your home +directories are prefixed with the chroot directory, append \"/.\" to +@samp{mail-chroot}. <doc/wiki/Chrooting.txt>.") + + (auth-socket-path + (file-name "/var/run/dovecot/auth-userdb") + "UNIX socket path to master authentication server to find users. +This is used by imap (for shared users) and lda.") + + (mail-plugin-dir + (file-name "/usr/lib/dovecot") + "Directory where to look up mail plugins.") + + (mail-plugins + (space-separated-string-list '()) + "List of plugins to load for all services. Plugins specific to IMAP, +LDA, etc. are added to this list in their own .conf files.") + + + (mail-cache-min-mail-count + (non-negative-integer 0) + "The minimum number of mails in a mailbox before updates are done to +cache file. This allows optimizing Dovecot's behavior to do less disk +writes at the cost of more disk reads.") + + (mailbox-idle-check-interval + (string "30 secs") + "When IDLE command is running, mailbox is checked once in a while to +see if there are any new mails or other changes. This setting defines +the minimum time to wait between those checks. Dovecot can also use +dnotify, inotify and kqueue to find out immediately when changes +occur.") + + (mail-save-crlf? + (boolean #f) + "Save mails with CR+LF instead of plain LF. This makes sending those +mails take less CPU, especially with sendfile() syscall with Linux and +FreeBSD. But it also creates a bit more disk I/O which may just make it +slower. Also note that if other software reads the mboxes/maildirs, +they may handle the extra CRs wrong and cause problems.") + + (maildir-stat-dirs? + (boolean #f) + "By default LIST command returns all entries in maildir beginning +with a dot. Enabling this option makes Dovecot return only entries +which are directories. This is done by stat()ing each entry, so it +causes more disk I/O. + (For systems setting struct @samp{dirent->d_type} this check is free +and it's done always regardless of this setting).") + + (maildir-copy-with-hardlinks? + (boolean #t) + "When copying a message, do it with hard links whenever possible. +This makes the performance much better, and it's unlikely to have any +side effects.") + + (maildir-very-dirty-syncs? + (boolean #f) + "Assume Dovecot is the only MUA accessing Maildir: Scan cur/ +directory only when its mtime changes unexpectedly or when we can't find +the mail otherwise.") + + (mbox-read-locks + (space-separated-string-list '("fcntl")) + "Which locking methods to use for locking mbox. There are four +available: + +@table @code +@item dotlock +Create <mailbox>.lock file. This is the oldest and most NFS-safe +solution. If you want to use /var/mail/ like directory, the users will +need write access to that directory. +@item dotlock-try +Same as dotlock, but if it fails because of permissions or because there +isn't enough disk space, just skip it. +@item fcntl +Use this if possible. Works with NFS too if lockd is used. +@item flock +May not exist in all systems. Doesn't work with NFS. +@item lockf +May not exist in all systems. Doesn't work with NFS. +@end table + +You can use multiple locking methods; if you do the order they're declared +in is important to avoid deadlocks if other MTAs/MUAs are using multiple +locking methods as well. Some operating systems don't allow using some of +them simultaneously.") + + (mbox-write-locks + (space-separated-string-list '("dotlock" "fcntl")) + "") + + (mbox-lock-timeout + (string "5 mins") + "Maximum time to wait for lock (all of them) before aborting.") + + (mbox-dotlock-change-timeout + (string "2 mins") + "If dotlock exists but the mailbox isn't modified in any way, +override the lock file after this much time.") + + (mbox-dirty-syncs? + (boolean #t) + "When mbox changes unexpectedly we have to fully read it to find out +what changed. If the mbox is large this can take a long time. Since +the change is usually just a newly appended mail, it'd be faster to +simply read the new mails. If this setting is enabled, Dovecot does +this but still safely fallbacks to re-reading the whole mbox file +whenever something in mbox isn't how it's expected to be. The only real +downside to this setting is that if some other MUA changes message +flags, Dovecot doesn't notice it immediately. Note that a full sync is +done with SELECT, EXAMINE, EXPUNGE and CHECK commands.") + + (mbox-very-dirty-syncs? + (boolean #f) + "Like @samp{mbox-dirty-syncs}, but don't do full syncs even with SELECT, +EXAMINE, EXPUNGE or CHECK commands. If this is set, +@samp{mbox-dirty-syncs} is ignored.") + + (mbox-lazy-writes? + (boolean #t) + "Delay writing mbox headers until doing a full write sync (EXPUNGE +and CHECK commands and when closing the mailbox). This is especially +useful for POP3 where clients often delete all mails. The downside is +that our changes aren't immediately visible to other MUAs.") + + (mbox-min-index-size + (non-negative-integer 0) + "If mbox size is smaller than this (e.g. 100k), don't write index +files. If an index file already exists it's still read, just not +updated.") + + (mdbox-rotate-size + (non-negative-integer #e2e6) + "Maximum dbox file size until it's rotated.") + + (mdbox-rotate-interval + (string "1d") + "Maximum dbox file age until it's rotated. Typically in days. Day +begins from midnight, so 1d = today, 2d = yesterday, etc. 0 = check +disabled.") + + (mdbox-preallocate-space? + (boolean #f) + "When creating new mdbox files, immediately preallocate their size to +@samp{mdbox-rotate-size}. This setting currently works only in Linux +with some filesystems (ext4, xfs).") + + (mail-attachment-dir + (string "") + "sdbox and mdbox support saving mail attachments to external files, +which also allows single instance storage for them. Other backends +don't support this for now. + +WARNING: This feature hasn't been tested much yet. Use at your own risk. + +Directory root where to store mail attachments. Disabled, if empty.") + + (mail-attachment-min-size + (non-negative-integer #e128e3) + "Attachments smaller than this aren't saved externally. It's also +possible to write a plugin to disable saving specific attachments +externally.") + + (mail-attachment-fs + (string "sis posix") + "Filesystem backend to use for saving attachments: +@table @code +@item posix +No SiS done by Dovecot (but this might help FS's own deduplication) +@item sis posix +SiS with immediate byte-by-byte comparison during saving +@item sis-queue posix +SiS with delayed comparison and deduplication. +@end table") + + (mail-attachment-hash + (string "%{sha1}") + "Hash format to use in attachment filenames. You can add any text and +variables: @code{%@{md4@}}, @code{%@{md5@}}, @code{%@{sha1@}}, +@code{%@{sha256@}}, @code{%@{sha512@}}, @code{%@{size@}}. Variables can be +truncated, e.g. @code{%@{sha256:80@}} returns only first 80 bits.") + + (default-process-limit + (non-negative-integer 100) + "") + + (default-client-limit + (non-negative-integer 1000) + "") + + (default-vsz-limit + (non-negative-integer #e256e6) + "Default VSZ (virtual memory size) limit for service processes. +This is mainly intended to catch and kill processes that leak memory +before they eat up everything.") + + (default-login-user + (string "dovenull") + "Login user is internally used by login processes. This is the most +untrusted user in Dovecot system. It shouldn't have access to anything +at all.") + + (default-internal-user + (string "dovecot") + "Internal user is used by unprivileged processes. It should be +separate from login user, so that login processes can't disturb other +processes.") + + (ssl? + (string "required") + "SSL/TLS support: yes, no, required. <doc/wiki/SSL.txt>.") + + (ssl-cert + (string "</etc/dovecot/default.pem") + "PEM encoded X.509 SSL/TLS certificate (public key).") + + (ssl-key + (string "</etc/dovecot/private/default.pem") + "PEM encoded SSL/TLS private key. The key is opened before +dropping root privileges, so keep the key file unreadable by anyone but +root.") + + (ssl-key-password + (string "") + "If key file is password protected, give the password here. +Alternatively give it when starting dovecot with -p parameter. Since +this file is often world-readable, you may want to place this setting +instead to a different.") + + (ssl-ca + (string "") + "PEM encoded trusted certificate authority. Set this only if you +intend to use @samp{ssl-verify-client-cert? #t}. The file should +contain the CA certificate(s) followed by the matching +CRL(s). (e.g. @samp{ssl-ca </etc/ssl/certs/ca.pem}).") + (ssl-require-crl? + (boolean #t) + "Require that CRL check succeeds for client certificates.") + (ssl-verify-client-cert? + (boolean #f) + "Request client to send a certificate. If you also want to require +it, set @samp{auth-ssl-require-client-cert? #t} in auth section.") + + (ssl-cert-username-field + (string "commonName") + "Which field from certificate to use for username. commonName and +x500UniqueIdentifier are the usual choices. You'll also need to set +@samp{auth-ssl-username-from-cert? #t}.") + + (ssl-parameters-regenerate + (hours 168) + "How often to regenerate the SSL parameters file. Generation is +quite CPU intensive operation. The value is in hours, 0 disables +regeneration entirely.") + + (ssl-protocols + (string "!SSLv2") + "SSL protocols to use.") + + (ssl-cipher-list + (string "ALL:!LOW:!SSLv2:!EXP:!aNULL") + "SSL ciphers to use.") + + (ssl-crypto-device + (string "") + "SSL crypto device to use, for valid values run \"openssl engine\".") + + (postmaster-address + (string "") + "Address to use when sending rejection mails. +Default is postmaster@@<your domain>. %d expands to recipient domain.") + + (hostname + (string "") + "Hostname to use in various parts of sent mails (e.g. in Message-Id) +and in LMTP replies. Default is the system's real hostname@@domain.") + + (quota-full-tempfail? + (boolean #f) + "If user is over quota, return with temporary failure instead of +bouncing the mail.") + + (sendmail-path + (file-name "/usr/sbin/sendmail") + "Binary to use for sending mails.") + + (submission-host + (string "") + "If non-empty, send mails via this SMTP host[:port] instead of +sendmail.") + + (rejection-subject + (string "Rejected: %s") + "Subject: header to use for rejection mails. You can use the same +variables as for @samp{rejection-reason} below.") + + (rejection-reason + (string "Your message to <%t> was automatically rejected:%n%r") + "Human readable error message for rejection mails. You can use +variables: + +@table @code +@item %n +CRLF +@item %r +reason +@item %s +original subject +@item %t +recipient +@end table") + + (recipient-delimiter + (string "+") + "Delimiter character between local-part and detail in email +address.") + + (lda-original-recipient-header + (string "") + "Header where the original recipient address (SMTP's RCPT TO: +address) is taken from if not available elsewhere. With dovecot-lda -a +parameter overrides this. A commonly used header for this is +X-Original-To.") + + (lda-mailbox-autocreate? + (boolean #f) + "Should saving a mail to a nonexistent mailbox automatically create +it?.") + + (lda-mailbox-autosubscribe? + (boolean #f) + "Should automatically created mailboxes be also automatically +subscribed?.") + + + (imap-max-line-length + (non-negative-integer #e64e3) + "Maximum IMAP command line length. Some clients generate very long +command lines with huge mailboxes, so you may need to raise this if you +get \"Too long argument\" or \"IMAP command line too large\" errors +often.") + + (imap-logout-format + (string "in=%i out=%o") + "IMAP logout format string: +@table @code +@item %i +total number of bytes read from client +@item %o +total number of bytes sent to client. +@end table") + + (imap-capability + (string "") + "Override the IMAP CAPABILITY response. If the value begins with '+', +add the given capabilities on top of the defaults (e.g. +XFOO XBAR).") + + (imap-idle-notify-interval + (string "2 mins") + "How long to wait between \"OK Still here\" notifications when client +is IDLEing.") + + (imap-id-send + (string "") + "ID field names and values to send to clients. Using * as the value +makes Dovecot use the default value. The following fields have default +values currently: name, version, os, os-version, support-url, +support-email.") + + (imap-id-log + (string "") + "ID fields sent by client to log. * means everything.") + + (imap-client-workarounds + (space-separated-string-list '()) + "Workarounds for various client bugs: + +@table @code +@item delay-newmail +Send EXISTS/RECENT new mail notifications only when replying to NOOP and +CHECK commands. Some clients ignore them otherwise, for example OSX +Mail (<v2.1). Outlook Express breaks more badly though, without this it +may show user \"Message no longer in server\" errors. Note that OE6 +still breaks even with this workaround if synchronization is set to +\"Headers Only\". + +@item tb-extra-mailbox-sep +Thunderbird gets somehow confused with LAYOUT=fs (mbox and dbox) and +adds extra @samp{/} suffixes to mailbox names. This option causes Dovecot to +ignore the extra @samp{/} instead of treating it as invalid mailbox name. + +@item tb-lsub-flags +Show \\Noselect flags for LSUB replies with LAYOUT=fs (e.g. mbox). +This makes Thunderbird realize they aren't selectable and show them +greyed out, instead of only later giving \"not selectable\" popup error. +@end table +") + + (imap-urlauth-host + (string "") + "Host allowed in URLAUTH URLs sent by client. \"*\" allows all.") ) + +(define-configuration opaque-dovecot-configuration + (dovecot + (package dovecot) + "The dovecot package.") + + (string + (string (dovecot-configuration-missing-field 'opaque-dovecot-configuration + 'string)) + "The contents of the @code{dovecot.conf} to use.")) + +(define %dovecot-accounts + ;; Account and group for the Dovecot daemon. + (list (user-group (name "dovecot") (system? #t)) + (user-account + (name "dovecot") + (group "dovecot") + (system? #t) + (comment "Dovecot daemon user") + (home-directory "/var/empty") + (shell #~(string-append #$shadow "/sbin/nologin"))) + + (user-group (name "dovenull") (system? #t)) + (user-account + (name "dovenull") + (group "dovenull") + (system? #t) + (comment "Dovecot daemon login user") + (home-directory "/var/empty") + (shell #~(string-append #$shadow "/sbin/nologin"))))) + +(define %dovecot-activation + ;; Activation gexp. + #~(begin + (use-modules (guix build utils)) + (define (mkdir-p/perms directory owner perms) + (mkdir-p directory) + (chown "/var/run/dovecot" (passwd:uid owner) (passwd:gid owner)) + (chmod directory perms)) + (define (build-subject parameters) + (string-concatenate + (map (lambda (pair) + (let ((k (car pair)) (v (cdr pair))) + (define (escape-char str chr) + (string-join (string-split str chr) (string #\\ chr))) + (string-append "/" k "=" + (escape-char (escape-char v #\=) #\/)))) + (filter (lambda (pair) (cdr pair)) parameters)))) + (define* (create-self-signed-certificate-if-absent + #:key private-key public-key (owner (getpwnam "root")) + (common-name (gethostname)) + (organization-name "GuixSD") + (organization-unit-name "Default Self-Signed Certificate") + (subject-parameters `(("CN" . ,common-name) + ("O" . ,organization-name) + ("OU" . ,organization-unit-name))) + (subject (build-subject subject-parameters))) + ;; Note that by default, OpenSSL outputs keys in PEM format. This + ;; is what we want. + (unless (file-exists? private-key) + (cond + ((zero? (system* (string-append #$openssl "/bin/openssl") + "genrsa" "-out" private-key "2048")) + (chown private-key (passwd:uid owner) (passwd:gid owner)) + (chmod private-key #o400)) + (else + (format (current-error-port) + "Failed to create private key at ~a.\n" private-key)))) + (unless (file-exists? public-key) + (cond + ((zero? (system* (string-append #$openssl "/bin/openssl") + "req" "-new" "-x509" "-key" private-key + "-out" public-key "-days" "3650" + "-batch" "-subj" subject)) + (chown public-key (passwd:uid owner) (passwd:gid owner)) + (chmod public-key #o444)) + (else + (format (current-error-port) + "Failed to create public key at ~a.\n" public-key))))) + (let ((user (getpwnam "dovecot"))) + (mkdir-p/perms "/var/run/dovecot" user #o755) + (mkdir-p/perms "/var/lib/dovecot" user #o755) + (mkdir-p/perms "/etc/dovecot" user #o755) + (mkdir-p/perms "/etc/dovecot/private" user #o700) + (create-self-signed-certificate-if-absent + #:private-key "/etc/dovecot/private/default.pem" + #:public-key "/etc/dovecot/default.pem" + #:owner (getpwnam "root") + #:common-name (format #f "Dovecot service on ~a" (gethostname)))))) + +(define (dovecot-dmd-service config) + "Return a list of <dmd-service> for CONFIG." + (let* ((config-str + (cond + ((opaque-dovecot-configuration? config) + (opaque-dovecot-configuration-string config)) + (else + (with-output-to-string + (lambda () + (serialize-configuration config + dovecot-configuration-fields)))))) + (config-file (plain-file "dovecot.conf" config-str)) + (dovecot (if (opaque-dovecot-configuration? config) + (opaque-dovecot-configuration-dovecot config) + (dovecot-configuration-dovecot config)))) + (list (dmd-service + (documentation "Run the Dovecot POP3/IMAP mail server.") + (provision '(dovecot)) + (requirement '(networking)) + (start #~(make-forkexec-constructor + (list (string-append #$dovecot "/sbin/dovecot") + "-F" "-c" #$config-file))) + (stop #~(make-forkexec-constructor + (list (string-append #$dovecot "/sbin/dovecot") + "-c" #$config-file "stop"))))))) + +(define %dovecot-pam-services + (list (unix-pam-service "dovecot"))) + +(define dovecot-service-type + (service-type (name 'dovecot) + (extensions + (list (service-extension dmd-root-service-type + dovecot-dmd-service) + (service-extension account-service-type + (const %dovecot-accounts)) + (service-extension pam-root-service-type + (const %dovecot-pam-services)) + (service-extension activation-service-type + (const %dovecot-activation)))))) + +(define* (dovecot-service #:key (config (dovecot-configuration))) + "Return a service that runs @command{dovecot}, a mail server that can run +POP3, IMAP, and LMTP. @var{config} should be a configuration object created +by @code{dovecot-configuration}. @var{config} may also be created by +@code{opaque-dovecot-configuration}, which allows specification of the +@code{dovecot.conf} as a string." + (validate-configuration config + (if (opaque-dovecot-configuration? config) + opaque-dovecot-configuration-fields + dovecot-configuration-fields)) + (service dovecot-service-type config)) + +;; A little helper to make it easier to document all those fields. +(define (generate-documentation) + (define documentation + `((dovecot-configuration + ,dovecot-configuration-fields + (dict dict-configuration) + (namespaces namespace-configuration) + (plugin plugin-configuration) + (passdbs passdb-configuration) + (userdbs userdb-configuration) + (services service-configuration) + (protocols protocol-configuration)) + (dict-configuration ,dict-configuration-fields) + (plugin-configuration ,plugin-configuration-fields) + (passdb-configuration ,passdb-configuration-fields) + (userdb-configuration ,userdb-configuration-fields) + (unix-listener-configuration ,unix-listener-configuration-fields) + (fifo-listener-configuration ,fifo-listener-configuration-fields) + (inet-listener-configuration ,inet-listener-configuration-fields) + (namespace-configuration + ,namespace-configuration-fields + (mailboxes mailbox-configuration)) + (mailbox-configuration ,mailbox-configuration-fields) + (service-configuration + ,service-configuration-fields + (listeners unix-listener-configuration fifo-listener-configuration + inet-listener-configuration)) + (protocol-configuration ,protocol-configuration-fields))) + (define (generate configuration-name) + (match (assq-ref documentation configuration-name) + ((fields . sub-documentation) + (format #t "\nAvailable @code{~a} fields are:\n\n" configuration-name) + (for-each + (lambda (f) + (let ((field-name (configuration-field-name f)) + (field-type (configuration-field-type f)) + (field-docs (string-trim-both + (configuration-field-documentation f))) + (default (catch #t + (configuration-field-default-value-thunk f) + (lambda _ 'nope)))) + (define (escape-chars str chars escape) + (with-output-to-string + (lambda () + (string-for-each (lambda (c) + (when (char-set-contains? chars c) + (display escape)) + (display c)) + str)))) + (define (show-default? val) + (or (string? default) (number? default) (boolean? default) + (and (list? val) (and-map show-default? val)))) + (format #t "@deftypevr {@code{~a} parameter} ~a ~a\n~a\n" + configuration-name field-type field-name field-docs) + (when (show-default? default) + (format #t "Defaults to @samp{~a}.\n" + (escape-chars (format #f "~s" default) + (char-set #\@ #\{ #\}) + #\@))) + (for-each generate (or (assq-ref sub-documentation field-name) '())) + (format #t "@end deftypevr\n\n"))) + fields)))) + (generate 'dovecot-configuration)) diff --git a/gnu/system.scm b/gnu/system.scm index ff981d95a2..6dfcc0fe3a 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Alex Kost <alezost@gmail.com> ;;; @@ -192,11 +192,14 @@ as 'needed-for-boot'." (operating-system-file-systems os))) (define (device-mappings fs) - (filter (lambda (md) - (string=? (string-append "/dev/mapper/" - (mapped-device-target md)) - (file-system-device fs))) - (operating-system-mapped-devices os))) + (let ((device (file-system-device fs))) + (if (string? device) ;title is 'device + (filter (lambda (md) + (string=? (string-append "/dev/mapper/" + (mapped-device-target md)) + device)) + (operating-system-mapped-devices os)) + '()))) (define (add-dependencies fs) ;; Add the dependencies due to device mappings to FS. @@ -213,7 +216,8 @@ as 'needed-for-boot'." "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f." (let ((target (string-append "/dev/mapper/" (mapped-device-target device)))) (find (lambda (fs) - (string=? (file-system-device fs) target)) + (and (eq? 'device (file-system-title fs)) + (string=? (file-system-device fs) target))) file-systems))) (define (operating-system-user-mapped-devices os) @@ -299,6 +303,7 @@ a container or that of a \"bare metal\" system." (operating-system-groups os)) (operating-system-skeletons os)) (operating-system-etc-service os) + (service fstab-service-type '()) (session-environment-service (operating-system-environment-variables os)) host-name procs root-fs unmount @@ -668,12 +673,14 @@ listed in OS. The C library expects to find it under ((system (operating-system-derivation os)) (root-fs -> (operating-system-root-file-system os)) (kernel -> (operating-system-kernel os)) + (root-device -> (if (eq? 'uuid (file-system-title root-fs)) + (uuid->string (file-system-device root-fs)) + (file-system-device root-fs))) (entries -> (list (menu-entry (label (kernel->grub-label kernel)) (linux kernel) (linux-arguments - (cons* (string-append "--root=" - (file-system-device root-fs)) + (cons* (string-append "--root=" root-device) #~(string-append "--system=" #$system) #~(string-append "--load=" #$system "/boot") diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl index dc5cfc81a4..87e8d1e93c 100644 --- a/gnu/system/examples/bare-bones.tmpl +++ b/gnu/system/examples/bare-bones.tmpl @@ -10,11 +10,11 @@ (timezone "Europe/Berlin") (locale "en_US.UTF-8") - ;; Assuming /dev/sdX is the target hard disk, and "root" is + ;; Assuming /dev/sdX is the target hard disk, and "my-root" is ;; the label of the target root file system. (bootloader (grub-configuration (device "/dev/sdX"))) (file-systems (cons (file-system - (device "root") + (device "my-root") (title 'label) (mount-point "/") (type "ext4")) diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl index ee660e0589..07183a533b 100644 --- a/gnu/system/examples/desktop.tmpl +++ b/gnu/system/examples/desktop.tmpl @@ -10,11 +10,11 @@ (timezone "Europe/Paris") (locale "en_US.UTF-8") - ;; Assuming /dev/sdX is the target hard disk, and "root" is - ;; the label of the target root file system. + ;; Assuming /dev/sdX is the target hard disk, and "my-root" + ;; is the label of the target root file system. (bootloader (grub-configuration (device "/dev/sdX"))) (file-systems (cons (file-system - (device "root") + (device "my-root") (title 'label) (mount-point "/") (type "ext4")) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 0a4b385fe3..d93044ce04 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,13 +18,13 @@ (define-module (gnu system file-systems) #:use-module (ice-9 match) - #:use-module (ice-9 regex) #:use-module (guix gexp) #:use-module (guix records) #:use-module (guix store) - #:use-module (rnrs bytevectors) - #:use-module ((gnu build file-systems) #:select (uuid->string)) - #:re-export (uuid->string) + #:use-module ((gnu build file-systems) + #:select (string->uuid uuid->string)) + #:re-export (string->uuid + uuid->string) #:export (<file-system> file-system file-system? @@ -35,12 +35,12 @@ file-system-needed-for-boot? file-system-flags file-system-options + file-system-mount? file-system-check? file-system-create-mount-point? file-system-dependencies file-system->spec - string->uuid uuid %fuse-control-file-system @@ -93,6 +93,8 @@ (default '())) (options file-system-options ; string or #f (default #f)) + (mount? file-system-mount? ; Boolean + (default #t)) (needed-for-boot? %file-system-needed-for-boot? ; Boolean (default #f)) (check? file-system-check? ; Boolean @@ -112,43 +114,9 @@ file system." "Return a list corresponding to file-system FS that can be passed to the initrd code." (match fs - (($ <file-system> device title mount-point type flags options _ check?) + (($ <file-system> device title mount-point type flags options _ _ check?) (list device title mount-point type flags options check?)))) -(define %uuid-rx - ;; The regexp of a UUID. - (make-regexp "^([[:xdigit:]]{8})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{12})$")) - -(define (string->uuid str) - "Parse STR as a DCE UUID (see <https://tools.ietf.org/html/rfc4122>) and -return its contents as a 16-byte bytevector. Return #f if STR is not a valid -UUID representation." - (and=> (regexp-exec %uuid-rx str) - (lambda (match) - (letrec-syntax ((hex->number - (syntax-rules () - ((_ index) - (string->number (match:substring match index) - 16)))) - (put! - (syntax-rules () - ((_ bv index (number len) rest ...) - (begin - (bytevector-uint-set! bv index number - (endianness big) len) - (put! bv (+ index len) rest ...))) - ((_ bv index) - bv)))) - (let ((time-low (hex->number 1)) - (time-mid (hex->number 2)) - (time-hi (hex->number 3)) - (clock-seq (hex->number 4)) - (node (hex->number 5)) - (uuid (make-bytevector 16))) - (put! uuid 0 - (time-low 4) (time-mid 2) (time-hi 2) - (clock-seq 2) (node 6))))))) - (define-syntax uuid (lambda (s) "Return the bytevector corresponding to the given UUID representation." diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 1492a0bb1c..3cba400a57 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -391,7 +391,8 @@ environment with the store shared with the host. MAPPINGS is a list of (source (file-system-device fs))) (or (string=? target (%store-prefix)) (string=? target "/") - (string-prefix? "/dev/" source)))) + (and (eq? 'device (file-system-title fs)) + (string-prefix? "/dev/" source))))) (operating-system-file-systems os))) (operating-system (inherit os) diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm index da06cb1358..a8ca354227 100644 --- a/guix/build-system/r.scm +++ b/guix/build-system/r.scm @@ -29,7 +29,8 @@ #:export (%r-build-system-modules r-build r-build-system - cran-uri)) + cran-uri + bioconductor-uri)) ;; Commentary: ;; @@ -46,6 +47,12 @@ available via the first URI, the second URI points to the archived version." (string-append "mirror://cran/src/contrib/Archive/" name "/" name "_" version ".tar.gz"))) +(define (bioconductor-uri name version) + "Return a URI string for the R package archive on Bioconductor for the +release corresponding to NAME and VERSION." + (string-append "http://bioconductor.org/packages/release/bioc/src/contrib/" + name "_" version ".tar.gz")) + (define %r-build-system-modules ;; Build-side modules imported by default. `((guix build r-build-system) diff --git a/guix/gexp.scm b/guix/gexp.scm index 14ced747b2..35adc179a1 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -35,6 +35,7 @@ local-file local-file? local-file-file + local-file-absolute-file-name local-file-name local-file-recursive? @@ -182,35 +183,76 @@ cross-compiling.)" ;;; File declarations. ;;; +;; A local file name. FILE is the file name the user entered, which can be a +;; relative file name, and ABSOLUTE is a promise that computes its canonical +;; absolute file name. We keep it in a promise to compute it lazily and avoid +;; repeated 'stat' calls. (define-record-type <local-file> - (%local-file file name recursive?) + (%%local-file file absolute name recursive?) local-file? (file local-file-file) ;string + (absolute %local-file-absolute-file-name) ;promise string (name local-file-name) ;string (recursive? local-file-recursive?)) ;Boolean -(define* (local-file file #:optional (name (basename file)) - #:key recursive?) +(define* (%local-file file promise #:optional (name (basename file)) + #:key recursive?) + ;; This intermediate procedure is part of our ABI, but the underlying + ;; %%LOCAL-FILE is not. + (%%local-file file promise name recursive?)) + +(define (extract-directory properties) + "Extract the directory name from source location PROPERTIES." + (match (assq 'filename properties) + (('filename . (? string? file-name)) + (dirname file-name)) + (_ + #f))) + +(define-syntax-rule (current-source-directory) + "Expand to the directory of the current source file or #f if it could not +be determined." + (extract-directory (current-source-location))) + +(define (absolute-file-name file directory) + "Return the canonical absolute file name for FILE, which lives in the +vicinity of DIRECTORY." + (canonicalize-path + (cond ((string-prefix? "/" file) file) + ((not directory) file) + ((string-prefix? "/" directory) + (string-append directory "/" file)) + (else file)))) + +(define-syntax-rule (local-file file rest ...) "Return an object representing local file FILE to add to the store; this -object can be used in a gexp. FILE will be added to the store under NAME--by -default the base name of FILE. +object can be used in a gexp. If FILE is a relative file name, it is looked +up relative to the source file where this form appears. FILE will be added to +the store under NAME--by default the base name of FILE. When RECURSIVE? is true, the contents of FILE are added recursively; if FILE designates a flat file and RECURSIVE? is true, its contents are added, and its permission bits are kept. This is the declarative counterpart of the 'interned-file' monadic procedure." - ;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing to - ;; do that, when RECURSIVE? is #t, we could end up creating a dangling - ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would just - ;; throw an error, both of which are inconvenient. - (%local-file (canonicalize-path file) name recursive?)) + (%local-file file + (delay (absolute-file-name file (current-source-directory))) + rest ...)) + +(define (local-file-absolute-file-name file) + "Return the absolute file name for FILE, a <local-file> instance. A +'system-error' exception is raised if FILE could not be found." + (force (%local-file-absolute-file-name file))) (define-gexp-compiler (local-file-compiler (file local-file?) system target) ;; "Compile" FILE by adding it to the store. (match file - (($ <local-file> file name recursive?) - (interned-file file name #:recursive? recursive?)))) + (($ <local-file> file (= force absolute) name recursive?) + ;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing + ;; to do that, when RECURSIVE? is #t, we could end up creating a dangling + ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would + ;; just throw an error, both of which are inconvenient. + (interned-file absolute name #:recursive? recursive?)))) (define-record-type <plain-file> (%plain-file name content references) diff --git a/guix/http-client.scm b/guix/http-client.scm index eb2c3f4d5f..c7cbc82aac 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -32,6 +32,7 @@ #:use-module (rnrs bytevectors) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix base64) #:use-module ((guix build utils) #:select (mkdir-p dump-port)) #:use-module ((guix build download) @@ -210,15 +211,23 @@ Raise an '&http-get-error' condition if downloading fails." (let loop ((uri (if (string? uri) (string->uri uri) uri))) - (let ((port (or port (open-connection-for-uri uri)))) + (let ((port (or port (open-connection-for-uri uri))) + (auth-header (match (uri-userinfo uri) + ((? string? str) + (list (cons 'Authorization + (string-append "Basic " + (base64-encode + (string->utf8 str)))))) + (_ '())))) (unless buffered? (setvbuf port _IONBF)) (let*-values (((resp data) ;; Try hard to use the API du jour to get an input port. (if (guile-version>? "2.0.7") - (http-get uri #:streaming? #t #:port port) ; 2.0.9+ + (http-get uri #:streaming? #t #:port port + #:headers auth-header) ; 2.0.9+ (http-get* uri #:decode-body? text? ; 2.0.7 - #:port port))) + #:port port #:headers auth-header))) ((code) (response-code resp))) (case code diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 845ecb5832..45c679cbe2 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -128,9 +128,12 @@ empty list when the FIELD cannot be found." #f "( *\\([^\\)]+\\)) *" value 'pre 'post) #\,))) - ;; When there is whitespace inside of items it is probably because - ;; this was not an actual list to begin with. - (remove (cut string-any char-set:whitespace <>) + (remove (lambda (item) + (or (string-null? item) + ;; When there is whitespace inside of items it is + ;; probably because this was not an actual list to + ;; begin with. + (string-any char-set:whitespace item))) (map string-trim-both items)))))) (define (beautify-description description) diff --git a/guix/licenses.scm b/guix/licenses.scm index 7e05b32993..9ace7f543b 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -30,7 +30,7 @@ non-copyleft bsd-style ;deprecated! cc0 - cc-by-sa4.0 cc-by3.0 + cc-by-sa4.0 cc-by-sa3.0 cc-by3.0 cddl1.0 cecill-c artistic2.0 clarified-artistic @@ -144,6 +144,11 @@ at URI, which may be a file:// URI pointing the package's tree." "http://creativecommons.org/licenses/by-sa/4.0/" "Creative Commons Attribution-ShareAlike 4.0 International")) +(define cc-by-sa3.0 + (license "CC-BY-SA 3.0" + "http://creativecommons.org/licenses/by-sa/3.0/" + "Creative Commons Attribution-ShareAlike 3.0 Unported")) + (define cc-by3.0 (license "CC-BY 3.0" "http://creativecommons.org/licenses/by/3.0/" diff --git a/guix/packages.scm b/guix/packages.scm index 68fb0916d8..41f3e20c41 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -89,6 +89,7 @@ package-transitive-target-inputs package-transitive-native-inputs package-transitive-propagated-inputs + package-transitive-native-search-paths package-transitive-supported-systems package-source-derivation package-derivation @@ -632,6 +633,17 @@ for the host system (\"native inputs\"), and not target inputs." recursively." (transitive-inputs (package-propagated-inputs package))) +(define (package-transitive-native-search-paths package) + "Return the list of search paths for PACKAGE and its propagated inputs, +recursively." + (append (package-native-search-paths package) + (append-map (match-lambda + ((label (? package? p) _ ...) + (package-native-search-paths p)) + (_ + '())) + (package-transitive-propagated-inputs package)))) + (define (transitive-input-references alist inputs) "Return a list of (assoc-ref ALIST <label>) for each (<label> <package> . _) in INPUTS and their transitive propagated inputs." diff --git a/guix/profiles.scm b/guix/profiles.scm index c222f4115d..ce86ff8e0a 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -176,7 +176,7 @@ omitted or #f, use the first output of PACKAGE." (output (or output (car (package-outputs package)))) (item package) (dependencies (delete-duplicates deps)) - (search-paths (package-native-search-paths package))))) + (search-paths (package-transitive-native-search-paths package))))) (define (packages->manifest packages) "Return a list of manifest entries, one for each item listed in PACKAGES. @@ -469,7 +469,7 @@ MANIFEST." (define (install-info info) (setenv "PATH" (string-append #+gzip "/bin")) ;for info.gz files (zero? - (system* (string-append #+texinfo "/bin/install-info") + (system* (string-append #+texinfo "/bin/install-info") "--silent" info (string-append #$output "/share/info/dir")))) (mkdir-p (string-append #$output "/share/info")) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 8ecd9560ed..9193ad32b2 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -204,6 +204,7 @@ options handled by 'set-build-options-from-command-line', and listed in (lambda (opt name arg result . rest) ;; XXX: Imperatively modify the search paths. (%package-module-path (cons arg (%package-module-path))) + (%patch-path (cons arg (%patch-path))) (set! %load-path (cons arg %load-path)) (set! %load-compiled-path (cons arg %load-compiled-path)) @@ -404,10 +405,16 @@ must be one of 'package', 'all', or 'transitive'~%") (define (options->things-to-build opts) "Read the arguments from OPTS and return a list of high-level objects to build---packages, gexps, derivations, and so on." - (define ensure-list - (match-lambda - ((x ...) x) - (x (list x)))) + (define (validate-type x) + (unless (or (package? x) (derivation? x) (gexp? x) (procedure? x)) + (leave (_ "~s: not something we can build~%") x))) + + (define (ensure-list x) + (let ((lst (match x + ((x ...) x) + (x (list x))))) + (for-each validate-type lst) + lst)) (append-map (match-lambda (('argument . (? string? spec)) @@ -424,8 +431,6 @@ build---packages, gexps, derivations, and so on." (ensure-list (read/eval str))) (('argument . (? derivation? drv)) drv) - (('argument . (? derivation-path? drv)) - (list )) (_ '())) opts)) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 9255f0018a..dcc4701779 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -113,7 +113,7 @@ Dependencies may include packages, origin, and file names." (((labels things . outputs) ...) things))) ((origin? thing) - (cons (origin-patch-guile thing) + (cons (or (origin-patch-guile thing) (default-guile)) (if (or (pair? (origin-patches thing)) (origin-snippet thing)) (match (origin-patch-inputs thing) @@ -171,7 +171,9 @@ GNU-BUILD-SYSTEM have zero dependencies." (description "same as 'bag', but without the bootstrap nodes") (identifier bag-node-identifier) (label node-full-name) - (edges (lift1 bag-node-edges-sans-bootstrap %store-monad)))) + (edges (lift1 (compose (cut filter package? <>) + bag-node-edges-sans-bootstrap) + %store-monad)))) ;;; diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 338c7e827d..f296f8a00e 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -587,6 +587,7 @@ be determined." Common Platform Enumeration (CPE) name." (match name ("icecat" "firefox") ;or "firefox_esr" + ("grub" "grub2") ;; TODO: Add more. (_ name))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index c62daee9a7..d0b5abd0e2 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -151,7 +151,7 @@ GENERATIONS is a list of generation numbers." "Delete from PROFILE all the generations matching PATTERN. PATTERN must be a string denoting a set of generations: the empty list means \"all generations but the current one\", a number designates a generation, and other patterns -denote ranges as interpreted by 'matching-derivations'." +denote ranges as interpreted by 'matching-generations'." (let ((current (generation-number profile))) (cond ((not (file-exists? profile)) ; XXX: race condition (raise (condition (&profile-not-found-error diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc index 47c7f9728e..f9fd61adde 100644 --- a/nix/libstore/build.cc +++ b/nix/libstore/build.cc @@ -84,6 +84,7 @@ struct HookInstance; /* A pointer to a goal. */ class Goal; +class DerivationGoal; typedef std::shared_ptr<Goal> GoalPtr; typedef std::weak_ptr<Goal> WeakGoalPtr; @@ -174,10 +175,10 @@ public: return exitCode; } - /* Cancel the goal. It should wake up its waiters, get rid of any - running child processes that are being monitored by the worker - (important!), etc. */ - virtual void cancel(bool timeout) = 0; + /* Callback in case of a timeout. It should wake up its waiters, + get rid of any running child processes that are being monitored + by the worker (important!), etc. */ + virtual void timedOut() = 0; virtual string key() = 0; @@ -799,11 +800,13 @@ private: result. */ ValidPathInfos prevInfos; + BuildResult result; + public: DerivationGoal(const Path & drvPath, const StringSet & wantedOutputs, Worker & worker, BuildMode buildMode = bmNormal); ~DerivationGoal(); - void cancel(bool timeout); + void timedOut() override; string key() { @@ -824,6 +827,8 @@ public: /* Add wanted outputs to an already existing derivation goal. */ void addWantedOutputs(const StringSet & outputs); + BuildResult getResult() { return result; } + private: /* The states. */ void init(); @@ -874,6 +879,8 @@ private: Path addHashRewrite(const Path & path); void repairClosure(); + + void done(BuildResult::Status status, const string & msg = ""); }; @@ -933,12 +940,12 @@ void DerivationGoal::killChild() } -void DerivationGoal::cancel(bool timeout) +void DerivationGoal::timedOut() { - if (settings.printBuildTrace && timeout) + if (settings.printBuildTrace) printMsg(lvlError, format("@ build-failed %1% - timeout") % drvPath); killChild(); - amDone(ecFailed); + done(BuildResult::TimedOut); } @@ -991,8 +998,8 @@ void DerivationGoal::haveDerivation() trace("loading derivation"); if (nrFailed != 0) { - printMsg(lvlError, format("cannot build missing derivation `%1%'") % drvPath); - amDone(ecFailed); + printMsg(lvlError, format("cannot build missing derivation ‘%1%’") % drvPath); + done(BuildResult::MiscFailure); return; } @@ -1014,7 +1021,7 @@ void DerivationGoal::haveDerivation() /* If they are all valid, then we're done. */ if (invalidOutputs.size() == 0 && buildMode == bmNormal) { - amDone(ecSuccess); + done(BuildResult::AlreadyValid); return; } @@ -1059,7 +1066,7 @@ void DerivationGoal::outputsSubstituted() unsigned int nrInvalid = checkPathValidity(false, buildMode == bmRepair).size(); if (buildMode == bmNormal && nrInvalid == 0) { - amDone(ecSuccess); + done(BuildResult::Substituted); return; } if (buildMode == bmRepair && nrInvalid == 0) { @@ -1132,7 +1139,7 @@ void DerivationGoal::repairClosure() } if (waitees.empty()) { - amDone(ecSuccess); + done(BuildResult::AlreadyValid); return; } @@ -1144,8 +1151,8 @@ void DerivationGoal::closureRepaired() { trace("closure repaired"); if (nrFailed > 0) - throw Error(format("some paths in the output closure of derivation `%1%' could not be repaired") % drvPath); - amDone(ecSuccess); + throw Error(format("some paths in the output closure of derivation ‘%1%’ could not be repaired") % drvPath); + done(BuildResult::AlreadyValid); } @@ -1157,7 +1164,7 @@ void DerivationGoal::inputsRealised() printMsg(lvlError, format("cannot build derivation `%1%': %2% dependencies couldn't be built") % drvPath % nrFailed); - amDone(ecFailed); + done(BuildResult::DependencyFailed); return; } @@ -1286,7 +1293,7 @@ void DerivationGoal::tryToBuild() if (buildMode != bmCheck && validPaths.size() == drv.outputs.size()) { debug(format("skipping build of derivation `%1%', someone beat us to it") % drvPath); outputLocks.setDeletion(true); - amDone(ecSuccess); + done(BuildResult::AlreadyValid); return; } @@ -1358,7 +1365,7 @@ void DerivationGoal::tryToBuild() printMsg(lvlError, format("@ build-failed %1% - %2% %3%") % drvPath % 0 % e.msg()); worker.permanentFailure = true; - amDone(ecFailed); + done(BuildResult::InputRejected, e.msg()); return; } @@ -1473,7 +1480,7 @@ void DerivationGoal::buildDone() registerOutputs(); if (buildMode == bmCheck) { - amDone(ecSuccess); + done(BuildResult::Built); return; } @@ -1508,10 +1515,12 @@ void DerivationGoal::buildDone() outputLocks.unlock(); buildUser.release(); + BuildResult::Status st = BuildResult::MiscFailure; + if (hook && WIFEXITED(status) && WEXITSTATUS(status) == 101) { if (settings.printBuildTrace) printMsg(lvlError, format("@ build-failed %1% - timeout") % drvPath); - worker.timedOut = true; + st = BuildResult::TimedOut; } else if (hook && (!WIFEXITED(status) || WEXITSTATUS(status) != 100)) { @@ -1524,7 +1533,11 @@ void DerivationGoal::buildDone() if (settings.printBuildTrace) printMsg(lvlError, format("@ build-failed %1% - %2% %3%") % drvPath % 1 % e.msg()); - worker.permanentFailure = !fixedOutput && !diskFull; + + st = + statusOk(status) ? BuildResult::OutputRejected : + fixedOutput || diskFull ? BuildResult::TransientFailure : + BuildResult::PermanentFailure; /* Register the outputs of this build as "failed" so we won't try to build them again (negative caching). @@ -1538,7 +1551,7 @@ void DerivationGoal::buildDone() worker.store.registerFailedPath(i->second.path); } - amDone(ecFailed); + done(st, e.msg()); return; } @@ -1548,7 +1561,7 @@ void DerivationGoal::buildDone() if (settings.printBuildTrace) printMsg(lvlError, format("@ build-succeeded %1% -") % drvPath); - amDone(ecSuccess); + done(BuildResult::Built); } @@ -1700,11 +1713,11 @@ void DerivationGoal::startBuilder() /* Create a temporary directory where the build will take place. */ auto drvName = storePathToName(drvPath); - tmpDir = createTempDir("", "nix-build-" + drvName, false, false, 0700); + tmpDir = createTempDir("", "guix-build-" + drvName, false, false, 0700); /* In a sandbox, for determinism, always use the same temporary directory. */ - tmpDirInSandbox = useChroot ? "/tmp/nix-build-" + drvName + "-0" : tmpDir; + tmpDirInSandbox = useChroot ? "/tmp/guix-build-" + drvName + "-0" : tmpDir; /* For convenience, set an environment pointing to the top build directory. */ @@ -2579,7 +2592,7 @@ void DerivationGoal::handleChildOutput(int fd, const string & data) printMsg(lvlError, format("%1% killed after writing more than %2% bytes of log output") % getName() % settings.maxLogSize); - cancel(true); // not really a timeout, but close enough + timedOut(); // not really a timeout, but close enough return; } if (verbosity >= settings.buildVerbosity) @@ -2628,8 +2641,7 @@ bool DerivationGoal::pathFailed(const Path & path) if (settings.printBuildTrace) printMsg(lvlError, format("@ build-failed %1% - cached") % drvPath); - worker.permanentFailure = true; - amDone(ecFailed); + done(BuildResult::CachedFailure); return true; } @@ -2649,6 +2661,18 @@ Path DerivationGoal::addHashRewrite(const Path & path) } +void DerivationGoal::done(BuildResult::Status status, const string & msg) +{ + result.status = status; + result.errorMsg = msg; + amDone(result.success() ? ecSuccess : ecFailed); + if (result.status == BuildResult::TimedOut) + worker.timedOut = true; + if (result.status == BuildResult::PermanentFailure || result.status == BuildResult::CachedFailure) + worker.permanentFailure = true; +} + + ////////////////////////////////////////////////////////////////////// @@ -2698,7 +2722,7 @@ public: SubstitutionGoal(const Path & storePath, Worker & worker, bool repair = false); ~SubstitutionGoal(); - void cancel(bool timeout); + void timedOut(); string key() { @@ -2743,9 +2767,9 @@ SubstitutionGoal::~SubstitutionGoal() } -void SubstitutionGoal::cancel(bool timeout) +void SubstitutionGoal::timedOut() { - if (settings.printBuildTrace && timeout) + if (settings.printBuildTrace) printMsg(lvlError, format("@ substituter-failed %1% timeout") % storePath); if (pid != -1) { pid_t savedPid = pid; @@ -3066,7 +3090,8 @@ Worker::~Worker() } -GoalPtr Worker::makeDerivationGoal(const Path & path, const StringSet & wantedOutputs, BuildMode buildMode) +GoalPtr Worker::makeDerivationGoal(const Path & path, + const StringSet & wantedOutputs, BuildMode buildMode) { GoalPtr goal = derivationGoals[path].lock(); if (!goal) { @@ -3323,7 +3348,7 @@ void Worker::waitForInput() /* Since goals may be canceled from inside the loop below (causing them go be erased from the `children' map), we have to be careful that we don't keep iterators alive across calls to - cancel(). */ + timedOut(). */ set<pid_t> pids; foreach (Children::iterator, i, children) pids.insert(i->first); @@ -3365,8 +3390,7 @@ void Worker::waitForInput() printMsg(lvlError, format("%1% timed out after %2% seconds of silence") % goal->getName() % settings.maxSilentTime); - goal->cancel(true); - timedOut = true; + goal->timedOut(); } else if (goal->getExitCode() == Goal::ecBusy && @@ -3377,8 +3401,7 @@ void Worker::waitForInput() printMsg(lvlError, format("%1% timed out after %2% seconds") % goal->getName() % settings.buildTimeout); - goal->cancel(true); - timedOut = true; + goal->timedOut(); } } diff --git a/nix/libstore/remote-store.cc b/nix/libstore/remote-store.cc deleted file mode 100644 index 324ef5eb30..0000000000 --- a/nix/libstore/remote-store.cc +++ /dev/null @@ -1,639 +0,0 @@ -#include "serialise.hh" -#include "util.hh" -#include "remote-store.hh" -#include "worker-protocol.hh" -#include "archive.hh" -#include "affinity.hh" -#include "globals.hh" - -#include <sys/types.h> -#include <sys/stat.h> -#include <sys/socket.h> -#include <sys/un.h> -#include <errno.h> -#include <fcntl.h> - -#include <iostream> -#include <unistd.h> -#include <cstring> - -namespace nix { - - -Path readStorePath(Source & from) -{ - Path path = readString(from); - assertStorePath(path); - return path; -} - - -template<class T> T readStorePaths(Source & from) -{ - T paths = readStrings<T>(from); - foreach (typename T::iterator, i, paths) assertStorePath(*i); - return paths; -} - -template PathSet readStorePaths(Source & from); - - -RemoteStore::RemoteStore() -{ - initialised = false; -} - - -void RemoteStore::openConnection(bool reserveSpace) -{ - if (initialised) return; - initialised = true; - - string remoteMode = getEnv("NIX_REMOTE"); - - if (remoteMode == "daemon") - /* Connect to a daemon that does the privileged work for - us. */ - connectToDaemon(); - else - throw Error(format("invalid setting for NIX_REMOTE, `%1%'") % remoteMode); - - from.fd = fdSocket; - to.fd = fdSocket; - - /* Send the magic greeting, check for the reply. */ - try { - writeInt(WORKER_MAGIC_1, to); - to.flush(); - unsigned int magic = readInt(from); - if (magic != WORKER_MAGIC_2) throw Error("protocol mismatch"); - - daemonVersion = readInt(from); - if (GET_PROTOCOL_MAJOR(daemonVersion) != GET_PROTOCOL_MAJOR(PROTOCOL_VERSION)) - throw Error("Nix daemon protocol version not supported"); - writeInt(PROTOCOL_VERSION, to); - - if (GET_PROTOCOL_MINOR(daemonVersion) >= 14) { - int cpu = settings.lockCPU ? lockToCurrentCPU() : -1; - if (cpu != -1) { - writeInt(1, to); - writeInt(cpu, to); - } else - writeInt(0, to); - } - - if (GET_PROTOCOL_MINOR(daemonVersion) >= 11) - writeInt(reserveSpace, to); - - processStderr(); - } - catch (Error & e) { - throw Error(format("cannot start daemon worker: %1%") % e.msg()); - } - - setOptions(); -} - - -void RemoteStore::connectToDaemon() -{ - fdSocket = socket(PF_UNIX, SOCK_STREAM, 0); - if (fdSocket == -1) - throw SysError("cannot create Unix domain socket"); - closeOnExec(fdSocket); - - string socketPath = settings.nixDaemonSocketFile; - - /* Urgh, sockaddr_un allows path names of only 108 characters. So - chdir to the socket directory so that we can pass a relative - path name. !!! this is probably a bad idea in multi-threaded - applications... */ - AutoCloseFD fdPrevDir = open(".", O_RDONLY); - if (fdPrevDir == -1) throw SysError("couldn't open current directory"); - if (chdir(dirOf(socketPath).c_str()) == -1) throw SysError(format("couldn't change to directory of ‘%1%’") % socketPath); - Path socketPathRel = "./" + baseNameOf(socketPath); - - struct sockaddr_un addr; - addr.sun_family = AF_UNIX; - if (socketPathRel.size() >= sizeof(addr.sun_path)) - throw Error(format("socket path `%1%' is too long") % socketPathRel); - using namespace std; - strcpy(addr.sun_path, socketPathRel.c_str()); - - if (connect(fdSocket, (struct sockaddr *) &addr, sizeof(addr)) == -1) - throw SysError(format("cannot connect to daemon at `%1%'") % socketPath); - - if (fchdir(fdPrevDir) == -1) - throw SysError("couldn't change back to previous directory"); -} - - -RemoteStore::~RemoteStore() -{ - try { - to.flush(); - fdSocket.close(); - } catch (...) { - ignoreException(); - } -} - - -void RemoteStore::setOptions() -{ - writeInt(wopSetOptions, to); - - writeInt(settings.keepFailed, to); - writeInt(settings.keepGoing, to); - writeInt(settings.tryFallback, to); - writeInt(verbosity, to); - writeInt(settings.maxBuildJobs, to); - writeInt(settings.maxSilentTime, to); - if (GET_PROTOCOL_MINOR(daemonVersion) >= 2) - writeInt(settings.useBuildHook, to); - if (GET_PROTOCOL_MINOR(daemonVersion) >= 4) { - writeInt(settings.buildVerbosity, to); - writeInt(logType, to); - writeInt(settings.printBuildTrace, to); - } - if (GET_PROTOCOL_MINOR(daemonVersion) >= 6) - writeInt(settings.buildCores, to); - if (GET_PROTOCOL_MINOR(daemonVersion) >= 10) - writeInt(settings.useSubstitutes, to); - - if (GET_PROTOCOL_MINOR(daemonVersion) >= 12) { - Settings::SettingsMap overrides = settings.getOverrides(); - writeInt(overrides.size(), to); - foreach (Settings::SettingsMap::iterator, i, overrides) { - writeString(i->first, to); - writeString(i->second, to); - } - } - - processStderr(); -} - - -bool RemoteStore::isValidPath(const Path & path) -{ - openConnection(); - writeInt(wopIsValidPath, to); - writeString(path, to); - processStderr(); - unsigned int reply = readInt(from); - return reply != 0; -} - - -PathSet RemoteStore::queryValidPaths(const PathSet & paths) -{ - openConnection(); - if (GET_PROTOCOL_MINOR(daemonVersion) < 12) { - PathSet res; - foreach (PathSet::const_iterator, i, paths) - if (isValidPath(*i)) res.insert(*i); - return res; - } else { - writeInt(wopQueryValidPaths, to); - writeStrings(paths, to); - processStderr(); - return readStorePaths<PathSet>(from); - } -} - - -PathSet RemoteStore::queryAllValidPaths() -{ - openConnection(); - writeInt(wopQueryAllValidPaths, to); - processStderr(); - return readStorePaths<PathSet>(from); -} - - -PathSet RemoteStore::querySubstitutablePaths(const PathSet & paths) -{ - openConnection(); - if (GET_PROTOCOL_MINOR(daemonVersion) < 12) { - PathSet res; - foreach (PathSet::const_iterator, i, paths) { - writeInt(wopHasSubstitutes, to); - writeString(*i, to); - processStderr(); - if (readInt(from)) res.insert(*i); - } - return res; - } else { - writeInt(wopQuerySubstitutablePaths, to); - writeStrings(paths, to); - processStderr(); - return readStorePaths<PathSet>(from); - } -} - - -void RemoteStore::querySubstitutablePathInfos(const PathSet & paths, - SubstitutablePathInfos & infos) -{ - if (paths.empty()) return; - - openConnection(); - - if (GET_PROTOCOL_MINOR(daemonVersion) < 3) return; - - if (GET_PROTOCOL_MINOR(daemonVersion) < 12) { - - foreach (PathSet::const_iterator, i, paths) { - SubstitutablePathInfo info; - writeInt(wopQuerySubstitutablePathInfo, to); - writeString(*i, to); - processStderr(); - unsigned int reply = readInt(from); - if (reply == 0) continue; - info.deriver = readString(from); - if (info.deriver != "") assertStorePath(info.deriver); - info.references = readStorePaths<PathSet>(from); - info.downloadSize = readLongLong(from); - info.narSize = GET_PROTOCOL_MINOR(daemonVersion) >= 7 ? readLongLong(from) : 0; - infos[*i] = info; - } - - } else { - - writeInt(wopQuerySubstitutablePathInfos, to); - writeStrings(paths, to); - processStderr(); - unsigned int count = readInt(from); - for (unsigned int n = 0; n < count; n++) { - Path path = readStorePath(from); - SubstitutablePathInfo & info(infos[path]); - info.deriver = readString(from); - if (info.deriver != "") assertStorePath(info.deriver); - info.references = readStorePaths<PathSet>(from); - info.downloadSize = readLongLong(from); - info.narSize = readLongLong(from); - } - - } -} - - -ValidPathInfo RemoteStore::queryPathInfo(const Path & path) -{ - openConnection(); - writeInt(wopQueryPathInfo, to); - writeString(path, to); - processStderr(); - ValidPathInfo info; - info.path = path; - info.deriver = readString(from); - if (info.deriver != "") assertStorePath(info.deriver); - info.hash = parseHash(htSHA256, readString(from)); - info.references = readStorePaths<PathSet>(from); - info.registrationTime = readInt(from); - info.narSize = readLongLong(from); - return info; -} - - -Hash RemoteStore::queryPathHash(const Path & path) -{ - openConnection(); - writeInt(wopQueryPathHash, to); - writeString(path, to); - processStderr(); - string hash = readString(from); - return parseHash(htSHA256, hash); -} - - -void RemoteStore::queryReferences(const Path & path, - PathSet & references) -{ - openConnection(); - writeInt(wopQueryReferences, to); - writeString(path, to); - processStderr(); - PathSet references2 = readStorePaths<PathSet>(from); - references.insert(references2.begin(), references2.end()); -} - - -void RemoteStore::queryReferrers(const Path & path, - PathSet & referrers) -{ - openConnection(); - writeInt(wopQueryReferrers, to); - writeString(path, to); - processStderr(); - PathSet referrers2 = readStorePaths<PathSet>(from); - referrers.insert(referrers2.begin(), referrers2.end()); -} - - -Path RemoteStore::queryDeriver(const Path & path) -{ - openConnection(); - writeInt(wopQueryDeriver, to); - writeString(path, to); - processStderr(); - Path drvPath = readString(from); - if (drvPath != "") assertStorePath(drvPath); - return drvPath; -} - - -PathSet RemoteStore::queryValidDerivers(const Path & path) -{ - openConnection(); - writeInt(wopQueryValidDerivers, to); - writeString(path, to); - processStderr(); - return readStorePaths<PathSet>(from); -} - - -PathSet RemoteStore::queryDerivationOutputs(const Path & path) -{ - openConnection(); - writeInt(wopQueryDerivationOutputs, to); - writeString(path, to); - processStderr(); - return readStorePaths<PathSet>(from); -} - - -PathSet RemoteStore::queryDerivationOutputNames(const Path & path) -{ - openConnection(); - writeInt(wopQueryDerivationOutputNames, to); - writeString(path, to); - processStderr(); - return readStrings<PathSet>(from); -} - - -Path RemoteStore::queryPathFromHashPart(const string & hashPart) -{ - openConnection(); - writeInt(wopQueryPathFromHashPart, to); - writeString(hashPart, to); - processStderr(); - Path path = readString(from); - if (!path.empty()) assertStorePath(path); - return path; -} - - -Path RemoteStore::addToStore(const string & name, const Path & _srcPath, - bool recursive, HashType hashAlgo, PathFilter & filter, bool repair) -{ - if (repair) throw Error("repairing is not supported when building through the Nix daemon"); - - openConnection(); - - Path srcPath(absPath(_srcPath)); - - writeInt(wopAddToStore, to); - writeString(name, to); - /* backwards compatibility hack */ - writeInt((hashAlgo == htSHA256 && recursive) ? 0 : 1, to); - writeInt(recursive ? 1 : 0, to); - writeString(printHashType(hashAlgo), to); - - try { - to.written = 0; - to.warn = true; - dumpPath(srcPath, to, filter); - to.warn = false; - processStderr(); - } catch (SysError & e) { - /* Daemon closed while we were sending the path. Probably OOM - or I/O error. */ - if (e.errNo == EPIPE) - try { - processStderr(); - } catch (EndOfFile & e) { } - throw; - } - - return readStorePath(from); -} - - -Path RemoteStore::addTextToStore(const string & name, const string & s, - const PathSet & references, bool repair) -{ - if (repair) throw Error("repairing is not supported when building through the Nix daemon"); - - openConnection(); - writeInt(wopAddTextToStore, to); - writeString(name, to); - writeString(s, to); - writeStrings(references, to); - - processStderr(); - return readStorePath(from); -} - - -void RemoteStore::exportPath(const Path & path, bool sign, - Sink & sink) -{ - openConnection(); - writeInt(wopExportPath, to); - writeString(path, to); - writeInt(sign ? 1 : 0, to); - processStderr(&sink); /* sink receives the actual data */ - readInt(from); -} - - -Paths RemoteStore::importPaths(bool requireSignature, Source & source) -{ - openConnection(); - writeInt(wopImportPaths, to); - /* We ignore requireSignature, since the worker forces it to true - anyway. */ - processStderr(0, &source); - return readStorePaths<Paths>(from); -} - - -void RemoteStore::buildPaths(const PathSet & drvPaths, BuildMode buildMode) -{ - openConnection(); - writeInt(wopBuildPaths, to); - if (GET_PROTOCOL_MINOR(daemonVersion) >= 13) { - writeStrings(drvPaths, to); - if (GET_PROTOCOL_MINOR(daemonVersion) >= 15) { - writeInt(buildMode, to); - } - /* Old daemons did not take a 'buildMode' parameter, so we need to - validate it here on the client side. */ - else if (buildMode != bmNormal) throw Error("repairing or checking \ -is not supported when building through the Nix daemon"); - } - else { - /* For backwards compatibility with old daemons, strip output - identifiers. */ - PathSet drvPaths2; - foreach (PathSet::const_iterator, i, drvPaths) - drvPaths2.insert(string(*i, 0, i->find('!'))); - writeStrings(drvPaths2, to); - } - processStderr(); - readInt(from); -} - - -void RemoteStore::ensurePath(const Path & path) -{ - openConnection(); - writeInt(wopEnsurePath, to); - writeString(path, to); - processStderr(); - readInt(from); -} - - -void RemoteStore::addTempRoot(const Path & path) -{ - openConnection(); - writeInt(wopAddTempRoot, to); - writeString(path, to); - processStderr(); - readInt(from); -} - - -void RemoteStore::addIndirectRoot(const Path & path) -{ - openConnection(); - writeInt(wopAddIndirectRoot, to); - writeString(path, to); - processStderr(); - readInt(from); -} - - -void RemoteStore::syncWithGC() -{ - openConnection(); - writeInt(wopSyncWithGC, to); - processStderr(); - readInt(from); -} - - -Roots RemoteStore::findRoots() -{ - openConnection(); - writeInt(wopFindRoots, to); - processStderr(); - unsigned int count = readInt(from); - Roots result; - while (count--) { - Path link = readString(from); - Path target = readStorePath(from); - result[link] = target; - } - return result; -} - - -void RemoteStore::collectGarbage(const GCOptions & options, GCResults & results) -{ - openConnection(false); - - writeInt(wopCollectGarbage, to); - writeInt(options.action, to); - writeStrings(options.pathsToDelete, to); - writeInt(options.ignoreLiveness, to); - writeLongLong(options.maxFreed, to); - writeInt(0, to); - if (GET_PROTOCOL_MINOR(daemonVersion) >= 5) { - /* removed options */ - writeInt(0, to); - writeInt(0, to); - } - - processStderr(); - - results.paths = readStrings<PathSet>(from); - results.bytesFreed = readLongLong(from); - readLongLong(from); // obsolete -} - - -PathSet RemoteStore::queryFailedPaths() -{ - openConnection(); - writeInt(wopQueryFailedPaths, to); - processStderr(); - return readStorePaths<PathSet>(from); -} - - -void RemoteStore::clearFailedPaths(const PathSet & paths) -{ - openConnection(); - writeInt(wopClearFailedPaths, to); - writeStrings(paths, to); - processStderr(); - readInt(from); -} - -void RemoteStore::optimiseStore() -{ - openConnection(); - writeInt(wopOptimiseStore, to); - processStderr(); - readInt(from); -} - -bool RemoteStore::verifyStore(bool checkContents, bool repair) -{ - openConnection(); - writeInt(wopVerifyStore, to); - writeInt(checkContents, to); - writeInt(repair, to); - processStderr(); - return readInt(from) != 0; -} - -void RemoteStore::processStderr(Sink * sink, Source * source) -{ - to.flush(); - unsigned int msg; - while ((msg = readInt(from)) == STDERR_NEXT - || msg == STDERR_READ || msg == STDERR_WRITE) { - if (msg == STDERR_WRITE) { - string s = readString(from); - if (!sink) throw Error("no sink"); - (*sink)((const unsigned char *) s.data(), s.size()); - } - else if (msg == STDERR_READ) { - if (!source) throw Error("no source"); - size_t len = readInt(from); - unsigned char * buf = new unsigned char[len]; - AutoDeleteArray<unsigned char> d(buf); - writeString(buf, source->read(buf, len), to); - to.flush(); - } - else { - string s = readString(from); - writeToStderr(s); - } - } - if (msg == STDERR_ERROR) { - string error = readString(from); - unsigned int status = GET_PROTOCOL_MINOR(daemonVersion) >= 8 ? readInt(from) : 1; - throw Error(format("%1%") % error, status); - } - else if (msg != STDERR_LAST) - throw Error("protocol error processing standard error"); -} - - -} diff --git a/nix/libstore/remote-store.hh b/nix/libstore/remote-store.hh deleted file mode 100644 index 030120db40..0000000000 --- a/nix/libstore/remote-store.hh +++ /dev/null @@ -1,106 +0,0 @@ -#pragma once - -#include <string> - -#include "store-api.hh" - - -namespace nix { - - -class Pipe; -class Pid; -struct FdSink; -struct FdSource; - - -class RemoteStore : public StoreAPI -{ -public: - - RemoteStore(); - - ~RemoteStore(); - - /* Implementations of abstract store API methods. */ - - bool isValidPath(const Path & path); - - PathSet queryValidPaths(const PathSet & paths); - - PathSet queryAllValidPaths(); - - ValidPathInfo queryPathInfo(const Path & path); - - Hash queryPathHash(const Path & path); - - void queryReferences(const Path & path, PathSet & references); - - void queryReferrers(const Path & path, PathSet & referrers); - - Path queryDeriver(const Path & path); - - PathSet queryValidDerivers(const Path & path); - - PathSet queryDerivationOutputs(const Path & path); - - StringSet queryDerivationOutputNames(const Path & path); - - Path queryPathFromHashPart(const string & hashPart); - - PathSet querySubstitutablePaths(const PathSet & paths); - - void querySubstitutablePathInfos(const PathSet & paths, - SubstitutablePathInfos & infos); - - Path addToStore(const string & name, const Path & srcPath, - bool recursive = true, HashType hashAlgo = htSHA256, - PathFilter & filter = defaultPathFilter, bool repair = false); - - Path addTextToStore(const string & name, const string & s, - const PathSet & references, bool repair = false); - - void exportPath(const Path & path, bool sign, - Sink & sink); - - Paths importPaths(bool requireSignature, Source & source); - - void buildPaths(const PathSet & paths, BuildMode buildMode); - - void ensurePath(const Path & path); - - void addTempRoot(const Path & path); - - void addIndirectRoot(const Path & path); - - void syncWithGC(); - - Roots findRoots(); - - void collectGarbage(const GCOptions & options, GCResults & results); - - PathSet queryFailedPaths(); - - void clearFailedPaths(const PathSet & paths); - - void optimiseStore(); - - bool verifyStore(bool checkContents, bool repair); -private: - AutoCloseFD fdSocket; - FdSink to; - FdSource from; - unsigned int daemonVersion; - bool initialised; - - void openConnection(bool reserveSpace = true); - - void processStderr(Sink * sink = 0, Source * source = 0); - - void connectToDaemon(); - - void setOptions(); -}; - - -} diff --git a/nix/libstore/store-api.cc b/nix/libstore/store-api.cc index 0238e5b0b6..30af5f5fed 100644 --- a/nix/libstore/store-api.cc +++ b/nix/libstore/store-api.cc @@ -304,13 +304,28 @@ void exportPaths(StoreAPI & store, const Paths & paths, writeInt(0, sink); } +Path readStorePath(Source & from) +{ + Path path = readString(from); + assertStorePath(path); + return path; +} + + +template<class T> T readStorePaths(Source & from) +{ + T paths = readStrings<T>(from); + foreach (typename T::iterator, i, paths) assertStorePath(*i); + return paths; +} + +template PathSet readStorePaths(Source & from); } #include "local-store.hh" #include "serialise.hh" -#include "remote-store.hh" namespace nix { @@ -321,10 +336,7 @@ std::shared_ptr<StoreAPI> store; std::shared_ptr<StoreAPI> openStore(bool reserveSpace) { - if (getEnv("NIX_REMOTE") == "") - return std::shared_ptr<StoreAPI>(new LocalStore(reserveSpace)); - else - return std::shared_ptr<StoreAPI>(new RemoteStore()); + return std::shared_ptr<StoreAPI>(new LocalStore(reserveSpace)); } diff --git a/nix/libstore/store-api.hh b/nix/libstore/store-api.hh index 9403cbee19..3e982f6dd3 100644 --- a/nix/libstore/store-api.hh +++ b/nix/libstore/store-api.hh @@ -106,6 +106,30 @@ typedef list<ValidPathInfo> ValidPathInfos; enum BuildMode { bmNormal, bmRepair, bmCheck }; +struct BuildResult +{ + enum Status { + Built = 0, + Substituted, + AlreadyValid, + PermanentFailure, + InputRejected, + OutputRejected, + TransientFailure, // possibly transient + CachedFailure, + TimedOut, + MiscFailure, + DependencyFailed, + LogLimitExceeded, + NotDeterministic, + } status = MiscFailure; + std::string errorMsg; + //time_t startTime = 0, stopTime = 0; + bool success() { + return status == Built || status == Substituted || status == AlreadyValid; + } +}; + class StoreAPI { diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc index 1934487d24..20a0732fcb 100644 --- a/nix/nix-daemon/guix-daemon.cc +++ b/nix/nix-daemon/guix-daemon.cc @@ -80,6 +80,7 @@ builds derivations on behalf of its clients."); #define GUIX_OPT_NO_BUILD_HOOK 14 #define GUIX_OPT_GC_KEEP_OUTPUTS 15 #define GUIX_OPT_GC_KEEP_DERIVATIONS 16 +#define GUIX_OPT_BUILD_ROUNDS 17 static const struct argp_option options[] = { @@ -104,6 +105,8 @@ static const struct argp_option options[] = n_("do not use the 'build hook'") }, { "cache-failures", GUIX_OPT_CACHE_FAILURES, 0, 0, n_("cache build failures") }, + { "rounds", GUIX_OPT_BUILD_ROUNDS, "N", 0, + n_("build each derivation N times in a row") }, { "lose-logs", GUIX_OPT_LOSE_LOGS, 0, 0, n_("do not keep build logs") }, { "disable-log-compression", GUIX_OPT_DISABLE_LOG_COMPRESSION, 0, 0, @@ -189,6 +192,18 @@ parse_opt (int key, char *arg, struct argp_state *state) case GUIX_OPT_CACHE_FAILURES: settings.cacheFailure = true; break; + case GUIX_OPT_BUILD_ROUNDS: + { + char *end; + unsigned long n = strtoul (arg, &end, 10); + if (end != arg + strlen (arg)) + { + fprintf (stderr, _("error: %s: invalid number of rounds\n"), arg); + exit (EXIT_FAILURE); + } + settings.set ("build-repeat", std::to_string (std::max (0UL, n - 1))); + break; + } case GUIX_OPT_IMPERSONATE_LINUX_26: settings.impersonateLinux26 = true; break; diff --git a/tests/graph.scm b/tests/graph.scm index ad8aea0ada..4f85432d2f 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -89,16 +89,18 @@ edges." (test-assert "bag-emerged DAG" (let-values (((backend nodes+edges) (make-recording-backend))) - (let ((p (dummy-package "p")) - (implicit (map (match-lambda - ((label package) package)) - (standard-packages)))) + (let* ((o (dummy-origin (method (lambda _ + (text-file "foo" "bar"))))) + (p (dummy-package "p" (source o))) + (implicit (map (match-lambda + ((label package) package)) + (standard-packages)))) (run-with-store %store (export-graph (list p) 'port #:node-type %bag-emerged-node-type #:backend backend)) ;; We should see exactly P and IMPLICIT, with one edge from P to each - ;; element of IMPLICIT. + ;; element of IMPLICIT. O must not appear among NODES. (let-values (((nodes edges) (nodes+edges))) (and (equal? (match nodes (((labels names) ...) @@ -148,7 +150,8 @@ edges." (let-values (((nodes edges) (nodes+edges))) (run-with-store %store (mlet %store-monad ((o* (lower-object o)) - (p* (lower-object p))) + (p* (lower-object p)) + (g (lower-object (default-guile)))) (return (and (find (match-lambda ((file "the-uri") #t) @@ -158,6 +161,13 @@ edges." ((source target) (and (string=? source (derivation-file-name p*)) (string=? target o*)))) + edges) + + ;; There must also be an edge from O to G. + (find (match-lambda + ((source target) + (and (string=? source o*) + (string=? target (derivation-file-name g))))) edges))))))))) (test-assert "derivation DAG" @@ -250,6 +260,17 @@ edges." (bootstrap? package))) diff)))))))) +(test-assert "node-transitive-edges, no duplicates" + (run-with-store %store + (let* ((p0 (dummy-package "p0")) + (p1a (dummy-package "p1a" (inputs `(("p0" ,p0))))) + (p1b (dummy-package "p1b" (inputs `(("p0" ,p0))))) + (p2 (dummy-package "p2" (inputs `(("p1a" ,p1a) ("p1b" ,p1b)))))) + (mlet %store-monad ((edges (node-edges %package-node-type + (list p2 p1a p1b p0)))) + (return (lset= eq? (node-transitive-edges (list p2) edges) + (list p1a p1b p0))))))) + (test-end "graph") diff --git a/tests/guix-package.sh b/tests/guix-package.sh index bb1037044d..5e6ff8b012 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -225,6 +225,10 @@ cat > "$module_dir/foo.scm"<<EOF EOF guix package -i emacs-foo-bar-patched -n +# Same when -L is used. +( unset GUIX_PACKAGE_PATH; \ + guix package -L "$module_dir" -i emacs-foo-bar-patched -n ) + # Make sure installing from a file works. cat > "$module_dir/package.scm"<<EOF (use-modules (gnu)) diff --git a/tests/guix-system.sh b/tests/guix-system.sh index e20bc98713..02e2524d9e 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -17,7 +17,7 @@ # along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. # -# Test the daemon and its interaction with 'guix substitute'. +# Test 'guix system', mostly error reporting. # set -e @@ -26,7 +26,15 @@ guix system --version tmpfile="t-guix-system-$$" errorfile="t-guix-system-error-$$" -trap 'rm -f "$tmpfile" "$errorfile"' EXIT + +# Note: This directory is chosen outside $builddir so that relative file name +# canonicalization doesn't mess up with 'current-source-directory', used by +# 'local-file' ('load' forces 'relative' for +# %FILE-PORT-NAME-CANONICALIZATION.) +tmpdir="${TMPDIR:-/tmp}/t-guix-system-$$" +mkdir "$tmpdir" + +trap 'rm -f "$tmpfile" "$errorfile" "$tmpdir"/*; rmdir "$tmpdir"' EXIT # Reporting of syntax errors. @@ -180,3 +188,23 @@ make_user_config "users" "group-that-does-not-exist" if guix system build "$tmpfile" -n 2> "$errorfile" then false else grep "supplementary group.*group-that-does-not-exist.*undeclared" "$errorfile"; fi + +# Try 'local-file' and relative file name resolution. + +cat > "$tmpdir/config.scm"<<EOF +(use-modules (gnu)) +(use-service-modules networking) + +(operating-system + $OS_BASE + (services (cons (tor-service (local-file "my-torrc")) + %base-services))) +EOF + +cat > "$tmpdir/my-torrc"<<EOF +# This is an example file. +EOF + +# In both cases 'my-torrc' should be properly resolved. +guix system build "$tmpdir/config.scm" -n +(cd "$tmpdir"; guix system build "config.scm" -n) diff --git a/tests/packages.scm b/tests/packages.scm index b28ae0b662..6a2f4f06e1 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -29,6 +29,7 @@ #:use-module (guix hash) #:use-module (guix derivations) #:use-module (guix packages) + #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system trivial) #:use-module (guix build-system gnu) @@ -504,6 +505,26 @@ (equal? x (collect (package-derivation %store b))) (equal? x (collect (package-derivation %store c))))))) +(test-assert "package-transitive-native-search-paths" + (let* ((sp (lambda (name) + (list (search-path-specification + (variable name) + (files '("foo/bar")))))) + (p0 (dummy-package "p0" (native-search-paths (sp "PATH0")))) + (p1 (dummy-package "p1" (native-search-paths (sp "PATH1")))) + (p2 (dummy-package "p2" + (native-search-paths (sp "PATH2")) + (inputs `(("p0" ,p0))) + (propagated-inputs `(("p1" ,p1))))) + (p3 (dummy-package "p3" + (native-search-paths (sp "PATH3")) + (native-inputs `(("p0" ,p0))) + (propagated-inputs `(("p2" ,p2)))))) + (lset= string=? + '("PATH1" "PATH2" "PATH3") + (map search-path-specification-variable + (package-transitive-native-search-paths p3))))) + (test-assert "package-cross-derivation" (let ((drv (package-cross-derivation %store (dummy-package "p") "mips64el-linux-gnu"))) diff --git a/tests/profiles.scm b/tests/profiles.scm index cc9a822cee..e659c2e26d 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -32,6 +32,7 @@ #:use-module (ice-9 regex) #:use-module (ice-9 popen) #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-64)) @@ -224,6 +225,14 @@ (package-native-search-paths packages:guile-2.0))))))))) +(test-assert "package->manifest-entry, search paths" + ;; See <http://bugs.gnu.org/22073>. + (let ((mpl (@ (gnu packages python) python2-matplotlib))) + (lset= eq? + (package-transitive-native-search-paths mpl) + (manifest-entry-search-paths + (package->manifest-entry mpl))))) + (test-assertm "etc/profile" ;; Make sure we get an 'etc/profile' file that at least defines $PATH. (mlet* %store-monad |