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

Merge branch 'master' into python-build-system

This commit is contained in:
Leo Famulari 2016-11-25 11:20:21 -05:00
parent d46491779e d66cbd1adc
commit de32aa74b4
No known key found for this signature in database
GPG Key ID: 2646FA30BACA7F08
108 changed files with 4566 additions and 885 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitignore vendored
View File

@ -50,6 +50,8 @@
/emacs/guix-helper.scm /emacs/guix-helper.scm
/etc/guix-daemon.conf /etc/guix-daemon.conf
/etc/guix-daemon.service /etc/guix-daemon.service
/etc/guix-publish.conf
/etc/guix-publish.service
/guix-daemon /guix-daemon
/guix-register /guix-register
/guix/config.scm /guix/config.scm
@ -125,3 +127,4 @@ config.cache
stamp-h[0-9] stamp-h[0-9]
tmp tmp
/doc/os-config-lightweight-desktop.texi /doc/os-config-lightweight-desktop.texi
/nix/scripts/download

9
Makefile.am
View File

@ -123,6 +123,7 @@ MODULES = \
guix/import/elpa.scm \ guix/import/elpa.scm \
guix/scripts.scm \ guix/scripts.scm \
guix/scripts/download.scm \ guix/scripts/download.scm \
guix/scripts/perform-download.scm \
guix/scripts/build.scm \ guix/scripts/build.scm \
guix/scripts/archive.scm \ guix/scripts/archive.scm \
guix/scripts/import.scm \ guix/scripts/import.scm \
@ -171,8 +172,8 @@ MODULES += \
endif BUILD_DAEMON_OFFLOAD endif BUILD_DAEMON_OFFLOAD
# Internal module with test suite support. # Internal modules with test suite support.
dist_noinst_DATA = guix/tests.scm dist_noinst_DATA = guix/tests.scm guix/tests/http.scm
# Linux-Libre configurations. # Linux-Libre configurations.
KCONFIGS = \ KCONFIGS = \
@ -189,7 +190,7 @@ EXAMPLES = \
gnu/system/examples/desktop.tmpl \ gnu/system/examples/desktop.tmpl \
gnu/system/examples/lightweight-desktop.tmpl gnu/system/examples/lightweight-desktop.tmpl
GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go guix/tests.go GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go $(dist_noinst_DATA:%.scm=%.go)
nobase_dist_guilemodule_DATA = \ nobase_dist_guilemodule_DATA = \
$(MODULES) $(KCONFIGS) $(EXAMPLES) \ $(MODULES) $(KCONFIGS) $(EXAMPLES) \
@ -407,7 +408,7 @@ CLEANFILES = \
# the whole thing. Likewise, set 'XDG_CACHE_HOME' to avoid loading possibly # the whole thing. Likewise, set 'XDG_CACHE_HOME' to avoid loading possibly
# stale files from ~/.cache/guile/ccache. # stale files from ~/.cache/guile/ccache.
%.go: make-go ; @: %.go: make-go ; @:
make-go: $(MODULES) guix/config.scm guix/tests.scm make-go: $(MODULES) guix/config.scm $(dist_noinst_DATA)
$(AM_V_at)echo "Compiling Scheme modules..." ; \ $(AM_V_at)echo "Compiling Scheme modules..." ; \
unset GUILE_LOAD_COMPILED_PATH ; \ unset GUILE_LOAD_COMPILED_PATH ; \
XDG_CACHE_HOME=/nowhere \ XDG_CACHE_HOME=/nowhere \

2
config-daemon.ac
View File

