~ruther/guix-local

3d82676919b952d0a7e205fa5da6320b1cf21e21 — Mark H Weaver 9 years ago f9a6531 + 7500e42
Merge branch 'master' into core-updates
M build-aux/run-system-tests.scm => build-aux/run-system-tests.scm +2 -1
@@ 68,7 68,8 @@
                           (out -> (map derivation->output-path drv)))
        (mbegin %store-monad
          (show-what-to-build* drv)
          (set-build-options* #:keep-going? #t #:keep-failed? #t)
          (set-build-options* #:keep-going? #t #:keep-failed? #t
                              #:fallback? #t)
          (built-derivations* drv)
          (mlet %store-monad ((valid  (filterm (store-lift valid-path?)
                                               out))

M gnu/build/file-systems.scm => gnu/build/file-systems.scm +19 -16
@@ 192,15 192,15 @@ not valid header was found."

(define (disk-partitions)
  "Return the list of device names corresponding to valid disk partitions."
  (define (partition? major minor)
    (let ((marker (format #f "/sys/dev/block/~a:~a/partition" major minor)))
      (catch 'system-error
        (lambda ()
          (not (zero? (call-with-input-file marker read))))
        (lambda args
          (if (= ENOENT (system-error-errno args))
              #f
              (apply throw args))))))
  (define (last-character str)
    (string-ref str (- (string-length str) 1)))

  (define (partition? name major minor)
    ;; Select device names that end in a digit, like libblkid's 'probe_all'
    ;; function does.  Checking for "/sys/dev/block/MAJOR:MINOR/partition"
    ;; doesn't work for partitions coming from mapped devices.
    (and (char-set-contains? char-set:digit (last-character name))
         (> major 2)))                      ;ignore RAM disks and floppy disks

  (call-with-input-file "/proc/partitions"
    (lambda (port)


@@ 217,7 217,7 @@ not valid header was found."
              (match (string-tokenize line)
                (((= string->number major) (= string->number minor)
                  blocks name)
                 (if (partition? major minor)
                 (if (partition? name major minor)
                     (loop (cons name parts))
                     (loop parts))))))))))



@@ 232,12 232,15 @@ warning and #f as the result."
        ;; When running on the hand-made /dev,
        ;; 'disk-partitions' could return partitions for which
        ;; we have no /dev node.  Handle that gracefully.
        (if (= ENOENT (system-error-errno args))
            (begin
              (format (current-error-port)
                      "warning: device '~a' not found~%" device)
              #f)
            (apply throw args))))))
        (let ((errno (system-error-errno args)))
          (cond ((= ENOENT errno)
                 (format (current-error-port)
                         "warning: device '~a' not found~%" device)
                 #f)
                ((= ENOMEDIUM errno)              ;for removable media
                 #f)
                (else
                 (apply throw args))))))))

(define (partition-predicate read field =)
  "Return a predicate that returns true if the FIELD of partition header that

M gnu/packages/bioinformatics.scm => gnu/packages/bioinformatics.scm +33 -0
@@ 7394,6 7394,39 @@ library implementing most of the pipeline's features.")
@dfn{RNA-centric annotation system} (RCAS).")
    (license license:agpl3+)))

