diff options
47 files changed, 1182 insertions, 384 deletions
diff --git a/Makefile.am b/Makefile.am index 4d1512f8ce..5888bc0266 100644 --- a/Makefile.am +++ b/Makefile.am @@ -171,6 +171,7 @@ MODULES = \ guix/scripts/import/texlive.scm \ guix/scripts/environment.scm \ guix/scripts/publish.scm \ + guix/scripts/weather.scm \ guix/scripts/edit.scm \ guix/scripts/size.scm \ guix/scripts/graph.scm \ diff --git a/build-aux/hydra/guix.scm b/build-aux/hydra/guix.scm index f496357562..659b8bfbc1 100644 --- a/build-aux/hydra/guix.scm +++ b/build-aux/hydra/guix.scm @@ -1,5 +1,5 @@ ;;; 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. ;;; @@ -43,13 +43,10 @@ (use-modules (guix store) (guix packages) (guix utils) + (guix grafts) (guix derivations) (guix build-system gnu) - (gnu packages version-control) (gnu packages package-management) - (gnu packages imagemagick) - (gnu packages graphviz) - (gnu packages man) (srfi srfi-1) (srfi srfi-26) (ice-9 match)) @@ -63,36 +60,15 @@ #:optional (package-derivation package-derivation)) "Convert PACKAGE to an alist suitable for Hydra." `((derivation . ,(derivation-file-name - (package-derivation store package system))) + (parameterize ((%graft? #f)) + (package-derivation store package system + #:graft? #f)))) (description . ,(package-synopsis package)) (long-description . ,(package-description package)) (license . ,(package-license package)) (home-page . ,(package-home-page package)) (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) "Return Hydra jobs." (define systems @@ -109,9 +85,22 @@ containing a Git checkout of Guix." (define guix-checkout (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)~%" - guix-checkout guix) + guix-checkout file) + `((tarball . ,(cute package->alist store - (tarball-package guix) - (%current-system)))))) + (dist-package guix file) + (%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)))) diff --git a/doc/guix.texi b/doc/guix.texi index dfa1e22fcc..e8c4e0eaf3 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -158,6 +158,7 @@ Utilities * Invoking guix challenge:: Challenging substitute servers. * Invoking guix copy:: Copying to and from a remote store. * Invoking guix container:: Process isolation. +* Invoking guix weather:: Assessing substitute availability. 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 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 @code{guix-daemon} with @code{--no-substitutes} (@pxref{Invoking 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 copy:: Copying to and from a remote store. * Invoking guix container:: Process isolation. +* Invoking guix weather:: Assessing substitute availability. @end menu @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 clients, we recommend using the @option{--cache} option, which enables 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 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 +@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 ********************************************************************* @node GNU Distribution @chapter GNU Distribution @@ -13658,7 +13731,8 @@ Local accounts with lower values will silently fail to authenticate. @cindex web @cindex www @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] @ [#:log-directory ``/var/log/nginx''] @ @@ -13810,6 +13884,56 @@ body of a named location block cannot contain location blocks. @end table @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 @subsubsection DNS Services diff --git a/gnu/local.mk b/gnu/local.mk index acfd2af36f..63894e8ec3 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -270,7 +270,6 @@ GNU_SYSTEM_MODULES = \ %D%/packages/mes.scm \ %D%/packages/messaging.scm \ %D%/packages/mingw.scm \ - %D%/packages/mg.scm \ %D%/packages/microcom.scm \ %D%/packages/moe.scm \ %D%/packages/monitoring.scm \ @@ -563,6 +562,7 @@ dist_patch_DATA = \ %D%/packages/patches/cyrus-sasl-CVE-2013-4122.patch \ %D%/packages/patches/dblatex-remove-multirow.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/diffutils-gets-undeclared.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/eudev-rules-directory.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/fabric-tests.patch \ %D%/packages/patches/fastcap-mulGlobal.patch \ @@ -663,6 +662,7 @@ dist_patch_DATA = \ %D%/packages/patches/gspell-dash-test.patch \ %D%/packages/patches/guile-1.8-cpp-4.5.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-linux-syscalls.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/perl-file-path-CVE-2017-6512.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-finance-quote-unuse-mozilla-ca.patch \ %D%/packages/patches/perl-gd-options-passthrough-and-fontconfig.patch \ diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index 0af43a6c0b..02d9baf493 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -661,14 +661,14 @@ network statistics collection, security monitoring, network debugging, etc.") (define-public tcpdump (package (name "tcpdump") - (version "4.9.0") + (version "4.9.1") (source (origin (method url-fetch) (uri (string-append "http://www.tcpdump.org/release/tcpdump-" version ".tar.gz")) (sha256 (base32 - "0pjsxsy8l71i813sa934cwf1ryp9xbr7nxwsvnzavjdirchq3sga")))) + "1wyqbg7bkmgqyslf1ns0xx9fcqi66hvcfm9nf77rl15jvvs8qi7r")))) (build-system gnu-build-system) (inputs `(("libpcap" ,libpcap) ("openssl" ,openssl))) @@ -2169,7 +2169,7 @@ tool for remote execution and deployment.") (("\"/etc/neofetch") (string-append "\"" out "/etc/neofetch")) (("\"/usr/share/neofetch") - (string-append "\"" out "/usr/share/neofetch")))) + (string-append "\"" out "/share/neofetch")))) #t)) (delete 'configure)))) (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 (package (name "nnn") - (version "1.2") + (version "1.3") (source (origin (method url-fetch) (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")) (sha256 (base32 - "08l0wcwwsl5kix9kg3h51s2afzg97y1rjjfi0ijs294kz57g1cfq")))) + "0sivgcmg3hihz15v2wgbxnd0icn06pyvvqdqh8x0mwkhvm434fpb")))) (build-system gnu-build-system) (inputs `(("ncurses" ,ncurses) ("readline" ,readline))) diff --git a/gnu/packages/certs.scm b/gnu/packages/certs.scm index 2441de6631..c7242dea92 100644 --- a/gnu/packages/certs.scm +++ b/gnu/packages/certs.scm @@ -74,7 +74,7 @@ (define-public nss-certs (package (name "nss-certs") - (version "3.31") + (version "3.32") (source (origin (method url-fetch) (uri (let ((version-with-underscores @@ -85,7 +85,7 @@ "nss-" version ".tar.gz"))) (sha256 (base32 - "0pd643a8ns7q5az5ai3ascrw666i2kbfiyy1c9hlhw9jd8jn21g9")))) + "0dfkgvah0ji8b8lpxyy2w0b3lyz5ldmryii4z7j2bfwnrj0z7iim")))) (build-system gnu-build-system) (outputs '("out")) (native-inputs diff --git a/gnu/packages/compression.scm b/gnu/packages/compression.scm index 6ed4519344..7237931b7d 100644 --- a/gnu/packages/compression.scm +++ b/gnu/packages/compression.scm @@ -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.") (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 (package (name "sharutils") diff --git a/gnu/packages/cups.scm b/gnu/packages/cups.scm index af06ec43f0..aba8ce7eb1 100644 --- a/gnu/packages/cups.scm +++ b/gnu/packages/cups.scm @@ -339,14 +339,14 @@ device-specific programs to convert and print many types of files.") (define-public hplip (package (name "hplip") - (version "3.17.6") + (version "3.17.7") (source (origin (method url-fetch) (uri (string-append "mirror://sourceforge/hplip/hplip/" version "/hplip-" version ".tar.gz")) (sha256 (base32 - "0zhhnp3ksd9i2maaqrsjn4p3y7im3llgylp2y8qgmqypm8s7ha40")))) + "03a0vkbrzvgj15il9rvr93kf5pc706gxcjk6akbkzds0zmdbsxrm")))) (build-system gnu-build-system) (home-page "http://hplipopensource.com/") (synopsis "HP Printer Drivers") diff --git a/gnu/packages/databases.scm b/gnu/packages/databases.scm index f5f3af2c05..994b8499ff 100644 --- a/gnu/packages/databases.scm +++ b/gnu/packages/databases.scm @@ -1015,7 +1015,8 @@ columns, primary keys, unique constraints and relationships.") "DBD-mysql-" version ".tar.gz")) (sha256 (base32 - "16bg7l28n65ngi1abjxvwk906a80i2vd5vzjn812dx8phdg8d7v2")))) + "16bg7l28n65ngi1abjxvwk906a80i2vd5vzjn812dx8phdg8d7v2")) + (patches (search-patches "perl-dbd-mysql-CVE-2017-10788.patch")))) (build-system perl-build-system) ;; Tests require running MySQL server (arguments `(#:tests? #f)) diff --git a/gnu/packages/disk.scm b/gnu/packages/disk.scm index a087141a87..0a6e2c9e1f 100644 --- a/gnu/packages/disk.scm +++ b/gnu/packages/disk.scm @@ -90,7 +90,7 @@ tables. It includes a library and command-line utility.") (define-public fdisk (package (name "fdisk") - (version "2.0.0a") + (version "2.0.0a1") (source (origin (method url-fetch) @@ -98,13 +98,27 @@ tables. It includes a library and command-line utility.") version ".tar.gz")) (sha256 (base32 - "04nd7civ561x2lwcmxhsqbprml3178jfc58fy1v7hzqg5k4nbhy3")))) + "1d8za79kw8ihnp2br084rgyjv9whkwp7957rzw815i0izx6xhqy9")))) (build-system gnu-build-system) (inputs `(("gettext" ,gettext-minimal) ("guile" ,guile-1.8) ("util-linux" ,util-linux) ("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/") (synopsis "Low-level disk partitioning and formatting") (description @@ -245,7 +259,7 @@ and a @command{fsck.vfat} compatibility symlink for use in an initrd.") (define-public sdparm (package (name "sdparm") - (version "1.09") + (version "1.10") (source (origin (method url-fetch) @@ -253,7 +267,7 @@ and a @command{fsck.vfat} compatibility symlink for use in an initrd.") name "-" version ".tar.xz")) (sha256 (base32 - "0jakqyjwi72zqjzss04bally0xl0lc4710mx8da08vpmir1hfphg")))) + "1jjq3lzgfy4r76rc26q02lv4wm5cb4dx5nh913h489zjrr4f3jbx")))) (build-system gnu-build-system) (home-page "http://sg.danny.cz/sg/sdparm.html") (synopsis "Provide access to SCSI device parameters") diff --git a/gnu/packages/game-development.scm b/gnu/packages/game-development.scm index dabe951da8..7ab9a1aefc 100644 --- a/gnu/packages/game-development.scm +++ b/gnu/packages/game-development.scm @@ -7,7 +7,7 @@ ;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016, 2017 Kei Kebreau <kei@openmailbox.org> ;;; 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> ;;; ;;; This file is part of GNU Guix. @@ -209,26 +209,15 @@ necessary. (define-public gzochi (package (name "gzochi") - (version "0.10.1") + (version "0.11.1") (source (origin (method url-fetch) (uri (string-append "mirror://savannah/gzochi/gzochi-" version ".tar.gz")) (sha256 (base32 - "166rawdal45kvanhvi0bkzy1d2pwf1p0lzslb287lcnm9vdw97yy")))) + "13j1m92zhxwkaaja3lg5x0h0b28mrrawdzk9d3hd19031akfxwb3")))) (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))) (inputs `(("bdb" ,bdb) ("glib" ,glib) diff --git a/gnu/packages/games.scm b/gnu/packages/games.scm index 2dec9a3951..d8848f82fa 100644 --- a/gnu/packages/games.scm +++ b/gnu/packages/games.scm @@ -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.") (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 (package (name "freedoom") @@ -725,7 +763,7 @@ asynchronously and at a user-defined speed.") (define-public chess (package (name "chess") - (version "6.2.4") + (version "6.2.5") (source (origin (method url-fetch) @@ -733,7 +771,7 @@ asynchronously and at a user-defined speed.") ".tar.gz")) (sha256 (base32 - "1vw2w3jwnmn44d5vsw47f8y70xvxcsz9m5msq9fgqlzjch15qhiw")))) + "00j8s0npgfdi41a0mr5w9qbdxagdk2v41lcr42rwl1jp6miyk6cs")))) (build-system gnu-build-system) (home-page "https://www.gnu.org/software/chess/") (synopsis "Full chess implementation") diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index b560fe816a..7a7f4d35da 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -61,6 +61,7 @@ #:use-module (gnu packages bison) #:use-module (gnu packages calendar) #:use-module (gnu packages check) + #:use-module (gnu packages cmake) #:use-module (gnu packages cups) #:use-module (gnu packages curl) #: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.") (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 ;; This version from GNOME's repository includes fixes for compiling with ;; recent versions of the build tools. The latest activity on the @@ -609,16 +687,15 @@ forgotten when the session ends.") (define-public evince (package (name "evince") - (version "3.24.0") + (version "3.24.1") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" (version-major+minor version) "/" name "-" version ".tar.xz")) - (patches (search-patches "evince-CVE-2017-1000083.patch")) (sha256 (base32 - "13yw0i68dgqp9alyliy3zifszh7rikkpi1xbz5binvxxgfpraf04")))) + "0dqgzwxl0xfr341r5i8j8hn6j6rhv62lmc6xbzjppcq76hhwb84w")))) (build-system glib-or-gtk-build-system) (arguments `(#:configure-flags '("--disable-nautilus") diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm index d4f1018f86..0fb25d8432 100644 --- a/gnu/packages/gnuzilla.scm +++ b/gnu/packages/gnuzilla.scm @@ -249,7 +249,7 @@ in C/C++.") (define-public nspr (package (name "nspr") - (version "4.15") + (version "4.16") (source (origin (method url-fetch) (uri (string-append @@ -257,7 +257,7 @@ in C/C++.") version "/src/nspr-" version ".tar.gz")) (sha256 (base32 - "101dksqm1z0hzd7ap82ccbxjr48s6q3xhshdl81qkj6hqdmy1p97")))) + "1l9wlnb9y0bzicv448jjl9kssqn044dc2qrkwzp4ll35fvch4ccv")))) (build-system gnu-build-system) (native-inputs `(("perl" ,perl))) @@ -281,7 +281,7 @@ in the Mozilla clients.") (define-public nss (package (name "nss") - (version "3.31") + (version "3.32") (source (origin (method url-fetch) (uri (let ((version-with-underscores @@ -292,7 +292,7 @@ in the Mozilla clients.") "nss-" version ".tar.gz"))) (sha256 (base32 - "0pd643a8ns7q5az5ai3ascrw666i2kbfiyy1c9hlhw9jd8jn21g9")) + "0dfkgvah0ji8b8lpxyy2w0b3lyz5ldmryii4z7j2bfwnrj0z7iim")) ;; Create nss.pc and nss-config. (patches (search-patches "nss-pkgconfig.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 ;; seems to be used only during the tests. (delete-file (string-append lib "/libgtest1.so")) + (delete-file (string-append lib "/libgtestutil.so")) #t)))))) (inputs diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index 0d1989e524..0297b9b21d 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -1554,16 +1554,28 @@ is no support for parsing block and inline level HTML.") (file-name (string-append name "-" version "-checkout")) (sha256 (base32 - "04lgh0nk6ddnwgh20hnz4pyhczaik0xbd50kikjsxcwcl46shavb")))) + "04lgh0nk6ddnwgh20hnz4pyhczaik0xbd50kikjsxcwcl46shavb")) + (patches (search-patches "guile-bytestructures-name-clash.patch")))) (build-system trivial-build-system) (arguments `(#:modules ((guix build utils)) #:builder (begin (use-modules (guix build utils) + (ice-9 ftw) (ice-9 match) (ice-9 popen) (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")) (guile (assoc-ref %build-inputs "guile")) (effective (read-line @@ -1572,7 +1584,7 @@ is no support for parsing block and inline level HTML.") "-c" "(display (effective-version))"))) (module-dir (string-append out "/share/guile/site/" effective)) - (source (assoc-ref %build-inputs "source")) + (source (getcwd)) (doc (string-append out "/share/doc/scheme-bytestructures")) (sld-files (with-directory-excursion source (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. (install-file "README.md" doc) #t)))) + (native-inputs + `(("tar" ,tar) + ("xz" ,xz))) (inputs `(("guile" ,guile-2.2))) (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.") (license license:gpl3+))) +(define-public guile2.0-bytestructures + (package-for-guile-2.0 guile-bytestructures)) + (define-public guile-aspell (package (name "guile-aspell") @@ -1838,6 +1856,9 @@ is not available for Guile 2.0.") manipulate repositories of the Git version control system.") (license license:gpl3+)))) +(define-public guile2.0-git + (package-for-guile-2.0 guile-git)) + (define-public guile-syntax-highlight (let ((commit "a047675e66861b647426372aa2ba7820f749616d") (revision "0")) diff --git a/gnu/packages/image-viewers.scm b/gnu/packages/image-viewers.scm index 6d85fce40b..644780b5e9 100644 --- a/gnu/packages/image-viewers.scm +++ b/gnu/packages/image-viewers.scm @@ -54,7 +54,7 @@ (define-public feh (package (name "feh") - (version "2.19") + (version "2.19.1") (home-page "https://feh.finalrewind.org/") (source (origin (method url-fetch) @@ -62,11 +62,11 @@ name "-" version ".tar.bz2")) (sha256 (base32 - "1sfhr6628xpj9p6bqihdq35y139x2gmrpydjlrwsl1rs77c2bgnf")))) + "1d4ycmai3dpajl0bdr9i56646g4h5j1lb95jjn0nckwcddcj927c")))) (build-system gnu-build-system) (arguments '(#:phases (alist-delete 'configure %standard-phases) - #:tests? #f + #:tests? #f ;FIXME: Requires 'perl-test-command'. #:make-flags (list "CC=gcc" (string-append "PREFIX=" (assoc-ref %outputs "out"))))) (inputs `(("imlib2" ,imlib2) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index f8093f590f..d0504f823d 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -106,6 +106,7 @@ #:use-module (guix build-system python) #:use-module (guix build-system trivial) #:use-module (guix download) + #:use-module (guix git-download) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #: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.") (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 ;; XXX: This package is basically unmaintained, but it provides a few ;; commands not yet provided by Inetutils, such as 'route', so we have to ;; live with it. - (package - (name "net-tools") + (let ((commit "479bb4a7e11a4084e2935c0a576388f92469225b") + (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") - (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 (method url-fetch) (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 ;; 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 (method url-fetch) (uri "http://ftp.de.debian.org/debian/pool/main/n/net-tools/net-tools_1.60-24.2.diff.gz") (sha256 (base32 - "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+))) + "0p93lsqx23v5fv4hpbrydmfvw1ha2rgqpn2zqbs2jhxkzhjc030p"))))))))) (define-public libcap (package diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index e92ae2ebfe..224cea56f6 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -88,6 +88,10 @@ `(#: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. #: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 (add-before 'configure 'pre-conf (lambda _ @@ -104,6 +108,27 @@ (string-append "SHELL=" (which "bash"))) (("SHELL=/bin/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)) ;; drop strip phase to make maxima build, see ;; https://www.ma.utexas.edu/pipermail/maxima/2008/009769.html diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index 7374cdda1f..cc76a93ed0 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -667,14 +667,14 @@ invoking @command{notifymuch} from the post-new hook.") (define-public notmuch (package (name "notmuch") - (version "0.24.2") + (version "0.25") (source (origin (method url-fetch) (uri (string-append "https://notmuchmail.org/releases/notmuch-" version ".tar.gz")) (sha256 (base32 - "0lfchvapk11qazdgsxj42igp9mpp83zbd0h1jj6r3ifmhikajxma")))) + "02z6d87ip1hkipz8d7w0sfklg8dd5fd5vlgp768640ixg0gqvlk5")))) (build-system gnu-build-system) (arguments '(#:make-flags (list "V=1") ; Verbose test output. @@ -930,6 +930,11 @@ compresses it.") (arguments '(#:configure-flags '("--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 (add-before 'build 'patch-mime (lambda* (#:key inputs #:allow-other-keys) diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index 87cc46b0a4..4a29b43aa3 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -316,7 +316,7 @@ the OCaml language.") (define-public glpk (package (name "glpk") - (version "4.62") + (version "4.63") (source (origin (method url-fetch) @@ -324,7 +324,7 @@ the OCaml language.") version ".tar.gz")) (sha256 (base32 - "0w7s3869ybwyq9a4490dikpib1qp3jnn5nqz1vvwqy1qz3ilnvh9")))) + "1xp7nclmp8inp20968bvvfcwmz3mz03sbm0v3yjz8aqwlpqjfkci")))) (build-system gnu-build-system) (inputs `(("gmp" ,gmp))) @@ -2075,8 +2075,7 @@ to BMP, JPEG or PNG image formats.") (patches (search-patches "maxima-defsystem-mkdir.patch")))) (build-system gnu-build-system) (inputs - `(("gcc" ,gcc) - ("gcl" ,gcl) + `(("gcl" ,gcl) ("gnuplot" ,gnuplot) ;for plots ("tk" ,tk))) ;Tcl/Tk is used by 'xmaxima' (native-inputs @@ -2100,13 +2099,6 @@ to BMP, JPEG or PNG image formats.") #:make-flags (list "TMPDIR=/tmp") #: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 (lambda _ (chmod "src/maxima" #o555) @@ -2118,7 +2110,9 @@ to BMP, JPEG or PNG image formats.") (lambda* (#:key outputs inputs #:allow-other-keys) (let* ((gnuplot (assoc-ref inputs "gnuplot")) (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 (mkdir-p "share/emacs") (mkdir-p "share/doc") @@ -2134,7 +2128,11 @@ to BMP, JPEG or PNG image formats.") (format out "~a ~s~a~%" "(setf $gnuplot_command " (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))))) (home-page "http://maxima.sourceforge.net") (synopsis "Numeric and symbolic expression manipulation") diff --git a/gnu/packages/mg.scm b/gnu/packages/mg.scm deleted file mode 100644 index 5df6770009..0000000000 --- a/gnu/packages/mg.scm +++ /dev/null @@ -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))) diff --git a/gnu/packages/mpi.scm b/gnu/packages/mpi.scm index 3b1ba003c6..54fdd35ad5 100644 --- a/gnu/packages/mpi.scm +++ b/gnu/packages/mpi.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net> ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr> +;;; Copyright © 2017 Dave Love <fx@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -110,7 +111,7 @@ bind processes, and much more.") (define-public openmpi (package (name "openmpi") - (version "1.10.3") + (version "1.10.7") (source (origin (method url-fetch) @@ -119,8 +120,9 @@ bind processes, and much more.") "/downloads/openmpi-" version ".tar.bz2")) (sha256 (base32 - "0k95ri9f8kzx5vhzrdbzn59rn2324fs4a96w5v8jy20j8dkbp13l")))) + "142s1vny9gllkq336yafxayjgcirj2jv0ddabj879jgya7hyr2d0")))) (build-system gnu-build-system) + (outputs '("out" "static")) (inputs `(("hwloc" ,hwloc "lib") ("gfortran" ,gfortran) @@ -137,6 +139,7 @@ bind processes, and much more.") "--enable-mpi-ext=all" "--with-devel-headers" "--enable-memchecker" + "--with-sge" ,(string-append "--with-valgrind=" (assoc-ref %build-inputs "valgrind")) ,(string-append "--with-hwloc=" @@ -153,11 +156,25 @@ bind processes, and much more.") (lambda* (#:key outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out"))) (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)))))) (home-page "http://www.open-mpi.org") - (synopsis "MPI-2 implementation") + (synopsis "MPI-3 implementation") (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 MPI is therefore able to combine the expertise, technologies, and resources from all across the High Performance Computing community in order to build the diff --git a/gnu/packages/ncurses.scm b/gnu/packages/ncurses.scm index 65531ec202..9f5905bc89 100644 --- a/gnu/packages/ncurses.scm +++ b/gnu/packages/ncurses.scm @@ -206,7 +206,7 @@ ncursesw library provides wide character support.") (define-public dialog (package (name "dialog") - (version "1.2-20150920") + (version "1.3-20170509") (source (origin (method url-fetch) (uri (string-append @@ -214,7 +214,7 @@ ncursesw library provides wide character support.") version ".tgz")) (sha256 (base32 - "01ccd585c241nkj02n0zdbx8jqhylgcfpcmmshynh0c7fv2ixrn4")))) + "0mj7rl5psilaj3bxxvjfd44qjknxjli98b0d1lxd3f9jqrsbmw9g")))) (build-system gnu-build-system) (arguments `(#:tests? #f)) ; no test suite diff --git a/gnu/packages/networking.scm b/gnu/packages/networking.scm index 2f4d3d233e..5f555ee67f 100644 --- a/gnu/packages/networking.scm +++ b/gnu/packages/networking.scm @@ -441,7 +441,7 @@ and up to 1 Mbit/s downstream.") (define-public whois (package (name "whois") - (version "5.2.16") + (version "5.2.17") (source (origin (method url-fetch) @@ -449,7 +449,7 @@ and up to 1 Mbit/s downstream.") name "_" version ".tar.xz")) (sha256 (base32 - "0fpwac26ja0rdqsbxyjcsk8gxgixfpxk0baj3rhnpaff3jv0ilp9")))) + "0r4np8gaxhy9c0v795dc4dhxms9zak31vd378sb1h7jpixkqax95")))) (build-system gnu-build-system) ;; TODO: unbundle mkpasswd binary + its po files. (arguments diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 8a5062802c..b2e4a6a2c8 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -76,8 +76,8 @@ ;; Note: the 'update-guix-package.scm' script expects this definition to ;; start precisely like this. (let ((version "0.13.0") - (commit "b547349d505c57fd679b6e48c472d8ab65469c96") - (revision 3)) + (commit "f1ddfe4f14b8a8d963f2f3e68d800b745696246d") + (revision 4)) (package (name "guix") @@ -93,7 +93,7 @@ (commit commit))) (sha256 (base32 - "0q6qr9hvrac1wj2ygn4jj4w89h1m35zkcjjd741sibc3l46pa93l")) + "11yjsn957igh6migxrnicdqrxc76skz5r0l7hfnm5gp45my1kd9p")) (file-name (string-append "guix-" version "-checkout")))) (build-system gnu-build-system) (arguments diff --git a/gnu/packages/patches/deja-dup-use-ref-keyword-for-iter.patch b/gnu/packages/patches/deja-dup-use-ref-keyword-for-iter.patch new file mode 100644 index 0000000000..a03e0c5481 --- /dev/null +++ b/gnu/packages/patches/deja-dup-use-ref-keyword-for-iter.patch @@ -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 + diff --git a/gnu/packages/patches/evince-CVE-2017-1000083.patch b/gnu/packages/patches/evince-CVE-2017-1000083.patch deleted file mode 100644 index 2ca062f337..0000000000 --- a/gnu/packages/patches/evince-CVE-2017-1000083.patch +++ /dev/null @@ -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 - diff --git a/gnu/packages/patches/guile-bytestructures-name-clash.patch b/gnu/packages/patches/guile-bytestructures-name-clash.patch new file mode 100644 index 0000000000..ac834dd504 --- /dev/null +++ b/gnu/packages/patches/guile-bytestructures-name-clash.patch @@ -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 + ) diff --git a/gnu/packages/patches/nss-pkgconfig.patch b/gnu/packages/patches/nss-pkgconfig.patch index a33e05fcf2..e3145aa4cf 100644 --- a/gnu/packages/patches/nss-pkgconfig.patch +++ b/gnu/packages/patches/nss-pkgconfig.patch @@ -221,5 +221,5 @@ Later adapted to apply cleanly to nss-3.21. RELEASE = nss --DIRS = coreconf lib cmd gtests -+DIRS = coreconf lib cmd gtests config +-DIRS = coreconf lib cmd cpputil gtests ++DIRS = coreconf lib cmd cpputil gtests config diff --git a/gnu/packages/patches/perl-dbd-mysql-CVE-2017-10788.patch b/gnu/packages/patches/perl-dbd-mysql-CVE-2017-10788.patch new file mode 100644 index 0000000000..74613cb632 --- /dev/null +++ b/gnu/packages/patches/perl-dbd-mysql-CVE-2017-10788.patch @@ -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 diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index c903de4c36..a088fefb86 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -4659,7 +4659,7 @@ reruns flaky tests. Ideally, tests reliably pass or fail, but sometimes test fixtures must rely 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.") (license license:asl2.0))) @@ -5876,7 +5876,11 @@ features useful for text console applications.") (inherit python2-urwid) (arguments (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 ;; Disable the vterm tests because of non-deterministic failures ;; 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 (package (name "python-cryptography-vectors") - (version "2.0") + (version "2.0.2") (source (origin (method url-fetch) (uri (pypi-uri "cryptography_vectors" version)) (sha256 (base32 - "0qadys01517k5wy0rifxip02p08kzrqxm5j0lmmlp0kr07h9jc7h")))) + "0yvi2cp23rg20bq3hd47ixbvjh0zgxnxrriqx5v17d7vkmliwbsi")))) (build-system python-build-system) (home-page "https://github.com/pyca/cryptography") (synopsis "Test vectors for the cryptography package") @@ -7659,14 +7663,14 @@ responses, rather than doing any computation.") (define-public python-cryptography (package (name "python-cryptography") - (version "2.0") + (version "2.0.2") (source (origin (method url-fetch) (uri (pypi-uri "cryptography" version)) (sha256 (base32 - "1c40qlxyn1jgg99f3pqi7146d3561rn9zdqc7w8f7kwr9ysm696k")))) + "1aq6ilnf2zdqshwqai4w8gmb5y6p7ip34qrjp1yb7sz77rkb501p")))) (build-system python-build-system) (inputs `(("openssl" ,openssl))) @@ -15812,3 +15816,30 @@ pure Python module.") (define-public python2-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)) diff --git a/gnu/packages/statistics.scm b/gnu/packages/statistics.scm index 604bdf9c5f..e9bda5c1fa 100644 --- a/gnu/packages/statistics.scm +++ b/gnu/packages/statistics.scm @@ -3900,14 +3900,14 @@ hierarchical clustering dendrograms.") (define-public r-preprocesscore (package (name "r-preprocesscore") - (version "1.38.0") + (version "1.38.1") (source (origin (method url-fetch) (uri (bioconductor-uri "preprocessCore" version)) (sha256 (base32 - "1vq8hwxz73j93q0ldw5bnhbas1f2ha5q1lr9pp4l8gp8zdwzfrjn")))) + "1ggvmak13rhxc4ghf16ncjfvgszc8yvza93s2l9kn8yiwr96vp2h")))) (properties `((upstream-name . "preprocessCore"))) (build-system r-build-system) diff --git a/gnu/packages/text-editors.scm b/gnu/packages/text-editors.scm index 98df48119a..7843c120aa 100644 --- a/gnu/packages/text-editors.scm +++ b/gnu/packages/text-editors.scm @@ -3,7 +3,8 @@ ;;; Copyright © 2016 Carlo Zancanaro <carlo@zancanaro.id.au> ;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org> ;;; 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. ;;; @@ -26,6 +27,7 @@ #:use-module (guix git-download) #:use-module (guix utils) #:use-module (guix build-system gnu) + #:use-module (guix build-system glib-or-gtk) #:use-module ((guix licenses) #:prefix license:) #:use-module (gnu packages) #:use-module (gnu packages assembly) @@ -34,6 +36,7 @@ #:use-module (gnu packages gcc) #:use-module (gnu packages glib) #:use-module (gnu packages gtk) + #:use-module (gnu packages libbsd) #:use-module (gnu packages lua) #:use-module (gnu packages ncurses) #:use-module (gnu packages pkg-config) @@ -178,7 +181,7 @@ bindings and many of the powerful features of GNU Emacs.") (sha256 (base32 "0b0az2wvqgvam7w0ns1j8xp2llslm1rx6h7zcsy06a7j0yp257cm")))) - (build-system gnu-build-system) + (build-system glib-or-gtk-build-system) (native-inputs `(("intltool" ,intltool) ("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.") (supported-systems '("x86_64-linux" "i686-linux")) (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))) diff --git a/gnu/packages/tls.scm b/gnu/packages/tls.scm index 4d2ddd9279..5a94ac6198 100644 --- a/gnu/packages/tls.scm +++ b/gnu/packages/tls.scm @@ -131,6 +131,9 @@ coordinating the use of PKCS#11 by different components or libraries living in the same process.") (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 (package (name "gnutls") @@ -185,7 +188,7 @@ living in the same process.") "debug" "doc")) ;4.1 MiB of man pages (native-inputs - `(("net-tools" ,net-tools) + `(("net-tools" ,net-tools-for-tests) ("pkg-config" ,pkg-config) ("which" ,which))) (inputs diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 0d10af020c..2e17201a5f 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -785,14 +785,14 @@ following features: (define-public subversion (package (name "subversion") - (version "1.8.17") + (version "1.8.18") (source (origin (method url-fetch) (uri (string-append "https://archive.apache.org/dist/subversion/" "subversion-" version ".tar.bz2")) (sha256 (base32 - "1450fkj1jmxyphqn6cd95z1ykwsabajm9jw4i412qpwss8w9a4fy")))) + "19lpqdrl86mjfdpayhn3f9rkmpb6zs2iny38cnxq6wcj7snh0sz5")))) (build-system gnu-build-system) (arguments '(#:phases diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm index d953ca0fd4..7f3f1ce8d6 100644 --- a/gnu/packages/video.scm +++ b/gnu/packages/video.scm @@ -1238,7 +1238,7 @@ other site that youtube-dl supports.") (define-public you-get (package (name "you-get") - (version "0.4.775") + (version "0.4.803") (source (origin (method url-fetch) (uri (string-append @@ -1247,7 +1247,7 @@ other site that youtube-dl supports.") (file-name (string-append name "-" version ".tar.gz")) (sha256 (base32 - "1pjjv42c9bysnj8s3c6v0g6b00lr7b21y8ypibnzd6z0jxlsq7sz")))) + "1rjy809x67dadzvj3midkhcda2kp6rqmbj6rbhjd5f16rvqgn7jp")))) (build-system python-build-system) (arguments ;; no tests diff --git a/gnu/packages/webkit.scm b/gnu/packages/webkit.scm index 8d04242743..5ab27b49f5 100644 --- a/gnu/packages/webkit.scm +++ b/gnu/packages/webkit.scm @@ -53,14 +53,14 @@ (define-public webkitgtk (package (name "webkitgtk") - (version "2.16.5") + (version "2.16.6") (source (origin (method url-fetch) (uri (string-append "https://www.webkitgtk.org/releases/" name "-" version ".tar.xz")) (sha256 (base32 - "1m3xpqs6ddq3m8z6vn83mqh5mkagxlp68vl5qnc7hxcf8brrc0wf")))) + "08abxbhi2n1pfby9f2c20z8mpmbvbs2z7vf0p5ckq4jkz46na8zw")))) (build-system cmake-build-system) (arguments '(#:tests? #f ; no tests diff --git a/gnu/packages/xiph.scm b/gnu/packages/xiph.scm index 5f6f47f305..47274411b5 100644 --- a/gnu/packages/xiph.scm +++ b/gnu/packages/xiph.scm @@ -322,15 +322,14 @@ ogginfo, to obtain information (tags, bitrate, length, etc.) about (define opus (package (name "opus") - (version "1.2") + (version "1.2.1") (source (origin (method url-fetch) - (uri (string-append - "http://downloads.xiph.org/releases/opus/opus-" version - ".tar.gz")) + (uri (string-append "https://archive.mozilla.org/pub/opus/opus-" + version ".tar.gz")) (sha256 (base32 - "1ad9q2g9vivx409jdsslv1hrh5r616qz2pjm96y8ymsigfl4bnvp")))) + "0ch7yzgg4bn1g36bpjsfrgs4n19c84d7wpdida6yzifrrhwx7byg")))) (build-system gnu-build-system) (synopsis "Versatile audio codec") (description diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm index 8155b96665..9acfe03efe 100644 --- a/gnu/packages/xorg.scm +++ b/gnu/packages/xorg.scm @@ -5707,14 +5707,14 @@ to answer a question. Xmessage can also exit after a specified time.") (define-public xterm (package (name "xterm") - (version "322") + (version "330") (source (origin (method url-fetch) (uri (string-append "ftp://ftp.invisible-island.net/xterm/" "xterm-" version ".tgz")) (sha256 (base32 - "1mh9s5g3fs64iimnl7axk0isb5306dyshisxlv5gr8vn7ysl3nws")))) + "1psnfmqd23v9gxj8a98nzrgvymrk0p1whwqi92gy15bbkzrgkvks")))) (build-system gnu-build-system) (arguments '(#:configure-flags '("--enable-wide-chars" "--enable-256-color" diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 813535ed65..e28e0d7ac5 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -37,7 +37,7 @@ #:use-module ((gnu packages linux) #:select (alsa-utils crda eudev e2fsprogs fuse gpm kbd lvm2 rng-tools)) #: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 package-management) #:use-module (gnu packages linux) @@ -1499,7 +1499,15 @@ failed to register hydra.gnu.org public key: ~a~%" status)))))))) #~()) #$@(if 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))))))) (define %guix-publish-accounts diff --git a/gnu/services/web.scm b/gnu/services/web.scm index f85b412159..c605d76866 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -41,7 +41,11 @@ nginx-named-location-configuration nginx-named-location-configuration? nginx-service - nginx-service-type)) + nginx-service-type + + fcgiwrap-configuration + fcgiwrap-configuration? + fcgiwrap-service-type)) ;;; Commentary: ;;; @@ -305,3 +309,55 @@ files in LOG-DIRECTORY, and stores temporary runtime files in RUN-DIRECTORY." (server-blocks server-list) (upstream-blocks upstream-list) (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)))) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 712e6df8d8..236807c70a 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -174,7 +174,8 @@ else PS1='\\u@\\h \\w\\$ ' fi alias ls='ls -p --color' -alias ll='ls -l'\n")) +alias ll='ls -l' +alias grep='grep --color'\n")) (zlogin (plain-file "zlogin" "\ # Honor system-wide environment variables source /etc/profile\n")) @@ -189,6 +190,11 @@ set debug-file-directory ~/.guix-profile/lib/debug\n"))) (".bashrc" ,bashrc) (".zlogin" ,zlogin) (".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) (".gdbinit" ,gdbinit)))) diff --git a/guix/git-download.scm b/guix/git-download.scm index 316835502c..5019a3e62f 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -1,6 +1,7 @@ ;;; 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 Christopher Baines <mail@cbaines.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,6 +29,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 popen) #:use-module (ice-9 rdelim) + #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:export (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." (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) "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. The returned predicate takes two arguments FILE and STAT where FILE is an absolute file name and STAT is the result of 'lstat'." - (define (parent-directory? thing directory) - ;; Return #t if DIRECTORY is the parent of THING. - (or (string-suffix? thing directory) - (and (string-index thing #\/) - (parent-directory? (dirname thing) directory)))) - - (let* ((pipe (with-directory-excursion directory - (open-pipe* OPEN_READ "git" "ls-files"))) - (files (let loop ((lines '())) - (match (read-line pipe) - ((? eof-object?) - (reverse lines)) - (line - (loop (cons line lines)))))) - (inodes (map (lambda (file) - (let ((stat (lstat - (string-append directory "/" file)))) - (cons (stat:dev stat) (stat:ino stat)))) - files)) - (status (close-pipe pipe))) + (let* ((pipe (with-directory-excursion directory + (open-pipe* OPEN_READ "git" "ls-files"))) + (files (let loop ((lines '())) + (match (read-line pipe) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + (directory-tree (files->directory-tree files)) + (inodes (fold (lambda (file result) + (let ((stat + (lstat (string-append directory "/" + file)))) + (vhash-consv (stat:ino stat) (stat:dev stat) + result))) + vlist-null + files)) + (prefix-length (+ 1 (string-length (canonicalize-path directory)))) + (status (close-pipe pipe))) (and (zero? status) (lambda (file stat) (match (stat:type stat) ('directory - ;; 'git ls-files' does not list directories, only regular files, - ;; so we need this special trick. - (any (lambda (f) (parent-directory? f file)) - files)) + (directory-in-tree? directory-tree + (string-drop file prefix-length))) ((or 'regular 'symlink) ;; Comparing file names is always tricky business so we rely on ;; inode numbers instead - (member (cons (stat:dev stat) (stat:ino stat)) - inodes)) + (match (vhash-assv (stat:ino stat) inodes) + ((_ . dev) (= dev (stat:dev stat))) + (#f #f))) (_ #f)))))) diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index a41f918049..9ee69e5296 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -296,7 +296,7 @@ META." (upstream-source (package (package-name package)) (version version) - (urls url)))))) + (urls (list url))))))) (define %cpan-updater (upstream-updater diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 566d117b02..d3cb64d604 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -400,6 +400,7 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable." "cat" "/proc/loadavg")) (line (read-line pipe))) (close-port pipe) + (disconnect! session) (if (eof-object? line) +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." (string-append %state-directory "/offload/machine-choice.lock")) - -(define %slots - ;; List of acquired build slots (open ports). - '()) - (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: ;; 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. (for-each release-build-slot slots) - ;; Prevent SLOT from being GC'd. - (set! %slots (cons slot %slots)) - best)) + ;; The caller must keep SLOT to protect it from GC and to + ;; eventually release it. + (values best slot))) (begin ;; BEST is overloaded, so try the next one. (release-build-slot slot) (loop others)))) - (() #f))))) + (() + (values #f #f)))))) (define* (process-request wants-local? system drv features #:key @@ -505,19 +503,25 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable." ;; We'll never be able to match REQS. (display "# decline\n")) ((x ...) - (let ((machine (choose-build-machine candidates))) + (let-values (((machine slot) + (choose-build-machine candidates))) (if machine - (begin - ;; Offload DRV to MACHINE. - (display "# accept\n") - (let ((inputs (string-tokenize (read-line))) - (outputs (string-tokenize (read-line)))) - (transfer-and-offload drv machine - #:inputs inputs - #:outputs outputs - #:max-silent-time max-silent-time - #:build-timeout build-timeout - #:print-build-trace? print-build-trace?))) + (dynamic-wind + (const #f) + (lambda () + ;; Offload DRV to MACHINE. + (display "# accept\n") + (let ((inputs (string-tokenize (read-line))) + (outputs (string-tokenize (read-line)))) + (transfer-and-offload drv machine + #:inputs inputs + #:outputs outputs + #: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. (display "# postpone\n"))))))) diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm new file mode 100644 index 0000000000..4c4dfac8f6 --- /dev/null +++ b/guix/scripts/weather.scm @@ -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: diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 6ec3e8d405..b8e0aca877 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -27,6 +27,7 @@ guix/scripts/graph.scm guix/scripts/challenge.scm guix/scripts/copy.scm guix/scripts/pack.scm +guix/scripts/weather.scm guix/gnu-maintenance.scm guix/scripts/container.scm guix/scripts/container/exec.scm |