From d663e5e6001fa3d23bb80848cd46560c92ea92c8 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Wed, 4 May 2016 12:46:01 -0400 Subject: [PATCH 01/47] gnu: imagemagick: Update to 6.9.3-10. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes CVE-2016–3714. * gnu/packages/imagemagick.scm (imagemagick): Update to 6.9.3-10. [source]: Remove patch. * gnu/packages/patches/imagemagick-test-segv.patch: Delete. * gnu/local.mk (dist_patch_DATA): Remove patch file from distribution. --- gnu/local.mk | 1 - gnu/packages/imagemagick.scm | 5 ++--- .../patches/imagemagick-test-segv.patch | 20 ------------------- 3 files changed, 2 insertions(+), 24 deletions(-) delete mode 100644 gnu/packages/patches/imagemagick-test-segv.patch diff --git a/gnu/local.mk b/gnu/local.mk index a01efa9224..6f9b1b1019 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -544,7 +544,6 @@ dist_patch_DATA = \ gnu/packages/patches/icu4c-CVE-2015-1270.patch \ gnu/packages/patches/icu4c-CVE-2015-4760.patch \ gnu/packages/patches/ilmbase-fix-tests.patch \ - gnu/packages/patches/imagemagick-test-segv.patch \ gnu/packages/patches/imlib2-CVE-2016-4024.patch \ gnu/packages/patches/irrlicht-mesa-10.patch \ gnu/packages/patches/jasper-CVE-2007-2721.patch \ diff --git a/gnu/packages/imagemagick.scm b/gnu/packages/imagemagick.scm index 2bdc333d91..095f662376 100644 --- a/gnu/packages/imagemagick.scm +++ b/gnu/packages/imagemagick.scm @@ -40,15 +40,14 @@ (define-public imagemagick (package (name "imagemagick") - (version "6.9.2-1") + (version "6.9.3-10") (source (origin (method url-fetch) (uri (string-append "mirror://imagemagick/ImageMagick-" version ".tar.xz")) (sha256 (base32 - "159afhqrj22jlz745ccbgnkdiwvn8pjcc96jic0iv9ms7gqxwln5")) - (patches (search-patches "imagemagick-test-segv.patch")))) + "0sik2jl1cywnpr5xm28mjhs1l8kxry65f3v2kqzp0cczhwf04gz3")))) (build-system gnu-build-system) (arguments `(#:configure-flags '("--with-frozenpaths") diff --git a/gnu/packages/patches/imagemagick-test-segv.patch b/gnu/packages/patches/imagemagick-test-segv.patch deleted file mode 100644 index 6626e54828..0000000000 --- a/gnu/packages/patches/imagemagick-test-segv.patch +++ /dev/null @@ -1,20 +0,0 @@ -This patch works around a segmentation fault in 'Magick++/tests/color' when -running 'Magick++/tests/tests.tap'. Here we get an exception early on, which -is supposedly harmless: - - Caught exception: color: UnableToOpenConfigureFile `colors.xml' @ warning/configure.c/GetConfigureOptions/706 - -However, when the stack unwinders run, 'UnregisterDOTImage' gets called even -though 'RegisterDOTImage' hadn't been called yet; thus, 'graphic_context' in -coders/dot.c is NULL, leading to the segfault. - ---- ImageMagick-6.9.2-1/coders/dot.c 2015-09-16 17:32:42.900323334 +0200 -+++ ImageMagick-6.9.2-1/coders/dot.c 2015-09-16 17:32:48.312367636 +0200 -@@ -240,6 +240,7 @@ ModuleExport void UnregisterDOTImage(voi - (void) UnregisterMagickInfo("GV"); - (void) UnregisterMagickInfo("DOT"); - #if defined(MAGICKCORE_GVC_DELEGATE) -+ if (graphic_context != NULL) - gvFreeContext(graphic_context); - #endif - } From 8c15e084fe5fd9492f61128c9995bb1741d225e3 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 4 May 2016 13:49:10 -0400 Subject: [PATCH 02/47] gnu: imlib2: Update to 1.4.9 [fixes CVE-2011-5326, CVE-2016-{3993,3994}]. * gnu/packages/image.scm (imlib2): Update to 1.4.9. [source]: Remove patch. * gnu/packages/patches/imlib2-CVE-2016-4024.patch: Delete file. * gnu/local.mk (dist_patch_DATA): Remove it. --- gnu/local.mk | 1 - gnu/packages/image.scm | 5 +- .../patches/imlib2-CVE-2016-4024.patch | 52 ------------------- 3 files changed, 2 insertions(+), 56 deletions(-) delete mode 100644 gnu/packages/patches/imlib2-CVE-2016-4024.patch diff --git a/gnu/local.mk b/gnu/local.mk index 6f9b1b1019..f6d365847f 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -544,7 +544,6 @@ dist_patch_DATA = \ gnu/packages/patches/icu4c-CVE-2015-1270.patch \ gnu/packages/patches/icu4c-CVE-2015-4760.patch \ gnu/packages/patches/ilmbase-fix-tests.patch \ - gnu/packages/patches/imlib2-CVE-2016-4024.patch \ gnu/packages/patches/irrlicht-mesa-10.patch \ gnu/packages/patches/jasper-CVE-2007-2721.patch \ gnu/packages/patches/jasper-CVE-2008-3520.patch \ diff --git a/gnu/packages/image.scm b/gnu/packages/image.scm index db64ea0c9b..669c360b96 100644 --- a/gnu/packages/image.scm +++ b/gnu/packages/image.scm @@ -459,7 +459,7 @@ compose, and analyze GIF images.") (define-public imlib2 (package (name "imlib2") - (version "1.4.8") + (version "1.4.9") (source (origin (method url-fetch) (uri (string-append @@ -467,8 +467,7 @@ compose, and analyze GIF images.") version ".tar.bz2")) (sha256 (base32 - "0xxhgkd1axlcmf3kp1d7naiygparpg8l3sg3d263rhl2z0gm7aw9")) - (patches (search-patches "imlib2-CVE-2016-4024.patch")))) + "08809xxk2555yj6glixzw9a0x3x8cx55imd89kj3r0h152bn8a3x")))) (build-system gnu-build-system) (native-inputs `(("pkgconfig" ,pkg-config))) diff --git a/gnu/packages/patches/imlib2-CVE-2016-4024.patch b/gnu/packages/patches/imlib2-CVE-2016-4024.patch deleted file mode 100644 index c4f1f21b28..0000000000 --- a/gnu/packages/patches/imlib2-CVE-2016-4024.patch +++ /dev/null @@ -1,52 +0,0 @@ -Fix CVE-2016-4024 (integer overflow in lib/image.h). - -https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2016-4024 - -Upstream source: -https://git.enlightenment.org/legacy/imlib2.git/commit/?id=7eba2e4c8ac0e20838947f10f29d0efe1add8227 - -From 7eba2e4c8ac0e20838947f10f29d0efe1add8227 Mon Sep 17 00:00:00 2001 -From: "Yuriy M. Kaminskiy" -Date: Wed, 6 Apr 2016 03:34:01 +0300 -Subject: Fix integer overflow resulting in insufficient heap allocation - -IMAGE_DIMENSIONS_OK ensures that image width and height are less then -46340, so that maximum number of pixels is ~2**31. - -Unfortunately, there are a lot of code that allocates image data with -something like - - malloc(w * h * sizeof(DATA32)); - -Obviously, on 32-bit machines this results in integer overflow, -insufficient heap allocation, with [massive] out-of-bounds heap -overwrite. -Either X_MAX should be reduced to 32767, or (w)*(h) should be checked to -not exceed ULONG_MAX/sizeof(DATA32). - -Security implications: -*) for 32-bit machines: insufficient heap allocation and heap overwrite -in many image loaders, with escalation potential to remote code -execution; -*) for 64-bit machines: it seems, no impact. ---- - src/lib/image.h | 3 ++- - 1 file changed, 2 insertions(+), 1 deletion(-) - -diff --git a/src/lib/image.h b/src/lib/image.h -index e9eb678..5fae6ed 100644 ---- a/src/lib/image.h -+++ b/src/lib/image.h -@@ -188,7 +188,8 @@ void __imlib_SaveImage(ImlibImage * im, const char *file, - - /* The maximum pixmap dimension is 65535. */ - /* However, for now, use 46340 (46340^2 < 2^31) to avoid buffer overflow issues. */ --#define X_MAX_DIM 46340 -+/* Reduced further to 32767, so that (w * h * sizeof(DATA32)) won't exceed ULONG_MAX */ -+#define X_MAX_DIM 32767 - - #define IMAGE_DIMENSIONS_OK(w, h) \ - ( ((w) > 0) && ((h) > 0) && ((w) < X_MAX_DIM) && ((h) < X_MAX_DIM) ) --- -cgit v0.12 - From cbb6239bed4713e9bc7197377487f2fcbd907a9d Mon Sep 17 00:00:00 2001 From: Jelle Licht Date: Sun, 1 May 2016 00:09:41 +0200 Subject: [PATCH 03/47] gnu: jemalloc: Update to 4.1.0. * gnu/packages/jemalloc.scm (jemalloc): Upodate to 4.1.0. Signed-off-by: Efraim Flashner --- gnu/packages/jemalloc.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/jemalloc.scm b/gnu/packages/jemalloc.scm index 5b4c2e0853..143c80c2cb 100644 --- a/gnu/packages/jemalloc.scm +++ b/gnu/packages/jemalloc.scm @@ -27,7 +27,7 @@ (define-public jemalloc (package (name "jemalloc") - (version "3.6.0") + (version "4.1.0") (source (origin (method url-fetch) (uri (string-append @@ -35,7 +35,7 @@ name "-" version ".tar.bz2")) (sha256 (base32 - "1zl4vxxjvhg72bdl53sl0idz9wp18c6yzjdmqcnwm09wvmcj2v71")))) + "13pc6gcs5d6ws63jv83vslrb1vlqdnf1dg43awkb9bbj9xqnvl7s")))) (build-system gnu-build-system) ;; XXX FIXME: Use gcc-4.8 on i686 to work around ;; . From 8c3e9a6a8d206e0185c1dffff7220ba28cdcaac4 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Wed, 4 May 2016 22:19:52 +0300 Subject: [PATCH 04/47] gnu: gnupg: Update to 2.1.12. * gnu/packages/gnupg.scm (gnupg): Update to 2.1.12. [source]: Remove patch. * gnu/packages/patches/gnupg-simple-query-ignore-status-messages.patch: Remove file. * gnu/local.mk (dist_patch_DATA): Remove reference. --- gnu/local.mk | 1 - gnu/packages/gnupg.scm | 6 +- ...-simple-query-ignore-status-messages.patch | 142 ------------------ 3 files changed, 2 insertions(+), 147 deletions(-) delete mode 100644 gnu/packages/patches/gnupg-simple-query-ignore-status-messages.patch diff --git a/gnu/local.mk b/gnu/local.mk index f6d365847f..63d11b024b 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -507,7 +507,6 @@ dist_patch_DATA = \ gnu/packages/patches/gmp-arm-asm-nothumb.patch \ gnu/packages/patches/gmp-faulty-test.patch \ gnu/packages/patches/gnucash-price-quotes-perl.patch \ - gnu/packages/patches/gnupg-simple-query-ignore-status-messages.patch \ gnu/packages/patches/gobject-introspection-absolute-shlib-path.patch \ gnu/packages/patches/gobject-introspection-cc.patch \ gnu/packages/patches/gobject-introspection-girepository.patch \ diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index b7c661257c..7bf6566be9 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -208,16 +208,14 @@ compatible to GNU Pth.") (define-public gnupg (package (name "gnupg") - (version "2.1.11") + (version "2.1.12") (source (origin (method url-fetch) (uri (string-append "mirror://gnupg/gnupg/gnupg-" version ".tar.bz2")) (sha256 (base32 - "06mn2viiwsyq991arh5i5fhr9jyxq2bi0jkdj7ndfisxihngpc5p")) - (patches (search-patches - "gnupg-simple-query-ignore-status-messages.patch")))) + "01n5py45x0r97l4dzmd803jpbpbcxr1591k3k4s8m9804jfr4d5c")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) diff --git a/gnu/packages/patches/gnupg-simple-query-ignore-status-messages.patch b/gnu/packages/patches/gnupg-simple-query-ignore-status-messages.patch deleted file mode 100644 index 153f71c38f..0000000000 --- a/gnu/packages/patches/gnupg-simple-query-ignore-status-messages.patch +++ /dev/null @@ -1,142 +0,0 @@ -Copied from upstream: -http://git.gnupg.org/cgi-bin/gitweb.cgi?p=gnupg.git;a=commitdiff;h=acac103ba5772ae738ce5409d17feab80596cde6 - -Fixes: https://debbugs.gnu.org/22558 -Upstream bug: https://bugs.gnupg.org/gnupg/issue2229 - -From acac103ba5772ae738ce5409d17feab80596cde6 Mon Sep 17 00:00:00 2001 -From: "Neal H. Walfield" -Date: Fri, 12 Feb 2016 22:12:21 +0100 -Subject: [PATCH] common: Change simple_query to ignore status messages. - -* common/simple-pwquery.c (simple_query): Ignore status messages. - --- -Signed-off-by: Neal H. Walfield -GnuPG-bug-id: 2229 ---- - common/simple-pwquery.c | 95 ++++++++++++++++++++++++++++++++++--------------- - 1 file changed, 67 insertions(+), 28 deletions(-) - -diff --git a/common/simple-pwquery.c b/common/simple-pwquery.c -index 90d04c0..b2d666c 100644 ---- a/common/simple-pwquery.c -+++ b/common/simple-pwquery.c -@@ -618,6 +618,7 @@ simple_query (const char *query) - int fd = -1; - int nread; - char response[500]; -+ int have = 0; - int rc; - - rc = agent_open (&fd); -@@ -628,40 +629,78 @@ simple_query (const char *query) - if (rc) - goto leave; - -- /* get response */ -- nread = readline (fd, response, 499); -- if (nread < 0) -- { -- rc = -nread; -- goto leave; -- } -- if (nread < 3) -+ while (1) - { -- rc = SPWQ_PROTOCOL_ERROR; -- goto leave; -- } -+ if (! have || ! strchr (response, '\n')) -+ /* get response */ -+ { -+ nread = readline (fd, &response[have], -+ sizeof (response) - 1 /* NUL */ - have); -+ if (nread < 0) -+ { -+ rc = -nread; -+ goto leave; -+ } -+ have += nread; -+ if (have < 3) -+ { -+ rc = SPWQ_PROTOCOL_ERROR; -+ goto leave; -+ } -+ response[have] = 0; -+ } - -- if (response[0] == 'O' && response[1] == 'K') -- /* OK, do nothing. */; -- else if ((nread > 7 && !memcmp (response, "ERR 111", 7) -- && (response[7] == ' ' || response[7] == '\n') ) -- || ((nread > 4 && !memcmp (response, "ERR ", 4) -- && (strtoul (response+4, NULL, 0) & 0xffff) == 99)) ) -- { -- /* 111 is the old Assuan code for canceled which might still -- be in use by old installations. 99 is GPG_ERR_CANCELED as -- used by modern gpg-agents; 0xffff is used to mask out the -- error source. */ -+ if (response[0] == 'O' && response[1] == 'K') -+ /* OK, do nothing. */; -+ else if ((nread > 7 && !memcmp (response, "ERR 111", 7) -+ && (response[7] == ' ' || response[7] == '\n') ) -+ || ((nread > 4 && !memcmp (response, "ERR ", 4) -+ && (strtoul (response+4, NULL, 0) & 0xffff) == 99)) ) -+ { -+ /* 111 is the old Assuan code for canceled which might still -+ be in use by old installations. 99 is GPG_ERR_CANCELED as -+ used by modern gpg-agents; 0xffff is used to mask out the -+ error source. */ - #ifdef SPWQ_USE_LOGGING -- log_info (_("canceled by user\n") ); -+ log_info (_("canceled by user\n") ); - #endif -- } -- else -- { -+ } -+ else if (response[0] == 'S' && response[1] == ' ') -+ { -+ char *nextline; -+ int consumed; -+ -+ nextline = strchr (response, '\n'); -+ if (! nextline) -+ /* Point to the NUL. */ -+ nextline = &response[have]; -+ else -+ /* Move past the \n. */ -+ nextline ++; -+ -+ consumed = (size_t) nextline - (size_t) response; -+ -+ /* Skip any additional newlines. */ -+ while (consumed < have && response[consumed] == '\n') -+ consumed ++; -+ -+ have -= consumed; -+ -+ if (have) -+ memmove (response, &response[consumed], have + 1); -+ -+ continue; -+ } -+ else -+ { - #ifdef SPWQ_USE_LOGGING -- log_error (_("problem with the agent\n")); -+ log_error (_("problem with the agent (unexpected response \"%s\"\n"), -+ response); - #endif -- rc = SPWQ_ERR_RESPONSE; -+ rc = SPWQ_ERR_RESPONSE; -+ } -+ -+ break; - } - - leave: --- -2.6.3 - From ee5f1e520430142a28a2a9e3d50fa61a650d8fe2 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Fri, 29 Apr 2016 12:34:25 +0300 Subject: [PATCH 05/47] Update .mailmap. * .mailmap: Add new entries for Danny Milosavljevic, Nils Gillmann and Raymond Nicholson. --- .mailmap | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.mailmap b/.mailmap index 93cb24bbba..8f61e0efae 100644 --- a/.mailmap +++ b/.mailmap @@ -12,6 +12,7 @@ Ben Woodcroft Ben Woodcroft Claes Wallin (韋嘉誠) Cyprien Nicolas +Danny Milosavljevic David Thompson David Thompson David Thompson @@ -28,10 +29,12 @@ Ludovic Courtès Mathieu Lirzin Mathieu Lirzin Nikita Karetnikov -Nils Gillmann +Nils Gillmann +Nils Gillmann Pjotr Prins Pjotr Prins Raimon Grau +Raymond Nicholson Ricardo Wurmus Ricardo Wurmus Sou Bunnbu (宋文武) From 41447b3199a1455c26639d535c6397d991611274 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Mon, 2 May 2016 11:06:08 +0300 Subject: [PATCH 06/47] gnu: libcue: Update to 2.1.0. * gnu/packages/cdrom.scm (libcue): Update to 2.1.0. [build-system]: Use 'cmake-build-system' (the upstream moved to it). [native-inputs]: Add 'bison' and 'flex'. --- gnu/packages/cdrom.scm | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/gnu/packages/cdrom.scm b/gnu/packages/cdrom.scm index 4eff2d5cb0..70772bf157 100644 --- a/gnu/packages/cdrom.scm +++ b/gnu/packages/cdrom.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer ;;; Copyright © 2015 Paul van der Walt ;;; Copyright © 2015, 2016 Efraim Flashner +;;; Copyright © 2016 Alex Kost ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,10 +25,13 @@ #:use-module (guix download) #:use-module (guix packages) #:use-module ((guix licenses) #:select (lgpl2.1+ gpl2 gpl2+ gpl3+)) + #:use-module (guix build-system cmake) #:use-module (guix build-system gnu) #:use-module (gnu packages) #:use-module (gnu packages acl) + #:use-module (gnu packages bison) #:use-module (gnu packages compression) + #:use-module (gnu packages flex) #:use-module (gnu packages gettext) #:use-module (gnu packages gtk) #:use-module (gnu packages man) @@ -230,16 +234,20 @@ capacity is user-selectable.") (define-public libcue (package (name "libcue") - (version "1.4.0") + (version "2.1.0") (source (origin (method url-fetch) - (uri (string-append "https://github.com/lipnitsk/libcue/releases/" - "download/v" version "/libcue-" - version ".tar.bz2")) + (uri (string-append + "https://github.com/lipnitsk/libcue/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) (sha256 (base32 - "17kjd7rjz1bvfn44n3n2bjb7a1ywd0yc0g4sqp5ihf9b5bn7cwlb")))) - (build-system gnu-build-system) + "1fradl3dx0pyy9rn1a0gak9gzgg40wax61f2s00zks7rwl0xv398")))) + (build-system cmake-build-system) + (native-inputs + `(("bison" ,bison) + ("flex" ,flex))) (home-page "https://github.com/lipnitsk/libcue") (synopsis "C library to parse cue sheets") (description "Libcue is a C library to parse so-called @dfn{cue sheets} From af5640d1dd18328dbfec5cb11f73224efd47f1aa Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Mon, 2 May 2016 13:42:33 +0300 Subject: [PATCH 07/47] gnu: tvtime: Update to 1.0.10. * gnu/packages/tv.scm (tvtime): Update to 1.0.10. [source]: Remove patches. [inputs]: Add 'alsa-lib'. * gnu/packages/patches/tvtime-gcc41.patch, gnu/packages/patches/tvtime-pngoutput.patch, gnu/packages/patches/tvtime-videodev2.patch, gnu/packages/patches/tvtime-xmltv.patch: Remove files. * gnu/local.mk (dist_patch_DATA): Remove them. --- gnu/local.mk | 4 -- gnu/packages/patches/tvtime-gcc41.patch | 58 --------------------- gnu/packages/patches/tvtime-pngoutput.patch | 15 ------ gnu/packages/patches/tvtime-videodev2.patch | 15 ------ gnu/packages/patches/tvtime-xmltv.patch | 28 ---------- gnu/packages/tv.scm | 25 +++++---- 6 files changed, 12 insertions(+), 133 deletions(-) delete mode 100644 gnu/packages/patches/tvtime-gcc41.patch delete mode 100644 gnu/packages/patches/tvtime-pngoutput.patch delete mode 100644 gnu/packages/patches/tvtime-videodev2.patch delete mode 100644 gnu/packages/patches/tvtime-xmltv.patch diff --git a/gnu/local.mk b/gnu/local.mk index 63d11b024b..2f77c50940 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -752,10 +752,6 @@ dist_patch_DATA = \ gnu/packages/patches/ttfautohint-source-date-epoch.patch \ gnu/packages/patches/tophat-build-with-later-seqan.patch \ gnu/packages/patches/torsocks-dns-test.patch \ - gnu/packages/patches/tvtime-gcc41.patch \ - gnu/packages/patches/tvtime-pngoutput.patch \ - gnu/packages/patches/tvtime-videodev2.patch \ - gnu/packages/patches/tvtime-xmltv.patch \ gnu/packages/patches/unzip-CVE-2014-8139.patch \ gnu/packages/patches/unzip-CVE-2014-8140.patch \ gnu/packages/patches/unzip-CVE-2014-8141.patch \ diff --git a/gnu/packages/patches/tvtime-gcc41.patch b/gnu/packages/patches/tvtime-gcc41.patch deleted file mode 100644 index d6e42721b8..0000000000 --- a/gnu/packages/patches/tvtime-gcc41.patch +++ /dev/null @@ -1,58 +0,0 @@ -Source: https://projects.archlinux.org/svntogit/community.git/tree/trunk/tvtime-1.0.2-gcc41.patch?h=packages/tvtime - ---- tvtime-1.0.1/plugins/greedyh.asm 2005-08-14 18:16:43.000000000 +0200 -+++ tvtime-1.0.1-gcc41/plugins/greedyh.asm 2005-11-28 17:53:09.210774544 +0100 -@@ -18,7 +18,7 @@ - - #include "x86-64_macros.inc" - --void DScalerFilterGreedyH::FUNCT_NAME(TDeinterlaceInfo* pInfo) -+void FUNCT_NAME(TDeinterlaceInfo* pInfo) - { - int64_t i; - bool InfoIsOdd = (pInfo->PictureHistory[0]->Flags & PICTURE_INTERLACED_ODD) ? 1 : 0; -diff -Naur tvtime-1.0.1/plugins/tomsmocomp/TomsMoCompAll2.inc tvtime-1.0.1-gcc41/plugins/tomsmocomp/TomsMoCompAll2.inc ---- tvtime-1.0.1/plugins/tomsmocomp/TomsMoCompAll2.inc 2004-10-20 17:31:05.000000000 +0200 -+++ tvtime-1.0.1-gcc41/plugins/tomsmocomp/TomsMoCompAll2.inc 2005-11-28 17:53:33.251119856 +0100 -@@ -5,9 +5,9 @@ - #endif - - #ifdef USE_STRANGE_BOB --#define SEARCH_EFFORT_FUNC(n) DScalerFilterTomsMoComp::SEFUNC(n##_SB) -+#define SEARCH_EFFORT_FUNC(n) SEFUNC(n##_SB) - #else --#define SEARCH_EFFORT_FUNC(n) DScalerFilterTomsMoComp::SEFUNC(n) -+#define SEARCH_EFFORT_FUNC(n) SEFUNC(n) - #endif - - int SEARCH_EFFORT_FUNC(0) // we don't try at all ;-) -diff -Naur tvtime-1.0.1/plugins/tomsmocomp.cpp tvtime-1.0.1-gcc41/plugins/tomsmocomp.cpp ---- tvtime-1.0.1/plugins/tomsmocomp.cpp 2004-10-20 19:38:04.000000000 +0200 -+++ tvtime-1.0.1-gcc41/plugins/tomsmocomp.cpp 2005-11-28 17:52:53.862107896 +0100 -@@ -31,7 +31,7 @@ - - #define IS_MMX - #define SSE_TYPE MMX --#define FUNCT_NAME DScalerFilterTomsMoComp::filterDScaler_MMX -+#define FUNCT_NAME filterDScaler_MMX - #include "tomsmocomp/TomsMoCompAll.inc" - #undef IS_MMX - #undef SSE_TYPE -@@ -39,7 +39,7 @@ - - #define IS_3DNOW - #define SSE_TYPE 3DNOW --#define FUNCT_NAME DScalerFilterTomsMoComp::filterDScaler_3DNOW -+#define FUNCT_NAME filterDScaler_3DNOW - #include "tomsmocomp/TomsMoCompAll.inc" - #undef IS_3DNOW - #undef SSE_TYPE -@@ -47,7 +47,7 @@ - - #define IS_SSE - #define SSE_TYPE SSE --#define FUNCT_NAME DScalerFilterTomsMoComp::filterDScaler_SSE -+#define FUNCT_NAME filterDScaler_SSE - #include "tomsmocomp/TomsMoCompAll.inc" - #undef IS_SSE - #undef SSE_TYPE diff --git a/gnu/packages/patches/tvtime-pngoutput.patch b/gnu/packages/patches/tvtime-pngoutput.patch deleted file mode 100644 index 0d14f77ca1..0000000000 --- a/gnu/packages/patches/tvtime-pngoutput.patch +++ /dev/null @@ -1,15 +0,0 @@ -Source: https://sources.debian.net/src/tvtime/1.0.2-14/debian/patches/libpng.diff - -From: Nobuhiro Iwamatsu -Date: Mon, 14 May 2012 19:01:31 +0900 -Prepares the package for libpng 1.5. Closes: #650582. - ---- tvtime-1.0.2.orig/src/pngoutput.c -+++ tvtime-1.0.2/src/pngoutput.c -@@ -18,5 +18,6 @@ - - #include - #include -+#include - #include - #include "pngoutput.h" diff --git a/gnu/packages/patches/tvtime-videodev2.patch b/gnu/packages/patches/tvtime-videodev2.patch deleted file mode 100644 index 74131f25d0..0000000000 --- a/gnu/packages/patches/tvtime-videodev2.patch +++ /dev/null @@ -1,15 +0,0 @@ -Fix compilation error: non-existing header file. - -This is an excerpt from the debian patch: -http://http.debian.net/debian/pool/main/t/tvtime/tvtime_1.0.2-14.diff.gz - ---- tvtime-1.0.2.orig/src/videodev2.h -+++ tvtime-1.0.2/src/videodev2.h -@@ -16,7 +16,6 @@ - #ifdef __KERNEL__ - #include /* need struct timeval */ - #endif --#include /* need __user */ - - /* for kernel versions 2.4.26 and below: */ - #ifndef __user diff --git a/gnu/packages/patches/tvtime-xmltv.patch b/gnu/packages/patches/tvtime-xmltv.patch deleted file mode 100644 index 2f4afc6e5a..0000000000 --- a/gnu/packages/patches/tvtime-xmltv.patch +++ /dev/null @@ -1,28 +0,0 @@ -Fix compilation error: conflicting types for 'locale_t'. - -This is an excerpt from the debian patch ... -http://http.debian.net/debian/pool/main/t/tvtime/tvtime_1.0.2-14.diff.gz - ---- tvtime-1.0.2.orig/src/xmltv.c -+++ tvtime-1.0.2/src/xmltv.c -@@ -118,9 +118,9 @@ - typedef struct { - const char *code; - const char *name; --} locale_t; -+} tvtime_locale_t; - --static locale_t locale_table[] = { -+static tvtime_locale_t locale_table[] = { - {"AA", "Afar"}, {"AB", "Abkhazian"}, {"AF", "Afrikaans"}, - {"AM", "Amharic"}, {"AR", "Arabic"}, {"AS", "Assamese"}, - {"AY", "Aymara"}, {"AZ", "Azerbaijani"}, {"BA", "Bashkir"}, -@@ -168,7 +168,7 @@ - {"XH", "Xhosa"}, {"YO", "Yoruba"}, {"ZH", "Chinese"}, - {"ZU", "Zulu"} }; - --const int num_locales = sizeof( locale_table ) / sizeof( locale_t ); -+const int num_locales = sizeof( locale_table ) / sizeof( tvtime_locale_t ); - - /** - * Timezone parsing code based loosely on the algorithm in diff --git a/gnu/packages/tv.scm b/gnu/packages/tv.scm index f58c03623e..2db71b8491 100644 --- a/gnu/packages/tv.scm +++ b/gnu/packages/tv.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Alex Kost +;;; Copyright © 2015, 2016 Alex Kost ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,30 +22,29 @@ #:use-module (guix build-system gnu) #:use-module ((guix licenses) #:prefix license:) #:use-module (gnu packages) - #:use-module (gnu packages xorg) - #:use-module (gnu packages image) #:use-module (gnu packages compression) + #:use-module (gnu packages fontutils) + #:use-module (gnu packages image) + #:use-module (gnu packages linux) #:use-module (gnu packages xml) - #:use-module (gnu packages fontutils)) + #:use-module (gnu packages xorg)) (define-public tvtime (package (name "tvtime") - (version "1.0.2") + (version "1.0.10") (source (origin (method url-fetch) - (uri (string-append "mirror://sourceforge/tvtime/tvtime-" - version ".tar.gz")) + (uri (string-append + "http://linuxtv.org/downloads/tvtime/tvtime-" + version ".tar.gz")) (sha256 (base32 - "08q5gzbyz0lxb730rz6d6amkzimlc7nanv6n50j2bpw4n2xa9wmf")) - (patches (search-patches "tvtime-videodev2.patch" - "tvtime-pngoutput.patch" - "tvtime-xmltv.patch" - "tvtime-gcc41.patch")))) + "1mk6dni82n8jv5wsrrpqzcwrg9ccx9vijb5sbm7gqm2y0h40q5y9")))) (build-system gnu-build-system) (inputs - `(("libx11" ,libx11) + `(("alsa-lib" ,alsa-lib) + ("libx11" ,libx11) ("libxext" ,libxext) ("libxt" ,libxt) ("libxtst" ,libxtst) From 8bf92e3904cb656d4c2160fc8befebaf21a65492 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 4 May 2016 16:38:22 +0200 Subject: [PATCH 08/47] services: herd: Move UI handling to 'guix system'. This makes (gnu services herd) independent of (guix ui). * gnu/services/herd.scm (&shepherd-error, &service-not-found-error) (&action-not-found-error, &action-exception-error) (&unknown-shepherd-error): New error condition types. (report-action-error): Remove. (raise-shepherd-error): New procedure. (display-message): Do not use 'info' and '_'. (invoke-action): Use 'raise-shepherd-error' instead of 'report-action-error'. Do not use 'warning'. (current-services): Do not use 'warning'. * guix/scripts/system.scm (with-shepherd-error-handling): New macro. (report-shepherd-error, call-with-service-upgrade-info): New procedures. (upgrade-shepherd-services): Use it. --- gnu/services/herd.scm | 80 +++++++++++++++++------ guix/scripts/system.scm | 138 ++++++++++++++++++++++++++-------------- 2 files changed, 151 insertions(+), 67 deletions(-) diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm index 9cb33a9fd0..c06e98800e 100644 --- a/gnu/services/herd.scm +++ b/gnu/services/herd.scm @@ -17,12 +17,27 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu services herd) - #:use-module (guix ui) #:use-module (guix utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (ice-9 match) - #:export (current-services + #:export (shepherd-error? + service-not-found-error? + service-not-found-error-service + action-not-found-error? + action-not-found-error-service + action-not-found-error-action + action-exception-error? + action-exception-error-service + action-exception-error-action + action-exception-error-key + action-exception-error-arguments + unknown-shepherd-error? + unknown-shepherd-error-sexp + + current-services unload-services unload-service load-services @@ -61,31 +76,54 @@ return the socket." (let ((connection (open-connection))) body ...)) -(define (report-action-error error) - "Report ERROR, an sexp received by a shepherd client in reply to COMMAND, a -command object." +(define-condition-type &shepherd-error &error + shepherd-error?) + +(define-condition-type &service-not-found-error &shepherd-error + service-not-found-error? + (service service-not-found-error-service)) + +(define-condition-type &action-not-found-error &shepherd-error + action-not-found-error? + (service action-not-found-error-service) + (action action-not-found-error-action)) + +(define-condition-type &action-exception-error &shepherd-error + action-exception-error? + (service action-exception-error-service) + (action action-exception-error-action) + (key action-exception-error-key) + (args action-exception-error-arguments)) + +(define-condition-type &unknown-shepherd-error &shepherd-error + unknown-shepherd-error? + (sexp unknown-shepherd-error-sexp)) + +(define (raise-shepherd-error error) + "Raise an error condition corresponding to ERROR, an sexp received by a +shepherd client in reply to COMMAND, a command object. Return #t if ERROR +does not denote an error." (match error (('error ('version 0 x ...) 'service-not-found service) - (report-error (_ "service '~a' could not be found~%") - service)) + (raise (condition (&service-not-found-error + (service service))))) (('error ('version 0 x ...) 'action-not-found action service) - (report-error (_ "service '~a' does not have an action '~a'~%") - service action)) + (raise (condition (&action-not-found-error + (service service) + (action action))))) (('error ('version 0 x ...) 'action-exception action service key (args ...)) - (report-error (_ "exception caught while executing '~a' \ -on service '~a':~%") - action service) - (print-exception (current-error-port) #f key args)) + (raise (condition (&action-exception-error + (service service) + (action action) + (key key) (args args))))) (('error . _) - (report-error (_ "something went wrong: ~s~%") - error)) + (raise (condition (&unknown-shepherd-error (sexp error))))) (#f ;not an error #t))) (define (display-message message) - ;; TRANSLATORS: Nothing to translate here. - (info (_ "shepherd: ~a~%") message)) + (format (current-error-port) "shepherd: ~a~%" message)) (define* (invoke-action service action arguments cont) "Invoke ACTION on SERVICE with ARGUMENTS. On success, call CONT with the @@ -107,10 +145,10 @@ result. Otherwise return #f." (('reply ('version 0 x ...) ('result y) ('error error) ('messages messages)) (for-each display-message messages) - (report-action-error error) + (raise-shepherd-error error) #f) (x - (warning (_ "invalid shepherd reply~%")) + ;; invalid reply #f)))) (define-syntax-rule (with-shepherd-action service (action args ...) @@ -129,7 +167,8 @@ of pairs." (define (current-services) "Return two lists: the list of currently running services, and the list of -currently stopped services." +currently stopped services. Return #f and #f if the list of services could +not be obtained." (with-shepherd-action 'root ('status) services (match services ((('service ('version 0 _ ...) _ ...) ...) @@ -144,7 +183,6 @@ currently stopped services." '() services)) (x - (warning (_ "failed to obtain list of shepherd services~%")) (values #f #f))))) (define (unload-service service) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index e5d754a6fa..dd1e534c9b 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -236,6 +236,72 @@ BODY..., and restore them." (with-monad %store-monad (return #f))))) +(define-syntax-rule (with-shepherd-error-handling body ...) + (warn-on-system-error + (guard (c ((shepherd-error? c) + (report-shepherd-error c))) + body ...))) + +(define (report-shepherd-error error) + "Report ERROR, a '&shepherd-error' error condition object." + (cond ((service-not-found-error? error) + (report-error (_ "service '~a' could not be found~%") + (service-not-found-error-service error))) + ((action-not-found-error? error) + (report-error (_ "service '~a' does not have an action '~a'~%") + (action-not-found-error-service error) + (action-not-found-error-action error))) + ((action-exception-error? error) + (report-error (_ "exception caught while executing '~a' \ +on service '~a':~%") + (action-exception-error-action error) + (action-exception-error-service error)) + (print-exception (current-error-port) #f + (action-exception-error-key error) + (action-exception-error-arguments error))) + ((unknown-shepherd-error? error) + (report-error (_ "something went wrong: ~s~%") + (unknown-shepherd-error-sexp error))) + ((shepherd-error? error) + (report-error (_ "shepherd error~%"))) + ((not error) ;not an error + #t))) + +(define (call-with-service-upgrade-info new-services mproc) + "Call MPROC, a monadic procedure in %STORE-MONAD, passing it the list of +names of services to load (upgrade), and the list of names of services to +unload." + (define (essential? service) + (memq service '(root shepherd))) + + (define new-service-names + (map (compose first shepherd-service-provision) + new-services)) + + (let-values (((running stopped) (current-services))) + (if (and running stopped) + (let* ((to-load + ;; Only load services that are either new or currently stopped. + (remove (lambda (service) + (memq (first (shepherd-service-provision service)) + running)) + new-services)) + (to-unload + ;; Unload services that are (1) no longer required, or (2) are + ;; in TO-LOAD. + (remove essential? + (append (remove (lambda (service) + (memq service new-service-names)) + (append running stopped)) + (filter (lambda (service) + (memq service stopped)) + (map shepherd-service-canonical-name + to-load)))))) + (mproc to-load to-unload)) + (with-monad %store-monad + (warning (_ "failed to obtain list of shepherd services~%")) + (return #f))))) + (define (upgrade-shepherd-services os) "Upgrade the Shepherd (PID 1) by unloading obsolete services and loading new services specified in OS and not currently running. @@ -243,59 +309,35 @@ services specified in OS and not currently running. This is currently very conservative in that it does not stop or unload any running service. Unloading or stopping the wrong service ('udev', say) could bring the system down." - (define (essential? service) - (memq service '(root shepherd))) - (define new-services (service-parameters (fold-services (operating-system-services os) #:target-type shepherd-root-service-type))) - (define new-service-names - (map (compose first shepherd-service-provision) - new-services)) + ;; Arrange to simply emit a warning if the service upgrade fails. + (with-shepherd-error-handling + (call-with-service-upgrade-info new-services + (lambda (to-load to-unload) + (for-each (lambda (unload) + (info (_ "unloading service '~a'...~%") unload) + (unload-service unload)) + to-unload) - ;; Arrange to simply emit a warning if we cannot connect to the shepherd. - (warn-on-system-error - (let-values (((running stopped) (current-services))) - (define to-load - ;; Only load services that are either new or currently stopped. - (remove (lambda (service) - (memq (first (shepherd-service-provision service)) - running)) - new-services)) - (define to-unload - ;; Unload services that are (1) no longer required, or (2) are in - ;; TO-LOAD. - (remove essential? - (append (remove (lambda (service) - (memq service new-service-names)) - (append running stopped)) - (filter (lambda (service) - (memq service stopped)) - (map shepherd-service-canonical-name - to-load))))) + (with-monad %store-monad + (munless (null? to-load) + (let ((to-load-names (map shepherd-service-canonical-name to-load)) + (to-start (filter shepherd-service-auto-start? to-load))) + (info (_ "loading new services:~{ ~a~}...~%") to-load-names) + (mlet %store-monad ((files (mapm %store-monad shepherd-service-file + to-load))) + ;; Here we assume that FILES are exactly those that were computed + ;; as part of the derivation that built OS, which is normally the + ;; case. + (load-services (map derivation->output-path files)) - (for-each (lambda (unload) - (info (_ "unloading service '~a'...~%") unload) - (unload-service unload)) - to-unload) - - (with-monad %store-monad - (munless (null? to-load) - (let ((to-load-names (map shepherd-service-canonical-name to-load)) - (to-start (filter shepherd-service-auto-start? to-load))) - (info (_ "loading new services:~{ ~a~}...~%") to-load-names) - (mlet %store-monad ((files (mapm %store-monad shepherd-service-file - to-load))) - ;; Here we assume that FILES are exactly those that were computed - ;; as part of the derivation that built OS, which is normally the - ;; case. - (load-services (map derivation->output-path files)) - - (for-each start-service - (map shepherd-service-canonical-name to-start)) - (return #t)))))))) + (for-each start-service + (map shepherd-service-canonical-name to-start)) + (return #t))))))))) (define* (switch-to-system os #:optional (profile %system-profile)) @@ -839,4 +881,8 @@ argument list and OPTS is the option alist." (parameterize ((%graft? (assoc-ref opts 'graft?))) (process-command command args opts))))) +;;; Local Variables: +;;; eval: (put 'call-with-service-upgrade-info 'scheme-indent-function 1) +;;; End: + ;;; system.scm ends here From 6aaf3ea62d883a717a3459b6c6da3c1cfede55e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 4 May 2016 16:59:31 +0200 Subject: [PATCH 09/47] environment: Use 'break' instead of 'split'. * guix/scripts/environment.scm (parse-args): Use 'break' instead of 'split'. --- guix/scripts/environment.scm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index d4c09ef54c..9ba487d1eb 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -25,7 +25,6 @@ #:use-module (guix packages) #:use-module (guix profiles) #:use-module (guix search-paths) - #:use-module (guix utils) #:use-module (guix build utils) #:use-module (guix monads) #:use-module ((guix gexp) #:select (lower-inputs)) @@ -499,12 +498,13 @@ Otherwise, return the derivation for the Bash package." ;; The '--' token is used to separate the command to run from the rest of ;; the operands. - (let-values (((args command) (split args "--"))) + (let-values (((args command) (break (cut string=? "--" <>) args))) (let ((opts (parse-command-line args %options (list %default-options) #:argument-handler handle-argument))) - (if (null? command) - opts - (alist-cons 'exec command opts))))) + (match command + (() opts) + (("--") opts) + (("--" command ...) (alist-cons 'exec command opts)))))) (define (assert-container-features) "Check if containers can be created and exit with an informative error From 4b6fa8b33970be414ae035f63ed80b147dcd8200 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 4 May 2016 17:02:15 +0200 Subject: [PATCH 10/47] utils: Remove 'split'. This procedure was redundant with SRFI-1's 'break'. * guix/utils.scm (split): Remove. * tests/utils.scm ("split, element is in list") ("split, element is not in list"): Remove. --- guix/utils.scm | 18 ------------------ tests/utils.scm | 14 -------------- 2 files changed, 32 deletions(-) diff --git a/guix/utils.scm b/guix/utils.scm index 6c01edde21..725f4346c3 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -85,7 +85,6 @@ fold2 fold-tree fold-tree-leaves - split cache-directory readlink* edit-expression @@ -788,23 +787,6 @@ are connected to NODE in the tree, or '() or #f if NODE is a leaf node." (else result))) init children roots)) -(define (split lst e) - "Return two values, a list containing the elements of the list LST that -appear before the first occurence of the object E and a list containing the -elements after E." - (define (same? x) - (equal? e x)) - - (let loop ((rest lst) - (acc '())) - (match rest - (() - (values lst '())) - (((? same?) . tail) - (values (reverse acc) tail)) - ((head . tail) - (loop tail (cons head acc)))))) - (define (cache-directory) "Return the cache directory for Guix, by default ~/.cache/guix." (or (getenv "XDG_CONFIG_HOME") diff --git a/tests/utils.scm b/tests/utils.scm index d0ee02a1cf..854999f670 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -122,20 +122,6 @@ '(0 1 2 3))) list)) -(test-equal "split, element is in list" - '((foo) (baz)) - (call-with-values - (lambda () - (split '(foo bar baz) 'bar)) - list)) - -(test-equal "split, element is not in list" - '((foo bar baz) ()) - (call-with-values - (lambda () - (split '(foo bar baz) 'quux)) - list)) - (test-equal "strip-keyword-arguments" '(a #:b b #:c c) (strip-keyword-arguments '(#:foo #:bar #:baz) From 958dd3ce68733bcd5c1231424c7e4ad39e67594a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 4 May 2016 17:35:47 +0200 Subject: [PATCH 11/47] utils: Move combinators to (guix combinators). * guix/utils.scm (compile-time-value, memoize, fold2) (fold-tree, fold-tree-leaves): Move to... * guix/combinators: ... here. New file. * tests/utils.scm ("fold2, 1 list", "fold2, 2 lists") (fold-tree tests): Move to... * tests/combinators.scm: ... here. New file. * Makefile.am (MODULES, SCM_TESTS): Add them. * gnu/packages.scm, gnu/packages/bootstrap.scm, gnu/services/herd.scm, guix/build-system/gnu.scm, guix/build-system/python.scm, guix/derivations.scm, guix/gnu-maintenance.scm, guix/import/elpa.scm, guix/scripts/archive.scm, guix/scripts/build.scm, guix/scripts/graph.scm, guix/scripts/lint.scm, guix/scripts/size.scm, guix/scripts/substitute.scm, guix/serialization.scm, guix/store.scm, guix/ui.scm: Adjust imports accordingly. --- Makefile.am | 2 + gnu/packages.scm | 1 + gnu/packages/bootstrap.scm | 3 +- gnu/services/herd.scm | 2 +- guix/build-system/gnu.scm | 1 + guix/build-system/python.scm | 1 + guix/combinators.scm | 116 +++++++++++++++++++++++++++++++++++ guix/derivations.scm | 1 + guix/gnu-maintenance.scm | 3 +- guix/import/elpa.scm | 4 +- guix/scripts/archive.scm | 1 + guix/scripts/build.scm | 1 + guix/scripts/graph.scm | 2 +- guix/scripts/lint.scm | 1 + guix/scripts/size.scm | 2 +- guix/scripts/substitute.scm | 1 + guix/serialization.scm | 4 +- guix/store.scm | 1 + guix/ui.scm | 1 + guix/utils.scm | 98 +++-------------------------- tests/combinators.scm | 85 +++++++++++++++++++++++++ tests/utils.scm | 56 ----------------- 22 files changed, 231 insertions(+), 156 deletions(-) create mode 100644 guix/combinators.scm create mode 100644 tests/combinators.scm diff --git a/Makefile.am b/Makefile.am index d0c1826782..4685fe1650 100644 --- a/Makefile.am +++ b/Makefile.am @@ -38,6 +38,7 @@ MODULES = \ guix/hash.scm \ guix/pk-crypto.scm \ guix/pki.scm \ + guix/combinators.scm \ guix/utils.scm \ guix/sets.scm \ guix/download.scm \ @@ -231,6 +232,7 @@ SCM_TESTS = \ tests/ui.scm \ tests/records.scm \ tests/upstream.scm \ + tests/combinators.scm \ tests/utils.scm \ tests/build-utils.scm \ tests/packages.scm \ diff --git a/gnu/packages.scm b/gnu/packages.scm index 1e3f383cbc..7130f58fdd 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -24,6 +24,7 @@ #:use-module (guix packages) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix combinators) #:use-module ((guix build utils) #:select ((package-name->name+version . hyphen-separated-name->name+version))) diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm index a3cd18519c..6a4eba99ef 100644 --- a/gnu/packages/bootstrap.scm +++ b/gnu/packages/bootstrap.scm @@ -27,7 +27,8 @@ #:use-module (guix build-system trivial) #:use-module ((guix store) #:select (add-to-store add-text-to-store)) #:use-module ((guix derivations) #:select (derivation)) - #:use-module (guix utils) + #:use-module ((guix utils) #:select (gnu-triplet->nix-system)) + #:use-module (guix combinators) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm index c06e98800e..7a9db90012 100644 --- a/gnu/services/herd.scm +++ b/gnu/services/herd.scm @@ -17,7 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu services herd) - #:use-module (guix utils) + #:use-module (guix combinators) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-34) diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index a7d1952b57..f6df183da4 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -19,6 +19,7 @@ (define-module (guix build-system gnu) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix combinators) #:use-module (guix derivations) #:use-module (guix search-paths) #:use-module (guix build-system) diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index 326e6fd429..c3d6c62404 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -21,6 +21,7 @@ (define-module (guix build-system python) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix combinators) #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix search-paths) diff --git a/guix/combinators.scm b/guix/combinators.scm new file mode 100644 index 0000000000..9e4689ba9c --- /dev/null +++ b/guix/combinators.scm @@ -0,0 +1,116 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2014 Eric Bavier +;;; +;;; 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 . + +(define-module (guix combinators) + #:use-module (ice-9 match) + #:use-module (ice-9 vlist) + #:export (memoize + fold2 + fold-tree + fold-tree-leaves + compile-time-value)) + +;;; Commentary: +;;; +;;; This module provides useful combinators that complement SRFI-1 and +;;; friends. +;;; +;;; Code: + +(define (memoize proc) + "Return a memoizing version of PROC." + (let ((cache (make-hash-table))) + (lambda args + (let ((results (hash-ref cache args))) + (if results + (apply values results) + (let ((results (call-with-values (lambda () + (apply proc args)) + list))) + (hash-set! cache args results) + (apply values results))))))) + +(define fold2 + (case-lambda + ((proc seed1 seed2 lst) + "Like `fold', but with a single list and two seeds." + (let loop ((result1 seed1) + (result2 seed2) + (lst lst)) + (if (null? lst) + (values result1 result2) + (call-with-values + (lambda () (proc (car lst) result1 result2)) + (lambda (result1 result2) + (loop result1 result2 (cdr lst))))))) + ((proc seed1 seed2 lst1 lst2) + "Like `fold', but with a two lists and two seeds." + (let loop ((result1 seed1) + (result2 seed2) + (lst1 lst1) + (lst2 lst2)) + (if (or (null? lst1) (null? lst2)) + (values result1 result2) + (call-with-values + (lambda () (proc (car lst1) (car lst2) result1 result2)) + (lambda (result1 result2) + (fold2 proc result1 result2 (cdr lst1) (cdr lst2))))))))) + +(define (fold-tree proc init children roots) + "Call (PROC NODE RESULT) for each node in the tree that is reachable from +ROOTS, using INIT as the initial value of RESULT. The order in which nodes +are traversed is not specified, however, each node is visited only once, based +on an eq? check. Children of a node to be visited are generated by +calling (CHILDREN NODE), the result of which should be a list of nodes that +are connected to NODE in the tree, or '() or #f if NODE is a leaf node." + (let loop ((result init) + (seen vlist-null) + (lst roots)) + (match lst + (() result) + ((head . tail) + (if (not (vhash-assq head seen)) + (loop (proc head result) + (vhash-consq head #t seen) + (match (children head) + ((or () #f) tail) + (children (append tail children)))) + (loop result seen tail)))))) + +(define (fold-tree-leaves proc init children roots) + "Like fold-tree, but call (PROC NODE RESULT) only for leaf nodes." + (fold-tree + (lambda (node result) + (match (children node) + ((or () #f) (proc node result)) + (else result))) + init children roots)) + +(define-syntax compile-time-value ;not quite at home + (syntax-rules () + "Evaluate the given expression at compile time. The expression must +evaluate to a simple datum." + ((_ exp) + (let-syntax ((v (lambda (s) + (let ((val exp)) + (syntax-case s () + (_ #`'#,(datum->syntax s val))))))) + v)))) + +;;; combinators.scm ends here diff --git a/guix/derivations.scm b/guix/derivations.scm index 2d8584e72d..d4f697477b 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -30,6 +30,7 @@ #:use-module (ice-9 vlist) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix combinators) #:use-module (guix monads) #:use-module (guix hash) #:use-module (guix base32) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 8021d99c8b..adb62aa68c 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2012, 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. @@ -30,6 +30,7 @@ #:use-module (guix http-client) #:use-module (guix ftp-client) #:use-module (guix utils) + #:use-module (guix combinators) #:use-module (guix records) #:use-module (guix upstream) #:use-module (guix packages) diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index ccc4063a53..320a09e8c6 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -35,8 +35,8 @@ #:use-module (guix base32) #:use-module (guix upstream) #:use-module (guix packages) - #:use-module ((guix utils) #:select (call-with-temporary-output-file - memoize)) + #:use-module ((guix combinators) #:select (memoize)) + #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:export (elpa->guix-package %elpa-updater)) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 3fb210ee91..e06c38aaab 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -19,6 +19,7 @@ (define-module (guix scripts archive) #:use-module (guix config) #:use-module (guix utils) + #:use-module (guix combinators) #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module ((guix serialization) #:select (restore-file)) #:use-module (guix store) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 9a6b427fc5..320ec39be2 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -24,6 +24,7 @@ #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix grafts) + #:use-module (guix combinators) ;; Use the procedure that destructures "NAME-VERSION" forms. #:use-module ((guix utils) #:hide (package-name->name+version)) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index b0d7c08582..ba63780e2b 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -21,7 +21,7 @@ #:use-module (guix graph) #:use-module (guix grafts) #:use-module (guix scripts) - #:use-module (guix utils) + #:use-module (guix combinators) #:use-module (guix packages) #:use-module (guix monads) #:use-module (guix store) diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index c581586ac3..06001d3eae 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -31,6 +31,7 @@ #:use-module (guix records) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix combinators) #:use-module (guix scripts) #:use-module (guix gnu-maintenance) #:use-module (guix monads) diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm index 8f0cb7decd..be1e8ca087 100644 --- a/guix/scripts/size.scm +++ b/guix/scripts/size.scm @@ -21,7 +21,7 @@ #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix monads) - #:use-module (guix utils) + #:use-module (guix combinators) #:use-module (guix grafts) #:use-module (guix packages) #:use-module (guix derivations) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 1cfab81dbd..d46d610347 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -21,6 +21,7 @@ #:use-module (guix ui) #:use-module ((guix store) #:hide (close-connection)) #:use-module (guix utils) + #:use-module (guix combinators) #:use-module (guix config) #:use-module (guix records) #:use-module (guix serialization) diff --git a/guix/serialization.scm b/guix/serialization.scm index 7a3defc03d..286b4cbf30 100644 --- a/guix/serialization.scm +++ b/guix/serialization.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,7 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (guix serialization) - #:use-module (guix utils) + #:use-module (guix combinators) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) diff --git a/guix/store.scm b/guix/store.scm index 8d1099dab2..f352a99cbd 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -19,6 +19,7 @@ (define-module (guix store) #:use-module (guix utils) #:use-module (guix config) + #:use-module (guix combinators) #:use-module (guix serialization) #:use-module (guix monads) #:autoload (guix base32) (bytevector->base32-string) diff --git a/guix/ui.scm b/guix/ui.scm index 04ac43723e..8310974ac7 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -30,6 +30,7 @@ #:use-module (guix packages) #:use-module (guix profiles) #:use-module (guix derivations) + #:use-module (guix combinators) #:use-module (guix build-system) #:use-module (guix serialization) #:use-module ((guix build utils) #:select (mkdir-p)) diff --git a/guix/utils.scm b/guix/utils.scm index 725f4346c3..f18bbd19ac 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -32,6 +32,7 @@ #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!)) + #:use-module (guix combinators) #:use-module ((guix build utils) #:select (dump-port)) #:use-module ((guix build syscalls) #:select (errno mkdtemp!)) #:use-module (ice-9 vlist) @@ -46,9 +47,7 @@ #:export (bytevector->base16-string base16-string->bytevector - compile-time-value fcntl-flock - memoize strip-keyword-arguments default-keyword-arguments substitute-keyword-arguments @@ -82,9 +81,6 @@ call-with-temporary-output-file call-with-temporary-directory with-atomic-file-output - fold2 - fold-tree - fold-tree-leaves cache-directory readlink* edit-expression @@ -97,22 +93,6 @@ call-with-compressed-output-port canonical-newline-port)) - -;;; -;;; Compile-time computations. -;;; - -(define-syntax compile-time-value - (syntax-rules () - "Evaluate the given expression at compile time. The expression must -evaluate to a simple datum." - ((_ exp) - (let-syntax ((v (lambda (s) - (let ((val exp)) - (syntax-case s () - (_ #`'#,(datum->syntax s val))))))) - v)))) - ;;; ;;; Base 16. @@ -432,22 +412,9 @@ exception if it's already taken." ;;; -;;; Miscellaneous. +;;; Keyword arguments. ;;; -(define (memoize proc) - "Return a memoizing version of PROC." - (let ((cache (make-hash-table))) - (lambda args - (let ((results (hash-ref cache args))) - (if results - (apply values results) - (let ((results (call-with-values (lambda () - (apply proc args)) - list))) - (hash-set! cache args results) - (apply values results))))))) - (define (strip-keyword-arguments keywords args) "Remove all of the keyword arguments listed in KEYWORDS from ARGS." (let loop ((args args) @@ -533,6 +500,11 @@ For instance: (#f (loop rest kw/values (cons* value kw result)))))))) + +;;; +;;; System strings. +;;; + (define* (nix-system->gnu-triplet #:optional (system (%current-system)) (vendor "unknown")) "Return a guess of the GNU triplet corresponding to Nix system @@ -731,62 +703,6 @@ output port, and PROC's result is returned." (lambda (key . args) (false-if-exception (delete-file template)))))) -(define fold2 - (case-lambda - ((proc seed1 seed2 lst) - "Like `fold', but with a single list and two seeds." - (let loop ((result1 seed1) - (result2 seed2) - (lst lst)) - (if (null? lst) - (values result1 result2) - (call-with-values - (lambda () (proc (car lst) result1 result2)) - (lambda (result1 result2) - (loop result1 result2 (cdr lst))))))) - ((proc seed1 seed2 lst1 lst2) - "Like `fold', but with a two lists and two seeds." - (let loop ((result1 seed1) - (result2 seed2) - (lst1 lst1) - (lst2 lst2)) - (if (or (null? lst1) (null? lst2)) - (values result1 result2) - (call-with-values - (lambda () (proc (car lst1) (car lst2) result1 result2)) - (lambda (result1 result2) - (fold2 proc result1 result2 (cdr lst1) (cdr lst2))))))))) - -(define (fold-tree proc init children roots) - "Call (PROC NODE RESULT) for each node in the tree that is reachable from -ROOTS, using INIT as the initial value of RESULT. The order in which nodes -are traversed is not specified, however, each node is visited only once, based -on an eq? check. Children of a node to be visited are generated by -calling (CHILDREN NODE), the result of which should be a list of nodes that -are connected to NODE in the tree, or '() or #f if NODE is a leaf node." - (let loop ((result init) - (seen vlist-null) - (lst roots)) - (match lst - (() result) - ((head . tail) - (if (not (vhash-assq head seen)) - (loop (proc head result) - (vhash-consq head #t seen) - (match (children head) - ((or () #f) tail) - (children (append tail children)))) - (loop result seen tail)))))) - -(define (fold-tree-leaves proc init children roots) - "Like fold-tree, but call (PROC NODE RESULT) only for leaf nodes." - (fold-tree - (lambda (node result) - (match (children node) - ((or () #f) (proc node result)) - (else result))) - init children roots)) - (define (cache-directory) "Return the cache directory for Guix, by default ~/.cache/guix." (or (getenv "XDG_CONFIG_HOME") diff --git a/tests/combinators.scm b/tests/combinators.scm new file mode 100644 index 0000000000..1e4bb236b7 --- /dev/null +++ b/tests/combinators.scm @@ -0,0 +1,85 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2014 Eric Bavier +;;; +;;; 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 . + +(define-module (test-combinators) + #:use-module (guix combinators) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64) + #:use-module (ice-9 vlist)) + +(test-begin "combinators") + +(test-equal "fold2, 1 list" + (list (reverse (iota 5)) + (map - (reverse (iota 5)))) + (call-with-values + (lambda () + (fold2 (lambda (i r1 r2) + (values (cons i r1) + (cons (- i) r2))) + '() '() + (iota 5))) + list)) + +(test-equal "fold2, 2 lists" + (list (reverse '((a . 0) (b . 1) (c . 2) (d . 3))) + (reverse '((a . 0) (b . -1) (c . -2) (d . -3)))) + (call-with-values + (lambda () + (fold2 (lambda (k v r1 r2) + (values (alist-cons k v r1) + (alist-cons k (- v) r2))) + '() '() + '(a b c d) + '(0 1 2 3))) + list)) + +(let* ((tree (alist->vhash + '((0 2 3) (1 3 4) (2) (3 5 6) (4 6) (5) (6)) + hashq)) + (add-one (lambda (_ r) (1+ r))) + (tree-lookup (lambda (n) (cdr (vhash-assq n tree))))) + (test-equal "fold-tree, single root" + 5 (fold-tree add-one 0 tree-lookup '(0))) + (test-equal "fold-tree, two roots" + 7 (fold-tree add-one 0 tree-lookup '(0 1))) + (test-equal "fold-tree, sum" + 16 (fold-tree + 0 tree-lookup '(0))) + (test-equal "fold-tree, internal" + 18 (fold-tree + 0 tree-lookup '(3 4))) + (test-equal "fold-tree, cons" + '(1 3 4 5 6) + (sort (fold-tree cons '() tree-lookup '(1)) <)) + (test-equal "fold-tree, overlapping paths" + '(1 3 4 5 6) + (sort (fold-tree cons '() tree-lookup '(1 4)) <)) + (test-equal "fold-tree, cons, two roots" + '(0 2 3 4 5 6) + (sort (fold-tree cons '() tree-lookup '(0 4)) <)) + (test-equal "fold-tree-leaves, single root" + 2 (fold-tree-leaves add-one 0 tree-lookup '(1))) + (test-equal "fold-tree-leaves, single root, sum" + 11 (fold-tree-leaves + 0 tree-lookup '(1))) + (test-equal "fold-tree-leaves, two roots" + 3 (fold-tree-leaves add-one 0 tree-lookup '(0 1))) + (test-equal "fold-tree-leaves, two roots, sum" + 13 (fold-tree-leaves + 0 tree-lookup '(0 1)))) + +(test-end) + diff --git a/tests/utils.scm b/tests/utils.scm index 854999f670..a54482e94c 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -97,31 +97,6 @@ (string-replace-substring "/nix/store/chbouib" "/nix/" "/gnu/") (string-replace-substring "" "foo" "bar"))) -(test-equal "fold2, 1 list" - (list (reverse (iota 5)) - (map - (reverse (iota 5)))) - (call-with-values - (lambda () - (fold2 (lambda (i r1 r2) - (values (cons i r1) - (cons (- i) r2))) - '() '() - (iota 5))) - list)) - -(test-equal "fold2, 2 lists" - (list (reverse '((a . 0) (b . 1) (c . 2) (d . 3))) - (reverse '((a . 0) (b . -1) (c . -2) (d . -3)))) - (call-with-values - (lambda () - (fold2 (lambda (k v r1 r2) - (values (alist-cons k v r1) - (alist-cons k (- v) r2))) - '() '() - '(a b c d) - '(0 1 2 3))) - list)) - (test-equal "strip-keyword-arguments" '(a #:b b #:c c) (strip-keyword-arguments '(#:foo #:bar #:baz) @@ -136,37 +111,6 @@ (ensure-keyword-arguments '(#:foo 2) '(#:bar 3)) (ensure-keyword-arguments '(#:foo 2) '(#:bar 3 #:foo 42)))) -(let* ((tree (alist->vhash - '((0 2 3) (1 3 4) (2) (3 5 6) (4 6) (5) (6)) - hashq)) - (add-one (lambda (_ r) (1+ r))) - (tree-lookup (lambda (n) (cdr (vhash-assq n tree))))) - (test-equal "fold-tree, single root" - 5 (fold-tree add-one 0 tree-lookup '(0))) - (test-equal "fold-tree, two roots" - 7 (fold-tree add-one 0 tree-lookup '(0 1))) - (test-equal "fold-tree, sum" - 16 (fold-tree + 0 tree-lookup '(0))) - (test-equal "fold-tree, internal" - 18 (fold-tree + 0 tree-lookup '(3 4))) - (test-equal "fold-tree, cons" - '(1 3 4 5 6) - (sort (fold-tree cons '() tree-lookup '(1)) <)) - (test-equal "fold-tree, overlapping paths" - '(1 3 4 5 6) - (sort (fold-tree cons '() tree-lookup '(1 4)) <)) - (test-equal "fold-tree, cons, two roots" - '(0 2 3 4 5 6) - (sort (fold-tree cons '() tree-lookup '(0 4)) <)) - (test-equal "fold-tree-leaves, single root" - 2 (fold-tree-leaves add-one 0 tree-lookup '(1))) - (test-equal "fold-tree-leaves, single root, sum" - 11 (fold-tree-leaves + 0 tree-lookup '(1))) - (test-equal "fold-tree-leaves, two roots" - 3 (fold-tree-leaves add-one 0 tree-lookup '(0 1))) - (test-equal "fold-tree-leaves, two roots, sum" - 13 (fold-tree-leaves + 0 tree-lookup '(0 1)))) - (test-assert "filtered-port, file" (let* ((file (search-path %load-path "guix.scm")) (input (open-file file "r0b"))) From 4d9ed58498e3acb5bad1c5b862853f72bd3312aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 4 May 2016 17:49:32 +0200 Subject: [PATCH 12/47] build: Preserve stderr for shell tests. Fixes a regression introduced in a9edb211e733b8b34e67ec3b4450567e9376986f where the .log files of the .sh tests would not contain stderr. * build-aux/test-env.in: Redirect stderr only when --quiet-stderr is passed. * Makefile.am (SCM_LOG_DRIVER): Add --quiet-stderr. --- Makefile.am | 7 +++++-- build-aux/test-env.in | 14 ++++++++++---- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/Makefile.am b/Makefile.am index 4685fe1650..6e8dfd318f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -297,8 +297,11 @@ TESTS = $(SCM_TESTS) $(SH_TESTS) AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)" GUILE_AUTO_COMPILE=0 -SCM_LOG_DRIVER = $(top_builddir)/test-env $(GUILE) --no-auto-compile \ - -e main $(top_srcdir)/build-aux/test-driver.scm +SCM_LOG_DRIVER = \ + $(top_builddir)/test-env --quiet-stderr \ + $(GUILE) --no-auto-compile -e main \ + $(top_srcdir)/build-aux/test-driver.scm + AM_SCM_LOG_DRIVER_FLAGS = --brief=yes SH_LOG_COMPILER = $(top_builddir)/test-env $(SHELL) diff --git a/build-aux/test-env.in b/build-aux/test-env.in index c3f60f7283..c153763a56 100644 --- a/build-aux/test-env.in +++ b/build-aux/test-env.in @@ -29,12 +29,18 @@ # stdout. unset CDPATH +case "$1" in + --quiet-stderr) + # Silence the daemon's output, which is often useless, as well as that + # of Bash (such as "Terminated" messages when 'guix-daemon' is + # killed.) + exec 2> /dev/null + shift + ;; +esac + if [ -x "@abs_top_builddir@/guix-daemon" ] then - # Silence the daemon's output, which is often useless, as well as that of - # Bash (such as "Terminated" messages when 'guix-daemon' is killed.) - exec 2> /dev/null - NIX_STORE_DIR="@GUIX_TEST_ROOT@/store" # Do that because store.scm calls `canonicalize-path' on it. From b13cf17fcfb62e82efd7477c0da7a56b11ff4288 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 4 May 2016 17:51:44 +0200 Subject: [PATCH 13/47] gnu: java-qdox: Escape "@" in description. * gnu/packages/java.scm (java-qdox-1.12)[description]: Use "@@tag", not "@tag". --- gnu/packages/java.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/java.scm b/gnu/packages/java.scm index fbee1a3fb3..e715798691 100644 --- a/gnu/packages/java.scm +++ b/gnu/packages/java.scm @@ -897,7 +897,7 @@ decompression and random access decompression have been fully implemented.") (description "QDox is a high speed, small footprint parser for extracting class/interface/method definitions from source files complete with JavaDoc -@code{@tags}. It is designed to be used by active code generators or +@code{@@tags}. It is designed to be used by active code generators or documentation tools.") (license license:asl2.0))) From b2fef041fcfbb63d7901c25647373aeda56b026e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 4 May 2016 22:48:28 +0200 Subject: [PATCH 14/47] system: Add procedures to access user accounts and service names. * gnu/system.scm (operating-system-user-accounts) (operating-system-shepherd-service-names): New procedures. --- gnu/system.scm | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/gnu/system.scm b/gnu/system.scm index 768ca9cab2..96ea153cd0 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -82,6 +82,8 @@ operating-system-file-systems operating-system-store-file-system operating-system-activation-script + operating-system-user-accounts + operating-system-shepherd-service-names operating-system-derivation operating-system-profile @@ -578,6 +580,22 @@ hardware-related operations as necessary when booting a Linux container." ;; BOOT is the script as a monadic value. (service-parameters boot))) +(define (operating-system-user-accounts os) + "Return the list of user accounts of OS." + (let* ((services (operating-system-services os)) + (account (fold-services services + #:target-type account-service-type))) + (filter user-account? + (service-parameters account)))) + +(define (operating-system-shepherd-service-names os) + "Return the list of Shepherd service names for OS." + (append-map shepherd-service-provision + (service-parameters + (fold-services (operating-system-services os) + #:target-type + shepherd-root-service-type)))) + (define* (operating-system-derivation os #:key container?) "Return a derivation that builds OS." (let* ((services (operating-system-services os #:container? container?)) From 957afcae3cded622f4260385f69b40dbdcaade9f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 4 May 2016 23:31:08 +0200 Subject: [PATCH 15/47] Add (gnu tests) and (gnu build marionette). * gnu/build/marionette.scm, gnu/tests.scm: New files. * gnu/local.mk (GNU_SYSTEM_MODULES): Add them. * gnu/system/vm.scm (common-qemu-options): Remove '-serial stdio'. --- gnu/build/marionette.scm | 206 +++++++++++++++++++++++++++++++++++++++ gnu/local.mk | 5 +- gnu/system/vm.scm | 2 +- gnu/tests.scm | 130 ++++++++++++++++++++++++ 4 files changed, 341 insertions(+), 2 deletions(-) create mode 100644 gnu/build/marionette.scm create mode 100644 gnu/tests.scm diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm new file mode 100644 index 0000000000..9399c55313 --- /dev/null +++ b/gnu/build/marionette.scm @@ -0,0 +1,206 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu build marionette) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:use-module (rnrs io ports) + #:use-module (ice-9 match) + #:export (marionette? + make-marionette + marionette-eval + marionette-control + %qwerty-us-keystrokes + marionette-type)) + +;;; Commentary: +;;; +;;; Instrumentation tools for QEMU virtual machines (VMs). A "marionette" is +;;; essentially a VM (a QEMU instance) with its monitor connected to a +;;; Unix-domain socket, and with a REPL inside the guest listening on a +;;; virtual console, which is itself connected to the host via a Unix-domain +;;; socket--these are the marionette's strings, connecting it to the almighty +;;; puppeteer. +;;; +;;; Code: + +(define-record-type + (marionette command pid monitor repl) + marionette? + (command marionette-command) ;list of strings + (pid marionette-pid) ;integer + (monitor marionette-monitor) ;port + (repl marionette-repl)) ;port + +(define* (wait-for-monitor-prompt port #:key (quiet? #t)) + "Read from PORT until we have seen all of QEMU's monitor prompt. When +QUIET? is false, the monitor's output is written to the current output port." + (define full-prompt + (string->list "(qemu) ")) + + (let loop ((prompt full-prompt) + (matches '()) + (prefix '())) + (match prompt + (() + ;; It's useful to set QUIET? so we don't display the echo of our own + ;; commands. + (unless quiet? + (for-each (lambda (line) + (format #t "qemu monitor: ~a~%" line)) + (string-tokenize (list->string (reverse prefix)) + (char-set-complement (char-set #\newline)))))) + ((chr rest ...) + (let ((read (read-char port))) + (cond ((eqv? read chr) + (loop rest (cons read matches) prefix)) + ((eof-object? read) + (error "EOF while waiting for QEMU monitor prompt" + (list->string (reverse prefix)))) + (else + (loop full-prompt + '() + (cons read (append matches prefix)))))))))) + +(define* (make-marionette command + #:key (socket-directory "/tmp") (timeout 20)) + "Return a QEMU marionette--i.e., a virtual machine with open connections to the +QEMU monitor and to the guest's backdoor REPL." + (define (file->sockaddr file) + (make-socket-address AF_UNIX + (string-append socket-directory "/" file))) + + (define extra-options + (list "-nographic" + "-monitor" (string-append "unix:" socket-directory "/monitor") + "-chardev" (string-append "socket,id=repl,path=" socket-directory + "/repl") + "-device" "virtio-serial" + "-device" "virtconsole,chardev=repl")) + + (let ((monitor (socket AF_UNIX SOCK_STREAM 0)) + (repl (socket AF_UNIX SOCK_STREAM 0))) + (bind monitor (file->sockaddr "monitor")) + (listen monitor 1) + (bind repl (file->sockaddr "repl")) + (listen repl 1) + + (match (primitive-fork) + (0 + (catch #t + (lambda () + (close monitor) + (close repl) + (match command + ((program . args) + (apply execl program program + (append args extra-options))))) + (lambda (key . args) + (print-exception (current-error-port) + (stack-ref (make-stack #t) 1) + key args) + (primitive-exit 1)))) + (pid + (format #t "QEMU runs as PID ~a~%" pid) + (sigaction SIGALRM + (lambda (signum) + (display "time is up!\n") ;FIXME: break + #t)) + (alarm timeout) + + (match (accept monitor) + ((monitor-conn . _) + (display "connected to QEMU's monitor\n") + (close-port monitor) + (wait-for-monitor-prompt monitor-conn) + (display "read QEMU monitor prompt\n") + (match (accept repl) + ((repl-conn . addr) + (display "connected to guest REPL\n") + (close-port repl) + (match (read repl-conn) + ('ready + (alarm 0) + (sigaction SIGALRM SIG_DFL) + (display "marionette is ready\n") + (marionette (append command extra-options) pid + monitor-conn repl-conn))))))))))) + +(define (marionette-eval exp marionette) + "Evaluate EXP in MARIONETTE's backdoor REPL. Return the result." + (match marionette + (($ command pid monitor repl) + (write exp repl) + (newline repl) + (read repl)))) + +(define (marionette-control command marionette) + "Run COMMAND in the QEMU monitor of MARIONETTE. COMMAND is a string such as +\"sendkey ctrl-alt-f1\" or \"screendump foo.ppm\" (info \"(qemu-doc) +pcsys_monitor\")." + (match marionette + (($ _ _ monitor) + (display command monitor) + (newline monitor) + (wait-for-monitor-prompt monitor)))) + +(define %qwerty-us-keystrokes + ;; Maps "special" characters to their keystrokes. + '((#\newline . "ret") + (#\space . "spc") + (#\- . "minus") + (#\+ . "shift-equal") + (#\* . "shift-8") + (#\= . "equal") + (#\? . "shift-slash") + (#\[ . "bracket_left") + (#\] . "bracket_right") + (#\( . "shift-9") + (#\) . "shift-0") + (#\/ . "slash") + (#\< . "less") + (#\> . "shift-less") + (#\. . "dot") + (#\, . "comma") + (#\; . "semicolon") + (#\bs . "backspace") + (#\tab . "tab"))) + +(define* (string->keystroke-commands str + #:optional + (keystrokes + %qwerty-us-keystrokes)) + "Return a list of QEMU monitor commands to send the keystrokes corresponding +to STR. KEYSTROKES is an alist specifying a mapping from characters to +keystrokes." + (string-fold-right (lambda (chr result) + (cons (string-append "sendkey " + (or (assoc-ref keystrokes chr) + (string chr))) + result)) + '() + str)) + +(define* (marionette-type str marionette + #:key (keystrokes %qwerty-us-keystrokes)) + "Type STR on MARIONETTE's keyboard, using the KEYSTROKES alist to map characters +to actual keystrokes." + (for-each (cut marionette-control <> marionette) + (string->keystroke-commands str keystrokes))) + +;;; marionette.scm ends here diff --git a/gnu/local.mk b/gnu/local.mk index 2f77c50940..d7797602e9 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -398,7 +398,10 @@ GNU_SYSTEM_MODULES = \ gnu/build/linux-container.scm \ gnu/build/linux-initrd.scm \ gnu/build/linux-modules.scm \ - gnu/build/vm.scm + gnu/build/marionette.scm \ + gnu/build/vm.scm \ + \ + gnu/tests.scm patchdir = $(guilemoduledir)/gnu/packages/patches diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 2fbef6a3fc..e6ce42467a 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -468,7 +468,7 @@ with '-virtfs' options for the host file systems listed in SHARED-FS." " -no-reboot -net nic,model=virtio \ " #$@(map virtfs-option shared-fs) " \ -net user \ - -serial stdio -vga std \ + -vga std \ -drive file=" #$image ",if=virtio,cache=writeback,werror=report,readonly \ -m 256")) diff --git a/gnu/tests.scm b/gnu/tests.scm new file mode 100644 index 0000000000..08d8315ea0 --- /dev/null +++ b/gnu/tests.scm @@ -0,0 +1,130 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu tests) + #:use-module (guix gexp) + #:use-module (gnu system) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:export (backdoor-service-type + marionette-operating-system)) + +;;; Commentary: +;;; +;;; This module provides the infrastructure to run operating system tests. +;;; The most important part of that is tools to instrument the OS under test, +;;; essentially allowing to run in a virtual machine controlled by the host +;;; system--hence the name "marionette". +;;; +;;; Code: + +(define (marionette-shepherd-service imported-modules) + "Return the Shepherd service for the marionette REPL" + (define device + "/dev/hvc0") + + (list (shepherd-service + (provision '(marionette)) + (requirement '(udev)) ;so that DEVICE is available + (modules '((ice-9 match) + (srfi srfi-9 gnu) + (guix build syscalls) + (rnrs bytevectors))) + (imported-modules `((guix build syscalls) + ,@imported-modules)) + (start + #~(lambda () + (define (clear-echo termios) + (set-field termios (termios-local-flags) + (logand (lognot (local-flags ECHO)) + (termios-local-flags termios)))) + + (define (self-quoting? x) + (letrec-syntax ((one-of (syntax-rules () + ((_) #f) + ((_ pred rest ...) + (or (pred x) + (one-of rest ...)))))) + (one-of symbol? string? pair? null? vector? + bytevector? number? boolean?))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #t) + (lambda () + (let* ((repl (open-file #$device "r+0")) + (termios (tcgetattr (fileno repl))) + (console (open-file "/dev/console" "r+0"))) + ;; Don't echo input back. + (tcsetattr (fileno repl) (tcsetattr-action TCSANOW) + (clear-echo termios)) + + ;; Redirect output to the console. + (close-fdes 1) + (close-fdes 2) + (dup2 (fileno console) 1) + (dup2 (fileno console) 2) + (close-port console) + + (display 'ready repl) + (let loop () + (newline repl) + + (match (read repl) + ((? eof-object?) + (primitive-exit 0)) + (expr + (catch #t + (lambda () + (let ((result (primitive-eval expr))) + (write (if (self-quoting? result) + result + (object->string result)) + repl))) + (lambda (key . args) + (print-exception (current-error-port) + (stack-ref (make-stack #t) 1) + key args) + (write #f repl))))) + (loop)))) + (lambda () + (primitive-exit 1)))) + (pid + pid)))) + (stop #~(make-kill-destructor))))) + +(define marionette-service-type + ;; This is the type of the "marionette" service, allowing a guest system to + ;; be manipulated from the host. This marionette REPL is essentially a + ;; universal marionette. + (service-type (name 'marionette-repl) + (extensions + (list (service-extension shepherd-root-service-type + marionette-shepherd-service))))) + +(define* (marionette-operating-system os + #:key (imported-modules '())) + "Return a marionetteed variant of OS such that OS can be used as a marionette +in a virtual machine--i.e., controlled from the host system." + (operating-system + (inherit os) + (services (cons (service marionette-service-type imported-modules) + (operating-system-user-services os))))) + +;;; tests.scm ends here From e9f693d06f94bd96488c3910dba6504f94a6b6f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 4 May 2016 23:33:59 +0200 Subject: [PATCH 16/47] tests: Add whole-system test. * gnu/system/vm.scm (virtualized-operating-system): Export. * gnu/tests/base.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * Makefile.am (check-system): New target. --- Makefile.am | 7 ++ gnu/local.mk | 3 +- gnu/system/vm.scm | 1 + gnu/tests/base.scm | 168 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 178 insertions(+), 1 deletion(-) create mode 100644 gnu/tests/base.scm diff --git a/Makefile.am b/Makefile.am index 6e8dfd318f..e0be844bfd 100644 --- a/Makefile.am +++ b/Makefile.am @@ -330,6 +330,13 @@ check-local: endif !CAN_RUN_TESTS +check-system: $(GOBJECTS) + $(AM_V_at)echo "Running system tests..." + $(AM_V_at)$(top_builddir)/pre-inst-env \ + $(GUILE) --no-auto-compile \ + -e '(@@ (run-system-tests) run-system-tests)' \ + $(top_srcdir)/build-aux/run-system-tests.scm + # Public key used to sign substitutes from hydra.gnu.org. dist_pkgdata_DATA = hydra.gnu.org.pub diff --git a/gnu/local.mk b/gnu/local.mk index d7797602e9..0292b39508 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -401,7 +401,8 @@ GNU_SYSTEM_MODULES = \ gnu/build/marionette.scm \ gnu/build/vm.scm \ \ - gnu/tests.scm + gnu/tests.scm \ + gnu/tests/base.scm patchdir = $(guilemoduledir)/gnu/packages/patches diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index e6ce42467a..676e89df98 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -58,6 +58,7 @@ #:export (expression->derivation-in-linux-vm qemu-image + virtualized-operating-system system-qemu-image system-qemu-image/shared-store diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm new file mode 100644 index 0000000000..bf2d095709 --- /dev/null +++ b/gnu/tests/base.scm @@ -0,0 +1,168 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu tests base) + #:use-module (gnu tests) + #:use-module (gnu system) + #:use-module (gnu system grub) + #:use-module (gnu system file-systems) + #:use-module (gnu system shadow) + #:use-module (gnu system vm) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (guix gexp) + #:use-module (guix store) + #:use-module (guix monads) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:export (%test-basic-os)) + +(define %simple-os + (operating-system + (host-name "komputilo") + (timezone "Europe/Berlin") + (locale "en_US.UTF-8") + + (bootloader (grub-configuration (device "/dev/sdX"))) + (file-systems (cons (file-system + (device "my-root") + (title 'label) + (mount-point "/") + (type "ext4")) + %base-file-systems)) + (firmware '()) + + (users (cons (user-account + (name "alice") + (comment "Bob's sister") + (group "users") + (supplementary-groups '("wheel" "audio" "video")) + (home-directory "/home/alice")) + %base-user-accounts)))) + + +(define %test-basic-os + ;; Monadic derivation that instruments %SIMPLE-OS, runs it in a VM, and runs + ;; a series of basic functionality tests. + (mlet* %store-monad ((os -> (marionette-operating-system + %simple-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + (run (system-qemu-image/shared-store-script + os #:graphic? #f))) + (define test + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-1) + (srfi srfi-26) + (srfi srfi-64) + (ice-9 match)) + + (define marionette + (make-marionette (list #$run))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "basic") + + (test-assert "uname" + (match (marionette-eval '(uname) marionette) + (#("Linux" "komputilo" version _ "x86_64") + (string-prefix? #$(package-version + (operating-system-kernel os)) + version)))) + + (test-assert "shell and user commands" + ;; Is everything in $PATH? + (zero? (marionette-eval '(system " +. /etc/profile +set -e -x +guix --version +ls --version +grep --version +info --version") + marionette))) + + (test-assert "accounts" + (let ((users (marionette-eval '(begin + (use-modules (ice-9 match)) + (let loop ((result '())) + (match (getpw) + (#f (reverse result)) + (x (loop (cons x result)))))) + marionette))) + (lset= string=? + (map passwd:name users) + (list + #$@(map user-account-name + (operating-system-user-accounts os)))))) + + (test-assert "shepherd services" + (let ((services (marionette-eval '(begin + (use-modules (gnu services herd)) + (call-with-values current-services + append)) + marionette))) + (lset= eq? + (pk 'services services) + '(root #$@(operating-system-shepherd-service-names + (virtualized-operating-system os '())))))) + + (test-equal "login on tty1" + "root\n" + (begin + (marionette-control "sendkey ctrl-alt-f1" marionette) + ;; Wait for the 'term-tty1' service to be running + (marionette-eval + '(begin + (use-modules (gnu services herd)) + + (let loop ((i 0)) + (when (> i 10) + (error "terminal service not running" (current-services))) + (unless (memq 'term-tty1 (current-services)) + (sleep 1) + (loop (+ i 1))))) + marionette) + + ;; Now we can type. + (marionette-type "root\n\nid -un > logged-in\n" marionette) + + ;; It can take a while before the shell commands are executed. + (let loop ((i 0)) + (unless (or (file-exists? "/root/logged-in") (> i 15)) + (sleep 1) + (loop (+ i 1)))) + (marionette-eval '(use-modules (rnrs io ports)) marionette) + (marionette-eval '(call-with-input-file "/root/logged-in" + get-string-all) + marionette))) + + (test-assert "screendump" + (begin + (marionette-control (string-append "screendump " #$output + "/tty1.ppm") + marionette) + (file-exists? "tty1.ppm"))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0)))) + + (gexp->derivation "basic" test + #:modules '((gnu build marionette))))) From 41c569d9b9c47ce8f2fb280f24c0a6d4e76f8bc7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 4 May 2016 23:56:42 +0200 Subject: [PATCH 17/47] build: Add 'run-system-tests.scm'. This file was meant to be added as part of commit e9f693d06f94bd96488c3910dba6504f94a6b6f9. * build-aux/run-system-tests.scm: New file. * Makefile.am (EXTRA_DIST): Add it. --- Makefile.am | 1 + build-aux/run-system-tests.scm | 71 ++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+) create mode 100644 build-aux/run-system-tests.scm diff --git a/Makefile.am b/Makefile.am index e0be844bfd..dfd486b256 100644 --- a/Makefile.am +++ b/Makefile.am @@ -361,6 +361,7 @@ EXTRA_DIST = \ build-aux/make-binary-tarball.scm \ build-aux/generate-authors.scm \ build-aux/test-driver.scm \ + build-aux/run-system-tests.scm \ srfi/srfi-37.scm.in \ srfi/srfi-64.scm \ srfi/srfi-64.upstream.scm \ diff --git a/build-aux/run-system-tests.scm b/build-aux/run-system-tests.scm new file mode 100644 index 0000000000..e98de9cb7e --- /dev/null +++ b/build-aux/run-system-tests.scm @@ -0,0 +1,71 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Ludovic Courtès +;;; +;;; 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 . + +(define-module (run-system-tests) + #:use-module (gnu tests base) + #:use-module (guix store) + #:use-module (guix monads) + #:use-module (guix derivations) + #:use-module (guix ui) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) + #:export (run-system-tests)) + +(define (built-derivations* drv) + (lambda (store) + (guard (c ((nix-protocol-error? c) + (values #f store))) + (values (build-derivations store drv) store)))) + +(define (filterm mproc lst) ;XXX: move to (guix monads) + (with-monad %store-monad + (>>= (foldm %store-monad + (lambda (item result) + (mlet %store-monad ((keep? (mproc item))) + (return (if keep? + (cons item result) + result)))) + '() + lst) + (lift1 reverse %store-monad)))) + +(define %system-tests + (list %test-basic-os)) + +(define (run-system-tests . args) + (with-store store + (run-with-store store + (mlet* %store-monad ((drv (sequence %store-monad %system-tests)) + (out -> (map derivation->output-path drv))) + (mbegin %store-monad + (show-what-to-build* drv) + (set-build-options* #:keep-going? #t #:keep-failed? #t) + (built-derivations* drv) + (mlet %store-monad ((valid (filterm (store-lift valid-path?) + out)) + (failed (filterm (store-lift + (negate valid-path?)) + out))) + (format #t "TOTAL: ~a\n" (length drv)) + (for-each (lambda (item) + (format #t "PASS: ~a~%" item)) + valid) + (for-each (lambda (item) + (format #t "FAIL: ~a~%" item)) + failed) + (exit (null? failed)))))))) From 1a957c21c693283f6c34cbf78b447d62a047e7b7 Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Thu, 5 May 2016 02:16:17 -0400 Subject: [PATCH 18/47] gnu: libressl: Update to 2.3.4 [security fixes]. Fixes CVE-2016-{2105, 2106, 2107, 2108, 2109}. * gnu/packages/tls.scm (libressl): Update to 2.3.4. --- gnu/packages/tls.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/gnu/packages/tls.scm b/gnu/packages/tls.scm index 6685ee0349..885552bcb7 100644 --- a/gnu/packages/tls.scm +++ b/gnu/packages/tls.scm @@ -321,15 +321,16 @@ required structures.") (define-public libressl (package (name "libressl") - (version "2.3.3") + (version "2.3.4") (source (origin (method url-fetch) (uri (string-append "http://ftp.openbsd.org/pub/OpenBSD/LibreSSL/libressl-" version ".tar.gz")) - (sha256 (base32 - "1a8anm8nsfyxds03csk738m2cmzjbsb867my1rz5ij3w31k32wvn")))) + (sha256 + (base32 + "1ag65pbvdikqj5y1w780jicl3ngi9ld2332ki6794y0gcar3a4bs")))) (build-system gnu-build-system) (native-search-paths ;; FIXME: These two variables must designate a single file or directory From 86670ca4b7c1c5c86bcffd0d82fc5940d5bf4f1d Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Thu, 5 May 2016 11:26:55 +0300 Subject: [PATCH 19/47] emacs: main: Use (guix combinators). Reported by rsiddharth on #guix. This is a followup to commit 958dd3ce68733bcd5c1231424c7e4ad39e67594a. * emacs/guix-main.scm: Use (guix combinators) module as 'memoize' moved there. --- emacs/guix-main.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index 5358f3bfa4..2be86f026b 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -52,6 +52,7 @@ (srfi srfi-19) (srfi srfi-26) (guix) + (guix combinators) (guix git-download) (guix packages) (guix profiles) From a82f322b1cc70063a648046963af2129162a7c04 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 5 May 2016 07:56:37 -0400 Subject: [PATCH 20/47] gnu: linux-libre-4.1: Update to 4.1.23. * gnu/packages/linux.scm (linux-libre-4.1): Update to 4.1.23. --- gnu/packages/linux.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index aa778beefb..186c9e7dad 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -354,13 +354,13 @@ It has been modified to remove all non-free binary blobs.") (define-public linux-libre-4.1 (package (inherit linux-libre) - (version "4.1.22") + (version "4.1.23") (source (origin (method url-fetch) (uri (linux-libre-urls version)) (sha256 (base32 - "0bn6qba7q4i3yn3zx2p56gawnb2gczrf4vyrjggirj4d60gvng7y")))) + "0f9ilyr05jmc3416sjy3n42zwch2h7mwg9wazaawjwc7905n8yy0")))) (native-inputs (let ((conf (kernel-config (or (%current-target-system) (%current-system)) From a6b3c07a7a2634c017b877c0ceb89b9b53feed13 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 5 May 2016 08:44:52 -0400 Subject: [PATCH 21/47] gnu: linux-libre-4.4: Update to 4.4.9. * gnu/packages/linux.scm (linux-libre-4.4): Update to 4.4.9. --- gnu/packages/linux.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 186c9e7dad..bcf73f0a9e 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -337,13 +337,13 @@ It has been modified to remove all non-free binary blobs.") (define-public linux-libre-4.4 (package (inherit linux-libre) - (version "4.4.8") + (version "4.4.9") (source (origin (method url-fetch) (uri (linux-libre-urls version)) (sha256 (base32 - "0zyhdy01gjglgmlrmpqa1sdnm0z91mzwspbksj6zvcamczb8ml53")))) + "04zwmqp5ib19jmbv2b1zzxdp4zhjkmx408mjky92dkyj33j43iki")))) (native-inputs (let ((conf (kernel-config (or (%current-target-system) (%current-system)) From c041dcd133db262aff996d4ae8b251d52ad07374 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 5 May 2016 08:48:07 -0400 Subject: [PATCH 22/47] gnu: linux-libre: Update to 4.5.3. * gnu/packages/linux.scm (linux-libre): Update to 4.5.3. --- gnu/packages/linux.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index bcf73f0a9e..e80c9004ed 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -222,7 +222,7 @@ for SYSTEM and optionally VARIANT, or #f if there is no such configuration." (search-path %load-path file))) (define-public linux-libre - (let* ((version "4.5.2") + (let* ((version "4.5.3") (build-phase '(lambda* (#:key system inputs #:allow-other-keys #:rest args) ;; Avoid introducing timestamps @@ -300,7 +300,7 @@ for SYSTEM and optionally VARIANT, or #f if there is no such configuration." (uri (linux-libre-urls version)) (sha256 (base32 - "0mw8n5pms33k3m3aamlryahrcbhfnqbzvkglgw3j4dhaja3hwr7n")))) + "1zb1qvbzkzih8fdfcvaxcgbhm5kckl6n8d312pbd478svx6fqi2s")))) (build-system gnu-build-system) (supported-systems '("x86_64-linux" "i686-linux")) (native-inputs `(("perl" ,perl) From 7309045cd31bd75ae7e0bd727af59e7615bbb0ae Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 3 May 2016 18:48:40 +0200 Subject: [PATCH 23/47] gnu: Add libiconv. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/base.scm (libiconv): New variable. Co-authored-by: Ludovic Courtès --- gnu/packages/base.scm | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index 1c4ebbf64f..beb689ea95 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2014 Alex Kost ;;; Copyright © 2014, 2015 Manolis Fragkiskos Ragkousis ;;; Copyright © 2016 Efraim Flashner +;;; Copyright © 2016 Jan Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,7 +25,7 @@ (define-module (gnu packages base) #:use-module ((guix licenses) - #:select (gpl3+ lgpl2.0+ public-domain)) + #:select (gpl3+ lgpl2.0+ lgpl3+ public-domain)) #:use-module (gnu packages) #:use-module (gnu packages acl) #:use-module (gnu packages bash) @@ -936,6 +937,33 @@ reflect changes made by political bodies to time zone boundaries, UTC offsets, and daylight-saving rules.") (license public-domain))) +(define-public libiconv + (package + (name "libiconv") + (version "1.14") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnu/libiconv/libiconv-" + version ".tar.gz")) + (sha256 + (base32 + "04q6lgl3kglmmhw59igq1n7v3rp1rpkypl366cy1k1yn2znlvckj")) + (modules '((guix build utils))) + (snippet + ;; Work around "declared gets" error on glibc systems (fixed by + ;; Gnulib commit 66712c23388e93e5c518ebc8515140fa0c807348.) + '(substitute* "srclib/stdio.in.h" + (("^#undef gets") "") + (("^_GL_WARN_ON_USE \\(gets.*") ""))))) + (build-system gnu-build-system) + (synopsis "Character set conversion library") + (description + "libiconv provides an implementation of the iconv function for systems +that lack it. iconv is used to convert between character encodings in a +program. It supports a wide variety of different encodings.") + (home-page "http://www.gnu.org/software/libiconv/") + (license lgpl3+))) + (define-public (canonical-package package) ;; Avoid circular dependency by lazily resolving 'commencement'. (let* ((iface (resolve-interface '(gnu packages commencement))) From 9c61acf2c111377303d0ac9179c1980b4f2316a3 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Thu, 5 May 2016 19:43:29 +0300 Subject: [PATCH 24/47] gnu: mercurial: Update to 3.8.1 [fixes CVE-2016-3105]. * gnu/packages/version-control.scm (mercurial): Update to 3.8.1. --- gnu/packages/version-control.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index fb85d933f9..944eb7ae24 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -605,14 +605,14 @@ control to Git repositories.") (define-public mercurial (package (name "mercurial") - (version "3.7.3") + (version "3.8.1") (source (origin (method url-fetch) (uri (string-append "https://www.mercurial-scm.org/" "release/mercurial-" version ".tar.gz")) (sha256 (base32 - "0c2vkad9piqkggyk8y310rf619qgdfcwswnk3nv21mg2fhnw96f0")))) + "156m6269xdqq7mpw01c6b065k29xnb8b9lyzn1b0nlz5il2izkps")))) (build-system python-build-system) (arguments `(;; Restrict to Python 2, as Python 3 would require From ddba00cdf06df0a4bf7067b5d76d143cb3b1c93d Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Thu, 5 May 2016 12:09:22 -0400 Subject: [PATCH 25/47] gnu: ntp: Update to 4.2.8p7 [security fixes]. This fixes CVE-2015-7704 and CVE-2016-{1547,1548,1549,1551,2516,2517, 2518,2519}. * gnu/packages/ntp.scm (ntp): Update to 4.2.8.p7. --- gnu/packages/ntp.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/ntp.scm b/gnu/packages/ntp.scm index f38fa22b5b..6dbb93f439 100644 --- a/gnu/packages/ntp.scm +++ b/gnu/packages/ntp.scm @@ -38,7 +38,7 @@ (define-public ntp (package (name "ntp") - (version "4.2.8p6") + (version "4.2.8p7") (source (origin (method url-fetch) (uri (string-append @@ -47,7 +47,7 @@ "/ntp-" version ".tar.gz")) (sha256 (base32 - "0j509gd0snj8dq15rhfv2v4wisfaabya1gmgqslk1kisawf0wgaq")) + "1p100856h17nb0kpnppy70nja57hbcc95h7shhxvw6mhl030rll1")) (modules '((guix build utils))) (snippet '(begin From 9478c9d834498f6c7353e56145412435869746e6 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Thu, 31 Dec 2015 17:25:41 +0200 Subject: [PATCH 26/47] gnu: Add connman. * gnu/packages/connman.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. --- gnu/local.mk | 1 + gnu/packages/connman.scm | 89 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 90 insertions(+) create mode 100644 gnu/packages/connman.scm diff --git a/gnu/local.mk b/gnu/local.mk index 0292b39508..cea6a73a55 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -73,6 +73,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/compression.scm \ gnu/packages/conkeror.scm \ gnu/packages/conky.scm \ + gnu/packages/connman.scm \ gnu/packages/cook.scm \ gnu/packages/cpio.scm \ gnu/packages/cppi.scm \ diff --git a/gnu/packages/connman.scm b/gnu/packages/connman.scm new file mode 100644 index 0000000000..2625ae8760 --- /dev/null +++ b/gnu/packages/connman.scm @@ -0,0 +1,89 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Efraim Flashner +;;; +;;; 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 . + +(define-module (gnu packages connman) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (guix licenses) + #:use-module (guix utils) + #:use-module (gnu packages) + #:use-module (gnu packages admin) + #:use-module (gnu packages glib) + #:use-module (gnu packages linux) + #:use-module (gnu packages pkg-config) + #:use-module (gnu packages python) + #:use-module (gnu packages readline) + #:use-module (gnu packages samba) + #:use-module (gnu packages tls) + #:use-module (gnu packages vpn)) + +(define-public connman + (package + (name "connman") + (version "1.32") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://kernel.org/pub/linux/network/connman/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "0k4kw2j78gwxf0rq79a099qkzl6wi4v5i7rfs4rn0si0fd68d19i")))) + (build-system gnu-build-system) + (arguments + `(#:configure-flags + (list "--enable-nmcompat" + ;; "--enable-polkit" + "--enable-openconnect" + "--enable-openvpn" + "--enable-vpnc" + "--enable-pptp" + "--enable-l2tp" + (string-append + "--with-dbusconfdir=" (assoc-ref %outputs "out") "/etc") + (string-append + "--with-dbusdatadir=" (assoc-ref %outputs "out") "/share")))) + (native-inputs + `(("pkg-config", pkg-config) + ("python" ,python-2))) + (inputs + `(("dbus" ,dbus) + ("glib" ,glib) + ("gnutls" ,gnutls) + ("iptables" ,iptables) + ;; ("polkit" ,polkit) ; pkg-config cannot find polkit.pc + ("readline" ,readline) + ;; These inputs are needed for connman to include the interface to + ;; these technologies so IF they are installed they can be used. + ;; TODO: add neard, ofono + ("openconnect" ,openconnect) + ("openvpn" ,openvpn) + ("ppp", ppp) + ("vpnc" ,vpnc) + ("wpa-supplicant" ,wpa-supplicant))) + (home-page "https://01.org/connman") + (synopsis "Connection management daemon") + (description "Connman provides a daemon for managing Internet connections. +The Connection Manager is designed to be slim and to use as few resources as +possible. It is fully modular system that can be extended through plug-ins. +The plug-in approach allows for easy adaption and modification for various use +cases. Connman implements DNS resolving and caching, DHCP clients for both +IPv4 and IPv6, link-local IPv4 address handling and tethering (IP connection +sharing) to clients via USB, ethernet, WiFi, cellular and Bluetooth.") + (license gpl2))) From 76192896e9fa9a79e76752b60b96a911a3e632ee Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Thu, 31 Dec 2015 22:10:11 +0200 Subject: [PATCH 27/47] services: Add connman-service. * gnu/services/networking.scm (connman-service): New procedure. (connman-service-type, %connman-activation): New variables. (connman-shepherd-service): New procedure. * doc/guix.texi (Networking Services): Document it. --- doc/guix.texi | 14 ++++++++++- gnu/services/networking.scm | 49 ++++++++++++++++++++++++++++++++++++- 2 files changed, 61 insertions(+), 2 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 0d72574619..b575faffd7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -18,7 +18,8 @@ Copyright @copyright{} 2014 Pierre-Antoine Rault@* Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@* Copyright @copyright{} 2015, 2016 Leo Famulari@* Copyright @copyright{} 2016 Ben Woodcroft@* -Copyright @copyright{} 2016 Chris Marusich +Copyright @copyright{} 2016 Chris Marusich@* +Copyright @copyright{} 2016 Efraim Flashner Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -7390,6 +7391,17 @@ Return a service that runs NetworkManager, a network connection manager attempting to keep network connectivity active when available. @end deffn +@cindex Connman +@deffn {Scheme Procedure} connman-service @ + [#:connman @var{connman}] +Return a service that runs @url{https://01.org/connman,Connman}, a network +connection manager. + +This service adds the @var{connman} package to the global profile, providing +several the @command{connmanctl} command to interact with the daemon and +configure networking." +@end deffn + @deffn {Scheme Procedure} ntp-service [#:ntp @var{ntp}] @ [#:name-service @var{%ntp-servers}] Return a service that runs the daemon from @var{ntp}, the diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 5a0a211236..af2a60936b 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver +;;; Copyright © 2016 Efraim Flashner ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,7 @@ #:use-module (gnu system shadow) #:use-module (gnu system pam) #:use-module (gnu packages admin) + #:use-module (gnu packages connman) #:use-module (gnu packages linux) #:use-module (gnu packages tor) #:use-module (gnu packages messaging) @@ -45,7 +47,8 @@ tor-service bitlbee-service wicd-service - network-manager-service)) + network-manager-service + connman-service)) ;;; Commentary: ;;; @@ -652,4 +655,48 @@ and @command{wicd-curses} user interfaces." that attempting to keep active network connectivity when available." (service network-manager-service-type network-manager)) + +;;; +;;; Connman +;;; + +(define %connman-activation + ;; Activation gexp for Connman. + #~(begin + (use-modules (guix build utils)) + (mkdir-p "/var/lib/connman/") + (mkdir-p "/var/lib/connman-vpn/"))) + +(define (connman-shepherd-service connman) + "Return a shepherd service for Connman" + (list (shepherd-service + (documentation "Run Connman") + (provision '(networking)) + (requirement '(user-processes dbus-system loopback)) + (start #~(make-forkexec-constructor + (list (string-append #$connman + "/sbin/connmand") + "-n" "-r"))) + (stop #~(make-kill-destructor))))) + +(define connman-service-type + (service-type (name 'connman) + (extensions + (list (service-extension shepherd-root-service-type + connman-shepherd-service) + (service-extension dbus-root-service-type list) + (service-extension activation-service-type + (const %connman-activation)) + ;; Add connman to the system profile. + (service-extension profile-service-type list))))) + +(define* (connman-service #:key (connman connman)) + "Return a service that runs @url{https://01.org/connman,Connman}, a network +connection manager. + +This service adds the @var{connman} package to the global profile, providing +several the @command{connmanctl} command to interact with the daemon and +configure networking." + (service connman-service-type connman)) + ;;; networking.scm ends here From 82047474ea4913ca0a67da410fcb2622c82afa14 Mon Sep 17 00:00:00 2001 From: Roel Janssen Date: Wed, 4 May 2016 15:55:23 +0200 Subject: [PATCH 28/47] gnu: Add r-coda. * gnu/packages/statistics.scm (r-coda): New variable. Signed-off-by: Leo Famulari --- gnu/packages/statistics.scm | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/gnu/packages/statistics.scm b/gnu/packages/statistics.scm index 3d0faf7572..a362b32478 100644 --- a/gnu/packages/statistics.scm +++ b/gnu/packages/statistics.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2016 Andreas Enge ;;; Copyright © 2016 Efraim Flashner ;;; Copyright © 2016 Pjotr Prins +;;; Copyright © 2016 Roel Janssen ;;; ;;; This file is part of GNU Guix. ;;; @@ -1239,6 +1240,27 @@ inference for statistical models.") `(("python2-setuptools" ,python2-setuptools) ,@(package-native-inputs stats)))))) +(define-public r-coda + (package + (name "r-coda") + (version "0.18-1") + (source (origin + (method url-fetch) + (uri (cran-uri "coda" version)) + (sha256 + (base32 + "03sc780734zj2kqcm8lkyvf76fql0jbfhkblpn8l58zmb6cqi958")))) + (build-system r-build-system) + (propagated-inputs + `(("r-lattice" ,r-lattice))) + (home-page "http://cran.r-project.org/web/packages/coda") + (synopsis "This is a package for Output Analysis and Diagnostics for MCMC") + (description "This package provides functions for summarizing and plotting +the output from Markov Chain Monte Carlo (MCMC) simulations, as well as +diagnostic tests of convergence to the equilibrium distribution of the Markov +chain.") + (license license:gpl2+))) + (define-public r-xml2 (package (name "r-xml2") From 52ad9cb60efd28e70c29a9e70a94cc20af6860bc Mon Sep 17 00:00:00 2001 From: Roel Janssen Date: Tue, 3 May 2016 15:06:42 +0200 Subject: [PATCH 29/47] gnu: Add r-estimability. * gnu/packages/statistics.scm (r-estimability): New variable. Signed-off-by: Leo Famulari --- gnu/packages/statistics.scm | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/gnu/packages/statistics.scm b/gnu/packages/statistics.scm index a362b32478..90dc4144ef 100644 --- a/gnu/packages/statistics.scm +++ b/gnu/packages/statistics.scm @@ -253,6 +253,24 @@ purposes for which more comprehensive (and widely tested) libraries such as OpenSSL should be used.") (license license:gpl2+))) +(define-public r-estimability + (package + (name "r-estimability") + (version "1.1-1") + (source (origin + (method url-fetch) + (uri (cran-uri "estimability" version)) + (sha256 + (base32 + "049adh8i0ad0m0qln2ylqdxcs5v2q9zfignn2a50r5f93ip2ay6w")))) + (build-system r-build-system) + (home-page "http://cran.r-project.org/web/packages/estimability") + (synopsis "Tools for assessing estimability of linear predictions") + (description "Provides tools for determining estimability of linear +functions of regression coefficients, and 'epredict' methods that handle +non-estimable cases correctly.") + (license license:gpl2+))) + (define-public r-gtable (package (name "r-gtable") From 8658d403508a9ec63a7f23e3086be49b977799d8 Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Fri, 6 May 2016 01:11:28 -0400 Subject: [PATCH 30/47] gnu: i3-wm: Use https URLs. * gnu/packages/wm.scm (i3-wm)[source]: Use https URL. [home-page]: Use https URL. --- gnu/packages/wm.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/wm.scm b/gnu/packages/wm.scm index 60842efab2..cdd3bde14b 100644 --- a/gnu/packages/wm.scm +++ b/gnu/packages/wm.scm @@ -148,7 +148,7 @@ commands would.") (version "4.12") (source (origin (method url-fetch) - (uri (string-append "http://i3wm.org/downloads/i3-" + (uri (string-append "https://i3wm.org/downloads/i3-" version ".tar.bz2")) (sha256 (base32 @@ -182,7 +182,7 @@ commands would.") `(("which" ,which) ("perl" ,perl) ("pkg-config" ,pkg-config))) - (home-page "http://i3wm.org/") + (home-page "https://i3wm.org/") (synopsis "Improved tiling window manager") (description "A tiling window manager, completely written from scratch. i3 is primarily targeted at advanced users and From fdad1f3c42b73c3ced7fe09fb880cb3989d381c5 Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Fri, 6 May 2016 01:13:11 -0400 Subject: [PATCH 31/47] gnu: i3status: Use https URLs. * gnu/packages/wm.scm (i3status)[source]: Use https URL. [home-page]: Use https URL. --- gnu/packages/wm.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/wm.scm b/gnu/packages/wm.scm index cdd3bde14b..da64a6e872 100644 --- a/gnu/packages/wm.scm +++ b/gnu/packages/wm.scm @@ -111,7 +111,7 @@ the leaves of a full binary tree.") (version "2.9") (source (origin (method url-fetch) - (uri (string-append "http://i3wm.org/i3status/i3status-" + (uri (string-append "https://i3wm.org/i3status/i3status-" version ".tar.bz2")) (sha256 (base32 @@ -131,7 +131,7 @@ the leaves of a full binary tree.") ("wireless-tools" ,wireless-tools) ("libcap" ,libcap) ("asciidoc" ,asciidoc))) - (home-page "http://i3wm.org/i3status/") + (home-page "https://i3wm.org/i3status/") (synopsis "Status bar for i3bar, dzen2, xmobar or similar programs") (description "i3status is a small program for generating a status bar for i3bar, dzen2, xmobar or similar programs. It is designed to be very efficient From 766a22fb4d12f9da526afb2232e1ec19d3fd926b Mon Sep 17 00:00:00 2001 From: Al McElrath Date: Tue, 5 Apr 2016 16:21:19 -0700 Subject: [PATCH 32/47] gnu: i3status: Update to 2.10. Signed-off-by: Leo Famulari --- gnu/packages/wm.scm | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/gnu/packages/wm.scm b/gnu/packages/wm.scm index da64a6e872..694db4794a 100644 --- a/gnu/packages/wm.scm +++ b/gnu/packages/wm.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2015 Paul van der Walt ;;; Copyright © 2016 Danny Milosavljevic ;;; Copyright © 2016 Efraim Flashner +;;; Copyright © 2016 Al McElrath ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,6 +34,7 @@ #:use-module (gnu packages base) #:use-module (gnu packages pkg-config) #:use-module (gnu packages perl) + #:use-module (gnu packages pulseaudio) #:use-module (gnu packages xorg) #:use-module (gnu packages xdisorg) #:use-module (gnu packages qt) @@ -108,14 +110,14 @@ the leaves of a full binary tree.") (define-public i3status (package (name "i3status") - (version "2.9") + (version "2.10") (source (origin (method url-fetch) (uri (string-append "https://i3wm.org/i3status/i3status-" version ".tar.bz2")) (sha256 (base32 - "1qwxbrga2fi5wf742hh9ajwa8b2kpzkjjnhjlz4wlpv21i80kss2")))) + "1497dsvb32z9xljmxz95dnyvsbayn188ilm3l4ys8m5h25vd1xfs")))) (build-system gnu-build-system) (arguments `(#:make-flags (list "CC=gcc" (string-append "PREFIX=" %output)) @@ -128,9 +130,12 @@ the leaves of a full binary tree.") ("libconfuse" ,libconfuse) ("libyajl" ,libyajl) ("alsa-lib" ,alsa-lib) - ("wireless-tools" ,wireless-tools) + ("pulseaudio" ,pulseaudio) + ("libnl" ,libnl) ("libcap" ,libcap) ("asciidoc" ,asciidoc))) + (native-inputs + `(("pkg-config" ,pkg-config))) (home-page "https://i3wm.org/i3status/") (synopsis "Status bar for i3bar, dzen2, xmobar or similar programs") (description "i3status is a small program for generating a status bar for From ba2613bb4e47938044a3c96b92debf1bddcf0140 Mon Sep 17 00:00:00 2001 From: Alex Griffin Date: Thu, 5 May 2016 09:59:03 -0500 Subject: [PATCH 33/47] system: Do not export PS1 in /etc/skel/.bashrc. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/system/shadow.scm (default-skeletons)[bashrc]: Remove "export" for 'PS1'. Signed-off-by: Ludovic Courtès --- gnu/system/shadow.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index a13ef1192c..b8837c63f0 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2016 Alex Griffin ;;; ;;; This file is part of GNU Guix. ;;; @@ -166,9 +167,9 @@ fi # Adjust the prompt depending on whether we're in 'guix environment'. if [ -n \"$GUIX_ENVIRONMENT\" ] then - export PS1='\\u@\\h \\w [env]\\$ ' + PS1='\\u@\\h \\w [env]\\$ ' else - export PS1='\\u@\\h \\w\\$ ' + PS1='\\u@\\h \\w\\$ ' fi alias ls='ls -p --color' alias ll='ls -l'\n")) From 4e0ea3eb288c2143b44bf324c64047762c72d3b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 6 May 2016 13:12:45 +0200 Subject: [PATCH 34/47] utils: Move 'fcntl-flock' to (guix build syscalls). * guix/utils.scm (%struct-flock, F_SETLKW, F_SETLK, F_xxLCK) (fcntl-flock): Move to... * guix/build/syscalls.scm: ... here. New variables. * guix/nar.scm: Adjust imports accordingly. * tests/utils.scm ("fcntl-flock wait", "fcntl-flock non-blocking"): Move to... * tests/syscalls.scm: ... here. New tests. (temp-file): New variable. --- guix/build/syscalls.scm | 69 ++++++++++++++++++++++++++++++++ guix/nar.scm | 4 +- guix/utils.scm | 75 +---------------------------------- tests/syscalls.scm | 88 +++++++++++++++++++++++++++++++++++++++++ tests/utils.scm | 82 -------------------------------------- 5 files changed, 160 insertions(+), 158 deletions(-) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index a9cd6e93c8..86723c23c7 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -65,6 +65,7 @@ processes mkdtemp! pivot-root + fcntl-flock CLONE_CHILD_CLEARTID CLONE_CHILD_SETTID @@ -637,6 +638,74 @@ system to PUT-OLD." (list new-root put-old (strerror err)) (list err))))))) + +;;; +;;; Advisory file locking. +;;; + +(define %struct-flock + ;; 'struct flock' from . + (list short ; l_type + short ; l_whence + size_t ; l_start + size_t ; l_len + int)) ; l_pid + +(define F_SETLKW + ;; On Linux-based systems, this is usually 7, but not always + ;; (exceptions include SPARC.) On GNU/Hurd, it's 9. + (cond ((string-contains %host-type "sparc") 9) ; sparc-*-linux-gnu + ((string-contains %host-type "linux") 7) ; *-linux-gnu + (else 9))) ; *-gnu* + +(define F_SETLK + ;; Likewise: GNU/Hurd and SPARC use 8, while the others typically use 6. + (cond ((string-contains %host-type "sparc") 8) ; sparc-*-linux-gnu + ((string-contains %host-type "linux") 6) ; *-linux-gnu + (else 8))) ; *-gnu* + +(define F_xxLCK + ;; The F_RDLCK, F_WRLCK, and F_UNLCK constants. + (cond ((string-contains %host-type "sparc") #(1 2 3)) ; sparc-*-linux-gnu + ((string-contains %host-type "hppa") #(1 2 3)) ; hppa-*-linux-gnu + ((string-contains %host-type "linux") #(0 1 2)) ; *-linux-gnu + (else #(1 2 3)))) ; *-gnu* + +(define fcntl-flock + (let ((proc (syscall->procedure int "fcntl" `(,int ,int *)))) + (lambda* (fd-or-port operation #:key (wait? #t)) + "Perform locking OPERATION on the file beneath FD-OR-PORT. OPERATION +must be a symbol, one of 'read-lock, 'write-lock, or 'unlock. When WAIT? is +true, block until the lock is acquired; otherwise, thrown an 'flock-error' +exception if it's already taken." + (define (operation->int op) + (case op + ((read-lock) (vector-ref F_xxLCK 0)) + ((write-lock) (vector-ref F_xxLCK 1)) + ((unlock) (vector-ref F_xxLCK 2)) + (else (error "invalid fcntl-flock operation" op)))) + + (define fd + (if (port? fd-or-port) + (fileno fd-or-port) + fd-or-port)) + + ;; XXX: 'fcntl' is a vararg function, but here we happily use the + ;; standard ABI; crossing fingers. + (let ((err (proc fd + (if wait? + F_SETLKW ; lock & wait + F_SETLK) ; non-blocking attempt + (make-c-struct %struct-flock + (list (operation->int operation) + SEEK_SET + 0 0 ; whole file + 0))))) + (or (zero? err) + + ;; Presumably we got EAGAIN or so. + (throw 'flock-error (errno))))))) + ;;; ;;; Network interfaces. diff --git a/guix/nar.scm b/guix/nar.scm index 43e5210752..739d3d3a57 100644 --- a/guix/nar.scm +++ b/guix/nar.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -18,8 +18,8 @@ ;;; along with GNU Guix. If not, see . (define-module (guix nar) - #:use-module (guix utils) #:use-module (guix serialization) + #:use-module (guix build syscalls) #:use-module ((guix build utils) #:select (delete-file-recursively with-directory-excursion)) #:use-module (guix store) diff --git a/guix/utils.scm b/guix/utils.scm index f18bbd19ac..d924e434bd 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -34,7 +34,7 @@ #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!)) #:use-module (guix combinators) #:use-module ((guix build utils) #:select (dump-port)) - #:use-module ((guix build syscalls) #:select (errno mkdtemp!)) + #:use-module ((guix build syscalls) #:select (mkdtemp!)) #:use-module (ice-9 vlist) #:use-module (ice-9 format) #:autoload (ice-9 popen) (open-pipe*) @@ -47,7 +47,6 @@ #:export (bytevector->base16-string base16-string->bytevector - fcntl-flock strip-keyword-arguments default-keyword-arguments substitute-keyword-arguments @@ -338,78 +337,6 @@ This procedure returns #t on success." (put-bytevector out post-bv)) #t)))))) - -;;; -;;; Advisory file locking. -;;; - -(define %struct-flock - ;; 'struct flock' from . - (list short ; l_type - short ; l_whence - size_t ; l_start - size_t ; l_len - int)) ; l_pid - -(define F_SETLKW - ;; On Linux-based systems, this is usually 7, but not always - ;; (exceptions include SPARC.) On GNU/Hurd, it's 9. - (compile-time-value - (cond ((string-contains %host-type "sparc") 9) ; sparc-*-linux-gnu - ((string-contains %host-type "linux") 7) ; *-linux-gnu - (else 9)))) ; *-gnu* - -(define F_SETLK - ;; Likewise: GNU/Hurd and SPARC use 8, while the others typically use 6. - (compile-time-value - (cond ((string-contains %host-type "sparc") 8) ; sparc-*-linux-gnu - ((string-contains %host-type "linux") 6) ; *-linux-gnu - (else 8)))) ; *-gnu* - -(define F_xxLCK - ;; The F_RDLCK, F_WRLCK, and F_UNLCK constants. - (compile-time-value - (cond ((string-contains %host-type "sparc") #(1 2 3)) ; sparc-*-linux-gnu - ((string-contains %host-type "hppa") #(1 2 3)) ; hppa-*-linux-gnu - ((string-contains %host-type "linux") #(0 1 2)) ; *-linux-gnu - (else #(1 2 3))))) ; *-gnu* - -(define fcntl-flock - (let* ((ptr (dynamic-func "fcntl" (dynamic-link))) - (proc (pointer->procedure int ptr `(,int ,int *)))) - (lambda* (fd-or-port operation #:key (wait? #t)) - "Perform locking OPERATION on the file beneath FD-OR-PORT. OPERATION -must be a symbol, one of 'read-lock, 'write-lock, or 'unlock. When WAIT? is -true, block until the lock is acquired; otherwise, thrown an 'flock-error' -exception if it's already taken." - (define (operation->int op) - (case op - ((read-lock) (vector-ref F_xxLCK 0)) - ((write-lock) (vector-ref F_xxLCK 1)) - ((unlock) (vector-ref F_xxLCK 2)) - (else (error "invalid fcntl-flock operation" op)))) - - (define fd - (if (port? fd-or-port) - (fileno fd-or-port) - fd-or-port)) - - ;; XXX: 'fcntl' is a vararg function, but here we happily use the - ;; standard ABI; crossing fingers. - (let ((err (proc fd - (if wait? - F_SETLKW ; lock & wait - F_SETLK) ; non-blocking attempt - (make-c-struct %struct-flock - (list (operation->int operation) - SEEK_SET - 0 0 ; whole file - 0))))) - (or (zero? err) - - ;; Presumably we got EAGAIN or so. - (throw 'flock-error (errno))))))) - ;;; ;;; Keyword arguments. diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 0b73fb4b0c..73fa8a7acf 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -29,6 +29,10 @@ ;; Test the (guix build syscalls) module, although there's not much that can ;; actually be tested without being root. +(define temp-file + (string-append "t-utils-" (number->string (getpid)))) + + (test-begin "syscalls") (test-equal "mount, ENOENT" @@ -172,6 +176,88 @@ (status:exit-val status)))) (eq? #t result)))))))) +(false-if-exception (delete-file temp-file)) +(test-equal "fcntl-flock wait" + 42 ; the child's exit status + (let ((file (open-file temp-file "w0b"))) + ;; Acquire an exclusive lock. + (fcntl-flock file 'write-lock) + (match (primitive-fork) + (0 + (dynamic-wind + (const #t) + (lambda () + ;; Reopen FILE read-only so we can have a read lock. + (let ((file (open-file temp-file "r0b"))) + ;; Wait until we can acquire the lock. + (fcntl-flock file 'read-lock) + (primitive-exit (read file))) + (primitive-exit 1)) + (lambda () + (primitive-exit 2)))) + (pid + ;; Write garbage and wait. + (display "hello, world!" file) + (force-output file) + (sleep 1) + + ;; Write the real answer. + (seek file 0 SEEK_SET) + (truncate-file file 0) + (write 42 file) + (force-output file) + + ;; Unlock, which should let the child continue. + (fcntl-flock file 'unlock) + + (match (waitpid pid) + ((_ . status) + (let ((result (status:exit-val status))) + (close-port file) + result))))))) + +(test-equal "fcntl-flock non-blocking" + EAGAIN ; the child's exit status + (match (pipe) + ((input . output) + (match (primitive-fork) + (0 + (dynamic-wind + (const #t) + (lambda () + (close-port output) + + ;; Wait for the green light. + (read-char input) + + ;; Open FILE read-only so we can have a read lock. + (let ((file (open-file temp-file "w0"))) + (catch 'flock-error + (lambda () + ;; This attempt should throw EAGAIN. + (fcntl-flock file 'write-lock #:wait? #f)) + (lambda (key errno) + (primitive-exit (pk 'errno errno))))) + (primitive-exit -1)) + (lambda () + (primitive-exit -2)))) + (pid + (close-port input) + (let ((file (open-file temp-file "w0"))) + ;; Acquire an exclusive lock. + (fcntl-flock file 'write-lock) + + ;; Tell the child to continue. + (write 'green-light output) + (force-output output) + + (match (waitpid pid) + ((_ . status) + (let ((result (status:exit-val status))) + (fcntl-flock file 'unlock) + (close-port file) + result))))))))) + (test-assert "all-network-interface-names" (match (all-network-interface-names) (((? string? names) ..1) @@ -303,3 +389,5 @@ 0)) (test-end) + +(false-if-exception (delete-file temp-file)) diff --git a/tests/utils.scm b/tests/utils.scm index a54482e94c..6590ed91cf 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -168,88 +168,6 @@ (call-with-decompressed-port 'xz (open-file temp-file "r0b") get-bytevector-all)))) -(false-if-exception (delete-file temp-file)) -(test-equal "fcntl-flock wait" - 42 ; the child's exit status - (let ((file (open-file temp-file "w0b"))) - ;; Acquire an exclusive lock. - (fcntl-flock file 'write-lock) - (match (primitive-fork) - (0 - (dynamic-wind - (const #t) - (lambda () - ;; Reopen FILE read-only so we can have a read lock. - (let ((file (open-file temp-file "r0b"))) - ;; Wait until we can acquire the lock. - (fcntl-flock file 'read-lock) - (primitive-exit (read file))) - (primitive-exit 1)) - (lambda () - (primitive-exit 2)))) - (pid - ;; Write garbage and wait. - (display "hello, world!" file) - (force-output file) - (sleep 1) - - ;; Write the real answer. - (seek file 0 SEEK_SET) - (truncate-file file 0) - (write 42 file) - (force-output file) - - ;; Unlock, which should let the child continue. - (fcntl-flock file 'unlock) - - (match (waitpid pid) - ((_ . status) - (let ((result (status:exit-val status))) - (close-port file) - result))))))) - -(test-equal "fcntl-flock non-blocking" - EAGAIN ; the child's exit status - (match (pipe) - ((input . output) - (match (primitive-fork) - (0 - (dynamic-wind - (const #t) - (lambda () - (close-port output) - - ;; Wait for the green light. - (read-char input) - - ;; Open FILE read-only so we can have a read lock. - (let ((file (open-file temp-file "w0"))) - (catch 'flock-error - (lambda () - ;; This attempt should throw EAGAIN. - (fcntl-flock file 'write-lock #:wait? #f)) - (lambda (key errno) - (primitive-exit (pk 'errno errno))))) - (primitive-exit -1)) - (lambda () - (primitive-exit -2)))) - (pid - (close-port input) - (let ((file (open-file temp-file "w0"))) - ;; Acquire an exclusive lock. - (fcntl-flock file 'write-lock) - - ;; Tell the child to continue. - (write 'green-light output) - (force-output output) - - (match (waitpid pid) - ((_ . status) - (let ((result (status:exit-val status))) - (fcntl-flock file 'unlock) - (close-port file) - result))))))))) - ;; This is actually in (guix store). (test-equal "store-path-package-name" "bash-4.2-p24" From d33c8b464915fb9bbe07434116fd6f3428e8cef0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 6 May 2016 13:23:54 +0200 Subject: [PATCH 35/47] syscalls: Use 'define-c-struct' for 'fcntl-flock'. * guix/build/syscalls.scm (%struct-flock): Use 'define-c-struct'. (fcntl-flock): Use 'write-flock!' and 'make-bytevector' instead of 'make-c-struct'. --- guix/build/syscalls.scm | 41 ++++++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 17 deletions(-) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 86723c23c7..48ff227e10 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -643,13 +643,16 @@ system to PUT-OLD." ;;; Advisory file locking. ;;; -(define %struct-flock - ;; 'struct flock' from . - (list short ; l_type - short ; l_whence - size_t ; l_start - size_t ; l_len - int)) ; l_pid +(define-c-struct %struct-flock ; + sizeof-flock + list + read-flock + write-flock! + (type short) + (whence short) + (start size_t) + (length size_t) + (pid int)) (define F_SETLKW ;; On Linux-based systems, this is usually 7, but not always @@ -690,21 +693,25 @@ exception if it's already taken." (fileno fd-or-port) fd-or-port)) + (define bv + (make-bytevector sizeof-flock)) + + (write-flock! bv 0 + (operation->int operation) SEEK_SET + 0 0 ;whole file + 0) + ;; XXX: 'fcntl' is a vararg function, but here we happily use the ;; standard ABI; crossing fingers. - (let ((err (proc fd + (let ((ret (proc fd (if wait? F_SETLKW ; lock & wait F_SETLK) ; non-blocking attempt - (make-c-struct %struct-flock - (list (operation->int operation) - SEEK_SET - 0 0 ; whole file - 0))))) - (or (zero? err) - - ;; Presumably we got EAGAIN or so. - (throw 'flock-error (errno))))))) + (bytevector->pointer bv))) + (err (errno))) + (unless (zero? ret) + ;; Presumably we got EAGAIN or so. + (throw 'flock-error err)))))) ;;; From e42eb908f6133c4c192b4a4ff17d52a4819c2a2e Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 6 May 2016 14:44:51 +0200 Subject: [PATCH 36/47] gnu: r: Update to 3.3.0. * gnu/packages/statistics.scm (r): Update to 3.3.0. [inputs]: Add curl and tzdata. [arguments]: Set TZDIR in "set-timezone" phase. --- gnu/packages/statistics.scm | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/gnu/packages/statistics.scm b/gnu/packages/statistics.scm index 90dc4144ef..04274f279a 100644 --- a/gnu/packages/statistics.scm +++ b/gnu/packages/statistics.scm @@ -99,7 +99,7 @@ be output in text, PostScript, PDF or HTML.") (define-public r (package (name "r") - (version "3.2.5") + (version "3.3.0") (source (origin (method url-fetch) (uri (string-append "mirror://cran/src/base/R-" @@ -107,7 +107,7 @@ be output in text, PostScript, PDF or HTML.") version ".tar.gz")) (sha256 (base32 - "1dc0iybjk9kr1nghz3fpir6mb9hb9rnrz9bgh00w5pg5vir5cx30")))) + "1r0i0cqs3p0vrpiwq0zg5kbrmja9rmaijyzf9f23v6d5n5ab2mlj")))) (build-system gnu-build-system) (arguments `(#:make-flags @@ -121,10 +121,14 @@ be output in text, PostScript, PDF or HTML.") ;; Set default pager to "cat", because otherwise it is "false", ;; making "help()" print nothing at all. (lambda _ (setenv "PAGER" "cat") #t)) - (add-before - 'check 'set-timezone + (add-before 'check 'set-timezone ;; Some tests require the timezone to be set. - (lambda _ (setenv "TZ" "UTC") #t)) + (lambda* (#:key inputs #:allow-other-keys) + (setenv "TZ" "UTC") + (setenv "TZDIR" + (string-append (assoc-ref inputs "tzdata") + "/share/zoneinfo")) + #t)) (add-after 'build 'make-info (lambda _ (zero? (system* "make" "info")))) (add-after 'build 'install-info @@ -161,6 +165,8 @@ be output in text, PostScript, PDF or HTML.") ("xz" ,xz))) (inputs `(("cairo" ,cairo) + ("curl" ,curl) + ("tzdata" ,tzdata) ("gfortran" ,gfortran) ("icu4c" ,icu4c) ("libjpeg" ,libjpeg) From 218a21069ad5bb34e6d2a36a9d126fc3056d7c58 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 6 May 2016 09:11:08 -0400 Subject: [PATCH 37/47] gnu: redis: Update to 3.2.0. --- gnu/packages/databases.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gnu/packages/databases.scm b/gnu/packages/databases.scm index 63ca754688..a8998d803d 100644 --- a/gnu/packages/databases.scm +++ b/gnu/packages/databases.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2012, 2014, 2015 Andreas Enge ;;; Copyright © 2013 Cyril Roelandt -;;; Copyright © 2014 David Thompson +;;; Copyright © 2014, 2016 David Thompson ;;; Copyright © 2014, 2015, 2016 Mark H Weaver ;;; Copyright © 2015 Eric Bavier ;;; Copyright © 2015 Sou Bunnbu @@ -863,14 +863,14 @@ similar to BerkeleyDB, LevelDB, etc.") (define-public redis (package (name "redis") - (version "3.0.7") + (version "3.2.0") (source (origin (method url-fetch) (uri (string-append "http://download.redis.io/releases/redis-" version".tar.gz")) (sha256 (base32 - "08vzfdr67gp3lvk770qpax2c5g2sx8hn6p64jn3jddrvxb2939xj")))) + "0ql7zp061xr66a1dzpa6a0ijm8zm133dd364va7q5h8avkrim7wq")))) (build-system gnu-build-system) (arguments '(#:tests? #f ; tests related to master/slave and replication fail From 04d1a0dc0cf23d64c446757e4c7185c18428910c Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Tue, 26 Apr 2016 18:38:48 -0400 Subject: [PATCH 38/47] gnu: nginx: Update to 1.10.0. * gnu/packages/web.scm (nginx): Update to 1.10.0. --- gnu/packages/web.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/web.scm b/gnu/packages/web.scm index a0e1ec9422..0c2798f1a8 100644 --- a/gnu/packages/web.scm +++ b/gnu/packages/web.scm @@ -109,14 +109,14 @@ and its related documentation.") (define-public nginx (package (name "nginx") - (version "1.8.1") + (version "1.10.0") (source (origin (method url-fetch) (uri (string-append "http://nginx.org/download/nginx-" version ".tar.gz")) (sha256 (base32 - "1dwpyw4pvhj68vxramqxm8f79pqz9lrm8mvifbn49h3615ikqjwg")))) + "0kdyqa5xaxvhz6y75ixs05mzygk3kszzdq5h0gnlrg35vp1lgmlf")))) (build-system gnu-build-system) (inputs `(("pcre" ,pcre) ("openssl" ,openssl) From ef3b904770a0b456d2846fdddfb477ea63ea85b2 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 6 May 2016 15:00:35 -0400 Subject: [PATCH 39/47] gnu: isc-dhcp: Update to 4.3.4 [with mitigation for CVE-2016-2774]. * gnu/packages/admin.scm (isc-dhcp): Update to 4.3.4. Update bundled 'bind' to 9.9.9. --- gnu/packages/admin.scm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index d815dfb8b5..303e9978a5 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -486,9 +486,9 @@ connection alive.") (define-public isc-dhcp (let* ((bind-major-version "9") (bind-minor-version "9") - (bind-patch-version "8") - (bind-release-type "-P") - (bind-release-version "4") + (bind-patch-version "9") + (bind-release-type "") ; for patch release, use "-P" + (bind-release-version "") ; for patch release, e.g. "4" (bind-version (string-append bind-major-version "." bind-minor-version @@ -498,14 +498,14 @@ connection alive.") bind-release-version))) (package (name "isc-dhcp") - (version "4.3.3-P1") + (version "4.3.4") (source (origin (method url-fetch) (uri (string-append "http://ftp.isc.org/isc/dhcp/" version "/dhcp-" version ".tar.gz")) (sha256 (base32 - "08crcsmg4dm2v533aq3883ik8mf4vvvd6r998r4vrgx1zxnqj7n1")))) + "0zk0imll6bfyp9p4ndn8h6s4ifijnw5bhixswifr5rnk7pp5l4gm")))) (build-system gnu-build-system) (arguments `(#:parallel-build? #f @@ -604,7 +604,7 @@ connection alive.") "/bind-" bind-version ".tar.gz")) (sha256 (base32 - "1wl9kl0630dc1qjrf7fnp8cscagfm5qgmisi0zhr1p6iwi9bil2y")))) + "0w8qqm6p2y6x57j2l0a3278g173wd84dsr4py9z00191f3wra74q")))) ;; When cross-compiling, we need the cross Coreutils and sed. ;; Otherwise just use those from %FINAL-INPUTS. From 9fab7937294edcb50d62297356091266a5586ff3 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 6 May 2016 15:03:37 -0400 Subject: [PATCH 40/47] gnu: bind-utils: Update to 9.10.4. * gnu/packages/dns.scm (bind-utils): Update to 9.10.4. --- gnu/packages/dns.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/dns.scm b/gnu/packages/dns.scm index 5c0bfc3f87..e92d8d26b8 100644 --- a/gnu/packages/dns.scm +++ b/gnu/packages/dns.scm @@ -66,14 +66,14 @@ and BOOTP/TFTP for network booting of diskless machines.") (define-public bind-utils (package (name "bind-utils") - (version "9.10.3-P4") + (version "9.10.4") (source (origin (method url-fetch) (uri (string-append "http://ftp.isc.org/isc/bind9/" version "/bind-" version ".tar.gz")) (sha256 (base32 - "0giys46ifypysf799w9v58kbaz1v3fbdzw3s212znifzzfsl9h1a")))) + "0mmhzi4483mkak47wj255a36g3v0yilxwfwlbckr1hssinri5m7q")))) (build-system gnu-build-system) (inputs ;; it would be nice to add GeoIP and gssapi once there is package From aa206271cf369250f347be50b5a0733d95b30d4e Mon Sep 17 00:00:00 2001 From: Alex Griffin Date: Thu, 5 May 2016 18:25:45 -0500 Subject: [PATCH 41/47] gnu: wesnoth: Update to 1.12.5. * gnu/packages/games.scm (wesnoth): Update to 1.12.5. Signed-off-by: Leo Famulari --- gnu/packages/games.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/gnu/packages/games.scm b/gnu/packages/games.scm index 55bffe9539..a298f03512 100644 --- a/gnu/packages/games.scm +++ b/gnu/packages/games.scm @@ -19,6 +19,7 @@ ;;; Copyright © 2016 Nils Gillmann ;;; Copyright © 2016 Albin Söderqvist ;;; Copyright © 2016 Kei Yamashita +;;; Copyright © 2016 Alex Griffin ;;; ;;; This file is part of GNU Guix. ;;; @@ -1021,14 +1022,14 @@ falling, themeable graphics and sounds, and replays.") (define-public wesnoth (package (name "wesnoth") - (version "1.12.4") + (version "1.12.5") (source (origin (method url-fetch) (uri (string-append "mirror://sourceforge/wesnoth/" name "-" version ".tar.bz2")) (sha256 (base32 - "19qyylylaljhk45lk2ja0xp7cx9iy4hx07l65zkg20a2v9h50lmz")))) + "07d8ms9ayswg2g530p0zwmz3d77zv68l6nmc718iq9sbv90av6jr")))) (build-system cmake-build-system) (arguments '(#:tests? #f ; no check target From 70dced54edc923ec8da86ae1c18ac50a7832b039 Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Fri, 6 May 2016 16:46:35 -0400 Subject: [PATCH 42/47] gnu: msmtp: Update to 1.6.4. * gnu/packages/mail.scm (msmtp): Update to 1.6.4. --- gnu/packages/mail.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index 56e85712db..c34296cef2 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -622,14 +622,14 @@ which can add many functionalities to the base client.") (define-public msmtp (package (name "msmtp") - (version "1.6.3") + (version "1.6.4") (source (origin (method url-fetch) (uri (string-append "mirror://sourceforge/msmtp/msmtp-" version ".tar.xz")) (sha256 (base32 - "0mbkflxv2swjz4185inis83v6pxcblpmapwjhgpc6wh7kh3bx0pr")))) + "1kfihblm769s4hv8iah5mqynqd6hfwlyz5rcg2v423a4llic0jcv")))) (build-system gnu-build-system) (inputs `(("libidn" ,libidn) From bdb2d56ee72f00a21047999a35ac7db714d8937c Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Fri, 6 May 2016 17:01:35 -0400 Subject: [PATCH 43/47] gnu: mutt: Update to 1.6.1. * gnu/packages/mail.scm (mutt): Update to 1.6.1. --- gnu/packages/mail.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index c34296cef2..17dd0adc04 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -177,14 +177,14 @@ aliasing facilities to work just as they would on normal mail.") (define-public mutt (package (name "mutt") - (version "1.6.0") + (version "1.6.1") (source (origin (method url-fetch) (uri (string-append "ftp://ftp.mutt.org/pub/mutt/mutt-" version ".tar.gz")) (sha256 (base32 - "06bc2drbgalkk68rzg7hq2v5m5qgjxff5357wg0419dpi8ivdbr9")) + "087dz1y9qhl4ikhsnnb4xmyvs82w6kx480w8zj130wdiqvn6rclq")) (patches (search-patches "mutt-store-references.patch")))) (build-system gnu-build-system) (inputs From 13416a10afdbad6546ef7943d93aba795ee5703b Mon Sep 17 00:00:00 2001 From: Kei Yamashita Date: Fri, 6 May 2016 18:57:42 -0400 Subject: [PATCH 44/47] gnu: Add moc. * gnu/packages/music.scm (moc): New variable. Signed-off-by: Leo Famulari --- gnu/packages/music.scm | 44 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/gnu/packages/music.scm b/gnu/packages/music.scm index 4946024264..7e0ea6210e 100644 --- a/gnu/packages/music.scm +++ b/gnu/packages/music.scm @@ -45,8 +45,10 @@ #:use-module (gnu packages check) #:use-module (gnu packages compression) #:use-module (gnu packages curl) + #:use-module (gnu packages cyrus-sasl) #:use-module (gnu packages docbook) #:use-module (gnu packages doxygen) + #:use-module (gnu packages file) #:use-module (gnu packages flex) #:use-module (gnu packages fltk) #:use-module (gnu packages fonts) @@ -84,6 +86,7 @@ #:use-module (gnu packages tcl) #:use-module (gnu packages texinfo) #:use-module (gnu packages texlive) + #:use-module (gnu packages tls) #:use-module (gnu packages video) #:use-module (gnu packages web) #:use-module (gnu packages wxwidgets) @@ -1547,3 +1550,44 @@ for improved Amiga ProTracker 2/3 compatibility.") (home-page "http://milkytracker.org/") ;; 'src/milkyplay' is under Modified BSD, the rest is under GPL3 or later. (license (list license:bsd-3 license:gpl3+)))) + +(define-public moc + (package + (name "moc") + (version "2.5.1") + (source (origin + (method url-fetch) + (uri (string-append "http://ftp.daper.net/pub/soft/" + name "/stable/" + name "-" version ".tar.bz2")) + (sha256 + (base32 + "1wn4za08z64bhsgfhr9c0crfyvy8c3b6a337wx7gz19am5srqh8v")))) + (build-system gnu-build-system) + (inputs + `(("alsa-lib" ,alsa-lib) + ("curl" ,curl) + ("faad2" ,faad2) + ("ffmpeg" ,ffmpeg) + ("file" ,file) + ("jack" ,jack-1) + ("libid3tag" ,libid3tag) + ("libltdl" ,libltdl) + ("libmodplug" ,libmodplug) + ("libmpcdec" ,libmpcdec) + ("libmad" ,libmad) + ("ncurses" ,ncurses) + ("openssl" ,openssl) + ("sasl" ,cyrus-sasl) + ("speex" ,speex) + ("taglib" ,taglib) + ("wavpack" ,wavpack) + ("zlib" ,zlib))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (synopsis "Console audio player designed to be powerful and easy to use") + (description + "Music on Console is a console audio player that supports many file +formats, including most audio formats recognized by FFMpeg.") + (home-page "http://moc.daper.net") + (license license:gpl2+))) From d17ae8c0c3023683a3175246a8ceedac237b5dd0 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 30 Apr 2016 10:31:13 +0200 Subject: [PATCH 45/47] gnu: Add thinkfan. * gnu/packages/linux.scm (thinkfan): New variable. Signed-off-by: Leo Famulari --- gnu/packages/linux.scm | 52 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index e80c9004ed..fcea499227 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -11,6 +11,7 @@ ;;; Copyright © 2016 Alex Kost ;;; Copyright © 2016 Raymond Nicholson ;;; Copyright © 2016 Mathieu Lirzin +;;; Copyright © 2016 Nicolas Goaziou ;;; ;;; This file is part of GNU Guix. ;;; @@ -63,6 +64,7 @@ #:use-module (gnu packages readline) #:use-module (gnu packages calendar) #:use-module (gnu packages tls) + #:use-module (gnu packages freedesktop) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix utils) @@ -2591,3 +2593,53 @@ where they are less likely to cause damage to the spinning disc. Requires a drive that supports the ATA/ATAPI-7 IDLE IMMEDIATE command with unload feature, and a laptop with an accelerometer. It has no effect on SSDs.") (license license:gpl2))) + +(define-public thinkfan + (package + (name "thinkfan") + (version "0.9.3") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/thinkfan/" + version "/thinkfan-" version ".tar.gz")) + (sha256 + (base32 + "0nz4c48f0i0dljpk5y33c188dnnwg8gz82s4grfl8l64jr4n675n")) + (modules '((guix build utils))) + ;; Fix erroneous man page location in Makefile leading to + ;; a compilation failure. + (snippet + '(substitute* "CMakeLists.txt" + (("thinkfan\\.1") "src/thinkfan.1"))))) + (build-system cmake-build-system) + (arguments + `(#:modules ((guix build cmake-build-system) + (guix build utils) + (srfi srfi-26)) + #:tests? #f ;no test target + #:configure-flags + ;; Enable reading temperatures from hard disks via S.M.A.R.T. + `("-DUSE_ATASMART:BOOL=ON") + #:phases + (modify-phases %standard-phases + ;; Install scripts for various foreign init systems. + (add-after 'install 'install-rc-scripts + (lambda* (#:key outputs #:allow-other-keys) + (for-each (cute install-file <> + (string-append (assoc-ref outputs "out") + "/share/thinkfan")) + (find-files (string-append "../thinkfan-" ,version + "/rcscripts") + ".*")) + #t))))) + (inputs + `(("libatasmart" ,libatasmart))) + (home-page "http://thinkfan.sourceforge.net/") + (synopsis "Simple fan control program") + (description + "Thinkfan is a simple fan control program. It reads temperatures, +checks them against configured limits and switches to appropriate (also +pre-configured) fan level. It requires a working @code{thinkpad_acpi} or any +other @code{hwmon} driver that enables temperature reading and fan control +from userspace.") + (license license:gpl3+))) From b5f13fdb9632524453031960fd5052a79a2ec1d5 Mon Sep 17 00:00:00 2001 From: Roel Janssen Date: Sat, 7 May 2016 18:45:47 +0200 Subject: [PATCH 46/47] gnu: Add r-mvtnorm. * gnu/packages/statistics.scm (r-mvtnorm): New variable. Signed-off-by: Leo Famulari --- gnu/packages/statistics.scm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/gnu/packages/statistics.scm b/gnu/packages/statistics.scm index 04274f279a..7b3483206f 100644 --- a/gnu/packages/statistics.scm +++ b/gnu/packages/statistics.scm @@ -2439,6 +2439,25 @@ things. RSP is ideal for self-contained scientific reports and R package vignettes.") (license license:lgpl2.1+))) +(define-public r-mvtnorm + (package + (name "r-mvtnorm") + (version "1.0-5") + (source (origin + (method url-fetch) + (uri (cran-uri "mvtnorm" version)) + (sha256 + (base32 + "1pc1mi2h063gh4a40009xk5j6pf5bm4274i5kycln38dixsry3yh")))) + (build-system r-build-system) + (inputs + `(("gfortran" ,gfortran))) + (home-page "http://mvtnorm.R-forge.R-project.org") + (synopsis "Package for multivariate normal and t-distributions") + (description "This package can compute multivariate normal and +t-probabilities, quantiles, random deviates and densities.") + (license license:gpl2))) + (define-public r-matrixstats (package (name "r-matrixstats") From 2d4422d5b53276661a68f65b91daa854de88c165 Mon Sep 17 00:00:00 2001 From: Roel Janssen Date: Sat, 7 May 2016 19:12:42 +0200 Subject: [PATCH 47/47] gnu: Add bash-tap. * gnu/packages/bash.scm (bash-tap): New variable. Signed-off-by: Leo Famulari --- gnu/packages/bash.scm | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/gnu/packages/bash.scm b/gnu/packages/bash.scm index cad66da70b..ff3acfc0e4 100644 --- a/gnu/packages/bash.scm +++ b/gnu/packages/bash.scm @@ -318,3 +318,46 @@ without modification.") completion for many common commands.") (home-page "http://bash-completion.alioth.debian.org/") (license gpl2+))) + +(define-public bash-tap + (package + (name "bash-tap") + (version "1.0.2") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/illusori/bash-tap/" + "archive/" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0qs1qi38bl3ns4mpagcawv618dsk2q1lgrbddgvs0wl3ia12cyz5")))) + ;; There is no compilation process to use this package, however, the bash + ;; scripts installed by this package start with "#!/bin/bash". To fix + ;; these lines, we use the patch-shebangs of the GNU build system. The + ;; project does not use a Makefile. + (build-system gnu-build-system) + (arguments + `(#:tests? #f ; There is no test suite. + #:phases + (modify-phases %standard-phases + ;; Because there are no configure scripts or Makefile, we can + ;; remove these phases. + (delete 'configure) + (delete 'build) + ;; The installation involves manually copying the files to a location. + ;; To make them easily accessible by setting PATH, we add the scripts + ;; to the "bin" folder. + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let ((bin (string-append (assoc-ref outputs "out") "/bin"))) + (install-file "bash-tap" bin) + (install-file "bash-tap-bootstrap" bin) + (install-file "bash-tap-mock" bin))))))) + (home-page "http://www.illusori.co.uk/projects/bash-tap/") + (synopsis "Bash port of a Test::More/Test::Builder-style TAP-compliant +test library") + (description "Bash TAP is a TAP-compliant Test::More-style testing library +for Bash shell scripts and functions. Along with the Test::More-style testing +helpers it provides helper functions for mocking commands and in-process output +capturing.") + (license expat)))