Merge branch 'master' into core-updates

gnu/local.mk

@@ -721,6 +721,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/gcr-disable-failing-tests.patch		\
   %D%/packages/patches/gcr-fix-collection-tests-to-work-with-gpg-21.patch	\
   %D%/packages/patches/gd-CVE-2018-5711.patch			\
+  %D%/packages/patches/gd-CVE-2018-1000222.patch		\
   %D%/packages/patches/gd-fix-tests-on-i686.patch		\
   %D%/packages/patches/gd-freetype-test-failure.patch		\
   %D%/packages/patches/gdm-CVE-2018-14424.patch			\

gnu/packages/bioconductor.scm

@@ -410,14 +410,14 @@ determining dependencies between variables, code improvement suggestions.")
 (define-public r-chippeakanno
   (package
     (name "r-chippeakanno")
-    (version "3.14.1")
+    (version "3.14.2")
     (source
      (origin
        (method url-fetch)
        (uri (bioconductor-uri "ChIPpeakAnno" version))
        (sha256
         (base32
-         "1cn1hfc3nvsf2n3563lkmvwjxfbiygx7f84zk683p89gy7zi1gyj"))))
+         "13rksc65lxxzyw11galh6xzvgzp5ii0gwiwpvrm395v2r17rhwsc"))))
     (properties `((upstream-name . "ChIPpeakAnno")))
     (build-system r-build-system)
     (propagated-inputs

gnu/packages/bioinformatics.scm

@@ -9866,14 +9866,14 @@ Shiny-based display methods for Bioconductor objects.")
 (define-public r-annotationhub
   (package
     (name "r-annotationhub")
-    (version "2.12.0")
+    (version "2.12.1")
     (source
      (origin
        (method url-fetch)
        (uri (bioconductor-uri "AnnotationHub" version))
        (sha256
         (base32
-         "11gh7qkgazs90czdqgv74gh2hz26xrmdp6wsz9x5pygbxls8xdw3"))))
+         "02ls279k1qlch147vw8kwvlhcqyzvi495bgv110m0xnnbpgbln6g"))))
     (properties `((upstream-name . "AnnotationHub")))
     (build-system r-build-system)
     (propagated-inputs

gnu/packages/gd.scm

@@ -39,6 +39,7 @@
 (define-public gd
   (package
     (name "gd")
+    (replacement gd/fixed)
     ;; Note: With libgd.org now pointing to github.com, genuine old
     ;; tarballs are no longer available.  Notably, versions 2.0.x are
     ;; missing.
@@ -91,6 +92,16 @@ most common applications of GD involve website development.")
                            "See COPYING file in the distribution."))
     (properties '((cpe-name . "libgd")))))
 
+(define-public gd/fixed
+  (hidden-package
+    (package
+      (inherit gd)
+      (source (origin
+                (inherit (package-source gd))
+                (patches (append (origin-patches (package-source gd))
+                                 (search-patches "gd-CVE-2018-5711.patch"
+                                                 "gd-CVE-2018-1000222.patch"))))))))
+
 (define-public perl-gd
   (package
     (name "perl-gd")

gnu/packages/patches/gd-CVE-2018-1000222.patch

@@ -0,0 +1,87 @@
+Fix CVE-2018-1000222:
+
+https://github.com/libgd/libgd/issues/447
+https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2018-1000222
+
+Patch copied from upstream source repository:
+
+https://github.com/libgd/libgd/commit/4b1e18a00ce7c4b7e6919c3b3109a034393b805a
+
+From 4b1e18a00ce7c4b7e6919c3b3109a034393b805a Mon Sep 17 00:00:00 2001
+From: Mike Frysinger <vapier@gentoo.org>
+Date: Sat, 14 Jul 2018 13:54:08 -0400
+Subject: [PATCH] bmp: check return value in gdImageBmpPtr
+
+Closes #447.
+
+(cherry picked from commit ac16bdf2d41724b5a65255d4c28fb0ec46bc42f5)
+---
+ src/gd_bmp.c | 17 ++++++++++++++---
+ 1 file changed, 14 insertions(+), 3 deletions(-)
+
+diff --git a/src/gd_bmp.c b/src/gd_bmp.c
+index ccafdcd..d625da1 100644
+--- a/src/gd_bmp.c
++++ b/src/gd_bmp.c
+@@ -48,6 +48,8 @@ static int bmp_read_4bit(gdImagePtr im, gdIOCtxPtr infile, bmp_info_t *info, bmp
+ static int bmp_read_8bit(gdImagePtr im, gdIOCtxPtr infile, bmp_info_t *info, bmp_hdr_t *header);
+ static int bmp_read_rle(gdImagePtr im, gdIOCtxPtr infile, bmp_info_t *info);
+ 
++static int _gdImageBmpCtx(gdImagePtr im, gdIOCtxPtr out, int compression);
++
+ #define BMP_DEBUG(s)
+ 
+ static int gdBMPPutWord(gdIOCtx *out, int w)
+@@ -88,8 +90,10 @@ BGD_DECLARE(void *) gdImageBmpPtr(gdImagePtr im, int *size, int compression)
+ 	void *rv;
+ 	gdIOCtx *out = gdNewDynamicCtx(2048, NULL);
+ 	if (out == NULL) return NULL;
+-	gdImageBmpCtx(im, out, compression);
+-	rv = gdDPExtractData(out, size);
++	if (!_gdImageBmpCtx(im, out, compression))
++		rv = gdDPExtractData(out, size);
++	else
++		rv = NULL;
+ 	out->gd_free(out);
+ 	return rv;
+ }
+@@ -142,6 +146,11 @@ BGD_DECLARE(void) gdImageBmp(gdImagePtr im, FILE *outFile, int compression)
+ 		compression - whether to apply RLE or not.
+ */
+ BGD_DECLARE(void) gdImageBmpCtx(gdImagePtr im, gdIOCtxPtr out, int compression)
++{
++	_gdImageBmpCtx(im, out, compression);
++}
++
++static int _gdImageBmpCtx(gdImagePtr im, gdIOCtxPtr out, int compression)
+ {
+ 	int bitmap_size = 0, info_size, total_size, padding;
+ 	int i, row, xpos, pixel;
+@@ -149,6 +158,7 @@ BGD_DECLARE(void) gdImageBmpCtx(gdImagePtr im, gdIOCtxPtr out, int compression)
+ 	unsigned char *uncompressed_row = NULL, *uncompressed_row_start = NULL;
+ 	FILE *tmpfile_for_compression = NULL;
+ 	gdIOCtxPtr out_original = NULL;
++	int ret = 1;
+ 
+ 	/* No compression if its true colour or we don't support seek */
+ 	if (im->trueColor) {
+@@ -326,6 +336,7 @@ BGD_DECLARE(void) gdImageBmpCtx(gdImagePtr im, gdIOCtxPtr out, int compression)
+ 		out_original = NULL;
+ 	}
+ 
++	ret = 0;
+ cleanup:
+ 	if (tmpfile_for_compression) {
+ #ifdef _WIN32
+@@ -339,7 +350,7 @@ cleanup:
+ 	if (out_original) {
+ 		out_original->gd_free(out_original);
+ 	}
+-	return;
++	return ret;
+ }
+ 
+ static int compress_row(unsigned char *row, int length)
+-- 
+2.18.0
+

gnu/packages/php.scm

@@ -57,7 +57,8 @@
              (inherit (package-source gd))
              (patches (search-patches "gd-fix-tests-on-i686.patch"
                                       "gd-freetype-test-failure.patch"
-                                      "gd-CVE-2018-5711.patch"))))))
+                                      "gd-CVE-2018-5711.patch"
+                                      "gd-CVE-2018-1000222.patch"))))))
 
 (define-public php
   (package

gnu/packages/statistics.scm

@@ -1749,13 +1749,13 @@ and density estimation.")
 (define-public r-chron
   (package
     (name "r-chron")
-    (version "2.3-52")
+    (version "2.3-53")
     (source (origin
               (method url-fetch)
               (uri (cran-uri "chron" version))
               (sha256
                (base32
-                "185lfp75cv3l4cavg64sccj8lgc5sivch13n6gkannv3pd5cyzy4"))))
+                "02bkywwsxwrxc035hv51dxgdm1fjxdm7dn19ivifln59dfs1862j"))))
     (build-system r-build-system)
     (home-page "https://cran.r-project.org/web/packages/chron")
     (synopsis "Chronological R objects which can handle dates and times")