(define-public r-mutationalpatterns
  (package
    (name "r-mutationalpatterns")
    (version "1.0.0")
    (source
     (origin
       (method url-fetch)
       (uri (bioconductor-uri "MutationalPatterns" version))
       (sha256
        (base32
         "1a3c2bm0xx0q4gf98jiw74msmdf2fr8rbsdysd5ww9kqlzmsbr17"))))
    (build-system r-build-system)
    (propagated-inputs
     `(("r-biocgenerics" ,r-biocgenerics)
       ("r-biostrings" ,r-biostrings)
       ("r-genomicranges" ,r-genomicranges)
       ("r-genomeinfodb" ,r-genomeinfodb)
       ("r-ggplot2" ,r-ggplot2)
       ("r-gridextra" ,r-gridextra)
       ("r-iranges" ,r-iranges)
       ("r-nmf" ,r-nmf)
       ("r-plyr" ,r-plyr)
       ("r-pracma" ,r-pracma)
       ("r-reshape2" ,r-reshape2)
       ("r-summarizedexperiment" ,r-summarizedexperiment)
       ("r-variantannotation" ,r-variantannotation)))
    (home-page "http://bioconductor.org/packages/MutationalPatterns/")
    (synopsis "Extract and visualize mutational patterns in genomic data")
    (description "This package provides an extensive toolset for the
characterization and visualization of a wide range of mutational patterns
in SNV base substitution data.")
    (license license:expat)))

(define-public emboss
  (package
    (name "emboss")

M gnu/packages/dav.scm => gnu/packages/dav.scm +2 -2
@@ 60,13 60,13 @@ clients.")
(define-public vdirsyncer
  (package
    (name "vdirsyncer")
    (version "0.13.1")
    (version "0.14.0")
    (source (origin
             (method url-fetch)
             (uri (pypi-uri name version))
             (sha256
              (base32
               "1c4kipcc7dx1rn5j1a1x7wckz09mm9ihwakf3ramwn1y78q5zanb"))))
               "1mbh2gykx9sqsnyfa962ifxksx4afl2lb9rcsbd6rsh3gj2il898"))))
    (build-system python-build-system)
    (arguments
      `(#:phases (modify-phases %standard-phases

M gnu/packages/gnome.scm => gnu/packages/gnome.scm +4 -3
@@ 3868,7 3868,7 @@ metadata in photo and video files of various formats.")
(define-public shotwell
  (package
    (name "shotwell")
    (version "0.23.5")
    (version "0.25.0")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnome/sources/" name "/"


@@ 3876,7 3876,7 @@ metadata in photo and video files of various formats.")
                                  name "-" version ".tar.xz"))
              (sha256
               (base32
                "0fgs1rgvkmy79bmpxrsvm5w8rvqml4l1vnwma0xqx5zzm02p8a07"))))
                "0f3ly7nxy3kqwgs40avsqkxcz98bfmlhlk30n0d7j7ndk67zz57h"))))
    (build-system glib-or-gtk-build-system)
    (propagated-inputs
     `(("dconf" ,dconf)))


@@ 3899,7 3899,8 @@ metadata in photo and video files of various formats.")
       ("libsoup" ,libsoup)
       ("libxml2" ,libxml2)
       ("libgudev" ,libgudev)
       ("libgphoto2" ,libgphoto2)))
       ("libgphoto2" ,libgphoto2)
       ("gcr" ,gcr)))
    (home-page "https://wiki.gnome.org/Apps/Shotwell")
    (synopsis "Photo manager for GNOME 3")
    (description

M gnu/packages/gnupg.scm => gnu/packages/gnupg.scm +9 -2
@@ 9,6 9,7 @@
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Nils Gillmann <ng0@libertad.pw>
;;; Copyright © 2016 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2016 Mike Gerwitz <mtg@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 43,6 44,7 @@
  #:use-module (gnu packages gnome)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages security-token)
  #:use-module (gnu packages tls)
  #:use-module (guix packages)
  #:use-module (guix download)


@@ 233,6 235,7 @@ compatible to GNU Pth.")
       ("libksba" ,libksba)
       ("npth" ,npth)
       ("openldap" ,openldap)
       ("pcsc-lite" ,pcsc-lite)
       ("readline" ,readline)
       ("sqlite" ,sqlite)
       ("zlib" ,zlib)))


@@ 240,10 243,14 @@ compatible to GNU Pth.")
    `(#:configure-flags '("--enable-gpg2-is-gpg")
      #:phases
      (modify-phases %standard-phases
        (add-before 'configure 'patch-config-files
          (lambda _
        (add-before 'configure 'patch-paths
          (lambda* (#:key inputs #:allow-other-keys)
            (substitute* "tests/openpgp/defs.inc"
              (("/bin/pwd") (which "pwd")))
            (substitute* "scd/scdaemon.c"
              (("\"(libpcsclite\\.so[^\"]*)\"" _ name)
               (string-append "\"" (assoc-ref inputs "pcsc-lite")
                              "/lib/" name "\"")))
            #t))
        (add-after 'build 'patch-scheme-tests
          (lambda _

M gnu/packages/gnustep.scm => gnu/packages/gnustep.scm +4 -1
@@ 76,7 76,10 @@
       ("libxft" ,libxft)
       ("libx11" ,libx11)
       ("fontconfig" ,fontconfig)
       ("libjpeg" ,libjpeg)))
       ("libjpeg" ,libjpeg)
       ("giflib" ,giflib)
       ("libpng" ,libpng)
       ("libtiff" ,libtiff)))
    (native-inputs
     `(("pkg-config" ,pkg-config)))
    (home-page "http://windowmaker.org/")

M gnu/packages/image.scm => gnu/packages/image.scm +2 -2
@@ 770,14 770,14 @@ convert, manipulate, filter and display a wide variety of image formats.")
(define-public jasper
  (package
    (name "jasper")
    (version "1.900.13")
    (version "1.900.16")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://www.ece.uvic.ca/~frodo/jasper"
                                  "/software/jasper-" version ".tar.gz"))
              (sha256
               (base32
                "0nmy5248gar057s94a30fssvq70m3jy4vdrfcispvn01ih33fa19"))))
                "0wgrz6970sf8apyld35vrxamzx46fq15l0ipkvjsjlbwfrhj57rl"))))
    (build-system gnu-build-system)
    (arguments
     '(#:make-flags '("CFLAGS=-std=c99"))) ; 1.900.13 added c++ style comments

M gnu/packages/linux.scm => gnu/packages/linux.scm +31 -2
@@ 2396,6 2396,35 @@ assemble, report on, and monitor arrays.  It can also move spares between raid
arrays when needed.")
    (license license:gpl2+)))

(define-public mdadm-static
  (package
    (inherit mdadm)
    (name "mdadm-static")
    (arguments
     (substitute-keyword-arguments (package-arguments mdadm)
       ((#:make-flags flags)
        `(cons "LDFLAGS = -static" ,flags))
       ((#:phases phases)
        `(modify-phases ,phases
           (add-after 'install 'remove-cruft
             (lambda* (#:key outputs #:allow-other-keys)
               (let* ((out         (assoc-ref outputs "out"))
                      (precious?   (lambda (file)
                                     (member file '("." ".." "sbin"))))
                      (directories (scandir out (negate precious?))))
                 (with-directory-excursion out
                   (for-each delete-file-recursively directories)
                   (remove-store-references "sbin/mdadm")
                   (delete-file "sbin/mdmon")
                   #t))))))
       ((#:modules modules %gnu-build-system-modules)
        `((ice-9 ftw) ,@modules))
       ((#:strip-flags _ '())
        ''("--strip-all"))                        ;strip a few extra KiB
       ((#:allowed-references _ '("out"))
        '("out"))))                               ;refer only self
    (synopsis "Statically-linked 'mdadm' command for use in an initrd")))

(define-public libaio
  (package
    (name "libaio")


@@ 2975,14 3004,14 @@ the default @code{nsswitch} and the experimental @code{umich_ldap}.")
(define-public mcelog
  (package
    (name "mcelog")
    (version "143")
    (version "144")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://git.kernel.org/cgit/utils/cpu/mce/"
                                  "mcelog.git/snapshot/v" version ".tar.gz"))
              (sha256
               (base32
                "1mn5i1d6ybfxqgr6smlpxcx1wb53h0r2rp90ild7919b9yqxpk0x"))
                "03jyhsl0s59sfqykj5p6gkb03k4w1h9ay31yxym1dnzis5sq99pa"))
              (file-name (string-append name "-" version ".tar.gz"))
              (modules '((guix build utils)))
              (snippet

M gnu/packages/python.scm => gnu/packages/python.scm +6 -3
@@ 7773,14 7773,14 @@ concurrent.futures package from Python 3.2")
(define-public python-urllib3
  (package
    (name "python-urllib3")
    (version "1.13.1")
    (version "1.18.1")
    (source
      (origin
        (method url-fetch)
        (uri (pypi-uri "urllib3" version))
        (sha256
         (base32
          "10rrbr6c6k7j5dvfsyj4b2gsgxg9gggnn708qixf6ll57xqivfkf"))))
          "1wb8aqnq53vzh2amrv8kc66f3h6fx217y0q62y6n30a64p2yqmam"))))
    (build-system python-build-system)
    (arguments `(#:tests? #f))
    (native-inputs


@@ 7795,7 7795,7 @@ concurrent.futures package from Python 3.2")
       ("python-ndg-httpsclient" ,python-ndg-httpsclient)
       ("python-pyasn1" ,python-pyasn1)
       ("python-pyopenssl" ,python-pyopenssl)))
    (home-page "http://urllib3.readthedocs.org/")
    (home-page "https://urllib3.readthedocs.org/")
    (synopsis "HTTP library with thread-safe connection pooling")
    (description
     "Urllib3 supports features left out of urllib and urllib2 libraries.  It


@@ 8984,6 8984,9 @@ anymore.")
               (base32
                "0p050msg5c8d0kadv702jnfshaxrb0il765cpkgnhn6mq5hakcyy"))))
    (build-system python-build-system)
    ;; We only need the the Python 2 variant, since for Python 3 our minimum
    ;; version is 3.4 which already includes this package as part of the
    ;; standard library.
    (arguments
     `(#:python ,python-2))
    (native-inputs

M gnu/packages/sdl.scm => gnu/packages/sdl.scm +18 -17
@@ 3,6 3,7 @@
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 47,7 48,7 @@
    (source (origin
             (method url-fetch)
             (uri
              (string-append "http://libsdl.org/release/SDL-"
              (string-append "https://libsdl.org/release/SDL-"
                             version ".tar.gz"))
             (sha256
              (base32


@@ 81,34 82,34 @@
    (description "Simple DirectMedia Layer is a cross-platform development
library designed to provide low level access to audio, keyboard, mouse,
joystick, and graphics hardware.")
    (home-page "http://libsdl.org/")
    (home-page "https://libsdl.org/")
    (license lgpl2.1)))

(define-public sdl2
  (package (inherit sdl)
    (name "sdl2")
    (version "2.0.4")
    (version "2.0.5")
    (source (origin
             (method url-fetch)
             (uri
              (string-append "http://libsdl.org/release/SDL2-"
              (string-append "https://libsdl.org/release/SDL2-"
                             version ".tar.gz"))
             (sha256
              (base32
               "0jqp46mxxbh9lhpx1ih6sp93k752j2smhpc0ad0q4cb3px0famfs"))))
               "11c75qj1qxmx67iwkvf9z4x69phk301pdn86zzr6jncnap7kh824"))))
    (license bsd-3)))

(define-public libmikmod
  (package
    (name "libmikmod")
    (version "3.3.7")
    (version "3.3.10")
    (source (origin
             (method url-fetch)
             (uri (string-append "mirror://sourceforge/mikmod/libmikmod/"
                                 version "/libmikmod-" version ".tar.gz"))
             (sha256
              (base32
               "18nrkf5l50hfg0y50yxr7bvik9f002lhn8c00nbcp6dgm5011x2c"))))
               "0j7g4jpa2zgzw7x6s3rldypa7zlwjvn97rwx0sylx1iihhlzbcq0"))))
    (build-system gnu-build-system)
    (arguments
     ;; By default, libmikmod tries to dlopen libasound etc., which won't work


@@ 154,7 155,7 @@ other supporting functions for SDL.")
    (source (origin
             (method url-fetch)
             (uri
              (string-append "http://www.libsdl.org/projects/SDL_image/release/SDL_image-"
              (string-append "https://www.libsdl.org/projects/SDL_image/release/SDL_image-"
                             version ".tar.gz"))
             (sha256
              (base32


@@ 180,7 181,7 @@ other supporting functions for SDL.")
    (description "SDL_image is an image file loading library for SDL that
supports the following formats: BMP, GIF, JPEG, LBM, PCX, PNG, PNM, TGA, TIFF,
WEBP, XCF, XPM, and XV.")
    (home-page "http://www.libsdl.org/projects/SDL_image/")
    (home-page "https://www.libsdl.org/projects/SDL_image/")
    (license zlib)))

(define-public sdl-mixer


@@ 190,7 191,7 @@ WEBP, XCF, XPM, and XV.")
    (source (origin
              (method url-fetch)
              (uri
               (string-append "http://www.libsdl.org/projects/SDL_mixer/release/SDL_mixer-"
               (string-append "https://www.libsdl.org/projects/SDL_mixer/release/SDL_mixer-"
                              version ".tar.gz"))
              (sha256
               (base32


@@ 218,7 219,7 @@ WEBP, XCF, XPM, and XV.")
It supports any number of simultaneously playing channels of 16 bit stereo
audio, plus a single channel of music.  Supported format include FLAC, MOD,
MIDI, Ogg Vorbis, and MP3.")
    (home-page "http://www.libsdl.org/projects/SDL_mixer/")
    (home-page "https://www.libsdl.org/projects/SDL_mixer/")
    (license zlib)))

(define-public sdl-net


@@ 228,7 229,7 @@ MIDI, Ogg Vorbis, and MP3.")
    (source (origin
              (method url-fetch)
              (uri
               (string-append "http://www.libsdl.org/projects/SDL_net/release/SDL_net-"
               (string-append "https://www.libsdl.org/projects/SDL_net/release/SDL_net-"
                              version ".tar.gz"))
              (sha256
               (base32


@@ 239,7 240,7 @@ MIDI, Ogg Vorbis, and MP3.")
    (synopsis "SDL networking library")
    (description "SDL_net is a small, cross-platform networking library for
SDL.")
    (home-page "http://www.libsdl.org/projects/SDL_net/")
    (home-page "https://www.libsdl.org/projects/SDL_net/")
    (license zlib)))

(define-public sdl-ttf


@@ 249,7 250,7 @@ SDL.")
    (source (origin
             (method url-fetch)
             (uri
              (string-append "http://www.libsdl.org/projects/SDL_ttf/release/SDL_ttf-"
              (string-append "https://www.libsdl.org/projects/SDL_ttf/release/SDL_ttf-"
                             version ".tar.gz"))
             (sha256
              (base32


@@ 261,7 262,7 @@ SDL.")
    (native-inputs `(("pkg-config" ,pkg-config)))
    (synopsis "SDL TrueType font library")
    (description "SDL_ttf is a TrueType font rendering library for SDL.")
    (home-page "http://www.libsdl.org/projects/SDL_ttf/")
    (home-page "https://www.libsdl.org/projects/SDL_ttf/")
    (license zlib)))

(define* (sdl-union #:optional (packages (list sdl sdl-gfx sdl-net sdl-ttf


@@ 308,7 309,7 @@ directory.")
    (source (origin
              (method url-fetch)
              (uri
               (string-append "http://www.libsdl.org/projects/SDL_image/release/SDL2_image-"
               (string-append "https://www.libsdl.org/projects/SDL_image/release/SDL2_image-"
                              version ".tar.gz"))
              (sha256
               (base32


@@ 342,7 343,7 @@ directory.")
    (source (origin
             (method url-fetch)
             (uri
              (string-append "http://www.libsdl.org/projects/SDL_ttf/release/SDL2_ttf-"
              (string-append "https://www.libsdl.org/projects/SDL_ttf/release/SDL2_ttf-"
                             version ".tar.gz"))
             (modules '((guix build utils)))
             (snippet

M gnu/packages/security-token.scm => gnu/packages/security-token.scm +36 -2
@@ 1,6 1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Mike Gerwitz <mtg@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 23,9 24,11 @@
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages curl)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages man)
  #:use-module (gnu packages curl))
  #:use-module (gnu packages perl)
  #:use-module (gnu packages pkg-config))

(define-public libyubikey
  (package


@@ 47,6 50,37 @@ the low-level development kit for the Yubico YubiKey authentication device.")
    (home-page "https://developers.yubico.com/yubico-c/")
    (license license:bsd-2)))

(define-public pcsc-lite
  (package
    (name "pcsc-lite")
    (version "1.8.18")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "https://alioth.debian.org/frs/download.php/file/4179/"
                    "pcsc-lite-" version ".tar.bz2"))
              (sha256
               (base32
                "0189s10xsgcmdvc2sixakncwlv47cg6by6m9vdm038gn32q34bdj"))))
    (build-system gnu-build-system)
    (arguments
     `(#:configure-flags '("--enable-usbdropdir=/var/lib/pcsc/drivers")))
    (native-inputs
     `(("perl" ,perl)                   ; for pod2man
       ("pkg-config" ,pkg-config)))
    (inputs
     `(("libudev" ,eudev)))
    (home-page "https://pcsclite.alioth.debian.org/pcsclite.html")
    (synopsis "Middleware to access a smart card using PC/SC")
    (description
     "pcsc-lite provides an interface to communicate with smartcards and
readers using the SCard API.  pcsc-lite is used to connect to the PC/SC daemon
from a client application and provide access to the desired reader.")
    (license (list license:bsd-3                ; pcsc-lite
                   license:expat                ; src/sd-daemon.[ch]
                   license:isc                  ; src/strlcat.c src/strlcpy.c
                   license:gpl3+))))            ; src/spy/*

(define-public ykclient
  (package
    (name "ykclient")

M gnu/packages/statistics.scm => gnu/packages/statistics.scm +8 -0
@@ 118,6 118,13 @@ be output in text, PostScript, PDF or HTML.")
                            "/lib/R/lib"))
       #:phases
       (modify-phases %standard-phases
         (add-before 'configure 'patch-uname
           (lambda* (#:key inputs #:allow-other-keys)
             (let ((uname-bin (string-append (assoc-ref inputs "coreutils")
                                             "/bin/uname")))
               (substitute* "src/scripts/R.sh.in"
                 (("uname") uname-bin)))
             #t))
         (add-before
          'configure 'set-default-pager
          ;; Set default pager to "cat", because otherwise it is "false",


@@ 170,6 177,7 @@ be output in text, PostScript, PDF or HTML.")
     `(;; We need not only cairo here, but pango to ensure that tests for the
       ;; "cairo" bitmapType plotting backend succeed.
       ("pango" ,pango)
       ("coreutils" ,coreutils)
       ("curl" ,curl)
       ("tzdata" ,tzdata)
       ("openblas" ,openblas)

M gnu/packages/textutils.scm => gnu/packages/textutils.scm +86 -0
@@ 6,6 6,7 @@
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 32,7 33,12 @@
  #:use-module (guix build-system trivial)
  #:use-module (gnu packages)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages python)
  #:use-module (gnu packages readline)
  #:use-module (gnu packages slang)
  #:use-module (gnu packages zip))

(define-public recode


@@ 373,3 379,83 @@ runs Word\".")
    (description "UTF8-CPP is a C++ library for handling UTF-8 encoded text
in a portable way.")
    (license license:boost1.0)))

(define-public dbacl
  (package
    (name "dbacl")
    (version "1.14")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "http://www.lbreyer.com/gpl/"
                           name "-" version ".tar.gz"))
       (sha256
        (base32
         "0224g6x71hyvy7jikfxmgcwww1r5lvk0jx36cva319cb9nmrbrq7"))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags
       (list
        (string-append "-I" (assoc-ref %build-inputs "slang")
                       "/include/slang")
        (string-append "-I" (assoc-ref %build-inputs "ncurses")
                       "/include/ncurses"))
       #:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'delete-sample6-and-japanese
           (lambda _
             (substitute* "doc/Makefile.am"
               (("sample6.txt") "")
               (("japanese.txt") ""))
             (delete-file "doc/sample6.txt")
             (delete-file "doc/japanese.txt")
             (substitute* (list "src/tests/Makefile.am"
                                "src/tests/Makefile.in")
               (("dbacl-jap.shin") "")
               (("dbacl-jap.sh") ""))
             #t))
         (add-after 'unpack 'delete-test
           ;; See comments about the license.
           (lambda _
             (delete-file "src/tests/dbacl-jap.shin")))
         (add-after 'delete-sample6-and-japanese 'autoreconf
           (lambda _
             (zero? (system* "autoreconf" "-vif"))))
         (add-after 'unpack 'fix-test-files
           (lambda* (#:key inputs outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (bin (string-append out "/bin")))
               (substitute* (find-files "src/tests/" "\\.shin$")
                 (("PATH=/bin:/usr/bin")
                  "#PATH=/bin:/usr/bin")
                 (("diff") (string-append (which "diff")))
                 (("tr") (string-append (which "tr"))))
               #t))))))
    (inputs
     `(("ncurses" ,ncurses)
       ("perl" ,perl)
       ("readline" ,readline)
       ("slang" ,slang)))
    (native-inputs
     `(("libtool" ,libtool)
       ("autoconf" ,autoconf)
       ("automake" ,automake)
       ("pkg-config" ,pkg-config)))
    (home-page "http://www.lbreyer.com/dbacl.html")
    (synopsis "Bayesian text and email classifier")
    (description
     "dbacl is a fast Bayesian text and email classifier.  It builds a variety
of language models using maximum entropy (minimum divergence) principles, and
these can then be used to categorize input data automatically among multiple
categories.")
    ;; The software is licensed as GPLv3 or later, but
    ;; includes various sample texts in the doc dir:
    ;; - sample1.txt, sample3 and sampe5.txt are in the public domain,
    ;;   by Mark Twain.
    ;; - sample2.txt, sample4.txt are in the public domain, by Aristotle.
    ;; - sample6.txt is a forwarded email, copyright unknown.
    ;;   Guix does exclude sample6.txt.
    ;; - japanese.txt is a Japanese unoffical translation of the
    ;;   GNU General Public License, (c) by the Free Software Foundation.
    ;;   Guix excludes this file.
    (license (list license:gpl3+ license:public-domain))))

M gnu/packages/valgrind.scm => gnu/packages/valgrind.scm +15 -14
@@ 2,6 2,7 @@
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 30,29 31,29 @@
(define-public valgrind
  (package
    (name "valgrind")
    (version "3.11.0")
    (version "3.12.0")
    (source (origin
             (method url-fetch)
             (uri (string-append "http://valgrind.org/downloads/valgrind-"
                                 version ".tar.bz2"))
             (sha256
              (base32
               "0hiv871b9bk689mv42mkhp76za78l5773glszfkdbpf1m1qn4fbc"))
               "18bnrw9b1d55wi1wnl68n25achsp9w48n51n1xw4fwjjnaal7jk7"))
             (patches (search-patches "valgrind-enable-arm.patch"))))
    (build-system gnu-build-system)
    (arguments
     '(#:phases (alist-cons-after
                 'install 'patch-suppression-files
                 (lambda* (#:key outputs #:allow-other-keys)
                   ;; Don't assume the FHS.
                   (let* ((out (assoc-ref outputs "out"))
                          (dir (string-append out "/lib/valgrind")))
                     (substitute* (find-files dir "\\.supp$")
                       (("obj:/lib") "obj:*/lib")
                       (("obj:/usr/X11R6/lib") "obj:*/lib")
                       (("obj:/usr/lib") "obj:*/lib"))
                     #t))
                 %standard-phases)))
     '(#:phases
       (modify-phases %standard-phases
         (add-after 'install 'patch-suppression-files
           (lambda* (#:key outputs #:allow-other-keys)
             ;; Don't assume the FHS.
             (let* ((out (assoc-ref outputs "out"))
                    (dir (string-append out "/lib/valgrind")))
               (substitute* (find-files dir "\\.supp$")
                 (("obj:/lib") "obj:*/lib")
                 (("obj:/usr/X11R6/lib") "obj:*/lib")
                 (("obj:/usr/lib") "obj:*/lib"))
               #t))))))
    (inputs `(;; GDB is needed to provide a sane default for `--db-command'.
              ("gdb" ,gdb)))
    (native-inputs `(("perl" ,perl)))

M gnu/system/mapped-devices.scm => gnu/system/mapped-devices.scm +5 -3
@@ 24,7 24,7 @@
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:autoload   (gnu packages cryptsetup) (cryptsetup)
  #:autoload   (gnu packages linux) (mdadm)
  #:autoload   (gnu packages linux) (mdadm-static)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match)
  #:export (mapped-device


@@ 150,12 150,14 @@ TARGET (e.g., \"/dev/md0\"), using 'mdadm'."
          (sleep 1)
          (loop (+ 1 attempts))))

      (zero? (apply system* (string-append #$mdadm "/sbin/mdadm")
      ;; Use 'mdadm-static' rather than 'mdadm' to avoid pulling its whole
      ;; closure (80 MiB) in the initrd when a RAID device is needed for boot.
      (zero? (apply system* #$(file-append mdadm-static "/sbin/mdadm")
                    "--assemble" #$target sources))))

(define (close-raid-device sources target)
  "Return a gexp that stops the RAID device TARGET."
  #~(zero? (system* (string-append #$mdadm "/sbin/mdadm")
  #~(zero? (system* #$(file-append mdadm-static "/sbin/mdadm")
                    "--stop" #$target)))

(define raid-device-mapping

M gnu/tests/install.scm => gnu/tests/install.scm +169 -3
@@ 33,6 33,8 @@
  #:use-module (guix gexp)
  #:use-module (guix utils)
  #:export (%test-installed-os
            %test-separate-store-os
            %test-raid-root-os
            %test-encrypted-os))

;;; Commentary:


@@ 190,9 192,9 @@ the installed system."

    (gexp->derivation "installation" install)))

(define (qemu-command/writable-image image)
(define* (qemu-command/writable-image image #:key (memory-size 256))
  "Return as a monadic value the command to run QEMU on a writable copy of
IMAGE, a disk image."
IMAGE, a disk image.  The QEMU VM is has access to MEMORY-SIZE MiB of RAM."
  (mlet %store-monad ((system (current-system)))
    (return #~(let ((image #$image))
                ;; First we need a writable copy of the image.


@@ 204,7 206,7 @@ IMAGE, a disk image."
                  ,@(if (file-exists? "/dev/kvm")
                        '("-enable-kvm")
                        '())
                  "-no-reboot" "-m" "256"
                  "-no-reboot" "-m" #$(number->string memory-size)
                  "-drive" "file=disk.img,if=virtio")))))




@@ 222,6 224,170 @@ build (current-guix) and then store a couple of full system images.")
                      "installed-os")))))


;;;
;;; Separate /gnu/store partition.
;;;

(define-os-with-source (%separate-store-os %separate-store-os-source)
  ;; The OS we want to install.
  (use-modules (gnu) (gnu tests) (srfi srfi-1))

  (operating-system
    (host-name "liberigilo")
    (timezone "Europe/Paris")
    (locale "en_US.UTF-8")

    (bootloader (grub-configuration (device "/dev/vdb")))
    (kernel-arguments '("console=ttyS0"))
    (file-systems (cons* (file-system
                           (device "root-fs")
                           (title 'label)
                           (mount-point "/")
                           (type "ext4"))
                         (file-system
                           (device "store-fs")
                           (title 'label)
                           (mount-point "/gnu")
                           (type "ext4")
                           (needed-for-boot? #t)) ;definitely!
                         %base-file-systems))
    (users %base-user-accounts)
    (services (cons (service marionette-service-type
                             (marionette-configuration
                              (imported-modules '((gnu services herd)
                                                  (guix combinators)))))
                    %base-services))))

(define %separate-store-installation-script
  ;; Installation with a separate /gnu partition.
  "\
. /etc/profile
set -e -x
guix --version

export GUIX_BUILD_OPTIONS=--no-grafts
guix build isc-dhcp
parted --script /dev/vdb mklabel gpt \\
  mkpart primary ext2 1M 3M \\
  mkpart primary ext2 3M 100M \\
  mkpart primary ext2 100M 1G \\
  set 1 boot on \\
  set 1 bios_grub on
mkfs.ext4 -L root-fs /dev/vdb2
mkfs.ext4 -L store-fs /dev/vdb3
mount /dev/vdb2 /mnt
mkdir /mnt/gnu
mount /dev/vdb3 /mnt/gnu
df -h /mnt
herd start cow-store /mnt
mkdir /mnt/etc
cp /etc/target-config.scm /mnt/etc/config.scm
guix system init /mnt/etc/config.scm /mnt --no-substitutes
sync
reboot\n")

(define %test-separate-store-os
  (system-test
   (name "separate-store-os")
   (description
    "Test basic functionality of an OS installed like one would do by hand,
where /gnu lives on a separate partition.")
   (value
    (mlet* %store-monad ((image   (run-install %separate-store-os
                                               %separate-store-os-source
                                               #:script
                                               %separate-store-installation-script))
                         (command (qemu-command/writable-image image)))
      (run-basic-test %separate-store-os command "separate-store-os")))))


;;;
;;; RAID root device.
;;;

(define-os-with-source (%raid-root-os %raid-root-os-source)
  ;; An OS whose root partition is a RAID partition.
  (use-modules (gnu) (gnu tests))

  (operating-system
    (host-name "raidified")
    (timezone "Europe/Paris")
    (locale "en_US.utf8")

    (bootloader (grub-configuration (device "/dev/vdb")))
    (kernel-arguments '("console=ttyS0"))
    (initrd (lambda (file-systems . rest)
              ;; Add a kernel module for RAID-0 (aka. "stripe").
              (apply base-initrd file-systems
                     #:extra-modules '("raid0")
                     rest)))
    (mapped-devices (list (mapped-device
                           (source (list "/dev/vda2" "/dev/vda3"))
                           (target "/dev/md0")
                           (type raid-device-mapping))))
    (file-systems (cons (file-system
                          (device "root-fs")
                          (title 'label)
                          (mount-point "/")
                          (type "ext4")
                          (dependencies mapped-devices))
                        %base-file-systems))
    (users %base-user-accounts)
    (services (cons (service marionette-service-type
                             (marionette-configuration
                              (imported-modules '((gnu services herd)
                                                  (guix combinators)))))
                    %base-services))))

(define %raid-root-installation-script
  ;; Installation with a separate /gnu partition.  See
  ;; <https://raid.wiki.kernel.org/index.php/RAID_setup> for more on RAID and
  ;; mdadm.
  "\
. /etc/profile
set -e -x
guix --version

export GUIX_BUILD_OPTIONS=--no-grafts
parted --script /dev/vdb mklabel gpt \\
  mkpart primary ext2 1M 3M \\
  mkpart primary ext2 3M 600M \\
  mkpart primary ext2 600M 1200M \\
  set 1 boot on \\
  set 1 bios_grub on
mdadm --create /dev/md0 --verbose --level=stripe --raid-devices=2 \\
  /dev/vdb2 /dev/vdb3
mkfs.ext4 -L root-fs /dev/md0
mount /dev/md0 /mnt
df -h /mnt
herd start cow-store /mnt
mkdir /mnt/etc
cp /etc/target-config.scm /mnt/etc/config.scm
guix system init /mnt/etc/config.scm /mnt --no-substitutes
sync
reboot\n")

(define %test-raid-root-os
  (system-test
   (name "raid-root-os")
   (description
    "Test functionality of an OS installed with a RAID root partition managed
by 'mdadm'.")
   (value
    (mlet* %store-monad ((image   (run-install %raid-root-os
                                               %raid-root-os-source
                                               #:script
                                               %raid-root-installation-script
                                               #:target-size (* 1300 MiB)))
                         (command (qemu-command/writable-image image)))
      (run-basic-test %raid-root-os
                      `(,@command) "raid-root-os")))))


;;;
;;; LUKS-encrypted root file system.
;;;

(define-os-with-source (%encrypted-root-os %encrypted-root-os-source)
  ;; The OS we want to install.
  (use-modules (gnu) (gnu tests) (srfi srfi-1))

M tests/pypi.scm => tests/pypi.scm +2 -2
@@ 122,7 122,7 @@ baz > 13.37")
                     ('base32
                      (? string? hash)))))
         ('build-system 'python-build-system)
         ('inputs
         ('propagated-inputs
          ('quasiquote
           (("python-bar" ('unquote 'python-bar))
            ("python-baz" ('unquote 'python-baz))


@@ 182,7 182,7 @@ baz > 13.37")
                     ('base32
                      (? string? hash)))))
         ('build-system 'python-build-system)
         ('inputs
         ('propagated-inputs
          ('quasiquote
           (("python-bar" ('unquote 'python-bar))
            ("python-baz" ('unquote 'python-baz))

M tests/syscalls.scm => tests/syscalls.scm +4 -1
@@ 146,7 146,10 @@
             (waitpid fork-pid)
             result))))))))

(unless perform-container-tests?
;; XXX: Skip this test when running Linux > 4.7.5 to work around
;; <https://bugzilla.kernel.org/show_bug.cgi?id=183461>.
(when (or (not perform-container-tests?)
          (version>? (utsname:release (uname)) "4.7.5"))
  (test-skip 1))
(test-equal "pivot-root"
  #t