Merge branch 'master' into core-updates

This commit is contained in:
Marius Bakke 2017-07-28 00:34:13 +02:00
commit e0b9e377f1
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
47 changed files with 1182 additions and 384 deletions

View File

@ -171,6 +171,7 @@ MODULES = \
guix/scripts/import/texlive.scm \ guix/scripts/import/texlive.scm \
guix/scripts/environment.scm \ guix/scripts/environment.scm \
guix/scripts/publish.scm \ guix/scripts/publish.scm \
guix/scripts/weather.scm \
guix/scripts/edit.scm \ guix/scripts/edit.scm \
guix/scripts/size.scm \ guix/scripts/size.scm \
guix/scripts/graph.scm \ guix/scripts/graph.scm \

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -43,13 +43,10 @@
(use-modules (guix store) (use-modules (guix store)
(guix packages) (guix packages)
(guix utils) (guix utils)
(guix grafts)
(guix derivations) (guix derivations)
(guix build-system gnu) (guix build-system gnu)
(gnu packages version-control)
(gnu packages package-management) (gnu packages package-management)
(gnu packages imagemagick)
(gnu packages graphviz)
(gnu packages man)
(srfi srfi-1) (srfi srfi-1)
(srfi srfi-26) (srfi srfi-26)
(ice-9 match)) (ice-9 match))
@ -63,36 +60,15 @@
#:optional (package-derivation package-derivation)) #:optional (package-derivation package-derivation))
"Convert PACKAGE to an alist suitable for Hydra." "Convert PACKAGE to an alist suitable for Hydra."
`((derivation . ,(derivation-file-name `((derivation . ,(derivation-file-name
(package-derivation store package system))) (parameterize ((%graft? #f))
(package-derivation store package system
#:graft? #f))))
(description . ,(package-synopsis package)) (description . ,(package-synopsis package))
(long-description . ,(package-description package)) (long-description . ,(package-description package))
(license . ,(package-license package)) (license . ,(package-license package))
(home-page . ,(package-home-page package)) (home-page . ,(package-home-page package))
(maintainers . ("bug-guix@gnu.org")))) (maintainers . ("bug-guix@gnu.org"))))
(define (tarball-package checkout)
"Return a package that does `make distcheck' from CHECKOUT, a directory
containing a Git checkout of Guix."
(let ((guix (@@ (gnu packages package-management) guix)))
(dist-package (package
(inherit guix)
(arguments (package-arguments guix))
(native-inputs `(("imagemagick" ,imagemagick)
,@(package-native-inputs guix))))
checkout
#:phases
'(modify-phases %dist-phases
(add-before 'build 'build-daemon
;; Build 'guix-daemon' first so that help2man
;; successfully creates 'guix-daemon.1'.
(lambda _
(let ((n (number->string
(parallel-job-count))))
(zero? (system* "make"
"nix/libstore/schema.sql.hh"
"guix-daemon" "-j" n)))))))))
(define (hydra-jobs store arguments) (define (hydra-jobs store arguments)
"Return Hydra jobs." "Return Hydra jobs."
(define systems (define systems
@ -109,9 +85,22 @@ containing a Git checkout of Guix."
(define guix-checkout (define guix-checkout
(assq-ref arguments 'guix)) (assq-ref arguments 'guix))
(let ((guix (assq-ref guix-checkout 'file-name))) (let ((file (assq-ref guix-checkout 'file-name)))
(format (current-error-port) "using checkout ~s (~s)~%" (format (current-error-port) "using checkout ~s (~s)~%"
guix-checkout guix) guix-checkout file)
`((tarball . ,(cute package->alist store `((tarball . ,(cute package->alist store
(tarball-package guix) (dist-package guix file)
(%current-system)))))) (%current-system)))
,@(map (lambda (system)
(let ((name (string->symbol
(string-append "guix." system))))
`(,name
. ,(cute package->alist store
(package
(inherit guix)
(version "latest")
(source file))
system))))
%hydra-supported-systems))))

View File

@ -158,6 +158,7 @@ Utilities
* Invoking guix challenge:: Challenging substitute servers. * Invoking guix challenge:: Challenging substitute servers.
* Invoking guix copy:: Copying to and from a remote store. * Invoking guix copy:: Copying to and from a remote store.
* Invoking guix container:: Process isolation. * Invoking guix container:: Process isolation.
* Invoking guix weather:: Assessing substitute availability.
Invoking @command{guix build} Invoking @command{guix build}
@ -2201,6 +2202,9 @@ authenticates substitute information itself, as explained above, which
is what we care about (whereas X.509 certificates are about is what we care about (whereas X.509 certificates are about
authenticating bindings between domain names and public keys.) authenticating bindings between domain names and public keys.)
You can get statistics on the substitutes provided by a server using the
@command{guix weather} command (@pxref{Invoking guix weather}).
The substitute mechanism can be disabled globally by running The substitute mechanism can be disabled globally by running
@code{guix-daemon} with @code{--no-substitutes} (@pxref{Invoking @code{guix-daemon} with @code{--no-substitutes} (@pxref{Invoking
guix-daemon}). It can also be disabled temporarily by passing the guix-daemon}). It can also be disabled temporarily by passing the
@ -4933,6 +4937,7 @@ the Scheme programming interface of Guix in a convenient way.
* Invoking guix challenge:: Challenging substitute servers. * Invoking guix challenge:: Challenging substitute servers.
* Invoking guix copy:: Copying to and from a remote store. * Invoking guix copy:: Copying to and from a remote store.
* Invoking guix container:: Process isolation. * Invoking guix container:: Process isolation.
* Invoking guix weather:: Assessing substitute availability.
@end menu @end menu
@node Invoking guix build @node Invoking guix build
@ -6869,7 +6874,8 @@ serves them. This ``on-the-fly'' mode is convenient in that it requires
no setup and is immediately available. However, when serving lots of no setup and is immediately available. However, when serving lots of
clients, we recommend using the @option{--cache} option, which enables clients, we recommend using the @option{--cache} option, which enables
caching of the archives before they are sent to clients---see below for caching of the archives before they are sent to clients---see below for
details. details. The @command{guix weather} command provides a handy way to
check what a server provides (@pxref{Invoking guix weather}).
As a bonus, @command{guix publish} also serves as a content-addressed As a bonus, @command{guix publish} also serves as a content-addressed
mirror for source files referenced in @code{origin} records mirror for source files referenced in @code{origin} records
@ -7269,6 +7275,73 @@ must be PID 1 of the container or one of its child processes.
@end table @end table
@node Invoking guix weather
@section Invoking @command{guix weather}
Occasionally you're grumpy because substitutes are lacking and you end
up building packages by yourself (@pxref{Substitutes}). The
@command{guix weather} command reports on substitute availability on the
specified servers so you can have an idea of whether you'll be grumpy
today. It can sometimes be useful info as a user, but it is primarily
useful to people running @command{guix publish} (@pxref{Invoking guix
publish}).
@cindex statistics, for substitutes
@cindex availability of substitutes
@cindex substitute availability
@cindex weather, substitute availability
Here's a sample run:
@example
$ guix weather --substitute-urls=https://guix.example.org
computing 5,872 package derivations for x86_64-linux...
looking for 6,128 store items on https://guix.example.org..
updating list of substitutes from 'https://guix.example.org'... 100.0%
https://guix.example.org
43.4% substitutes available (2,658 out of 6,128)
7,032.5 MiB of nars (compressed)
19,824.2 MiB on disk (uncompressed)
0.030 seconds per request (182.9 seconds in total)
33.5 requests per second
@end example
As you can see, it reports the fraction of all the packages for which
substitutes are available on the server---regardless of whether
substitutes are enabled, and regardless of whether this server's signing
key is authorized. It also reports the size of the compressed archives
(``nars'') provided by the server, the size the corresponding store
items occupy in the store (assuming deduplication is turned off), and
the server's throughput.
To achieve that, @command{guix weather} queries over HTTP(S) meta-data
(@dfn{narinfos}) for all the relevant store items. Like @command{guix
challenge}, it ignores signatures on those substitutes, which is
innocuous since the command only gathers statistics and cannot install
those substitutes.
Among other things, it is possible to query specific system types and
specific package sets. The available options are listed below.
@table @code
@item --substitute-urls=@var{urls}
@var{urls} is the space-separated list of substitute server URLs to
query. When this option is omitted, the default set of substitute
servers is queried.
@item --system=@var{system}
@itemx -s @var{system}
Query substitutes for @var{system}---e.g., @code{aarch64-linux}. This
option can be repeated, in which case @command{guix weather} will query
substitutes for several system types.
@item --manifest=@var{file}
Instead of querying substitutes for all the packages, only ask for those
specified in @var{file}. @var{file} must contain a @dfn{manifest}, as
with the @code{-m} option of @command{guix package} (@pxref{Invoking
guix package}).
@end table
@c ********************************************************************* @c *********************************************************************
@node GNU Distribution @node GNU Distribution
@chapter GNU Distribution @chapter GNU Distribution
@ -13658,7 +13731,8 @@ Local accounts with lower values will silently fail to authenticate.
@cindex web @cindex web
@cindex www @cindex www
@cindex HTTP @cindex HTTP
The @code{(gnu services web)} module provides the following service: The @code{(gnu services web)} module provides the nginx web server and
also a fastcgi wrapper daemon.
@deffn {Scheme Procedure} nginx-service [#:nginx nginx] @ @deffn {Scheme Procedure} nginx-service [#:nginx nginx] @
[#:log-directory ``/var/log/nginx''] @ [#:log-directory ``/var/log/nginx''] @
@ -13810,6 +13884,56 @@ body of a named location block cannot contain location blocks.
@end table @end table
@end deftp @end deftp
@cindex fastcgi
@cindex fcgiwrap
FastCGI is an interface between the front-end and the back-end of a web
service. It is a somewhat legacy facility; new web services should
generally just talk HTTP between the front-end and the back-end.
However there are a number of back-end services such as PHP or the
optimized HTTP Git repository access that use FastCGI, so we have
support for it in Guix.
To use FastCGI, you configure the front-end web server (e.g., nginx) to
dispatch some subset of its requests to the fastcgi backend, which
listens on a local TCP or UNIX socket. There is an intermediary
@code{fcgiwrap} program that sits between the actual backend process and
the web server. The front-end indicates which backend program to run,
passing that information to the @code{fcgiwrap} process.
@defvr {Scheme Variable} fcgiwrap-service-type
A service type for the @code{fcgiwrap} FastCGI proxy.
@end defvr
@deftp {Data Type} fcgiwrap-configuration
Data type representing the configuration of the @code{fcgiwrap} serice.
This type has the following parameters:
@table @asis
@item @code{package} (default: @code{fcgiwrap})
The fcgiwrap package to use.
@item @code{socket} (default: @code{tcp:127.0.0.1:9000})
The socket on which the @code{fcgiwrap} process should listen, as a
string. Valid @var{socket} values include
@code{unix:@var{/path/to/unix/socket}},
@code{tcp:@var{dot.ted.qu.ad}:@var{port}} and
@code{tcp6:[@var{ipv6_addr}]:port}.
@item @code{user} (default: @code{fcgiwrap})
@itemx @code{group} (default: @code{fcgiwrap})
The user and group names, as strings, under which to run the
@code{fcgiwrap} process. The @code{fastcgi} service will ensure that if
the user asks for the specific user or group names @code{fcgiwrap} that
the corresponding user and/or group is present on the system.
It is possible to configure a FastCGI-backed web service to pass HTTP
authentication information from the front-end to the back-end, and to
allow @code{fcgiwrap} to run the back-end process as a corresponding
local user. To enable this capability on the back-end., run
@code{fcgiwrap} as the @code{root} user and group. Note that this
capability also has to be configured on the front-end as well.
@end table
@end deftp
@node DNS Services @node DNS Services
@subsubsection DNS Services @subsubsection DNS Services

View File

@ -270,7 +270,6 @@ GNU_SYSTEM_MODULES = \
%D%/packages/mes.scm \ %D%/packages/mes.scm \
%D%/packages/messaging.scm \ %D%/packages/messaging.scm \
%D%/packages/mingw.scm \ %D%/packages/mingw.scm \
%D%/packages/mg.scm \
%D%/packages/microcom.scm \ %D%/packages/microcom.scm \
%D%/packages/moe.scm \ %D%/packages/moe.scm \
%D%/packages/monitoring.scm \ %D%/packages/monitoring.scm \
@ -563,6 +562,7 @@ dist_patch_DATA = \
%D%/packages/patches/cyrus-sasl-CVE-2013-4122.patch \ %D%/packages/patches/cyrus-sasl-CVE-2013-4122.patch \
%D%/packages/patches/dblatex-remove-multirow.patch \ %D%/packages/patches/dblatex-remove-multirow.patch \
%D%/packages/patches/dbus-helper-search-path.patch \ %D%/packages/patches/dbus-helper-search-path.patch \
%D%/packages/patches/deja-dup-use-ref-keyword-for-iter.patch \
%D%/packages/patches/dfu-programmer-fix-libusb.patch \ %D%/packages/patches/dfu-programmer-fix-libusb.patch \
%D%/packages/patches/diffutils-gets-undeclared.patch \ %D%/packages/patches/diffutils-gets-undeclared.patch \
%D%/packages/patches/doc++-include-directives.patch \ %D%/packages/patches/doc++-include-directives.patch \
@ -578,7 +578,6 @@ dist_patch_DATA = \
%D%/packages/patches/emacs-source-date-epoch.patch \ %D%/packages/patches/emacs-source-date-epoch.patch \
%D%/packages/patches/eudev-rules-directory.patch \ %D%/packages/patches/eudev-rules-directory.patch \
%D%/packages/patches/evilwm-lost-focus-bug.patch \ %D%/packages/patches/evilwm-lost-focus-bug.patch \
%D%/packages/patches/evince-CVE-2017-1000083.patch \
%D%/packages/patches/exim-CVE-2017-1000369.patch \ %D%/packages/patches/exim-CVE-2017-1000369.patch \
%D%/packages/patches/fabric-tests.patch \ %D%/packages/patches/fabric-tests.patch \
%D%/packages/patches/fastcap-mulGlobal.patch \ %D%/packages/patches/fastcap-mulGlobal.patch \
@ -663,6 +662,7 @@ dist_patch_DATA = \
%D%/packages/patches/gspell-dash-test.patch \ %D%/packages/patches/gspell-dash-test.patch \
%D%/packages/patches/guile-1.8-cpp-4.5.patch \ %D%/packages/patches/guile-1.8-cpp-4.5.patch \
%D%/packages/patches/guile-2.2-default-utf8.patch \ %D%/packages/patches/guile-2.2-default-utf8.patch \
%D%/packages/patches/guile-bytestructures-name-clash.patch \
%D%/packages/patches/guile-default-utf8.patch \ %D%/packages/patches/guile-default-utf8.patch \
%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 \
@ -885,6 +885,7 @@ dist_patch_DATA = \
%D%/packages/patches/pcre2-CVE-2017-8786.patch \ %D%/packages/patches/pcre2-CVE-2017-8786.patch \
%D%/packages/patches/perl-file-path-CVE-2017-6512.patch \ %D%/packages/patches/perl-file-path-CVE-2017-6512.patch \
%D%/packages/patches/perl-autosplit-default-time.patch \ %D%/packages/patches/perl-autosplit-default-time.patch \
%D%/packages/patches/perl-dbd-mysql-CVE-2017-10788.patch \
%D%/packages/patches/perl-deterministic-ordering.patch \ %D%/packages/patches/perl-deterministic-ordering.patch \
%D%/packages/patches/perl-finance-quote-unuse-mozilla-ca.patch \ %D%/packages/patches/perl-finance-quote-unuse-mozilla-ca.patch \
%D%/packages/patches/perl-gd-options-passthrough-and-fontconfig.patch \ %D%/packages/patches/perl-gd-options-passthrough-and-fontconfig.patch \

View File

@ -661,14 +661,14 @@ network statistics collection, security monitoring, network debugging, etc.")
(define-public tcpdump (define-public tcpdump
(package (package
(name "tcpdump") (name "tcpdump")
(version "4.9.0") (version "4.9.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://www.tcpdump.org/release/tcpdump-" (uri (string-append "http://www.tcpdump.org/release/tcpdump-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0pjsxsy8l71i813sa934cwf1ryp9xbr7nxwsvnzavjdirchq3sga")))) "1wyqbg7bkmgqyslf1ns0xx9fcqi66hvcfm9nf77rl15jvvs8qi7r"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("libpcap" ,libpcap) (inputs `(("libpcap" ,libpcap)
("openssl" ,openssl))) ("openssl" ,openssl)))
@ -2169,7 +2169,7 @@ tool for remote execution and deployment.")
(("\"/etc/neofetch") (("\"/etc/neofetch")
(string-append "\"" out "/etc/neofetch")) (string-append "\"" out "/etc/neofetch"))
(("\"/usr/share/neofetch") (("\"/usr/share/neofetch")
(string-append "\"" out "/usr/share/neofetch")))) (string-append "\"" out "/share/neofetch"))))
#t)) #t))
(delete 'configure)))) (delete 'configure))))
(home-page "https://github.com/dylanaraps/neofetch") (home-page "https://github.com/dylanaraps/neofetch")
@ -2184,7 +2184,7 @@ you are running, what theme or icon set you are using, etc.")
(define-public nnn (define-public nnn
(package (package
(name "nnn") (name "nnn")
(version "1.2") (version "1.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/jarun/nnn/" (uri (string-append "https://github.com/jarun/nnn/"
@ -2192,7 +2192,7 @@ you are running, what theme or icon set you are using, etc.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"08l0wcwwsl5kix9kg3h51s2afzg97y1rjjfi0ijs294kz57g1cfq")))) "0sivgcmg3hihz15v2wgbxnd0icn06pyvvqdqh8x0mwkhvm434fpb"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("ncurses" ,ncurses) (inputs `(("ncurses" ,ncurses)
("readline" ,readline))) ("readline" ,readline)))

View File

@ -74,7 +74,7 @@
(define-public nss-certs (define-public nss-certs
(package (package
(name "nss-certs") (name "nss-certs")
(version "3.31") (version "3.32")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (let ((version-with-underscores (uri (let ((version-with-underscores
@ -85,7 +85,7 @@
"nss-" version ".tar.gz"))) "nss-" version ".tar.gz")))
(sha256 (sha256
(base32 (base32
"0pd643a8ns7q5az5ai3ascrw666i2kbfiyy1c9hlhw9jd8jn21g9")))) "0dfkgvah0ji8b8lpxyy2w0b3lyz5ldmryii4z7j2bfwnrj0z7iim"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out")) (outputs '("out"))
(native-inputs (native-inputs

View File

@ -474,6 +474,36 @@ more than bzip2, which makes it well suited for software distribution and data
archiving. Lzip is a clean implementation of the LZMA algorithm.") archiving. Lzip is a clean implementation of the LZMA algorithm.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public lziprecover
(package
(name "lziprecover")
(version "1.19")
(source (origin
(method url-fetch)
(uri (string-append "mirror://savannah/lzip/" name "/"
name "-" version ".tar.gz"))
(sha256
(base32
"0z5fbkm0qprypjf7kxkqganniibj0zml13zvfkrchnjafcmmzyld"))))
(build-system gnu-build-system)
(home-page "http://www.nongnu.org/lzip/lziprecover.html")
(synopsis "Recover and decompress data from damaged lzip files")
(description
"Lziprecover is a data recovery tool and decompressor for files in the lzip
compressed data format (.lz). It can test the integrity of lzip files, extract
data from damaged ones, and repair most files with small errors (up to one
single-byte error per member) entirely.
Lziprecover is not a replacement for regular backups, but a last line of defence
when even the backups are corrupt. It can recover files by merging the good
parts of two or more damaged copies, such as can be easily produced by running
@command{ddrescue} on a failing device.
This package also includes @command{unzcrash}, a tool to test the robustness of
decompressors when faced with corrupted input.")
(license (list license:bsd-2 ; arg_parser.{cc,h}
license:gpl2+)))) ; everything else
(define-public sharutils (define-public sharutils
(package (package
(name "sharutils") (name "sharutils")

View File

@ -339,14 +339,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.17.6") (version "3.17.7")
(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
"0zhhnp3ksd9i2maaqrsjn4p3y7im3llgylp2y8qgmqypm8s7ha40")))) "03a0vkbrzvgj15il9rvr93kf5pc706gxcjk6akbkzds0zmdbsxrm"))))
(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")

View File

@ -1015,7 +1015,8 @@ columns, primary keys, unique constraints and relationships.")
"DBD-mysql-" version ".tar.gz")) "DBD-mysql-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"16bg7l28n65ngi1abjxvwk906a80i2vd5vzjn812dx8phdg8d7v2")))) "16bg7l28n65ngi1abjxvwk906a80i2vd5vzjn812dx8phdg8d7v2"))
(patches (search-patches "perl-dbd-mysql-CVE-2017-10788.patch"))))
(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))

View File

@ -90,7 +90,7 @@ tables. It includes a library and command-line utility.")
(define-public fdisk (define-public fdisk
(package (package
(name "fdisk") (name "fdisk")
(version "2.0.0a") (version "2.0.0a1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -98,13 +98,27 @@ tables. It includes a library and command-line utility.")
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"04nd7civ561x2lwcmxhsqbprml3178jfc58fy1v7hzqg5k4nbhy3")))) "1d8za79kw8ihnp2br084rgyjv9whkwp7957rzw815i0izx6xhqy9"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("gettext" ,gettext-minimal) `(("gettext" ,gettext-minimal)
("guile" ,guile-1.8) ("guile" ,guile-1.8)
("util-linux" ,util-linux) ("util-linux" ,util-linux)
("parted" ,parted))) ("parted" ,parted)))
;; The build neglects to look for its own headers in its own tree. A next
;; release should fix this, but may never come: GNU fdisk looks abandoned.
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'skip-broken-header-probes
(lambda _
(substitute* "backend/configure"
(("gnufdisk-common.h .*") "\n"))
#t)))
#:make-flags (list (string-append "CPPFLAGS="
" -I../common/include "
" -I../debug/include "
" -I../exception/include"))))
(home-page "https://www.gnu.org/software/fdisk/") (home-page "https://www.gnu.org/software/fdisk/")
(synopsis "Low-level disk partitioning and formatting") (synopsis "Low-level disk partitioning and formatting")
(description (description
@ -245,7 +259,7 @@ and a @command{fsck.vfat} compatibility symlink for use in an initrd.")
(define-public sdparm (define-public sdparm
(package (package
(name "sdparm") (name "sdparm")
(version "1.09") (version "1.10")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -253,7 +267,7 @@ and a @command{fsck.vfat} compatibility symlink for use in an initrd.")
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0jakqyjwi72zqjzss04bally0xl0lc4710mx8da08vpmir1hfphg")))) "1jjq3lzgfy4r76rc26q02lv4wm5cb4dx5nh913h489zjrr4f3jbx"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(home-page "http://sg.danny.cz/sg/sdparm.html") (home-page "http://sg.danny.cz/sg/sdparm.html")
(synopsis "Provide access to SCSI device parameters") (synopsis "Provide access to SCSI device parameters")

View File

@ -7,7 +7,7 @@
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017 Kei Kebreau <kei@openmailbox.org> ;;; Copyright © 2016, 2017 Kei Kebreau <kei@openmailbox.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Julian Graham <joolean@gmail.com> ;;; Copyright © 2016, 2017 Julian Graham <joolean@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -209,26 +209,15 @@ necessary.
(define-public gzochi (define-public gzochi
(package (package
(name "gzochi") (name "gzochi")
(version "0.10.1") (version "0.11.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://savannah/gzochi/gzochi-" (uri (string-append "mirror://savannah/gzochi/gzochi-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"166rawdal45kvanhvi0bkzy1d2pwf1p0lzslb287lcnm9vdw97yy")))) "13j1m92zhxwkaaja3lg5x0h0b28mrrawdzk9d3hd19031akfxwb3"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments
'(#:phases (modify-phases %standard-phases
(add-before 'configure 'remove-Werror
(lambda _
;; We can't build with '-Werror', notably
;; because deprecated functions of
;; libmicrohttpd are being used.
(substitute* (find-files "." "^Makefile\\.in$")
(("-Werror")
""))
#t)))))
(native-inputs `(("pkgconfig" ,pkg-config))) (native-inputs `(("pkgconfig" ,pkg-config)))
(inputs `(("bdb" ,bdb) (inputs `(("bdb" ,bdb)
("glib" ,glib) ("glib" ,glib)

View File

@ -242,6 +242,44 @@ giant insects to killer robots and things far stranger and deadlier, and against
the others like yourself, that want what you have.") the others like yourself, that want what you have.")
(license license:cc-by-sa3.0))) (license license:cc-by-sa3.0)))
(define-public cowsay
(package
(name "cowsay")
(version "3.03")
(source (origin
(method url-fetch)
(uri (string-append "https://web.archive.org/web/20071026043648/"
"http://www.nog.net:80/~tony/warez/"
"cowsay-" version ".tar.gz"))
(sha256
(base32
"1bxj802na2si2bk5zh7n0b7c33mg8a5n2wnvh0vihl9bmjkp51hb"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(delete 'configure)
(delete 'install)
(replace 'build
(lambda* (#:key outputs #:allow-other-keys)
(zero? (system* "sh" "install.sh"
(assoc-ref outputs "out")))))
(replace 'check
(lambda* (#:key outputs #:allow-other-keys)
(zero? (system* (string-append (assoc-ref outputs "out")
"/bin/cowsay")
"We're done!")))))))
(inputs
`(("perl" ,perl)))
(home-page (string-append "https://web.archive.org/web/20071026043648/"
"http://www.nog.net:80/~tony/warez/"))
(synopsis "Speaking cow text filter")
(description "Cowsay is basically a text filter. Send some text into it,
and you get a cow saying your text. If you think a talking cow isn't enough,
cows can think too. All you have to do is run @code{cowthink}.")
;; Any version of the GPL.
(license license:gpl3+)))
(define-public freedoom (define-public freedoom
(package (package
(name "freedoom") (name "freedoom")
@ -725,7 +763,7 @@ asynchronously and at a user-defined speed.")
(define-public chess (define-public chess
(package (package
(name "chess") (name "chess")
(version "6.2.4") (version "6.2.5")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -733,7 +771,7 @@ asynchronously and at a user-defined speed.")
".tar.gz")) ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1vw2w3jwnmn44d5vsw47f8y70xvxcsz9m5msq9fgqlzjch15qhiw")))) "00j8s0npgfdi41a0mr5w9qbdxagdk2v41lcr42rwl1jp6miyk6cs"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(home-page "https://www.gnu.org/software/chess/") (home-page "https://www.gnu.org/software/chess/")
(synopsis "Full chess implementation") (synopsis "Full chess implementation")

View File

@ -61,6 +61,7 @@
#:use-module (gnu packages bison) #:use-module (gnu packages bison)
#:use-module (gnu packages calendar) #:use-module (gnu packages calendar)
#:use-module (gnu packages check) #:use-module (gnu packages check)
#:use-module (gnu packages cmake)
#:use-module (gnu packages cups) #:use-module (gnu packages cups)
#:use-module (gnu packages curl) #:use-module (gnu packages curl)
#:use-module (gnu packages cyrus-sasl) #:use-module (gnu packages cyrus-sasl)
@ -193,6 +194,83 @@ Desktop. It is designed to be as simple as possible and has some unique
features to enable users to create their discs easily and quickly.") features to enable users to create their discs easily and quickly.")
(license license:gpl2+))) (license license:gpl2+)))
(define-public deja-dup
(package
(name "deja-dup")
(version "34.3")
(source (origin
(method url-fetch)
(uri "https://launchpadlibrarian.net/295170991/deja-dup-34.3.tar.xz")
(sha256
(base32
"1xqcr61hpbahbla7gdjn4ngjfz7w6f57y7f5pkb77yk05f60j2n9"))
(patches
(search-patches "deja-dup-use-ref-keyword-for-iter.patch"))))
(build-system glib-or-gtk-build-system)
(arguments
`(#:modules ((guix build gnu-build-system)
((guix build cmake-build-system) #:prefix cmake:)
(guix build glib-or-gtk-build-system)
(guix build utils))
#:imported-modules (,@%glib-or-gtk-build-system-modules
(guix build cmake-build-system))
#:test-target "test"
#:configure-flags (list (string-append
"-DCMAKE_INSTALL_FULL_DATADIR=" %output)
(string-append
"-DCMAKE_INSTALL_LIBEXECDIR=" %output))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-lockfile-deletion
(lambda rest
(substitute* "libdeja/tools/duplicity/DuplicityInstance.vala"
(("/bin/rm")
(which "rm")))))
(replace 'configure
(assoc-ref cmake:%standard-phases 'configure))
(delete 'check) ;; Fails due to issues with DBus
(add-after 'install 'wrap-deja-dup
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((python (assoc-ref inputs "python"))
(python-path (getenv "PYTHONPATH"))
(duplicity (assoc-ref inputs "duplicity"))
(out (assoc-ref outputs "out")))
(for-each
(lambda (program)
(wrap-program program
`("PATH" ":" prefix (,(string-append python "/bin")
,(string-append duplicity "/bin"))))
(wrap-program program
`("PYTHONPATH" ":" prefix (,python-path))))
(find-files (string-append out "/bin")))
#t))))))
(inputs
`(("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
("gobject-introspection" ,gobject-introspection)
("duplicity" ,duplicity)
("python" ,python2-minimal)
("python-pygobject" ,python2-pygobject)
("gtk+" ,gtk+)
("libnotify" ,libnotify)
("libpeas" ,libpeas)
("libsecret" ,libsecret)
("packagekit" ,packagekit)))
(native-inputs
`(("pkg-config" ,pkg-config)
("vala" ,vala)
("gettext" ,gettext-minimal)
("itstool" ,itstool)
("intltool" ,intltool)
("cmake", cmake)))
(home-page "https://launchpad.net/deja-dup")
(synopsis "Simple backup tool, for regular encrypted backups")
(description
"Déjà Dup is a simple backup tool, for regular encrypted backups. It
uses duplicity as the backend, which supports incremental backups and storage
either on a local, or remote machine via a number of methods.")
(license license:gpl3+)))
(define-public dia (define-public dia
;; This version from GNOME's repository includes fixes for compiling with ;; This version from GNOME's repository includes fixes for compiling with
;; recent versions of the build tools. The latest activity on the ;; recent versions of the build tools. The latest activity on the
@ -609,16 +687,15 @@ forgotten when the session ends.")
(define-public evince (define-public evince
(package (package
(name "evince") (name "evince")
(version "3.24.0") (version "3.24.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 "/"
(version-major+minor version) "/" (version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(patches (search-patches "evince-CVE-2017-1000083.patch"))
(sha256 (sha256
(base32 (base32
"13yw0i68dgqp9alyliy3zifszh7rikkpi1xbz5binvxxgfpraf04")))) "0dqgzwxl0xfr341r5i8j8hn6j6rhv62lmc6xbzjppcq76hhwb84w"))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(arguments (arguments
`(#:configure-flags '("--disable-nautilus") `(#:configure-flags '("--disable-nautilus")

View File

@ -249,7 +249,7 @@ in C/C++.")
(define-public nspr (define-public nspr
(package (package
(name "nspr") (name "nspr")
(version "4.15") (version "4.16")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -257,7 +257,7 @@ in C/C++.")
version "/src/nspr-" version ".tar.gz")) version "/src/nspr-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"101dksqm1z0hzd7ap82ccbxjr48s6q3xhshdl81qkj6hqdmy1p97")))) "1l9wlnb9y0bzicv448jjl9kssqn044dc2qrkwzp4ll35fvch4ccv"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("perl" ,perl))) `(("perl" ,perl)))
@ -281,7 +281,7 @@ in the Mozilla clients.")
(define-public nss (define-public nss
(package (package
(name "nss") (name "nss")
(version "3.31") (version "3.32")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (let ((version-with-underscores (uri (let ((version-with-underscores
@ -292,7 +292,7 @@ in the Mozilla clients.")
"nss-" version ".tar.gz"))) "nss-" version ".tar.gz")))
(sha256 (sha256
(base32 (base32
"0pd643a8ns7q5az5ai3ascrw666i2kbfiyy1c9hlhw9jd8jn21g9")) "0dfkgvah0ji8b8lpxyy2w0b3lyz5ldmryii4z7j2bfwnrj0z7iim"))
;; Create nss.pc and nss-config. ;; Create nss.pc and nss-config.
(patches (search-patches "nss-pkgconfig.patch" (patches (search-patches "nss-pkgconfig.patch"
"nss-increase-test-timeout.patch")))) "nss-increase-test-timeout.patch"))))
@ -364,6 +364,7 @@ in the Mozilla clients.")
;; phase to fail. Here we simply delete libgtest1.so, since it ;; phase to fail. Here we simply delete libgtest1.so, since it
;; seems to be used only during the tests. ;; seems to be used only during the tests.
(delete-file (string-append lib "/libgtest1.so")) (delete-file (string-append lib "/libgtest1.so"))
(delete-file (string-append lib "/libgtestutil.so"))
#t)))))) #t))))))
(inputs (inputs

View File

@ -1554,16 +1554,28 @@ is no support for parsing block and inline level HTML.")
(file-name (string-append name "-" version "-checkout")) (file-name (string-append name "-" version "-checkout"))
(sha256 (sha256
(base32 (base32
"04lgh0nk6ddnwgh20hnz4pyhczaik0xbd50kikjsxcwcl46shavb")))) "04lgh0nk6ddnwgh20hnz4pyhczaik0xbd50kikjsxcwcl46shavb"))
(patches (search-patches "guile-bytestructures-name-clash.patch"))))
(build-system trivial-build-system) (build-system trivial-build-system)
(arguments (arguments
`(#:modules ((guix build utils)) `(#:modules ((guix build utils))
#:builder #:builder
(begin (begin
(use-modules (guix build utils) (use-modules (guix build utils)
(ice-9 ftw)
(ice-9 match) (ice-9 match)
(ice-9 popen) (ice-9 popen)
(ice-9 rdelim)) (ice-9 rdelim))
;; Unpack.
(setenv "PATH"
(string-join (list (assoc-ref %build-inputs "tar")
(assoc-ref %build-inputs "xz"))
"/bin:" 'suffix))
(system* "tar" "xf" (assoc-ref %build-inputs "source"))
(match (scandir ".")
(("." ".." directory)
(chdir directory)))
(let* ((out (assoc-ref %outputs "out")) (let* ((out (assoc-ref %outputs "out"))
(guile (assoc-ref %build-inputs "guile")) (guile (assoc-ref %build-inputs "guile"))
(effective (read-line (effective (read-line
@ -1572,7 +1584,7 @@ is no support for parsing block and inline level HTML.")
"-c" "(display (effective-version))"))) "-c" "(display (effective-version))")))
(module-dir (string-append out "/share/guile/site/" (module-dir (string-append out "/share/guile/site/"
effective)) effective))
(source (assoc-ref %build-inputs "source")) (source (getcwd))
(doc (string-append out "/share/doc/scheme-bytestructures")) (doc (string-append out "/share/doc/scheme-bytestructures"))
(sld-files (with-directory-excursion source (sld-files (with-directory-excursion source
(find-files "bytestructures/r7" "\\.exports.sld$"))) (find-files "bytestructures/r7" "\\.exports.sld$")))
@ -1612,6 +1624,9 @@ is no support for parsing block and inline level HTML.")
;; Also copy over the README. ;; Also copy over the README.
(install-file "README.md" doc) (install-file "README.md" doc)
#t)))) #t))))
(native-inputs
`(("tar" ,tar)
("xz" ,xz)))
(inputs (inputs
`(("guile" ,guile-2.2))) `(("guile" ,guile-2.2)))
(home-page "https://github.com/TaylanUB/scheme-bytestructures") (home-page "https://github.com/TaylanUB/scheme-bytestructures")
@ -1624,6 +1639,9 @@ an abstraction over raw memory. It's also more powerful than the C
type system, elevating types to first-class status.") type system, elevating types to first-class status.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public guile2.0-bytestructures
(package-for-guile-2.0 guile-bytestructures))
(define-public guile-aspell (define-public guile-aspell
(package (package
(name "guile-aspell") (name "guile-aspell")
@ -1838,6 +1856,9 @@ is not available for Guile 2.0.")
manipulate repositories of the Git version control system.") manipulate repositories of the Git version control system.")
(license license:gpl3+)))) (license license:gpl3+))))
(define-public guile2.0-git
(package-for-guile-2.0 guile-git))
(define-public guile-syntax-highlight (define-public guile-syntax-highlight
(let ((commit "a047675e66861b647426372aa2ba7820f749616d") (let ((commit "a047675e66861b647426372aa2ba7820f749616d")
(revision "0")) (revision "0"))

View File

@ -54,7 +54,7 @@
(define-public feh (define-public feh
(package (package
(name "feh") (name "feh")
(version "2.19") (version "2.19.1")
(home-page "https://feh.finalrewind.org/") (home-page "https://feh.finalrewind.org/")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
@ -62,11 +62,11 @@
name "-" version ".tar.bz2")) name "-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"1sfhr6628xpj9p6bqihdq35y139x2gmrpydjlrwsl1rs77c2bgnf")))) "1d4ycmai3dpajl0bdr9i56646g4h5j1lb95jjn0nckwcddcj927c"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:phases (alist-delete 'configure %standard-phases) '(#:phases (alist-delete 'configure %standard-phases)
#:tests? #f #:tests? #f ;FIXME: Requires 'perl-test-command'.
#:make-flags #:make-flags
(list "CC=gcc" (string-append "PREFIX=" (assoc-ref %outputs "out"))))) (list "CC=gcc" (string-append "PREFIX=" (assoc-ref %outputs "out")))))
(inputs `(("imlib2" ,imlib2) (inputs `(("imlib2" ,imlib2)

View File

@ -106,6 +106,7 @@
#:use-module (guix build-system python) #:use-module (guix build-system python)
#:use-module (guix build-system trivial) #:use-module (guix build-system trivial)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:) #:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix utils) #:use-module (guix utils)
@ -1189,14 +1190,96 @@ consists of several tools, of which the most important are @command{ip} and
messages and are accompanied by a set of manpages.") messages and are accompanied by a set of manpages.")
(license license:gpl2+))) (license license:gpl2+)))
;; There are two packages for net-tools. The first, net-tools, is more recent
;; and probably safer to use with untrusted inputs (i.e. the internet). The
;; second, net-tools-for-tests, is relatively old and buggy. It can be used in
;; package test suites and should never be referred to by a built package. Use
;; #:disallowed-references to enforce this.
;;
;; When we are able to rebuild many packages (i.e. core-updates), we can update
;; net-tools-for-tests if appropriate.
;;
;; See <https://bugs.gnu.org/27811> for more information.
(define-public net-tools (define-public net-tools
;; XXX: This package is basically unmaintained, but it provides a few ;; XXX: This package is basically unmaintained, but it provides a few
;; commands not yet provided by Inetutils, such as 'route', so we have to ;; commands not yet provided by Inetutils, such as 'route', so we have to
;; live with it. ;; live with it.
(package (let ((commit "479bb4a7e11a4084e2935c0a576388f92469225b")
(name "net-tools") (revision "0"))
(package
(name "net-tools")
(version (string-append "1.60-" revision "." (string-take commit 7)))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://git.code.sf.net/p/net-tools/code")
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"189mdjfbd7j7j0jysy34nqn5byy9g5f6ylip1sikk7kz08vjml4s"))))
(home-page "http://net-tools.sourceforge.net/")
(build-system gnu-build-system)
(arguments
'(#:modules ((guix build gnu-build-system)
(guix build utils)
(srfi srfi-1)
(srfi srfi-26))
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(mkdir-p (string-append out "/bin"))
(mkdir-p (string-append out "/sbin"))
;; Pretend we have everything...
(system "yes | make config")
;; ... except for the things we don't have.
;; HAVE_AFDECnet requires libdnet, which we don't have.
;; HAVE_HWSTRIP and HAVE_HWTR require kernel headers
;; that have been removed.
;; XXX SELINUX and AFBLUETOOTH are removed for now, but we should
;; think about adding them later.
(substitute* '("config.make" "config.h")
(("^.*HAVE_(AFDECnet|HWSTRIP|HWTR|SELINUX|AFBLUETOOTH)[ =]1.*$")
"")))))
(add-after 'install 'remove-redundant-commands
(lambda* (#:key outputs #:allow-other-keys)
;; Remove commands and man pages redundant with Inetutils.
(let* ((out (assoc-ref outputs "out"))
(dup (append-map (cut find-files out <>)
'("^hostname"
"^(yp|nis|dns)?domainname"))))
(for-each delete-file dup)
#t))))
;; Binaries that depend on libnet-tools.a don't declare that
;; dependency, making it parallel-unsafe.
#:parallel-build? #f
#:tests? #f ; no test suite
#:make-flags (let ((out (assoc-ref %outputs "out")))
(list "CC=gcc"
(string-append "BASEDIR=" out)
(string-append "INSTALLNLSDIR=" out "/share/locale")
(string-append "mandir=/share/man")))))
(native-inputs `(("gettext" ,gettext-minimal)))
(synopsis "Tools for controlling the network subsystem in Linux")
(description
"This package includes the important tools for controlling the network
subsystem of the Linux kernel. This includes arp, ifconfig, netstat, rarp and
route. Additionally, this package contains utilities relating to particular
network hardware types (plipconfig, slattach) and advanced aspects of IP
configuration (iptunnel, ipmaddr).")
(license license:gpl2+))))
(define-public net-tools-for-tests
(hidden-package (package (inherit net-tools)
(version "1.60") (version "1.60")
(home-page "http://net-tools.sourceforge.net/") ;; Git depends on net-tools-for-tests via GnuTLS, so we can't use git-fetch
;; here. We should find a better workaround for this problem so that we can
;; use the latest upstream source.
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (list (string-append (uri (list (string-append
@ -1272,23 +1355,17 @@ messages and are accompanied by a set of manpages.")
;; Use the big Debian patch set (the thing does not even compile out of ;; Use the big Debian patch set (the thing does not even compile out of
;; the box.) ;; the box.)
;; XXX The patch is not actually applied, due to a bug in the 'patch' phase
;; above. However, this package variant is only used in GnuTLS's tests. It
;; will be adjusted when convenient for the build farm.
;; See <https://bugs.gnu.org/27811> for more information.
(inputs `(("patch" ,(origin (inputs `(("patch" ,(origin
(method url-fetch) (method url-fetch)
(uri (uri
"http://ftp.de.debian.org/debian/pool/main/n/net-tools/net-tools_1.60-24.2.diff.gz") "http://ftp.de.debian.org/debian/pool/main/n/net-tools/net-tools_1.60-24.2.diff.gz")
(sha256 (sha256
(base32 (base32
"0p93lsqx23v5fv4hpbrydmfvw1ha2rgqpn2zqbs2jhxkzhjc030p")))))) "0p93lsqx23v5fv4hpbrydmfvw1ha2rgqpn2zqbs2jhxkzhjc030p")))))))))
(native-inputs `(("gettext" ,gettext-minimal)))
(synopsis "Tools for controlling the network subsystem in Linux")
(description
"This package includes the important tools for controlling the network
subsystem of the Linux kernel. This includes arp, ifconfig, netstat, rarp and
route. Additionally, this package contains utilities relating to particular
network hardware types (plipconfig, slattach) and advanced aspects of IP
configuration (iptunnel, ipmaddr).")
(license license:gpl2+)))
(define-public libcap (define-public libcap
(package (package

View File

@ -88,6 +88,10 @@
`(#:parallel-build? #f ; The build system seems not to be thread safe. `(#:parallel-build? #f ; The build system seems not to be thread safe.
#:tests? #f ; There does not seem to be make check or anything similar. #:tests? #f ; There does not seem to be make check or anything similar.
#:configure-flags '("--enable-ansi") ; required for use by the maxima package #:configure-flags '("--enable-ansi") ; required for use by the maxima package
#:make-flags (list
"CFLAGS=-fgnu89-inline" ; removes inline function warnings
(string-append "GCC=" (assoc-ref %build-inputs "gcc")
"/bin/gcc"))
#:phases (modify-phases %standard-phases #:phases (modify-phases %standard-phases
(add-before 'configure 'pre-conf (add-before 'configure 'pre-conf
(lambda _ (lambda _
@ -104,6 +108,27 @@
(string-append "SHELL=" (which "bash"))) (string-append "SHELL=" (which "bash")))
(("SHELL=/bin/sh") (("SHELL=/bin/sh")
(string-append "SHELL=" (which "sh")))) (string-append "SHELL=" (which "sh"))))
(substitute* "h/linux.defs"
(("#CC") "CC")
(("-fwritable-strings") "")
(("-Werror") ""))
#t))
(add-after 'install 'wrap
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((gcl (assoc-ref outputs "out"))
(input-path (lambda (lib path)
(string-append
(assoc-ref inputs lib) path)))
(binaries '("binutils")))
;; GCC and the GNU binutils are necessary for GCL to be
;; able to compile Lisp functions and programs (this is
;; a standard feature in Common Lisp). While the
;; the location of GCC is specified in the make-flags,
;; the GNU binutils must be available in GCL's $PATH.
(wrap-program (string-append gcl "/bin/gcl")
`("PATH" prefix ,(map (lambda (binary)
(input-path binary "/bin"))
binaries))))
#t)) #t))
;; drop strip phase to make maxima build, see ;; drop strip phase to make maxima build, see
;; https://www.ma.utexas.edu/pipermail/maxima/2008/009769.html ;; https://www.ma.utexas.edu/pipermail/maxima/2008/009769.html

View File

@ -667,14 +667,14 @@ invoking @command{notifymuch} from the post-new hook.")
(define-public notmuch (define-public notmuch
(package (package
(name "notmuch") (name "notmuch")
(version "0.24.2") (version "0.25")
(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
"0lfchvapk11qazdgsxj42igp9mpp83zbd0h1jj6r3ifmhikajxma")))) "02z6d87ip1hkipz8d7w0sfklg8dd5fd5vlgp768640ixg0gqvlk5"))))
(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.
@ -930,6 +930,11 @@ compresses it.")
(arguments (arguments
'(#:configure-flags '(#:configure-flags
'("--enable-gnutls" "--enable-pgpmime-plugin" "--enable-enchant") '("--enable-gnutls" "--enable-pgpmime-plugin" "--enable-enchant")
#:make-flags
;; Disable updating icon cache since it's done by the profile hook.
;; Conflict with other packages in the profile would be inevitable
;; otherwise.
'("gtk_update_icon_cache=true")
#:phases (modify-phases %standard-phases #:phases (modify-phases %standard-phases
(add-before 'build 'patch-mime (add-before 'build 'patch-mime
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)

View File

@ -316,7 +316,7 @@ the OCaml language.")
(define-public glpk (define-public glpk
(package (package
(name "glpk") (name "glpk")
(version "4.62") (version "4.63")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -324,7 +324,7 @@ the OCaml language.")
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0w7s3869ybwyq9a4490dikpib1qp3jnn5nqz1vvwqy1qz3ilnvh9")))) "1xp7nclmp8inp20968bvvfcwmz3mz03sbm0v3yjz8aqwlpqjfkci"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("gmp" ,gmp))) `(("gmp" ,gmp)))
@ -2075,8 +2075,7 @@ to BMP, JPEG or PNG image formats.")
(patches (search-patches "maxima-defsystem-mkdir.patch")))) (patches (search-patches "maxima-defsystem-mkdir.patch"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("gcc" ,gcc) `(("gcl" ,gcl)
("gcl" ,gcl)
("gnuplot" ,gnuplot) ;for plots ("gnuplot" ,gnuplot) ;for plots
("tk" ,tk))) ;Tcl/Tk is used by 'xmaxima' ("tk" ,tk))) ;Tcl/Tk is used by 'xmaxima'
(native-inputs (native-inputs
@ -2100,13 +2099,6 @@ to BMP, JPEG or PNG image formats.")
#:make-flags (list "TMPDIR=/tmp") #:make-flags (list "TMPDIR=/tmp")
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-before 'configure 'set-gcc-path
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "lisp-utils/defsystem.lisp"
(("\\(defparameter \\*c-compiler\\* \"gcc\"\\)")
(string-append "(defparameter *c-compiler* \""
(assoc-ref inputs "gcc") "/bin/gcc\")")))
#t))
(add-before 'check 'pre-check (add-before 'check 'pre-check
(lambda _ (lambda _
(chmod "src/maxima" #o555) (chmod "src/maxima" #o555)
@ -2118,7 +2110,9 @@ to BMP, JPEG or PNG image formats.")
(lambda* (#:key outputs inputs #:allow-other-keys) (lambda* (#:key outputs inputs #:allow-other-keys)
(let* ((gnuplot (assoc-ref inputs "gnuplot")) (let* ((gnuplot (assoc-ref inputs "gnuplot"))
(out (assoc-ref outputs "out")) (out (assoc-ref outputs "out"))
(datadir (string-append out "/share/maxima/" ,version))) (datadir (string-append out "/share/maxima/" ,version))
(binutils (string-append (assoc-ref inputs "binutils")
"/bin")))
(with-directory-excursion out (with-directory-excursion out
(mkdir-p "share/emacs") (mkdir-p "share/emacs")
(mkdir-p "share/doc") (mkdir-p "share/doc")
@ -2134,7 +2128,11 @@ to BMP, JPEG or PNG image formats.")
(format out "~a ~s~a~%" (format out "~a ~s~a~%"
"(setf $gnuplot_command " "(setf $gnuplot_command "
(string-append gnuplot "/bin/gnuplot") ")") (string-append gnuplot "/bin/gnuplot") ")")
(dump-port in out))))) (dump-port in out))))
;; Ensure that Maxima will have access to the GNU binutils
;; components at runtime.
(wrap-program (string-append out "/bin/maxima")
`("PATH" prefix (,binutils))))
#t))))) #t)))))
(home-page "http://maxima.sourceforge.net") (home-page "http://maxima.sourceforge.net")
(synopsis "Numeric and symbolic expression manipulation") (synopsis "Numeric and symbolic expression manipulation")

View File

@ -1,76 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.org>
;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages mg)
#:use-module (guix licenses)
#:use-module (guix download)
#:use-module (guix packages)
#:use-module (guix build-system gnu)
#:use-module (gnu packages libbsd)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages pkg-config))
(define-public mg
(package
(name "mg")
(version "20161005")
(source (origin
(method url-fetch)
(uri (string-append "http://homepage.boetes.org/software/mg/mg-"
version ".tar.gz"))
(sha256
(base32
"0qaydk2cy765n9clghmi5gdnpwn15y2v0fj6r0jcm0v7d89vbz5p"))
(modules '((guix build utils)))
(snippet
'(begin
(substitute* "GNUmakefile"
(("/usr/bin/") ""))))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("libbsd" ,libbsd)
("ncurses" ,ncurses)))
(arguments
;; No test suite available.
'(#:tests? #f
#:make-flags (list (string-append "prefix=" %output)
"CURSES_LIBS=-lncurses"
"CC=gcc")
#:phases (modify-phases %standard-phases
(delete 'configure)
(add-before 'install 'patch-tutorial-location
(lambda* (#:key outputs #:allow-other-keys)
(substitute* "mg.1"
(("/usr") (assoc-ref outputs "out")))
#t))
(add-after 'install 'install-tutorial
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(doc (string-append out "/share/doc/mg")))
(install-file "tutorial" doc)
#t))))))
(home-page "http://homepage.boetes.org/software/mg/")
(synopsis "Microscopic GNU Emacs clone")
(description
"Mg (mg) is a GNU Emacs style editor, with which it is \"broadly\"
compatible. This is a portable version of the mg maintained by the OpenBSD
team.")
(license public-domain)))

View File

@ -3,6 +3,7 @@
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net> ;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2017 Dave Love <fx@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -110,7 +111,7 @@ bind processes, and much more.")
(define-public openmpi (define-public openmpi
(package (package
(name "openmpi") (name "openmpi")
(version "1.10.3") (version "1.10.7")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -119,8 +120,9 @@ bind processes, and much more.")
"/downloads/openmpi-" version ".tar.bz2")) "/downloads/openmpi-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"0k95ri9f8kzx5vhzrdbzn59rn2324fs4a96w5v8jy20j8dkbp13l")))) "142s1vny9gllkq336yafxayjgcirj2jv0ddabj879jgya7hyr2d0"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" "static"))
(inputs (inputs
`(("hwloc" ,hwloc "lib") `(("hwloc" ,hwloc "lib")
("gfortran" ,gfortran) ("gfortran" ,gfortran)
@ -137,6 +139,7 @@ bind processes, and much more.")
"--enable-mpi-ext=all" "--enable-mpi-ext=all"
"--with-devel-headers" "--with-devel-headers"
"--enable-memchecker" "--enable-memchecker"
"--with-sge"
,(string-append "--with-valgrind=" ,(string-append "--with-valgrind="
(assoc-ref %build-inputs "valgrind")) (assoc-ref %build-inputs "valgrind"))
,(string-append "--with-hwloc=" ,(string-append "--with-hwloc="
@ -153,11 +156,25 @@ bind processes, and much more.")
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))) (let ((out (assoc-ref outputs "out")))
(for-each delete-file (find-files out "config.log")) (for-each delete-file (find-files out "config.log"))
#t)))
(add-after 'install 'move-static-libraries
(lambda* (#:key outputs #:allow-other-keys)
;; Move 19 MiB of static libraries to 'static'.
(let* ((out (assoc-ref outputs "out"))
(static (assoc-ref outputs "static"))
(lib (string-append out "/lib"))
(slib (string-append static "/lib")))
(mkdir-p slib)
(for-each (lambda (file)
(rename-file
file
(string-append slib "/" (basename file))))
(find-files lib "\\.a$"))
#t)))))) #t))))))
(home-page "http://www.open-mpi.org") (home-page "http://www.open-mpi.org")
(synopsis "MPI-2 implementation") (synopsis "MPI-3 implementation")
(description (description
"The Open MPI Project is an MPI-2 implementation that is developed and "The Open MPI Project is an MPI-3 implementation that is developed and
maintained by a consortium of academic, research, and industry partners. Open maintained by a consortium of academic, research, and industry partners. Open
MPI is therefore able to combine the expertise, technologies, and resources MPI is therefore able to combine the expertise, technologies, and resources
from all across the High Performance Computing community in order to build the from all across the High Performance Computing community in order to build the

View File

@ -206,7 +206,7 @@ ncursesw library provides wide character support.")
(define-public dialog (define-public dialog
(package (package
(name "dialog") (name "dialog")
(version "1.2-20150920") (version "1.3-20170509")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -214,7 +214,7 @@ ncursesw library provides wide character support.")
version ".tgz")) version ".tgz"))
(sha256 (sha256
(base32 (base32
"01ccd585c241nkj02n0zdbx8jqhylgcfpcmmshynh0c7fv2ixrn4")))) "0mj7rl5psilaj3bxxvjfd44qjknxjli98b0d1lxd3f9jqrsbmw9g"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f)) ; no test suite `(#:tests? #f)) ; no test suite

View File

@ -441,7 +441,7 @@ and up to 1 Mbit/s downstream.")
(define-public whois (define-public whois
(package (package
(name "whois") (name "whois")
(version "5.2.16") (version "5.2.17")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -449,7 +449,7 @@ and up to 1 Mbit/s downstream.")
name "_" version ".tar.xz")) name "_" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0fpwac26ja0rdqsbxyjcsk8gxgixfpxk0baj3rhnpaff3jv0ilp9")))) "0r4np8gaxhy9c0v795dc4dhxms9zak31vd378sb1h7jpixkqax95"))))
(build-system gnu-build-system) (build-system gnu-build-system)
;; TODO: unbundle mkpasswd binary + its po files. ;; TODO: unbundle mkpasswd binary + its po files.
(arguments (arguments

View File

@ -76,8 +76,8 @@
;; Note: the 'update-guix-package.scm' script expects this definition to ;; Note: the 'update-guix-package.scm' script expects this definition to
;; start precisely like this. ;; start precisely like this.
(let ((version "0.13.0") (let ((version "0.13.0")
(commit "b547349d505c57fd679b6e48c472d8ab65469c96") (commit "f1ddfe4f14b8a8d963f2f3e68d800b745696246d")
(revision 3)) (revision 4))
(package (package
(name "guix") (name "guix")
@ -93,7 +93,7 @@
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"0q6qr9hvrac1wj2ygn4jj4w89h1m35zkcjjd741sibc3l46pa93l")) "11yjsn957igh6migxrnicdqrxc76skz5r0l7hfnm5gp45my1kd9p"))
(file-name (string-append "guix-" version "-checkout")))) (file-name (string-append "guix-" version "-checkout"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments

View File

@ -0,0 +1,41 @@
From 5676766be5e845ccb6cdf46cfa8722497f151752 Mon Sep 17 00:00:00 2001
From: Jeremy Bicha <jbicha@ubuntu.com>
Date: Fri, 16 Jun 2017 15:11:37 -0400
Subject: Use 'ref' keyword for iter, requires vala 0.36
diff --git a/deja-dup/widgets/ConfigList.vala b/deja-dup/widgets/ConfigList.vala
index 15de2d6..02cd81a 100644
--- a/deja-dup/widgets/ConfigList.vala
+++ b/deja-dup/widgets/ConfigList.vala
@@ -333,7 +333,7 @@ public class ConfigList : ConfigWidget
model.row_deleted.disconnect(write_to_config);
foreach (Gtk.TreeIter iter in iters) {
- (model as Gtk.ListStore).remove(iter);
+ (model as Gtk.ListStore).remove(ref iter);
}
model.row_deleted.connect(write_to_config);
diff --git a/deja-dup/widgets/ConfigLocation.vala b/deja-dup/widgets/ConfigLocation.vala
index 869e2a8..d21c556 100644
--- a/deja-dup/widgets/ConfigLocation.vala
+++ b/deja-dup/widgets/ConfigLocation.vala
@@ -397,12 +397,12 @@ public class ConfigLocation : ConfigWidget
if (uuid == saved_uuid)
return;
- store.remove(iter);
+ store.remove(ref iter);
if (--num_volumes == 0) {
Gtk.TreeIter sep_iter;
if (store.get_iter_from_string(out sep_iter, index_vol_sep.to_string())) {
- store.remove(sep_iter);
+ store.remove(ref sep_iter);
index_vol_sep = -2;
}
}
--
cgit v0.10.2

View File

@ -1,109 +0,0 @@
Fix CVE-2017-1000083.
http://seclists.org/oss-sec/2017/q3/128
https://bugzilla.gnome.org/show_bug.cgi?id=784630
Patch copied from upstream source repository:
https://git.gnome.org/browse/evince/commit/?id=717df38fd8509bf883b70d680c9b1b3cf36732ee
From 717df38fd8509bf883b70d680c9b1b3cf36732ee Mon Sep 17 00:00:00 2001
From: Bastien Nocera <hadess@hadess.net>
Date: Thu, 6 Jul 2017 20:02:00 +0200
Subject: comics: Remove support for tar and tar-like commands
diff --git a/backend/comics/comics-document.c b/backend/comics/comics-document.c
index 4c74731..641d785 100644
--- a/backend/comics/comics-document.c
+++ b/backend/comics/comics-document.c
@@ -56,8 +56,7 @@ typedef enum
RARLABS,
GNAUNRAR,
UNZIP,
- P7ZIP,
- TAR
+ P7ZIP
} ComicBookDecompressType;
typedef struct _ComicsDocumentClass ComicsDocumentClass;
@@ -117,9 +116,6 @@ static const ComicBookDecompressCommand command_usage_def[] = {
/* 7zip */
{NULL , "%s l -- %s" , "%s x -y %s -o%s", FALSE, OFFSET_7Z},
-
- /* tar */
- {"%s -xOf" , "%s -tf %s" , NULL , FALSE, NO_OFFSET}
};
static GSList* get_supported_image_extensions (void);
@@ -364,13 +360,6 @@ comics_check_decompress_command (gchar *mime_type,
comics_document->command_usage = GNAUNRAR;
return TRUE;
}
- comics_document->selected_command =
- g_find_program_in_path ("bsdtar");
- if (comics_document->selected_command) {
- comics_document->command_usage = TAR;
- return TRUE;
- }
-
} else if (g_content_type_is_a (mime_type, "application/x-cbz") ||
g_content_type_is_a (mime_type, "application/zip")) {
/* InfoZIP's unzip program */
@@ -396,12 +385,6 @@ comics_check_decompress_command (gchar *mime_type,
comics_document->command_usage = P7ZIP;
return TRUE;
}
- comics_document->selected_command =
- g_find_program_in_path ("bsdtar");
- if (comics_document->selected_command) {
- comics_document->command_usage = TAR;
- return TRUE;
- }
} else if (g_content_type_is_a (mime_type, "application/x-cb7") ||
g_content_type_is_a (mime_type, "application/x-7z-compressed")) {
@@ -425,27 +408,6 @@ comics_check_decompress_command (gchar *mime_type,
comics_document->command_usage = P7ZIP;
return TRUE;
}
- comics_document->selected_command =
- g_find_program_in_path ("bsdtar");
- if (comics_document->selected_command) {
- comics_document->command_usage = TAR;
- return TRUE;
- }
- } else if (g_content_type_is_a (mime_type, "application/x-cbt") ||
- g_content_type_is_a (mime_type, "application/x-tar")) {
- /* tar utility (Tape ARchive) */
- comics_document->selected_command =
- g_find_program_in_path ("tar");
- if (comics_document->selected_command) {
- comics_document->command_usage = TAR;
- return TRUE;
- }
- comics_document->selected_command =
- g_find_program_in_path ("bsdtar");
- if (comics_document->selected_command) {
- comics_document->command_usage = TAR;
- return TRUE;
- }
} else {
g_set_error (error,
EV_DOCUMENT_ERROR,
diff --git a/configure.ac b/configure.ac
index 9e9f831..7eb0f1f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -795,7 +795,7 @@ AC_SUBST(TIFF_MIME_TYPES)
AC_SUBST(APPDATA_TIFF_MIME_TYPES)
AM_SUBST_NOTMAKE(APPDATA_TIFF_MIME_TYPES)
if test "x$enable_comics" = "xyes"; then
- COMICS_MIME_TYPES="application/x-cbr;application/x-cbz;application/x-cb7;application/x-cbt;application/x-ext-cbr;application/x-ext-cbz;application/vnd.comicbook+zip;application/x-ext-cb7;application/x-ext-cbt"
+ COMICS_MIME_TYPES="application/x-cbr;application/x-cbz;application/x-cb7;application/x-ext-cbr;application/x-ext-cbz;application/vnd.comicbook+zip;application/x-ext-cb7;"
APPDATA_COMICS_MIME_TYPES=$(echo "<mimetype>$COMICS_MIME_TYPES</mimetype>" | sed -e 's/;/<\/mimetype>\n <mimetype>/g')
if test -z "$EVINCE_MIME_TYPES"; then
EVINCE_MIME_TYPES="${COMICS_MIME_TYPES}"
--
cgit v0.12

View File

@ -0,0 +1,31 @@
This patch works around a name clash between the 'cstring-pointer' module and
the 'cstring-module' variable that occurs in Guile 2.0:
ice-9/boot-9.scm:109:20: re-exporting local variable: cstring-pointer
--- guile-bytestructures-20170402.91d042e-checkout/bytestructures/guile.scm 2017-07-25 17:04:32.858289986 +0200
+++ guile-bytestructures-20170402.91d042e-checkout/bytestructures/guile.scm 2017-07-25 17:04:41.130244725 +0200
@@ -1,6 +1,6 @@
(define-module (bytestructures guile))
-(import
+(use-modules
(bytestructures guile base)
(bytestructures guile vector)
(bytestructures guile struct)
@@ -8,7 +8,7 @@
(bytestructures guile pointer)
(bytestructures guile numeric)
(bytestructures guile string)
- (bytestructures guile cstring-pointer))
+ ((bytestructures guile cstring-pointer) #:prefix cstr:))
(re-export
make-bytestructure-descriptor
bytestructure-descriptor?
@@ -75,5 +75,5 @@
bs:string
- cstring-pointer
+ cstr:cstring-pointer
)

View File

@ -221,5 +221,5 @@ Later adapted to apply cleanly to nss-3.21.
RELEASE = nss RELEASE = nss
-DIRS = coreconf lib cmd gtests -DIRS = coreconf lib cmd cpputil gtests
+DIRS = coreconf lib cmd gtests config +DIRS = coreconf lib cmd cpputil gtests config

View File

@ -0,0 +1,62 @@
Fix CVE-2017-10788:
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2017-10788
Patch written to match corrected documentation specifications:
Old: http://web.archive.org/web/20161220021610/https://dev.mysql.com/doc/refman/5.7/en/mysql-stmt-close.html
New: https://dev.mysql.com/doc/refman/5.7/en/mysql-stmt-close.html
The patch itself is from https://github.com/perl5-dbi/DBD-mysql/issues/120#issuecomment-312420660.
From 9ce10cfae7138c37c3a0cb2ba2a1d682482943d0 Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Sun, 25 Jun 2017 10:07:39 +0200
Subject: [PATCH] Fix use-after-free after calling mysql_stmt_close()
Ignore return value from mysql_stmt_close() and also its error message
because it points to freed memory after mysql_stmt_close() was called.
---
dbdimp.c | 8 ++------
mysql.xs | 7 ++-----
2 files changed, 4 insertions(+), 11 deletions(-)
diff --git a/dbdimp.c b/dbdimp.c
index c60a5f6..a6410e5 100644
--- a/dbdimp.c
+++ b/dbdimp.c
@@ -4894,12 +4894,8 @@ void dbd_st_destroy(SV *sth, imp_sth_t *imp_sth) {
if (imp_sth->stmt)
{
- if (mysql_stmt_close(imp_sth->stmt))
- {
- do_error(DBIc_PARENT_H(imp_sth), mysql_stmt_errno(imp_sth->stmt),
- mysql_stmt_error(imp_sth->stmt),
- mysql_stmt_sqlstate(imp_sth->stmt));
- }
+ mysql_stmt_close(imp_sth->stmt);
+ imp_sth->stmt= NULL;
}
#endif
diff --git a/mysql.xs b/mysql.xs
index 55376e1..affde59 100644
--- a/mysql.xs
+++ b/mysql.xs
@@ -434,11 +434,8 @@ do(dbh, statement, attr=Nullsv, ...)
if (bind)
Safefree(bind);
- if(mysql_stmt_close(stmt))
- {
- fprintf(stderr, "\n failed while closing the statement");
- fprintf(stderr, "\n %s", mysql_stmt_error(stmt));
- }
+ mysql_stmt_close(stmt);
+ stmt= NULL;
if (retval == -2) /* -2 means error */
{
--
1.7.9.5

View File

@ -4659,7 +4659,7 @@ reruns flaky tests.
Ideally, tests reliably pass or fail, but sometimes test fixtures must rely Ideally, tests reliably pass or fail, but sometimes test fixtures must rely
on components that aren't 100% reliable. With flaky, instead of removing on components that aren't 100% reliable. With flaky, instead of removing
those tests or marking them to @code{@skip}, they can be automatically those tests or marking them to @code{@@skip}, they can be automatically
retried.") retried.")
(license license:asl2.0))) (license license:asl2.0)))
@ -5876,7 +5876,11 @@ features useful for text console applications.")
(inherit python2-urwid) (inherit python2-urwid)
(arguments (arguments
(append (append
'(#:phases `(;; Explicitly using Python 2 is necessary due the argument list being
;; built from only the 'delete-test_vterm.py' phase and python-urwid's
;; package arguments, which by default assumes the use of Python 3.
#:python ,python-2
#:phases
(modify-phases %standard-phases (modify-phases %standard-phases
;; Disable the vterm tests because of non-deterministic failures ;; Disable the vterm tests because of non-deterministic failures
;; with Python 2. See https://github.com/urwid/urwid/issues/230. ;; with Python 2. See https://github.com/urwid/urwid/issues/230.
@ -7637,14 +7641,14 @@ responses, rather than doing any computation.")
(define-public python-cryptography-vectors (define-public python-cryptography-vectors
(package (package
(name "python-cryptography-vectors") (name "python-cryptography-vectors")
(version "2.0") (version "2.0.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "cryptography_vectors" version)) (uri (pypi-uri "cryptography_vectors" version))
(sha256 (sha256
(base32 (base32
"0qadys01517k5wy0rifxip02p08kzrqxm5j0lmmlp0kr07h9jc7h")))) "0yvi2cp23rg20bq3hd47ixbvjh0zgxnxrriqx5v17d7vkmliwbsi"))))
(build-system python-build-system) (build-system python-build-system)
(home-page "https://github.com/pyca/cryptography") (home-page "https://github.com/pyca/cryptography")
(synopsis "Test vectors for the cryptography package") (synopsis "Test vectors for the cryptography package")
@ -7659,14 +7663,14 @@ responses, rather than doing any computation.")
(define-public python-cryptography (define-public python-cryptography
(package (package
(name "python-cryptography") (name "python-cryptography")
(version "2.0") (version "2.0.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "cryptography" version)) (uri (pypi-uri "cryptography" version))
(sha256 (sha256
(base32 (base32
"1c40qlxyn1jgg99f3pqi7146d3561rn9zdqc7w8f7kwr9ysm696k")))) "1aq6ilnf2zdqshwqai4w8gmb5y6p7ip34qrjp1yb7sz77rkb501p"))))
(build-system python-build-system) (build-system python-build-system)
(inputs (inputs
`(("openssl" ,openssl))) `(("openssl" ,openssl)))
@ -15812,3 +15816,30 @@ pure Python module.")
(define-public python2-rencode (define-public python2-rencode
(package-with-python2 python-rencode)) (package-with-python2 python-rencode))
(define-public python-flask-principal
(package
(name "python-flask-principal")
(version "0.4.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "Flask-Principal" version))
(sha256
(base32
"0lwlr5smz8vfm5h9a9i7da3q1c24xqc6vm9jdywdpgxfbi5i7mpm"))))
(build-system python-build-system)
(propagated-inputs
`(("python-blinker" ,python-blinker)))
(native-inputs
`(("python-flask" ,python-flask)
("python-nose" ,python-nose)))
(home-page "http://packages.python.org/Flask-Principal/")
(synopsis "Identity management for Flask")
(description "@code{flask_principal} is a identity management library for
Flask. It supports managing both authentication and authorization data in a
thread-local variable.")
(license license:expat)))
(define-public python2-flask-principal
(package-with-python2 python-flask-principal))

View File

@ -3900,14 +3900,14 @@ hierarchical clustering dendrograms.")
(define-public r-preprocesscore (define-public r-preprocesscore
(package (package
(name "r-preprocesscore") (name "r-preprocesscore")
(version "1.38.0") (version "1.38.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (bioconductor-uri "preprocessCore" version)) (uri (bioconductor-uri "preprocessCore" version))
(sha256 (sha256
(base32 (base32
"1vq8hwxz73j93q0ldw5bnhbas1f2ha5q1lr9pp4l8gp8zdwzfrjn")))) "1ggvmak13rhxc4ghf16ncjfvgszc8yvza93s2l9kn8yiwr96vp2h"))))
(properties (properties
`((upstream-name . "preprocessCore"))) `((upstream-name . "preprocessCore")))
(build-system r-build-system) (build-system r-build-system)

View File

@ -3,7 +3,8 @@
;;; Copyright © 2016 Carlo Zancanaro <carlo@zancanaro.id.au> ;;; Copyright © 2016 Carlo Zancanaro <carlo@zancanaro.id.au>
;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2017 Feng Shu <tumashu@163.com> ;;; Copyright © 2017 Feng Shu <tumashu@163.com>
;;; Copyright © 2017 ng0 <ng0@no-reply.pragmatique.xyz> ;;; Copyright © 2017 ng0 <ng0@infotropique.org>
;;; Copyright © 2014 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -26,6 +27,7 @@
#:use-module (guix git-download) #:use-module (guix git-download)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system glib-or-gtk)
#:use-module ((guix licenses) #:prefix license:) #:use-module ((guix licenses) #:prefix license:)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages assembly) #:use-module (gnu packages assembly)
@ -34,6 +36,7 @@
#:use-module (gnu packages gcc) #:use-module (gnu packages gcc)
#:use-module (gnu packages glib) #:use-module (gnu packages glib)
#:use-module (gnu packages gtk) #:use-module (gnu packages gtk)
#:use-module (gnu packages libbsd)
#:use-module (gnu packages lua) #:use-module (gnu packages lua)
#:use-module (gnu packages ncurses) #:use-module (gnu packages ncurses)
#:use-module (gnu packages pkg-config) #:use-module (gnu packages pkg-config)
@ -178,7 +181,7 @@ bindings and many of the powerful features of GNU Emacs.")
(sha256 (sha256
(base32 (base32
"0b0az2wvqgvam7w0ns1j8xp2llslm1rx6h7zcsy06a7j0yp257cm")))) "0b0az2wvqgvam7w0ns1j8xp2llslm1rx6h7zcsy06a7j0yp257cm"))))
(build-system gnu-build-system) (build-system glib-or-gtk-build-system)
(native-inputs (native-inputs
`(("intltool" ,intltool) `(("intltool" ,intltool)
("pkg-config" ,pkg-config))) ("pkg-config" ,pkg-config)))
@ -227,3 +230,58 @@ Wordstar-, EMACS-, Pico, Nedit or vi-like key bindings. e3 can be used on
16, 32, and 64-bit CPUs.") 16, 32, and 64-bit CPUs.")
(supported-systems '("x86_64-linux" "i686-linux")) (supported-systems '("x86_64-linux" "i686-linux"))
(license license:gpl2+))) (license license:gpl2+)))
(define-public mg
(package
(name "mg")
(version "20170401")
(source (origin
(method url-fetch)
(uri (string-append "https://homepage.boetes.org/software/mg/mg-"
version ".tar.gz"))
(sha256
(base32
"1arasswgdadbb265rahq3867r9s54jva6k4m3p5n0f8mgjqhhdha"))
(modules '((guix build utils)))
(snippet
'(begin
(substitute* "GNUmakefile"
(("/usr/bin/") ""))))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("libbsd" ,libbsd)
("ncurses" ,ncurses)))
(arguments
;; No test suite available.
'(#:tests? #f
#:make-flags (list (string-append "prefix=" %output)
"CURSES_LIBS=-lncurses"
"CC=gcc")
#:phases (modify-phases %standard-phases
(delete 'configure)
(add-before 'build 'correct-location-of-difftool
(lambda _
(substitute* "buffer.c"
(("/usr/bin/diff")
(which "diff")))
#t))
(add-before 'install 'patch-tutorial-location
(lambda* (#:key outputs #:allow-other-keys)
(substitute* "mg.1"
(("/usr") (assoc-ref outputs "out")))
#t))
(add-after 'install 'install-tutorial
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(doc (string-append out "/share/doc/mg")))
(install-file "tutorial" doc)
#t))))))
(home-page "http://homepage.boetes.org/software/mg/")
(synopsis "Microscopic GNU Emacs clone")
(description
"Mg (mg) is a GNU Emacs style editor, with which it is \"broadly\"
compatible. This is a portable version of the mg maintained by the OpenBSD
team.")
(license license:public-domain)))

View File

@ -131,6 +131,9 @@ coordinating the use of PKCS#11 by different components or libraries
living in the same process.") living in the same process.")
(license license:bsd-3))) (license license:bsd-3)))
;; TODO Add net-tools-for-tests to #:disallowed-references when we can afford
;; rebuild GnuTLS (i.e. core-updates).
(define-public gnutls (define-public gnutls
(package (package
(name "gnutls") (name "gnutls")
@ -185,7 +188,7 @@ living in the same process.")
"debug" "debug"
"doc")) ;4.1 MiB of man pages "doc")) ;4.1 MiB of man pages
(native-inputs (native-inputs
`(("net-tools" ,net-tools) `(("net-tools" ,net-tools-for-tests)
("pkg-config" ,pkg-config) ("pkg-config" ,pkg-config)
("which" ,which))) ("which" ,which)))
(inputs (inputs

View File

@ -785,14 +785,14 @@ following features:
(define-public subversion (define-public subversion
(package (package
(name "subversion") (name "subversion")
(version "1.8.17") (version "1.8.18")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://archive.apache.org/dist/subversion/" (uri (string-append "https://archive.apache.org/dist/subversion/"
"subversion-" version ".tar.bz2")) "subversion-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"1450fkj1jmxyphqn6cd95z1ykwsabajm9jw4i412qpwss8w9a4fy")))) "19lpqdrl86mjfdpayhn3f9rkmpb6zs2iny38cnxq6wcj7snh0sz5"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:phases '(#:phases

View File

@ -1238,7 +1238,7 @@ other site that youtube-dl supports.")
(define-public you-get (define-public you-get
(package (package
(name "you-get") (name "you-get")
(version "0.4.775") (version "0.4.803")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -1247,7 +1247,7 @@ other site that youtube-dl supports.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1pjjv42c9bysnj8s3c6v0g6b00lr7b21y8ypibnzd6z0jxlsq7sz")))) "1rjy809x67dadzvj3midkhcda2kp6rqmbj6rbhjd5f16rvqgn7jp"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
;; no tests ;; no tests

View File

@ -53,14 +53,14 @@
(define-public webkitgtk (define-public webkitgtk
(package (package
(name "webkitgtk") (name "webkitgtk")
(version "2.16.5") (version "2.16.6")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://www.webkitgtk.org/releases/" (uri (string-append "https://www.webkitgtk.org/releases/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1m3xpqs6ddq3m8z6vn83mqh5mkagxlp68vl5qnc7hxcf8brrc0wf")))) "08abxbhi2n1pfby9f2c20z8mpmbvbs2z7vf0p5ckq4jkz46na8zw"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
'(#:tests? #f ; no tests '(#:tests? #f ; no tests

View File

@ -322,15 +322,14 @@ ogginfo, to obtain information (tags, bitrate, length, etc.) about
(define opus (define opus
(package (package
(name "opus") (name "opus")
(version "1.2") (version "1.2.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append "https://archive.mozilla.org/pub/opus/opus-"
"http://downloads.xiph.org/releases/opus/opus-" version version ".tar.gz"))
".tar.gz"))
(sha256 (sha256
(base32 (base32
"1ad9q2g9vivx409jdsslv1hrh5r616qz2pjm96y8ymsigfl4bnvp")))) "0ch7yzgg4bn1g36bpjsfrgs4n19c84d7wpdida6yzifrrhwx7byg"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(synopsis "Versatile audio codec") (synopsis "Versatile audio codec")
(description (description

View File

@ -5707,14 +5707,14 @@ to answer a question. Xmessage can also exit after a specified time.")
(define-public xterm (define-public xterm
(package (package
(name "xterm") (name "xterm")
(version "322") (version "330")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "ftp://ftp.invisible-island.net/xterm/" (uri (string-append "ftp://ftp.invisible-island.net/xterm/"
"xterm-" version ".tgz")) "xterm-" version ".tgz"))
(sha256 (sha256
(base32 (base32
"1mh9s5g3fs64iimnl7axk0isb5306dyshisxlv5gr8vn7ysl3nws")))) "1psnfmqd23v9gxj8a98nzrgvymrk0p1whwqi92gy15bbkzrgkvks"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:configure-flags '("--enable-wide-chars" "--enable-256-color" '(#:configure-flags '("--enable-wide-chars" "--enable-256-color"

View File

@ -37,7 +37,7 @@
#:use-module ((gnu packages linux) #:use-module ((gnu packages linux)
#:select (alsa-utils crda eudev e2fsprogs fuse gpm kbd lvm2 rng-tools)) #:select (alsa-utils crda eudev e2fsprogs fuse gpm kbd lvm2 rng-tools))
#:use-module ((gnu packages base) #:use-module ((gnu packages base)
#:select (canonical-package glibc)) #:select (canonical-package glibc glibc-utf8-locales))
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages package-management) #:use-module (gnu packages package-management)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
@ -1499,7 +1499,15 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
#~()) #~())
#$@(if cache #$@(if cache
#~((string-append "--cache=" #$cache)) #~((string-append "--cache=" #$cache))
#~())))) #~()))
;; Make sure we run in a UTF-8 locale so we can produce
;; nars for packages that contain UTF-8 file names such
;; as 'nss-certs'. See <https://bugs.gnu.org/26948>.
#:environment-variables
(list (string-append "GUIX_LOCPATH="
#$glibc-utf8-locales "/lib/locale")
"LC_ALL=en_US.utf8")))
(stop #~(make-kill-destructor))))))) (stop #~(make-kill-destructor)))))))
(define %guix-publish-accounts (define %guix-publish-accounts

View File

@ -41,7 +41,11 @@
nginx-named-location-configuration nginx-named-location-configuration
nginx-named-location-configuration? nginx-named-location-configuration?
nginx-service nginx-service
nginx-service-type)) nginx-service-type
fcgiwrap-configuration
fcgiwrap-configuration?
fcgiwrap-service-type))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -305,3 +309,55 @@ files in LOG-DIRECTORY, and stores temporary runtime files in RUN-DIRECTORY."
(server-blocks server-list) (server-blocks server-list)
(upstream-blocks upstream-list) (upstream-blocks upstream-list)
(file config-file)))) (file config-file))))
(define-record-type* <fcgiwrap-configuration> fcgiwrap-configuration
make-fcgiwrap-configuration
fcgiwrap-configuration?
(package fcgiwrap-configuration-package ;<package>
(default fcgiwrap))
(socket fcgiwrap-configuration-socket
(default "tcp:127.0.0.1:9000"))
(user fcgiwrap-configuration-user
(default "fcgiwrap"))
(group fcgiwrap-configuration-group
(default "fcgiwrap")))
(define fcgiwrap-accounts
(match-lambda
(($ <fcgiwrap-configuration> package socket user group)
(filter identity
(list
(and (equal? group "fcgiwrap")
(user-group
(name "fcgiwrap")
(system? #t)))
(and (equal? user "fcgiwrap")
(user-account
(name "fcgiwrap")
(group group)
(system? #t)
(comment "Fcgiwrap Daemon")
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))))))))
(define fcgiwrap-shepherd-service
(match-lambda
(($ <fcgiwrap-configuration> package socket user group)
(list (shepherd-service
(provision '(fcgiwrap))
(documentation "Run the fcgiwrap daemon.")
(requirement '(networking))
(start #~(make-forkexec-constructor
'(#$(file-append package "/sbin/fcgiwrap")
"-s" #$socket)
#:user #$user #:group #$group))
(stop #~(make-kill-destructor)))))))
(define fcgiwrap-service-type
(service-type (name 'fcgiwrap)
(extensions
(list (service-extension shepherd-root-service-type
fcgiwrap-shepherd-service)
(service-extension account-service-type
fcgiwrap-accounts)))
(default-value (fcgiwrap-configuration))))

View File

@ -174,7 +174,8 @@ else
PS1='\\u@\\h \\w\\$ ' PS1='\\u@\\h \\w\\$ '
fi fi
alias ls='ls -p --color' alias ls='ls -p --color'
alias ll='ls -l'\n")) alias ll='ls -l'
alias grep='grep --color'\n"))
(zlogin (plain-file "zlogin" "\ (zlogin (plain-file "zlogin" "\
# Honor system-wide environment variables # Honor system-wide environment variables
source /etc/profile\n")) source /etc/profile\n"))
@ -189,6 +190,11 @@ set debug-file-directory ~/.guix-profile/lib/debug\n")))
(".bashrc" ,bashrc) (".bashrc" ,bashrc)
(".zlogin" ,zlogin) (".zlogin" ,zlogin)
(".Xdefaults" ,xdefaults) (".Xdefaults" ,xdefaults)
(".guile" ,(plain-file "dot-guile"
(string-append
"(use-modules (ice-9 readline))\n\n"
";; Enable completion at the REPL.\n"
"(activate-readline)\n")))
(".guile-wm" ,guile-wm) (".guile-wm" ,guile-wm)
(".gdbinit" ,gdbinit)))) (".gdbinit" ,gdbinit))))

View File

@ -1,6 +1,7 @@
;;; 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, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -28,6 +29,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 popen) #:use-module (ice-9 popen)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:export (git-reference #:export (git-reference
git-reference? git-reference?
@ -125,45 +127,84 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
"Return the file-name for packages using git-download." "Return the file-name for packages using git-download."
(string-append name "-" version "-checkout")) (string-append name "-" version "-checkout"))
;;;
;;; 'git-predicate'.
;;;
(define (files->directory-tree files)
"Return a tree of vhashes representing the directory listed in FILES, a list
like '(\"a/b\" \"b/c/d\")."
(fold (lambda (file result)
(let loop ((file (string-split file #\/))
(result result))
(match file
((_)
result)
((directory children ...)
(match (vhash-assoc directory result)
(#f
(vhash-cons directory (loop children vlist-null)
result))
((_ . previous)
;; XXX: 'vhash-delete' is O(n).
(vhash-cons directory (loop children previous)
(vhash-delete directory result)))))
(()
result))))
vlist-null
files))
(define (directory-in-tree? tree directory)
"Return true if DIRECTORY, a string like \"a/b\", denotes a directory listed
in TREE."
(let loop ((directory (string-split directory #\/))
(tree tree))
(match directory
(()
#t)
((head . tail)
(match (vhash-assoc head tree)
((_ . sub-tree) (loop tail sub-tree))
(#f #f))))))
(define (git-predicate directory) (define (git-predicate directory)
"Return a predicate that returns true if a file is part of the Git checkout "Return a predicate that returns true if a file is part of the Git checkout
living at DIRECTORY. Upon Git failure, return #f instead of a predicate. living at DIRECTORY. Upon Git failure, return #f instead of a predicate.
The returned predicate takes two arguments FILE and STAT where FILE is an The returned predicate takes two arguments FILE and STAT where FILE is an
absolute file name and STAT is the result of 'lstat'." absolute file name and STAT is the result of 'lstat'."
(define (parent-directory? thing directory) (let* ((pipe (with-directory-excursion directory
;; Return #t if DIRECTORY is the parent of THING. (open-pipe* OPEN_READ "git" "ls-files")))
(or (string-suffix? thing directory) (files (let loop ((lines '()))
(and (string-index thing #\/) (match (read-line pipe)
(parent-directory? (dirname thing) directory)))) ((? eof-object?)
(reverse lines))
(let* ((pipe (with-directory-excursion directory (line
(open-pipe* OPEN_READ "git" "ls-files"))) (loop (cons line lines))))))
(files (let loop ((lines '())) (directory-tree (files->directory-tree files))
(match (read-line pipe) (inodes (fold (lambda (file result)
((? eof-object?) (let ((stat
(reverse lines)) (lstat (string-append directory "/"
(line file))))
(loop (cons line lines)))))) (vhash-consv (stat:ino stat) (stat:dev stat)
(inodes (map (lambda (file) result)))
(let ((stat (lstat vlist-null
(string-append directory "/" file)))) files))
(cons (stat:dev stat) (stat:ino stat)))) (prefix-length (+ 1 (string-length (canonicalize-path directory))))
files)) (status (close-pipe pipe)))
(status (close-pipe pipe)))
(and (zero? status) (and (zero? status)
(lambda (file stat) (lambda (file stat)
(match (stat:type stat) (match (stat:type stat)
('directory ('directory
;; 'git ls-files' does not list directories, only regular files, (directory-in-tree? directory-tree
;; so we need this special trick. (string-drop file prefix-length)))
(any (lambda (f) (parent-directory? f file))
files))
((or 'regular 'symlink) ((or 'regular 'symlink)
;; Comparing file names is always tricky business so we rely on ;; Comparing file names is always tricky business so we rely on
;; inode numbers instead ;; inode numbers instead
(member (cons (stat:dev stat) (stat:ino stat)) (match (vhash-assv (stat:ino stat) inodes)
inodes)) ((_ . dev) (= dev (stat:dev stat)))
(#f #f)))
(_ (_
#f)))))) #f))))))

View File

@ -296,7 +296,7 @@ META."
(upstream-source (upstream-source
(package (package-name package)) (package (package-name package))
(version version) (version version)
(urls url)))))) (urls (list url)))))))
(define %cpan-updater (define %cpan-updater
(upstream-updater (upstream-updater

View File

@ -400,6 +400,7 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
"cat" "/proc/loadavg")) "cat" "/proc/loadavg"))
(line (read-line pipe))) (line (read-line pipe)))
(close-port pipe) (close-port pipe)
(disconnect! session)
(if (eof-object? line) (if (eof-object? line)
+inf.0 ;MACHINE does not respond, so assume it is infinitely loaded +inf.0 ;MACHINE does not respond, so assume it is infinitely loaded
@ -427,13 +428,9 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
"Return the name of the file used as a lock when choosing a build machine." "Return the name of the file used as a lock when choosing a build machine."
(string-append %state-directory "/offload/machine-choice.lock")) (string-append %state-directory "/offload/machine-choice.lock"))
(define %slots
;; List of acquired build slots (open ports).
'())
(define (choose-build-machine machines) (define (choose-build-machine machines)
"Return the best machine among MACHINES, or #f." "Return two values: the best machine among MACHINES and its build
slot (which must later be released with 'release-build-slot'), or #f and #f."
;; Proceed like this: ;; Proceed like this:
;; 1. Acquire the global machine-choice lock. ;; 1. Acquire the global machine-choice lock.
@ -480,14 +477,15 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
;; Release slots from the uninteresting machines. ;; Release slots from the uninteresting machines.
(for-each release-build-slot slots) (for-each release-build-slot slots)
;; Prevent SLOT from being GC'd. ;; The caller must keep SLOT to protect it from GC and to
(set! %slots (cons slot %slots)) ;; eventually release it.
best)) (values best slot)))
(begin (begin
;; BEST is overloaded, so try the next one. ;; BEST is overloaded, so try the next one.
(release-build-slot slot) (release-build-slot slot)
(loop others)))) (loop others))))
(() #f))))) (()
(values #f #f))))))
(define* (process-request wants-local? system drv features (define* (process-request wants-local? system drv features
#:key #:key
@ -505,19 +503,25 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
;; We'll never be able to match REQS. ;; We'll never be able to match REQS.
(display "# decline\n")) (display "# decline\n"))
((x ...) ((x ...)
(let ((machine (choose-build-machine candidates))) (let-values (((machine slot)
(choose-build-machine candidates)))
(if machine (if machine
(begin (dynamic-wind
;; Offload DRV to MACHINE. (const #f)
(display "# accept\n") (lambda ()
(let ((inputs (string-tokenize (read-line))) ;; Offload DRV to MACHINE.
(outputs (string-tokenize (read-line)))) (display "# accept\n")
(transfer-and-offload drv machine (let ((inputs (string-tokenize (read-line)))
#:inputs inputs (outputs (string-tokenize (read-line))))
#:outputs outputs (transfer-and-offload drv machine
#:max-silent-time max-silent-time #:inputs inputs
#:build-timeout build-timeout #:outputs outputs
#:print-build-trace? print-build-trace?))) #:max-silent-time max-silent-time
#:build-timeout build-timeout
#:print-build-trace?
print-build-trace?)))
(lambda ()
(release-build-slot slot)))
;; Not now, all the machines are busy. ;; Not now, all the machines are busy.
(display "# postpone\n"))))))) (display "# postpone\n")))))))

234
guix/scripts/weather.scm Normal file
View File

@ -0,0 +1,234 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; 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 weather)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module (guix derivations)
#:use-module (guix monads)
#:use-module (guix store)
#:use-module (guix grafts)
#:use-module (guix build syscalls)
#:use-module (guix scripts substitute)
#:use-module (gnu packages)
#:use-module (web uri)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (guix-weather))
(define (all-packages)
"Return the list of public packages we are going to query."
(fold-packages (lambda (package result)
(match (package-replacement package)
((? package? replacement)
(cons* replacement package result))
(#f
(cons package result))))
'()))
(define* (package-outputs packages
#:optional (system (%current-system)))
"Return the list of outputs of all of PACKAGES for the given SYSTEM."
(let ((packages (filter (cut supported-package? <> system) packages)))
(define update-progress!
(let ((total (length packages))
(done 0)
(width (max 10 (- (terminal-columns) 10))))
(lambda ()
(set! done (+ 1 done))
(let* ((ratio (/ done total 1.))
(done (inexact->exact (round (* width ratio))))
(left (- width done)))
(format (current-error-port) "~5,1f% [~a~a]\r"
(* ratio 100.)
(make-string done #\#)
(make-string left #\space))
(when (>= done total)
(newline (current-error-port)))
(force-output (current-error-port))))))
(format (current-error-port)
(G_ "computing ~h package derivations for ~a...~%")
(length packages) system)
(foldm %store-monad
(lambda (package result)
(mlet %store-monad ((drv (package->derivation package system
#:graft? #f)))
(update-progress!)
(match (derivation->output-paths drv)
(((names . items) ...)
(return (append items result))))))
'()
packages)))
(cond-expand
(guile-2.2
;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it.
(define time-monotonic time-tai))
(else #t))
(define (call-with-time thunk kont)
"Call THUNK and pass KONT the elapsed time followed by THUNK's return
values."
(let* ((start (current-time time-monotonic))
(result (call-with-values thunk list))
(end (current-time time-monotonic)))
(apply kont (time-difference end start) result)))
(define-syntax-rule (let/time ((time result exp)) body ...)
(call-with-time (lambda () exp) (lambda (time result) body ...)))
(define (report-server-coverage server items)
"Report the subset of ITEMS available as substitutes on SERVER."
(define MiB (* (expt 2 20) 1.))
(format #t (G_ "looking for ~h store items on ~a...~%")
(length items) server)
(let/time ((time narinfos (lookup-narinfos server items)))
(format #t "~a~%" server)
(let ((obtained (length narinfos))
(requested (length items))
(sizes (filter-map narinfo-file-size narinfos))
(time (+ (time-second time)
(/ (time-nanosecond time) 1e9))))
(format #t (G_ " ~2,1f% substitutes available (~h out of ~h)~%")
(* 100. (/ obtained requested 1.))
obtained requested)
(let ((total (/ (reduce + 0 sizes) MiB)))
(match (length sizes)
((? zero?)
(format #t (G_ " unknown substitute sizes~%")))
(len
(if (= len obtained)
(format #t (G_ " ~,1h MiB of nars (compressed)~%") total)
(format #t (G_ " at least ~,1h MiB of nars (compressed)~%")
total)))))
(format #t (G_ " ~,1h MiB on disk (uncompressed)~%")
(/ (reduce + 0 (map narinfo-size narinfos)) MiB))
(format #t (G_ " ~,3h seconds per request (~,1h seconds in total)~%")
(/ time requested 1.) time)
(format #t (G_ " ~,1h requests per second~%")
(/ requested time 1.)))))
;;;
;;; Command-line options.
;;;
(define (show-help)
(display (G_ "Usage: guix weather [OPTIONS]
Report the availability of substitutes.\n"))
(display (G_ "
--substitute-urls=URLS
check for available substitutes at URLS"))
(display (G_ "
-m, --manifest=MANIFEST
look up substitutes for packages specified in MANIFEST"))
(display (G_ "
-s, --system=SYSTEM consider substitutes for SYSTEM--e.g., \"i686-linux\""))
(newline)
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(define %options
(list (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix challenge")))
(option '("substitute-urls") #t #f
(lambda (opt name arg result . rest)
(let ((urls (string-tokenize arg)))
(for-each (lambda (url)
(unless (string->uri url)
(leave (G_ "~a: invalid URL~%") url)))
urls)
(apply values
(alist-cons 'substitute-urls urls
(alist-delete 'substitute-urls result))
rest))))
(option '(#\m "manifest") #t #f
(lambda (opt name arg result)
(alist-cons 'manifest arg result)))
(option '(#\s "system") #t #f
(lambda (opt name arg result)
(alist-cons 'system arg result)))))
(define %default-options
`((substitute-urls . ,%default-substitute-urls)))
(define (load-manifest file)
"Load the manifest from FILE and return the list of packages it refers to."
(let* ((user-module (make-user-module '((guix profiles) (gnu))))
(manifest (load* file user-module)))
(map manifest-entry-item
(manifest-transitive-entries manifest))))
;;;
;;; Entry point.
;;;
(define (guix-weather . args)
(with-error-handling
(let* ((opts (parse-command-line args %options
(list %default-options)))
(urls (assoc-ref opts 'substitute-urls))
(systems (match (filter-map (match-lambda
(('system . system) system)
(_ #f))
opts)
(() (list (%current-system)))
(systems systems)))
(packages (let ((file (assoc-ref opts 'manifest)))
(if file
(load-manifest file)
(all-packages))))
(items (with-store store
(parameterize ((%graft? #f))
(concatenate
(run-with-store store
(mapm %store-monad
(lambda (system)
(package-outputs packages system))
systems)))))))
(for-each (lambda (server)
(report-server-coverage server items))
urls))))
;;; Local Variables:
;;; eval: (put 'let/time 'scheme-indent-function 1)
;;; End:

View File

@ -27,6 +27,7 @@ guix/scripts/graph.scm
guix/scripts/challenge.scm guix/scripts/challenge.scm
guix/scripts/copy.scm guix/scripts/copy.scm
guix/scripts/pack.scm guix/scripts/pack.scm
guix/scripts/weather.scm
guix/gnu-maintenance.scm guix/gnu-maintenance.scm
guix/scripts/container.scm guix/scripts/container.scm
guix/scripts/container/exec.scm guix/scripts/container/exec.scm