gnu/packages/tex.scm

@@ -4250,14 +4250,14 @@ PDF documents.")
 (define-public texmaker
   (package
     (name "texmaker")
-    (version "4.5")
+    (version "5.0.2")
     (source (origin
               (method url-fetch)
               (uri (string-append "http://www.xm1math.net/texmaker/texmaker-"
                                   version ".tar.bz2"))
               (sha256
                (base32
-                "056njk6j8wma23mlp7xa3rgfaxx0q8ynwx8wkmj7iy0b85p9ds9c"))))
+                "0y81mjm89b99pr9svcwpaf4iz2q9pc9hjas5kiwd1pbgl5vqskm9"))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases
@@ -4268,9 +4268,9 @@ PDF documents.")
              (let ((out (assoc-ref outputs "out")))
                (invoke "qmake"
                        (string-append "PREFIX=" out)
-                       (string-append "DESKTOPDIR=" out
+                       (string-append "DESKTOPDIR=" out "/share/applications")
-                                      "/share/applications")
                        (string-append "ICONDIR=" out "/share/pixmaps")
+                       (string-append "METAINFODIR=" out "/share/metainfo")
                        "texmaker.pro")))))))
     (inputs
      `(("poppler-qt5" ,poppler-qt5)

gnu/packages/tls.scm

@@ -502,20 +502,20 @@ netcat implementation that supports TLS.")
   (package
     (name "python-acme")
     ;; Remember to update the hash of certbot when updating python-acme.
-    (version "0.26.1")
+    (version "0.27.1")
     (source (origin
               (method url-fetch)
               (uri (pypi-uri "acme" version))
               (sha256
                (base32
-                "1glhwqj6yyb11820lspgd0gl5dqdfljn43kcy4ar5caccpsbbrw6"))))
+                "142gynlfx7yv0sdba3gpdxlnhg9chhz7hpdxdrp630z17h1bk9ri"))))
     (build-system python-build-system)
     (arguments
      `(#:phases
        (modify-phases %standard-phases
          (add-after 'build 'build-documentation
            (lambda _
-             (zero? (system* "make" "-C" "docs" "man" "info"))))
+             (invoke "make" "-C" "docs" "man" "info")))
          (add-after 'install 'install-documentation
            (lambda* (#:key outputs #:allow-other-keys)
              (let* ((out (assoc-ref outputs "out"))
@@ -559,7 +559,7 @@ netcat implementation that supports TLS.")
               (uri (pypi-uri name version))
               (sha256
                (base32
-                "0rnayqhdabm0rljxh76blqd11h51dqnwlwvql0j6xwzpccym30s9"))))
+                "0anh3vjy9sif1bkp25nj76ii37xx8hh0igcx60ppag12xlabsw1m"))))
     (build-system python-build-system)
     (arguments
      `(,@(substitute-keyword-arguments (package-arguments python-acme)

guix/scripts/build.scm

@@ -735,7 +735,7 @@ needed."
 
         (parameterize ((current-build-output-port (if quiet?
                                                       (%make-void-port "w")
-                                                      (current-error-port))))
+                                                      (build-output-port #:verbose? #t))))
           (let* ((mode  (assoc-ref opts 'build-mode))
                  (drv   (options->derivations store opts))
                  (urls  (map (cut string-append <> "/log")

guix/scripts/package.scm

@@ -329,7 +329,8 @@ ENTRIES, a list of manifest entries, in the context of PROFILE."
   `((verbosity . 0)
     (graft? . #t)
     (substitutes? . #t)
-    (build-hook? . #t)))
+    (build-hook? . #t)
+    (print-build-trace? . #t)))
 
 (define (show-help)
   (display (G_ "Usage: guix package [OPTION]...
@@ -930,18 +931,24 @@ processed, #f otherwise."
         (arg-handler arg result)
         (leave (G_ "~A: extraneous argument~%") arg)))
 
-  (let ((opts (parse-command-line args %options (list %default-options #f)
+  (define opts
-                                  #:argument-handler handle-argument)))
+    (parse-command-line args %options (list %default-options #f)
-    (with-error-handling
+                        #:argument-handler handle-argument))
-      (or (process-query opts)
+  (define verbose?
-          (parameterize ((%store  (open-connection))
+    (assoc-ref opts 'verbose?))
-                         (%graft? (assoc-ref opts 'graft?)))
-            (set-build-options-from-command-line (%store) opts)
 
-            (parameterize ((%guile-for-build
+  (with-error-handling
-                            (package-derivation
+    (or (process-query opts)
-                             (%store)
+        (parameterize ((%store  (open-connection))
-                             (if (assoc-ref opts 'bootstrap?)
+                       (%graft? (assoc-ref opts 'graft?)))
-                                 %bootstrap-guile
+          (set-build-options-from-command-line (%store) opts)
-                                 (canonical-package guile-2.2)))))
+
-              (process-actions (%store) opts)))))))
+          (parameterize ((%guile-for-build
+                          (package-derivation
+                           (%store)
+                           (if (assoc-ref opts 'bootstrap?)
+                               %bootstrap-guile
+                               (canonical-package guile-2.2))))
+                         (current-build-output-port
+                          (build-output-port #:verbose? verbose?)))
+            (process-actions (%store) opts))))))

guix/ui.scm

@@ -10,6 +10,9 @@
 ;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
 ;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch>
 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
+;;; Copyright © 2013, 2014 Free Software Foundation, Inc.
+;;; Copyright © 2018 Sahithi Yarlagadda <sahi@swecha.net>
+;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -115,7 +118,8 @@
             guix-warning-port
             warning
             info
-            guix-main))
+            guix-main
+            build-output-port))
 
 ;;; Commentary:
 ;;;
@@ -1622,4 +1626,160 @@ and signal handling has already been set up."
   (initialize-guix)
   (apply run-guix args))
 
+(define color-table
+  `((CLEAR       .   "0")
+    (RESET       .   "0")
+    (BOLD        .   "1")
+    (DARK        .   "2")
+    (UNDERLINE   .   "4")
+    (UNDERSCORE  .   "4")
+    (BLINK       .   "5")
+    (REVERSE     .   "6")
+    (CONCEALED   .   "8")
+    (BLACK       .  "30")
+    (RED         .  "31")
+    (GREEN       .  "32")
+    (YELLOW      .  "33")
+    (BLUE        .  "34")
+    (MAGENTA     .  "35")
+    (CYAN        .  "36")
+    (WHITE       .  "37")
+    (ON-BLACK    .  "40")
+    (ON-RED      .  "41")
+    (ON-GREEN    .  "42")
+    (ON-YELLOW   .  "43")
+    (ON-BLUE     .  "44")
+    (ON-MAGENTA  .  "45")
+    (ON-CYAN     .  "46")
+    (ON-WHITE    .  "47")))
+
+(define (color . lst)
+  "Return a string containing the ANSI escape sequence for producing the
+requested set of attributes in LST.  Unknown attributes are ignored."
+  (let ((color-list
+         (remove not
+                 (map (lambda (color) (assq-ref color-table color))
+                      lst))))
+    (if (null? color-list)
+        ""
+        (string-append
+         (string #\esc #\[)
+         (string-join color-list ";" 'infix)
+         "m"))))
+
+(define (colorize-string str . color-list)
+  "Return a copy of STR colorized using ANSI escape sequences according to the
+attributes STR.  At the end of the returned string, the color attributes will
+be reset such that subsequent output will not have any colors in effect."
+  (string-append
+   (apply color color-list)
+   str
+   (color 'RESET)))
+
+(define* (build-output-port #:key
+                            (colorize? #t)
+                            verbose?
+                            (port (current-error-port)))
+  "Return a soft port that processes build output.  By default it colorizes
+phase announcements and replaces any other output with a spinner."
+  (define spun? #f)
+  (define spin!
+    (let ((steps (circular-list "\\" "|" "/" "-")))
+      (lambda ()
+        (match steps
+          ((first . rest)
+           (set! steps rest)
+           (set! spun? #t) ; remember to erase spinner
+           first)))))
+
+  (define use-color?
+    (and colorize?
+         (not (or (getenv "NO_COLOR")
+                  (getenv "INSIDE_EMACS")
+                  (not (isatty? port))))))
+
+  (define handle-string
+    (let* ((proc (if use-color?
+                     colorize-string
+                     (lambda (s . _) s)))
+           (rules `(("^(@ build-started) (.*) (.*)"
+                     #:transform
+                     ,(lambda (m)
+                        (string-append
+                         (proc "Building " 'BLUE 'BOLD)
+                         (match:substring m 2) "\n")))
+                    ("^(@ build-failed) (.*) (.*)"
+                     #:transform
+                     ,(lambda (m)
+                        (string-append
+                         (proc "Build failed: " 'RED 'BOLD)
+                         (match:substring m 2) "\n")))
+                    ("^(@ build-succeeded) (.*) (.*)"
+                     #:transform
+                     ,(lambda (m)
+                        (string-append
+                         (proc "Built " 'GREEN 'BOLD)
+                         (match:substring m 2) "\n")))
+                    ("^(@ substituter-started) (.*) (.*)"
+                     #:transform
+                     ,(lambda (m)
+                        (string-append
+                         (proc "Substituting " 'BLUE 'BOLD)
+                         (match:substring m 2) "\n")))
+                    ("^(@ substituter-failed) (.*) (.*) (.*)"
+                     #:transform
+                     ,(lambda (m)
+                        (string-append
+                         (proc "Substituter failed: " 'RED 'BOLD)
+                         (match:substring m 2) "\n"
+                         (match:substring m 3) ": "
+                         (match:substring m 4) "\n")))
+                    ("^(@ substituter-succeeded) (.*)"
+                     #:transform
+                     ,(lambda (m)
+                        (string-append
+                         (proc "Substituted " 'GREEN 'BOLD)
+                         (match:substring m 2) "\n")))
+                    ("^(starting phase )(.*)"
+                     BLUE GREEN)
+                    ("^(phase)(.*)(succeeded after)(.*)(seconds)(.*)"
+                     GREEN BLUE GREEN BLUE GREEN BLUE)
+                    ("^(phase)(.*)(failed after)(.*)(seconds)(.*)"
+                     RED BLUE RED BLUE RED BLUE))))
+      (lambda (str)
+        (let ((processed
+               (any (match-lambda
+                      ((pattern #:transform transform)
+                       (and=> (string-match pattern str)
+                              transform))
+                      ((pattern . colors)
+                       (and=> (string-match pattern str)
+                              (lambda (m)
+                                (let ((substrings
+                                       (map (cut match:substring m <>)
+                                            (iota (- (match:count m) 1) 1))))
+                                  (string-join (map proc substrings colors) ""))))))
+                    rules)))
+          (when spun?
+            (display (string #\backspace) port))
+          (if processed
+              (begin
+                (display processed port)
+                (set! spun? #f))
+              ;; Print unprocessed line, or replace with spinner
+              (display (if verbose? str (spin!)) port))))))
+  (make-soft-port
+   (vector
+    ;; procedure accepting one character for output
+    (cut write <> port)
+    ;; procedure accepting a string for output
+    handle-string
+    ;; thunk for flushing output
+    (lambda () (force-output port))
+    ;; thunk for getting one character
+    (const #t)
+    ;; thunk for closing port (not by garbage collection)
+    (lambda () (close port)))
+   "w"))
+
 ;;; ui.scm ends here