@ -144,6 +144,8 @@ if test "x$guix_build_daemon" = "xyes"; then
AC_CONFIG_FILES([nix/scripts/list-runtime-roots], AC_CONFIG_FILES([nix/scripts/list-runtime-roots],
[chmod +x nix/scripts/list-runtime-roots]) [chmod +x nix/scripts/list-runtime-roots])
AC_CONFIG_FILES([nix/scripts/download],
[chmod +x nix/scripts/download])
AC_CONFIG_FILES([nix/scripts/substitute], AC_CONFIG_FILES([nix/scripts/substitute],
[chmod +x nix/scripts/substitute]) [chmod +x nix/scripts/substitute])
AC_CONFIG_FILES([nix/scripts/guix-authenticate], AC_CONFIG_FILES([nix/scripts/guix-authenticate],

189
doc/guix.texi
View File

@ -453,7 +453,7 @@ If your host distro uses the systemd init system, this can be achieved
with these commands: with these commands:
@example @example
# cp ~root/.guix-profile/lib/systemd/system/guix-daemon.service \ # ln -s ~root/.guix-profile/lib/systemd/system/guix-daemon.service \
/etc/systemd/system/ /etc/systemd/system/
# systemctl start guix-daemon && systemctl enable guix-daemon # systemctl start guix-daemon && systemctl enable guix-daemon
@end example @end example
@ -461,7 +461,7 @@ with these commands:
If your host distro uses the Upstart init system: If your host distro uses the Upstart init system:
@example @example
# cp ~root/.guix-profile/lib/upstart/system/guix-daemon.conf /etc/init/ # ln -s ~root/.guix-profile/lib/upstart/system/guix-daemon.conf /etc/init/
# start guix-daemon # start guix-daemon
@end example @end example
@ -4841,6 +4841,10 @@ When using this option, you have @emph{absolutely no guarantee} that you
are communicating with the authentic server responsible for the given are communicating with the authentic server responsible for the given
URL, which makes you vulnerable to ``man-in-the-middle'' attacks. URL, which makes you vulnerable to ``man-in-the-middle'' attacks.
@item --output=@var{file}
@itemx -o @var{file}
Save the downloaded file to @var{file} instead of adding it to the
store.
@end table @end table
@node Invoking guix hash @node Invoking guix hash
@ -5380,9 +5384,11 @@ Identify inputs that should most likely be native inputs.
@item source @item source
@itemx home-page @itemx home-page
@itemx mirror-url
@itemx source-file-name @itemx source-file-name
Probe @code{home-page} and @code{source} URLs and report those that are Probe @code{home-page} and @code{source} URLs and report those that are
invalid. Check that the source file name is meaningful, e.g. is not invalid. Suggest a @code{mirror://} URL when applicable. Check that
the source file name is meaningful, e.g. is not
just a version number or ``git-checkout'', without a declared just a version number or ``git-checkout'', without a declared
@code{file-name} (@pxref{origin Reference}). @code{file-name} (@pxref{origin Reference}).
@ -6054,6 +6060,30 @@ add a call to @code{guix-publish-service} in the @code{services} field
of the @code{operating-system} declaration (@pxref{guix-publish-service, of the @code{operating-system} declaration (@pxref{guix-publish-service,
@code{guix-publish-service}}). @code{guix-publish-service}}).
If you are instead running Guix on a ``foreign distro'', follow these
instructions:”
@itemize
@item
If your host distro uses the systemd init system:
@example
# ln -s ~root/.guix-profile/lib/systemd/system/guix-publish.service \
/etc/systemd/system/
# systemctl start guix-publish && systemctl enable guix-publish
@end example
@item
If your host distro uses the Upstart init system:
@example
# ln -s ~root/.guix-profile/lib/upstart/system/guix-publish.conf /etc/init/
# start guix-publish
@end example
@item
Otherwise, proceed similarly with your distro's init system.
@end itemize
@node Invoking guix challenge @node Invoking guix challenge
@section Invoking @command{guix challenge} @section Invoking @command{guix challenge}
@ -6404,7 +6434,9 @@ hardware is not supported on GuixSD.
One of the main areas where free drivers or firmware are lacking is WiFi One of the main areas where free drivers or firmware are lacking is WiFi
devices. WiFi devices known to work include those using Atheros chips devices. WiFi devices known to work include those using Atheros chips
(AR9271 and AR7010), which corresponds to the @code{ath9k} Linux-libre (AR9271 and AR7010), which corresponds to the @code{ath9k} Linux-libre
driver, and for which free firmware exists and is available driver, and those using Broadcom/AirForce chips (BCM43xx with
Wireless-Core Revision 5), which corresponds to the @code{b43-open}
Linux-libre driver. Free firmware exists for both and is available
out-of-the-box on GuixSD, as part of @var{%base-firmware} out-of-the-box on GuixSD, as part of @var{%base-firmware}
(@pxref{operating-system Reference, @code{firmware}}). (@pxref{operating-system Reference, @code{firmware}}).
@ -6638,27 +6670,26 @@ partition lives at @file{/dev/sda1}, a file system with the label
mkfs.ext4 -L my-root /dev/sda1 mkfs.ext4 -L my-root /dev/sda1
@end example @end example
@c FIXME: Uncomment this once GRUB fully supports encrypted roots. @cindex encrypted disk
@c A typical command sequence may be: If you are instead planning to encrypt the root partition, you can use
@c the Cryptsetup/LUKS utilities to do that (see @inlinefmtifelse{html,
@c @example @uref{https://linux.die.net/man/8/cryptsetup, @code{man cryptsetup}},
@c # fdisk /dev/sdX @code{man cryptsetup}} for more information.) Assuming you want to
@c @dots{} Create partitions etc.@dots{} store the root partition on @file{/dev/sda1}, the command sequence would
@c # cryptsetup luksFormat /dev/sdX1 be along these lines:
@c # cryptsetup open --type luks /dev/sdX1 my-partition
@c # mkfs.ext4 -L my-root /dev/mapper/my-partition
@c @end example
In addition to e2fsprogs, the suite of tools to manipulate
ext2/ext3/ext4 file systems, the installation image includes
Cryptsetup/LUKS for disk encryption.
Once that is done, mount the target root partition under @file{/mnt}
with a command like (again, assuming @file{/dev/sda1} is the root
partition):
@example @example
mount /dev/sda1 /mnt cryptsetup luksFormat /dev/sda1
cryptsetup open --type luks /dev/sda1 my-partition
mkfs.ext4 -L my-root /dev/mapper/my-partition
@end example
Once that is done, mount the target root partition under @file{/mnt}
with a command like (again, assuming @code{my-root} is the label of the
root partition):
@example
mount LABEL=my-root /mnt
@end example @end example
Finally, if you plan to use one or more swap partitions (@pxref{Memory Finally, if you plan to use one or more swap partitions (@pxref{Memory
@ -6721,6 +6752,10 @@ Be sure that your partition labels match the value of their respective
@code{device} fields in your @code{file-system} configuration, assuming @code{device} fields in your @code{file-system} configuration, assuming
your @code{file-system} configuration sets the value of @code{title} to your @code{file-system} configuration sets the value of @code{title} to
@code{'label}. @code{'label}.
@item
If there are encrypted or RAID partitions, make sure to add a
@code{mapped-devices} field to describe them (@pxref{Mapped Devices}).
@end itemize @end itemize
Once you are done preparing the configuration file, the new system must Once you are done preparing the configuration file, the new system must
@ -6965,7 +7000,9 @@ desired configuration. In particular, notice how we use @code{inherit}
to create a new configuration which has the same values as the old to create a new configuration which has the same values as the old
configuration, but with a few modifications. configuration, but with a few modifications.
The configuration for a typical ``desktop'' usage, with the X11 display @cindex encrypted disk
The configuration for a typical ``desktop'' usage, with an encrypted
root partition, the X11 display
server, GNOME and Xfce (users can choose which of these desktop server, GNOME and Xfce (users can choose which of these desktop
environments to use at the log-in screen by pressing @kbd{F1}), network environments to use at the log-in screen by pressing @kbd{F1}), network
management, power management, and more, would look like this: management, power management, and more, would look like this:
@ -7078,9 +7115,10 @@ the Linux kernel. @xref{Initial RAM Disk}.
@cindex firmware @cindex firmware
List of firmware packages loadable by the operating system kernel. List of firmware packages loadable by the operating system kernel.
The default includes firmware needed for Atheros-based WiFi devices The default includes firmware needed for Atheros- and Broadcom-based
(Linux-libre module @code{ath9k}). @xref{Hardware Considerations}, for WiFi devices (Linux-libre modules @code{ath9k} and @code{b43-open},
more info on supported hardware. respectively). @xref{Hardware Considerations}, for more info on
supported hardware.
@item @code{host-name} @item @code{host-name}
The host name. The host name.
@ -7289,13 +7327,16 @@ errors before being mounted.
When true, the mount point is created if it does not exist yet. When true, the mount point is created if it does not exist yet.
@item @code{dependencies} (default: @code{'()}) @item @code{dependencies} (default: @code{'()})
This is a list of @code{<file-system>} objects representing file systems This is a list of @code{<file-system>} or @code{<mapped-device>} objects
that must be mounted before (and unmounted after) this one. representing file systems that must be mounted or mapped devices that
must be opened before (and unmounted or closed after) this one.
As an example, consider a hierarchy of mounts: @file{/sys/fs/cgroup} is As an example, consider a hierarchy of mounts: @file{/sys/fs/cgroup} is
a dependency of @file{/sys/fs/cgroup/cpu} and a dependency of @file{/sys/fs/cgroup/cpu} and
@file{/sys/fs/cgroup/memory}. @file{/sys/fs/cgroup/memory}.
Another example is a file system that depends on a mapped device, for
example for an encrypted partition (@pxref{Mapped Devices}).
@end table @end table
@end deftp @end deftp
@ -8364,10 +8405,10 @@ Protocol (DHCP) client, on all the non-loopback network interfaces.
@end deffn @end deffn
@deffn {Scheme Procedure} static-networking-service @var{interface} @var{ip} @ @deffn {Scheme Procedure} static-networking-service @var{interface} @var{ip} @
[#:gateway #f] [#:name-servers @code{'()}] [#:netmask #f] [#:gateway #f] [#:name-servers @code{'()}]
Return a service that starts @var{interface} with address @var{ip}. If Return a service that starts @var{interface} with address @var{ip}. If
@var{gateway} is true, it must be a string specifying the default network @var{netmask} is true, use it as the network mask. If @var{gateway} is true,
gateway. it must be a string specifying the default network gateway.
@end deffn @end deffn
@cindex wicd @cindex wicd
@ -8403,13 +8444,22 @@ configure networking."
@end deffn @end deffn
@cindex WPA Supplicant @cindex WPA Supplicant
@deffn {Scheme Procedure} wpa-supplicant-service @ @defvr {Scheme Variable} wpa-supplicant-service-type
[#:wpa-supplicant @var{wpa-supplicant}] This is the service type to run @url{https://w1.fi/wpa_supplicant/,WPA
Return a service that runs @url{https://w1.fi/wpa_supplicant/,WPA
supplicant}, an authentication daemon required to authenticate against supplicant}, an authentication daemon required to authenticate against
encrypted WiFi or ethernet networks. Service is started to listen for encrypted WiFi or ethernet networks. It is configured to listen for
requests on D-Bus. requests on D-Bus.
@end deffn
The value of this service is the @code{wpa-supplicant} package to use.
Thus, it can be instantiated like this:
@lisp
(use-modules (gnu services networking)
(gnu packages admin))
(service wpa-supplicant-type wpa-supplicant)
@end lisp
@end defvr
@cindex NTP @cindex NTP
@cindex real time clock @cindex real time clock
@ -11367,13 +11417,13 @@ could instantiate a dovecot service like this:
@subsubsection Kerberos Services @subsubsection Kerberos Services
@cindex Kerberos @cindex Kerberos
The @code{(gnu services Kerberos)} module provides services relating to The @code{(gnu services kerberos)} module provides services relating to
the authentication protocol @dfn{Kerberos}. the authentication protocol @dfn{Kerberos}.
@subsubheading PAM krb5 Service @subsubheading PAM krb5 Service
@cindex pam-krb5 @cindex pam-krb5
The pam-krb5 service allows for login authentication and password The @code{pam-krb5} service allows for login authentication and password
management via Kerberos. management via Kerberos.
You will need this service if you want PAM enabled applications to authenticate You will need this service if you want PAM enabled applications to authenticate
users using Kerberos. users using Kerberos.
@ -11672,6 +11722,67 @@ A @code{<dicod-database>} object serving the GNU Collaborative International
Dictonary of English using the @code{gcide} package. Dictonary of English using the @code{gcide} package.
@end defvr @end defvr
@subsubsection Version Control
The @code{(gnu services version-control)} module provides the following services:
@subsubheading Git daemon service
@deffn {Scheme Procedure} git-daemon-service [#:config (git-daemon-configuration)]
Return a service that runs @command{git daemon}, a simple TCP server to
expose repositiories over the Git protocol for annoymous access.
The optional @var{config} argument should be a
@code{<git-daemon-configuration>} object, by default it allows read-only
access to exported@footnote{By creating the magic file
"git-daemon-export-ok" in the repository directory.} repositories under
@file{/srv/git}.
@end deffn
@deftp {Data Type} git-daemon-configuration
Data type representing the configuration for @code{git-daemon-service}.
@table @asis
@item @code{package} (default: @var{git})
Package object of the Git distributed version control system.
@item @code{export-all?} (default: @var{#f})
Whether to allow access for all Git repositories, even if they do not
have the @file{git-daemon-export-ok} file.
@item @code{base-path} (default: @file{/srv/git})
Whether to remap all the path requests as relative to the given path.
If you run git daemon with @var{(base-path "/srv/git")} on example.com,
then if you later try to pull @code{git://example.com/hello.git}, git
daemon will interpret the path as @code{/srv/git/hello.git}.
@item @code{user-path} (default: @var{#f})
Whether to allow @code{~user} notation to be used in requests. When
specified with empty string, requests to @code{git://host/~alice/foo} is
taken as a request to access @code{foo} repository in the home directory
of user @code{alice}. If @var{(user-path "path")} is specified, the
same request is taken as a request to access @code{path/foo} repository
in the home directory of user @code{alice}.
@item @code{listen} (default: @var{'()})
Whether to listen on specific IP addresses or hostnames, defaults to
all.
@item @code{port} (default: @var{#f})
Whether to listen on an alternative port, which defaults to 9418.
@item @code{whitelist} (default: @var{'()})
If not empty, only allow access to this list of directories.
@item @code{extra-options} (default: @var{'()})
Extra options will be passed to @code{git daemon}, please run
@command{man git-daemon} for more information.
@end table
@end deftp
@node Setuid Programs @node Setuid Programs
@subsection Setuid Programs @subsection Setuid Programs

12
etc/guix-publish.conf.in Normal file
View File

@ -0,0 +1,12 @@
# This is a "job" for the Upstart init system to launch 'guix-daemon'.
# Drop it in /etc/init to have 'guix-daemon' automatically started.
description "Publish the GNU Guix store"
start on runlevel [2345]
stop on runlevel [016]
task
exec @bindir@/guix publish --user=nobody --port=8181

19
etc/guix-publish.service.in Normal file
View File

@ -0,0 +1,19 @@
# This is a "service unit file" for the systemd init system to launch
# 'guix publish'. Drop it in /etc/systemd/system or similar to have
# 'guix publish' automatically started.
[Unit]
Description=Publish the GNU Guix store
[Service]
ExecStart=@bindir@/guix publish --user=nobody --port=8181
Environment=GUIX_LOCPATH=/root/.guix-profile/lib/locale
RemainAfterExit=yes
StandardOutput=syslog
StandardError=syslog
# See <https://lists.gnu.org/archive/html/guix-devel/2016-04/msg00608.html>.
TasksMax=1024
[Install]
WantedBy=multi-user.target

5
gnu/build/install.scm
View File

@ -46,6 +46,11 @@ Note that the caller must make sure that GRUB.CFG is registered as a GC root
so that the fonts, background images, etc. referred to by GRUB.CFG are not so that the fonts, background images, etc. referred to by GRUB.CFG are not
GC'd." GC'd."
(install-grub-config grub.cfg mount-point) (install-grub-config grub.cfg mount-point)
;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or root
;; partition.
(setenv "GRUB_ENABLE_CRYPTODISK" "y")
(unless (zero? (system* "grub-install" "--no-floppy" (unless (zero? (system* "grub-install" "--no-floppy"
"--boot-directory" "--boot-directory"
(string-append mount-point "/boot") (string-append mount-point "/boot")

102
gnu/build/marionette.scm
View File

@ -21,10 +21,13 @@
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 popen)
#:export (marionette? #:export (marionette?
make-marionette make-marionette
marionette-eval marionette-eval
marionette-control marionette-control
marionette-screen-text
wait-for-screen-text
%qwerty-us-keystrokes %qwerty-us-keystrokes
marionette-type)) marionette-type))
@ -45,7 +48,10 @@
(command marionette-command) ;list of strings (command marionette-command) ;list of strings
(pid marionette-pid) ;integer (pid marionette-pid) ;integer
(monitor marionette-monitor) ;port (monitor marionette-monitor) ;port
(repl marionette-repl)) ;port (repl %marionette-repl)) ;promise of a port
(define-syntax-rule (marionette-repl marionette)
(force (%marionette-repl marionette)))
(define* (wait-for-monitor-prompt port #:key (quiet? #t)) (define* (wait-for-monitor-prompt port #:key (quiet? #t))
"Read from PORT until we have seen all of QEMU's monitor prompt. When "Read from PORT until we have seen all of QEMU's monitor prompt. When
@ -93,6 +99,13 @@ QEMU monitor and to the guest's backdoor REPL."
"-device" "virtio-serial" "-device" "virtio-serial"
"-device" "virtconsole,chardev=repl")) "-device" "virtconsole,chardev=repl"))
(define (accept* port)
(match (select (list port) '() (list port) timeout)
(((port) () ())
(accept port))
(_
(error "timeout in 'accept'" port))))
(let ((monitor (socket AF_UNIX SOCK_STREAM 0)) (let ((monitor (socket AF_UNIX SOCK_STREAM 0))
(repl (socket AF_UNIX SOCK_STREAM 0))) (repl (socket AF_UNIX SOCK_STREAM 0)))
(bind monitor (file->sockaddr "monitor")) (bind monitor (file->sockaddr "monitor"))
@ -117,34 +130,36 @@ QEMU monitor and to the guest's backdoor REPL."
(primitive-exit 1)))) (primitive-exit 1))))
(pid (pid
(format #t "QEMU runs as PID ~a~%" pid) (format #t "QEMU runs as PID ~a~%" pid)
(sigaction SIGALRM
(lambda (signum)
(display "time is up!\n") ;FIXME: break
#t))
(alarm timeout)
(match (accept monitor) (match (accept* monitor)
((monitor-conn . _) ((monitor-conn . _)
(display "connected to QEMU's monitor\n") (display "connected to QEMU's monitor\n")
(close-port monitor) (close-port monitor)
(wait-for-monitor-prompt monitor-conn) (wait-for-monitor-prompt monitor-conn)
(display "read QEMU monitor prompt\n") (display "read QEMU monitor prompt\n")
(match (accept repl)
((repl-conn . addr) (marionette (append command extra-options) pid
(display "connected to guest REPL\n") monitor-conn
(close-port repl)
(match (read repl-conn) ;; The following 'accept' call connects immediately, but
('ready ;; we don't know whether the guest has connected until
(alarm 0) ;; we actually receive the 'ready' message.
(sigaction SIGALRM SIG_DFL) (match (accept* repl)
(display "marionette is ready\n") ((repl-conn . addr)
(marionette (append command extra-options) pid (display "connected to guest REPL\n")
monitor-conn repl-conn))))))))))) (close-port repl)
;; Delay reception of the 'ready' message so that the
;; caller can already send monitor commands.
(delay
(match (read repl-conn)
('ready
(display "marionette is ready\n")
repl-conn))))))))))))
(define (marionette-eval exp marionette) (define (marionette-eval exp marionette)
"Evaluate EXP in MARIONETTE's backdoor REPL. Return the result." "Evaluate EXP in MARIONETTE's backdoor REPL. Return the result."
(match marionette (match marionette
(($ <marionette> command pid monitor repl) (($ <marionette> command pid monitor (= force repl))
(write exp repl) (write exp repl)
(newline repl) (newline repl)
(read repl)))) (read repl))))
@ -159,6 +174,55 @@ pcsys_monitor\")."
(newline monitor) (newline monitor)
(wait-for-monitor-prompt monitor)))) (wait-for-monitor-prompt monitor))))
(define* (marionette-screen-text marionette
#:key
(ocrad "ocrad"))
"Take a screenshot of MARIONETTE, perform optical character
recognition (OCR), and return the text read from the screen as a string. Do
this by invoking OCRAD (file name for GNU Ocrad's command)"
(define (random-file-name)
(string-append "/tmp/marionette-screenshot-"
(number->string (random (expt 2 32)) 16)
".ppm"))
(let ((image (random-file-name)))
(dynamic-wind
(const #t)
(lambda ()
(marionette-control (string-append "screendump " image)
marionette)
;; Tell Ocrad to invert the image colors (make it black on white) and
;; to scale the image up, which significantly improves the quality of
;; the result. In spite of this, be aware that OCR confuses "y" and
;; "V" and sometimes erroneously introduces white space.
(let* ((pipe (open-pipe* OPEN_READ ocrad
"-i" "-s" "10" image))
(text (get-string-all pipe)))
(unless (zero? (close-pipe pipe))
(error "'ocrad' failed" ocrad))
text))
(lambda ()
(false-if-exception (delete-file image))))))
(define* (wait-for-screen-text marionette predicate
#:key (timeout 30) (ocrad "ocrad"))
"Wait for TIMEOUT seconds or until the screen text on MARIONETTE matches
PREDICATE, whichever comes first. Raise an error when TIMEOUT is exceeded."
(define start
(car (gettimeofday)))
(define end
(+ start timeout))
(let loop ()
(if (> (car (gettimeofday)) end)
(error "'wait-for-screen-text' timeout" predicate)
(or (predicate (marionette-screen-text marionette #:ocrad ocrad))
(begin
(sleep 1)
(loop))))))
(define %qwerty-us-keystrokes (define %qwerty-us-keystrokes
;; Maps "special" characters to their keystrokes. ;; Maps "special" characters to their keystrokes.
'((#\newline . "ret") '((#\newline . "ret")

11
gnu/local.mk
View File

@ -295,6 +295,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/pem.scm \ %D%/packages/pem.scm \
%D%/packages/perl.scm \ %D%/packages/perl.scm \
%D%/packages/photo.scm \ %D%/packages/photo.scm \
%D%/packages/php.scm \
%D%/packages/pkg-config.scm \ %D%/packages/pkg-config.scm \
%D%/packages/plotutils.scm \ %D%/packages/plotutils.scm \
%D%/packages/polkit.scm \ %D%/packages/polkit.scm \
@ -415,6 +416,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/sddm.scm \ %D%/services/sddm.scm \
%D%/services/spice.scm \ %D%/services/spice.scm \
%D%/services/ssh.scm \ %D%/services/ssh.scm \
%D%/services/version-control.scm \
%D%/services/web.scm \ %D%/services/web.scm \
%D%/services/xorg.scm \ %D%/services/xorg.scm \
\ \
@ -551,8 +553,10 @@ dist_patch_DATA = \
%D%/packages/patches/gcc-6-cross-environment-variables.patch \ %D%/packages/patches/gcc-6-cross-environment-variables.patch \
%D%/packages/patches/gd-CVE-2016-7568.patch \ %D%/packages/patches/gd-CVE-2016-7568.patch \
%D%/packages/patches/gd-CVE-2016-8670.patch \ %D%/packages/patches/gd-CVE-2016-8670.patch \
%D%/packages/patches/gd-fix-chunk-size-on-boundaries.patch \
%D%/packages/patches/gd-fix-gd2-read-test.patch \ %D%/packages/patches/gd-fix-gd2-read-test.patch \
%D%/packages/patches/gd-fix-tests-on-i686.patch \ %D%/packages/patches/gd-fix-tests-on-i686.patch \
%D%/packages/patches/gd-fix-truecolor-format-correction.patch \
%D%/packages/patches/gegl-CVE-2012-4433.patch \ %D%/packages/patches/gegl-CVE-2012-4433.patch \
%D%/packages/patches/geoclue-config.patch \ %D%/packages/patches/geoclue-config.patch \
%D%/packages/patches/ghostscript-CVE-2013-5653.patch \ %D%/packages/patches/ghostscript-CVE-2013-5653.patch \
@ -587,6 +591,7 @@ dist_patch_DATA = \
%D%/packages/patches/guile-linux-syscalls.patch \ %D%/packages/patches/guile-linux-syscalls.patch \
%D%/packages/patches/guile-present-coding.patch \ %D%/packages/patches/guile-present-coding.patch \
%D%/packages/patches/guile-relocatable.patch \ %D%/packages/patches/guile-relocatable.patch \
%D%/packages/patches/guile-repl-server-test.patch \
%D%/packages/patches/guile-rsvg-pkgconfig.patch \ %D%/packages/patches/guile-rsvg-pkgconfig.patch \
%D%/packages/patches/gtk2-respect-GUIX_GTK2_PATH.patch \ %D%/packages/patches/gtk2-respect-GUIX_GTK2_PATH.patch \
%D%/packages/patches/gtk2-respect-GUIX_GTK2_IM_MODULE_FILE.patch \ %D%/packages/patches/gtk2-respect-GUIX_GTK2_IM_MODULE_FILE.patch \
@ -594,6 +599,7 @@ dist_patch_DATA = \
%D%/packages/patches/gtk3-respect-GUIX_GTK3_PATH.patch \ %D%/packages/patches/gtk3-respect-GUIX_GTK3_PATH.patch \
%D%/packages/patches/gtk3-respect-GUIX_GTK3_IM_MODULE_FILE.patch \ %D%/packages/patches/gtk3-respect-GUIX_GTK3_IM_MODULE_FILE.patch \
%D%/packages/patches/gtkglext-disable-disable-deprecated.patch \ %D%/packages/patches/gtkglext-disable-disable-deprecated.patch \
%D%/packages/patches/handbrake-pkg-config-path.patch \
%D%/packages/patches/hdf4-architectures.patch \ %D%/packages/patches/hdf4-architectures.patch \
%D%/packages/patches/hdf4-reproducibility.patch \ %D%/packages/patches/hdf4-reproducibility.patch \
%D%/packages/patches/hdf4-shared-fortran.patch \ %D%/packages/patches/hdf4-shared-fortran.patch \
@ -612,6 +618,7 @@ dist_patch_DATA = \
%D%/packages/patches/hypre-ldflags.patch \ %D%/packages/patches/hypre-ldflags.patch \
%D%/packages/patches/icecat-avoid-bundled-libraries.patch \ %D%/packages/patches/icecat-avoid-bundled-libraries.patch \
%D%/packages/patches/icecat-binutils.patch \ %D%/packages/patches/icecat-binutils.patch \
%D%/packages/patches/icecat-CVE-2016-9064.patch \
%D%/packages/patches/icu4c-CVE-2014-6585.patch \ %D%/packages/patches/icu4c-CVE-2014-6585.patch \
%D%/packages/patches/icu4c-CVE-2015-1270.patch \ %D%/packages/patches/icu4c-CVE-2015-1270.patch \
%D%/packages/patches/icu4c-CVE-2015-4760.patch \ %D%/packages/patches/icu4c-CVE-2015-4760.patch \
@ -665,8 +672,6 @@ dist_patch_DATA = \
%D%/packages/patches/libtiff-CVE-2016-5314.patch \ %D%/packages/patches/libtiff-CVE-2016-5314.patch \
%D%/packages/patches/libtiff-CVE-2016-5321.patch \ %D%/packages/patches/libtiff-CVE-2016-5321.patch \
%D%/packages/patches/libtiff-CVE-2016-5323.patch \ %D%/packages/patches/libtiff-CVE-2016-5323.patch \
%D%/packages/patches/libtiff-CVE-2016-5652.patch \
%D%/packages/patches/libtiff-CVE-2016-9273.patch \
%D%/packages/patches/libtiff-oob-accesses-in-decode.patch \ %D%/packages/patches/libtiff-oob-accesses-in-decode.patch \
%D%/packages/patches/libtiff-oob-write-in-nextdecode.patch \ %D%/packages/patches/libtiff-oob-write-in-nextdecode.patch \
%D%/packages/patches/libtool-skip-tests2.patch \ %D%/packages/patches/libtool-skip-tests2.patch \
@ -700,6 +705,7 @@ dist_patch_DATA = \
%D%/packages/patches/luajit-no_ldconfig.patch \ %D%/packages/patches/luajit-no_ldconfig.patch \
%D%/packages/patches/luajit-symlinks.patch \ %D%/packages/patches/luajit-symlinks.patch \
%D%/packages/patches/luit-posix.patch \ %D%/packages/patches/luit-posix.patch \
%D%/packages/patches/lvm2-static-link.patch \
%D%/packages/patches/make-impure-dirs.patch \ %D%/packages/patches/make-impure-dirs.patch \
%D%/packages/patches/mars-install.patch \ %D%/packages/patches/mars-install.patch \
%D%/packages/patches/mars-sfml-2.3.patch \ %D%/packages/patches/mars-sfml-2.3.patch \
@ -785,6 +791,7 @@ dist_patch_DATA = \
%D%/packages/patches/pinball-src-deps.patch \ %D%/packages/patches/pinball-src-deps.patch \
%D%/packages/patches/pinball-system-ltdl.patch \ %D%/packages/patches/pinball-system-ltdl.patch \
%D%/packages/patches/pingus-sdl-libs-config.patch \ %D%/packages/patches/pingus-sdl-libs-config.patch \
%D%/packages/patches/pixman-CVE-2016-5296.patch \
%D%/packages/patches/plink-1.07-unclobber-i.patch \ %D%/packages/patches/plink-1.07-unclobber-i.patch \
%D%/packages/patches/plink-endian-detection.patch \ %D%/packages/patches/plink-endian-detection.patch \
%D%/packages/patches/plotutils-libpng-jmpbuf.patch \ %D%/packages/patches/plotutils-libpng-jmpbuf.patch \

4
gnu/packages/algebra.scm
View File

@ -202,7 +202,7 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
(define-public giac-xcas (define-public giac-xcas
(package (package
(name "giac-xcas") (name "giac-xcas")
(version "1.2.2-95") (version "1.2.2-103")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
;; "~parisse/giac" is not used because the maintainer regularly ;; "~parisse/giac" is not used because the maintainer regularly
@ -214,7 +214,7 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
"source/giac_" version ".tar.gz")) "source/giac_" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1zyaz5pgj7w6ka4qxic4kmbcqcikpn8ry3jvhi2kd72hwa0v65y2")))) "1qrhjw2sdvyv2x8fqs9isqv8rgldn448gfxbi7zbva8m5va5b3z1"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases

10
gnu/packages/aspell.scm
View File

@ -1,7 +1,8 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright ©2016 John Darrington <jmd@gnu.org> ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -155,3 +156,10 @@ dictionaries, including personal ones.")
#:sha256 #:sha256
(base32 (base32
"0ffb87yjsh211hllpc4b9khqqrblial4pzi1h9r3v465z1yhn3j4"))) "0ffb87yjsh211hllpc4b9khqqrblial4pzi1h9r3v465z1yhn3j4")))
(define-public aspell-dict-he
(aspell-dictionary "he" "Hebrew"
#:version "1.0-0"
#:sha256
(base32
"13bhbghx5b8g0119g3wxd4n8mlf707y41vlf59irxjj0kynankfn")))

82
gnu/packages/audio.scm
View File

@ -8,6 +8,7 @@
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com> ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is> ;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016 Lukas Gradl <lgradl@openmailbox.org> ;;; Copyright © 2016 Lukas Gradl <lgradl@openmailbox.org>
;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -343,6 +344,57 @@ tools (analyzer, mono/stereo tools, crossovers).")
;; The plugins are released under LGPLv2.1+ ;; The plugins are released under LGPLv2.1+
(license (list license:lgpl2.1+ license:gpl2+)))) (license (list license:lgpl2.1+ license:gpl2+))))
(define-public espeak
(package
(name "espeak")
(version "1.48.04")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/espeak/espeak/"
"espeak-" (version-major+minor version)
"/espeak-" version "-source.zip"))
(sha256
(base32
"0n86gwh9pw0jqqpdz7mxggllfr8k0r7pc67ayy7w5z6z79kig6mz"))
(modules '((guix build utils)))
(snippet
;; remove prebuilt binaries
'(delete-file-recursively "linux_32bit"))))
(build-system gnu-build-system)
(arguments
`(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
(string-append "DATADIR="
(assoc-ref %outputs "out")
"/share/espeak-data")
(string-append "LDFLAGS=-Wl,-rpath="
(assoc-ref %outputs "out")
"/lib")
"AUDIO=pulseaudio")
#:tests? #f ; no check target
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda _
(chdir "src")
;; We use version 19 of the PortAudio library, so we must copy the
;; corresponding file to be sure that espeak compiles correctly.
(copy-file "portaudio19.h" "portaudio.h")
(substitute* "Makefile"
(("/bin/ln") "ln"))
#t)))))
(inputs
`(("portaudio" ,portaudio)
("pulseaudio" ,pulseaudio)))
(native-inputs `(("unzip" ,unzip)))
(home-page "http://espeak.sourceforge.net/")
(synopsis "Software speech synthesizer")
(description "eSpeak is a software speech synthesizer for English and
other languages. eSpeak uses a \"formant synthesis\" method. This allows many
languages to be provided in a small size. The speech is clear, and can be used
at high speeds, but is not as natural or smooth as larger synthesizers which are
based on human speech recordings.")
(license license:gpl3+)))
(define-public infamous-plugins (define-public infamous-plugins
(package (package
(name "infamous-plugins") (name "infamous-plugins")
@ -1126,19 +1178,24 @@ well suited to all musical instruments and vocals.")
(version "1.3.2") (version "1.3.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append ;; The original home-page is gone. Download the tarball from an
"http://factorial.hu/system/files/ir.lv2-" ;; archive mirror instead.
version ".tar.gz")) (uri (list (string-append
"https://web.archive.org/web/20150803095032/"
"http://factorial.hu/system/files/ir.lv2-"
version ".tar.gz")
(string-append
"https://mirrors.kernel.org/gentoo/distfiles/ir.lv2-"
version ".tar.gz")))
(sha256 (sha256
(base32 (base32
"1jh2z01l9m4ar7yz0n911df07dygc7n4cl59p7qdjbh0nvkm747g")))) "1jh2z01l9m4ar7yz0n911df07dygc7n4cl59p7qdjbh0nvkm747g"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f ;no "check" target `(#:tests? #f ; no tests
#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))) #:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")))
#:phases #:phases (modify-phases %standard-phases
;; no configure script (delete 'configure)))) ; no configure script
(alist-delete 'configure %standard-phases)))
(inputs (inputs
`(("libsndfile" ,libsndfile) `(("libsndfile" ,libsndfile)
("libsamplerate" ,libsamplerate) ("libsamplerate" ,libsamplerate)
@ -1152,7 +1209,9 @@ well suited to all musical instruments and vocals.")
(list (search-path-specification (list (search-path-specification
(variable "LV2_PATH") (variable "LV2_PATH")
(files '("lib/lv2"))))) (files '("lib/lv2")))))
(home-page "http://factorial.hu/plugins/lv2/ir") ;; Link to an archived copy of the home-page since the original is gone.
(home-page (string-append "https://web.archive.org/web/20150803095032/"
"http://factorial.hu/plugins/lv2/ir"))
(synopsis "LV2 convolution reverb") (synopsis "LV2 convolution reverb")
(description (description
"IR is a low-latency, real-time, high performance signal convolver "IR is a low-latency, real-time, high performance signal convolver
@ -2282,21 +2341,22 @@ interface.")
(define-public qsynth (define-public qsynth
(package (package
(name "qsynth") (name "qsynth")
(version "0.4.1") (version "0.4.3")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://sourceforge/qsynth/qsynth/" version (uri (string-append "mirror://sourceforge/qsynth/qsynth/" version
"/qsynth-" version ".tar.gz")) "/qsynth-" version ".tar.gz"))
(sha256 (sha256
(base32 "034p6mbwrjnxd9b6h20cidxi4ilkk3cgpjp154j0jzjs1ipf7x2h")))) (base32 "1j5hm99fjrnaw8wbmlh4qixkv3rw5dl429mp1ag7js2ydrx0j9yy"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f ; no "check" phase `(#:tests? #f ; no "check" phase
#:configure-flags #:configure-flags
'("CXXFLAGS=-std=gnu++11"))) '("CXXFLAGS=-std=gnu++11")))
(native-inputs (native-inputs
`(("qttools" ,qttools))) `(("qttools" ,qttools)
("pkg-config" ,pkg-config)))
(inputs (inputs
`(("fluidsynth" ,fluidsynth) `(("fluidsynth" ,fluidsynth)
("qtbase" ,qtbase) ("qtbase" ,qtbase)

13
gnu/packages/bioinformatics.scm
View File

@ -1252,9 +1252,6 @@ splice junctions between exons.")
(assoc-ref outputs "out") "/share/doc/bwa")) (assoc-ref outputs "out") "/share/doc/bwa"))
(man (string-append (man (string-append
(assoc-ref outputs "out") "/share/man/man1"))) (assoc-ref outputs "out") "/share/man/man1")))
(mkdir-p bin)
(mkdir-p doc)
(mkdir-p man)
(install-file "bwa" bin) (install-file "bwa" bin)
(install-file "README.md" doc) (install-file "README.md" doc)
(install-file "bwa.1" man))) (install-file "bwa.1" man)))
@ -2018,7 +2015,7 @@ identify enrichments with functional annotations of the genome.")
(define-public diamond (define-public diamond
(package (package
(name "diamond") (name "diamond")
(version "0.8.26") (version "0.8.27")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -2027,7 +2024,7 @@ identify enrichments with functional annotations of the genome.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"17s38pgjih6yc2z81040pircbv60c9wr33mbcyki2rfpv8rbxlh0")))) "0g0zdyfnri9v7nfbh8f7zqs4af1xydqkiw8m0cx4jc2ql4chpf6a"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
'(#:tests? #f ; no "check" target '(#:tests? #f ; no "check" target
@ -2125,7 +2122,6 @@ of nucleic acid binding proteins.")
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))) (bin (string-append out "/bin")))
(mkdir-p bin)
(for-each (lambda (file) (for-each (lambda (file)
(install-file file bin)) (install-file file bin))
(find-files "../bin" ".*")) (find-files "../bin" ".*"))
@ -2708,7 +2704,7 @@ estimates transcript expression.")
(alist-replace (alist-replace
'install 'install
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let ((bin (string-append (assoc-ref outputs "out") "/bi/"))) (let ((bin (string-append (assoc-ref outputs "out") "/bin/")))
(for-each (lambda (file) (for-each (lambda (file)
(install-file file bin)) (install-file file bin))
(find-files (find-files
@ -4770,7 +4766,6 @@ optionally compressed by gzip.")
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))) (bin (string-append out "/bin")))
(mkdir-p bin)
(install-file "snap-aligner" bin) (install-file "snap-aligner" bin)
(install-file "SNAPCommand" bin) (install-file "SNAPCommand" bin)
#t)))))) #t))))))
@ -5630,7 +5625,6 @@ Needleman-Wunsch).")
(replace 'install (replace 'install
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let ((bin (string-append (assoc-ref outputs "out") "/bin"))) (let ((bin (string-append (assoc-ref outputs "out") "/bin")))
(mkdir-p bin)
(install-file "ParDRe" bin) (install-file "ParDRe" bin)
#t)))))) #t))))))
(inputs (inputs
@ -7508,7 +7502,6 @@ intervals (e.g. genes, sequence alignments).")
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))) (bin (string-append out "/bin")))
(mkdir-p bin)
(for-each (lambda (file) (for-each (lambda (file)
(install-file file bin)) (install-file file bin))
(find-files "bin" ".*"))) (find-files "bin" ".*")))

4
gnu/packages/bittorrent.scm
View File

@ -207,7 +207,7 @@ interface, for the Transmission BitTorrent daemon.")
(define-public aria2 (define-public aria2
(package (package
(name "aria2") (name "aria2")
(version "1.28.0") (version "1.29.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/tatsuhiro-t/aria2/" (uri (string-append "https://github.com/tatsuhiro-t/aria2/"
@ -215,7 +215,7 @@ interface, for the Transmission BitTorrent daemon.")
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1w3jblfxqg30n3ndh2wrbhbddcg92lrgcx438qiwzamrayjjb8g0")))) "0bn8j6yhjnsxlxr1cdxw39gphvsrk3qhvvq92rsirxjvwwix0r0s"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:configure-flags (list "--enable-libaria2" `(#:configure-flags (list "--enable-libaria2"

15
gnu/packages/chez.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2016 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -34,7 +35,8 @@
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages image) #:use-module (gnu packages image)
#:use-module (gnu packages xorg) #:use-module (gnu packages xorg)
#:use-module (ice-9 match)) #:use-module (ice-9 match)
#:use-module (srfi srfi-1))
(define nanopass (define nanopass
(let ((version "1.9")) (let ((version "1.9"))
@ -94,12 +96,15 @@
(list ,(match (or (%current-target-system) (%current-system)) (list ,(match (or (%current-target-system) (%current-system))
("x86_64-linux" '(list "--machine=ta6le")) ("x86_64-linux" '(list "--machine=ta6le"))
("i686-linux" '(list "--machine=ti3le")) ("i686-linux" '(list "--machine=ti3le"))
;; FIXME: Some people succeeded in cross-compiling to ;; Let autodetection have its attempt on other architectures.
;; ARM. https://github.com/cisco/ChezScheme/issues/13
(_ (_
'()))) '())))
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'unpack 'patch-processor-detection
(lambda _ (substitute* "configure"
(("uname -a") "uname -m"))
#t))
;; Adapt the custom 'configure' script. ;; Adapt the custom 'configure' script.
(replace 'configure (replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys) (lambda* (#:key inputs outputs #:allow-other-keys)
@ -187,7 +192,9 @@
(find-files lib "scheme.boot")) (find-files lib "scheme.boot"))
#t)))))) #t))))))
;; According to the documentation MIPS is not supported. ;; According to the documentation MIPS is not supported.
(supported-systems (delete "mips64el-linux" %supported-systems)) ;; Cross-compiling for the Raspberry Pi is supported, but not native ARM.
(supported-systems (fold delete %supported-systems
'("mips64el-linux" "armhf-linux")))
(home-page "http://www.scheme.com") (home-page "http://www.scheme.com")
(synopsis "R6RS Scheme compiler and run-time") (synopsis "R6RS Scheme compiler and run-time")
(description (description

10
gnu/packages/compression.scm
View File

@ -603,24 +603,24 @@ writing of compressed data created with the zlib and bzip2 libraries.")
(define-public lz4 (define-public lz4
(package (package
(name "lz4") (name "lz4")
(version "131") (version "1.7.4.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/Cyan4973/lz4/archive/" (uri (string-append "https://github.com/Cyan4973/lz4/archive/"
"r" version ".tar.gz")) "v" version ".tar.gz"))
(sha256 (sha256
(base32 "1vfg305zvj50hwscad24wan9jar6nqj14gdk2hqyr7bb9mhh0kcx")) (base32 "0l39bymif15rmmfz7h6wvrr853rix4wj8wbqq8z8fm49xa7gx9fb"))
(file-name (string-append name "-" version ".tar.gz")))) (file-name (string-append name "-" version ".tar.gz"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("valgrind" ,valgrind))) (native-inputs `(("valgrind" ,valgrind))) ; for tests
(arguments (arguments
`(#:test-target "test" `(#:test-target "test"
#:parallel-tests? #f ; tests fail if run in parallel #:parallel-tests? #f ; tests fail if run in parallel
#:make-flags (list "CC=gcc" #:make-flags (list "CC=gcc"
(string-append "PREFIX=" (assoc-ref %outputs "out"))) (string-append "PREFIX=" (assoc-ref %outputs "out")))
#:phases (modify-phases %standard-phases #:phases (modify-phases %standard-phases
(delete 'configure)))) (delete 'configure)))) ; no configure script
(home-page "https://github.com/Cyan4973/lz4") (home-page "https://github.com/Cyan4973/lz4")
(synopsis "Compression algorithm focused on speed") (synopsis "Compression algorithm focused on speed")
(description "LZ4 is a lossless compression algorithm, providing (description "LZ4 is a lossless compression algorithm, providing

4
gnu/packages/connman.scm
View File

@ -36,7 +36,7 @@
(define-public connman (define-public connman
(package (package
(name "connman") (name "connman")
(version "1.32") (version "1.33")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -44,7 +44,7 @@
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0k4kw2j78gwxf0rq79a099qkzl6wi4v5i7rfs4rn0si0fd68d19i")))) "187mknq2i907gf8dz0i79359gn1qc9mryvqkcgb280d7dw1ld2dw"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:configure-flags `(#:configure-flags

2
gnu/packages/crypto.scm
View File

@ -329,7 +329,7 @@ no man page, refer to the home page for usage details.")
("gnupg" ,gnupg) ("gnupg" ,gnupg)
("cryptsetup" ,cryptsetup) ("cryptsetup" ,cryptsetup)
("e2fsprogs" ,e2fsprogs) ;for mkfs.ext4 ("e2fsprogs" ,e2fsprogs) ;for mkfs.ext4
("gettext" ,gnu-gettext) ;used at runtime ("gettext" ,gettext-minimal) ;used at runtime
("mlocate" ,mlocate) ("mlocate" ,mlocate)
("pinentry" ,pinentry) ("pinentry" ,pinentry)
("qrencode" ,qrencode) ("qrencode" ,qrencode)

65
gnu/packages/cryptsetup.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -58,3 +59,67 @@ setup information in the partition header, enabling the users to transport
or migrate their data seamlessly.") or migrate their data seamlessly.")
(license license:gpl2) (license license:gpl2)
(home-page "https://gitlab.com/cryptsetup/cryptsetup"))) (home-page "https://gitlab.com/cryptsetup/cryptsetup")))
(define (static-library library)
"Return a variant of package LIBRARY that provides static libraries ('.a'
files). This assumes LIBRARY uses Libtool."
(package
(inherit library)
(name (string-append (package-name library) "-static"))
(arguments
(substitute-keyword-arguments (package-arguments library)
((#:configure-flags flags ''())
`(append '("--disable-shared" "--enable-static")
,flags))))))
(define-public cryptsetup-static
;; Stripped-down statically-linked 'cryptsetup' command for use in initrds.
(package
(inherit cryptsetup)
(name "cryptsetup-static")
(arguments
'(#:configure-flags '("--disable-shared"
"--enable-static-cryptsetup"
;; 'libdevmapper.a' pulls in libpthread and libudev.
"LIBS=-ludev -pthread")
#:allowed-references () ;this should be self-contained
#:modules ((ice-9 ftw)
(ice-9 match)
(guix build utils)
(guix build gnu-build-system))
#:phases (modify-phases %standard-phases
(add-after 'install 'remove-cruft
(lambda* (#:key outputs #:allow-other-keys)
;; Remove everything except the 'cryptsetup' command and
;; its friend.
(let ((out (assoc-ref outputs "out")))
(with-directory-excursion out
(let ((dirs (scandir "."
(match-lambda
((or "." "..") #f)
(_ #t)))))
(for-each delete-file-recursively
(delete "sbin" dirs))
(for-each (lambda (file)
(rename-file (string-append file
".static")
file)
(remove-store-references file))
'("sbin/cryptsetup" "sbin/veritysetup"))
#t))))))))
(inputs
(let ((libgcrypt-static
(package
(inherit (static-library libgcrypt))
(propagated-inputs
`(("libgpg-error-host" ,(static-library libgpg-error)))))))
`(("libgcrypt" ,libgcrypt-static)
("lvm2" ,lvm2-static)
("util-linux" ,util-linux "static")
("util-linux" ,util-linux)
("popt" ,popt))))
(synopsis "Hard disk encryption tool (statically linked)")))

4
gnu/packages/cups.scm
View File

@ -317,14 +317,14 @@ device-specific programs to convert and print many types of files.")
(define-public hplip (define-public hplip
(package (package
(name "hplip") (name "hplip")
(version "3.16.10") (version "3.16.11")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://sourceforge/hplip/hplip/" version (uri (string-append "mirror://sourceforge/hplip/hplip/" version
"/hplip-" version ".tar.gz")) "/hplip-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"117f1p0splg51ljn4nn97c0mbl0jba440ahb3d8njq7p6h1lxd25")))) "094vkyr0rjng72m13dgr824cdl7q20x23qjxzih4w7l9njn0rqpn"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(home-page "http://hplipopensource.com/") (home-page "http://hplipopensource.com/")
(synopsis "HP Printer Drivers") (synopsis "HP Printer Drivers")

26
gnu/packages/databases.scm
View File

@ -558,6 +558,26 @@ widely deployed SQL database engine in the world. The source code for SQLite
is in the public domain.") is in the public domain.")
(license public-domain))) (license public-domain)))
(define-public sqlite-3.15.1
(package (inherit sqlite)
(version "3.15.1")
(source (origin
(method url-fetch)
(uri (let ((numeric-version
(match (string-split version #\.)
((first-digit other-digits ...)
(string-append first-digit
(string-pad-right
(string-concatenate
(map (cut string-pad <> 2 #\0)
other-digits))
6 #\0))))))
(string-append "https://sqlite.org/2016/sqlite-autoconf-"
numeric-version ".tar.gz")))
(sha256
(base32
"1ig2d9jzzixiifmgqsl6kjcvy17jwxby3s24gfnc5qvyd6vqkyjx"))))))
(define-public tdb (define-public tdb
(package (package
(name "tdb") (name "tdb")
@ -799,15 +819,15 @@ columns, primary keys, unique constraints and relationships.")
(define-public perl-dbd-mysql (define-public perl-dbd-mysql
(package (package
(name "perl-dbd-mysql") (name "perl-dbd-mysql")
(version "4.037") (version "4.039")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MI/MICHIELB/" (uri (string-append "mirror://cpan/authors/id/C/CA/CAPTTOFU/"
"DBD-mysql-" version ".tar.gz")) "DBD-mysql-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1z1wxnzhxfr9awjqb1d8pz9hf50shbk9ip2jmsmgdlwfyb78lmyz")))) "0k4p3bjdbmxm2amb0qiiwmn8v83zrjkz5qp84xdjrg8k5v9aj0hn"))))
(build-system perl-build-system) (build-system perl-build-system)
;; Tests require running MySQL server ;; Tests require running MySQL server
(arguments `(#:tests? #f)) (arguments `(#:tests? #f))

10
gnu/packages/dico.scm
View File

@ -37,20 +37,14 @@
(define-public dico (define-public dico
(package (package
(name "dico") (name "dico")
(version "2.3") (version "2.4")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/dico/dico-" (uri (string-append "mirror://gnu/dico/dico-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"13by0zimx90v2j8v7n4k9y3xwmh4q9jdc2f4f8yjs3x7f5bzm2pk")) "13m7vahfbdj7hb38bjgd4cmfswavvxrcpppj9n4m4rar3wyzg52g"))))
(snippet
;; Upstream commit 89922fc.
'(substitute* "include/dico/markup.h"
(("const char \\*dico_markup_type;")
"extern const char *dico_markup_type;")))
(modules '((guix build utils)))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:configure-flags (list (string-append "--with-guile-site-dir=" %output '(#:configure-flags (list (string-append "--with-guile-site-dir=" %output

69
gnu/packages/emacs.scm
View File

@ -1031,6 +1031,29 @@ light user interface.")
and seeking.") and seeking.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-emms-mode-line-cycle
(package
(name "emacs-emms-mode-line-cycle")
(version "0.2.5")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/momomo5717/emms-mode-line-cycle"
"/archive/" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0ifszi930pnaxk1x8pcydmvnp06868gc7nfx14q17zbajbx735k6"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emms" ,emms)))
(home-page "https://github.com/momomo5717/emms-mode-line-cycle")
(synopsis "Display the EMMS mode line as a ticker")
(description
"This is a minor mode for updating the EMMS mode-line string cyclically
within a specified width. It is useful for displaying long track titles.")
(license license:gpl3+)))
;;; ;;;
;;; Miscellaneous. ;;; Miscellaneous.
@ -3197,14 +3220,14 @@ passive voice.")
(define-public emacs-org (define-public emacs-org
(package (package
(name "emacs-org") (name "emacs-org")
(version "20160912") (version "20161118")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://orgmode.org/elpa/org-" (uri (string-append "http://elpa.gnu.org/packages/org-"
version ".tar")) version ".tar"))
(sha256 (sha256
(base32 (base32
"1xawj0pdvqrgzlixxgbfa01gzajfaz47anr5m4aw035rhc6s02r7")))) "1w9g8r08kaiw9f4fjsj0hbffzq85rj734j5lxvbaafbnz7dbklk1"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "http://orgmode.org/") (home-page "http://orgmode.org/")
(synopsis "Outline-based notes management and organizer") (synopsis "Outline-based notes management and organizer")
@ -3241,7 +3264,7 @@ Flx has support for ido (interactively do things) through flx-ido.")
(define-public emacs-cyberpunk-theme (define-public emacs-cyberpunk-theme
(package (package
(name "emacs-cyberpunk-theme") (name "emacs-cyberpunk-theme")
(version "1.17") (version "1.18")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -3249,7 +3272,7 @@ Flx has support for ido (interactively do things) through flx-ido.")
"archive/" version ".tar.gz")) "archive/" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"068jcn4g1bvwgpcvyfqygzw6ahill51c1sqzyyvj2paxckbd7h51")) "0pxzbw0qjxgkhhs3gn3k9qy41kl1a4pfzbw83dk24l4b3nxd24wg"))
(file-name (string-append name "-" version ".tar.gz")))) (file-name (string-append name "-" version ".tar.gz"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "https://github.com/n3mo/cyberpunk-theme.el") (home-page "https://github.com/n3mo/cyberpunk-theme.el")
@ -3259,6 +3282,35 @@ Flx has support for ido (interactively do things) through flx-ido.")
known loosely as deftheme. Many mode-specific customizations are included.") known loosely as deftheme. Many mode-specific customizations are included.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-danneskjold-theme
(let* ((commit "8733d2fe8743e8a01826ea6d4430ef376c727e57")
(revision "1"))
(package
(name "emacs-danneskjold-theme")
(version (string-append "0.0.0-" revision "." (string-take commit 7)))
(home-page "https://github.com/rails-to-cosmos/danneskjold-theme")
(source
(origin
(method git-fetch)
(uri (git-reference
(url home-page)
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"0s6rbsb0y8i8m5b9xm4gw1p1cxsxdqnqxqqb638pygz9f76mbir1"))))
(build-system emacs-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'delete-screenshots
(lambda _
(delete-file-recursively "screenshots") #t)))))
(synopsis "High-contrast Emacs theme")
(description
"@code{danneskjold-theme} is a high-contrast theme for Emacs.")
(license license:gpl3+))))
(define-public emacs-auto-complete (define-public emacs-auto-complete
(package (package
(name "emacs-auto-complete") (name "emacs-auto-complete")
@ -3298,7 +3350,7 @@ extensibility.")
(base32 "1w08hnsbknrcjlzp42c99bgwc9hzsnf5m4apdv0dacql2s09zfm2")))) (base32 "1w08hnsbknrcjlzp42c99bgwc9hzsnf5m4apdv0dacql2s09zfm2"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("gettext" ,gnu-gettext))) `(("gettext" ,gettext-minimal)))
(arguments (arguments
`(#:configure-flags `(#:configure-flags
(list (string-append "--with-charmaps=" (list (string-append "--with-charmaps="
@ -3326,9 +3378,8 @@ This package contains the library database.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append "mirror://savannah/m17n/m17n-lib-"
"http://download.savannah.gnu.org/releases/m17n/m17n-lib-" version ".tar.gz"))
version ".tar.gz"))
(sha256 (sha256
(base32 "10yv730i25g1rpzv6q49m6xn4p8fjm7jdwvik2h70sn8w3hm7f4f")))) (base32 "10yv730i25g1rpzv6q49m6xn4p8fjm7jdwvik2h70sn8w3hm7f4f"))))
(build-system gnu-build-system) (build-system gnu-build-system)

181
gnu/packages/engineering.scm
View File

@ -4,6 +4,7 @@
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 David Thompson <davet@gnu.org> ;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Theodoros Foradis <theodoros.for@openmailbox.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -29,6 +30,7 @@
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module ((guix licenses) #:prefix license:) #:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system cmake) #:use-module (guix build-system cmake)
#:use-module (gnu packages) #:use-module (gnu packages)
@ -39,6 +41,7 @@
#:use-module (gnu packages boost) #:use-module (gnu packages boost)
#:use-module (gnu packages check) #:use-module (gnu packages check)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages curl)
#:use-module (gnu packages flex) #:use-module (gnu packages flex)
#:use-module (gnu packages fontutils) #:use-module (gnu packages fontutils)
#:use-module (gnu packages gd) #:use-module (gnu packages gd)
@ -55,9 +58,14 @@
#:use-module (gnu packages maths) #:use-module (gnu packages maths)
#:use-module (gnu packages perl) #:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config) #:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages qt) #:use-module (gnu packages qt)
#:use-module (gnu packages swig)
#:use-module (gnu packages tcl) #:use-module (gnu packages tcl)
#:use-module (gnu packages tls)
#:use-module (gnu packages tex) #:use-module (gnu packages tex)
#:use-module (gnu packages wxwidgets)
#:use-module (gnu packages xorg)
#:use-module (srfi srfi-1)) #:use-module (srfi srfi-1))
(define-public librecad (define-public librecad
@ -218,6 +226,33 @@ and design rule checking. It also includes an autorouter and a trace
optimizer; and it can produce photorealistic and design review images.") optimizer; and it can produce photorealistic and design review images.")
(license license:gpl2+))) (license license:gpl2+)))
(define-public pcb-rnd
(package (inherit pcb)
(name "pcb-rnd")
(version "1.1.3")
(source (origin
(method url-fetch)
(uri (string-append "http://repo.hu/projects/pcb-rnd/releases/"
"pcb-rnd-" version ".tar.gz"))
(sha256
(base32
"0pycynla60b96jkb6fh6f4sx663pqbzjwnixhw5ym8sym2absm09"))))
(arguments
`(#:tests? #f ; no check target
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'cc-is-gcc
(lambda _ (setenv "CC" "gcc") #t))
(replace 'configure
;; The configure script doesn't tolerate most of our configure flags.
(lambda* (#:key outputs #:allow-other-keys)
(zero? (system* "sh" "configure"
(string-append "--prefix="
(assoc-ref outputs "out")))))))))
(home-page "http://repo.hu/projects/pcb-rnd/")
(description "PCB RND is a fork of the GNU PCB circuit board editing tool
featuring various improvements and bug fixes.")))
(define-public fastcap (define-public fastcap
(package (package
(name "fastcap") (name "fastcap")
@ -561,3 +596,149 @@ fundamental, primitive shapes are represented as code in the user-level
language.") language.")
(license (list license:lgpl2.1+ ;library (license (list license:lgpl2.1+ ;library
license:gpl2+))))) ;Guile bindings license:gpl2+))))) ;Guile bindings
;; We use kicad from a git commit, because support for boost 1.61.0 has been
;; recently added.
(define-public kicad
(let ((commit "4ee344e150bfaf3a6f3f7bf935fb96ae07c423fa")
(revision "1"))
(package
(name "kicad")
(version (string-append "4.0-" revision "."
(string-take commit 7)))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://git.launchpad.net/kicad")
(commit commit)))
(sha256
(base32 "0kf6r92nps0658i9n3p9vp5dzbssmc22lvjv5flyvnlf83l63s4n"))
(file-name (string-append name "-" version "-checkout"))))
(build-system cmake-build-system)
(arguments
`(#:out-of-source? #t
#:tests? #f ; no tests
#:configure-flags
(list "-DKICAD_STABLE_VERSION=ON"
"-DKICAD_REPO_NAME=stable"
,(string-append "-DKICAD_BUILD_VERSION=4.0-"
(string-take commit 7))
"-DCMAKE_BUILD_TYPE=Release"
"-DKICAD_SKIP_BOOST=ON"; Use our system's boost library.
"-DKICAD_SCRIPTING=ON"
"-DKICAD_SCRIPTING_MODULES=ON"
"-DKICAD_SCRIPTING_WXPYTHON=ON"
;; Has to be set explicitely, as we don't have the wxPython
;; headers in the wxwidgets store item, but in wxPython.
(string-append "-DCMAKE_CXX_FLAGS=-I"
(assoc-ref %build-inputs "wxpython")
"/include/wx-3.0")
"-DCMAKE_BUILD_WITH_INSTALL_RPATH=TRUE"
;; TODO: Enable this when CA certs are working with curl.
"-DBUILD_GITHUB_PLUGIN=OFF")
#:phases
(modify-phases %standard-phases
(add-after 'install 'wrap-program
;; Ensure correct Python at runtime.
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(python (assoc-ref inputs "python"))
(file (string-append out "/bin/kicad"))
(path (string-append
out
"/lib/python2.7/site-packages:"
(getenv "PYTHONPATH"))))
(wrap-program file
`("PYTHONPATH" ":" prefix (,path))
`("PATH" ":" prefix
(,(string-append python "/bin:")))))
#t)))))
(native-inputs
`(("boost" ,boost)
("gettext" ,gnu-gettext)
("pkg-config" ,pkg-config)
("swig" ,swig)
("zlib" ,zlib)))
(inputs
`(("cairo" ,cairo)
("curl" ,curl)
("desktop-file-utils" ,desktop-file-utils)
("glew" ,glew)
("glm" ,glm)
("hicolor-icon-theme" ,hicolor-icon-theme)
("libsm" ,libsm)
("mesa" ,mesa)
("openssl" ,openssl)
("python" ,python-2)
("wxwidgets" ,wxwidgets-gtk2)
("wxpython" ,python2-wxpython)))
(home-page "http://kicad-pcb.org/")
(synopsis "Electronics Design Automation Suite")
(description "Kicad is a program for the formation of printed circuit
boards and electrical circuits. The software has a number of programs that
perform specific functions, for example, pcbnew (Editing PCB), eeschema (editing
electrical diagrams), gerbview (viewing Gerber files) and others.")
(license license:gpl3+))))
(define-public kicad-library
(let ((version "4.0.4"))
(package
(name "kicad-library")
(version version)
(source (origin
(method url-fetch)
(uri (string-append
"http://downloads.kicad-pcb.org/libraries/kicad-library-"
version ".tar.gz"))
(sha256
(base32
"1wyda58y39lhxml0xv1ngvddi0nqihx9bnlza46ajzms38ajvh12"))))
(build-system cmake-build-system)
(arguments
`(#:out-of-source? #t
#:tests? #f ; no tests
#:phases
(modify-phases %standard-phases
(add-after 'install 'install-footprints ; from footprints tarball
(lambda* (#:key inputs outputs #:allow-other-keys)
(zero? (system* "tar" "xvf"
(assoc-ref inputs "kicad-footprints")
"-C" (string-append (assoc-ref outputs "out")
"/share/kicad/modules")
"--strip-components=1"))))
;; We change the default global footprint file, which is generated if
;; it doesn't exist in user's home directory, from the one using the
;; github plugin, to the one using the KISYSMOD environment path.
(add-after 'install-footprints 'use-pretty-footprint-table
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(template-dir (string-append out "/share/kicad/template"))
(fp-lib-table (string-append template-dir "/fp-lib-table")))
(delete-file fp-lib-table)
(copy-file (string-append fp-lib-table ".for-pretty")
fp-lib-table))
#t)))))
(native-search-paths
(list (search-path-specification
(variable "KISYSMOD") ; footprint path
(files '("share/kicad/modules")))
(search-path-specification
(variable "KISYS3DMOD") ; 3D model path
(files '("share/kicad/modules/packages3d")))))
;; Kicad distributes footprints in a separate tarball
(native-inputs
`(("kicad-footprints"
,(origin
(method url-fetch)
(uri (string-append
"http://downloads.kicad-pcb.org/libraries/kicad-footprints-"
version ".tar.gz"))
(sha256
(base32
"0ya4gg6clz3vp2wrb67xwg0bhwh5q8ag39jjmpcp4zjcqs1f48rb"))))))
(home-page "http://kicad-pcb.org/")
(synopsis "Libraries for kicad")
(description "This package provides Kicad component, footprint and 3D
render model libraries.")
(license license:lgpl2.0+))))

92
gnu/packages/firmware.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,11 +20,14 @@
(define-module (gnu packages firmware) (define-module (gnu packages firmware)
#:use-module (guix licenses) #:use-module (guix licenses)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download) #:use-module (guix git-download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages bison)
#:use-module (gnu packages cmake) #:use-module (gnu packages cmake)
#:use-module (gnu packages cross-base) #:use-module (gnu packages cross-base)
#:use-module (gnu packages flex)
#:use-module (gnu packages perl)) #:use-module (gnu packages perl))
(define-public ath9k-htc-firmware (define-public ath9k-htc-firmware
@ -82,3 +86,91 @@
802.11n NICs (aka Wi-Fi USB dongles). It is used by the ath9k driver of 802.11n NICs (aka Wi-Fi USB dongles). It is used by the ath9k driver of
Linux-libre.") Linux-libre.")
(license (non-copyleft "http://directory.fsf.org/wiki/License:ClearBSD")))) (license (non-copyleft "http://directory.fsf.org/wiki/License:ClearBSD"))))
(define-public b43-tools
(let ((commit "8dce53297966b31b6c70a7a03c2433978dd9f288")
(rev "1"))
(package
(name "b43-tools")
(version (string-append "20140625-" rev "." (string-take commit 7)))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "http://git.bues.ch/git/b43-tools.git")
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"08k7sdr9jagm43r2zv4h03j86klhkblpk73p12444a3vzg1gy1lv"))))
(build-system gnu-build-system)
(native-inputs
`(("flex" ,flex)
("bison" ,bison)))
(arguments
`(#:modules ((srfi srfi-1)
(guix build gnu-build-system)
(guix build utils))
#:tests? #f ;no tests
#:phases
(let ((subdirs '("assembler" "disassembler")))
(modify-phases %standard-phases
(delete 'configure)
(add-before 'build 'patch-/bin/true
(lambda _
(substitute* (find-files "." "Makefile")
(("/bin/true") ":"))
#t))
(replace 'build
(lambda _
(every (lambda (dir)
(zero? (system* "make" "-C" dir "CC=gcc")))
subdirs)))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(mkdir-p (string-append out "/bin"))
(every (lambda (dir)
(zero?
(system* "make" "-C" dir
(string-append "PREFIX=" out)
"install")))
subdirs))))))))
(home-page
"http://bues.ch/cms/hacking/misc.html#linux_b43_driver_firmware_tools")
(synopsis "Collection of tools for the b43 wireless driver")
(description
"The b43 firmware tools is a collection of firmware extractor,
assembler, disassembler, and debugging tools for the Linux kernel b43 wireless
driver.")
(license gpl2))))
(define-public openfwwf-firmware
(package
(name "openfwwf-firmware")
(version "5.2")
(source
(origin
(method url-fetch)
(uri (string-append "http://netweb.ing.unibs.it/~openfwwf/firmware/"
"openfwwf-" version ".tar.gz"))
(sha256
(base32
"1p60gdi7w88s7qw82d3g9v7mk887mhvidf4l5q5hh09j10h37q4x"))))
(build-system gnu-build-system)
(native-inputs
`(("b43-tools" ,b43-tools)))
(arguments
`(#:make-flags (list (string-append "PREFIX="
(assoc-ref %outputs "out")
"/lib/firmware/b43-open"))
#:tests? #f ;no tests
#:phases (modify-phases %standard-phases
(delete 'configure))))
(home-page "http://netweb.ing.unibs.it/~openfwwf/")
(synopsis "Firmware for BCM43xx devices")
(description
"This is firmware from Open FirmWare for WiFi networks (OpenFWWF) for the
Broadcom/AirForce chipset BCM43xx with Wireless-Core Revision 5. It is used
by the b43-open driver of Linux-libre.")
(license gpl2)))

2
gnu/packages/ftp.scm
View File

@ -142,7 +142,7 @@ FTP browser, as well as non-interactive commands such as 'ncftpput' and
(native-inputs (native-inputs
`(("automake" ,automake) `(("automake" ,automake)
("autoconf" ,autoconf) ("autoconf" ,autoconf)
("gettext" ,gnu-gettext))) ("gettext" ,gettext-minimal)))
(arguments (arguments
`(#:phases `(#:phases
(modify-phases %standard-phases (modify-phases %standard-phases

4
gnu/packages/games.scm
View File

@ -946,7 +946,7 @@ Protocol).")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
"http://downloads.sourceforge.net/project/extremetuxracer/releases/" "mirror://sourceforge/extremetuxracer/releases/"
version "/etr-" version ".tar.xz")) version "/etr-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
@ -2575,7 +2575,7 @@ in strikes against the evil corporation.")
"0jk2w5b6s6nkzri585bbz16cif2fhqcnl5l1mq3rd98r9nil3hd1")))) "0jk2w5b6s6nkzri585bbz16cif2fhqcnl5l1mq3rd98r9nil3hd1"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config))) (native-inputs `(("pkg-config" ,pkg-config)))
(inputs `(("gettext" ,gnu-gettext) (inputs `(("gettext" ,gettext-minimal)
("glu" ,glu) ("glu" ,glu)
("quesoglc" ,quesoglc) ("quesoglc" ,quesoglc)
("sdl-union" ,(sdl-union (list sdl sdl-image sdl-mixer))))) ("sdl-union" ,(sdl-union (list sdl sdl-image sdl-mixer)))))

2
gnu/packages/gcc.scm
View File

@ -45,7 +45,7 @@
(define %gcc-infrastructure (define %gcc-infrastructure
;; Base URL for GCC's infrastructure. ;; Base URL for GCC's infrastructure.
"ftp://gcc.gnu.org/pub/gcc/infrastructure/") "mirror://gcc/infrastructure/")
(define (gcc-configure-flags-for-triplet target) (define (gcc-configure-flags-for-triplet target)
"Return a list of additional GCC `configure' flags for TARGET, a GNU triplet. "Return a list of additional GCC `configure' flags for TARGET, a GNU triplet.

5
gnu/packages/gnome.scm
View File

@ -3868,7 +3868,7 @@ metadata in photo and video files of various formats.")
(define-public shotwell (define-public shotwell
(package (package
(name "shotwell") (name "shotwell")
(version "0.25.0") (version "0.25.0.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/" (uri (string-append "mirror://gnome/sources/" name "/"
@ -3876,7 +3876,7 @@ metadata in photo and video files of various formats.")
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0f3ly7nxy3kqwgs40avsqkxcz98bfmlhlk30n0d7j7ndk67zz57h")))) "19h0ckrgv0c6sj85m6ankyqkmy453ph9kq6zhf7ys2k5xsrrd776"))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(propagated-inputs (propagated-inputs
`(("dconf" ,dconf))) `(("dconf" ,dconf)))
@ -4747,6 +4747,7 @@ devices using the GNOME desktop.")
("cups" ,cups) ("cups" ,cups)
("dconf" ,dconf) ("dconf" ,dconf)
("docbook-xsl" ,docbook-xsl) ("docbook-xsl" ,docbook-xsl)
("gdk-pixbuf" ,gdk-pixbuf) ; for loading SVG files
("gnome-bluetooth" ,gnome-bluetooth) ("gnome-bluetooth" ,gnome-bluetooth)
("gnome-desktop" ,gnome-desktop) ("gnome-desktop" ,gnome-desktop)
("gnome-online-accounts" ,gnome-online-accounts) ("gnome-online-accounts" ,gnome-online-accounts)

19
gnu/packages/gnupg.scm
View File

@ -7,7 +7,7 @@
;;; Copyright © 2015, 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2015, 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org> ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Nils Gillmann <ng0@libertad.pw> ;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2016 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2016 Mike Gerwitz <mtg@gnu.org> ;;; Copyright © 2016 Mike Gerwitz <mtg@gnu.org>
;;; ;;;
@ -213,14 +213,14 @@ compatible to GNU Pth.")
(define-public gnupg (define-public gnupg
(package (package
(name "gnupg") (name "gnupg")
(version "2.1.15") (version "2.1.16")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnupg/gnupg/gnupg-" version (uri (string-append "mirror://gnupg/gnupg/gnupg-" version
".tar.bz2")) ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"1pgz02gd84ab94w4xdg67p9z8kvkyr9d523bvcxxd2hviwh1m362")))) "0i483m9q032a0s50f1izb213g4h5i7pcgn395m6hvl3sg2kadfa9"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("pkg-config" ,pkg-config)))
@ -245,8 +245,6 @@ compatible to GNU Pth.")
(modify-phases %standard-phases (modify-phases %standard-phases
(add-before 'configure 'patch-paths (add-before 'configure 'patch-paths
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
(substitute* "tests/openpgp/defs.inc"
(("/bin/pwd") (which "pwd")))
(substitute* "scd/scdaemon.c" (substitute* "scd/scdaemon.c"
(("\"(libpcsclite\\.so[^\"]*)\"" _ name) (("\"(libpcsclite\\.so[^\"]*)\"" _ name)
(string-append "\"" (assoc-ref inputs "pcsc-lite") (string-append "\"" (assoc-ref inputs "pcsc-lite")
@ -256,13 +254,12 @@ compatible to GNU Pth.")
(lambda _ (lambda _
(substitute* (find-files "tests" ".\\.scm$") (substitute* (find-files "tests" ".\\.scm$")
(("/usr/bin/env gpgscm") (("/usr/bin/env gpgscm")
(string-append (getcwd) "/tests/gpgscm/gpgscm"))))) (string-append (getcwd) "/tests/gpgscm/gpgscm")))
(add-before 'check 'set-home #t))
;; Some tests require write access to $HOME, otherwise leading to ;; If this variable is undefined, /bin/pwd is invoked.
;; 'failed to create directory /homeless-shelter/.asy' error. (add-before 'check 'set-gnupg-home
;; TODO Try removing this phase for GnuPG 2.1.16.
(lambda _ (lambda _
(setenv "HOME" "/tmp") (setenv "GNUPGHOME" (getcwd))
#t))))) #t)))))
(home-page "https://gnupg.org/") (home-page "https://gnupg.org/")
(synopsis "GNU Privacy Guard") (synopsis "GNU Privacy Guard")

34
gnu/packages/gnuzilla.scm
View File

@ -346,13 +346,28 @@ standards.")
,(mozilla-patch "icecat-CVE-2016-5284-pt5.patch" "0799490f4e6f" "1ypv6i48nabbhcqbach8fbgz9bmnhm7q5z9dnfid44z8g54l3f33") ,(mozilla-patch "icecat-CVE-2016-5284-pt5.patch" "0799490f4e6f" "1ypv6i48nabbhcqbach8fbgz9bmnhm7q5z9dnfid44z8g54l3f33")
,(mozilla-patch "icecat-CVE-2016-5284-pt6.patch" "fc990e4ae8bc" "1s2cj505ajwwiy4xvn5zlmyzqpgahxmqqvis0a6xm6mjbjh02gm4") ,(mozilla-patch "icecat-CVE-2016-5284-pt6.patch" "fc990e4ae8bc" "1s2cj505ajwwiy4xvn5zlmyzqpgahxmqqvis0a6xm6mjbjh02gm4")
,(mozilla-patch "icecat-bug-1251088.patch" "5ffa912ed83e" "0v5lpv3c89c2d4y5acn0kyijv096axdnrvaj5ya5yypzfcaqxv24") ,(mozilla-patch "icecat-bug-1251088.patch" "5ffa912ed83e" "0v5lpv3c89c2d4y5acn0kyijv096axdnrvaj5ya5yypzfcaqxv24")
,(mozilla-patch "icecat-bug-1292590.patch" "d4b5b8f3e373" "0w8cxn6ryhgxryy8k8i06yw4mknv509ns9ff1avd0hmgxa83mcdp") ,(mozilla-patch "icecat-CVE-2016-5290-pt1.patch" "d4b5b8f3e373" "0w8cxn6ryhgxryy8k8i06yw4mknv509ns9ff1avd0hmgxa83mcdp")
,(mozilla-patch "icecat-bug-1298169.patch" "adce603ae36d" "0mgs85cwx61bk17r7npl311l4m8yn4667wyhgjmm2ajiys6nn0yl") ,(mozilla-patch "icecat-CVE-2016-5290-pt2.patch" "adce603ae36d" "0mgs85cwx61bk17r7npl311l4m8yn4667wyhgjmm2ajiys6nn0yl")
,(mozilla-patch "icecat-bug-1301496.patch" "97268426bb6f" "1z7hg796cgag025gm9pp2szz7w870s7naagdri1dlsilj797v8hr") ,(mozilla-patch "icecat-CVE-2016-5290-pt3.patch" "97268426bb6f" "1z7hg796cgag025gm9pp2szz7w870s7naagdri1dlsilj797v8hr")
,(mozilla-patch "icecat-bug-1299519.patch" "fc055950b6b8" "05iml5k3rzc653jk4imd111sh18625jxfxkcj12kjdihl0gdr4x4") ,(mozilla-patch "icecat-CVE-2016-5290-pt4.patch" "fc055950b6b8" "05iml5k3rzc653jk4imd111sh18625jxfxkcj12kjdihl0gdr4x4")
,(mozilla-patch "icecat-bug-1303710.patch" "6f845c23565b" "01dlbnmpsnwr448fajs276y62gl03r74k1hxnwsg6ihwhnfdvn5a") ,(mozilla-patch "icecat-CVE-2016-5290-pt5.patch" "6f845c23565b" "01dlbnmpsnwr448fajs276y62gl03r74k1hxnwsg6ihwhnfdvn5a")
,(mozilla-patch "icecat-bug-1301343.patch" "e5d51ca7a3c0" "0hshcz24hc6pkz5pcqxhajm17ibwrlfn1s00frfnpjjy56vacfz0") ,(mozilla-patch "icecat-CVE-2016-5290-pt6.patch" "e5d51ca7a3c0" "0hshcz24hc6pkz5pcqxhajm17ibwrlfn1s00frfnpjjy56vacfz0")
,(mozilla-patch "icecat-bug-1299686.patch" "576f1725a57e" "1lic9d3r8r1vcniw1g3ca71390lw3dmwjsw55dp6z96hyjbcq3fd"))) ,(mozilla-patch "icecat-CVE-2016-5290-pt7.patch" "61d1463acd04" "1iig4a79dxmfcr6w82mdhyl88wy7d36g5n4p24632kbabgl9j9sz")
,(mozilla-patch "icecat-CVE-2016-5290-pt8.patch" "8e0bab4216de" "1knq8h5ni8crfndi3p78b2pyj5lzchqw67vk0yx061r76mq4wp4r")
,(mozilla-patch "icecat-CVE-2016-5290-pt9.patch" "bb10104dc89e" "1flvagckrzfk7hs2xzb5j3s5i0ck57ygyskh5494xmpa2a1nnsqj")
,(mozilla-patch "icecat-CVE-2016-5290-pt10.patch" "7006b275b829" "0sqagm247wx94mf51fyhdkn0vf1a1qy9i829shjnhssd79srxmnn")
,(mozilla-patch "icecat-CVE-2016-5290-pt11.patch" "32ce7be98543" "1y2r9i4p1qpqi75mlwmibr51whz5h1vj28c6mh6ik57dxkqxbclb")
,(mozilla-patch "icecat-CVE-2016-5291.patch" "3ff0c89f3b26" "1prn74aglshaj27jfrpd2s2i4slpljw4rbzjxc1qgwjvkq4m6j6f")
,(mozilla-patch "icecat-CVE-2016-5297.patch" "46b07bdbf8b2" "1n8y1c5l0ms81dra7jsx8mp633ak5qvx105drvlg9hn3m0fwv1lj")
,(search-patch "icecat-CVE-2016-9064.patch") ; adapted for icecat based on:
; "00c2b7baaa0b" "0y02yb7r62656nq9dji9dnwils2lxqasjz5byv62j1xa87r7f9hp"
,(mozilla-patch "icecat-CVE-2016-9066.patch" "576f1725a57e" "1lic9d3r8r1vcniw1g3ca71390lw3dmwjsw55dp6z96hyjbcq3fd")
,(mozilla-patch "icecat-bug-1212939.patch" "4a0e851f83e4" "182vx1qxrr7r2175jjf0bcixwwm1khdj4sq0c8wnsyry7p9waq5q")
,(mozilla-patch "icecat-bug-1168743.patch" "a1e06af61ab3" "07llk1ba6axjasiv30vicz96k55ff4mybxy21vjxk6j0asgyjz23")
,(mozilla-patch "icecat-bug-1287176.patch" "0569d5dce9db" "1d41sqbq6jc3af73dz9w19win7v7c12kw1mp7j7b1gkadq46c4y7")
,(mozilla-patch "icecat-bug-1263665.patch" "a79cafee93f4" "0bn7hpm8mh8qmkpz5wiridr792irrs5sjxyvryazy2i0p4pjh62p")
,(mozilla-patch "icecat-bug-1304962.patch" "f61049d5f373" "04d1na31qqq7yq4jjvhq6vzqq3f23rwac8c6fw4h5fx1pdb3l997")
,(mozilla-patch "icecat-bug-1314574.patch" "46b2558ca469" "00q8676xg4wb7p371wgi04nl05j7idkb2kna9a0l08k6lks9wdhh")))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin
@ -411,8 +426,7 @@ standards.")
("glib" ,glib) ("glib" ,glib)
("gstreamer" ,gstreamer) ("gstreamer" ,gstreamer)
("gst-plugins-base" ,gst-plugins-base) ("gst-plugins-base" ,gst-plugins-base)
("gtk+" ,gtk+) ("gtk+" ,gtk+-2)
("gtk+-2" ,gtk+-2)
("pango" ,pango) ("pango" ,pango)
("freetype" ,freetype) ("freetype" ,freetype)
("hunspell" ,hunspell) ("hunspell" ,hunspell)
@ -456,7 +470,7 @@ standards.")
;; practice somehow. See <http://hydra.gnu.org/build/378133>. ;; practice somehow. See <http://hydra.gnu.org/build/378133>.
#:validate-runpath? #f #:validate-runpath? #f
#:configure-flags '("--enable-default-toolkit=cairo-gtk3" #:configure-flags '("--enable-default-toolkit=cairo-gtk2"
"--enable-pango" "--enable-pango"
"--enable-gio" "--enable-gio"
"--enable-svg" "--enable-svg"

11
gnu/packages/grub.scm
View File

@ -127,9 +127,16 @@
(("set -e") "exit 77\nset -e")) (("set -e") "exit 77\nset -e"))
#t))))) #t)))))
(inputs (inputs
`(;; ("lvm2" ,lvm2) `(("gettext" ,gettext-minimal)
("gettext" ,gettext-minimal)
;; Depend on LVM2 for libdevmapper, used by 'grub-probe' and
;; 'grub-install' to recognize mapped devices (LUKS, etc.)
("lvm2" ,lvm2)
;; Depend on mdadm, which is invoked by 'grub-probe' and 'grub-install'
;; to determine whether the root file system is RAID.
("mdadm" ,mdadm) ("mdadm" ,mdadm)
("freetype" ,freetype) ("freetype" ,freetype)
;; ("libusb" ,libusb) ;; ("libusb" ,libusb)
;; ("fuse" ,fuse) ;; ("fuse" ,fuse)

33
gnu/packages/gstreamer.scm
View File

@ -97,7 +97,7 @@ arrays of data.")
(define-public gstreamer (define-public gstreamer
(package (package
(name "gstreamer") (name "gstreamer")
(version "1.10.0") (version "1.10.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -106,7 +106,7 @@ arrays of data.")
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"01vjsgz58n6nrmnahs4ac7v4656yc042ymffqjzqa0a8pvx7hxqy")))) "1npnpyrw8603ivi5g3ziglvh3hq2shypid2vjcmki6g6w2bgk3gn"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" "doc")) (outputs '("out" "doc"))
(arguments (arguments
@ -145,7 +145,7 @@ This package provides the core library and elements.")
(define-public gst-plugins-base (define-public gst-plugins-base
(package (package
(name "gst-plugins-base") (name "gst-plugins-base")
(version "1.10.0") (version "1.10.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -153,7 +153,7 @@ This package provides the core library and elements.")
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0jp9rwv0am8qv32q3dzhdcbyygg5wjm4fg20njyhp6n6vybyzkdz")))) "1jbnr6vbklzli493xdd8y5sflm32r90lifpacxw9vbvs9hlyxkv6"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" "doc")) (outputs '("out" "doc"))
(propagated-inputs (propagated-inputs
@ -187,7 +187,8 @@ This package provides the core library and elements.")
(add-before 'configure 'patch (add-before 'configure 'patch
(lambda _ (lambda _
(substitute* "tests/check/libs/pbutils.c" (substitute* "tests/check/libs/pbutils.c"
(("/bin/sh") (which "sh")))))))) (("/bin/sh") (which "sh")))
#t)))))
(home-page "https://gstreamer.freedesktop.org/") (home-page "https://gstreamer.freedesktop.org/")
(synopsis (synopsis
"Plugins for the GStreamer multimedia library") "Plugins for the GStreamer multimedia library")
@ -199,7 +200,7 @@ for the GStreamer multimedia library.")
(define-public gst-plugins-good (define-public gst-plugins-good
(package (package
(name "gst-plugins-good") (name "gst-plugins-good")
(version "1.10.0") (version "1.10.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -208,7 +209,7 @@ for the GStreamer multimedia library.")
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1qhx6x3ax1qqbvm20zhqax3dsas4yzlx7vdjnjqllqzmcfbma0vs")))) "1hkcap9l2603266gyi6jgvx7frbvfmb7xhfhjizbczy1wykjwr57"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("aalib" ,aalib) `(("aalib" ,aalib)
@ -264,14 +265,14 @@ developers consider to have good quality code and correct functionality.")
(define-public gst-plugins-bad (define-public gst-plugins-bad
(package (package
(name "gst-plugins-bad") (name "gst-plugins-bad")
(version "1.10.0") (version "1.10.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://gstreamer.freedesktop.org/src/" (uri (string-append "https://gstreamer.freedesktop.org/src/"
name "/" name "-" version ".tar.xz")) name "/" name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0kqwh5r4j05f2w9m353grvypn0106hxcr52409f7rvm3w4b9sprx")))) "07cjra4fclrk6lpdm5hrsgp79aqpklx3v3l9scain091zvchwghk"))))
(outputs '("out" "doc")) (outputs '("out" "doc"))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
@ -329,7 +330,7 @@ developers consider to have good quality code and correct functionality.")
;("qtx11extras" ,qtx11extras) ;("qtx11extras" ,qtx11extras)
("soundtouch" ,soundtouch) ("soundtouch" ,soundtouch)
("x265" ,x265) ("x265" ,x265)
;("wayland" ,wayland) ; needs wayland-protocols ;("wayland" ,wayland) ; needs gtk+ built with wayland support
)) ))
(home-page "https://gstreamer.freedesktop.org/") (home-page "https://gstreamer.freedesktop.org/")
(synopsis "Plugins for the GStreamer multimedia library") (synopsis "Plugins for the GStreamer multimedia library")
@ -341,7 +342,7 @@ par compared to the rest.")
(define-public gst-plugins-ugly (define-public gst-plugins-ugly
(package (package
(name "gst-plugins-ugly") (name "gst-plugins-ugly")
(version "1.10.0") (version "1.10.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -349,7 +350,7 @@ par compared to the rest.")
name "/" name "-" version ".tar.xz")) name "/" name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1q2m3bl8kh9q3grshj55lb2mqby4r20qfsrffc2l7ddb0ccqvplp")))) "1hl385fys7hfx5ffipavvhciq6hwm731rs4d6r9fn7h9qagxbv55"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("gst-plugins-base" ,gst-plugins-base) `(("gst-plugins-base" ,gst-plugins-base)
@ -380,7 +381,7 @@ distribution problems in some jurisdictions, e.g. due to patent threats.")
(define-public gst-libav (define-public gst-libav
(package (package
(name "gst-libav") (name "gst-libav")
(version "1.10.0") (version "1.10.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -388,7 +389,7 @@ distribution problems in some jurisdictions, e.g. due to patent threats.")
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0nyqkggcxfrbflcf4jyj0h9l1rkbi3r5h61w4fcbp2n72522165g")))) "1ivjbh5g0l5ykfpc16kq5x2jz8d4ignyha14jpiz3pz6w26qpci7"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:configure-flags '("--with-system-libav") '(#:configure-flags '("--with-system-libav")
@ -418,7 +419,7 @@ compression formats through the use of the libav library.")
(define-public python-gst (define-public python-gst
(package (package
(name "python-gst") (name "python-gst")
(version "1.10.0") (version "1.10.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -426,7 +427,7 @@ compression formats through the use of the libav library.")
"gst-python-" version ".tar.xz")) "gst-python-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0hf71m0vqnd5sdj14li935xzzmqxh606qgw744a25w3vwj9v8nfy")))) "04xhh0z0c0s6aq7kvmfs4r6yl1pjnqz0krp05pbjy62ayx5b61ak"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
;; XXX: Factorize python-sitedir with python-build-system. ;; XXX: Factorize python-sitedir with python-build-system.

5
gnu/packages/gtk.scm
View File

@ -1116,7 +1116,7 @@ extensive documentation, including API reference and a tutorial.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://ftp.gnome.org/pub/GNOME/sources" (uri (string-append "mirror://gnome/sources"
"/pygtk/" (version-major+minor version) "/pygtk/" (version-major+minor version)
"/pygtk-" version ".tar.bz2")) "/pygtk-" version ".tar.bz2"))
(sha256 (sha256
@ -1289,7 +1289,8 @@ can also be used to document application code.")
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config) `(("pkg-config" ,pkg-config)
("intltool" ,intltool))) ("intltool" ,intltool)))
(propagated-inputs (inputs
;; Don't propagate GTK+ to reduce "profile pollution".
`(("gtk+" ,gtk+-2))) ; required by gtk-engines-2.pc `(("gtk+" ,gtk+-2))) ; required by gtk-engines-2.pc
(home-page "http://live.gnome.org/GnomeArt") (home-page "http://live.gnome.org/GnomeArt")
(synopsis "Theming engines for GTK+ 2.x") (synopsis "Theming engines for GTK+ 2.x")

3
gnu/packages/guile.scm
View File

@ -217,7 +217,8 @@ without requiring the source code to be rewritten.")
".tar.xz")) ".tar.xz"))
(sha256 (sha256
(base32 (base32
"12yqkr974y91ylgw6jnmci2v90i90s7h9vxa4zk0sai8vjnz4i1p")))))) "12yqkr974y91ylgw6jnmci2v90i90s7h9vxa4zk0sai8vjnz4i1p"))
(patches (search-patches "guile-repl-server-test.patch"))))))
(define-public guile-next (define-public guile-next
(package (inherit guile-2.0) (package (inherit guile-2.0)

33
gnu/packages/image.scm
View File

@ -243,7 +243,7 @@ extracting icontainer icon files.")
(define-public libtiff (define-public libtiff
(package (package
(name "libtiff") (name "libtiff")
(replacement libtiff/fixed) (replacement libtiff-4.0.7)
(version "4.0.6") (version "4.0.6")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
@ -283,24 +283,18 @@ collection of tools for doing simple manipulations of TIFF images.")
"See COPYRIGHT in the distribution.")) "See COPYRIGHT in the distribution."))
(home-page "http://www.remotesensing.org/libtiff/"))) (home-page "http://www.remotesensing.org/libtiff/")))
(define libtiff/fixed (define libtiff-4.0.7
(package (package
(inherit libtiff) (inherit libtiff)
(version "4.0.7")
(source (origin (source (origin
(inherit (package-source libtiff)) (method url-fetch)
(patches (search-patches (uri (string-append "ftp://download.osgeo.org/libtiff/tiff-"
"libtiff-oob-accesses-in-decode.patch" version ".tar.gz"))
"libtiff-oob-write-in-nextdecode.patch" (sha256
"libtiff-CVE-2015-8665+CVE-2015-8683.patch" (base32
"libtiff-CVE-2016-3623.patch" "06ghqhr4db1ssq0acyyz49gr8k41gzw6pqb6mbn5r7jqp77s4hwz"))))
"libtiff-CVE-2016-3945.patch" (home-page "http://www.simplesystems.org/libtiff/")))
"libtiff-CVE-2016-3990.patch"
"libtiff-CVE-2016-3991.patch"
"libtiff-CVE-2016-5314.patch"
"libtiff-CVE-2016-5321.patch"
"libtiff-CVE-2016-5323.patch"
"libtiff-CVE-2016-5652.patch"
"libtiff-CVE-2016-9273.patch"))))))
(define-public libwmf (define-public libwmf
(package (package
@ -849,15 +843,16 @@ convert, manipulate, filter and display a wide variety of image formats.")
(define-public jasper (define-public jasper
(package (package
(name "jasper") (name "jasper")
(version "1.900.19") (version "1.900.29")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://www.ece.uvic.ca/~frodo/jasper" (uri (string-append "https://www.ece.uvic.ca/~frodo/jasper"
"/software/jasper-" version ".tar.gz")) "/software/jasper-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0dm3k0wdny3s37zxm9s9riv46p69c14bnn532fv6cv5b6l1b0pwb")))) "1h1575wdzq1p7y2xvy1gbiypai1iils5awhy4gadr78qpb9ykrra"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("libjpeg" ,libjpeg)))
(synopsis "JPEG-2000 library") (synopsis "JPEG-2000 library")
(description "The JasPer Project is an initiative to provide a reference (description "The JasPer Project is an initiative to provide a reference
implementation of the codec specified in the JPEG-2000 Part-1 standard (i.e., implementation of the codec specified in the JPEG-2000 Part-1 standard (i.e.,
@ -944,7 +939,7 @@ differences in file encoding, image quality, and other small variations.")
(patches (list (search-patch "steghide-fixes.patch"))))) (patches (list (search-patch "steghide-fixes.patch")))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("gettext" ,gnu-gettext) `(("gettext" ,gettext-minimal)
("libtool" ,libtool) ("libtool" ,libtool)
("perl" ,perl))) ;for tests ("perl" ,perl))) ;for tests
(inputs (inputs

4
gnu/packages/imagemagick.scm
View File

@ -43,14 +43,14 @@
(define-public imagemagick (define-public imagemagick
(package (package
(name "imagemagick") (name "imagemagick")
(version "6.9.6-4") (version "6.9.6-5")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://imagemagick/ImageMagick-" (uri (string-append "mirror://imagemagick/ImageMagick-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1mv2qihr9jfagz1dds42q46zirh0dvx0rai7pkqmbzy2bp2c48ym")))) "037lg2m0y5b17lyi34jdlkq4h03ck67j5m6wr84nvwd3jfx240cd"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:configure-flags '("--with-frozenpaths" "--without-gcc-arch") `(#:configure-flags '("--with-frozenpaths" "--without-gcc-arch")

37
gnu/packages/linux.scm
View File

@ -327,14 +327,14 @@ It has been modified to remove all non-free binary blobs.")
(define %intel-compatible-systems '("x86_64-linux" "i686-linux")) (define %intel-compatible-systems '("x86_64-linux" "i686-linux"))
(define-public linux-libre (define-public linux-libre
(make-linux-libre "4.8.7" (make-linux-libre "4.8.10"
"1jbwm131zv59iyr6qw7qcbcfz49qqb2hhx30230gb99flyc5h4hg" "04kwarmpz5adz64wwy0xpwzxsri7jrjkhbmjlwxsac69x9a26bkl"
%intel-compatible-systems %intel-compatible-systems
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define-public linux-libre-4.4 (define-public linux-libre-4.4
(make-linux-libre "4.4.31" (make-linux-libre "4.4.34"
"1s4xdllvxw02g4yqlafcacgsgdpxccf6dlqafpqffm873q1y9n4d" "04ng40l2av34bcfwjs5vliv15f0m8bl0sfw08imspiplxvajd6ca"
%intel-compatible-systems %intel-compatible-systems
#:configuration-file kernel-config)) #:configuration-file kernel-config))
@ -345,8 +345,8 @@ It has been modified to remove all non-free binary blobs.")
#:configuration-file kernel-config)) #:configuration-file kernel-config))
;; Avoid rebuilding kernel variants when there is a minor version bump. ;; Avoid rebuilding kernel variants when there is a minor version bump.
(define %linux-libre-version "4.8.7") (define %linux-libre-version "4.8.10")
(define %linux-libre-hash "1jbwm131zv59iyr6qw7qcbcfz49qqb2hhx30230gb99flyc5h4hg") (define %linux-libre-hash "04kwarmpz5adz64wwy0xpwzxsri7jrjkhbmjlwxsac69x9a26bkl")
(define-public linux-libre-arm-generic (define-public linux-libre-arm-generic
(make-linux-libre %linux-libre-version (make-linux-libre %linux-libre-version
@ -1683,7 +1683,8 @@ time.")
(("confdir = .*$") (("confdir = .*$")
"confdir = @sysconfdir@\n") "confdir = @sysconfdir@\n")
(("DEFAULT_SYS_DIR = @DEFAULT_SYS_DIR@") (("DEFAULT_SYS_DIR = @DEFAULT_SYS_DIR@")
"DEFAULT_SYS_DIR = @sysconfdir@")))))) "DEFAULT_SYS_DIR = @sysconfdir@"))))
(patches (search-patches "lvm2-static-link.patch"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config) `(("pkg-config" ,pkg-config)
@ -1738,6 +1739,22 @@ mapper. Kernel components are part of Linux-libre.")
;; Command-line tools are GPLv2. ;; Command-line tools are GPLv2.
(license (list license:gpl2 license:lgpl2.1)))) (license (list license:gpl2 license:lgpl2.1))))
(define-public lvm2-static
(package
(inherit lvm2)
(name "lvm2-static")
;; Propagate udev because libdevmapper.a depends on libudev.
(inputs (alist-delete "udev" (package-inputs lvm2)))
(propagated-inputs `(("udev" ,eudev)))
(arguments
(substitute-keyword-arguments (package-arguments lvm2)
((#:configure-flags flags '())
;; LVM2 doesn't use Libtool, hence the custom option.
`(cons "--enable-static_link" ,flags))))
(synopsis "Logical volume management for Linux (statically linked)")))
(define-public wireless-tools (define-public wireless-tools
(package (package
(name "wireless-tools") (name "wireless-tools")
@ -2647,7 +2664,7 @@ and copy/paste text in the console and in xterm.")
(define-public btrfs-progs (define-public btrfs-progs
(package (package
(name "btrfs-progs") (name "btrfs-progs")
(version "4.8.3") (version "4.8.4")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://kernel.org/linux/kernel/" (uri (string-append "mirror://kernel.org/linux/kernel/"
@ -2655,7 +2672,7 @@ and copy/paste text in the console and in xterm.")
"btrfs-progs-v" version ".tar.xz")) "btrfs-progs-v" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1wlflrygnpndppil9g12pk184f75g9qx1lkr0x1gijigglqhr9n1")))) "1ib1ybpjhcymcycjiraz1vk01qlyvpwcg7mwfhmacdy3cvbfl9mz"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" (outputs '("out"
"static")) ; static versions of binaries in "out" (~16MiB!) "static")) ; static versions of binaries in "out" (~16MiB!)
@ -3128,7 +3145,7 @@ developers.")
(string-append "PREFIX=" %output)) (string-append "PREFIX=" %output))
#:tests? #f)) ; no tests #:tests? #f)) ; no tests
(native-inputs (native-inputs
`(("gnu-gettext" ,gnu-gettext) `(("gettext" ,gettext-minimal)
("pkg-config" ,pkg-config))) ("pkg-config" ,pkg-config)))
(inputs (inputs
`(("libdrm" ,libdrm) `(("libdrm" ,libdrm)

33
gnu/packages/mail.scm
View File

@ -537,14 +537,14 @@ invoking @command{notifymuch} from the post-new hook.")
(define-public notmuch (define-public notmuch
(package (package
(name "notmuch") (name "notmuch")
(version "0.23.1") (version "0.23.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://notmuchmail.org/releases/notmuch-" (uri (string-append "https://notmuchmail.org/releases/notmuch-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"106ijsnilqf8760z4cq99rqzjsvyaw86d0lgnzz7v95gm4d2l0g8")))) "1g4p5hsrqqbqk6s2w756als60wppvjgpyq104smy3w9vshl7bzgd"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:make-flags (list "V=1") ; Verbose test output. '(#:make-flags (list "V=1") ; Verbose test output.
@ -568,6 +568,11 @@ invoking @command{notifymuch} from the post-new hook.")
;; Patch various inline shell invocations. ;; Patch various inline shell invocations.
(substitute* (find-files "test" "\\.sh$") (substitute* (find-files "test" "\\.sh$")
(("/bin/sh") (which "sh"))) (("/bin/sh") (which "sh")))
;; XXX: Some signature verification tests fail with
;; gnupg-2.1.16, so we skip them. See this thread:
;; https://notmuchmail.org/pipermail/notmuch/2016/023688.html
(setenv "NOTMUCH_SKIP_TESTS"
"T350-crypto.2 T350-crypto.3 T350-crypto.4 T350-crypto.15")
#t))))) #t)))))
(native-inputs (native-inputs
`(("bash-completion" ,bash-completion) `(("bash-completion" ,bash-completion)
@ -1469,15 +1474,15 @@ converts them to maildir format directories.")
(define-public mpop (define-public mpop
(package (package
(name "mpop") (name "mpop")
(version "1.2.5") (version "1.2.6")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://downloads.sourceforge.net/mpop/mpop-" (uri (string-append "mirror://sourceforge/mpop/mpop/" version
version ".tar.xz")) "/mpop-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0n0ij258kn8lfa6nyr6l6plc4hf1wvyf1hkwicvdbjqdqrgjnq81")))) "0p1ix63jh64dibrlccch8q7gxl9nn18wd2qpyr5z1h4gs2fpmv4z"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("gnutls" ,gnutls) `(("gnutls" ,gnutls)
@ -1603,14 +1608,14 @@ transfer protocols.")
(define-public opensmtpd (define-public opensmtpd
(package (package
(name "opensmtpd") (name "opensmtpd")
(version "5.9.2p1") (version "6.0.2p1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://www.opensmtpd.org/archives/" (uri (string-append "https://www.opensmtpd.org/archives/"
name "-" version ".tar.gz")) name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"07d7f1m5sxyz6mkk228rcm7fsf7350994ayvmhgph333q5rz48im")))) "1b4h64w45hpmfq5721smhg4s0shs64gbcjqjpx3fbiw4hz8bdy9a"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("bdb" ,bdb) `(("bdb" ,bdb)
@ -1620,11 +1625,15 @@ transfer protocols.")
("linux-pam" ,linux-pam) ("linux-pam" ,linux-pam)
("zlib" ,zlib))) ("zlib" ,zlib)))
(native-inputs (native-inputs
`(("bison" ,bison))) `(("bison" ,bison)
("groff" ,groff)))
(arguments (arguments
`(#:configure-flags (list "--with-table-db" "--localstatedir=/var" `(#:configure-flags
"--with-user-smtpd=smtpd" "--with-user-queue=smtpq" (list "--with-table-db" "--localstatedir=/var"
"--with-group-queue=smtpq") "--with-user-smtpd=smtpd" "--with-user-queue=smtpq"
"--with-group-queue=smtpq"
"--with-path-socket=/var/run"
"--with-path-CAfile=/etc/ssl/certs/ca-certificates.crt")
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
;; OpenSMTPD provides a single utility smtpctl to control the daemon and ;; OpenSMTPD provides a single utility smtpctl to control the daemon and

6
gnu/packages/maths.scm
View File

@ -563,7 +563,10 @@ incompatible with HDF5.")
(inputs (inputs
`(("zlib" ,zlib))) `(("zlib" ,zlib)))
(arguments (arguments
`(#:phases `(;; Some of the users, notably Flann, need the C++ interface.
#:configure-flags '("--enable-cxx")
#:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-before 'configure 'patch-configure (add-before 'configure 'patch-configure
(lambda _ (lambda _
@ -2723,7 +2726,6 @@ set.")
;; Custom install because docs/Makefile doesn't honor ${docdir}. ;; Custom install because docs/Makefile doesn't honor ${docdir}.
(let* ((doc (assoc-ref outputs "doc")) (let* ((doc (assoc-ref outputs "doc"))
(docdir (string-append doc "/share/doc/hypre-" ,version))) (docdir (string-append doc "/share/doc/hypre-" ,version)))
(mkdir-p docdir)
(with-directory-excursion "docs" (with-directory-excursion "docs"
(for-each (lambda (base) (for-each (lambda (base)
(install-file (string-append base ".pdf") docdir) (install-file (string-append base ".pdf") docdir)

1
gnu/packages/mp3.scm
View File

@ -441,7 +441,6 @@ format.")
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))) (bin (string-append out "/bin")))
(mkdir-p bin)
(install-file "mpc123" bin))))) (install-file "mpc123" bin)))))
#:tests? #f)) #:tests? #f))
(native-inputs (native-inputs

6
gnu/packages/mpd.scm
View File

@ -183,7 +183,7 @@ terminal using ncurses.")
(define-public ncmpcpp (define-public ncmpcpp
(package (package
(name "ncmpcpp") (name "ncmpcpp")
(version "0.7.5") (version "0.7.7")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (uri
@ -191,7 +191,7 @@ terminal using ncurses.")
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"0zg084m06y7dd8ccy6aq9hx8q7qi2s5kl0br5139hrmk40q68kvy")))) "1vq19m36608pvw1g8nbcaqqb89wsw05v35pi45xwr20z7g4bxg5p"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("libmpdclient" ,libmpdclient) (inputs `(("libmpdclient" ,libmpdclient)
("boost" ,boost) ("boost" ,boost)
@ -296,7 +296,7 @@ interface for the Music Player Daemon.")
`("GI_TYPELIB_PATH" ":" prefix (,gi-typelib-path)))) `("GI_TYPELIB_PATH" ":" prefix (,gi-typelib-path))))
#t))))) #t)))))
(native-inputs (native-inputs
`(("gettext" ,gnu-gettext))) `(("gettext" ,gettext-minimal)))
(inputs (inputs
`(("python-mpd2" ,python-mpd2) `(("python-mpd2" ,python-mpd2)
("gtk+" ,gtk+) ("gtk+" ,gtk+)

205
gnu/packages/music.scm
View File

@ -504,7 +504,7 @@ interface. It is implemented as a frontend to @code{klick}.")
(define-public lilypond (define-public lilypond
(package (package
(name "lilypond") (name "lilypond")
(version "2.19.33") (version "2.19.51")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -513,7 +513,7 @@ interface. It is implemented as a frontend to @code{klick}.")
name "-" version ".tar.gz")) name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0s4vbbfy4xwq4da4kmlnndalmcyx2jaz7y8praah2146qbnr90xh")))) "1b4jvc0fixbnp8x457fzk5wgb4zd03npwwivp60kc27fmv63w5l1"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f ; out-test/collated-files.html fails `(#:tests? #f ; out-test/collated-files.html fails
@ -881,7 +881,7 @@ users to select LV2 plugins and run them with jalv.")
(define-public synthv1 (define-public synthv1
(package (package
(name "synthv1") (name "synthv1")
(version "0.7.5") (version "0.8.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (uri
@ -889,7 +889,7 @@ users to select LV2 plugins and run them with jalv.")
"/synthv1-" version ".tar.gz")) "/synthv1-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0h5zja78phf9705i9g54zh61iczb24iv7rxhljyms30sjgajig1y")))) "155pfyhr6d35ciw95pbxlqy7751cmij8j5d849rvblqbjzyzb5qx"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f ; There are no tests. `(#:tests? #f ; There are no tests.
@ -909,6 +909,74 @@ users to select LV2 plugins and run them with jalv.")
oscillators and stereo effects.") oscillators and stereo effects.")
(license license:gpl2+))) (license license:gpl2+)))
(define-public drumkv1
(package
(name "drumkv1")
(version "0.8.0")
(source (origin
(method url-fetch)
(uri
(string-append "mirror://sourceforge/drumkv1/drumkv1/" version
"/drumkv1-" version ".tar.gz"))
(sha256
(base32
"1n2kd468kn71yp2asmamprvblmdlvh0zd8lsh3598dwi4b7aa3ga"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; There are no tests.
#:configure-flags
'("CXXFLAGS=-std=gnu++11")))
(inputs
`(("jack" ,jack-1)
("lv2" ,lv2)
("libsndfile" ,libsndfile)
("alsa-lib" ,alsa-lib)
("liblo" ,liblo)
("qtbase" ,qtbase)))
(native-inputs
`(("pkg-config" ,pkg-config)
("qttools" ,qttools)))
(home-page "http://drumkv1.sourceforge.net")
(synopsis "Drum-kit sampler synthesizer with stereo effects")
(description
"Drumkv1 is an old-school drum-kit sampler synthesizer with stereo
effects.")
(license license:gpl2+)))
(define-public samplv1
(package
(name "samplv1")
(version "0.8.0")
(source (origin
(method url-fetch)
(uri
(string-append "mirror://sourceforge/samplv1/samplv1/" version
"/samplv1-" version ".tar.gz"))
(sha256
(base32
"0j3hkmd9q0bw9b7nk9cssqywlrishkd1n790a9vq6gh3pdc5sf3r"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; There are no tests.
#:configure-flags
'("CXXFLAGS=-std=gnu++11")))
(inputs
`(("jack" ,jack-1)
("lv2" ,lv2)
("libsndfile" ,libsndfile)
("alsa-lib" ,alsa-lib)
("liblo" ,liblo)
("qtbase" ,qtbase)))
(native-inputs
`(("pkg-config" ,pkg-config)
("qttools" ,qttools)))
(home-page "http://samplv1.sourceforge.net")
(synopsis "Polyphonic sampler synthesizer with stereo effects")
(description
"Samplv1 is an old-school polyphonic sampler synthesizer with stereo
effects.")
(license license:gpl2+)))
(define-public amsynth (define-public amsynth
(package (package
(name "amsynth") (name "amsynth")
@ -1148,7 +1216,6 @@ is subjective.")
(lib (string-append share "/java")) (lib (string-append share "/java"))
(swt (assoc-ref inputs "java-swt"))) (swt (assoc-ref inputs "java-swt")))
(mkdir-p bin) (mkdir-p bin)
(mkdir-p lib)
;; install all jars ;; install all jars
(for-each (lambda (file) (for-each (lambda (file)
(install-file file lib)) (install-file file lib))
@ -1407,7 +1474,7 @@ backends, including ALSA, OSS, Network and FluidSynth.")
(define-public zynaddsubfx (define-public zynaddsubfx
(package (package
(name "zynaddsubfx") (name "zynaddsubfx")
(version "2.5.4") (version "3.0.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -1415,7 +1482,7 @@ backends, including ALSA, OSS, Network and FluidSynth.")
version "/zynaddsubfx-" version ".tar.bz2")) version "/zynaddsubfx-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"16llaa2wg2gbgjhwp3632b2vx9jvanj4csv7d41k233ms6d1sjq1")))) "0p640hlw28264nzrnd2lm4bi5snas4fvh80p8lpxvph2hjw3sncl"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -1433,6 +1500,7 @@ backends, including ALSA, OSS, Network and FluidSynth.")
(inputs (inputs
`(("liblo" ,liblo) `(("liblo" ,liblo)
("ntk" ,ntk) ("ntk" ,ntk)
("mesa" ,mesa)
("alsa-lib" ,alsa-lib) ("alsa-lib" ,alsa-lib)
("jack" ,jack-1) ("jack" ,jack-1)
("fftw" ,fftw) ("fftw" ,fftw)
@ -1570,14 +1638,14 @@ computer's keyboard.")
(define-public qtractor (define-public qtractor
(package (package
(name "qtractor") (name "qtractor")
(version "0.7.9") (version "0.8.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://downloads.sourceforge.net/qtractor/" (uri (string-append "http://downloads.sourceforge.net/qtractor/"
"qtractor-" version ".tar.gz")) "qtractor-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0pp459kfgrnngj373gnwwl43xjz32lmyf7v62p2nnjh6c7wr1ryq")))) "17v563liyqcvil204ry1qfp09d91944nqz2ig33f5c3pyg4z2427"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments `(#:tests? #f)) ; no "check" target (arguments `(#:tests? #f)) ; no "check" target
(inputs (inputs
@ -2169,8 +2237,8 @@ simulation of a push pull transistor fuzz effect with added high octave."))))
pedal.")))) pedal."))))
(define-public gx-saturator-lv2 (define-public gx-saturator-lv2
(let ((commit "361399245d234b4d02f11f066d25ac15d90c6bf8") (let ((commit "0b581ac85c515325b9f16e51937cae6e1bf81a0a")
(revision "1")) (revision "2"))
(package (inherit gx-guvnor-lv2) (package (inherit gx-guvnor-lv2)
(name "gx-saturator-lv2") (name "gx-saturator-lv2")
(version (string-append "0-" revision "." (string-take commit 9))) (version (string-append "0-" revision "." (string-take commit 9)))
@ -2181,27 +2249,16 @@ pedal."))))
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"13cf5gxr2wzp5954hdhbl79v98a665ll5434mb3668p4j33sv217")) "1cl785pzq8zk55m1rnhfd6qsabci6kpf4pf002gwr91vagyq246z"))
(file-name (string-append name "-" version "-checkout")))) (file-name (string-append name "-" version "-checkout"))))
(arguments
(substitute-keyword-arguments (package-arguments gx-guvnor-lv2)
((#:phases phases)
`(modify-phases ,phases
(add-after 'unpack 'escape-shell-commands
(lambda _
(substitute* "Makefile"
(("cat ") "$(shell cat ")
(("/dev/null") "/dev/null)")
(("SSE_CFLAGS = \"\"") "SSE_CFLAGS ="))
#t))))))
(home-page "https://github.com/brummer10/GxSaturator.lv2") (home-page "https://github.com/brummer10/GxSaturator.lv2")
(synopsis "Saturation effect") (synopsis "Saturation effect")
(description "This package provides the LV2 plugin \"GxSaturator\", a (description "This package provides the LV2 plugin \"GxSaturator\", a
saturation effect.")))) saturation effect."))))
(define-public gx-hyperion-lv2 (define-public gx-hyperion-lv2
(let ((commit "7d993bc77f9946b3df0e481632c61b2dcbb6549f") (let ((commit "6a096a664e553e551e179e85cf390bd1683410fb")
(revision "1")) (revision "2"))
(package (inherit gx-guvnor-lv2) (package (inherit gx-guvnor-lv2)
(name "gx-hyperion-lv2") (name "gx-hyperion-lv2")
(version (string-append "0-" revision "." (string-take commit 9))) (version (string-append "0-" revision "." (string-take commit 9)))
@ -2212,27 +2269,16 @@ saturation effect."))))
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"12klcyc6l9v93ii3478mqz44jzvh5np1sk8zzdmz42jp0w8qd429")) "1ksv3wmylhwbf6kjl2lnhr14h9rfl291cfm21471gnb1r68yqfxh"))
(file-name (string-append name "-" version "-checkout")))) (file-name (string-append name "-" version "-checkout"))))
(arguments
(substitute-keyword-arguments (package-arguments gx-guvnor-lv2)
((#:phases phases)
`(modify-phases ,phases
(add-after 'unpack 'escape-shell-commands
(lambda _
(substitute* "Makefile"
(("cat ") "$(shell cat ")
(("/dev/null") "/dev/null)")
(("SSE_CFLAGS = \"\"") "SSE_CFLAGS ="))
#t))))))
(home-page "https://github.com/brummer10/GxHyperion.lv2") (home-page "https://github.com/brummer10/GxHyperion.lv2")
(synopsis "Simulation of the Hyperion Fuzz pedal") (synopsis "Simulation of the Hyperion Fuzz pedal")
(description "This package provides the LV2 plugin \"GxHyperion\", a (description "This package provides the LV2 plugin \"GxHyperion\", a
simulation of the Hyperion Fuzz pedal.")))) simulation of the Hyperion Fuzz pedal."))))
(define-public gx-voodoo-fuzz-lv2 (define-public gx-voodoo-fuzz-lv2
(let ((commit "d2d6b27bc279f98c2fd11bbd58ffe2fb2c321ec4") (let ((commit "aec7889b489385e8add06126e7a36ae2e26254b1")
(revision "1")) (revision "2"))
(package (inherit gx-guvnor-lv2) (package (inherit gx-guvnor-lv2)
(name "gx-voodoo-fuzz-lv2") (name "gx-voodoo-fuzz-lv2")
(version (string-append "0-" revision "." (string-take commit 9))) (version (string-append "0-" revision "." (string-take commit 9)))
@ -2243,19 +2289,8 @@ simulation of the Hyperion Fuzz pedal."))))
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"1ji915bly588a8xwvwspvsqv0nh8ljgi6rky2mk1d9d6nz96jrbk")) "0mc41ldlv89069iaysnfiqxy5h5sr8mdi5cxm3ij5q5v4jv3viwx"))
(file-name (string-append name "-" version "-checkout")))) (file-name (string-append name "-" version "-checkout"))))
(arguments
(substitute-keyword-arguments (package-arguments gx-guvnor-lv2)
((#:phases phases)
`(modify-phases ,phases
(add-after 'unpack 'escape-shell-commands
(lambda _
(substitute* "Makefile"
(("cat ") "$(shell cat ")
(("/dev/null") "/dev/null)")
(("SSE_CFLAGS = \"\"") "SSE_CFLAGS ="))
#t))))))
(home-page "https://github.com/brummer10/GxVoodoFuzz.lv2") (home-page "https://github.com/brummer10/GxVoodoFuzz.lv2")
(synopsis "Fuzz effect modelled after the Voodoo Lab SuperFuzz") (synopsis "Fuzz effect modelled after the Voodoo Lab SuperFuzz")
(description "This package provides the LV2 plugin \"GxVoodooFuzz\", a (description "This package provides the LV2 plugin \"GxVoodooFuzz\", a
@ -2264,8 +2299,8 @@ Bosstone circuit, followed by the tone control of the FoxToneMachine in
parallel with a DarkBooster, followed by a volume control.")))) parallel with a DarkBooster, followed by a volume control."))))
(define-public gx-super-fuzz-lv2 (define-public gx-super-fuzz-lv2
(let ((commit "9800354caeb4082a64ca55b2daa9a9a1f79b8c21") (let ((commit "f40389575812c909007d140d327ce579930b71f7")
(revision "1")) (revision "2"))
(package (inherit gx-guvnor-lv2) (package (inherit gx-guvnor-lv2)
(name "gx-super-fuzz-lv2") (name "gx-super-fuzz-lv2")
(version (string-append "0-" revision "." (string-take commit 9))) (version (string-append "0-" revision "." (string-take commit 9)))
@ -2276,19 +2311,8 @@ parallel with a DarkBooster, followed by a volume control."))))
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"1jclp53p01h94cpx17wm4765r7klbr41g7bvq87l53qwlrgkc7a9")) "174bibj8qzm8zr6f5h8bcj94iry17zravk8flpdy84n6yg7cixji"))
(file-name (string-append name "-" version "-checkout")))) (file-name (string-append name "-" version "-checkout"))))
(arguments
(substitute-keyword-arguments (package-arguments gx-guvnor-lv2)
((#:phases phases)
`(modify-phases ,phases
(add-after 'unpack 'escape-shell-commands
(lambda _
(substitute* "Makefile"
(("cat ") "$(shell cat ")
(("/dev/null") "/dev/null)")
(("SSE_CFLAGS = \"\"") "SSE_CFLAGS ="))
#t))))))
(home-page "https://github.com/brummer10/GxSuperFuzz.lv2") (home-page "https://github.com/brummer10/GxSuperFuzz.lv2")
(synopsis "Fuzz effect modelled after the UniVox SuperFuzz") (synopsis "Fuzz effect modelled after the UniVox SuperFuzz")
(description "This package provides the LV2 plugin \"GxVoodooFuzz\", an (description "This package provides the LV2 plugin \"GxVoodooFuzz\", an
@ -2297,8 +2321,8 @@ pot, which is usualy in the housing, is exposed as a control parameter. It
adjusts the amount of harmonics.")))) adjusts the amount of harmonics."))))
(define-public gx-vintage-fuzz-master-lv2 (define-public gx-vintage-fuzz-master-lv2
(let ((commit "c3ab9a3019a8381a398718b98615940b4a225b9e") (let ((commit "0fec0bc1e8a8ba909a68e916e036138a3425d7db")
(revision "1")) (revision "2"))
(package (inherit gx-guvnor-lv2) (package (inherit gx-guvnor-lv2)
(name "gx-vintage-fuzz-master-lv2") (name "gx-vintage-fuzz-master-lv2")
(version (string-append "0-" revision "." (string-take commit 9))) (version (string-append "0-" revision "." (string-take commit 9)))
@ -2309,27 +2333,16 @@ adjusts the amount of harmonics."))))
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"0s1ghysggx6psalyhcpgjnmf38vama6jcqgbldqmxii5c2w2ybsc")) "06szi6d2iwkygbw5azhwzhcl2as4lmk2gs9hanngsf46a1zbdcp7"))
(file-name (string-append name "-" version "-checkout")))) (file-name (string-append name "-" version "-checkout"))))
(arguments
(substitute-keyword-arguments (package-arguments gx-guvnor-lv2)
((#:phases phases)
`(modify-phases ,phases
(add-after 'unpack 'escape-shell-commands
(lambda _
(substitute* "Makefile"
(("cat ") "$(shell cat ")
(("/dev/null") "/dev/null)")
(("SSE_CFLAGS = \"\"") "SSE_CFLAGS ="))
#t))))))
(home-page "https://github.com/brummer10/GxVintageFuzzMaster.lv2") (home-page "https://github.com/brummer10/GxVintageFuzzMaster.lv2")
(synopsis "Fuzz effect simulation of the vintage Fuzz Master") (synopsis "Fuzz effect simulation of the vintage Fuzz Master")
(description "This package provides the LV2 plugin (description "This package provides the LV2 plugin
\"GxVintageFuzzMaster\", a simulation of the vintage Fuzz Master pedal.")))) \"GxVintageFuzzMaster\", a simulation of the vintage Fuzz Master pedal."))))
(define-public gx-slow-gear-lv2 (define-public gx-slow-gear-lv2
(let ((commit "1071c2b2936ebad859242cb578af2f3415f8900f") (let ((commit "cb852e0426f4e6fe077e7f1ede73a4da335cfc5e")
(revision "1")) (revision "2"))
(package (inherit gx-guvnor-lv2) (package (inherit gx-guvnor-lv2)
(name "gx-slow-gear-lv2") (name "gx-slow-gear-lv2")
(version (string-append "0-" revision "." (string-take commit 9))) (version (string-append "0-" revision "." (string-take commit 9)))
@ -2340,27 +2353,16 @@ adjusts the amount of harmonics."))))
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"0c6099h5qkv7ilsvxxcrzwy1h6lkld1srh3fvbjxyw9q34kbqsyl")) "0dp7afi1r3kzciiyn1hrkz6arsq47ys9sx5g4b7xa9k1dv92ishp"))
(file-name (string-append name "-" version "-checkout")))) (file-name (string-append name "-" version "-checkout"))))
(arguments
(substitute-keyword-arguments (package-arguments gx-guvnor-lv2)
((#:phases phases)
`(modify-phases ,phases
(add-after 'unpack 'escape-shell-commands
(lambda _
(substitute* "Makefile"
(("cat ") "$(shell cat ")
(("/dev/null") "/dev/null)")
(("SSE_CFLAGS = \"\"") "SSE_CFLAGS ="))
#t))))))
(home-page "https://github.com/brummer10/GxSlowGear.lv2") (home-page "https://github.com/brummer10/GxSlowGear.lv2")
(synopsis "Slow gear audio effect") (synopsis "Slow gear audio effect")
(description "This package provides the LV2 plugin \"GxSlowGear\", a (description "This package provides the LV2 plugin \"GxSlowGear\", a
slow gear audio effect to produce volume swells.")))) slow gear audio effect to produce volume swells."))))
(define-public gx-switchless-wah-lv2 (define-public gx-switchless-wah-lv2
(let ((commit "1d466240c482b7ce9136aee39044068ab96f1c92") (let ((commit "7b08691203314612999f0ce2328cdc1161cd6665")
(revision "1")) (revision "2"))
(package (inherit gx-guvnor-lv2) (package (inherit gx-guvnor-lv2)
(name "gx-switchless-wah-lv2") (name "gx-switchless-wah-lv2")
(version (string-append "0-" revision "." (string-take commit 9))) (version (string-append "0-" revision "." (string-take commit 9)))
@ -2371,19 +2373,8 @@ slow gear audio effect to produce volume swells."))))
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"0g6njgsm8s76n6yys09a8w77z93pjjgqq9hzhhsrl73hhvyr9qmy")) "04jqfpncmrrqn34p21w4v9m2x5a5wsqwbm4f3byxvq4vcibwxzk2"))
(file-name (string-append name "-" version "-checkout")))) (file-name (string-append name "-" version "-checkout"))))
(arguments
(substitute-keyword-arguments (package-arguments gx-guvnor-lv2)
((#:phases phases)
`(modify-phases ,phases
(add-after 'unpack 'escape-shell-commands
(lambda _
(substitute* "Makefile"
(("cat ") "$(shell cat ")
(("/dev/null") "/dev/null)")
(("SSE_CFLAGS = \"\"") "SSE_CFLAGS ="))
#t))))))
(home-page "https://github.com/brummer10/GxSwitchlessWah.lv2") (home-page "https://github.com/brummer10/GxSwitchlessWah.lv2")
(synopsis "Wah emulation with switchless activation") (synopsis "Wah emulation with switchless activation")
(description "This package provides the LV2 plugin \"GxSwitchlessWah\", (description "This package provides the LV2 plugin \"GxSwitchlessWah\",

6
gnu/packages/networking.scm
View File

@ -454,7 +454,7 @@ and up to 1 Mbit/s downstream.")
(inputs (inputs
`(("libidn" ,libidn))) `(("libidn" ,libidn)))
(native-inputs (native-inputs
`(("gettext" ,gnu-gettext) `(("gettext" ,gettext-minimal)
("perl" ,perl))) ("perl" ,perl)))
(synopsis "Improved whois client") (synopsis "Improved whois client")
(description "This whois client is intelligent and can (description "This whois client is intelligent and can
@ -467,7 +467,7 @@ which can be used to encrypt a password with @code{crypt(3)}.")
(define-public wireshark (define-public wireshark
(package (package
(name "wireshark") (name "wireshark")
(version "2.2.1") (version "2.2.2")
(synopsis "Network traffic analyzer") (synopsis "Network traffic analyzer")
(source (source
(origin (origin
@ -476,7 +476,7 @@ which can be used to encrypt a password with @code{crypt(3)}.")
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"0jciaqz119vmznd8mi4gq5dgwz7vn453cnm2086mxcy80jpj43lh")))) "1csm035ayfzn1xzzsmzcjk2ixx39d70aykr4nh0a88chk9gfzb7r"))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(inputs `(("bison" ,bison) (inputs `(("bison" ,bison)
("c-ares" ,c-ares) ("c-ares" ,c-ares)

8
gnu/packages/package-management.scm
View File

@ -166,7 +166,7 @@
;; guix' always contains them. ;; guix' always contains them.
("autoconf" ,(autoconf-wrapper)) ("autoconf" ,(autoconf-wrapper))
("automake" ,automake) ("automake" ,automake)
("gettext" ,gnu-gettext) ("gettext" ,gettext-minimal)
("texinfo" ,texinfo) ("texinfo" ,texinfo)
("graphviz" ,graphviz) ("graphviz" ,graphviz)
("help2man" ,help2man))) ("help2man" ,help2man)))
@ -222,9 +222,9 @@ the Nix package manager.")
;; ;;
;; Note: use a very short commit id; with a longer one, the limit on ;; Note: use a very short commit id; with a longer one, the limit on
;; hash-bang lines would be exceeded while running the tests. ;; hash-bang lines would be exceeded while running the tests.
(let ((commit "7ca37da855fd921fa3925bb62f8015f770b7e784")) (let ((commit "1f410017ff91458feda8c5788223d17696b71e36"))
(package (inherit guix-0.11.0) (package (inherit guix-0.11.0)
(version (string-append "0.11.0-3." (string-take commit 4))) (version (string-append "0.11.0-4." (string-take commit 4)))
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -234,7 +234,7 @@ the Nix package manager.")
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"0bw5y9rgy2jq81lrd0g5c3gqpmlrjlgv0ynn7kz8v08lxkidaw8s")) "1mgzcbf1mry39wvvjflj76zggsshsip2pngxpaf2479yr3ri6v50"))
(file-name (string-append "guix-" version "-checkout")))) (file-name (string-append "guix-" version "-checkout"))))
(arguments (arguments
(substitute-keyword-arguments (package-arguments guix-0.11.0) (substitute-keyword-arguments (package-arguments guix-0.11.0)

102
gnu/packages/patches/gd-fix-chunk-size-on-boundaries.patch Normal file
View File

@ -0,0 +1,102 @@
This fixes PHP bug #73155: https://bugs.php.net/bug.php?id=73155
Patch adapted from upstream source repository:
https://github.com/libgd/libgd/commit/8067a8ac336dfe0acbe96ec2eb24572209a7f279
(.gitignore change removed)
From 8067a8ac336dfe0acbe96ec2eb24572209a7f279 Mon Sep 17 00:00:00 2001
From: "Christoph M. Becker" <cmbecker69@gmx.de>
Date: Fri, 23 Sep 2016 18:29:52 +0200
Subject: [PATCH] Fix #309: gdImageGd2() writes wrong chunk sizes on boundaries
(cherry picked from commit bb1998a16e30d542ab22eba5501911a9aa066edb)
---
src/gd_gd2.c | 4 ++--
tests/gd2/CMakeLists.txt | 1 +
tests/gd2/Makemodule.am | 1 +
tests/gd2/bug00309.c | 37 +++++++++++++++++++++++++++++++++++++
4 files changed, 41 insertions(+), 2 deletions(-)
create mode 100644 tests/gd2/bug00309.c
diff --git a/src/gd_gd2.c b/src/gd_gd2.c
index 75e5e1f..b9b2f93 100644
--- a/src/gd_gd2.c
+++ b/src/gd_gd2.c
@@ -938,8 +938,8 @@ _gdImageGd2 (gdImagePtr im, gdIOCtx * out, int cs, int fmt)
};
/* Work out number of chunks. */
- ncx = im->sx / cs + 1;
- ncy = im->sy / cs + 1;
+ ncx = (im->sx + cs - 1) / cs;
+ ncy = (im->sy + cs - 1) / cs;
/* Write the standard header. */
_gd2PutHeader (im, out, cs, fmt, ncx, ncy);
diff --git a/tests/gd2/CMakeLists.txt b/tests/gd2/CMakeLists.txt
index 3b650ad..247b466 100644
--- a/tests/gd2/CMakeLists.txt
+++ b/tests/gd2/CMakeLists.txt
@@ -1,5 +1,6 @@
SET(TESTS_FILES
bug_289
+ bug00309
gd2_empty_file
gd2_im2im
gd2_null
diff --git a/tests/gd2/Makemodule.am b/tests/gd2/Makemodule.am
index b8ee946..d69aee0 100644
--- a/tests/gd2/Makemodule.am
+++ b/tests/gd2/Makemodule.am
@@ -1,5 +1,6 @@
libgd_test_programs += \
gd2/bug_289 \
+ gd2/bug00309 \
gd2/gd2_empty_file \
gd2/php_bug_72339 \
gd2/gd2_read_corrupt
diff --git a/tests/gd2/bug00309.c b/tests/gd2/bug00309.c
new file mode 100644
index 0000000..b649cdc
--- /dev/null
+++ b/tests/gd2/bug00309.c
@@ -0,0 +1,37 @@
+/**
+ * Regression test for <https://github.com/libgd/libgd/issues/309>.
+ *
+ * We test that an image with 64x64 pixels reports only a single chunk in the
+ * GD2 image header when the chunk size is 64.
+ */
+
+
+#include "gd.h"
+#include "gdtest.h"
+
+
+int main()
+{
+ gdImagePtr im;
+ unsigned char *buf;
+ int size, word;
+
+ im = gdImageCreate(64, 64);
+ gdImageColorAllocate(im, 0, 0, 0);
+
+ buf = gdImageGd2Ptr(im, 64, 1, &size);
+
+ gdImageDestroy(im);
+
+ word = buf[10] << 8 | buf[11];
+ gdTestAssertMsg(word == 64, "chunk size is %d, but expected 64\n", word);
+ word = buf[14] << 8 | buf[15];
+ gdTestAssertMsg(word == 1, "x chunk count is %d, but expected 1\n", word);
+ word = buf[16] << 8 | buf[17];
+ gdTestAssertMsg(word == 1, "y chunk count is %d, but expected 1\n", word);
+ gdTestAssertMsg(size == 5145, "file size is %d, but expected 5145\n", size);
+
+ gdFree(buf);
+
+ return gdNumFailures();
+}

95
gnu/packages/patches/gd-fix-truecolor-format-correction.patch Normal file
View File

@ -0,0 +1,95 @@
This fixes PHP bug #73159: https://bugs.php.net/bug.php?id=73159
Patch lifted from upstream source repository:
https://github.com/libgd/libgd/commit/e1f61a4141d2e0937a13b8bfb1992b9f29eb05f5
From e1f61a4141d2e0937a13b8bfb1992b9f29eb05f5 Mon Sep 17 00:00:00 2001
From: "Christoph M. Becker" <cmbecker69@gmx.de>
Date: Mon, 15 Aug 2016 17:49:40 +0200
Subject: [PATCH] Fix #289: Passing unrecognized formats to gdImageGd2 results
in corrupted files
We must not apply the format correction twice for truecolor images.
(cherry picked from commit 09090c125658e23a4ae2a2e002646bb7278bd89e)
---
src/gd_gd2.c | 2 +-
tests/gd2/CMakeLists.txt | 1 +
tests/gd2/Makemodule.am | 1 +
tests/gd2/bug_289.c | 33 +++++++++++++++++++++++++++++++++
4 files changed, 36 insertions(+), 1 deletion(-)
create mode 100644 tests/gd2/bug_289.c
diff --git a/src/gd_gd2.c b/src/gd_gd2.c
index 86c881e..75e5e1f 100644
--- a/src/gd_gd2.c
+++ b/src/gd_gd2.c
@@ -918,7 +918,7 @@ _gdImageGd2 (gdImagePtr im, gdIOCtx * out, int cs, int fmt)
/* Force fmt to a valid value since we don't return anything. */
/* */
if ((fmt != GD2_FMT_RAW) && (fmt != GD2_FMT_COMPRESSED)) {
- fmt = im->trueColor ? GD2_FMT_TRUECOLOR_COMPRESSED : GD2_FMT_COMPRESSED;
+ fmt = GD2_FMT_COMPRESSED;
};
if (im->trueColor) {
fmt += 2;
diff --git a/tests/gd2/CMakeLists.txt b/tests/gd2/CMakeLists.txt
index 8aecacc..3b650ad 100644
--- a/tests/gd2/CMakeLists.txt
+++ b/tests/gd2/CMakeLists.txt
@@ -1,4 +1,5 @@
SET(TESTS_FILES
+ bug_289
gd2_empty_file
gd2_im2im
gd2_null
diff --git a/tests/gd2/Makemodule.am b/tests/gd2/Makemodule.am
index 754a284..b8ee946 100644
--- a/tests/gd2/Makemodule.am
+++ b/tests/gd2/Makemodule.am
@@ -1,4 +1,5 @@
libgd_test_programs += \
+ gd2/bug_289 \
gd2/gd2_empty_file \
gd2/php_bug_72339 \
gd2/gd2_read_corrupt
diff --git a/tests/gd2/bug_289.c b/tests/gd2/bug_289.c
new file mode 100644
index 0000000..ad311e9
--- /dev/null
+++ b/tests/gd2/bug_289.c
@@ -0,0 +1,33 @@
+/**
+ * Passing an unrecognized format to gdImageGd2() should result in
+ * GD2_FMT_TRUECOLOR_COMPRESSED for truecolor images.
+ *
+ * See <https://github.com/libgd/libgd/issues/289>.
+ */
+
+#include "gd.h"
+#include "gdtest.h"
+
+
+#define GD2_FMT_UNRECOGNIZED 0
+#define GD2_FMT_TRUECOLOR_COMPRESSED 4
+
+#define MSG "expected %s byte to be %d, but got %d\n"
+
+
+int main()
+{
+ gdImagePtr im;
+ char *buffer;
+ int size;
+
+ im = gdImageCreateTrueColor(10, 10);
+ gdTestAssert(im != NULL);
+ buffer = (char *) gdImageGd2Ptr(im, 128, GD2_FMT_UNRECOGNIZED, &size);
+ gdTestAssert(buffer != NULL);
+ gdImageDestroy(im);
+ gdTestAssertMsg(buffer[12] == 0, MSG, "1st", 0, buffer[12]);
+ gdTestAssertMsg(buffer[13] == GD2_FMT_TRUECOLOR_COMPRESSED, MSG, "2nd", GD2_FMT_TRUECOLOR_COMPRESSED, buffer[13]);
+
+ return gdNumFailures();
+}

48
gnu/packages/patches/guile-repl-server-test.patch Normal file
View File

@ -0,0 +1,48 @@
commit 8d6209ea56241bb1890c142539927c9ef3fb5a13
Author: Ludovic Courtès <ludo@gnu.org>
Date: Fri Nov 4 22:44:32 2016 +0100
tests: Throw 'unresolved when the REPL server is too slow.
commit 2fbde7f02adb8c6585e9baf6e293ee49cd23d4c4
Author: Ludovic Courtès <ludo@gnu.org>
Date: Fri Nov 4 22:45:51 2016 +0100
tests: Avoid race condition in REPL server test.
index ca389ba..4b5ec0c 100644
--- a/test-suite/tests/00-repl-server.test
+++ b/test-suite/tests/00-repl-server.test
@@ -61,10 +61,11 @@ socket connected to that server."
(lambda ()
(connect client-socket sockaddr))
(lambda args
- (when (and (memv (system-error-errno args)
- (list ENOENT ECONNREFUSED))
- (< tries 3))
- (sleep 1)
+ (when (memv (system-error-errno args)
+ (list ENOENT ECONNREFUSED))
+ (when (> tries 30)
+ (throw 'unresolved))
+ (usleep 100)
(loop (+ tries 1))))))
(proc client-socket))
@@ -104,8 +105,14 @@ reached."
"scheme@(repl-server)> $1 = 42\n"
(with-repl-server socket
(read-until-prompt socket %last-line-before-prompt)
- (display "(+ 40 2)\n(quit)\n" socket)
- (read-string socket)))
+
+ ;; Wait until 'repl-reader' in boot-9 has written the prompt.
+ ;; Otherwise, if we write too quickly, 'repl-reader' checks for
+ ;; 'char-ready?' and doesn't print the prompt.
+ (match (select (list socket) '() (list socket) 3)
+ (((_) () ())
+ (display "(+ 40 2)\n(quit)\n" socket)
+ (read-string socket)))))
(pass-if "HTTP inter-protocol attack" ;CVE-2016-8606
(with-repl-server socket

24
gnu/packages/patches/handbrake-pkg-config-path.patch Normal file
View File

@ -0,0 +1,24 @@
Do not clobber PKG_CONFIG_PATH during configure.
--- HandBrake-0.10.5/gtk/module.rules.orig 2016-02-11 14:14:05.000000000 -0600
+++ HandBrake-0.10.5/gtk/module.rules 2016-10-29 22:27:50.550960848 -0500
@@ -15,7 +15,7 @@
set -e; cd $(GTK.src/); NOCONFIGURE=1 ./autogen.sh
set -e; cd $(GTK.build/); $(call fn.ABSOLUTE,$(GTK.src/))configure \
$(GTK.CONFIGURE.extra) \
- PKG_CONFIG_PATH=$(BUILD/)contrib/lib/pkgconfig \
+ PKG_CONFIG_PATH=$(BUILD/)contrib/lib/pkgconfig$(if $(PKG_CONFIG_PATH),:)$(PKG_CONFIG_PATH) \
CFLAGS="$(call fn.ARGS,GTK.GCC,.g .O *D ?extra)" \
LDFLAGS="$(call fn.ARGS,GTK.GCC,?strip .g .O ?extra.exe)" \
--prefix=$(PREFIX) \
--- Handbrake-0.10.5-0.77d09e9-checkout/make/include/contrib.defs 1969-12-31 18:00:00.000000000 -0600
+++ Handbrake-0.10.5-0.77d09e9-checkout/make/include/contrib.defs 2016-11-01 13:11:43.826144311 -0500
@@ -119,7 +119,7 @@
endif
$(1).CONFIGURE.env.CPPFLAGS = CPPFLAGS="-I$$(call fn.ABSOLUTE,$(CONTRIB.build/))include $$(call fn.ARGS,$(1).GCC,*archs *sysroot *minver ?extra *D)"
$(1).CONFIGURE.env.LDFLAGS = LDFLAGS="-L$$(call fn.ABSOLUTE,$(CONTRIB.build/))lib $$(call fn.ARGS,$(1).GCC,*archs *sysroot *minver ?extra.exe *D)"
- $(1).CONFIGURE.env.PKG_CONFIG_PATH = PKG_CONFIG_PATH="$$(call fn.ABSOLUTE,$$(CONTRIB.build/))lib/pkgconfig"
+ $(1).CONFIGURE.env.PKG_CONFIG_PATH = PKG_CONFIG_PATH="$$(call fn.ABSOLUTE,$$(CONTRIB.build/))lib/pkgconfig$(if $(PKG_CONFIG_PATH),:)$(PKG_CONFIG_PATH)"
$(1).CONFIGURE.env.args = !CC !CFLAGS !CXX !CXXFLAGS !CPPFLAGS !LD !LDFLAGS !PKG_CONFIG_PATH !LOCAL_PATH !CROSS
$(1).CONFIGURE.env = $$(call fn.ARGS,$(1).CONFIGURE.env,$$($(1).CONFIGURE.env.args))

996
gnu/packages/patches/icecat-CVE-2016-9064.patch Normal file
View File

@ -0,0 +1,996 @@
Copied from
<https://hg.mozilla.org/releases/mozilla-esr45/raw-rev/00c2b7baaa0b>
but with one hunk omitted: the git binary patch for
toolkit/mozapps/extensions/test/addons/test_update_multi2/addon.xpi
which is not present in the IceCat sources.
# HG changeset patch
# User Andrew Swan <aswan@mozilla.com>
# Date 1474063218 25200
# Node ID 00c2b7baaa0b4bfb7d5f1aac31c094ea6b255e1f
# Parent 46b07bdbf8b20cf3fdc28104add57ff58a55832b
Bug 1303418 - Don't allow upgrades that change the addon ID. r=mossop, a=lizzard
MozReview-Commit-ID: JHINo8ShmeI
diff --git a/toolkit/mozapps/extensions/AddonManager.jsm b/toolkit/mozapps/extensions/AddonManager.jsm
--- a/toolkit/mozapps/extensions/AddonManager.jsm
+++ b/toolkit/mozapps/extensions/AddonManager.jsm
@@ -2956,16 +2956,18 @@ this.AddonManager = {
// The downloaded file seems to be corrupted in some way.
ERROR_CORRUPT_FILE: -3,
// An error occured trying to write to the filesystem.
ERROR_FILE_ACCESS: -4,
// The add-on must be signed and isn't.
ERROR_SIGNEDSTATE_REQUIRED: -5,
// The downloaded add-on had a different type than expected.
ERROR_UNEXPECTED_ADDON_TYPE: -6,
+ // The addon did not have the expected ID
+ ERROR_INCORRECT_ID: -7,
// These must be kept in sync with AddonUpdateChecker.
// No error was encountered.
UPDATE_STATUS_NO_ERROR: 0,
// The update check timed out
UPDATE_STATUS_TIMEOUT: -1,
// There was an error while downloading the update information.
UPDATE_STATUS_DOWNLOAD_ERROR: -2,
diff --git a/toolkit/mozapps/extensions/internal/XPIProvider.jsm b/toolkit/mozapps/extensions/internal/XPIProvider.jsm
--- a/toolkit/mozapps/extensions/internal/XPIProvider.jsm
+++ b/toolkit/mozapps/extensions/internal/XPIProvider.jsm
@@ -5473,16 +5473,37 @@ AddonInstall.prototype = {
// loadManifestFromZipReader performs the certificate verification for us
this.addon = yield loadManifestFromZipReader(zipreader, this.installLocation);
}
catch (e) {
zipreader.close();
return Promise.reject([AddonManager.ERROR_CORRUPT_FILE, e]);
}
+ if (this.existingAddon) {
+ // Check various conditions related to upgrades
+ if (this.addon.id != this.existingAddon.id) {
+ zipreader.close();
+ return Promise.reject([AddonManager.ERROR_INCORRECT_ID,
+ `Refusing to upgrade addon ${this.existingAddon.id} to different ID ${this.addon.id}`]);
+ }
+
+ if (this.addon.type == "multipackage") {
+ zipreader.close();
+ return Promise.reject([AddonManager.ERROR_UNEXPECTED_ADDON_TYPE,
+ `Refusing to upgrade addon ${this.existingAddon.id} to a multi-package xpi`]);
+ }
+
+ if (this.existingAddon.type == "webextension" && this.addon.type != "webextension") {
+ zipreader.close();
+ return Promise.reject([AddonManager.ERROR_UNEXPECTED_ADDON_TYPE,
+ "Webextensions may not be updated to other extension types"]);
+ }
+ }
+
if (mustSign(this.addon.type)) {
if (this.addon.signedState <= AddonManager.SIGNEDSTATE_MISSING) {
// This add-on isn't properly signed by a signature that chains to the
// trusted root.
let state = this.addon.signedState;
this.addon = null;
zipreader.close();
@@ -5510,23 +5531,16 @@ AddonInstall.prototype = {
} else {
zipreader.close();
return Promise.reject([AddonManager.ERROR_CORRUPT_FILE,
"XPI is incorrectly signed"]);
}
}
}
- if (this.existingAddon && this.existingAddon.type == "webextension" &&
- this.addon.type != "webextension") {
- zipreader.close();
- return Promise.reject([AddonManager.ERROR_UNEXPECTED_ADDON_TYPE,
- "WebExtensions may not be upated to other extension types"]);
- }
-
if (this.addon.type == "multipackage")
return this._loadMultipackageManifests(zipreader);
zipreader.close();
this.updateAddonURIs();
this.addon._install = this;
@@ -5791,16 +5805,17 @@ AddonInstall.prototype = {
else {
// TODO Should we send some event here (bug 557716)?
this.state = AddonManager.STATE_CHECKING;
new UpdateChecker(this.addon, {
onUpdateFinished: aAddon => this.downloadCompleted(),
}, AddonManager.UPDATE_WHEN_ADDON_INSTALLED);
}
}, ([error, message]) => {
+ this.removeTemporaryFile();
this.downloadFailed(error, message);
});
}
else {
if (aRequest instanceof Ci.nsIHttpChannel)
this.downloadFailed(AddonManager.ERROR_NETWORK_FAILURE,
aRequest.responseStatus + " " +
aRequest.responseStatusText);
diff --git a/toolkit/mozapps/extensions/test/addons/test_update_multi1/bootstrap.js b/toolkit/mozapps/extensions/test/addons/test_update_multi1/bootstrap.js
new file mode 100644
--- /dev/null
+++ b/toolkit/mozapps/extensions/test/addons/test_update_multi1/bootstrap.js
@@ -0,0 +1,5 @@
+
+function install(data, reason) {}
+function startup(data, reason) {}
+function shutdown(data, reason) {}
+function uninstall(data, reason) {}
diff --git a/toolkit/mozapps/extensions/test/addons/test_update_multi1/install.rdf b/toolkit/mozapps/extensions/test/addons/test_update_multi1/install.rdf
new file mode 100644
--- /dev/null
+++ b/toolkit/mozapps/extensions/test/addons/test_update_multi1/install.rdf
@@ -0,0 +1,16 @@
+<?xml version="1.0"?>
+<RDF xmlns="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns:em="http://www.mozilla.org/2004/em-rdf#">
+<Description about="urn:mozilla:install-manifest">
+ <em:id>updatemulti@tests.mozilla.org</em:id>
+ <em:version>1.0</em:version>
+ <em:updateURL>http://localhost:4444/data/test_update_multi.rdf</em:updateURL>
+ <em:bootstrap>true</em:bootstrap>
+ <em:name>Test Addon 1</em:name>
+<em:targetApplication><Description>
+ <em:id>xpcshell@tests.mozilla.org</em:id>
+ <em:minVersion>1</em:minVersion>
+ <em:maxVersion>1</em:maxVersion>
+</Description></em:targetApplication>
+</Description>
+</RDF>
diff --git a/toolkit/mozapps/extensions/test/addons/test_update_multi2/install.rdf b/toolkit/mozapps/extensions/test/addons/test_update_multi2/install.rdf
new file mode 100644
--- /dev/null
+++ b/toolkit/mozapps/extensions/test/addons/test_update_multi2/install.rdf
@@ -0,0 +1,9 @@
+<?xml version="1.0"?>
+<RDF xmlns="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns:em="http://www.mozilla.org/2004/em-rdf#">
+<Description about="urn:mozilla:install-manifest">
+ <em:id>updatemulti@tests.mozilla.org</em:id>
+ <em:type>32</em:type>
+ <em:version>2.0</em:version>
+</Description>
+</RDF>
diff --git a/toolkit/mozapps/extensions/test/addons/test_updateid1/bootstrap.js b/toolkit/mozapps/extensions/test/addons/test_updateid1/bootstrap.js
new file mode 100644
--- /dev/null
+++ b/toolkit/mozapps/extensions/test/addons/test_updateid1/bootstrap.js
@@ -0,0 +1,5 @@
+
+function install(data, reason) {}
+function startup(data, reason) {}
+function shutdown(data, reason) {}
+function uninstall(data, reason) {}
diff --git a/toolkit/mozapps/extensions/test/addons/test_updateid1/install.rdf b/toolkit/mozapps/extensions/test/addons/test_updateid1/install.rdf
new file mode 100644
--- /dev/null
+++ b/toolkit/mozapps/extensions/test/addons/test_updateid1/install.rdf
@@ -0,0 +1,16 @@
+<?xml version="1.0"?>
+<RDF xmlns="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns:em="http://www.mozilla.org/2004/em-rdf#">
+<Description about="urn:mozilla:install-manifest">
+ <em:id>addon1@tests.mozilla.org</em:id>
+ <em:version>1.0</em:version>
+ <em:updateURL>http://localhost:4444/data/test_updateid.rdf</em:updateURL>
+ <em:bootstrap>true</em:bootstrap>
+ <em:name>Test Addon 1</em:name>
+<em:targetApplication><Description>
+ <em:id>xpcshell@tests.mozilla.org</em:id>
+ <em:minVersion>1</em:minVersion>
+ <em:maxVersion>1</em:maxVersion>
+</Description></em:targetApplication>
+</Description>
+</RDF>
diff --git a/toolkit/mozapps/extensions/test/addons/test_updateid2/bootstrap.js b/toolkit/mozapps/extensions/test/addons/test_updateid2/bootstrap.js
new file mode 100644
--- /dev/null
+++ b/toolkit/mozapps/extensions/test/addons/test_updateid2/bootstrap.js
@@ -0,0 +1,5 @@
+
+function install(data, reason) {}
+function startup(data, reason) {}
+function shutdown(data, reason) {}
+function uninstall(data, reason) {}
diff --git a/toolkit/mozapps/extensions/test/addons/test_updateid2/install.rdf b/toolkit/mozapps/extensions/test/addons/test_updateid2/install.rdf
new file mode 100644
--- /dev/null
+++ b/toolkit/mozapps/extensions/test/addons/test_updateid2/install.rdf
@@ -0,0 +1,16 @@
+<?xml version="1.0"?>
+<RDF xmlns="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns:em="http://www.mozilla.org/2004/em-rdf#">
+<Description about="urn:mozilla:install-manifest">
+ <em:id>addon1.changed@tests.mozilla.org</em:id>
+ <em:version>2.0</em:version>
+ <em:updateURL>http://localhost:4444/data/test_updateid.rdf</em:updateURL>
+ <em:bootstrap>true</em:bootstrap>
+ <em:name>Test Addon 1</em:name>
+<em:targetApplication><Description>
+ <em:id>xpcshell@tests.mozilla.org</em:id>
+ <em:minVersion>1</em:minVersion>
+ <em:maxVersion>1</em:maxVersion>
+</Description></em:targetApplication>
+</Description>
+</RDF>
diff --git a/toolkit/mozapps/extensions/test/addons/test_updateid2_2/install.rdf b/toolkit/mozapps/extensions/test/addons/test_updateid2_2/install.rdf
deleted file mode 100644
--- a/toolkit/mozapps/extensions/test/addons/test_updateid2_2/install.rdf
+++ /dev/null
@@ -1,24 +0,0 @@
-<?xml version="1.0"?>
-
-<RDF xmlns="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
- xmlns:em="http://www.mozilla.org/2004/em-rdf#">
-
- <Description about="urn:mozilla:install-manifest">
- <em:id>addon2@tests.mozilla.org</em:id>
- <em:version>2.0</em:version>
- <em:updateURL>http://localhost:4444/data/test_updateid.rdf</em:updateURL>
-
- <!-- Front End MetaData -->
- <em:name>Test 2</em:name>
- <em:description>Test Description</em:description>
-
- <em:targetApplication>
- <Description>
- <em:id>xpcshell@tests.mozilla.org</em:id>
- <em:minVersion>1</em:minVersion>
- <em:maxVersion>1</em:maxVersion>
- </Description>
- </em:targetApplication>
-
- </Description>
-</RDF>
diff --git a/toolkit/mozapps/extensions/test/addons/test_updateid2_5/install.rdf b/toolkit/mozapps/extensions/test/addons/test_updateid2_5/install.rdf
deleted file mode 100644
--- a/toolkit/mozapps/extensions/test/addons/test_updateid2_5/install.rdf
+++ /dev/null
@@ -1,24 +0,0 @@
-<?xml version="1.0"?>
-
-<RDF xmlns="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
- xmlns:em="http://www.mozilla.org/2004/em-rdf#">
-
- <Description about="urn:mozilla:install-manifest">
- <em:id>addon2@tests.mozilla.org</em:id>
- <em:version>5.0</em:version>
- <em:updateURL>http://localhost:4444/data/test_updateid.rdf</em:updateURL>
-
- <!-- Front End MetaData -->
- <em:name>Test 2</em:name>
- <em:description>Test Description</em:description>
-
- <em:targetApplication>
- <Description>
- <em:id>xpcshell@tests.mozilla.org</em:id>
- <em:minVersion>1</em:minVersion>
- <em:maxVersion>1</em:maxVersion>
- </Description>
- </em:targetApplication>
-
- </Description>
-</RDF>
diff --git a/toolkit/mozapps/extensions/test/addons/test_updateid3_3/bootstrap.js b/toolkit/mozapps/extensions/test/addons/test_updateid3_3/bootstrap.js
deleted file mode 100644
--- a/toolkit/mozapps/extensions/test/addons/test_updateid3_3/bootstrap.js
+++ /dev/null
@@ -1,21 +0,0 @@
-Components.utils.import("resource://gre/modules/Services.jsm");
-
-function install(data, reason) {
- Services.prefs.setIntPref("bootstraptest.installed_version", 3);
- Services.prefs.setIntPref("bootstraptest.install_reason", reason);
-}
-
-function startup(data, reason) {
- Services.prefs.setIntPref("bootstraptest.active_version", 3);
- Services.prefs.setIntPref("bootstraptest.startup_reason", reason);
-}
-
-function shutdown(data, reason) {
- Services.prefs.setIntPref("bootstraptest.active_version", 0);
- Services.prefs.setIntPref("bootstraptest.shutdown_reason", reason);
-}
-
-function uninstall(data, reason) {
- Services.prefs.setIntPref("bootstraptest.installed_version", 0);
- Services.prefs.setIntPref("bootstraptest.uninstall_reason", reason);
-}
diff --git a/toolkit/mozapps/extensions/test/addons/test_updateid3_3/install.rdf b/toolkit/mozapps/extensions/test/addons/test_updateid3_3/install.rdf
deleted file mode 100644
--- a/toolkit/mozapps/extensions/test/addons/test_updateid3_3/install.rdf
+++ /dev/null
@@ -1,25 +0,0 @@
-<?xml version="1.0"?>
-
-<RDF xmlns="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
- xmlns:em="http://www.mozilla.org/2004/em-rdf#">
-
- <Description about="urn:mozilla:install-manifest">
- <em:id>addon3@tests.mozilla.org</em:id>
- <em:version>3.0</em:version>
- <em:updateURL>http://localhost:4444/data/test_updateid.rdf</em:updateURL>
- <em:bootstrap>true</em:bootstrap>
-
- <!-- Front End MetaData -->
- <em:name>Test 3</em:name>
- <em:description>Test Description</em:description>
-
- <em:targetApplication>
- <Description>
- <em:id>xpcshell@tests.mozilla.org</em:id>
- <em:minVersion>1</em:minVersion>
- <em:maxVersion>1</em:maxVersion>
- </Description>
- </em:targetApplication>
-
- </Description>
-</RDF>
diff --git a/toolkit/mozapps/extensions/test/addons/test_updateid4_4/bootstrap.js b/toolkit/mozapps/extensions/test/addons/test_updateid4_4/bootstrap.js
deleted file mode 100644
--- a/toolkit/mozapps/extensions/test/addons/test_updateid4_4/bootstrap.js
+++ /dev/null
@@ -1,21 +0,0 @@
-Components.utils.import("resource://gre/modules/Services.jsm");
-
-function install(data, reason) {
- Services.prefs.setIntPref("bootstraptest.installed_version", 4);
- Services.prefs.setIntPref("bootstraptest.install_reason", reason);
-}
-
-function startup(data, reason) {
- Services.prefs.setIntPref("bootstraptest.active_version", 4);
- Services.prefs.setIntPref("bootstraptest.startup_reason", reason);
-}
-
-function shutdown(data, reason) {
- Services.prefs.setIntPref("bootstraptest.active_version", 0);
- Services.prefs.setIntPref("bootstraptest.shutdown_reason", reason);
-}
-
-function uninstall(data, reason) {
- Services.prefs.setIntPref("bootstraptest.installed_version", 0);
- Services.prefs.setIntPref("bootstraptest.uninstall_reason", reason);
-}
diff --git a/toolkit/mozapps/extensions/test/addons/test_updateid4_4/install.rdf b/toolkit/mozapps/extensions/test/addons/test_updateid4_4/install.rdf
deleted file mode 100644
--- a/toolkit/mozapps/extensions/test/addons/test_updateid4_4/install.rdf
+++ /dev/null
@@ -1,25 +0,0 @@
-<?xml version="1.0"?>
-
-<RDF xmlns="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
- xmlns:em="http://www.mozilla.org/2004/em-rdf#">
-
- <Description about="urn:mozilla:install-manifest">
- <em:id>addon4@tests.mozilla.org</em:id>
- <em:version>4.0</em:version>
- <em:updateURL>http://localhost:4444/data/test_updateid.rdf</em:updateURL>
- <em:bootstrap>true</em:bootstrap>
-
- <!-- Front End MetaData -->
- <em:name>Test 4</em:name>
- <em:description>Test Description</em:description>
-
- <em:targetApplication>
- <Description>
- <em:id>xpcshell@tests.mozilla.org</em:id>
- <em:minVersion>1</em:minVersion>
- <em:maxVersion>1</em:maxVersion>
- </Description>
- </em:targetApplication>
-
- </Description>
-</RDF>
diff --git a/toolkit/mozapps/extensions/test/xpcshell/data/test_update_multi.rdf b/toolkit/mozapps/extensions/test/xpcshell/data/test_update_multi.rdf
new file mode 100644
--- /dev/null
+++ b/toolkit/mozapps/extensions/test/xpcshell/data/test_update_multi.rdf
@@ -0,0 +1,26 @@
+<?xml version="1.0" encoding="UTF-8"?>
+
+<RDF xmlns="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns:em="http://www.mozilla.org/2004/em-rdf#">
+
+ <Description about="urn:mozilla:extension:updatemulti@tests.mozilla.org">
+ <em:updates>
+ <Seq>
+ <li>
+ <Description>
+ <em:version>2.0</em:version>
+ <em:targetApplication>
+ <Description>
+ <em:id>xpcshell@tests.mozilla.org</em:id>
+ <em:minVersion>1</em:minVersion>
+ <em:maxVersion>1</em:maxVersion>
+ <em:updateLink>http://localhost:4444/addons/test_update_multi2.xpi</em:updateLink>
+ </Description>
+ </em:targetApplication>
+ </Description>
+ </li>
+ </Seq>
+ </em:updates>
+ </Description>
+
+</RDF>
diff --git a/toolkit/mozapps/extensions/test/xpcshell/data/test_updateid.rdf b/toolkit/mozapps/extensions/test/xpcshell/data/test_updateid.rdf
--- a/toolkit/mozapps/extensions/test/xpcshell/data/test_updateid.rdf
+++ b/toolkit/mozapps/extensions/test/xpcshell/data/test_updateid.rdf
@@ -9,77 +9,17 @@
<li>
<Description>
<em:version>2.0</em:version>
<em:targetApplication>
<Description>
<em:id>xpcshell@tests.mozilla.org</em:id>
<em:minVersion>1</em:minVersion>
<em:maxVersion>1</em:maxVersion>
- <em:updateLink>http://localhost:4444/addons/test_updateid2_2.xpi</em:updateLink>
- </Description>
- </em:targetApplication>
- </Description>
- </li>
- </Seq>
- </em:updates>
- </Description>
-
- <Description about="urn:mozilla:extension:addon2@tests.mozilla.org">
- <em:updates>
- <Seq>
- <li>
- <Description>
- <em:version>3.0</em:version>
- <em:targetApplication>
- <Description>
- <em:id>xpcshell@tests.mozilla.org</em:id>
- <em:minVersion>1</em:minVersion>
- <em:maxVersion>1</em:maxVersion>
- <em:updateLink>http://localhost:4444/addons/test_updateid3_3.xpi</em:updateLink>
- </Description>
- </em:targetApplication>
- </Description>
- </li>
- </Seq>
- </em:updates>
- </Description>
-
- <Description about="urn:mozilla:extension:addon3@tests.mozilla.org">
- <em:updates>
- <Seq>
- <li>
- <Description>
- <em:version>4.0</em:version>
- <em:targetApplication>
- <Description>
- <em:id>xpcshell@tests.mozilla.org</em:id>
- <em:minVersion>1</em:minVersion>
- <em:maxVersion>1</em:maxVersion>
- <em:updateLink>http://localhost:4444/addons/test_updateid4_4.xpi</em:updateLink>
- </Description>
- </em:targetApplication>
- </Description>
- </li>
- </Seq>
- </em:updates>
- </Description>
-
- <Description about="urn:mozilla:extension:addon4@tests.mozilla.org">
- <em:updates>
- <Seq>
- <li>
- <Description>
- <em:version>5.0</em:version>
- <em:targetApplication>
- <Description>
- <em:id>xpcshell@tests.mozilla.org</em:id>
- <em:minVersion>1</em:minVersion>
- <em:maxVersion>1</em:maxVersion>
- <em:updateLink>http://localhost:4444/addons/test_updateid2_5.xpi</em:updateLink>
+ <em:updateLink>http://localhost:4444/addons/test_updateid2.xpi</em:updateLink>
</Description>
</em:targetApplication>
</Description>
</li>
</Seq>
</em:updates>
</Description>
diff --git a/toolkit/mozapps/extensions/test/xpcshell/test_updateid.js b/toolkit/mozapps/extensions/test/xpcshell/test_updateid.js
--- a/toolkit/mozapps/extensions/test/xpcshell/test_updateid.js
+++ b/toolkit/mozapps/extensions/test/xpcshell/test_updateid.js
@@ -2,421 +2,85 @@
* http://creativecommons.org/publicdomain/zero/1.0/
*/
// This verifies that updating an add-on to a new ID works
// The test extension uses an insecure update url.
Services.prefs.setBoolPref("extensions.checkUpdateSecurity", false);
-Components.utils.import("resource://testing-common/httpd.js");
-var testserver;
const profileDir = gProfD.clone();
profileDir.append("extensions");
-function resetPrefs() {
- Services.prefs.setIntPref("bootstraptest.active_version", -1);
- Services.prefs.setIntPref("bootstraptest.installed_version", -1);
- Services.prefs.setIntPref("bootstraptest.startup_reason", -1);
- Services.prefs.setIntPref("bootstraptest.shutdown_reason", -1);
- Services.prefs.setIntPref("bootstraptest.install_reason", -1);
- Services.prefs.setIntPref("bootstraptest.uninstall_reason", -1);
-}
-
-function getActiveVersion() {
- return Services.prefs.getIntPref("bootstraptest.active_version");
-}
-
-function getInstalledVersion() {
- return Services.prefs.getIntPref("bootstraptest.installed_version");
-}
-
-function run_test() {
- createAppInfo("xpcshell@tests.mozilla.org", "XPCShell", "1", "1.9.2");
-
- // Create and configure the HTTP server.
- testserver = new HttpServer();
- testserver.registerDirectory("/data/", do_get_file("data"));
- testserver.registerDirectory("/addons/", do_get_file("addons"));
- testserver.start(4444);
-
- do_test_pending();
- run_test_1();
-}
-
-function end_test() {
- testserver.stop(do_test_finished);
-}
-
-function installUpdate(aInstall, aCallback) {
- aInstall.addListener({
- onInstallEnded: function(aInstall) {
- // give the startup time to run
- do_execute_soon(function() {
- aCallback(aInstall);
- });
- }
- });
-
- aInstall.install();
-}
-
-// Verify that an update to an add-on with a new ID uninstalls the old add-on
-function run_test_1() {
- writeInstallRDFForExtension({
- id: "addon1@tests.mozilla.org",
- version: "1.0",
- updateURL: "http://localhost:4444/data/test_updateid.rdf",
- targetApplications: [{
- id: "xpcshell@tests.mozilla.org",
- minVersion: "1",
- maxVersion: "1"
- }],
- name: "Test Addon 1",
- }, profileDir);
-
- startupManager();
-
- AddonManager.getAddonByID("addon1@tests.mozilla.org", function(a1) {
- do_check_neq(a1, null);
- do_check_eq(a1.version, "1.0");
+function promiseInstallUpdate(install) {
+ return new Promise((resolve, reject) => {
+ install.addListener({
+ onDownloadFailed: () => {
+ let err = new Error("download error");
+ err.code = install.error;
+ reject(err);
+ },
+ onInstallFailed: () => {
+ let err = new Error("install error");
+ err.code = install.error;
+ reject(err);
+ },
+ onInstallEnded: resolve,
+ });
- a1.findUpdates({
- onUpdateAvailable: function(addon, install) {
- do_check_eq(install.name, addon.name);
- do_check_eq(install.version, "2.0");
- do_check_eq(install.state, AddonManager.STATE_AVAILABLE);
- do_check_eq(install.existingAddon, a1);
-
- installUpdate(install, check_test_1);
- }
- }, AddonManager.UPDATE_WHEN_USER_REQUESTED);
- });
-}
-
-function check_test_1(install) {
- AddonManager.getAddonByID("addon1@tests.mozilla.org", callback_soon(function(a1) {
- // Existing add-on should have a pending upgrade
- do_check_neq(a1.pendingUpgrade, null);
- do_check_eq(a1.pendingUpgrade.id, "addon2@tests.mozilla.org");
- do_check_eq(a1.pendingUpgrade.install.existingAddon, a1);
- do_check_neq(a1.syncGUID);
-
- let a1SyncGUID = a1.syncGUID;
-
- restartManager();
-
- AddonManager.getAddonsByIDs(["addon1@tests.mozilla.org",
- "addon2@tests.mozilla.org"], function([a1, a2]) {
- // Should have uninstalled the old and installed the new
- do_check_eq(a1, null);
- do_check_neq(a2, null);
- do_check_neq(a2.syncGUID, null);
-
- // The Sync GUID should change when the ID changes
- do_check_neq(a1SyncGUID, a2.syncGUID);
-
- a2.uninstall();
-
- do_execute_soon(run_test_2);
- });
- }));
-}
-
-// Test that when the new add-on already exists we just upgrade that
-function run_test_2() {
- restartManager();
- shutdownManager();
-
- writeInstallRDFForExtension({
- id: "addon1@tests.mozilla.org",
- version: "1.0",
- updateURL: "http://localhost:4444/data/test_updateid.rdf",
- targetApplications: [{
- id: "xpcshell@tests.mozilla.org",
- minVersion: "1",
- maxVersion: "1"
- }],
- name: "Test Addon 1",
- }, profileDir);
- writeInstallRDFForExtension({
- id: "addon2@tests.mozilla.org",
- version: "1.0",
- targetApplications: [{
- id: "xpcshell@tests.mozilla.org",
- minVersion: "1",
- maxVersion: "1"
- }],
- name: "Test Addon 2",
- }, profileDir);
-
- startupManager();
-
- AddonManager.getAddonByID("addon1@tests.mozilla.org", function(a1) {
- do_check_neq(a1, null);
- do_check_eq(a1.version, "1.0");
-
- a1.findUpdates({
- onUpdateAvailable: function(addon, install) {
- installUpdate(install, check_test_2);
- }
- }, AddonManager.UPDATE_WHEN_USER_REQUESTED);
+ install.install();
});
}
-function check_test_2(install) {
- AddonManager.getAddonsByIDs(["addon1@tests.mozilla.org",
- "addon2@tests.mozilla.org"],
- callback_soon(function([a1, a2]) {
- do_check_eq(a1.pendingUpgrade, null);
- // Existing add-on should have a pending upgrade
- do_check_neq(a2.pendingUpgrade, null);
- do_check_eq(a2.pendingUpgrade.id, "addon2@tests.mozilla.org");
- do_check_eq(a2.pendingUpgrade.install.existingAddon, a2);
-
- restartManager();
-
- AddonManager.getAddonsByIDs(["addon1@tests.mozilla.org",
- "addon2@tests.mozilla.org"], function([a1, a2]) {
- // Should have uninstalled the old and installed the new
- do_check_neq(a1, null);
- do_check_neq(a2, null);
-
- a1.uninstall();
- a2.uninstall();
-
- do_execute_soon(run_test_3);
- });
- }));
-}
-
-// Test that we rollback correctly when removing the old add-on fails
-function run_test_3() {
- restartManager();
- shutdownManager();
-
- // This test only works on Windows
- if (!("nsIWindowsRegKey" in AM_Ci)) {
- run_test_4();
- return;
- }
-
- writeInstallRDFForExtension({
- id: "addon1@tests.mozilla.org",
- version: "1.0",
- updateURL: "http://localhost:4444/data/test_updateid.rdf",
- targetApplications: [{
- id: "xpcshell@tests.mozilla.org",
- minVersion: "1",
- maxVersion: "1"
- }],
- name: "Test Addon 1",
- }, profileDir);
-
- startupManager();
+// Create and configure the HTTP server.
+let testserver = createHttpServer(4444);
+testserver.registerDirectory("/data/", do_get_file("data"));
+testserver.registerDirectory("/addons/", do_get_file("addons"));
- AddonManager.getAddonByID("addon1@tests.mozilla.org", function(a1) {
- do_check_neq(a1, null);
- do_check_eq(a1.version, "1.0");
-
- a1.findUpdates({
- onUpdateAvailable: function(addon, install) {
- installUpdate(install, check_test_3);
- }
- }, AddonManager.UPDATE_WHEN_USER_REQUESTED);
- });
-}
-
-function check_test_3(install) {
- AddonManager.getAddonByID("addon1@tests.mozilla.org", callback_soon(function(a1) {
- // Existing add-on should have a pending upgrade
- do_check_neq(a1.pendingUpgrade, null);
- do_check_eq(a1.pendingUpgrade.id, "addon2@tests.mozilla.org");
- do_check_eq(a1.pendingUpgrade.install.existingAddon, a1);
-
- // Lock the old add-on open so it can't be uninstalled
- var file = profileDir.clone();
- file.append("addon1@tests.mozilla.org");
- if (!file.exists())
- file.leafName += ".xpi";
- else
- file.append("install.rdf");
-
- var fstream = AM_Cc["@mozilla.org/network/file-output-stream;1"].
- createInstance(AM_Ci.nsIFileOutputStream);
- fstream.init(file, FileUtils.MODE_APPEND | FileUtils.MODE_WRONLY, FileUtils.PERMS_FILE, 0);
-
- restartManager();
-
- fstream.close();
-
- AddonManager.getAddonsByIDs(["addon1@tests.mozilla.org",
- "addon2@tests.mozilla.org"],
- callback_soon(function([a1, a2]) {
- // Should not have installed the new add-on but it should still be
- // pending install
- do_check_neq(a1, null);
- do_check_eq(a2, null);
-
- restartManager();
-
- AddonManager.getAddonsByIDs(["addon1@tests.mozilla.org",
- "addon2@tests.mozilla.org"], function([a1, a2]) {
- // Should have installed the new add-on
- do_check_eq(a1, null);
- do_check_neq(a2, null);
-
- a2.uninstall();
-
- do_execute_soon(run_test_4);
- });
- }));
- }));
+function run_test() {
+ createAppInfo("xpcshell@tests.mozilla.org", "XPCShell", "1", "1.9.2");
+ startupManager();
+ run_next_test();
}
-// Tests that upgrading to a bootstrapped add-on works but requires a restart
-function run_test_4() {
- restartManager();
- shutdownManager();
-
- writeInstallRDFForExtension({
- id: "addon2@tests.mozilla.org",
- version: "2.0",
- updateURL: "http://localhost:4444/data/test_updateid.rdf",
- targetApplications: [{
- id: "xpcshell@tests.mozilla.org",
- minVersion: "1",
- maxVersion: "1"
- }],
- name: "Test Addon 2",
- }, profileDir);
-
- startupManager();
-
- resetPrefs();
-
- AddonManager.getAddonByID("addon2@tests.mozilla.org", function(a2) {
- do_check_neq(a2, null);
- do_check_neq(a2.syncGUID, null);
- do_check_eq(a2.version, "2.0");
-
- a2.findUpdates({
- onUpdateAvailable: function(addon, install) {
- installUpdate(install, check_test_4);
- }
- }, AddonManager.UPDATE_WHEN_USER_REQUESTED);
- });
-}
-
-function check_test_4() {
- AddonManager.getAddonsByIDs(["addon2@tests.mozilla.org",
- "addon3@tests.mozilla.org"],
- callback_soon(function([a2, a3]) {
- // Should still be pending install even though the new add-on is restartless
- do_check_neq(a2, null);
- do_check_eq(a3, null);
-
- do_check_neq(a2.pendingUpgrade, null);
- do_check_eq(a2.pendingUpgrade.id, "addon3@tests.mozilla.org");
-
- do_check_eq(getInstalledVersion(), -1);
- do_check_eq(getActiveVersion(), -1);
-
- restartManager();
-
- AddonManager.getAddonsByIDs(["addon2@tests.mozilla.org",
- "addon3@tests.mozilla.org"], function([a2, a3]) {
- // Should have updated
- do_check_eq(a2, null);
- do_check_neq(a3, null);
-
- do_check_eq(getInstalledVersion(), 3);
- do_check_eq(getActiveVersion(), 3);
-
- do_execute_soon(run_test_5);
- });
- }));
-}
-
-// Tests that upgrading to another bootstrapped add-on works without a restart
-function run_test_5() {
- AddonManager.getAddonByID("addon3@tests.mozilla.org", function(a3) {
- do_check_neq(a3, null);
- do_check_eq(a3.version, "3.0");
+// Verify that an update to an add-on with a new ID fails
+add_task(function* test_update_new_id() {
+ yield promiseInstallAllFiles([do_get_addon("test_updateid1")]);
- a3.findUpdates({
- onUpdateAvailable: function(addon, install) {
- installUpdate(install, check_test_5);
- }
- }, AddonManager.UPDATE_WHEN_USER_REQUESTED);
- });
-}
-
-function check_test_5() {
- AddonManager.getAddonsByIDs(["addon3@tests.mozilla.org",
- "addon4@tests.mozilla.org"],
- callback_soon(function([a3, a4]) {
- // Should have updated
- do_check_eq(a3, null);
- do_check_neq(a4, null);
-
- do_check_eq(getInstalledVersion(), 4);
- do_check_eq(getActiveVersion(), 4);
-
- restartManager();
-
- AddonManager.getAddonsByIDs(["addon3@tests.mozilla.org",
- "addon4@tests.mozilla.org"], function([a3, a4]) {
- // Should still be gone
- do_check_eq(a3, null);
- do_check_neq(a4, null);
-
- do_check_eq(getInstalledVersion(), 4);
- do_check_eq(getActiveVersion(), 4);
-
- run_test_6();
- });
- }));
-}
+ let addon = yield promiseAddonByID("addon1@tests.mozilla.org");
+ do_check_neq(addon, null);
+ do_check_eq(addon.version, "1.0");
-// Tests that upgrading to a non-bootstrapped add-on works but requires a restart
-function run_test_6() {
- AddonManager.getAddonByID("addon4@tests.mozilla.org", function(a4) {
- do_check_neq(a4, null);
- do_check_eq(a4.version, "4.0");
-
- a4.findUpdates({
- onUpdateAvailable: function(addon, install) {
- installUpdate(install, check_test_6);
- }
- }, AddonManager.UPDATE_WHEN_USER_REQUESTED);
- });
-}
+ let update = yield promiseFindAddonUpdates(addon, AddonManager.UPDATE_WHEN_USER_REQUESTED);
+ let install = update.updateAvailable;
+ do_check_eq(install.name, addon.name);
+ do_check_eq(install.version, "2.0");
+ do_check_eq(install.state, AddonManager.STATE_AVAILABLE);
+ do_check_eq(install.existingAddon, addon);
-function check_test_6() {
- AddonManager.getAddonsByIDs(["addon4@tests.mozilla.org",
- "addon2@tests.mozilla.org"],
- callback_soon(function([a4, a2]) {
- // Should still be pending install even though the old add-on is restartless
- do_check_neq(a4, null);
- do_check_eq(a2, null);
-
- do_check_neq(a4.pendingUpgrade, null);
- do_check_eq(a4.pendingUpgrade.id, "addon2@tests.mozilla.org");
-
- do_check_eq(getInstalledVersion(), 4);
- do_check_eq(getActiveVersion(), 4);
+ yield Assert.rejects(promiseInstallUpdate(install),
+ function(err) { return err.code == AddonManager.ERROR_INCORRECT_ID },
+ "Upgrade to a different ID fails");
- restartManager();
+ addon.uninstall();
+});
- AddonManager.getAddonsByIDs(["addon4@tests.mozilla.org",
- "addon2@tests.mozilla.org"], function([a4, a2]) {
- // Should have updated
- do_check_eq(a4, null);
- do_check_neq(a2, null);
+// Verify that an update to a multi-package xpi fails
+add_task(function* test_update_new_id() {
+ yield promiseInstallAllFiles([do_get_addon("test_update_multi1")]);
- do_check_eq(getInstalledVersion(), 0);
- do_check_eq(getActiveVersion(), 0);
+ let addon = yield promiseAddonByID("updatemulti@tests.mozilla.org");
+ do_check_neq(addon, null);
+ do_check_eq(addon.version, "1.0");
- end_test();
- });
- }));
-}
+ let update = yield promiseFindAddonUpdates(addon, AddonManager.UPDATE_WHEN_USER_REQUESTED);
+ let install = update.updateAvailable;
+ do_check_eq(install.name, addon.name);
+ do_check_eq(install.version, "2.0");
+ do_check_eq(install.state, AddonManager.STATE_AVAILABLE);
+ do_check_eq(install.existingAddon, addon);
+
+ yield Assert.rejects(promiseInstallUpdate(install),
+ function(err) { return err.code == AddonManager.ERROR_UNEXPECTED_ADDON_TYPE },
+ "Upgrade to a multipackage xpi fails");
+
+ addon.uninstall();
+});

47
gnu/packages/patches/libtiff-CVE-2016-5652.patch
View File

@ -1,47 +0,0 @@
Fix CVE-2016-5652 (buffer overflow in t2p_readwrite_pdf_image_tile()).
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2016-5652
Patches exfiltrated from upstream CVS repo with:
cvs diff -u -r 1.92 -r 1.94 tools/tiff2pdf.c
Index: tools/tiff2pdf.c
===================================================================
RCS file: /cvs/maptools/cvsroot/libtiff/tools/tiff2pdf.c,v
retrieving revision 1.92
retrieving revision 1.94
diff -u -r1.92 -r1.94
--- a/tools/tiff2pdf.c 23 Sep 2016 22:12:18 -0000 1.92
+++ b/tools/tiff2pdf.c 9 Oct 2016 11:03:36 -0000 1.94
@@ -2887,21 +2887,24 @@
return(0);
}
if(TIFFGetField(input, TIFFTAG_JPEGTABLES, &count, &jpt) != 0) {
- if (count > 0) {
- _TIFFmemcpy(buffer, jpt, count);
+ if (count >= 4) {
+ /* Ignore EOI marker of JpegTables */
+ _TIFFmemcpy(buffer, jpt, count - 2);
bufferoffset += count - 2;
+ /* Store last 2 bytes of the JpegTables */
table_end[0] = buffer[bufferoffset-2];
table_end[1] = buffer[bufferoffset-1];
- }
- if (count > 0) {
xuint32 = bufferoffset;
+ bufferoffset -= 2;
bufferoffset += TIFFReadRawTile(
input,
tile,
- (tdata_t) &(((unsigned char*)buffer)[bufferoffset-2]),
+ (tdata_t) &(((unsigned char*)buffer)[bufferoffset]),
-1);
- buffer[xuint32-2]=table_end[0];
- buffer[xuint32-1]=table_end[1];
+ /* Overwrite SOI marker of image scan with previously */
+ /* saved end of JpegTables */
+ buffer[xuint32-2]=table_end[0];
+ buffer[xuint32-1]=table_end[1];
} else {
bufferoffset += TIFFReadRawTile(
input,

41
gnu/packages/patches/libtiff-CVE-2016-9273.patch
View File

@ -1,41 +0,0 @@
Fix CVE-2016-9273:
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2016-9273
http://bugzilla.maptools.org/show_bug.cgi?id=2587
Patch extracted from upstream CVS repo:
2016-11-10 Even Rouault <even.rouault at spatialys.com>
revision 1.37
date: 2016-11-09 18:00:49 -0500; author: erouault; state: Exp; lines: +10 -1; commitid: pzKipPxDJO2dxvtz;
* libtiff/tif_strip.c: make TIFFNumberOfStrips() return the td->td_nstrips
value when it is non-zero, instead of recomputing it. This is needed in
TIFF_STRIPCHOP mode where td_nstrips is modified. Fixes a read outsize of
array in tiffsplit (or other utilities using TIFFNumberOfStrips()).
Fixes http://bugzilla.maptools.org/show_bug.cgi?id=2587
Index: libtiff/tif_strip.c
===================================================================
RCS file: /cvs/maptools/cvsroot/libtiff/libtiff/tif_strip.c,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- a/libtiff/tif_strip.c 7 Jun 2015 22:35:40 -0000 1.36
+++ b/libtiff/tif_strip.c 9 Nov 2016 23:00:49 -0000 1.37
@@ -63,6 +63,15 @@
TIFFDirectory *td = &tif->tif_dir;
uint32 nstrips;
+ /* If the value was already computed and store in td_nstrips, then return it,
+ since ChopUpSingleUncompressedStrip might have altered and resized the
+ since the td_stripbytecount and td_stripoffset arrays to the new value
+ after the initial affectation of td_nstrips = TIFFNumberOfStrips() in
+ tif_dirread.c ~line 3612.
+ See http://bugzilla.maptools.org/show_bug.cgi?id=2587 */
+ if( td->td_nstrips )
+ return td->td_nstrips;
+
nstrips = (td->td_rowsperstrip == (uint32) -1 ? 1 :
TIFFhowmany_32(td->td_imagelength, td->td_rowsperstrip));
if (td->td_planarconfig == PLANARCONFIG_SEPARATE)

14
gnu/packages/patches/lvm2-static-link.patch Normal file
View File

@ -0,0 +1,14 @@
Fix static linking of 'lvm.static', which indirectly depend on libpthread
via libdevmapper.a.
--- LVM2.2.02.166/tools/Makefile.in 2016-11-22 21:31:15.521045149 +0100
+++ LVM2.2.02.166/tools/Makefile.in 2016-11-22 21:31:24.085082767 +0100
@@ -148,7 +148,7 @@ endif
lvm.static: $(OBJECTS) lvm-static.o $(top_builddir)/lib/liblvm-internal.a $(interfacebuilddir)/libdevmapper.a
$(CC) $(CFLAGS) $(LDFLAGS) -static -L$(interfacebuilddir) -o $@ \
- $(OBJECTS) lvm-static.o $(LVMLIBS) $(STATIC_LIBS) $(LIBS)
+ $(OBJECTS) lvm-static.o $(LVMLIBS) $(STATIC_LIBS) $(LIBS) $(PTHREAD_LIBS)
liblvm2cmd.a: $(top_builddir)/lib/liblvm-internal.a $(OBJECTS) lvmcmdlib.o lvm2cmd.o
cat $(top_builddir)/lib/liblvm-internal.a > $@

19
gnu/packages/patches/pixman-CVE-2016-5296.patch Normal file
View File

@ -0,0 +1,19 @@
Fix CVE-2016-5296: Heap-buffer-overflow WRITE in rasterize_edges_1
Adapted for upstream pixman based on:
https://hg.mozilla.org/releases/mozilla-esr45/rev/5e39c1c2fded
--- pixman-0.34.0/pixman/pixman-edge-imp.h.orig 2015-06-30 05:48:31.000000000 -0400
+++ pixman-0.34.0/pixman/pixman-edge-imp.h 2016-11-16 01:09:34.046335106 -0500
@@ -55,8 +55,9 @@
*
* (The AA case does a similar adjustment in RENDER_SAMPLES_X)
*/
- lx += X_FRAC_FIRST(1) - pixman_fixed_e;
- rx += X_FRAC_FIRST(1) - pixman_fixed_e;
+ /* we cast to unsigned to get defined behaviour for overflow */
+ lx = (unsigned)lx + X_FRAC_FIRST(1) - pixman_fixed_e;
+ rx = (unsigned)rx + X_FRAC_FIRST(1) - pixman_fixed_e;
#endif
/* clip X */
if (lx < 0)

1
gnu/packages/pdf.scm
View File

@ -692,7 +692,6 @@ vector formats.")
(,(string-append sdl "/lib"))) (,(string-append sdl "/lib")))
`("PATH" ":" prefix ;for pdftoppm `("PATH" ":" prefix ;for pdftoppm
(,(string-append xpdf "/bin")))) (,(string-append xpdf "/bin"))))
(mkdir-p man1)
(install-file "impressive.1" man1) (install-file "impressive.1" man1)
#t)))))) #t))))))
(home-page "http://impressive.sourceforge.net") (home-page "http://impressive.sourceforge.net")

33
gnu/packages/perl.scm
View File

@ -7,7 +7,7 @@
;;; Copyright © 2016 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Jochem Raat <jchmrt@riseup.net> ;;; Copyright © 2016 Jochem Raat <jchmrt@riseup.net>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Coypright © 2016 ng0 <ng0@we.make.ritual.n0.is> ;;; Coypright © 2016 ng0 <ng0@libertad.pw>
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co> ;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
;;; Copyright © 2016 Roel Janssen <roel@gnu.org> ;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
@ -48,7 +48,7 @@
(version "5.24.0") (version "5.24.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://www.cpan.org/src/5.0/perl-" (uri (string-append "mirror://cpan/src/5.0/perl-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
@ -2055,6 +2055,35 @@ each stack frame.")
interface for the RFC 2104 HMAC mechanism.") interface for the RFC 2104 HMAC mechanism.")
(license (package-license perl)))) (license (package-license perl))))
(define-public perl-digest-md5
(package
(name "perl-digest-md5")
(version "2.55")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/G/GA/GAAS/Digest-MD5-"
version ".tar.gz"))
(sha256
(base32
"0g0fklbrm2krswc1xhp4iwn1dhqq71fqh2p5wm8xj9a4s6i9ic83"))))
(build-system perl-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'build 'set-permissions
(lambda _
;; Make MD5.so read-write so it can be stripped.
(chmod "blib/arch/auto/Digest/MD5/MD5.so" #o755))))))
(home-page "http://search.cpan.org/dist/Digest-MD5")
(synopsis "Perl interface to the MD-5 algorithm")
(description
"The @code{Digest::MD5} module allows you to use the MD5 Message Digest
algorithm from within Perl programs. The algorithm takes as
input a message of arbitrary length and produces as output a
128-bit \"fingerprint\" or \"message digest\" of the input.")
(license (package-license perl))))
(define-public perl-digest-sha1 (define-public perl-digest-sha1
(package (package
(name "perl-digest-sha1") (name "perl-digest-sha1")

334
gnu/packages/php.scm Normal file
View File

@ -0,0 +1,334 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.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/>.
(define-module (gnu packages php)
#:use-module (gnu packages)
#:use-module (gnu packages algebra)
#:use-module (gnu packages aspell)
#:use-module (gnu packages base)
#:use-module (gnu packages bison)
#:use-module (gnu packages compression)
#:use-module (gnu packages curl)
#:use-module (gnu packages cyrus-sasl)
#:use-module (gnu packages databases)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages gd)
#:use-module (gnu packages gettext)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages image)
#:use-module (gnu packages linux)
#:use-module (gnu packages multiprecision)
#:use-module (gnu packages openldap)
#:use-module (gnu packages pcre)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages readline)
#:use-module (gnu packages textutils)
#:use-module (gnu packages tls)
#:use-module (gnu packages web)
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg)
#:use-module (gnu packages zip)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module ((guix licenses) #:prefix license:))
;; This fixes PHP bugs 73155 and 73159. Remove when gd
;; is updated to > 2.2.3.
(define gd-for-php
(package (inherit gd)
(source
(origin
(inherit (package-source gd))
(patches (search-patches
"gd-fix-truecolor-format-correction.patch"
"gd-fix-chunk-size-on-boundaries.patch"))))))
(define-public php
(package
(name "php")
(version "7.0.13")
(home-page "https://secure.php.net/")
(source (origin
(method url-fetch)
(uri (string-append home-page "distributions/"
name "-" version ".tar.xz"))
(sha256
(base32
"1gzihbpcp51jc587gs1ryn59hsnr7vf5427dmcvdimvm77wsfyrm"))
(modules '((guix build utils)))
(snippet
'(with-directory-excursion "ext"
(for-each delete-file-recursively
;; Some of the bundled libraries have no proper upstream.
;; Ideally we'd extract these out as separate packages:
;;"mbstring/libmbfl"
;;"date/lib"
;;"bcmath/libbcmath"
;;"fileinfo/libmagic" ; This is a patched version of libmagic.
'("gd/libgd"
"mbstring/oniguruma"
"pcre/pcrelib"
"sqlite3/libsqlite"
"xmlrpc/libxmlrpc"
"zip/lib"))))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags
(let-syntax ((with (syntax-rules ()
((_ option input)
(string-append option "="
(assoc-ref %build-inputs input))))))
(list (with "--with-bz2" "bzip2")
(with "--with-curl" "curl")
(with "--with-freetype-dir" "freetype")
(with "--with-gd" "gd")
(with "--with-gdbm" "gdbm")
(with "--with-gettext" "glibc") ; libintl.h
(with "--with-gmp" "gmp")
(with "--with-jpeg-dir" "libjpeg")
(with "--with-ldap" "openldap")
(with "--with-ldap-sasl" "cyrus-sasl")
(with "--with-libzip" "zip")
(with "--with-libxml-dir" "libxml2")
(with "--with-onig" "oniguruma")
(with "--with-pcre-dir" "pcre")
(with "--with-pcre-regex" "pcre")
(with "--with-pdo-pgsql" "postgresql")
(with "--with-pdo-sqlite" "sqlite")
(with "--with-pgsql" "postgresql")
(with "--with-png-dir" "libpng")
;; PHP’s Pspell extension, while retaining its current name,
;; now uses the Aspell library.
(with "--with-pspell" "aspell")
(with "--with-readline" "readline")
(with "--with-sqlite3" "sqlite")
(with "--with-tidy" "tidy")
(with "--with-webp-dir" "libwebp")
(with "--with-xpm-dir" "libxpm")
(with "--with-xsl" "libxslt")
(with "--with-zlib-dir" "zlib")
;; We could add "--with-snmp", but it requires netsnmp that
;; we don't have a package for. It is used to build the snmp
;; extension of php.
"--with-iconv"
"--with-openssl"
"--with-pdo-mysql"
"--with-zlib"
"--enable-calendar"
"--enable-dba=shared"
"--enable-exif"
"--enable-flatfile"
"--enable-fpm"
"--enable-ftp"
"--enable-inifile"
"--enable-mbstring"
"--enable-pcntl"
"--enable-sockets"
"--enable-threads"))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'do-not-record-build-flags
(lambda _
;; Prevent configure flags from being stored and causing
;; unnecessary runtime dependencies.
(substitute* "scripts/php-config.in"
(("@CONFIGURE_OPTIONS@") "")
(("@PHP_LDFLAGS@") ""))
;; This file has ISO-8859-1 encoding.
(with-fluids ((%default-port-encoding "ISO-8859-1"))
(substitute* "main/build-defs.h.in"
(("@CONFIGURE_COMMAND@") "(omitted)")))
#t))
(add-before 'build 'patch-/bin/sh
(lambda _
(substitute* '("run-tests.php" "ext/standard/proc_open.c")
(("/bin/sh") (which "sh")))
#t))
(add-before 'check 'prepare-tests
(lambda _
;; Some of these files have ISO-8859-1 encoding, whereas others
;; use ASCII, so we can't use a "catch-all" find-files here.
(with-fluids ((%default-port-encoding "ISO-8859-1"))
(substitute* '("ext/mbstring/tests/mb_send_mail02.phpt"
"ext/mbstring/tests/mb_send_mail04.phpt"
"ext/mbstring/tests/mb_send_mail05.phpt"
"ext/mbstring/tests/mb_send_mail06.phpt")
(("/bin/cat") (which "cat"))))
(substitute* '("ext/mbstring/tests/mb_send_mail01.phpt"
"ext/mbstring/tests/mb_send_mail03.phpt"
"ext/mbstring/tests/bug52861.phpt"
"ext/standard/tests/general_functions/bug34794.phpt"
"ext/standard/tests/general_functions/bug44667.phpt"
"ext/standard/tests/general_functions/proc_open.phpt")
(("/bin/cat") (which "cat")))
;; The encoding of this file is not recognized, so we simply drop it.
(delete-file "ext/mbstring/tests/mb_send_mail07.phpt")
(substitute* "ext/standard/tests/streams/bug60602.phpt"
(("'ls'") (string-append "'" (which "ls") "'")))
;; Drop tests that are known to fail.
(for-each delete-file
'("ext/posix/tests/posix_getgrgid.phpt" ; Requires /etc/group.
"ext/sockets/tests/bug63000.phpt" ; Fails to detect OS.
"ext/sockets/tests/socket_shutdown.phpt" ; Requires DNS.
"ext/sockets/tests/socket_send.phpt" ; Likewise.
"ext/sockets/tests/mcast_ipv4_recv.phpt" ; Requires multicast.
;; These needs /etc/services.
"ext/standard/tests/general_functions/getservbyname_basic.phpt"
"ext/standard/tests/general_functions/getservbyport_basic.phpt"
"ext/standard/tests/general_functions/getservbyport_variation1.phpt"
;; And /etc/protocols.
"ext/standard/tests/network/getprotobyname_basic.phpt"
"ext/standard/tests/network/getprotobynumber_basic.phpt"
;; And exotic locales.
"ext/standard/tests/strings/setlocale_basic1.phpt"
"ext/standard/tests/strings/setlocale_basic2.phpt"
"ext/standard/tests/strings/setlocale_basic3.phpt"
"ext/standard/tests/strings/setlocale_variation1.phpt"
;; XXX: These gd tests fails. Likely because our version
;; is different from the (patched) bundled one.
;; Here, gd quits immediately after "fatal libpng error"; while the
;; test expects it to additionally return a "setjmp" error and warning.
"ext/gd/tests/bug39780_extern.phpt"
"ext/gd/tests/libgd00086_extern.phpt"
;; Extra newline in gd-png output.
"ext/gd/tests/bug45799.phpt"
;; Different error message than expected from imagecrop().
"ext/gd/tests/bug66356.phpt"
;; Similarly for imagecreatefromgd2().
"ext/gd/tests/bug72339.phpt"
;; Call to undefined function imageantialias(). They are
;; supposed to fail anyway.
"ext/gd/tests/bug72482.phpt"
"ext/gd/tests/bug72482_2.phpt"
"ext/gd/tests/bug73213.phpt"
;; Test expects generic "gd warning" but gets the actual function name.
"ext/gd/tests/createfromwbmp2_extern.phpt"
;; TODO: Enable these when libgd is built with xpm support.
"ext/gd/tests/xpm2gd.phpt"
"ext/gd/tests/xpm2jpg.phpt"
"ext/gd/tests/xpm2png.phpt"
;; XXX: These iconv tests have the expected outcome,
;; but with different error messages.
;; Expects "illegal character", instead gets "unknown error (84)".
"ext/iconv/tests/bug52211.phpt"
;; Expects "wrong charset", gets unknown error (22).
"ext/iconv/tests/iconv_mime_decode_variation3.phpt"
"ext/iconv/tests/iconv_strlen_error2.phpt"
"ext/iconv/tests/iconv_strlen_variation2.phpt"
"ext/iconv/tests/iconv_substr_error2.phpt"
;; Expects conversion error, gets "error condition Termsig=11".
"ext/iconv/tests/iconv_strpos_error2.phpt"
"ext/iconv/tests/iconv_strrpos_error2.phpt"
;; Similar, but iterating over multiple values.
;; iconv breaks the loop after the first error with Termsig=11.
"ext/iconv/tests/iconv_strpos_variation4.phpt"
"ext/iconv/tests/iconv_strrpos_variation3.phpt"
;; XXX: These test failures appear legitimate, needs investigation.
;; open_basedir() restriction failure.
"ext/curl/tests/bug61948.phpt"
;; Expects a false boolean, gets empty array from glob().
"ext/standard/tests/file/bug41655_1.phpt"
"ext/standard/tests/file/glob_variation5.phpt"
;; Test output is correct, but in wrong order.
"ext/standard/tests/streams/proc_open_bug64438.phpt"
;; The test expects an Array, but instead get the contents(?).
"ext/gd/tests/bug43073.phpt"
;; imagettftext() returns wrong coordinates.
"ext/gd/tests/bug48732.phpt"
;; Similarly for imageftbbox().
"ext/gd/tests/bug48801.phpt"
;; Different expected output from imagecolorallocate().
"ext/gd/tests/bug53504.phpt"
;; Wrong image size after scaling an image.
"ext/gd/tests/bug73272.phpt"
;; Expects iconv to detect illegal characters, instead gets
;; "unknown error (84)" and heap corruption(!).
"ext/iconv/tests/bug48147.phpt"
;; Expects illegal character ".", gets "=?utf-8?Q?."
"ext/iconv/tests/bug51250.phpt"
;; @iconv() does not return expected output.
"ext/iconv/tests/iconv003.phpt"
;; iconv throws "buffer length exceeded" on some string checks.
"ext/iconv/tests/iconv_mime_encode.phpt"
;; file_get_contents(): iconv stream filter
;; ("ISO-8859-1"=>"UTF-8") unknown error.
"ext/standard/tests/file/bug43008.phpt"
;; Table data not created in sqlite(?).
"ext/pdo_sqlite/tests/bug_42589.phpt"))
;; Skip tests requiring network access.
(setenv "SKIP_ONLINE_TESTS" "1")
;; Without this variable, 'make test' passes regardless of failures.
(setenv "REPORT_EXIT_STATUS" "1")
#t)))
#:test-target "test"))
(inputs
`(("aspell" ,aspell)
("bzip2" ,bzip2)
("curl" ,curl)
("cyrus-sasl" ,cyrus-sasl)
("freetype" ,freetype)
("gd" ,gd-for-php)
("gdbm" ,gdbm)
("glibc" ,glibc)
("gmp" ,gmp)
("libgcrypt" ,libgcrypt)
("libjpeg" ,libjpeg)
("libpng" ,libpng)
("libwebp" ,libwebp)
("libxml2" ,libxml2)
("libxpm" ,libxpm)
("libxslt" ,libxslt)
("libx11" ,libx11)
("oniguruma" ,oniguruma)
("openldap" ,openldap)
("openssl" ,openssl)
("pcre" ,pcre)
("postgresql" ,postgresql)
("readline" ,readline)
("sqlite" ,sqlite-3.15.1)
("tidy" ,tidy)
("zip" ,zip)
("zlib" ,zlib)))
(native-inputs
`(("pkg-config" ,pkg-config)
("bison" ,bison)
("intltool" ,intltool)
("procps" ,procps))) ; For tests.
(synopsis "PHP programming language")
(description
"PHP (PHP Hypertext Processor) is a server-side (CGI) scripting
language designed primarily for web development but is also used as
a general-purpose programming language. PHP code may be embedded into
HTML code, or it can be used in combination with various web template
systems, web content management systems and web frameworks." )
(license (list
(license:non-copyleft "file://LICENSE") ; The PHP license.
(license:non-copyleft "file://Zend/LICENSE") ; The Zend license.
license:lgpl2.1 ; ext/mbstring/libmbfl
license:lgpl2.1+ ; ext/bcmath/libbcmath
license:bsd-2 ; ext/fileinfo/libmagic
license:expat)))) ; ext/date/lib

2
gnu/packages/psyc.scm
View File

@ -212,7 +212,7 @@ including psyced.")
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config) `(("pkg-config" ,pkg-config)
("bison" ,bison) ("bison" ,bison)
("gnu-gettext" ,gnu-gettext) ("gettext" ,gettext-minimal)
("help2man" ,help2man) ("help2man" ,help2man)
("autoconf" ,autoconf) ("autoconf" ,autoconf)
("automake" ,automake))) ("automake" ,automake)))

14
gnu/packages/python.scm
View File

@ -453,14 +453,14 @@ pidof, tty, taskset, pmap.")
(define-public python-passlib (define-public python-passlib
(package (package
(name "python-passlib") (name "python-passlib")
(version "1.6.5") (version "1.7.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "passlib" version)) (uri (pypi-uri "passlib" version))
(sha256 (sha256
(base32 (base32
"1z27wdxs5rj5xhhqfzvzn3yg682irkxw6dcs5jj7mcf97psk8gd8")))) "1vdbqsa1a31s98fxkinl052q8nnpvbxnb83qanxfpi2p6c2zdr0b"))))
(build-system python-build-system) (build-system python-build-system)
(native-inputs (native-inputs
`(("python-nose" ,python-nose))) `(("python-nose" ,python-nose)))
@ -1570,6 +1570,8 @@ standard library.")
(base32 (base32
"1ckvrypyvb7jbqlgwdz0y337ajagjv7dgxyns326nqwypn1wpq0i")))) "1ckvrypyvb7jbqlgwdz0y337ajagjv7dgxyns326nqwypn1wpq0i"))))
(build-system python-build-system) (build-system python-build-system)
(arguments
`(#:tests? #f)) ; Currently pafy can not find itself in the tests
(propagated-inputs (propagated-inputs
;; Youtube-dl is a python package which is imported in the file ;; Youtube-dl is a python package which is imported in the file
;; "backend_youtube_dl.py", therefore it needs to be propagated. ;; "backend_youtube_dl.py", therefore it needs to be propagated.
@ -2194,13 +2196,13 @@ files.")
(define-public python-pyld (define-public python-pyld
(package (package
(name "python-pyld") (name "python-pyld")
(version "0.6.8") (version "0.7.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "PyLD" version)) (uri (pypi-uri "PyLD" version))
(sha256 (sha256
(base32 (base32
"0k881ffazpf8q1z8862g4bb3pzwpnz9whrci2mf311mvn1qbyqad")))) "1m0fs6897vxfkf7awah5i66i7b7smm5fnywf1w50fpzyfbfhr156"))))
(build-system python-build-system) (build-system python-build-system)
(arguments `(#:tests? #f)) ; no tests (arguments `(#:tests? #f)) ; no tests
(home-page "http://github.com/digitalbazaar/pyld") (home-page "http://github.com/digitalbazaar/pyld")
@ -7877,13 +7879,13 @@ processes across test runs.")
(define-public python-icalendar (define-public python-icalendar
(package (package
(name "python-icalendar") (name "python-icalendar")
(version "3.10") (version "3.11")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "icalendar" version)) (uri (pypi-uri "icalendar" version))
(sha256 (sha256
(base32 (base32
"01amnk3621s7fagfla86npd25knbqirchg7h1jpqxqp103d02bs7")))) "01v2f3swd5s72x65cdihw83dx1z799b4i49a6ncg7vqmcm20wapd"))))
(build-system python-build-system) (build-system python-build-system)
(propagated-inputs (propagated-inputs
`(("python-dateutil-2" ,python-dateutil-2) `(("python-dateutil-2" ,python-dateutil-2)

3
gnu/packages/qemu.scm
View File

@ -117,10 +117,9 @@
(let ((out (assoc-ref outputs "out"))) (let ((out (assoc-ref outputs "out")))
(and (zero? (system* "make" "info")) (and (zero? (system* "make" "info"))
(let ((infodir (string-append out "/share/info"))) (let ((infodir (string-append out "/share/info")))
(mkdir-p infodir)
(for-each (lambda (info) (for-each (lambda (info)
(install-file info infodir)) (install-file info infodir))
(find-files "." "\\.info$")) (find-files "." "\\.info"))
#t)))))) #t))))))
(add-before 'check 'make-gtester-verbose (add-before 'check 'make-gtester-verbose
(lambda _ (lambda _

50
gnu/packages/ruby.scm
View File

@ -47,6 +47,7 @@
(define-public ruby (define-public ruby
(package (package
(name "ruby") (name "ruby")
(replacement ruby-2.3.3)
(version "2.3.1") (version "2.3.1")
(source (source
(origin (origin
@ -101,9 +102,10 @@ a focus on simplicity and productivity.")
(home-page "https://ruby-lang.org") (home-page "https://ruby-lang.org")
(license license:ruby))) (license license:ruby)))
(define-public ruby-2.2 (define ruby-2.3.3
(package (inherit ruby) (package
(version "2.2.5") (inherit ruby)
(version "2.3.3")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -112,7 +114,25 @@ a focus on simplicity and productivity.")
"/ruby-" version ".tar.xz")) "/ruby-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1mw7bzw76g5w37cwhb57r6gxcl2vn9lfrlyf4h4xms3qlnhflvzq")))))) "1p0rfk0blrbfjcnv0vb0ha4hxflgkfhv9zbzp4vvld2pi31ahkqs"))
(modules '((guix build utils)))
(snippet `(begin
;; Remove bundled libffi
(delete-file-recursively "ext/fiddle/libffi-3.2.1")
#t))))))
(define-public ruby-2.2
(package (inherit ruby)
(version "2.2.6")
(source
(origin
(method url-fetch)
(uri (string-append "http://cache.ruby-lang.org/pub/ruby/"
(version-major+minor version)
"/ruby-" version ".tar.xz"))
(sha256
(base32
"0fbk2pyjphynj4kxn27vb5rsq6brr3y85p784jd1rxwws30fq54l"))))))
(define-public ruby-2.1 (define-public ruby-2.1
(package (inherit ruby) (package (inherit ruby)
@ -4179,3 +4199,25 @@ patterns.")
libraries for compiling Ruby native extensions.") libraries for compiling Ruby native extensions.")
(home-page "https://github.com/ruby-gnome2/pkg-config") (home-page "https://github.com/ruby-gnome2/pkg-config")
(license license:lgpl2.0+))) (license license:lgpl2.0+)))
(define-public ruby-net-http-digest-auth
(package
(name "ruby-net-http-digest-auth")
(version "1.4")
(source
(origin
(method url-fetch)
(uri (rubygems-uri "net-http-digest_auth" version))
(sha256
(base32
"14801gr34g0rmqz9pv4rkfa3crfdbyfk6r48vpg5a5407v0sixqi"))))
(build-system ruby-build-system)
(native-inputs
`(("ruby-hoe" ,ruby-hoe)))
(synopsis "RFC 2617 HTTP digest authentication library")
(description
"This library implements HTTP's digest authentication scheme based on
RFC 2617. This enables the use of the digest authentication scheme instead
of the more insecure basic authentication scheme.")
(home-page "http://github.com/drbrain/net-http-digest_auth")
(license license:expat)))

4
gnu/packages/shells.scm
View File

@ -288,14 +288,14 @@ ksh, and tcsh.")
(define-public xonsh (define-public xonsh
(package (package
(name "xonsh") (name "xonsh")
(version "0.4.6") (version "0.4.7")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "xonsh" version)) (uri (pypi-uri "xonsh" version))
(sha256 (sha256
(base32 (base32
"0byxd9kjl99q2pyvjh9jy18l0di1i35wr0qqgnw4i6jh6ig3zcki")) "04b0z41mxiwsp5rl21fzrixcdmx2kndjlh4gn3582qfga9hihf20"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
`(begin `(begin

2
gnu/packages/syndication.scm
View File

@ -53,7 +53,7 @@
#:make-flags (list (string-append "prefix=" (assoc-ref %outputs "out"))) #:make-flags (list (string-append "prefix=" (assoc-ref %outputs "out")))
#:test-target "test")) #:test-target "test"))
(native-inputs (native-inputs
`(("gettext" ,gnu-gettext) `(("gettext" ,gettext-minimal)
("perl" ,perl) ("perl" ,perl)
("pkg-config" ,pkg-config) ("pkg-config" ,pkg-config)
("ruby" ,ruby))) ; for tests ("ruby" ,ruby))) ; for tests

5
gnu/packages/telephony.scm
View File

@ -134,9 +134,8 @@ to initiate and control SIP sessions.")
(version "4.1.0") (version "4.1.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append "mirror://savannah/exosip/libeXosip2-"
"http://download.savannah.gnu.org/releases/exosip/libeXosip2-" version ".tar.gz"))
version ".tar.gz"))
(sha256 (base32 (sha256 (base32
"17cna8kpc8nk1si419vgr6r42k2lda0rdk50vlxrw8rzg0xp2xrw")))) "17cna8kpc8nk1si419vgr6r42k2lda0rdk50vlxrw8rzg0xp2xrw"))))
(build-system gnu-build-system) (build-system gnu-build-system)

27
gnu/packages/upnp.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in> ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -27,7 +28,7 @@
(define-public miniupnpc (define-public miniupnpc
(package (package
(name "miniupnpc") (name "miniupnpc")
(version "1.9") (version "2.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -35,7 +36,7 @@
"http://miniupnp.tuxfamily.org/files/miniupnpc-" "http://miniupnp.tuxfamily.org/files/miniupnpc-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 "0r24jdqcyf839n30ppimdna0hvybscyziaad7ng99fw0x19y88r9")))) (base32 "0fzrc6fs8vzb2yvk01bd3q5jkarysl7gjlyaqncy3yvfk2wcwd6l"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("python" ,python-2))) `(("python" ,python-2)))
@ -54,14 +55,22 @@
(string-append "LDFLAGS=-Wl,-rpath=" (string-append "LDFLAGS=-Wl,-rpath="
(assoc-ref %outputs "out") "/lib")) (assoc-ref %outputs "out") "/lib"))
#:phases #:phases
(alist-delete 'configure %standard-phases))) (modify-phases %standard-phases
(delete 'configure)
(add-before 'install 'qualify-paths
(lambda* (#:key outputs #:allow-other-keys)
(substitute* "external-ip.sh"
(("upnpc")
(string-append (assoc-ref outputs "out") "/bin/upnpc"))))))))
(home-page "http://miniupnp.free.fr/") (home-page "http://miniupnp.free.fr/")
(synopsis "Library implementing the client side UPnP protocol") (synopsis "UPnP protocol client library")
(description (description
"MiniUPnPc is a library is useful whenever an application needs to listen "The MiniUPnPc client library facilitates access to the services provided
for incoming connections but is run behind a UPnP enabled router or firewall. by any Universal Plug and Play (UPnP) Internet Gateway Device (IGD) present on
Examples for such applications include: P2P applications, FTP clients for the network. In UPnP terminology, MiniUPnPc is a UPnP Control Point. It is
active mode, IRC (for DCC) or IM applications, network games, any server useful whenever an application needs to listen for incoming connections while
software.") running behind a UPnP-enabled router or firewall. Such applications include
peer-to-peer applications, active-mode FTP clients, DCC file transfers over
IRC, instant messaging, network games, and most server software.")
(license (license
(x11-style "file://LICENSE" "See 'LICENSE' file in the distribution")))) (x11-style "file://LICENSE" "See 'LICENSE' file in the distribution"))))

123
gnu/packages/video.scm
View File

@ -12,6 +12,7 @@
;;; Copyright © 2016 Dmitry Nikolaev <cameltheman@gmail.com> ;;; Copyright © 2016 Dmitry Nikolaev <cameltheman@gmail.com>
;;; Copyright © 2016 Andy Patterson <ajpatter@uwaterloo.ca> ;;; Copyright © 2016 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is> ;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -51,6 +52,7 @@
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bison) #:use-module (gnu packages bison)
#:use-module (gnu packages cdrom) #:use-module (gnu packages cdrom)
#:use-module (gnu packages cmake)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages curl) #:use-module (gnu packages curl)
#:use-module (gnu packages databases) #:use-module (gnu packages databases)
@ -64,11 +66,14 @@
#:use-module (gnu packages gl) #:use-module (gnu packages gl)
#:use-module (gnu packages glib) #:use-module (gnu packages glib)
#:use-module (gnu packages guile) #:use-module (gnu packages guile)
#:use-module (gnu packages gnome)
#:use-module (gnu packages gnupg) #:use-module (gnu packages gnupg)
#:use-module (gnu packages gstreamer)
#:use-module (gnu packages gtk) #:use-module (gnu packages gtk)
#:use-module (gnu packages image) #:use-module (gnu packages image)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages lua) #:use-module (gnu packages lua)
#:use-module (gnu packages m4)
#:use-module (gnu packages mp3) #:use-module (gnu packages mp3)
#:use-module (gnu packages ncurses) #:use-module (gnu packages ncurses)
#:use-module (gnu packages ocr) #:use-module (gnu packages ocr)
@ -85,6 +90,7 @@
#:use-module (gnu packages tls) #:use-module (gnu packages tls)
#:use-module (gnu packages version-control) #:use-module (gnu packages version-control)
#:use-module (gnu packages web) #:use-module (gnu packages web)
#:use-module (gnu packages webkit)
#:use-module (gnu packages xdisorg) #:use-module (gnu packages xdisorg)
#:use-module (gnu packages xiph) #:use-module (gnu packages xiph)
#:use-module (gnu packages xml) #:use-module (gnu packages xml)
@ -827,7 +833,7 @@ SVCD, DVD, 3ivx, DivX 3/4/5, WMV and H.264 movies.")
(define-public mpv (define-public mpv
(package (package
(name "mpv") (name "mpv")
(version "0.21.0") (version "0.22.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -835,7 +841,7 @@ SVCD, DVD, 3ivx, DivX 3/4/5, WMV and H.264 movies.")
".tar.gz")) ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1lwvvhldqrkp44zdm3wbi7qrsln13s8ympwwckqhwl4whp78wpyh")) "1xl2a0nfbkcq00f41m50fmfz9hl7hzpk7cq7j38r38rp1s7sryf0"))
(file-name (string-append name "-" version ".tar.gz")))) (file-name (string-append name "-" version ".tar.gz"))))
(build-system waf-build-system) (build-system waf-build-system)
(native-inputs (native-inputs
@ -1478,7 +1484,7 @@ be used for realtime video capture via Linux-specific APIs.")
(define-public obs (define-public obs
(package (package
(name "obs") (name "obs")
(version "0.16.2") (version "0.16.6")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/jp9000/obs-studio" (uri (string-append "https://github.com/jp9000/obs-studio"
@ -1486,7 +1492,7 @@ be used for realtime video capture via Linux-specific APIs.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0p2grxyaf79hb3nlja23xp7b2vc1w18llvzcyhnjn2lhwfjabcgm")))) "00vwdnf0gnwp029sznsr0s4lcky3brxbmpy0ch7igjpk5sf6mkqp"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
`(#:tests? #f ; no tests `(#:tests? #f ; no tests
@ -1702,6 +1708,12 @@ Content System specification.")
(base32 (base32
"1s7h35yx6f0szf8mm8612ic913w3v05m2kwphjfcxnpq0ammhyci")))) "1s7h35yx6f0szf8mm8612ic913w3v05m2kwphjfcxnpq0ammhyci"))))
(build-system python-build-system) (build-system python-build-system)
(arguments
;; Tests need to be disabled until #556 upstream is fixed. It reads as if the
;; test suite results differ depending on the country and also introduce
;; non-determinism in the tests.
;; https://github.com/mps-youtube/mps-youtube/issues/556
`(#:tests? #f))
(propagated-inputs (propagated-inputs
`(("python-pafy" ,python-pafy) `(("python-pafy" ,python-pafy)
("python-pygobject" ,python-pygobject))) ; For mpris2 support ("python-pygobject" ,python-pygobject))) ; For mpris2 support
@ -1715,3 +1727,106 @@ It can use either mpv or mplayer for playback, and for conversion of
formats ffmpeg or libav is used. Users should install one of the formats ffmpeg or libav is used. Users should install one of the
supported players in addition to this package.") supported players in addition to this package.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public handbrake
(package
(name "handbrake")
(version "0.10.5")
(source (origin
(method url-fetch)
(uri (string-append "https://handbrake.fr/rotation.php?file="
"HandBrake-" version ".tar.bz2"))
(file-name (string-append "handbrake-" version ".tar.bz2"))
(sha256
(base32
"1w720y3bplkz187wgvy4a4xm0vpppg45mlni55l6yi8v2bfk14pv"))
(patches (search-patches "handbrake-pkg-config-path.patch"))
(modules '((guix build utils)))
(snippet
;; Remove bundled libraries and source not necessary for
;; running under a GNU environment.
'(begin
(for-each delete-file-recursively '("contrib" "macosx" "win"))
#t))))
(build-system glib-or-gtk-build-system)
(native-inputs
`(("automake" ,automake) ;gui subpackage must be bootstrapped
("autoconf" ,autoconf)
("curl" ,curl) ;not actually used, but tested for
("intltool" ,intltool)
("libtool" ,libtool)
("pkg-config" ,pkg-config)
("python" ,python-2))) ;for configuration
(inputs
`(("bzip2" ,bzip2)
("dbus-glib" ,dbus-glib)
("ffmpeg" ,ffmpeg)
("fontconfig" ,fontconfig)
("freetype" ,freetype)
("glib" ,glib)
("gstreamer" ,gstreamer)
("gst-plugins-base" ,gst-plugins-base)
("gtk+" ,gtk+)
("lame" ,lame)
("libass" ,libass)
("libbluray" ,libbluray)
("libdvdnav" ,libdvdnav)
("libdvdread" ,libdvdread)
("libgudev" ,libgudev)
("libmpeg2" ,libmpeg2)
("libnotify" ,libnotify)
("libogg" ,libogg)
("libsamplerate" ,libsamplerate)
("libtheora" ,libtheora)
("libvorbis" ,libvorbis)
("libvpx" ,libvpx)
("libxml2" ,libxml2)
("libx264" ,libx264)
("x265" ,x265)
("zlib" ,zlib)))
(arguments
`(#:tests? #f ;tests require Ruby and claim to be unsupported
#:phases
(modify-phases %standard-phases
(add-before 'patch-source-shebangs 'bootstrap-gtk
;; Run bootstrap ahead of time so that shebangs get patched.
(lambda _
(setenv "CONFIG_SHELL" (which "sh"))
(setenv "NOCONFIGURE" "1")
;; Patch the Makefile so that it doesn't bootstrap again.
(substitute* "gtk/module.rules"
((".*autogen\\.sh.*") ""))
(zero? (system* "sh" "./gtk/autogen.sh"))))
(add-before 'configure 'disable-contrib
(lambda _
(substitute* "make/include/main.defs"
;; Disable unconditional inclusion of some "contrib"
;; libraries (ffmpeg, libvpx, libdvdread, libdvdnav,
;; and libbluray), which would lead to fetching and
;; building of these libraries. Use our own instead.
(("MODULES \\+= contrib") "# MODULES += contrib"))
#t))
(add-before 'configure 'fix-x265-linking
(lambda _
(substitute* "test/module.defs"
;; Fix missing library during linking error
(("TEST.GCC.l =") "TEST.GCC.l = x265"))
#t))
(replace 'configure
(lambda* (#:key outputs configure-flags #:allow-other-keys)
;; 'configure' is not an autoconf-generated script, and
;; errors on unrecognized arguments,
;; e.g. --enable-fast-install
(let ((out (assoc-ref outputs "out")))
(zero? (apply system* "./configure"
(string-append "--prefix=" out)
(or configure-flags '()))))))
(add-after 'configure 'chdir-build
(lambda _ (chdir "./build") #t)))))
(home-page "https://handbrake.fr")
(synopsis "Video transcoder")
(description
"HandBrake is a tool for converting video from any format to a selection
of modern, widely supported codecs.")
;; Most under GPL version 2 or later, and portions under BSD 3 Clause
(license (list license:gpl2+ license:bsd-3))))

6
gnu/packages/vim.scm
View File

@ -49,7 +49,7 @@
(define-public vim (define-public vim
(package (package
(name "vim") (name "vim")
(version "8.0.0073") (version "8.0.0101")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/vim/vim/archive/v" (uri (string-append "https://github.com/vim/vim/archive/v"
@ -57,7 +57,7 @@
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1snbzgj89scjs0v3m86p53wvpal9jgs1s6i3hv7jyknpnjvqv5q5")))) "0kzk1p5vnqr8j5jwb3p745zx3dki5jwlsp7rh6nli0ci2w6vg3r8"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:test-target "test" `(#:test-target "test"
@ -129,7 +129,7 @@ configuration files.")
("fontconfig" ,fontconfig) ("fontconfig" ,fontconfig)
("freetype" ,freetype) ("freetype" ,freetype)
("gdk-pixbuf" ,gdk-pixbuf) ("gdk-pixbuf" ,gdk-pixbuf)
("gettext" ,gnu-gettext) ("gettext" ,gettext-minimal)
("glib" ,glib) ("glib" ,glib)
("gpm" ,gpm) ("gpm" ,gpm)
("gtk" ,gtk+-2) ("gtk" ,gtk+-2)

22
gnu/packages/w3m.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016 Kei Kebreau <kei@openmailbox.org> ;;; Copyright © 2016 Kei Kebreau <kei@openmailbox.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -35,7 +36,7 @@
(define-public w3m (define-public w3m
(package (package
(name "w3m") (name "w3m")
(version "0.5.3+git20161031") (version "0.5.3+git20161120")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
;; Debian's fork of w3m is the only one that is still ;; Debian's fork of w3m is the only one that is still
@ -46,16 +47,17 @@
(file-name (string-append "w3m-" version "-checkout")) (file-name (string-append "w3m-" version "-checkout"))
(sha256 (sha256
(base32 (base32
"142vkkmsk76wj9w6r4y2pa1hmy1kkzmc73an9zchx0ikm2z92x6s")))) "06n5a9jdyihkd4xdjmyci32dpqp1k2l5awia5g9ng0bn256bacdc"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments `(#:tests? #f ; no check target (arguments
#:phases (alist-cons-before '(#:tests? #f ; no check target
'configure 'fix-perl #:phases
(lambda _ (modify-phases %standard-phases
(substitute* '("scripts/w3mmail.cgi.in" (add-before 'configure 'fix-perl
"scripts/dirlist.cgi.in") (lambda _ (substitute* '("scripts/w3mmail.cgi.in"
(("@PERL@") (which "perl")))) "scripts/dirlist.cgi.in")
%standard-phases))) (("@PERL@") (which "perl")))
#t)))))
(inputs (inputs
`(("libgc" ,libgc) `(("libgc" ,libgc)
("ncurses" ,ncurses) ("ncurses" ,ncurses)

43
gnu/packages/web.scm
View File

@ -15,6 +15,7 @@
;;; Copyright © 2016 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2016 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is> ;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2016 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -122,14 +123,14 @@ and its related documentation.")
(define-public nginx (define-public nginx
(package (package
(name "nginx") (name "nginx")
(version "1.11.4") (version "1.11.6")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://nginx.org/download/nginx-" (uri (string-append "https://nginx.org/download/nginx-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0fvb09ycxz3xnyynav6ybj6miwh9kv8jcb2vzrmvqhzn8cgiq8h6")))) "1gc5phrzm2hbpvryaya6rlvasa00vjips4hv5q1rqbcfa6xsnlri"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("pcre" ,pcre) (inputs `(("pcre" ,pcre)
("openssl" ,openssl) ("openssl" ,openssl)
@ -149,7 +150,6 @@ and its related documentation.")
(list (string-append "--prefix=" (assoc-ref outputs "out")) (list (string-append "--prefix=" (assoc-ref outputs "out"))
"--with-http_ssl_module" "--with-http_ssl_module"
"--with-pcre-jit" "--with-pcre-jit"
"--with-ipv6"
"--with-debug" "--with-debug"
;; Even when not cross-building, we pass the ;; Even when not cross-building, we pass the
;; --crossbuild option to avoid customizing for the ;; --crossbuild option to avoid customizing for the
@ -3826,3 +3826,40 @@ runs in a terminal or through your browser. It provides fast and valuable
HTTP statistics for system administrators that require a visual server report HTTP statistics for system administrators that require a visual server report
on the fly.") on the fly.")
(license l:x11))) (license l:x11)))
(define-public httptunnel
(package
(name "httptunnel")
(version "3.3")
(source
(origin
(method url-fetch)
(uri (string-append "http://www.nocrew.org/software/httptunnel/"
name "-" version ".tar.gz"))
(sha256
(base32
"0mn5s6p68n32xzadz6ds5i6bp44dyxzkq68r1yljlv470jr84bql"))
(modules '((guix build utils)))
(snippet
;; Remove non-free IETF RFC documentation.
'(delete-file-recursively "doc"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
;; The default configure phase tries to pass environment variables as
;; command-line arguments, which confuses the ./configure script.
(replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")))
(setenv "CONFIG_SHELL" (which "bash"))
(zero? (system* "./configure"
(string-append "--prefix=" out)))))))))
(home-page "http://www.nocrew.org/software/httptunnel.html")
(synopsis "Tunnel data connections through HTTP requests")
(description "httptunnel creates a bidirectional virtual data connection
tunnelled through HTTP (HyperText Transfer Protocol) requests. This can be
useful for users behind restrictive firewalls. As long as Web traffic is
allowed, even through a HTTP-only proxy, httptunnel can be combined with other
tools like SSH (Secure Shell) to reach the outside world.")
(license l:gpl2+)))

4
gnu/packages/wm.scm
View File

@ -299,7 +299,7 @@ prompt.")
(synopsis "Tiling window manager") (synopsis "Tiling window manager")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://hackage.haskell.org/package/xmonad/" (uri (string-append "mirror://hackage/package/xmonad/"
name "-" version ".tar.gz")) name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
@ -355,7 +355,7 @@ tiled on several screens.")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://hackage.haskell.org/package/xmonad-contrib/" (uri (string-append "mirror://hackage/package/xmonad-contrib/"
"xmonad-contrib-" version ".tar.gz")) "xmonad-contrib-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32

81
gnu/packages/wxwidgets.scm
View File

@ -1,6 +1,8 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com> ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Theodoros Foradis <theodoros.for@openmailbox.org>
;;; Copyright © 2016 Danny Milosavljevic <dannym@scratchpost.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -22,6 +24,7 @@
#:use-module (guix download) #:use-module (guix download)
#:use-module ((guix licenses) #:prefix l:) #:use-module ((guix licenses) #:prefix l:)
#:use-module (guix build-system glib-or-gtk) #:use-module (guix build-system glib-or-gtk)
#:use-module (guix build-system python)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
@ -31,6 +34,7 @@
#:use-module (gnu packages gtk) #:use-module (gnu packages gtk)
#:use-module (gnu packages image) #:use-module (gnu packages image)
#:use-module (gnu packages pkg-config) #:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages sdl) #:use-module (gnu packages sdl)
#:use-module (gnu packages webkit) #:use-module (gnu packages webkit)
#:use-module (gnu packages xorg)) #:use-module (gnu packages xorg))
@ -109,3 +113,80 @@ and many other languages.")
(assoc-ref %outputs "out") "/lib")) (assoc-ref %outputs "out") "/lib"))
;; No 'check' target. ;; No 'check' target.
#:tests? #f)))) #:tests? #f))))
(define-public wxwidgets-gtk2
(package (inherit wxwidgets)
(inputs `(("gtk+" ,gtk+-2)
,@(alist-delete
"gtk+"
(package-inputs wxwidgets))))
(name "wxwidgets-gtk2")))
(define-public python2-wxpython
(package
(name "python2-wxpython")
(version "3.0.2.0")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/wxpython/wxPython/"
version "/wxPython-src-" version ".tar.bz2"))
(sha256
(base32
"0qfzx3sqx4mwxv99sfybhsij4b5pc03ricl73h4vhkzazgjjjhfm"))
(modules '((guix build utils)))
(snippet
'(begin
(lambda (folder)
(delete-file-recursively (string-append "src/" folder))
'("expat" "jpeg" "png" "tiff" "zlib" "msw" "osx" "msdos"))
(substitute* '("wxPython/setup.py")
;; setup.py tries to keep its own license the same as wxwidget's
;; license (which it expects under $WXWIN/docs).
(("'preamble.txt', 'licence.txt', 'licendoc.txt', 'lgpl.txt'")
""))))))
(build-system python-build-system)
(arguments
`(#:python ,python-2
#:tests? #f ; tests fail
#:configure-flags (list "WXPORT=gtk2"
"UNICODE=1")
#:phases
(modify-phases %standard-phases
(add-before 'build 'chdir
(lambda _
(chdir "wxPython")
#t))
(add-after 'chdir 'set-wx-out-dir
(lambda* (#:key outputs #:allow-other-keys)
;; By default, install phase tries to copy the wxPython headers in
;; gnu/store/...-wxwidgets-3.0.2 , which it can't, so they are
;; redirected to the output directory by setting WXPREFIX.
(substitute* "config.py"
(("= getWxConfigValue\\('--prefix'\\)")
(string-append "= '" (assoc-ref outputs "out") "'")))
(substitute* "wx/build/config.py"
(("= getWxConfigValue\\('--prefix'\\)")
(string-append "= '" (assoc-ref outputs "out") "'")))
#t))
(add-after 'set-wx-out-dir 'setenv
(lambda* (#:key inputs outputs #:allow-other-keys)
(setenv "WXWIN" (assoc-ref inputs "wxwidgets"))
(use-modules (ice-9 popen) (ice-9 rdelim))
(let ((port (open-pipe* OPEN_READ
(string-append (assoc-ref inputs "wxwidgets")
"/bin/wx-config") "--cppflags")))
(setenv "CPPFLAGS" (read-string port))
(close-pipe port))
#t)))))
(native-inputs
`(("mesa" ,mesa) ; for glcanvas
("pkg-config" ,pkg-config)
("python2-setuptools" ,python2-setuptools)))
(inputs
`(("gtk+" ,gtk+-2) ; for wxPython/src/helpers.cpp
("wxwidgets" ,wxwidgets-gtk2)))
(synopsis "Python 2 Bindings for wxWidgets")
(description "@code{wxpython} provides Python 2 bindings for wxWidgets.")
(home-page "http://wxpython.org/")
(license (package-license wxwidgets))))

51
gnu/packages/xdisorg.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org>
@ -15,6 +15,7 @@
;;; Copyright © 2016 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2016 Petter <petter@mykolab.ch>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -240,6 +241,7 @@ following the mouse.")
(package (package
(name "pixman") (name "pixman")
(version "0.34.0") (version "0.34.0")
(replacement pixman/fixed)
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -261,6 +263,13 @@ manipulation, providing features such as image compositing and trapezoid
rasterisation.") rasterisation.")
(license license:x11))) (license license:x11)))
(define pixman/fixed
(package
(inherit pixman)
(source (origin
(inherit (package-source pixman))
(patches (search-patches "pixman-CVE-2016-5296.patch"))))))
(define-public libdrm (define-public libdrm
(package (package
@ -1061,3 +1070,43 @@ XCB util-xrm module provides the following libraries:
- xrm: utility functions for the X resource manager.") - xrm: utility functions for the X resource manager.")
(license license:x11))) (license license:x11)))
(define-public xcalib
(package
(name "xcalib")
(version "0.8")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/xcalib/xcalib/" version
"/xcalib-source-" version ".tar.gz"))
(sha256
(base32
"1rh6xb51c5xz926dnn82a2fn643g0sr4a8z66rn6yi7523kjw4ca"))))
(build-system gnu-build-system)
(arguments
'(#:make-flags '("CC=gcc")
#:tests? #f ; No test suite
#:phases (modify-phases %standard-phases
(delete 'configure)
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin")))
(install-file "xcalib" bin))))
(add-after 'install 'install-doc
(lambda* (#:key outputs #:allow-other-keys)
(let ((doc (string-append(assoc-ref outputs "out")
"/share/doc/xcalib")))
(install-file "README" doc)
;; Avoid unspecified return value.
#t))))))
(inputs `(("libx11", libx11)
("libxext", libxext)
("libxxf86vm", libxxf86vm)))
(synopsis "Tiny monitor calibration loader for XFree86 (or X.org)")
(description "xcalib is a tiny tool to load the content of vcgt-Tags in ICC
profiles to the video card's gamma ramp. It does work with most video card
drivers except the generic VESA driver. Alter brightness, contrast, RGB, and
invert colors on a specific display/screen.")
(home-page "http://xcalib.sourceforge.net/")
(license license:gpl2)))

4
gnu/packages/xiph.scm
View File

@ -356,7 +356,7 @@ decoding .opus files.")
(define opusfile (define opusfile
(package (package
(name "opusfile") (name "opusfile")
(version "0.7") (version "0.8")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -364,7 +364,7 @@ decoding .opus files.")
".tar.gz")) ".tar.gz"))
(sha256 (sha256
(base32 (base32
"00f3wwjv3hxwg05g22s6mkkxikz80ljsn70g39cmi43jph9ysawy")))) "192mp2jgn5s9815h31ybzsfipmbppmdhwx1dymrk26xarz9iw8rc"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(propagated-inputs (propagated-inputs
`(("opus" ,opus))) `(("opus" ,opus)))

94
gnu/services/dbus.scm
View File

@ -21,7 +21,9 @@
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services shepherd) #:use-module (gnu services shepherd)
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu system pam)
#:use-module ((gnu packages glib) #:select (dbus)) #:use-module ((gnu packages glib) #:select (dbus))
#:use-module (gnu packages polkit)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix records) #:use-module (guix records)
@ -30,7 +32,10 @@
#:export (dbus-configuration #:export (dbus-configuration
dbus-configuration? dbus-configuration?
dbus-root-service-type dbus-root-service-type
dbus-service)) dbus-service
polkit-service-type
polkit-service))
;;; ;;;
;;; D-Bus. ;;; D-Bus.
@ -218,4 +223,91 @@ and policy files. For example, to allow avahi-daemon to use the system bus,
(dbus-configuration (dbus dbus) (dbus-configuration (dbus dbus)
(services services)))) (services services))))
;;;
;;; Polkit privilege management service.
;;;
(define-record-type* <polkit-configuration>
polkit-configuration make-polkit-configuration
polkit-configuration?
(polkit polkit-configuration-polkit ;<package>
(default polkit))
(actions polkit-configuration-actions ;list of <package>
(default '())))
(define %polkit-accounts
(list (user-group (name "polkitd") (system? #t))
(user-account
(name "polkitd")
(group "polkitd")
(system? #t)
(comment "Polkit daemon user")
(home-directory "/var/empty")
(shell "/run/current-system/profile/sbin/nologin"))))
(define %polkit-pam-services
(list (unix-pam-service "polkit-1")))
(define (polkit-directory packages)
"Return a directory containing an @file{actions} and possibly a
@file{rules.d} sub-directory, for use as @file{/etc/polkit-1}."
(with-imported-modules '((guix build union))
(computed-file "etc-polkit-1"
#~(begin
(use-modules (guix build union) (srfi srfi-26))
(union-build #$output
(map (cut string-append <>
"/share/polkit-1")
(list #$@packages)))))))
(define polkit-etc-files
(match-lambda
(($ <polkit-configuration> polkit packages)
`(("polkit-1" ,(polkit-directory (cons polkit packages)))))))
(define polkit-setuid-programs
(match-lambda
(($ <polkit-configuration> polkit)
(list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1")
(file-append polkit "/bin/pkexec")))))
(define polkit-service-type
(service-type (name 'polkit)
(extensions
(list (service-extension account-service-type
(const %polkit-accounts))
(service-extension pam-root-service-type
(const %polkit-pam-services))
(service-extension dbus-root-service-type
(compose
list
polkit-configuration-polkit))
(service-extension etc-service-type
polkit-etc-files)
(service-extension setuid-program-service-type
polkit-setuid-programs)))
;; Extensions are lists of packages that provide polkit rules
;; or actions under share/polkit-1/{actions,rules.d}.
(compose concatenate)
(extend (lambda (config actions)
(polkit-configuration
(inherit config)
(actions
(append (polkit-configuration-actions config)
actions)))))))
(define* (polkit-service #:key (polkit polkit))
"Return a service that runs the
@uref{http://www.freedesktop.org/wiki/Software/polkit/, Polkit privilege
management service}, which allows system administrators to grant access to
privileged operations in a structured way. By querying the Polkit service, a
privileged system component can know when it should grant additional
capabilities to ordinary users. For example, an ordinary user can be granted
the capability to suspend the system if the user is logged in locally."
(service polkit-service-type
(polkit-configuration (polkit polkit))))
;;; dbus.scm ends here ;;; dbus.scm ends here

93
gnu/services/desktop.scm
View File

@ -37,7 +37,6 @@
#:use-module (gnu packages gnome) #:use-module (gnu packages gnome)
#:use-module (gnu packages xfce) #:use-module (gnu packages xfce)
#:use-module (gnu packages avahi) #:use-module (gnu packages avahi)
#:use-module (gnu packages polkit)
#:use-module (gnu packages xdisorg) #:use-module (gnu packages xdisorg)
#:use-module (gnu packages suckless) #:use-module (gnu packages suckless)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
@ -68,11 +67,6 @@
bluetooth-service bluetooth-service
polkit-configuration
polkit-configuration?
polkit-service
polkit-service-type
elogind-configuration elogind-configuration
elogind-configuration? elogind-configuration?
elogind-service elogind-service
@ -413,93 +407,6 @@ Users need to be in the @code{lp} group to access the D-Bus service.
" "
(service bluetooth-service-type bluez)) (service bluetooth-service-type bluez))
;;;
;;; Polkit privilege management service.
;;;
(define-record-type* <polkit-configuration>
polkit-configuration make-polkit-configuration
polkit-configuration?
(polkit polkit-configuration-polkit ;<package>
(default polkit))
(actions polkit-configuration-actions ;list of <package>
(default '())))
(define %polkit-accounts
(list (user-group (name "polkitd") (system? #t))
(user-account
(name "polkitd")
(group "polkitd")
(system? #t)
(comment "Polkit daemon user")
(home-directory "/var/empty")
(shell "/run/current-system/profile/sbin/nologin"))))
(define %polkit-pam-services
(list (unix-pam-service "polkit-1")))
(define (polkit-directory packages)
"Return a directory containing an @file{actions} and possibly a
@file{rules.d} sub-directory, for use as @file{/etc/polkit-1}."
(with-imported-modules '((guix build union))
(computed-file "etc-polkit-1"
#~(begin
(use-modules (guix build union) (srfi srfi-26))
(union-build #$output
(map (cut string-append <>
"/share/polkit-1")
(list #$@packages)))))))
(define polkit-etc-files
(match-lambda
(($ <polkit-configuration> polkit packages)
`(("polkit-1" ,(polkit-directory (cons polkit packages)))))))
(define polkit-setuid-programs
(match-lambda
(($ <polkit-configuration> polkit)
(list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1")
(file-append polkit "/bin/pkexec")))))
(define polkit-service-type
(service-type (name 'polkit)
(extensions
(list (service-extension account-service-type
(const %polkit-accounts))
(service-extension pam-root-service-type
(const %polkit-pam-services))
(service-extension dbus-root-service-type
(compose
list
polkit-configuration-polkit))
(service-extension etc-service-type
polkit-etc-files)
(service-extension setuid-program-service-type
polkit-setuid-programs)))
;; Extensions are lists of packages that provide polkit rules
;; or actions under share/polkit-1/{actions,rules.d}.
(compose concatenate)
(extend (lambda (config actions)
(polkit-configuration
(inherit config)
(actions
(append (polkit-configuration-actions config)
actions)))))))
(define* (polkit-service #:key (polkit polkit))
"Return a service that runs the
@uref{http://www.freedesktop.org/wiki/Software/polkit/, Polkit privilege
management service}, which allows system administrators to grant access to
privileged operations in a structured way. By querying the Polkit service, a
privileged system component can know when it should grant additional
capabilities to ordinary users. For example, an ordinary user can be granted
the capability to suspend the system if the user is logged in locally."
(service polkit-service-type
(polkit-configuration (polkit polkit))))
;;; ;;;
;;; Colord D-Bus service. ;;; Colord D-Bus service.

20
gnu/services/dict.scm
View File

@ -105,15 +105,17 @@ database {
(chown rundir (passwd:uid user) (passwd:gid user))))) (chown rundir (passwd:uid user) (passwd:gid user)))))
(define (dicod-shepherd-service config) (define (dicod-shepherd-service config)
(list (shepherd-service (let ((dicod (file-append (dicod-configuration-dico config)
(provision '(dicod)) "/bin/dicod"))
(documentation "Run the dicod daemon.") (dicod.conf (dicod-configuration-file config)))
(start #~(make-forkexec-constructor (list (shepherd-service
(list (string-append #$dico "/bin/dicod") "--foreground" (provision '(dicod))
(string-append (documentation "Run the dicod daemon.")
"--config=" #$(dicod-configuration-file config))) (start #~(make-forkexec-constructor
#:user "dicod" #:group "dicod")) (list #$dicod "--foreground"
(stop #~(make-kill-destructor))))) (string-append "--config=" #$dicod.conf))
#:user "dicod" #:group "dicod"))
(stop #~(make-kill-destructor))))))
(define dicod-service-type (define dicod-service-type
(service-type (service-type

71
gnu/services/networking.scm
View File

@ -62,6 +62,7 @@
bitlbee-service bitlbee-service
bitlbee-service-type bitlbee-service-type
wicd-service-type
wicd-service wicd-service
network-manager-service network-manager-service
connman-service connman-service
@ -112,21 +113,19 @@ fe80::1%lo0 apps.facebook.com\n")
static-networking? static-networking?
(interface static-networking-interface) (interface static-networking-interface)
(ip static-networking-ip) (ip static-networking-ip)
(netmask static-networking-netmask
(default #f))
(gateway static-networking-gateway) (gateway static-networking-gateway)
(provision static-networking-provision) (provision static-networking-provision)
(name-servers static-networking-name-servers) (name-servers static-networking-name-servers))
(net-tools static-networking-net-tools))
(define static-networking-service-type (define static-networking-service-type
(shepherd-service-type (shepherd-service-type
'static-networking 'static-networking
(match-lambda (match-lambda
(($ <static-networking> interface ip gateway provision (($ <static-networking> interface ip netmask gateway provision
name-servers net-tools) name-servers)
(let ((loopback? (memq 'loopback provision))) (let ((loopback? (memq 'loopback provision)))
;; TODO: Eventually replace 'route' with bindings for the appropriate
;; ioctls.
(shepherd-service (shepherd-service
;; Unless we're providing the loopback interface, wait for udev to be up ;; Unless we're providing the loopback interface, wait for udev to be up
@ -139,18 +138,28 @@ fe80::1%lo0 apps.facebook.com\n")
(start #~(lambda _ (start #~(lambda _
;; Return #t if successfully started. ;; Return #t if successfully started.
(let* ((addr (inet-pton AF_INET #$ip)) (let* ((addr (inet-pton AF_INET #$ip))
(sockaddr (make-socket-address AF_INET addr 0))) (sockaddr (make-socket-address AF_INET addr 0))
(mask (and #$netmask
(inet-pton AF_INET #$netmask)))
(maskaddr (and mask
(make-socket-address AF_INET
mask 0)))
(gateway (and #$gateway
(inet-pton AF_INET #$gateway)))
(gatewayaddr (and gateway
(make-socket-address AF_INET
gateway 0))))
(configure-network-interface #$interface sockaddr (configure-network-interface #$interface sockaddr
(logior IFF_UP (logior IFF_UP
#$(if loopback? #$(if loopback?
#~IFF_LOOPBACK #~IFF_LOOPBACK
0)))) 0))
#$(if gateway #:netmask maskaddr)
#~(zero? (system* (string-append #$net-tools (when gateway
"/sbin/route") (let ((sock (socket AF_INET SOCK_DGRAM 0)))
"add" "-net" "default" (add-network-route/gateway sock gatewayaddr)
"gw" #$gateway)) (close-port sock))))
#t)
#$(if (pair? name-servers) #$(if (pair? name-servers)
#~(call-with-output-file "/etc/resolv.conf" #~(call-with-output-file "/etc/resolv.conf"
(lambda (port) (lambda (port)
@ -160,35 +169,34 @@ fe80::1%lo0 apps.facebook.com\n")
(for-each (lambda (server) (for-each (lambda (server)
(format port "nameserver ~a~%" (format port "nameserver ~a~%"
server)) server))
'#$name-servers))) '#$name-servers)
#t))
#t))) #t)))
(stop #~(lambda _ (stop #~(lambda _
;; Return #f is successfully stopped. ;; Return #f is successfully stopped.
(let ((sock (socket AF_INET SOCK_STREAM 0))) (let ((sock (socket AF_INET SOCK_STREAM 0)))
(when #$gateway
(delete-network-route sock
(make-socket-address
AF_INET INADDR_ANY 0)))
(set-network-interface-flags sock #$interface 0) (set-network-interface-flags sock #$interface 0)
(close-port sock)) (close-port sock)
(not #$(if gateway #f)))
#~(system* (string-append #$net-tools
"/sbin/route")
"del" "-net" "default")
#t))))
(respawn? #f))))))) (respawn? #f)))))))
(define* (static-networking-service interface ip (define* (static-networking-service interface ip
#:key #:key
gateway netmask gateway
(provision '(networking)) (provision '(networking))
(name-servers '()) (name-servers '()))
(net-tools net-tools))
"Return a service that starts @var{interface} with address @var{ip}. If "Return a service that starts @var{interface} with address @var{ip}. If
@var{gateway} is true, it must be a string specifying the default network @var{netmask} is true, use it as the network mask. If @var{gateway} is true,
gateway." it must be a string specifying the default network gateway."
(service static-networking-service-type (service static-networking-service-type
(static-networking (interface interface) (ip ip) (static-networking (interface interface) (ip ip)
(gateway gateway) (netmask netmask) (gateway gateway)
(provision provision) (provision provision)
(name-servers name-servers) (name-servers name-servers))))
(net-tools net-tools))))
(define dhcp-client-service-type (define dhcp-client-service-type
(shepherd-service-type (shepherd-service-type
@ -674,7 +682,7 @@ and @command{wicd-curses} user interfaces."
(list (shepherd-service (list (shepherd-service
(documentation "Run the NetworkManager.") (documentation "Run the NetworkManager.")
(provision '(networking)) (provision '(networking))
(requirement '(user-processes dbus-system loopback)) (requirement '(user-processes dbus-system wpa-supplicant loopback))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list (string-append #$network-manager (list (string-append #$network-manager
"/sbin/NetworkManager") "/sbin/NetworkManager")
@ -687,6 +695,7 @@ and @command{wicd-curses} user interfaces."
(list (service-extension shepherd-root-service-type (list (service-extension shepherd-root-service-type
network-manager-shepherd-service) network-manager-shepherd-service)
(service-extension dbus-root-service-type list) (service-extension dbus-root-service-type list)
(service-extension polkit-service-type list)
(service-extension activation-service-type (service-extension activation-service-type
(const %network-manager-activation)) (const %network-manager-activation))
;; Add network-manager to the system profile. ;; Add network-manager to the system profile.

141
gnu/services/version-control.scm Normal file
View File

@ -0,0 +1,141 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016 Sou Bunnbu <iyzsong@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 services version-control)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu services shepherd)
#:use-module (gnu system shadow)
#:use-module (gnu packages version-control)
#:use-module (gnu packages admin)
#:use-module (guix records)
#:use-module (guix gexp)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (git-daemon-service
git-daemon-service-type
git-daemon-configuration
git-daemon-configuration?))
;;; Commentary:
;;;
;;; Version Control related services.
;;;
;;; Code:
;;;
;;; Git daemon.
;;;
(define-record-type* <git-daemon-configuration>
git-daemon-configuration
make-git-daemon-configuration
git-daemon-configuration?
(package git-daemon-configuration-package ;package
(default git))
(export-all? git-daemon-configuration-export-all ;boolean
(default #f))
(base-path git-daemon-configuration-base-path ;string | #f
(default "/srv/git"))
(user-path git-daemon-configuration-user-path ;string | #f
(default #f))
(listen git-daemon-configuration-listen ;list of string
(default '()))
(port git-daemon-configuration-port ;number | #f
(default #f))
(whitelist git-daemon-configuration-whitelist ;list of string
(default '()))
(extra-options git-daemon-configuration-extra-options ;list of string
(default '())))
(define git-daemon-shepherd-service
(match-lambda
(($ <git-daemon-configuration>
package export-all? base-path user-path
listen port whitelist extra-options)
(let* ((git (file-append package "/bin/git"))
(command `(,git
"daemon" "--syslog" "--reuseaddr"
,@(if export-all?
'("--export-all")
'())
,@(if base-path
`(,(string-append "--base-path=" base-path))
'())
,@(if user-path
`(,(string-append "--user-path=" user-path))
'())
,@(map (cut string-append "--listen=" <>) listen)
,@(if port
`(,(string-append
"--port=" (number->string port)))
'())
,@extra-options
,@whitelist)))
(list (shepherd-service
(documentation "Run the git-daemon.")
(requirement '(networking))
(provision '(git-daemon))
(start #~(make-forkexec-constructor '#$command
#:user "git-daemon"
#:group "git-daemon"))
(stop #~(make-kill-destructor))))))))
(define %git-daemon-accounts
;; User account and group for git-daemon.
(list (user-group
(name "git-daemon")
(system? #t))
(user-account
(name "git-daemon")
(system? #t)
(group "git-daemon")
(comment "Git daemon user")
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))))
(define (git-daemon-activation config)
"Return the activation gexp for git-daemon using CONFIG."
(let ((base-path (git-daemon-configuration-base-path config)))
#~(begin
(use-modules (guix build utils))
;; Create the 'base-path' directory when it's not '#f'.
(and=> #$base-path mkdir-p))))
(define git-daemon-service-type
(service-type
(name 'git-daemon)
(extensions
(list (service-extension shepherd-root-service-type
git-daemon-shepherd-service)
(service-extension account-service-type
(const %git-daemon-accounts))
(service-extension activation-service-type
git-daemon-activation)))))
(define* (git-daemon-service #:key (config (git-daemon-configuration)))
"Return a service that runs @command{git daemon}, a simple TCP server to
expose repositories over the Git protocol for annoymous access.
The optional @var{config} argument should be a
@code{<git-daemon-configuration>} object, by default it allows read-only
access to exported repositories under @file{/srv/git}."
(service git-daemon-service-type config))

3
gnu/system.scm
View File

@ -346,7 +346,8 @@ explicitly appear in OS."
(define %base-firmware (define %base-firmware
;; Firmware usable by default. ;; Firmware usable by default.
(list ath9k-htc-firmware)) (list ath9k-htc-firmware
openfwwf-firmware))
(define %base-packages (define %base-packages
;; Default set of packages globally visible. It should include anything ;; Default set of packages globally visible. It should include anything

15
gnu/system/examples/desktop.tmpl
View File

@ -1,5 +1,6 @@
;; This is an operating system configuration template ;; This is an operating system configuration template
;; for a "desktop" setup with GNOME and Xfce. ;; for a "desktop" setup with GNOME and Xfce where the
;; root partition is encrypted with LUKS.
(use-modules (gnu) (gnu system nss)) (use-modules (gnu) (gnu system nss))
(use-service-modules desktop) (use-service-modules desktop)
@ -13,11 +14,21 @@
;; Assuming /dev/sdX is the target hard disk, and "my-root" ;; Assuming /dev/sdX is the target hard disk, and "my-root"
;; is the label of the target root file system. ;; is the label of the target root file system.
(bootloader (grub-configuration (device "/dev/sdX"))) (bootloader (grub-configuration (device "/dev/sdX")))
;; Specify a mapped device for the encrypted root partition.
;; The UUID is that returned by 'cryptsetup luksUUID'.
(mapped-devices
(list (mapped-device
(source (uuid "12345678-1234-1234-1234-123456789abc"))
(target "the-root-device")
(type luks-device-mapping))))
(file-systems (cons (file-system (file-systems (cons (file-system
(device "my-root") (device "my-root")
(title 'label) (title 'label)
(mount-point "/") (mount-point "/")
(type "ext4")) (type "ext4")
(dependencies mapped-devices))
%base-file-systems)) %base-file-systems))
(users (cons (user-account (users (cons (user-account

8
gnu/system/mapped-devices.scm
View File

@ -23,7 +23,7 @@
#:use-module (guix modules) #:use-module (guix modules)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services shepherd) #:use-module (gnu services shepherd)
#:autoload (gnu packages cryptsetup) (cryptsetup) #:autoload (gnu packages cryptsetup) (cryptsetup-static)
#:autoload (gnu packages linux) (mdadm-static) #:autoload (gnu packages linux) (mdadm-static)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -104,7 +104,9 @@
((gnu build file-systems) ((gnu build file-systems)
#:select (find-partition-by-luks-uuid))) #:select (find-partition-by-luks-uuid)))
(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") ;; Use 'cryptsetup-static', not 'cryptsetup', to avoid pulling the
;; whole world inside the initrd (for when we're in an initrd).
(zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup")
"open" "--type" "luks" "open" "--type" "luks"
;; Note: We cannot use the "UUID=source" syntax here ;; Note: We cannot use the "UUID=source" syntax here
@ -120,7 +122,7 @@
(define (close-luks-device source target) (define (close-luks-device source target)
"Return a gexp that closes TARGET, a LUKS device." "Return a gexp that closes TARGET, a LUKS device."
#~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") #~(zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup")
"close" #$target))) "close" #$target)))
(define luks-device-mapping (define luks-device-mapping

2
gnu/system/vm.scm
View File

@ -317,7 +317,6 @@ of the GNU system as described by OS."
(initrd (lambda (file-systems . rest) (initrd (lambda (file-systems . rest)
(apply base-initrd file-systems (apply base-initrd file-systems
#:virtio? #t #:virtio? #t
#:qemu-networking? #t
rest))) rest)))
;; Force our own root file system. ;; Force our own root file system.
@ -386,7 +385,6 @@ environment with the store shared with the host. MAPPINGS is a list of
(apply base-initrd file-systems (apply base-initrd file-systems
#:volatile-root? #t #:volatile-root? #t
#:virtio? #t #:virtio? #t
#:qemu-networking? #t
rest))) rest)))
;; Disable swap. ;; Disable swap.

59
gnu/tests/base.scm
View File

@ -31,6 +31,8 @@
#:use-module (gnu services mcron) #:use-module (gnu services mcron)
#:use-module (gnu services shepherd) #:use-module (gnu services shepherd)
#:use-module (gnu services networking) #:use-module (gnu services networking)
#:use-module (gnu packages imagemagick)
#:use-module (gnu packages ocr)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
@ -65,10 +67,16 @@
%base-user-accounts)))) %base-user-accounts))))
(define* (run-basic-test os command #:optional (name "basic")) (define* (run-basic-test os command #:optional (name "basic")
#:key initialization)
"Return a derivation called NAME that tests basic features of the OS started "Return a derivation called NAME that tests basic features of the OS started
using COMMAND, a gexp that evaluates to a list of strings. Compare some using COMMAND, a gexp that evaluates to a list of strings. Compare some
properties of running system to what's declared in OS, an <operating-system>." properties of running system to what's declared in OS, an <operating-system>.
When INITIALIZATION is true, it must be a one-argument procedure that is
passed a gexp denoting the marionette, and it must return gexp that is
inserted before the first test. This is used to introduce an extra
initialization step, such as entering a LUKS passphrase."
(define test (define test
(with-imported-modules '((gnu build marionette)) (with-imported-modules '((gnu build marionette))
#~(begin #~(begin
@ -86,6 +94,9 @@ properties of running system to what's declared in OS, an <operating-system>."
(test-begin "basic") (test-begin "basic")
#$(and initialization
(initialization #~marionette))
(test-assert "uname" (test-assert "uname"
(match (marionette-eval '(uname) marionette) (match (marionette-eval '(uname) marionette)
(#("Linux" host-name version _ architecture) (#("Linux" host-name version _ architecture)
@ -150,14 +161,20 @@ info --version")
(marionette-type "root\n\nid -un > logged-in\n" marionette) (marionette-type "root\n\nid -un > logged-in\n" marionette)
;; It can take a while before the shell commands are executed. ;; It can take a while before the shell commands are executed.
(let loop ((i 0))
(unless (or (file-exists? "/root/logged-in") (> i 15))
(sleep 1)
(loop (+ i 1))))
(marionette-eval '(use-modules (rnrs io ports)) marionette) (marionette-eval '(use-modules (rnrs io ports)) marionette)
(marionette-eval '(call-with-input-file "/root/logged-in" (marionette-eval
get-string-all) '(let loop ((i 0))
marionette))) (catch 'system-error
(lambda ()
(call-with-input-file "/root/logged-in"
get-string-all))
(lambda args
(if (and (< i 15) (= ENOENT (system-error-errno args)))
(begin
(sleep 1)
(loop (+ i 1)))
(apply throw args)))))
marionette)))
(test-assert "host name resolution" (test-assert "host name resolution"
(match (marionette-eval (match (marionette-eval
@ -182,14 +199,8 @@ info --version")
(test-equal "locale" (test-equal "locale"
"en_US.utf8" "en_US.utf8"
(marionette-eval '(begin (marionette-eval '(let ((before (setlocale LC_ALL "en_US.utf8")))
;; XXX: This 'setenv' call wouldn't be needed (setlocale LC_ALL before))
;; but our glibc@2.23 currently ignores
;; /run/current-system/locale.
(setenv "GUIX_LOCPATH"
"/run/current-system/locale")
(let ((before (setlocale LC_ALL "en_US.utf8")))
(setlocale LC_ALL before)))
marionette)) marionette))
(test-assert "/run/current-system is a GC root" (test-assert "/run/current-system is a GC root"
@ -235,6 +246,20 @@ info --version")
marionette) marionette)
(file-exists? "tty1.ppm"))) (file-exists? "tty1.ppm")))
(test-assert "screen text"
(let ((text (marionette-screen-text marionette
#:ocrad
#$(file-append ocrad
"/bin/ocrad"))))
;; Check whether the welcome message and shell prompt are
;; displayed. Note: OCR confuses "y" and "V" for instance, so
;; we cannot reliably match the whole text.
(and (string-contains text "This is the GNU")
(string-contains text
(string-append
"root@"
#$(operating-system-host-name os))))))
(test-end) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

66
gnu/tests/install.scm
View File

@ -24,6 +24,7 @@
#:use-module (gnu system install) #:use-module (gnu system install)
#:use-module (gnu system vm) #:use-module (gnu system vm)
#:use-module ((gnu build vm) #:select (qemu-command)) #:use-module ((gnu build vm) #:select (qemu-command))
#:use-module (gnu packages ocr)
#:use-module (gnu packages qemu) #:use-module (gnu packages qemu)
#:use-module (gnu packages package-management) #:use-module (gnu packages package-management)
#:use-module (guix store) #:use-module (guix store)
@ -398,17 +399,20 @@ by 'mdadm'.")
(locale "en_US.UTF-8") (locale "en_US.UTF-8")
(bootloader (grub-configuration (device "/dev/vdb"))) (bootloader (grub-configuration (device "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
;; detection logic in 'enter-luks-passphrase'.
(mapped-devices (list (mapped-device
(source (uuid "12345678-1234-1234-1234-123456789abc"))
(target "the-root-device")
(type luks-device-mapping))))
(file-systems (cons (file-system (file-systems (cons (file-system
(device "/dev/mapper/the-root-device") (device "/dev/mapper/the-root-device")
(title 'device) (title 'device)
(mount-point "/") (mount-point "/")
(type "ext4")) (type "ext4"))
%base-file-systems)) %base-file-systems))
(mapped-devices (list (mapped-device
(source "REPLACE-WITH-LUKS-UUID")
(target "the-root-device")
(type luks-device-mapping))))
(users (cons (user-account (users (cons (user-account
(name "charlie") (name "charlie")
(group "users") (group "users")
@ -435,7 +439,8 @@ parted --script /dev/vdb mklabel gpt \\
mkpart primary ext2 3M 1G \\ mkpart primary ext2 3M 1G \\
set 1 boot on \\ set 1 boot on \\
set 1 bios_grub on set 1 bios_grub on
echo -n thepassphrase | cryptsetup luksFormat -q /dev/vdb2 - echo -n thepassphrase | \\
cryptsetup luksFormat --uuid=12345678-1234-1234-1234-123456789abc -q /dev/vdb2 -
echo -n thepassphrase | \\ echo -n thepassphrase | \\
cryptsetup open --type luks --key-file - /dev/vdb2 the-root-device cryptsetup open --type luks --key-file - /dev/vdb2 the-root-device
mkfs.ext4 -L my-root /dev/mapper/the-root-device mkfs.ext4 -L my-root /dev/mapper/the-root-device
@ -443,15 +448,53 @@ mount LABEL=my-root /mnt
herd start cow-store /mnt herd start cow-store /mnt
mkdir /mnt/etc mkdir /mnt/etc
cp /etc/target-config.scm /mnt/etc/config.scm cp /etc/target-config.scm /mnt/etc/config.scm
cat /mnt/etc/config
luks_uuid=`cryptsetup luksUUID /dev/vdb2`
sed -i /mnt/etc/config.scm \\
-e \"s/\\\"REPLACE-WITH-LUKS-UUID\\\"/(uuid \\\"$luks_uuid\\\")/g\"
guix system build /mnt/etc/config.scm guix system build /mnt/etc/config.scm
guix system init /mnt/etc/config.scm /mnt --no-substitutes guix system init /mnt/etc/config.scm /mnt --no-substitutes
sync sync
reboot\n") reboot\n")
(define (enter-luks-passphrase marionette)
"Return a gexp to be inserted in the basic system test running on MARIONETTE
to enter the LUKS passphrase."
(let ((ocrad (file-append ocrad "/bin/ocrad")))
#~(begin
(define (passphrase-prompt? text)
(string-contains (pk 'screen-text text) "Enter pass"))
(define (bios-boot-screen? text)
;; Return true if TEXT corresponds to the boot screen, before GRUB's
;; menu.
(string-prefix? "SeaBIOS" text))
(test-assert "enter LUKS passphrase for GRUB"
(begin
;; At this point we have no choice but to use OCR to determine
;; when the passphrase should be entered.
(wait-for-screen-text #$marionette passphrase-prompt?
#:ocrad #$ocrad)
(marionette-type "thepassphrase\n" #$marionette)
;; Now wait until we leave the boot screen. This is necessary so
;; we can then be sure we match the "Enter passphrase" prompt from
;; 'cryptsetup', in the initrd.
(wait-for-screen-text #$marionette (negate bios-boot-screen?)
#:ocrad #$ocrad
#:timeout 20)))
(test-assert "enter LUKS passphrase for the initrd"
(begin
;; XXX: Here we use OCR as well but we could instead use QEMU
;; '-serial stdio' and run it in an input pipe,
(wait-for-screen-text #$marionette passphrase-prompt?
#:ocrad #$ocrad
#:timeout 60)
(marionette-type "thepassphrase\n" #$marionette)
;; Take a screenshot for debugging purposes.
(marionette-control (string-append "screendump " #$output
"/post-initrd-passphrase.ppm")
#$marionette))))))
(define %test-encrypted-os (define %test-encrypted-os
(system-test (system-test
(name "encrypted-root-os") (name "encrypted-root-os")
@ -465,6 +508,7 @@ build (current-guix) and then store a couple of full system images.")
#:script #:script
%encrypted-root-installation-script)) %encrypted-root-installation-script))
(command (qemu-command/writable-image image))) (command (qemu-command/writable-image image)))
(run-basic-test %encrypted-root-os command "encrypted-root-os"))))) (run-basic-test %encrypted-root-os command "encrypted-root-os"
#:initialization enter-luks-passphrase)))))
;;; install.scm ends here ;;; install.scm ends here

220
guix/build/syscalls.scm
View File

@ -87,12 +87,16 @@
all-network-interface-names all-network-interface-names
network-interface-names network-interface-names
network-interface-flags network-interface-flags
network-interface-netmask
loopback-network-interface? loopback-network-interface?
network-interface-address network-interface-address
set-network-interface-flags set-network-interface-flags
set-network-interface-address set-network-interface-address
set-network-interface-netmask
set-network-interface-up set-network-interface-up
configure-network-interface configure-network-interface
add-network-route/gateway
delete-network-route
interface? interface?
interface-name interface-name
@ -202,7 +206,7 @@ result is the alignment of the \"most strictly aligned component\"."
types ...)))) types ...))))
(define-syntax write-type (define-syntax write-type
(syntax-rules (~ array) (syntax-rules (~ array *)
((_ bv offset (type ~ order) value) ((_ bv offset (type ~ order) value)
(bytevector-uint-set! bv offset value (bytevector-uint-set! bv offset value
(endianness order) (sizeof* type))) (endianness order) (sizeof* type)))
@ -215,6 +219,9 @@ result is the alignment of the \"most strictly aligned component\"."
((head . tail) ((head . tail)
(write-type bv o type head) (write-type bv o type head)
(loop (+ 1 i) tail (+ o (sizeof* type)))))))) (loop (+ 1 i) tail (+ o (sizeof* type))))))))
((_ bv offset '* value)
(bytevector-uint-set! bv offset (pointer-address value)
(native-endianness) (sizeof* '*)))
((_ bv offset type value) ((_ bv offset type value)
(bytevector-uint-set! bv offset value (bytevector-uint-set! bv offset value
(native-endianness) (sizeof* type))))) (native-endianness) (sizeof* type)))))
@ -262,6 +269,29 @@ result is the alignment of the \"most strictly aligned component\"."
(align offset type0) (align offset type0)
type0)))))) type0))))))
(define-syntax define-c-struct-macro
(syntax-rules ()
"Define NAME as a macro that can be queried to get information about the C
struct it represents. In particular:
(NAME field-offset FIELD)
returns the offset in bytes of FIELD within the C struct represented by NAME."
((_ name ((fields types) ...))
(define-c-struct-macro name
(fields ...) 0 ()
((fields types) ...)))
((_ name (fields ...) offset (clauses ...) ((field type) rest ...))
(define-c-struct-macro name
(fields ...)
(+ (align offset type) (type-size type))
(clauses ... ((_ field-offset field) (align offset type)))
(rest ...)))
((_ name (fields ...) offset (clauses ...) ())
(define-syntax name
(syntax-rules (field-offset fields ...)
clauses ...)))))
(define-syntax define-c-struct (define-syntax define-c-struct
(syntax-rules () (syntax-rules ()
"Define SIZE as the size in bytes of the C structure made of FIELDS. READ "Define SIZE as the size in bytes of the C structure made of FIELDS. READ
@ -269,6 +299,8 @@ as a deserializer and WRITE! as a serializer for the C structure with the
given TYPES. READ uses WRAP-FIELDS to return its value." given TYPES. READ uses WRAP-FIELDS to return its value."
((_ name size wrap-fields read write! (fields types) ...) ((_ name size wrap-fields read write! (fields types) ...)
(begin (begin
(define-c-struct-macro name
((fields types) ...))
(define size (define size
(struct-size 0 () types ...)) (struct-size 0 () types ...))
(define (write! bv offset fields ...) (define (write! bv offset fields ...)
@ -276,6 +308,12 @@ given TYPES. READ uses WRAP-FIELDS to return its value."
(define* (read bv #:optional (offset 0)) (define* (read bv #:optional (offset 0))
(read-types wrap-fields bv offset (types ...) ())))))) (read-types wrap-fields bv offset (types ...) ()))))))
(define-syntax-rule (c-struct-field-offset type field)
"Return the offset in BYTES of FIELD within TYPE, where TYPE is a C struct
defined with 'define-c-struct' and FIELD is a field identifier. An
expansion-time error is raised if FIELD does not exist in TYPE."
(type field-offset field))
;;; ;;;
;;; FFI. ;;; FFI.
@ -761,6 +799,22 @@ exception if it's already taken."
(if (string-contains %host-type "linux") (if (string-contains %host-type "linux")
#x8916 ;GNU/Linux #x8916 ;GNU/Linux
-1)) ;FIXME: GNU/Hurd? -1)) ;FIXME: GNU/Hurd?
(define SIOCGIFNETMASK
(if (string-contains %host-type "linux")
#x891b ;GNU/Linux
-1)) ;FIXME: GNU/Hurd?
(define SIOCSIFNETMASK
(if (string-contains %host-type "linux")
#x891c ;GNU/Linux
-1)) ;FIXME: GNU/Hurd?
(define SIOCADDRT
(if (string-contains %host-type "linux")
#x890B ;GNU/Linux
-1)) ;FIXME: GNU/Hurd?
(define SIOCDELRT
(if (string-contains %host-type "linux")
#x890C ;GNU/Linux
-1)) ;FIXME: GNU/Hurd?
;; Flags and constants from <net/if.h>. ;; Flags and constants from <net/if.h>.
@ -770,10 +824,13 @@ exception if it's already taken."
(define IF_NAMESIZE 16) ;maximum interface name size (define IF_NAMESIZE 16) ;maximum interface name size
(define ifconf-struct (define-c-struct %ifconf-struct
;; 'struct ifconf', from <net/if.h>. sizeof-ifconf
(list int ;int ifc_len list
'*)) ;struct ifreq *ifc_ifcu read-ifconf
write-ifconf!
(length int) ;int ifc_len
(request '*)) ;struct ifreq *ifc_ifcu
(define ifreq-struct-size (define ifreq-struct-size
;; 'struct ifreq' begins with an array of IF_NAMESIZE bytes containing the ;; 'struct ifreq' begins with an array of IF_NAMESIZE bytes containing the
@ -865,15 +922,18 @@ to interfaces that are currently up."
(sock (or sock (socket SOCK_STREAM AF_INET 0))) (sock (or sock (socket SOCK_STREAM AF_INET 0)))
(len (* ifreq-struct-size 10)) (len (* ifreq-struct-size 10))
(reqs (make-bytevector len)) (reqs (make-bytevector len))
(conf (make-c-struct ifconf-struct (conf (make-bytevector sizeof-ifconf)))
(list len (bytevector->pointer reqs))))) (write-ifconf! conf 0
len (bytevector->pointer reqs))
(let-values (((ret err) (let-values (((ret err)
(%ioctl (fileno sock) SIOCGIFCONF conf))) (%ioctl (fileno sock) SIOCGIFCONF
(bytevector->pointer conf))))
(when close? (when close?
(close-port sock)) (close-port sock))
(if (zero? ret) (if (zero? ret)
(bytevector->string-list reqs ifreq-struct-size (bytevector->string-list reqs ifreq-struct-size
(match (parse-c-struct conf ifconf-struct) (match (read-ifconf conf)
((len . _) len))) ((len . _) len)))
(throw 'system-error "network-interface-list" (throw 'system-error "network-interface-list"
"network-interface-list: ~A" "network-interface-list: ~A"
@ -961,6 +1021,22 @@ interface NAME."
(list name (strerror err)) (list name (strerror err))
(list err)))))) (list err))))))
(define (set-network-interface-netmask socket name sockaddr)
"Set the network mask of interface NAME to SOCKADDR."
(let ((req (make-bytevector ifreq-struct-size)))
(bytevector-copy! (string->utf8 name) 0 req 0
(min (string-length name) (- IF_NAMESIZE 1)))
;; Set the 'ifr_addr' field.
(write-socket-address! sockaddr req IF_NAMESIZE)
(let-values (((ret err)
(%ioctl (fileno socket) SIOCSIFNETMASK
(bytevector->pointer req))))
(unless (zero? ret)
(throw 'system-error "set-network-interface-netmask"
"set-network-interface-netmask on ~A: ~A"
(list name (strerror err))
(list err))))))
(define (network-interface-address socket name) (define (network-interface-address socket name)
"Return the address of network interface NAME. The result is an object of "Return the address of network interface NAME. The result is an object of
the same type as that returned by 'make-socket-address'." the same type as that returned by 'make-socket-address'."
@ -977,15 +1053,35 @@ the same type as that returned by 'make-socket-address'."
(list name (strerror err)) (list name (strerror err))
(list err)))))) (list err))))))
(define (configure-network-interface name sockaddr flags) (define (network-interface-netmask socket name)
"Return the netmask of network interface NAME. The result is an object of
the same type as that returned by 'make-socket-address'."
(let ((req (make-bytevector ifreq-struct-size)))
(bytevector-copy! (string->utf8 name) 0 req 0
(min (string-length name) (- IF_NAMESIZE 1)))
(let-values (((ret err)
(%ioctl (fileno socket) SIOCGIFNETMASK
(bytevector->pointer req))))
(if (zero? ret)
(read-socket-address req IF_NAMESIZE)
(throw 'system-error "network-interface-netmask"
"network-interface-netmask on ~A: ~A"
(list name (strerror err))
(list err))))))
(define* (configure-network-interface name sockaddr flags
#:key netmask)
"Configure network interface NAME to use SOCKADDR, an address as returned by "Configure network interface NAME to use SOCKADDR, an address as returned by
'make-socket-address', and FLAGS, a bitwise-or of IFF_* constants." 'make-socket-address', and FLAGS, a bitwise-or of IFF_* constants. If NETMASK
is true, it must be a socket address to use as the network mask."
(let ((sock (socket (sockaddr:fam sockaddr) SOCK_STREAM 0))) (let ((sock (socket (sockaddr:fam sockaddr) SOCK_STREAM 0)))
(dynamic-wind (dynamic-wind
(const #t) (const #t)
(lambda () (lambda ()
(set-network-interface-address sock name sockaddr) (set-network-interface-address sock name sockaddr)
(set-network-interface-flags sock name flags)) (set-network-interface-flags sock name flags)
(when netmask
(set-network-interface-netmask sock name netmask)))
(lambda () (lambda ()
(close-port sock))))) (close-port sock)))))
@ -1002,6 +1098,106 @@ the same type as that returned by 'make-socket-address'."
(lambda () (lambda ()
(close-port sock))))) (close-port sock)))))
;;;
;;; Network routes.
;;;
(define-c-struct %rtentry ;'struct rtentry' from <net/route.h>
sizeof-rtentry
list
read-rtentry
write-rtentry!
(pad1 unsigned-long)
(destination (array uint8 16)) ;struct sockaddr
(gateway (array uint8 16)) ;struct sockaddr
(genmask (array uint8 16)) ;struct sockaddr
(flags unsigned-short)
(pad2 short)
(pad3 long)
(tos uint8)
(class uint8)
(pad4 (array uint8 (if (= 8 (sizeof* '*)) 3 1)))
(metric short)
(device '*)
(mtu unsigned-long)
(window unsigned-long)
(initial-rtt unsigned-short))
(define RTF_UP #x0001) ;'rtentry' flags from <net/route.h>
(define RTF_GATEWAY #x0002)
(define %sockaddr-any
(make-socket-address AF_INET INADDR_ANY 0))
(define add-network-route/gateway
;; To allow field names to be matched as literals, we need to move them out
;; of the lambda's body since the parameters have the same name. A lot of
;; fuss for very little.
(let-syntax ((gateway-offset (identifier-syntax
(c-struct-field-offset %rtentry gateway)))
(destination-offset (identifier-syntax
(c-struct-field-offset %rtentry destination)))
(genmask-offset (identifier-syntax
(c-struct-field-offset %rtentry genmask))))
(lambda* (socket gateway
#:key (destination %sockaddr-any) (genmask %sockaddr-any))
"Add a network route for DESTINATION (a socket address as returned by
'make-socket-address') that goes through GATEWAY (a socket address). For
instance, the call:
(add-network-route/gateway sock
(make-socket-address
AF_INET
(inet-pton AF_INET \"192.168.0.1\")
0))
is equivalent to this 'net-tools' command:
route add -net default gw 192.168.0.1
because the default value of DESTINATION is \"0.0.0.0\"."
(let ((route (make-bytevector sizeof-rtentry 0)))
(write-socket-address! gateway route gateway-offset)
(write-socket-address! destination route destination-offset)
(write-socket-address! genmask route genmask-offset)
(bytevector-u16-native-set! route
(c-struct-field-offset %rtentry flags)
(logior RTF_UP RTF_GATEWAY))
(let-values (((ret err)
(%ioctl (fileno socket) SIOCADDRT
(bytevector->pointer route))))
(unless (zero? ret)
(throw 'system-error "add-network-route/gateway"
"add-network-route/gateway: ~A"
(list (strerror err))
(list err))))))))
(define delete-network-route
(let-syntax ((destination-offset (identifier-syntax
(c-struct-field-offset %rtentry destination))))
(lambda* (socket destination)
"Delete the network route for DESTINATION. For instance, the call:
(delete-network-route sock
(make-socket-address AF_INET INADDR_ANY 0))
is equivalent to the 'net-tools' command:
route del -net default
"
(let ((route (make-bytevector sizeof-rtentry 0)))
(write-socket-address! destination route destination-offset)
(let-values (((ret err)
(%ioctl (fileno socket) SIOCDELRT
(bytevector->pointer route))))
(unless (zero? ret)
(throw 'system-error "delete-network-route"
"delete-network-route: ~A"
(list (strerror err))
(list err))))))))
;;; ;;;
;;; Details about network interfaces---aka. 'getifaddrs'. ;;; Details about network interfaces---aka. 'getifaddrs'.

4
guix/derivations.scm
View File

@ -86,6 +86,7 @@
derivation-path->output-path derivation-path->output-path
derivation-path->output-paths derivation-path->output-paths
derivation derivation
raw-derivation
map-derivation map-derivation
@ -1306,3 +1307,6 @@ ALLOWED-REFERENCES, DISALLOWED-REFERENCES, LOCAL-BUILD?, and SUBSTITUTABLE?."
(define built-derivations (define built-derivations
(store-lift build-derivations)) (store-lift build-derivations))
(define raw-derivation
(store-lift derivation))

159
guix/download.scm
View File

@ -309,27 +309,64 @@
(let ((module (resolve-interface '(gnu packages tls)))) (let ((module (resolve-interface '(gnu packages tls))))
(module-ref module 'gnutls))) (module-ref module 'gnutls)))
(define* (url-fetch url hash-algo hash (define built-in-builders*
#:optional name (let ((cache (make-weak-key-hash-table)))
#:key (system (%current-system)) (lambda ()
(guile (default-guile))) "Return, as a monadic value, the list of built-in builders supported by
"Return a fixed-output derivation that fetches URL (a string, or a list of the daemon."
strings denoting alternate URLs), which is expected to have hash HASH of type (lambda (store)
HASH-ALGO (a symbol). By default, the file name is the base name of URL; ;; Memoize the result to avoid repeated RPCs.
optionally, NAME can specify a different file name. (values (or (hashq-ref cache store)
(let ((result (built-in-builders store)))
(hashq-set! cache store result)
result))
store)))))
When one of the URL starts with mirror://, then its host part is (define* (built-in-download file-name url
interpreted as the name of a mirror scheme, taken from %MIRROR-FILE. #:key system hash-algo hash
mirrors content-addressed-mirrors
(guile 'unused))
"Download FILE-NAME from URL using the built-in 'download' builder.
Alternately, when URL starts with file://, return the corresponding file name This is an \"out-of-band\" download in that the returned derivation does not
in the store." explicitly depend on Guile, GnuTLS, etc. Instead, the daemon performs the
(define file-name download by itself using its own dependencies."
(match url (mlet %store-monad ((mirrors (lower-object mirrors))
((head _ ...) (content-addressed-mirrors
(basename head)) (lower-object content-addressed-mirrors)))
(_ (raw-derivation file-name "builtin:download" '()
(basename url)))) #:system system
#:hash-algo hash-algo
#:hash hash
#:inputs `((,mirrors)
(,content-addressed-mirrors))
;; Honor the user's proxy and locale settings.
#:leaked-env-vars '("http_proxy" "https_proxy"
"LC_ALL" "LC_MESSAGES" "LANG"
"COLUMNS")
#:env-vars `(("url" . ,(object->string url))
("mirrors" . ,mirrors)
("content-addressed-mirrors"
. ,content-addressed-mirrors))
;; Do not offload this derivation because we cannot be
;; sure that the remote daemon supports the 'download'
;; built-in. We may remove this limitation when support
;; for that built-in is widespread.
#:local-build? #t)))
(define* (in-band-download file-name url
#:key system hash-algo hash
mirrors content-addressed-mirrors
guile)
"Download FILE-NAME from URL using a normal, \"in-band\" fixed-output
derivation.
This is now deprecated since it has the drawback of causing bootstrapping
issues: we may need to build GnuTLS just to be able to download the source of
GnuTLS itself and its dependencies. See <http://bugs.gnu.org/22774>."
(define need-gnutls? (define need-gnutls?
;; True if any of the URLs need TLS support. ;; True if any of the URLs need TLS support.
(let ((https? (cut string-prefix? "https://" <>))) (let ((https? (cut string-prefix? "https://" <>)))
@ -366,47 +403,81 @@ in the store."
read)))) read))))
(url-fetch (value-from-environment "guix download url") (url-fetch (value-from-environment "guix download url")
#$output #$output
#:mirrors (call-with-input-file #$%mirror-file read) #:mirrors (call-with-input-file #$mirrors read)
;; Content-addressed mirrors. ;; Content-addressed mirrors.
#:hashes #:hashes
(value-from-environment "guix download hashes") (value-from-environment "guix download hashes")
#:content-addressed-mirrors #:content-addressed-mirrors
(primitive-load #$%content-addressed-mirror-file) (primitive-load #$content-addressed-mirrors)
;; No need to validate certificates since we know the ;; No need to validate certificates since we know the
;; hash of the expected result. ;; hash of the expected result.
#:verify-certificate? #f))))) #:verify-certificate? #f)))))
(mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation file-name builder
#:guile-for-build guile
#:system system
#:hash-algo hash-algo
#:hash hash
;; Use environment variables and a fixed script
;; name so there's only one script in store for
;; all the downloads.
#:script-name "download"
#:env-vars
`(("guix download url" . ,(object->string url))
("guix download hashes"
. ,(object->string `((,hash-algo . ,hash)))))
;; Honor the user's proxy settings.
#:leaked-env-vars '("http_proxy" "https_proxy")
;; In general, offloading downloads is not a good
;; idea. Daemons before 0.8.3 would also
;; interpret this as "do not substitute" (see
;; <https://bugs.gnu.org/18747>.)
#:local-build? #t)))
(define* (url-fetch url hash-algo hash
#:optional name
#:key (system (%current-system))
(guile (default-guile)))
"Return a fixed-output derivation that fetches URL (a string, or a list of
strings denoting alternate URLs), which is expected to have hash HASH of type
HASH-ALGO (a symbol). By default, the file name is the base name of URL;
optionally, NAME can specify a different file name.
When one of the URL starts with mirror://, then its host part is
interpreted as the name of a mirror scheme, taken from %MIRROR-FILE.
Alternately, when URL starts with file://, return the corresponding file name
in the store."
(define file-name
(match url
((head _ ...)
(basename head))
(_
(basename url))))
(let ((uri (and (string? url) (string->uri url)))) (let ((uri (and (string? url) (string->uri url))))
(if (or (and (string? url) (not uri)) (if (or (and (string? url) (not uri))
(and uri (memq (uri-scheme uri) '(#f file)))) (and uri (memq (uri-scheme uri) '(#f file))))
(interned-file (if uri (uri-path uri) url) (interned-file (if uri (uri-path uri) url)
(or name file-name)) (or name file-name))
(mlet %store-monad ((guile (package->derivation guile system))) (mlet* %store-monad ((builtins (built-in-builders*))
(gexp->derivation (or name file-name) builder (download -> (if (member "download" builtins)
#:guile-for-build guile built-in-download
#:system system in-band-download)))
#:hash-algo hash-algo (download (or name file-name) url
#:hash hash #:guile guile
#:system system
;; Use environment variables and a fixed script #:hash-algo hash-algo
;; name so there's only one script in store for #:hash hash
;; all the downloads. #:mirrors %mirror-file
#:script-name "download" #:content-addressed-mirrors
#:env-vars %content-addressed-mirror-file)))))
`(("guix download url" . ,(object->string url))
("guix download hashes"
. ,(object->string `((,hash-algo . ,hash)))))
;; Honor the user's proxy settings.
#:leaked-env-vars '("http_proxy" "https_proxy")
;; In general, offloading downloads is not a good
;; idea. Daemons before 0.8.3 would also
;; interpret this as "do not substitute" (see
;; <https://bugs.gnu.org/18747>.)
#:local-build? #t)))))
(define* (url-fetch/tarbomb url hash-algo hash (define* (url-fetch/tarbomb url hash-algo hash
#:optional name #:optional name

3
guix/gexp.scm
View File

@ -453,9 +453,6 @@ whether this should be considered a \"native\" input or not."
'())) '()))
(gexp-references gexp))))) (gexp-references gexp)))))
(define raw-derivation
(store-lift derivation))
(define* (lower-inputs inputs (define* (lower-inputs inputs
#:key system target) #:key system target)
"Turn any package from INPUTS into a derivation for SYSTEM; return the "Turn any package from INPUTS into a derivation for SYSTEM; return the

4
guix/profiles.scm
View File

@ -501,10 +501,6 @@ if not found."
#t)))) #t))))
items)) items))
;; TODO: Factorize.
(define references*
(store-lift references))
(with-monad %store-monad (with-monad %store-monad
(match (manifest-entry-item entry) (match (manifest-entry-item entry)
((? package? package) ((? package? package)

58
guix/scripts/download.scm
View File

@ -23,12 +23,15 @@
#:use-module (guix hash) #:use-module (guix hash)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix download) #:use-module ((guix download) #:hide (url-fetch))
#:use-module ((guix build download) #:select (current-terminal-columns)) #:use-module ((guix build download)
#:use-module ((guix build syscalls) #:select (terminal-columns)) #:select (url-fetch current-terminal-columns))
#:use-module ((guix build syscalls)
#:select (terminal-columns))
#:use-module (web uri) #:use-module (web uri)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37) #:use-module (srfi srfi-37)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports) #:use-module (ice-9 binary-ports)
@ -39,15 +42,31 @@
;;; Command-line options. ;;; Command-line options.
;;; ;;;
(define (download-to-file url file)
"Download the file at URI to FILE. Return FILE."
(let ((uri (string->uri url)))
(match (uri-scheme uri)
((or 'file #f)
(copy-file (uri-path uri) file))
(_
(url-fetch url file)))
file))
(define* (download-to-store* url #:key (verify-certificate? #t))
(with-store store
(download-to-store store url
#:verify-certificate? verify-certificate?)))
(define %default-options (define %default-options
;; Alist of default option values. ;; Alist of default option values.
`((format . ,bytevector->nix-base32-string) `((format . ,bytevector->nix-base32-string)
(verify-certificate? . #t))) (verify-certificate? . #t)
(download-proc . ,download-to-store*)))
(define (show-help) (define (show-help)
(display (_ "Usage: guix download [OPTION] URL (display (_ "Usage: guix download [OPTION] URL
Download the file at URL, add it to the store, and print its store path Download the file at URL to the store or to the given file, and print its
and the hash of its contents. file name and the hash of its contents.
Supported formats: 'nix-base32' (default), 'base32', and 'base16' Supported formats: 'nix-base32' (default), 'base32', and 'base16'
('hex' and 'hexadecimal' can be used as well).\n")) ('hex' and 'hexadecimal' can be used as well).\n"))
@ -56,6 +75,8 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
(format #t (_ " (format #t (_ "
--no-check-certificate --no-check-certificate
do not validate the certificate of HTTPS servers ")) do not validate the certificate of HTTPS servers "))
(format #f (_ "
-o, --output=FILE download to FILE"))
(newline) (newline)
(display (_ " (display (_ "
-h, --help display this help and exit")) -h, --help display this help and exit"))
@ -84,6 +105,12 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
(option '("no-check-certificate") #f #f (option '("no-check-certificate") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'verify-certificate? #f result))) (alist-cons 'verify-certificate? #f result)))
(option '(#\o "output") #t #f
(lambda (opt name arg result)
(alist-cons 'download-proc
(lambda* (url #:key verify-certificate?)
(download-to-file url arg))
(alist-delete 'download result))))
(option '(#\h "help") #f #f (option '(#\h "help") #f #f
(lambda args (lambda args
@ -113,24 +140,17 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
(with-error-handling (with-error-handling
(let* ((opts (parse-options)) (let* ((opts (parse-options))
(store (open-connection))
(arg (or (assq-ref opts 'argument) (arg (or (assq-ref opts 'argument)
(leave (_ "no download URI was specified~%")))) (leave (_ "no download URI was specified~%"))))
(uri (or (string->uri arg) (uri (or (string->uri arg)
(leave (_ "~a: failed to parse URI~%") (leave (_ "~a: failed to parse URI~%")
arg))) arg)))
(path (case (uri-scheme uri) (fetch (assq-ref opts 'download-proc))
((file) (path (parameterize ((current-terminal-columns
(add-to-store store (basename (uri-path uri)) (terminal-columns)))
#f "sha256" (uri-path uri))) (fetch arg
(else #:verify-certificate?
(parameterize ((current-terminal-columns (assq-ref opts 'verify-certificate?))))
(terminal-columns)))
(download-to-store store (uri->string uri)
(basename (uri-path uri))
#:verify-certificate?
(assoc-ref opts
'verify-certificate?))))))
(hash (call-with-input-file (hash (call-with-input-file
(or path (or path
(leave (_ "~a: download failed~%") (leave (_ "~a: download failed~%")

43
guix/scripts/lint.scm
View File

@ -67,6 +67,7 @@
check-home-page check-home-page
check-source check-source
check-source-file-name check-source-file-name
check-mirror-url
check-license check-license
check-vulnerabilities check-vulnerabilities
check-formatting check-formatting
@ -600,6 +601,14 @@ descriptions maintained upstream."
(location->string loc) (package-full-name package) (location->string loc) (package-full-name package)
(fill-paragraph (escape-quotes upstream) 77 7))))))) (fill-paragraph (escape-quotes upstream) 77 7)))))))
(define (origin-uris origin)
"Return the list of URIs (strings) for ORIGIN."
(match (origin-uri origin)
((? string? uri)
(list uri))
((uris ...)
uris)))
(define (check-source package) (define (check-source package)
"Emit a warning if PACKAGE has an invalid 'source' field, or if that "Emit a warning if PACKAGE has an invalid 'source' field, or if that
'source' is not reachable." 'source' is not reachable."
@ -616,10 +625,7 @@ descriptions maintained upstream."
(let ((origin (package-source package))) (let ((origin (package-source package)))
(when (and origin (when (and origin
(eqv? (origin-method origin) url-fetch)) (eqv? (origin-method origin) url-fetch))
(let* ((strings (origin-uri origin)) (let ((uris (map string->uri (origin-uris origin))))
(uris (if (list? strings)
(map string->uri strings)
(list (string->uri strings)))))
;; Just make sure that at least one of the URIs is valid. ;; Just make sure that at least one of the URIs is valid.
(call-with-values (call-with-values
@ -659,6 +665,31 @@ descriptions maintained upstream."
(_ "the source file name should contain the package name") (_ "the source file name should contain the package name")
'source)))) 'source))))
(define (check-mirror-url package)
"Check whether PACKAGE uses source URLs that should be 'mirror://'."
(define (check-mirror-uri uri) ;XXX: could be optimized
(let loop ((mirrors %mirrors))
(match mirrors
(()
#t)
(((mirror-id mirror-urls ...) rest ...)
(match (find (cut string-prefix? <> uri) mirror-urls)
(#f
(loop rest))
(prefix
(emit-warning package
(format #f (_ "URL should be \
'mirror://~a/~a'")
mirror-id
(string-drop uri (string-length prefix)))
'source)))))))
(let ((origin (package-source package)))
(when (and (origin? origin)
(eqv? (origin-method origin) url-fetch))
(let ((uris (origin-uris origin)))
(for-each check-mirror-uri uris)))))
(define (check-derivation package) (define (check-derivation package)
"Emit a warning if we fail to compile PACKAGE to a derivation." "Emit a warning if we fail to compile PACKAGE to a derivation."
(catch #t (catch #t
@ -900,6 +931,10 @@ or a list thereof")
(name 'source) (name 'source)
(description "Validate source URLs") (description "Validate source URLs")
(check check-source)) (check check-source))
(lint-checker
(name 'mirror-url)
(description "Suggest 'mirror://' URLs")
(check check-mirror-url))
(lint-checker (lint-checker
(name 'source-file-name) (name 'source-file-name)
(description "Validate file names of sources") (description "Validate file names of sources")

113
guix/scripts/perform-download.scm Normal file
View File

@ -0,0 +1,113 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts perform-download)
#:use-module (guix ui)
#:use-module (guix derivations)
#:use-module ((guix store) #:select (derivation-path?))
#:use-module (guix build download)
#:use-module (ice-9 match)
#:export (guix-perform-download))
;; This program is a helper for the daemon's 'download' built-in builder.
(define-syntax derivation-let
(syntax-rules ()
((_ drv ((id name) rest ...) body ...)
(let ((id (assoc-ref (derivation-builder-environment-vars drv)
name)))
(derivation-let drv (rest ...) body ...)))
((_ drv () body ...)
(begin body ...))))
(define %user-module
;; Module in which content-address mirror procedures are evaluated.
(let ((module (make-fresh-user-module)))
(module-use! module (resolve-interface '(guix base32)))
module))
(define (perform-download drv)
"Perform the download described by DRV, a fixed-output derivation."
(derivation-let drv ((url "url")
(output "out")
(executable "executable")
(mirrors "mirrors")
(content-addressed-mirrors "content-addressed-mirrors"))
(unless url
(leave (_ "~a: missing URL~%") (derivation-file-name drv)))
(let* ((url (call-with-input-string url read))
(drv-output (assoc-ref (derivation-outputs drv) "out"))
(algo (derivation-output-hash-algo drv-output))
(hash (derivation-output-hash drv-output)))
(unless (and algo hash)
(leave (_ "~a is not a fixed-output derivation~%")
(derivation-file-name drv)))
;; We're invoked by the daemon, which gives us write access to OUTPUT.
(when (url-fetch url output
#:mirrors (if mirrors
(call-with-input-file mirrors read)
'())
#:content-addressed-mirrors
(if content-addressed-mirrors
(call-with-input-file content-addressed-mirrors
(lambda (port)
(eval (read port) %user-module)))
'())
#:hashes `((,algo . ,hash))
;; Since DRV's output hash is known, X.509 certificate
;; validation is pointless.
#:verify-certificate? #f)
(when (and executable (string=? executable "1"))
(chmod output #o755))))))
(define (assert-low-privileges)
(when (zero? (getuid))
(leave (_ "refusing to run with elevated privileges (UID ~a)~%")
(getuid))))
(define (guix-perform-download . args)
"Perform the download described by the given fixed-output derivation.
This is an \"out-of-band\" download in that this code is executed directly by
the daemon and not explicitly described as an input of the derivation. This
allows us to sidestep bootstrapping problems, such downloading the source code
of GnuTLS over HTTPS, before we have built GnuTLS. See
<http://bugs.gnu.org/22774>."
(with-error-handling
(match args
(((? derivation-path? drv))
;; This program must be invoked by guix-daemon under an unprivileged
;; UID to prevent things downloading from 'file:///etc/shadow' or
;; arbitrary code execution via the content-addressed mirror
;; procedures. (That means we exclude users who did not pass
;; '--build-users-group'.)
(assert-low-privileges)
(perform-download (call-with-input-file drv read-derivation)))
(("--version")
(show-version-and-exit))
(x
(leave (_ "fixed-output derivation name expected~%"))))))
;; Local Variables:
;; eval: (put 'derivation-let 'scheme-indent-function 2)
;; End:
;; perform-download.scm ends here

3
guix/scripts/system.scm
View File

@ -77,9 +77,6 @@
;;; Installation. ;;; Installation.
;;; ;;;
;; TODO: Factorize.
(define references*
(store-lift references))
(define topologically-sorted* (define topologically-sorted*
(store-lift topologically-sorted)) (store-lift topologically-sorted))

29
guix/store.scm
View File

@ -95,8 +95,10 @@
path-info-registration-time path-info-registration-time
path-info-nar-size path-info-nar-size
built-in-builders
references references
references/substitutes references/substitutes
references*
requisites requisites
referrers referrers
optimize-store optimize-store
@ -187,7 +189,8 @@
(query-substitutable-paths 32) (query-substitutable-paths 32)
(query-valid-derivers 33) (query-valid-derivers 33)
(optimize-store 34) (optimize-store 34)
(verify-store 35)) (verify-store 35)
(built-in-builders 80))
(define-enumerate-type hash-algo (define-enumerate-type hash-algo
;; hash.hh ;; hash.hh
@ -283,7 +286,7 @@
(write-string (bytevector->base16-string arg) p)))) (write-string (bytevector->base16-string arg) p))))
(define-syntax read-arg (define-syntax read-arg
(syntax-rules (integer boolean string store-path store-path-list (syntax-rules (integer boolean string store-path store-path-list string-list
substitutable-path-list path-info base16) substitutable-path-list path-info base16)
((_ integer p) ((_ integer p)
(read-int p)) (read-int p))
@ -295,6 +298,8 @@
(read-store-path p)) (read-store-path p))
((_ store-path-list p) ((_ store-path-list p)
(read-store-path-list p)) (read-store-path-list p))
((_ string-list p)
(read-string-list p))
((_ substitutable-path-list p) ((_ substitutable-path-list p)
(read-substitutable-path-list p)) (read-substitutable-path-list p))
((_ path-info p) ((_ path-info p)
@ -914,6 +919,23 @@ that there is no guarantee that the order of the resulting list matches the
order of PATHS." order of PATHS."
substitutable-path-list)) substitutable-path-list))
(define built-in-builders
(let ((builders (operation (built-in-builders)
"Return the built-in builders."
string-list)))
(lambda (store)
"Return the names of the supported built-in derivation builders
supported by STORE."
;; Check whether STORE's version supports this RPC and built-in
;; derivation builders in general, which appeared in Guix > 0.11.0.
;; Return the empty list if it doesn't. Note that this RPC does not
;; exist in 'nix-daemon'.
(if (or (> (nix-server-major-version store) #x100)
(and (= (nix-server-major-version store) #x100)
(>= (nix-server-minor-version store) #x60)))
(builders store)
'()))))
(define-operation (optimize-store) (define-operation (optimize-store)
"Optimize the store by hard-linking identical files (\"deduplication\".) "Optimize the store by hard-linking identical files (\"deduplication\".)
Return #t on success." Return #t on success."
@ -1149,6 +1171,9 @@ where FILE is the entry's absolute file name and STAT is the result of
(define set-build-options* (define set-build-options*
(store-lift set-build-options)) (store-lift set-build-options))
(define references*
(store-lift references))
(define-inlinable (current-system) (define-inlinable (current-system)
;; Consult the %CURRENT-SYSTEM fluid at bind time. This is equivalent to ;; Consult the %CURRENT-SYSTEM fluid at bind time. This is equivalent to
;; (lift0 %current-system %store-monad), but inlinable, thus avoiding ;; (lift0 %current-system %store-monad), but inlinable, thus avoiding

120
guix/tests/http.scm Normal file
View File

@ -0,0 +1,120 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix tests http)
#:use-module (ice-9 threads)
#:use-module (web server)
#:use-module (web server http)
#:use-module (web response)
#:use-module (srfi srfi-39)
#:export (with-http-server
call-with-http-server
%http-server-port
%http-server-socket
%local-url))
;;; Commentary:
;;;
;;; Code to spawn a Web server for testing purposes.
;;;
;;; Code:
(define %http-server-port
;; TCP port to use for the stub HTTP server.
(make-parameter 9999))
(define (%local-url)
;; URL to use for 'home-page' tests.
(string-append "http://localhost:" (number->string (%http-server-port))
"/foo/bar"))
(define %http-server-socket
;; Listening socket for the web server. It is useful to export it so that
;; tests can check whether we succeeded opening the socket and tests skip if
;; needed.
(delay
(catch 'system-error
(lambda ()
(let ((sock (socket PF_INET SOCK_STREAM 0)))
(setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
(bind sock
(make-socket-address AF_INET INADDR_LOOPBACK
(%http-server-port)))
sock))
(lambda args
(let ((err (system-error-errno args)))
(format (current-error-port)
"warning: cannot run Web server for tests: ~a~%"
(strerror err))
#f)))))
(define (http-write server client response body)
"Write RESPONSE."
(let* ((response (write-response response client))
(port (response-port response)))
(cond
((not body)) ;pass
(else
(write-response-body response body)))
(close-port port)
(quit #t) ;exit the server thread
(values)))
;; Mutex and condition variable to synchronize with the HTTP server.
(define %http-server-lock (make-mutex))
(define %http-server-ready (make-condition-variable))
(define (http-open . args)
"Start listening for HTTP requests and signal %HTTP-SERVER-READY."
(with-mutex %http-server-lock
(let ((result (apply (@@ (web server http) http-open) args)))
(signal-condition-variable %http-server-ready)
result)))
(define-server-impl stub-http-server
;; Stripped-down version of Guile's built-in HTTP server.
http-open
(@@ (web server http) http-read)
http-write
(@@ (web server http) http-close))
(define (call-with-http-server code data thunk)
"Call THUNK with an HTTP server running and returning CODE and DATA (a
string) on HTTP requests."
(define (server-body)
(define (handle request body)
(values (build-response #:code code
#:reason-phrase "Such is life")
data))
(catch 'quit
(lambda ()
(run-server handle stub-http-server
`(#:socket ,(force %http-server-socket))))
(const #t)))
(with-mutex %http-server-lock
(let ((server (make-thread server-body)))
(wait-condition-variable %http-server-ready %http-server-lock)
;; Normally SERVER exits automatically once it has received a request.
(thunk))))
(define-syntax-rule (with-http-server code data body ...)
(call-with-http-server code data (lambda () body ...)))
;;; http.scm ends here

6
guix/ui.scm
View File

@ -1094,7 +1094,8 @@ DURATION-RELATION with the current time."
(removed (lset-difference (removed (lset-difference
equal-entry? (list-entries old) (list-entries new)))) equal-entry? (list-entries old) (list-entries new))))
(for-each (cut display-entry <> "+") added) (for-each (cut display-entry <> "+") added)
(for-each (cut display-entry <> "-") removed))) (for-each (cut display-entry <> "-") removed)
(newline)))
(display-diff profile gen1 gen2)) (display-diff profile gen1 gen2))
@ -1184,7 +1185,8 @@ optionally contain a version number and an output name, as in these examples:
(define (show-guix-help) (define (show-guix-help)
(define (internal? command) (define (internal? command)
(member command '("substitute" "authenticate" "offload"))) (member command '("substitute" "authenticate" "offload"
"perform-download")))
(format #t (_ "Usage: guix COMMAND ARGS... (format #t (_ "Usage: guix COMMAND ARGS...
Run COMMAND with ARGS.\n")) Run COMMAND with ARGS.\n"))

36
nix/libstore/build.cc
View File

@ -8,6 +8,7 @@
#include "util.hh" #include "util.hh"
#include "archive.hh" #include "archive.hh"
#include "affinity.hh" #include "affinity.hh"
#include "builtins.hh"
#include <map> #include <map>
#include <sstream> #include <sstream>
@ -2047,7 +2048,12 @@ void DerivationGoal::runChild()
commonChildInit(builderOut); commonChildInit(builderOut);
#if CHROOT_ENABLED #if CHROOT_ENABLED
if (useChroot) { /* Note: built-in builders are *not* running in a chroot environment
so that we can easily implement them in Guile without having it as
a derivation input (they are running under a separate build user,
though). */
if (useChroot && !isBuiltin(drv)) {
/* Initialise the loopback interface. */ /* Initialise the loopback interface. */
AutoCloseFD fd(socket(PF_INET, SOCK_DGRAM, IPPROTO_IP)); AutoCloseFD fd(socket(PF_INET, SOCK_DGRAM, IPPROTO_IP));
if (fd == -1) throw SysError("cannot open IP socket"); if (fd == -1) throw SysError("cannot open IP socket");
@ -2255,6 +2261,28 @@ void DerivationGoal::runChild()
throw SysError("setuid failed"); throw SysError("setuid failed");
} }
restoreSIGPIPE();
/* Indicate that we managed to set up the build environment. */
writeFull(STDERR_FILENO, "\n");
/* Execute the program. This should not return. */
if (isBuiltin(drv)) {
try {
logType = ltFlat;
auto buildDrv = lookupBuiltinBuilder(drv.builder);
if (buildDrv != NULL)
buildDrv(drv, drvPath);
else
throw Error(format("unsupported builtin function '%1%'") % string(drv.builder, 8));
_exit(0);
} catch (std::exception & e) {
writeFull(STDERR_FILENO, "error: " + string(e.what()) + "\n");
_exit(1);
}
}
/* Fill in the arguments. */ /* Fill in the arguments. */
Strings args; Strings args;
string builderBasename = baseNameOf(drv.builder); string builderBasename = baseNameOf(drv.builder);
@ -2262,12 +2290,6 @@ void DerivationGoal::runChild()
foreach (Strings::iterator, i, drv.args) foreach (Strings::iterator, i, drv.args)
args.push_back(rewriteHashes(*i, rewritesToTmp)); args.push_back(rewriteHashes(*i, rewritesToTmp));
restoreSIGPIPE();
/* Indicate that we managed to set up the build environment. */
writeFull(STDERR_FILENO, "\n");
/* Execute the program. This should not return. */
execve(drv.builder.c_str(), stringsToCharPtrs(args).data(), stringsToCharPtrs(envStrs).data()); execve(drv.builder.c_str(), stringsToCharPtrs(args).data(), stringsToCharPtrs(envStrs).data());
throw SysError(format("executing `%1%'") % drv.builder); throw SysError(format("executing `%1%'") % drv.builder);

79
nix/libstore/builtins.cc Normal file
View File

@ -0,0 +1,79 @@
/* GNU Guix --- Functional package management for GNU
Copyright (C) 2016 Ludovic Courtès <ludo@gnu.org>
This file is part of GNU Guix.
GNU Guix is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or (at
your option) any later version.
GNU Guix is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. */
#include <builtins.hh>
#include <util.hh>
#include <globals.hh>
#include <unistd.h>
namespace nix {
static void builtinDownload(const Derivation &drv,
const std::string &drvPath)
{
/* Invoke 'guix perform-download'. */
Strings args;
args.push_back("perform-download");
args.push_back(drvPath);
/* Close all other file descriptors. */
closeMostFDs(set<int>());
const char *const argv[] = { "download", drvPath.c_str(), NULL };
/* XXX: Hack our way to use the 'download' script from 'LIBEXECDIR/guix'
or just 'LIBEXECDIR', depending on whether we're running uninstalled or
not. */
const string subdir = getenv("GUIX_UNINSTALLED") != NULL
? "" : "/guix";
const string program = settings.nixLibexecDir + subdir + "/download";
execv(program.c_str(), (char *const *) argv);
throw SysError(format("failed to run download program '%1%'") % program);
}
static const std::map<std::string, derivationBuilder> builtins =
{
{ "download", builtinDownload }
};
derivationBuilder lookupBuiltinBuilder(const std::string & name)
{
if (name.substr(0, 8) == "builtin:")
{
auto realName = name.substr(8);
auto builder = builtins.find(realName);
return builder == builtins.end() ? NULL : builder->second;
}
else
return NULL;
}
std::list<std::string> builtinBuilderNames()
{
std::list<std::string> result;
for(auto&& iter: builtins)
{
result.push_back(iter.first);
}
return result;
}
}

44
nix/libstore/builtins.hh Normal file
View File

@ -0,0 +1,44 @@
/* GNU Guix --- Functional package management for GNU
Copyright (C) 2016 Ludovic Courtès <ludo@gnu.org>
This file is part of GNU Guix.
GNU Guix is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or (at
your option) any later version.
GNU Guix is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. */
/* Interface to built-in derivation builders. */
#pragma once
#include <derivations.hh>
#include <map>
#include <string>
namespace nix {
inline bool isBuiltin(const Derivation & drv)
{
return string(drv.builder, 0, 8) == "builtin:";
}
/* Build DRV, which lives at DRVPATH. */
typedef void (*derivationBuilder) (const Derivation &drv,
const std::string &drvPath);
/* Return the built-in builder called BUILDER, or NULL if none was
found. */
derivationBuilder lookupBuiltinBuilder(const std::string &builder);
/* Return the list of supported built-in builder names. */
std::list<std::string> builtinBuilderNames();
}

5
nix/libstore/worker-protocol.hh
View File

@ -6,7 +6,7 @@ namespace nix {
#define WORKER_MAGIC_1 0x6e697863 #define WORKER_MAGIC_1 0x6e697863
#define WORKER_MAGIC_2 0x6478696f #define WORKER_MAGIC_2 0x6478696f
#define PROTOCOL_VERSION 0x10f #define PROTOCOL_VERSION 0x160
#define GET_PROTOCOL_MAJOR(x) ((x) & 0xff00) #define GET_PROTOCOL_MAJOR(x) ((x) & 0xff00)
#define GET_PROTOCOL_MINOR(x) ((x) & 0x00ff) #define GET_PROTOCOL_MINOR(x) ((x) & 0x00ff)
@ -43,7 +43,8 @@ typedef enum {
wopQuerySubstitutablePaths = 32, wopQuerySubstitutablePaths = 32,
wopQueryValidDerivers = 33, wopQueryValidDerivers = 33,
wopOptimiseStore = 34, wopOptimiseStore = 34,
wopVerifyStore = 35 wopVerifyStore = 35,
wopBuiltinBuilders = 80
} WorkerOp; } WorkerOp;

Some files were not shown because too many files have changed in this diff Show More