Merge branch 'master' into staging
authorMarius Bakke <mbakke@fastmail.com>
Sun, 24 Sep 2017 17:18:35 +0000 (19:18 +0200)
committerMarius Bakke <mbakke@fastmail.com>
Sun, 24 Sep 2017 17:18:35 +0000 (19:18 +0200)
41 files changed:
doc/guix.texi
gnu/build/vm.scm
gnu/local.mk
gnu/packages/audio.scm
gnu/packages/avr.scm
gnu/packages/bioinformatics.scm
gnu/packages/crypto.scm
gnu/packages/disk.scm
gnu/packages/emacs.scm
gnu/packages/fabric-management.scm [new file with mode: 0644]
gnu/packages/finance.scm
gnu/packages/freedesktop.scm
gnu/packages/game-development.scm
gnu/packages/games.scm
gnu/packages/gnome.scm
gnu/packages/gnunet.scm
gnu/packages/haskell.scm
gnu/packages/ibus.scm
gnu/packages/imagemagick.scm
gnu/packages/irc.scm
gnu/packages/linux.scm
gnu/packages/machine-learning.scm
gnu/packages/music.scm
gnu/packages/package-management.scm
gnu/packages/parallel.scm
gnu/packages/photo.scm
gnu/packages/python.scm
gnu/packages/statistics.scm
gnu/packages/video.scm
gnu/packages/vim.scm
gnu/packages/xorg.scm
gnu/services.scm
gnu/services/base.scm
gnu/services/networking.scm
gnu/services/rsync.scm [new file with mode: 0644]
gnu/system.scm
gnu/system/pam.scm
gnu/system/uuid.scm
gnu/tests/rsync.scm [new file with mode: 0644]
guix/licenses.scm
tests/uuid.scm

index 601cf51..0462a64 100644 (file)
@@ -10125,6 +10125,11 @@ then update @code{resolv.conf} to point to the local nameserver.
 NetworkManager will not modify @code{resolv.conf}.
 @end table
 
+@item @code{vpn-plugins} (default: @code{'()})
+This is the list of available plugins for virtual private networks
+(VPNs).  An example of this is the @code{network-manager-openvpn}
+package, which allows NetworkManager to manage VPNs @i{via} OpenVPN.
+
 @end table
 @end deftp
 
@@ -10330,6 +10335,75 @@ In addition, @var{extra-settings} specifies a string to append to the
 configuration file.
 @end deffn
 
+The @code{(gnu services rsync)} module provides the following services:
+
+You might want an rsync daemon if you have files that you want available
+so anyone (or just yourself) can download existing files or upload new
+files.
+
+@deffn {Scheme Variable} rsync-service-type
+This is the type for the @uref{https://rsync.samba.org, rsync} rsync daemon,
+@command{rsync-configuration} record as in this example:
+
+@example
+(service rsync-service-type)
+@end example
+
+See below for details about @code{rsync-configuration}.
+@end deffn
+
+@deftp {Data Type} rsync-configuration
+Data type representing the configuration for @code{rsync-service}.
+
+@table @asis
+@item @code{package} (default: @var{rsync})
+@code{rsync} package to use.
+
+@item @code{port-number} (default: @code{873})
+TCP port on which @command{rsync} listens for incoming connections.  If port
+is less than @code{1024} @command{rsync} needs to be started as the
+@code{root} user and group.
+
+@item @code{pid-file} (default: @code{"/var/run/rsyncd/rsyncd.pid"})
+Name of the file where @command{rsync} writes its PID.
+
+@item @code{lock-file} (default: @code{"/var/run/rsyncd/rsyncd.lock"})
+Name of the file where @command{rsync} writes its lock file.
+
+@item @code{log-file} (default: @code{"/var/log/rsyncd.log"})
+Name of the file where @command{rsync} writes its log file.
+
+@item @code{use-chroot?} (default: @var{#t})
+Whether to use chroot for @command{rsync} shared directory.
+
+@item @code{share-path} (default: @file{/srv/rsync})
+Location of the @command{rsync} shared directory.
+
+@item @code{share-comment} (default: @code{"Rsync share"})
+Comment of the @command{rsync} shared directory.
+
+@item @code{read-only?} (default: @var{#f})
+Read-write permissions to shared directory.
+
+@item @code{timeout} (default: @code{300})
+I/O timeout in seconds.
+
+@item @code{user} (default: @var{"root"})
+Owner of the @code{rsync} process.
+
+@item @code{group} (default: @var{"root"})
+Group of the @code{rsync} process.
+
+@item @code{uid} (default: @var{"rsyncd"})
+User name or user ID that file transfers to and from that module should take
+place as when the daemon was run as @code{root}.
+
+@item @code{gid} (default: @var{"rsyncd"})
+Group name or group ID that will be used when accessing the module.
+
+@end table
+@end deftp
+
 Furthermore, @code{(gnu services ssh)} provides the following services.
 @cindex SSH
 @cindex SSH server
index 6da4fa6..7537f81 100644 (file)
@@ -406,19 +406,6 @@ GRUB configuration and OS-DRV as the stuff in it."
                             ;; filesystem, so create it.
                             "mnt=/tmp/root/mnt"
                             "--"
-                            ;; Store two copies of the headers.
-                            ;; The resulting ISO-9660 image has a DOS MBR and
-                            ;; one protective partition (with type 0xCD).
-                            ;; Because GuixSD only uses actual partitions
-                            ;; rather than what /proc/partitions returns, work
-                            ;; around it by storing the primary volume
-                            ;; descriptor twice, once where it should be and
-                            ;; once in the partition.
-                            ;; Allegedly, otherwise, many other GNU tools
-                            ;; (automounters etc) would also be confused by
-                            ;; the extra partition so it makes sense to
-                            ;; store two copies in any case.
-                            "-boot_image" "any" "partition_offset=16"
                             "-volid" ,(string-upcase volume-id)
                             ,@(if volume-uuid
                                   `("-volume_date" "uuid"
index bfa55bf..0991fe5 100644 (file)
@@ -140,6 +140,7 @@ GNU_SYSTEM_MODULES =                                \
   %D%/packages/enlightenment.scm               \
   %D%/packages/entr.scm                                \
   %D%/packages/erlang.scm                      \
+  %D%/packages/fabric-management.scm           \
   %D%/packages/fcitx.scm                       \
   %D%/packages/figlet.scm                      \
   %D%/packages/file.scm                                \
@@ -451,6 +452,7 @@ GNU_SYSTEM_MODULES =                                \
   %D%/services/shepherd.scm                    \
   %D%/services/herd.scm                                \
   %D%/services/pm.scm                          \
+  %D%/services/rsync.scm                       \
   %D%/services/sddm.scm                                \
   %D%/services/spice.scm                               \
   %D%/services/ssh.scm                         \
@@ -497,6 +499,7 @@ GNU_SYSTEM_MODULES =                                \
   %D%/tests/mail.scm                           \
   %D%/tests/messaging.scm                      \
   %D%/tests/networking.scm                     \
+  %D%/tests/rsync.scm                          \
   %D%/tests/ssh.scm                            \
   %D%/tests/virtualization.scm                 \
   %D%/tests/web.scm
index e33f5e3..c295e41 100644 (file)
@@ -1073,7 +1073,7 @@ PS, and DAB+.")
     (native-inputs
      `(("llvm" ,llvm-with-rtti)
        ("which" ,which)
-       ("xxd" ,vim)
+       ("xxd" ,xxd)
        ("ctags" ,emacs-minimal)  ; for ctags
        ("pkg-config" ,pkg-config)))
     (inputs
index aaa0428..ecb7cd1 100644 (file)
@@ -157,7 +157,7 @@ C++.")
        (list (string-append "PREFIX=" (assoc-ref %outputs "out")))))
     (native-inputs
      `(("unzip" ,unzip)
-       ("vim" ,vim))) ; for xxd
+       ("xxd" ,xxd)))
     (home-page "http://microscheme.org/")
     (synopsis "Scheme subset for Atmel microcontrollers")
     (description
index d94b297..95632e2 100644 (file)
@@ -4064,7 +4064,7 @@ predicts the locations of structural units in the sequences.")
 (define-public proteinortho
   (package
     (name "proteinortho")
-    (version "5.16")
+    (version "5.16b")
     (source
      (origin
       (method url-fetch)
@@ -4074,7 +4074,7 @@ predicts the locations of structural units in the sequences.")
         version "_src.tar.gz"))
       (sha256
        (base32
-        "0z4f5cg0cs8ai62hfvp4q6w66q2phcc55nhs4xj5cyhxxivjv2ai"))))
+        "1wl0dawpssqwfjvr651r4wlww8hhjin8nba6xh71ks7sbypx886j"))))
     (build-system gnu-build-system)
     (arguments
      `(#:test-target "test"
@@ -5407,7 +5407,7 @@ application of SortMeRNA is filtering rRNA from metatranscriptomic data.")
              #t))
          (delete 'configure))))
     (native-inputs
-     `(("vim" ,vim))) ; for xxd
+     `(("xxd" ,xxd)))
     (inputs
      `(("htslib" ,htslib)
        ("zlib" ,zlib)))
index 6b28030..9c657cd 100644 (file)
 (define-public libsodium
   (package
     (name "libsodium")
-    (version "1.0.13")
+    (version "1.0.14")
     (source (origin
             (method url-fetch)
             (uri (list (string-append
-                        "http://download.libsodium.org/libsodium/"
+                        "https://download.libsodium.org/libsodium/"
                         "releases/libsodium-" version ".tar.gz")
                        (string-append
                         "https://download.libsodium.org/libsodium/"
                         "releases/old/libsodium-" version ".tar.gz")))
             (sha256
              (base32
-              "1z93wfg4k5svg8yck6cgdr6ysj91kbpn03nyzwxanncy3b5sq4ww"))))
+              "1rvylybhxyn6ap3hrcingsl737zrqg12l7r91ns93j7xjz889z1w"))))
     (build-system gnu-build-system)
     (synopsis "Portable NaCl-based crypto library")
     (description
      "Sodium is a new easy-to-use high-speed software library for network
 communication, encryption, decryption, signatures, etc.")
     (license license:isc)
-    (home-page "http://libsodium.org")))
+    (home-page "https://libsodium.org")))
 
 (define-public libmd
   (package
index 463dd3e..d19f8e8 100644 (file)
@@ -216,7 +216,7 @@ to recover data more efficiently by only reading the necessary blocks.")
      `(#:make-flags (list (string-append "PREFIX=" %output)
                           "CC=gcc")))
     (native-inputs
-     `(("xxd" ,vim))) ; for tests
+     `(("xxd" ,xxd))) ; for tests
     (home-page "https://github.com/dosfstools/dosfstools")
     (synopsis "Utilities for making and checking MS-DOS FAT file systems")
     (description
index e203cfc..1c55c8b 100644 (file)
@@ -1504,6 +1504,25 @@ work with Emacs 24 and 25.")
 a command.")
     (license license:gpl3+)))
 
+(define-public emacs-olivetti
+  (package
+    (name "emacs-olivetti")
+    (version "1.5.7")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "https://stable.melpa.org/packages/olivetti-"
+                    version ".el"))
+              (sha256
+               (base32
+                "1yj2ylg46q0pw1xzlv2b0fv9x8p56x25284s9v2smwjr4vf0nwcj"))))
+    (build-system emacs-build-system)
+    (home-page "https://github.com/rnkn/olivetti")
+    (synopsis "Emacs minor mode for a nice writing environment")
+    (description "This package provides an Emacs minor mode that puts writing
+in the center.")
+    (license license:gpl3+)))
+
 (define-public emacs-undo-tree
   (package
     (name "emacs-undo-tree")
diff --git a/gnu/packages/fabric-management.scm b/gnu/packages/fabric-management.scm
new file mode 100644 (file)
index 0000000..76ef9ee
--- /dev/null
@@ -0,0 +1,173 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Dave Love <fx@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages fabric-management)
+  #:use-module (guix packages)
+  #:use-module (guix licenses)
+  #:use-module (guix download)
+  #:use-module (guix utils)
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages autotools)
+  #:use-module (gnu packages bison)
+  #:use-module (gnu packages flex)
+  #:use-module (gnu packages glib)
+  #:use-module (gnu packages graphviz)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages perl)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages swig)
+  #:use-module (gnu packages tcl))
+
+;; Fixme: Done for the library, but needs support for running the daemon
+;;        (shepherd definition).
+;;        We should probably have a lib output, but that currently generates
+;;        a cycle.
+(define-public opensm
+  (package
+    (name "opensm")
+    (version "3.3.20")
+    (source
+     (origin
+       (method url-fetch)
+       (uri
+        (string-append "https://www.openfabrics.org/downloads/management/opensm-"
+                       version ".tar.gz"))
+       (sha256 (base32 "162sg1w7kgy8ayl8a4dcbrfacmnfy2lr9a2yjyq0k65rmd378zg1"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("flex" ,flex)
+       ("bison" ,bison)))
+    (inputs
+     `(("rdma-core" ,rdma-core)))
+    (arguments
+     `(#:configure-flags '("--disable-static")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'install 'doc
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let* ((base (assoc-ref outputs "out"))
+                    (doc  (string-append base "/share/doc/"
+                                         ,name "-" ,version)))
+               (for-each (lambda (file)
+                           (install-file file doc))
+                         (append (list "AUTHORS" "COPYING" "ChangeLog")
+                                 (find-files "doc")))
+               #t))))))
+    (home-page "https://www.openfabrics.org/")
+    (synopsis "OpenIB InfiniBand Subnet Manager and management utilities")
+    (description "\
+OpenSM is the OpenIB project's Subnet Manager for Infiniband networks.
+The subnet manager is run as a system daemon on one of the machines in
+the infiniband fabric to manage the fabric's routing state.  This package
+also contains various tools for diagnosing and testing Infiniband networks
+that can be used from any machine and do not need to be run on a machine
+running the opensm daemon.")
+    (license (list gpl2 bsd-2))))
+
+(define-public infiniband-diags
+  (package
+    (name "infiniband-diags")
+    (version "2.0.0")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "https://github.com/linux-rdma/infiniband-diags/archive/"
+                           version ".tar.gz"))
+       (file-name (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32 "1ns9sjwvxnklhi47d6k5x8kxdk1n7f5362y45xwxqmr7gwfvpmwa"))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("rdma-core" ,rdma-core)
+       ("opensm" ,opensm)
+       ("glib" ,glib)))
+    (outputs '("out" "lib"))
+    (native-inputs
+     ;; FIXME: needs rst2man for man pages
+     `(("autoconf" ,autoconf)
+       ("automake" ,automake)
+       ("libtool" ,libtool)
+       ("perl" ,perl)
+       ("pkg-config" ,pkg-config)))
+    (arguments
+     '(#:configure-flags
+       (list (string-append "CPPFLAGS=-I" (assoc-ref %build-inputs "opensm")
+                            "/include/infiniband")
+             (string-append "--with-perl-installdir=" (assoc-ref %outputs "lib")
+                            "/lib/perl5/vendor_perl")
+             "--disable-static")
+       #:phases
+       (modify-phases %standard-phases
+         (add-before 'configure 'autotools
+           (lambda _
+             (zero? (system "./autogen.sh"))))
+         (add-after 'install 'licence
+           (lambda _
+             (let ((doc (string-append (assoc-ref %outputs "lib") "/share/doc")))
+               (mkdir-p doc)
+               (install-file "COPYING" doc))))
+         (add-after 'install-file 'move-perl
+           ;; Avoid perl in lib closure
+           (lambda _
+             (let ((perlout (string-append (assoc-ref %outputs "out") "/lib"))
+                   (perlin (string-append (assoc-ref %outputs "lib")
+                                          "/lib/perl5")))
+               (mkdir-p perlout)
+               (rename-file perlin perlout)
+               #t))))))
+    (home-page "https://github.com/linux-rdma/infiniband-diags")
+    (synopsis "Infiniband diagnotic tools")
+    (description "This is a set of command-line utilities to help configure,
+debug, and maintain Infiniband (IB) fabrics.
+
+In addition to the utilities, a sub-library, @file{libibnetdisc}, is provided
+to scan an entire IB fabric and return data structures representing it.  The
+interface to this library is not guaranteed to be stable.")
+    (license (list gpl2 bsd-2)))) ; dual
+
+(define-public ibutils
+  (package
+    (name "ibutils")
+    (version "1.5.7-0.2.gbd7e502")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "https://www.openfabrics.org/downloads/ibutils/ibutils-"
+                           version ".tar.gz"))
+       (sha256
+        (base32 "00x7v6cf8l5y6g9xwh1sg738ch42fhv19msx0h0090nhr0bv98v7"))))
+    (build-system gnu-build-system)
+    (inputs `(("graphviz" ,graphviz)
+              ("tcl" ,tcl)
+              ("tk" ,tk)
+              ("infiniband-diags" ,infiniband-diags)
+              ("rdma-core" ,rdma-core)
+              ("opensm" ,opensm)
+              ("perl" ,perl)))
+    (native-inputs `(("swig" ,swig)))
+    (arguments
+     `(#:configure-flags
+       (list (string-append "--with-osm="  (assoc-ref %build-inputs "opensm"))
+             (string-append "--with-tk-lib=" (assoc-ref %build-inputs "tk") "/lib")
+             "--disable-static")))
+    (synopsis "InfiniBand network utilities")
+    (description "These command-line utilities allow for diagnosing and
+testing InfiniBand networks.")
+    (home-page "https://www.openfabrics.org/downloads/ibutils/")
+    (license bsd-2)))
index 06b8f1c..9e346a6 100644 (file)
@@ -57,7 +57,7 @@
 (define-public bitcoin-core
   (package
     (name "bitcoin-core")
-    (version "0.14.2")
+    (version "0.15.0.1")
     (source (origin
              (method url-fetch)
              (uri
                              version "/bitcoin-" version ".tar.gz"))
              (sha256
               (base32
-               "1jp8vdc25gs46gj1d9mraqa1xnampffpa7mdy0fw80xca77fbi0s"))))
+               "16si3skhm6jhw1pkniv2b9y1kkdhjmhj392palphir0qc1srwzmm"))))
     (build-system gnu-build-system)
     (native-inputs
      `(("pkg-config" ,pkg-config)
        ("python" ,python) ; for the tests
-       ("util-linux" ,util-linux))) ; provides the hexdump command for tests
+       ("util-linux" ,util-linux)   ; provides the hexdump command for tests
+       ("qttools" ,qttools)))
     (inputs
      `(("bdb" ,bdb-5.3) ; with 6.2.23, there is an error: ambiguous overload
        ("boost" ,boost)
@@ -78,8 +79,7 @@
        ("miniupnpc" ,miniupnpc)
        ("openssl" ,openssl)
        ("protobuf" ,protobuf)
-       ;; TODO Build with the modular Qt.
-       ("qt" ,qt)))
+       ("qtbase" ,qtbase)))
     (arguments
      `(#:configure-flags
         (list
           "--with-incompatible-bdb"
           ;; Boost is not found unless specified manually.
           (string-append "--with-boost="
-                         (assoc-ref %build-inputs "boost")))
+                         (assoc-ref %build-inputs "boost"))
+          ;; XXX: The configure script looks up Qt paths by
+          ;; `pkg-config --variable=host_bins Qt5Core`, which fails to pick
+          ;; up executables residing in 'qttools', so we specify them here.
+          (string-append "ac_cv_path_LRELEASE="
+                         (assoc-ref %build-inputs "qttools")
+                         "/bin/lrelease")
+          (string-append "ac_cv_path_LUPDATE="
+                         (assoc-ref %build-inputs "qttools")
+                         "/bin/lupdate"))
        #:phases
         (modify-phases %standard-phases
           (add-before 'check 'set-home
index b9a2b4e..950961e 100644 (file)
@@ -3,7 +3,7 @@
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2015, 2017 Andy Wingo <wingo@pobox.com>
 ;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2015 David Hashe <david.hashe@dhashe.com>
 ;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2016 Kei Kebreau <kkebreau@posteo.net>
@@ -366,7 +366,10 @@ manager for the current system.")
              (substitute* "test/test-icon.py"
                (("/usr/share/icons/hicolor/index.theme")
                 (string-append (assoc-ref inputs "hicolor-icon-theme")
-                               "/share/icons/hicolor/index.theme")))
+                               "/share/icons/hicolor/index.theme"))
+               ;; FIXME: This test fails because the theme contains the unknown
+               ;; key "Scale".
+               (("theme.validate\\(\\)") "#"))
 
              ;; One test fails with:
              ;; AssertionError: 'x-apple-ios-png' != 'png'
index 5633456..9916a1c 100644 (file)
@@ -11,6 +11,7 @@
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
 ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
+;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -192,6 +193,31 @@ necessary.
     ;; The MD5 implementation contained in GRFID is under the zlib license.
     (license (list license:gpl2 license:gpl2+ license:zlib))))
 
+(define-public catcodec
+  (package
+    (name "catcodec")
+    (version "1.0.5")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "https://binaries.openttd.org/extra/catcodec/"
+                           version "/catcodec-" version "-source.tar.xz"))
+       (sha256
+        (base32
+         "1qg0c2i4p29sxj0q6qp2jynlrzm5pphz2xhcjqlxa69ycrnlxzs7"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f ; no tests
+       #:make-flags (list (string-append "prefix=" %output))
+       #:phases (modify-phases %standard-phases
+                  (delete 'configure))))
+    (home-page "http://dev.openttdcoop.org/projects/catcodec")
+    (synopsis "Encode/decode OpenTTD sounds")
+    (description "catcodec encodes and decodes sounds for OpenTTD.  These
+sounds are not much more than some metadata (description and filename) and raw
+PCM data.")
+    (license license:gpl2)))
+
 (define-public gzochi
   (package
     (name "gzochi")
index 7bfd05c..aef6f01 100644 (file)
@@ -2427,17 +2427,19 @@ and a game metadata scraper.")
          ;; The build process fails if the configure script is passed the
          ;; option "--enable-fast-install".
          (replace 'configure
-           (lambda* (#:key inputs outputs #:allow-other-keys)
+           (lambda* (#:key inputs outputs (configure-flags '())
+                     #:allow-other-keys)
              (let ((out (assoc-ref outputs "out"))
                    (lzo (assoc-ref inputs "lzo")))
                (zero?
-                (system* "./configure"
-                         (string-append "--prefix=" out)
-                         ;; Provide the "lzo" path.
-                         (string-append "--with-liblzo2="
-                                        lzo "/lib/liblzo2.a")
-                         ;; Put the binary in 'bin' instead of 'games'.
-                         "--binary-dir=bin"))))))))
+                (apply system* "./configure"
+                       (string-append "--prefix=" out)
+                       ;; Provide the "lzo" path.
+                       (string-append "--with-liblzo2="
+                                      lzo "/lib/liblzo2.a")
+                       ;; Put the binary in 'bin' instead of 'games'.
+                       "--binary-dir=bin"
+                       configure-flags))))))))
     (native-inputs `(("pkg-config" ,pkg-config)))
     (inputs
      `(("allegro" ,allegro-4)
@@ -2464,10 +2466,6 @@ engine.  When you start it you will be prompted to download a graphics set.")
     ;; different terms.
     (license (list license:bsd-3 license:gpl2 license:lgpl2.1+ license:zlib))))
 
-;; TODO Add 'openttd-opengfx' and 'openttd-openmsx' packages and make
-;; 'openttd' a wrapper around them.  The engine is playable by itself,
-;; but it asks a user to download graphics if it's not found.
-
 (define openttd-opengfx
   (package
     (name "openttd-opengfx")
@@ -2485,7 +2483,7 @@ engine.  When you start it you will be prompted to download a graphics set.")
      '(#:make-flags (list "CC=gcc"
                           (string-append "INSTALL_DIR="
                                          (assoc-ref %outputs "out")
-                                         "/share/openttd/baseset"))
+                                         "/share/games/openttd/baseset/opengfx"))
        #:phases
        (modify-phases %standard-phases
          (replace 'configure
@@ -2503,7 +2501,8 @@ engine.  When you start it you will be prompted to download a graphics set.")
        ;; different software versions than upstream does, some of the md5sums
        ;; are different. However, the package is still reproducible, it's safe
        ;; to disable this test.
-       #:tests? #f))
+       #:tests? #f
+       #:parallel-build? #f))
     (native-inputs `(("dos2unix" ,dos2unix)
                      ("gimp" ,gimp)
                      ("grfcodec" ,grfcodec)
@@ -2525,27 +2524,108 @@ OpenGFX provides you with...
 @end enumerate")
     (license license:gpl2)))
 
+(define openttd-opensfx
+  (package
+    (name "openttd-opensfx")
+    (version "0.2.3")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append
+             "https://binaries.openttd.org/extra/opensfx/"
+             version "/opensfx-" version "-source.tar.gz"))
+       (sha256
+        (base32
+         "03jxgp02ks31hmsdh4xh0xcpkb70ds8jakc9pfc1y9vdrdavh4p5"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("catcodec" ,catcodec)
+       ("python" ,python2-minimal)))
+    (arguments
+     `(#:make-flags
+       (list (string-append "INSTALL_DIR=" %output
+                            "/share/games/openttd/baseset/opensfx"))
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'make-reproducible
+           (lambda _
+             ;; Remove the time dependency of the installed tarball by setting
+             ;; the modification times if its members to 0.
+             (substitute* "scripts/Makefile.def"
+               (("-cf") " --mtime=@0 -cf"))
+             #t))
+         (delete 'configure))))
+    (home-page "http://dev.openttdcoop.org/projects/opensfx")
+    (synopsis "Base sounds for OpenTTD")
+    (description "OpenSFX is a set of free base sounds for OpenTTD which make
+it possible to play OpenTTD without requiring the proprietary sound files from
+the original Transport Tycoon Deluxe.")
+    (license license:cc-sampling-plus-1.0)))
+
+(define openttd-openmsx
+  (package
+    (name "openttd-openmsx")
+    (version "0.3.1")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append
+             "https://binaries.openttd.org/extra/openmsx/"
+             version "/openmsx-" version "-source.tar.gz"))
+       (sha256
+        (base32
+         "0nskq97a6fsv1v6d62zf3yb8whzhqnlh3lap3va3nzvj7csjgf7c"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("python" ,python2-minimal)))
+    (arguments
+     `(#:make-flags
+       (list (string-append "INSTALL_DIR=" %output
+                            "/share/games/openttd/baseset"))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)
+         (add-after 'install 'post-install
+           ;; Rename openmsx-version to openmsx
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let ((install-directory (string-append (assoc-ref outputs "out")
+                                                     "/share/games/openttd/baseset")))
+               (rename-file (string-append install-directory "/openmsx-" ,version)
+                            (string-append install-directory "/openmsx"))
+               #t))))))
+    (home-page "http://dev.openttdcoop.org/projects/openmsx")
+    (synopsis "Music set for OpenTTD")
+    (description "OpenMSX is a music set for OpenTTD which makes it possible
+to play OpenTTD without requiring the proprietary music from the original
+Transport Tycoon Deluxe.")
+    (license license:gpl2)))
+
 (define-public openttd
   (package
     (inherit openttd-engine)
     (name "openttd")
     (arguments
-     (substitute-keyword-arguments (package-arguments openttd-engine)
-       ((#:phases phases)
-        `(modify-phases ,phases
-           (add-after 'install 'install-data
-             (lambda* (#:key inputs outputs #:allow-other-keys)
-               (let*
-                   ((opengfx (assoc-ref inputs "opengfx"))
-                    (out (assoc-ref outputs "out"))
-                    (gfx-dir
-                     (string-append out
-                                    "/share/games/openttd/baseset/opengfx")))
-                 (mkdir-p gfx-dir)
-                 (copy-recursively opengfx gfx-dir))
-               #t))))))
+     `(#:configure-flags
+       (list (string-append "--with-midi=" (assoc-ref %build-inputs "timidity++")
+                            "/bin/timidity"))
+       ,@(substitute-keyword-arguments (package-arguments openttd-engine)
+           ((#:phases phases)
+            `(modify-phases ,phases
+               (add-after 'install 'install-data
+                 (lambda* (#:key inputs outputs #:allow-other-keys)
+                   (for-each
+                    (lambda (input)
+                      (copy-recursively (assoc-ref inputs input)
+                                        (assoc-ref outputs "out")))
+                    (list "opengfx" "openmsx" "opensfx"))
+                   #t)))))))
+    (inputs
+     `(("timidity++" ,timidity++)
+       ,@(package-inputs openttd-engine)))
     (native-inputs
      `(("opengfx" ,openttd-opengfx)
+       ("openmsx" ,openttd-openmsx)
+       ("opensfx" ,openttd-opensfx)
        ,@(package-native-inputs openttd-engine)))))
 
 (define-public pinball
index f8451fd..a4e5d83 100644 (file)
@@ -26,6 +26,7 @@
 ;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2017 nee <nee-git@hidamari.blue>
 ;;; Copyright © 2017 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2017 Mohammed Sadiq <sadiq@sadiqpk.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -51,6 +52,7 @@
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system glib-or-gtk)
+  #:use-module (guix build-system meson)
   #:use-module (guix build-system trivial)
   #:use-module (gnu packages)
   #:use-module (gnu packages admin)
@@ -2960,11 +2962,20 @@ service via the system message bus.")
              (substitute* "data/Locations.xml"
                (("Asia/Rangoon")
                 "Asia/Yangon"))
-            #t)))))
+             #t))
+         (replace 'install
+           (lambda _
+             (zero?
+              (system* "make"
+                       ;; Install vala bindings into $out.
+                       (string-append "vapidir=" %output
+                                      "/share/vala/vapi")
+                       "install")))))))
     (native-inputs
      `(("glib:bin" ,glib "bin") ; for glib-mkenums
        ("gobject-introspection" ,gobject-introspection)
        ("pkg-config" ,pkg-config)
+       ("vala" ,vala)
        ("intltool" ,intltool)))
     (propagated-inputs
      ;; gweather-3.0.pc refers to GTK+, GDK-Pixbuf, GLib/GObject, libxml, and
@@ -5954,6 +5965,34 @@ specified duration and save it as a GIF encoded animated image file.")
       (home-page "https://git.gnome.org/browse/byzanz")
       (license license:gpl2+))))
 
+(define-public gsound
+  (package
+    (name "gsound")
+    (version "1.0.2")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "mirror://gnome/sources/" name "/"
+                                  (version-major+minor version) "/"
+                                  name "-" version ".tar.xz"))
+              (sha256
+               (base32
+                "0lwfwx2c99qrp08pfaj59pks5dphsnxjgrxyadz065d8xqqgza5v"))))
+    (build-system glib-or-gtk-build-system)
+    (native-inputs
+     `(("pkg-config" ,pkg-config)
+       ("gobject-introspection" ,gobject-introspection)
+       ("vala" ,vala)))
+    (inputs
+     `(("glib" ,glib)
+       ("libcanberra" ,libcanberra)))
+    (home-page "https://wiki.gnome.org/Projects/GSound")
+    (synopsis "GObject wrapper for libcanberra")
+    (description
+     "GSound is a small library for playing system sounds.  It's designed to be
+used via GObject Introspection, and is a thin wrapper around the libcanberra C
+library.")
+    (license license:lgpl2.1+)))
+
 (define-public libzapojit
   (package
     (name "libzapojit")
@@ -5982,6 +6021,44 @@ specified duration and save it as a GIF encoded animated image file.")
 Microsoft SkyDrive and Hotmail, using their REST protocols.")
     (license license:lgpl2.1+)))
 
+(define-public gnome-clocks
+  (package
+    (name "gnome-clocks")
+    (version "3.26.0")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "mirror://gnome/sources/" name "/"
+                                  (version-major+minor version) "/"
+                                  name "-" version ".tar.xz"))
+              (sha256
+               (base32
+                "00a5bqi1hbyb9kbl4p393l1g6rddl2y6ljxjby9c5j3k1qka0c0g"))))
+    (build-system meson-build-system)
+    (arguments
+     '(#:glib-or-gtk? #t))
+    (native-inputs
+     `(("vala" ,vala)
+       ("pkg-config" ,pkg-config)
+       ("glib" ,glib "bin")             ; for glib-compile-resources
+       ("gtk+-bin" ,gtk+ "bin")         ; for gtk-update-icon-cache
+       ("desktop-file-utils" ,desktop-file-utils)
+       ("gettext" ,gettext-minimal)
+       ("itstool" ,itstool)))
+    (inputs
+     `(("glib" ,glib)
+       ("gtk+" ,gtk+)
+       ("gsound" ,gsound)
+       ("geoclue" ,geoclue)
+       ("geocode-glib" ,geocode-glib)
+       ("libgweather" ,libgweather)
+       ("gnome-desktop" ,gnome-desktop)))
+    (home-page "https://wiki.gnome.org/Apps/Clocks")
+    (synopsis "GNOME's clock application")
+    (description
+     "GNOME Clocks is a simple clocks application designed to fit the GNOME
+desktop.  It supports world clock, stop watch, alarms, and count down timer.")
+    (license license:gpl3+)))
+
 (define-public gnome-calendar
   (package
     (name "gnome-calendar")
index 426d0ee..82702e4 100644 (file)
@@ -186,14 +186,14 @@ and support for SSL3 and TLS.")
 (define-public gnurl
   (package
    (name "gnurl")
-   (version "7.55.1-3")
+   (version "7.55.1-4")
    (source (origin
             (method url-fetch)
             (uri (string-append "https://gnunet.org/sites/default/files/"
                                 name "-" version ".tar.bz2"))
             (sha256
              (base32
-              "1p2qdh44hgsxjlzh4d3n51xr66cg2z517vpr818flvcrmpq2vxpq"))))
+              "09c1bfwiwxqlh0dl839lslwhvkf98bvpyg9x4pcn3sagz0i8hxfl"))))
    (build-system gnu-build-system)
    (outputs '("out"
               "doc"))                             ; 1.5 MiB of man3 pages
@@ -201,9 +201,7 @@ and support for SSL3 and TLS.")
              ("libidn" ,libidn)
              ("zlib" ,zlib)))
    (native-inputs
-    `(("autoconf" ,autoconf)
-      ("automake" ,automake)
-      ("libtool" ,libtool)
+    `(("libtool" ,libtool)
       ("groff" ,groff)
       ("perl" ,perl)
       ("pkg-config" ,pkg-config)
@@ -234,10 +232,6 @@ and support for SSL3 and TLS.")
               (rename-file (string-append out "/share/man/man3")
                            (string-append doc "/share/man/man3"))
               #t)))
-        (add-after 'unpack 'autoconf
-          ;; Clear artifacts left (shebangs) from release preparation.
-          (lambda _
-            (zero? (system* "sh" "buildconf"))))
         (replace 'check
           (lambda _
             ;; It is unclear why test1026 fails, however the content of it
index 4f9e90e..7e879f4 100644 (file)
@@ -36,6 +36,7 @@
   #:use-module (gnu packages ghostscript)
   #:use-module (gnu packages gl)
   #:use-module (gnu packages libffi)
+  #:use-module (gnu packages lisp)
   #:use-module (gnu packages lua)
   #:use-module (gnu packages maths)
   #:use-module (gnu packages multiprecision)
   #:use-module (guix utils)
   #:use-module (ice-9 regex))
 
+(define-public cl-yale-haskell
+  (let ((commit "85f94c72a16c5f70301dd8db04cde9de2d7dd270")
+        (revision "1"))
+    (package
+      (name "cl-yale-haskell")
+      (version (string-append "2.0.5-" revision "." (string-take commit 9)))
+      (source (origin
+                (method git-fetch)
+                (uri (git-reference
+                      (url "http://git.elephly.net/software/yale-haskell.git")
+                      (commit commit)))
+                (file-name (string-append "yale-haskell-" commit "-checkout"))
+                (sha256
+                 (base32
+                  "0bal3m6ryrjamz5p93bhs9rp5msk8k7lpcqr44wd7xs9b9k8w74g"))))
+      (build-system gnu-build-system)
+      (arguments
+       `(#:tests? #f                    ; no tests
+         ;; Stripping binaries leads to a broken executable lisp system image.
+         #:strip-binaries? #f
+         #:make-flags
+         (list (string-append "PREFIX=" (assoc-ref %outputs "out")))
+         #:phases
+         (modify-phases %standard-phases
+           (replace 'configure
+             (lambda _
+               (setenv "PRELUDE" "./progs/prelude")
+               (setenv "HASKELL_LIBRARY" "./progs/lib")
+               (setenv "PRELUDEBIN" "./progs/prelude/clisp")
+               (setenv "HASKELLPROG" "./bin/clisp-haskell")
+               #t)))))
+      (inputs
+       `(("clisp" ,clisp)))
+      (home-page "http://git.elephly.net/software/yale-haskell.git")
+      (synopsis "Port of the Yale Haskell system to CLISP")
+      (description "This package provides the Yale Haskell system running on
+top of CLISP.")
+      (license license:bsd-4))))
+
 (define ghc-bootstrap-x86_64-7.8.4
   (origin
     (method url-fetch)
index 7bbf2d6..a74c321 100644 (file)
@@ -135,7 +135,7 @@ may also simplify input method development.")
 (define-public ibus-libpinyin
   (package
    (name "ibus-libpinyin")
-   (version "1.9.0")
+   (version "1.9.2")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://github.com/libpinyin/"
@@ -143,15 +143,15 @@ may also simplify input method development.")
              (file-name (string-append name "-" version ".tar.gz"))
              (sha256
               (base32
-               "0gly314z6zn2fv52jw0764k66ry97llk009bk1q1iwf6rr829v68"))))
+               "0wpgs0m62l4zlis9f11b7xknhgnw2xw485nc2xrzk880s17pp1mr"))))
    (build-system glib-or-gtk-build-system)
    (arguments
-     `(#:phases
-       (modify-phases %standard-phases
-         (add-after 'unpack 'autogen
-           (lambda _ (and (zero? (system* "intltoolize"))
-                          (zero? (system* "autoreconf" "-vif")))))
-         (add-after 'wrap-program 'wrap-with-additional-paths
+    `(#:phases
+      (modify-phases %standard-phases
+        (add-after 'unpack 'autogen
+          (lambda _ (and (zero? (system* "intltoolize"))
+                         (zero? (system* "autoreconf" "-vif")))))
+        (add-after 'wrap-program 'wrap-with-additional-paths
           (lambda* (#:key inputs outputs #:allow-other-keys)
             ;; Make sure 'ibus-setup-libpinyin' runs with the correct
             ;; PYTHONPATH and GI_TYPELIB_PATH.
@@ -170,8 +170,8 @@ may also simplify input method development.")
       ("libpinyin" ,libpinyin)
       ("bdb" ,bdb)
       ("sqlite" ,sqlite)
-      ("python" ,python-2)
-      ("pyxdg" ,python2-pyxdg)
+      ("python" ,python)
+      ("pyxdg" ,python-pyxdg)
       ("gtk+" ,gtk+)))
    (native-inputs
     `(("pkg-config" ,pkg-config)
@@ -190,7 +190,7 @@ ZhuYin (Bopomofo) input method based on libpinyin for IBus.")
 (define-public libpinyin
   (package
     (name "libpinyin")
-    (version "2.0.0")
+    (version "2.1.0")
     (source (origin
               (method url-fetch)
               (uri (string-append
@@ -199,7 +199,7 @@ ZhuYin (Bopomofo) input method based on libpinyin for IBus.")
               (file-name (string-append name "-" version ".tar.gz"))
               (sha256
                (base32
-                "17fibx9psrxfiznm4yw8klgbnh3ksyisx0pm1n59kxkrq61v8y0b"))))
+                "1iijpin65cmgawfx7sfdw1anmabljva0af1f9gx8ad6b4slhvknn"))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases
index 5f3e3ad..7599f87 100644 (file)
     ;; The 7 release series has an incompatible API, while the 6 series is still
     ;; maintained. Don't update to 7 until we've made sure that the ImageMagick
     ;; users are ready for the 7-series API.
-    (version "6.9.9-12")
+    (version "6.9.9-15")
     (source (origin
              (method url-fetch)
              (uri (string-append "mirror://imagemagick/ImageMagick-"
                                  version ".tar.xz"))
              (sha256
               (base32
-               "10k63nb1wi5fq1xg1wkjfw7ph46ysy8rndgp18knj2zr06zjjrc5"))))
+               "0bxgdc1qiyvag6a2iiqcbwp4ak0m1mzi9qhs51fbrvv6syy12m6c"))))
     (build-system gnu-build-system)
     (arguments
      `(#:configure-flags '("--with-frozenpaths" "--without-gcc-arch")
index 4545a88..5523492 100644 (file)
@@ -150,14 +150,14 @@ SILC and ICB protocols via plugins.")
 (define-public weechat
   (package
     (name "weechat")
-    (version "1.9")
+    (version "1.9.1")
     (source (origin
               (method url-fetch)
               (uri (string-append "https://weechat.org/files/src/weechat-"
                                   version ".tar.xz"))
               (sha256
                (base32
-                "1zvxz98krq98y7jh3yrjbardg3yxp6y2031rvb7rp5ssk8lyp1fc"))
+                "1z92hprvgp128svfbr25x8j9kd114j9929bzbqasrcd92v31z6f2"))
               (patches (search-patches "weechat-python.patch"))))
     (build-system cmake-build-system)
     (native-inputs `(("gettext" ,gettext-minimal)
index e860e40..dd83964 100644 (file)
@@ -367,8 +367,8 @@ It has been modified to remove all non-free binary blobs.")
 
 (define %intel-compatible-systems '("x86_64-linux" "i686-linux"))
 
-(define %linux-libre-version "4.13.2")
-(define %linux-libre-hash "166yy7nah2h2ffxqgb92nfwrvihna3kvdx4ryppf34gmybmmfw36")
+(define %linux-libre-version "4.13.3")
+(define %linux-libre-hash "011mjm7kz8sf45zj17qldww34q8wh1sv6j0zqrmrlrj39i0xq1a2")
 
 (define-public linux-libre
   (make-linux-libre %linux-libre-version
@@ -377,8 +377,8 @@ It has been modified to remove all non-free binary blobs.")
                     #:configuration-file kernel-config))
 
 (define-public linux-libre-4.9
-  (make-linux-libre "4.9.50"
-                    "1igjb2qr4znvz9p5ix18lbiv8bkfgn7lprn92gdyff4g4r4kzh72"
+  (make-linux-libre "4.9.51"
+                    "168pyrddkfsmwgk4npnlp2hsxmqv6zpwsspyv2ngr9bdnzh45pvj"
                     %intel-compatible-systems
                     #:configuration-file kernel-config))
 
@@ -389,8 +389,8 @@ It has been modified to remove all non-free binary blobs.")
                     #:configuration-file kernel-config))
 
 (define-public linux-libre-4.1
-  (make-linux-libre "4.1.43"
-                    "0ycqmvczj7lm7czilnwpyp14n2lzilyx7m43rsq1qdm2m5rp4q2w"
+  (make-linux-libre "4.1.44"
+                    "1h1v2n8fxnn98y0jz9pnr4xdmc0v4l5d3hfxa5n5r3xmjksf1xs3"
                     %intel-compatible-systems
                     #:configuration-file kernel-config
                     #:patches
@@ -2099,14 +2099,14 @@ time.")
 (define-public lvm2
   (package
     (name "lvm2")
-    (version "2.02.171")
+    (version "2.02.174")
     (source (origin
               (method url-fetch)
               (uri (string-append "ftp://sources.redhat.com/pub/lvm2/releases/LVM2."
                                   version ".tgz"))
               (sha256
                (base32
-                "0r4r9fsvpj9hjmf0zz7h4prz12r6y16jhjhsvk1sbfpsl88sf5dq"))
+                "12qa2yfxnbjdx7kgxqqaglni50b46l5cp1rwjb24mccc830cwvpv"))
               (modules '((guix build utils)))
               (snippet
                '(begin
index 4af36d9..8cd0106 100644 (file)
@@ -487,6 +487,8 @@ in terms of new algorithms.")
     (propagated-inputs
      `(("r-rcpp" ,r-rcpp)
        ("r-rcpparmadillo" ,r-rcpparmadillo)))
+    (inputs
+     `(("armadillo" ,armadillo)))
     (home-page "http://cran.r-project.org/web/packages/AdaptiveSparsity")
     (synopsis "Adaptive sparsity models")
     (description
index b111217..a3821d8 100644 (file)
@@ -1894,14 +1894,14 @@ computer's keyboard.")
 (define-public qtractor
   (package
     (name "qtractor")
-    (version "0.8.3")
+    (version "0.8.4")
     (source (origin
               (method url-fetch)
               (uri (string-append "http://downloads.sourceforge.net/qtractor/"
                                   "qtractor-" version ".tar.gz"))
               (sha256
                (base32
-                "0ggqp2pz6r0pvapbbil51fh5185rn0i9kgzm9ff8r8y1135zllk8"))))
+                "17bbjfn94843g5q1h7xh23fwyazpfgg4fw6drrn5wgk2vx7qpkis"))))
     (build-system gnu-build-system)
     (arguments `(#:tests? #f)) ; no "check" target
     (inputs
index 9f7792d..197a7a0 100644 (file)
@@ -538,7 +538,7 @@ transactions from C or Python.")
               ("python-libarchive-c" ,python-libarchive-c)
               ("python-tlsh" ,python-tlsh)
               ("colordiff" ,colordiff)
-              ("xxd" ,vim)
+              ("xxd" ,xxd)
 
               ;; Below are modules used for tests.
               ("python-pytest" ,python-pytest)
index 5101838..739c51e 100644 (file)
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
-;;; Copyright © 2015, 2016 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2015, 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2016 Pjotr Prins <pjotr.guix@thebird.nl>
 ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
@@ -45,7 +45,7 @@
 (define-public parallel
   (package
     (name "parallel")
-    (version "20170822")
+    (version "20170922")
     (source
      (origin
       (method url-fetch)
@@ -53,7 +53,7 @@
                           version ".tar.bz2"))
       (sha256
        (base32
-        "0j4i0dfbk1i37mcdl7l5ynsldp8biqnbm32sm0cl26by0nivyjc9"))))
+        "0r8mdnmimdf4n6q5k0l8zdql83ka5plrb5qm3rcgkcfwmnk0p0k1"))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases
index c1b196f..8862bdf 100644 (file)
 (define-public libraw
   (package
     (name "libraw")
-    (version "0.18.4")
+    (version "0.18.5")
     (source (origin
               (method url-fetch)
               (uri (string-append "https://www.libraw.org/data/LibRaw-"
                                   version ".tar.gz"))
               (sha256
                (base32
-                "15qc7g5y1m6yi6w9ia79cd6yk0836z7lqw5yigl62n768qdr7x7a"))))
+                "0y519nlvl4bfnnxbwry35f6gbcv6jbbpd2lmiwv6pbyzv4a7saps"))))
     (build-system gnu-build-system)
     (home-page "https://www.libraw.org")
     (synopsis "Raw image decoder")
index 86fd00d..bbb855b 100644 (file)
@@ -2837,13 +2837,13 @@ cutting and pasting that code over and over.")
 (define-public python-unidecode
   (package
     (name "python-unidecode")
-    (version "0.04.20")
+    (version "0.04.21")
     (source (origin
              (method url-fetch)
              (uri (pypi-uri "Unidecode" version))
              (sha256
               (base32
-               "1q00i8gpsq3d9r0q8wk4b290fxl0kqlsdk7iadvli45in6s1hi7d"))))
+               "0lfhp9c5xrbpjvbpr12ji52g1lx04404bzzdg6pvabhzisw6l2i8"))))
     (build-system python-build-system)
     (home-page "https://pypi.python.org/pypi/Unidecode")
     (synopsis "ASCII transliterations of Unicode text")
@@ -2852,7 +2852,7 @@ cutting and pasting that code over and over.")
 useful when integrating with legacy code that doesn't support Unicode, or for
 ease of entry of non-Roman names on a US keyboard, or when constructing ASCII
 machine identifiers from human-readable Unicode strings that should still be
-somewhat intelligeble.")
+somewhat intelligible.")
     (license license:gpl2+)))
 
 (define-public python2-unidecode
@@ -3655,14 +3655,14 @@ is designed to have a low barrier to entry.")
 (define-public python-cython
   (package
     (name "python-cython")
-    (version "0.26")
+    (version "0.27")
     (source
      (origin
        (method url-fetch)
        (uri (pypi-uri "Cython" version))
        (sha256
         (base32
-         "0riciynnr0r68cvg6r3gbhi9x7h44pdwb7926m6n5vfs5p1f492c"))))
+         "02y0pp1nx77b8s1mpxc6da2dccl6wd31pp4ksi9via479qcvacmr"))))
     (build-system python-build-system)
     ;; we need the full python package and not just the python-wrapper
     ;; because we need libpython3.3m.so
index cf88dd2..a00dddc 100644 (file)
@@ -500,14 +500,14 @@ nonlinear mixed-effects models.")
 (define-public r-mgcv
   (package
    (name "r-mgcv")
-   (version "1.8-21")
+   (version "1.8-22")
    (source
     (origin
      (method url-fetch)
      (uri (cran-uri "mgcv" version))
      (sha256
       (base32
-       "1vgjz4ihms9kch6fadh0hkzgwv34wzbdmdzm6392cql1mx06x0mi"))))
+       "1546p6aflg3z6xl2mns1n2c3j8q2spr9cjggj9rn33vrrhsv4fss"))))
    (build-system r-build-system)
    (propagated-inputs
     `(("r-matrix" ,r-matrix)
@@ -2836,14 +2836,14 @@ statements.")
 (define-public r-segmented
   (package
     (name "r-segmented")
-    (version "0.5-2.1")
+    (version "0.5-2.2")
     (source
      (origin
        (method url-fetch)
        (uri (cran-uri "segmented" version))
        (sha256
         (base32
-         "1i576xksc761nyv2dmq86nwbgqvp0plz6bjcn69nkdwq2wbizmw8"))))
+         "1wdjxkgqjqw5q2nywmgkf6y21lb0alhvaqg0m0dr2xyxf1ii79rs"))))
     (build-system r-build-system)
     (home-page "http://cran.r-project.org/web/packages/segmented")
     (synopsis "Regression models with breakpoints estimation")
@@ -3086,14 +3086,14 @@ analysis of large sparse or dense matrices.")
 (define-public r-glmnet
   (package
    (name "r-glmnet")
-   (version "2.0-12")
+   (version "2.0-13")
    (source
     (origin
      (method url-fetch)
      (uri (cran-uri "glmnet" version))
      (sha256
       (base32
-       "1f8j440xi3xq37gvddiq2v610cvpzpg34n43116kixw1zvikm5ra"))))
+       "1zdqp6wnqxzp5qn2ky47phbkrxv3cpgbwmdp896h3xxjvp58sa7k"))))
    (build-system r-build-system)
    (inputs
     `(("gfortran" ,gfortran)))
index 48aac38..07c9133 100644 (file)
@@ -1115,7 +1115,7 @@ access to mpv's powerful playback capabilities.")
 (define-public youtube-dl
   (package
     (name "youtube-dl")
-    (version "2017.09.15")
+    (version "2017.09.24")
     (source (origin
               (method url-fetch)
               (uri (string-append "https://yt-dl.org/downloads/"
@@ -1123,7 +1123,7 @@ access to mpv's powerful playback capabilities.")
                                   version ".tar.gz"))
               (sha256
                (base32
-                "1kw8pqzvhbpyxcz2jb692j4cgzd3vmd81mra09xvpzkq974jkx7f"))))
+                "0j2m75j0d1n83i7jzpkcj7ir0bkskj024j9b0yi88zipcg740wbx"))))
     (build-system python-build-system)
     (arguments
      ;; The problem here is that the directory for the man page and completion
@@ -1232,7 +1232,7 @@ other site that youtube-dl supports.")
 (define-public you-get
   (package
     (name "you-get")
-    (version "0.4.803")
+    (version "0.4.915")
     (source (origin
               (method url-fetch)
               (uri (string-append
@@ -1241,7 +1241,7 @@ other site that youtube-dl supports.")
               (file-name (string-append name "-" version ".tar.gz"))
               (sha256
                (base32
-                "1rjy809x67dadzvj3midkhcda2kp6rqmbj6rbhjd5f16rvqgn7jp"))))
+                "147qf8kdxjv9003fgx50ws0rmjjq98sv11q6c3sdwd29zylaj1ql"))))
     (build-system python-build-system)
     (arguments
      ;; no tests
index f4416a5..dffd6d9 100644 (file)
@@ -102,6 +102,27 @@ Vim is perfect for all kinds of text editing, from composing email to editing
 configuration files.")
     (license license:vim)))
 
+(define-public xxd
+  (package (inherit vim)
+    (name "xxd")
+    (arguments
+     `(#:make-flags '("CC=gcc")
+       #:tests? #f ; there are none
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)
+         (add-after 'unpack 'chdir
+           (lambda _
+             (chdir "src/xxd")))
+         (replace 'install
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let ((bin (string-append (assoc-ref outputs "out") "/bin")))
+               (install-file "xxd" bin)
+               #t))))))
+    (synopsis "Hexdump utility from vim")
+    (description "This package provides the Hexdump utility xxd that comes
+with the editor vim.")))
+
 (define-public vim-full
   (package
     ;; This package should share its source with Vim, but it doesn't
index 8554060..0178ee1 100644 (file)
@@ -5893,7 +5893,7 @@ basic eye-candy effects.")
 (define-public xpra
   (package
     (name "xpra")
-    (version "2.1.1")
+    (version "2.1.2")
     (source
      (origin
        (method url-fetch)
@@ -5901,7 +5901,7 @@ basic eye-candy effects.")
                            version ".tar.xz"))
        (sha256
         (base32
-         "0fgdddhafxnpjlw5nhfyfyimxp43hdn4yhp1vbsjrz3ypfsfhxq7"))))
+         "0a5ffs6gm7j7vzqdbhfmjn9z8qxm9m9as7a1vjmjx63yxv9jqihn"))))
     (build-system python-build-system)
     (inputs `(("ffmpeg", ffmpeg)
               ("flac", flac)
index 2ebd701..329b7b1 100644 (file)
@@ -97,7 +97,8 @@
             %activation-service
             etc-service
 
-            file-union))                      ;XXX: for lack of a better place
+            file-union                        ;XXX: for lack of a better place
+            directory-union))
 
 ;;; Comment:
 ;;;
index 10c8f1b..64620a9 100644 (file)
@@ -59,8 +59,6 @@
             user-unmount-service
             swap-service
             user-processes-service
-            session-environment-service
-            session-environment-service-type
             host-name-service
             console-keymap-service
             %default-console-font
@@ -600,47 +598,6 @@ to add @var{device} to the kernel's entropy pool.  The service will fail if
             (rng-tools rng-tools)
             (device device))))
 
-
-;;;
-;;; System-wide environment variables.
-;;;
-
-(define (environment-variables->environment-file vars)
-  "Return a file for pam_env(8) that contains environment variables VARS."
-  (apply mixed-text-file "environment"
-         (append-map (match-lambda
-                       ((key . value)
-                        (list key "=" value "\n")))
-                     vars)))
-
-(define session-environment-service-type
-  (service-type
-   (name 'session-environment)
-   (extensions
-    (list (service-extension
-           etc-service-type
-           (lambda (vars)
-             (list `("environment"
-                     ,(environment-variables->environment-file vars)))))))
-   (compose concatenate)
-   (extend append)
-   (description
-    "Populate @file{/etc/environment} with the specified environment
-variables.  The value of this service is a list of name/value pairs for
-environments variables, such as:
-
-@example
-'((\"TZ\" . \"Canada/Pacific\"))
-@end example\n")))
-
-(define (session-environment-service vars)
-  "Return a service that builds the @file{/etc/environment}, which can be read
-by PAM-aware applications to set environment variables for sessions.
-
-VARS should be an association list in which both the keys and the values are
-strings or string-valued gexps."
-  (service session-environment-service-type vars))
-
 \f
 ;;;
 ;;; Console & co.
index fbedaa5..42b96b4 100644 (file)
@@ -25,6 +25,7 @@
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services dbus)
+  #:use-module (gnu services base)
   #:use-module (gnu system shadow)
   #:use-module (gnu system pam)
   #:use-module (gnu packages admin)
@@ -909,7 +910,9 @@ and @command{wicd-curses} user interfaces."
   (network-manager network-manager-configuration-network-manager
                    (default network-manager))
   (dns network-manager-configuration-dns
-       (default "default")))
+       (default "default"))
+  (vpn-plugins network-manager-vpn-plugins        ;list of <package>
+               (default '())))
 
 (define %network-manager-activation
   ;; Activation gexp for NetworkManager.
@@ -917,25 +920,38 @@ and @command{wicd-curses} user interfaces."
       (use-modules (guix build utils))
       (mkdir-p "/etc/NetworkManager/system-connections")))
 
+(define (vpn-plugin-directory plugins)
+  "Return a directory containing PLUGINS, the NM VPN plugins."
+  (directory-union "network-manager-vpn-plugins" plugins))
+
+(define network-manager-environment
+  (match-lambda
+    (($ <network-manager-configuration> network-manager dns vpn-plugins)
+     ;; Define this variable in the global environment such that
+     ;; "nmcli connection import type openvpn file foo.ovpn" works.
+     `(("NM_VPN_PLUGIN_DIR"
+        . ,(file-append (vpn-plugin-directory vpn-plugins)
+                        "/lib/NetworkManager/VPN"))))))
+
 (define network-manager-shepherd-service
   (match-lambda
-    (($ <network-manager-configuration> network-manager dns)
-     (let
-         ((conf (plain-file "NetworkManager.conf"
-                            (string-append "
-[main]
-dns=" dns "
-"))))
-     (list (shepherd-service
-            (documentation "Run the NetworkManager.")
-            (provision '(networking))
-            (requirement '(user-processes dbus-system wpa-supplicant loopback))
-            (start #~(make-forkexec-constructor
-                      (list (string-append #$network-manager
-                                           "/sbin/NetworkManager")
-                            (string-append "--config=" #$conf)
-                            "--no-daemon")))
-            (stop #~(make-kill-destructor))))))))
+    (($ <network-manager-configuration> network-manager dns vpn-plugins)
+     (let ((conf (plain-file "NetworkManager.conf"
+                             (string-append "[main]\ndns=" dns "\n")))
+           (vpn  (vpn-plugin-directory vpn-plugins)))
+       (list (shepherd-service
+              (documentation "Run the NetworkManager.")
+              (provision '(networking))
+              (requirement '(user-processes dbus-system wpa-supplicant loopback))
+              (start #~(make-forkexec-constructor
+                        (list (string-append #$network-manager
+                                             "/sbin/NetworkManager")
+                              (string-append "--config=" #$conf)
+                              "--no-daemon")
+                        #:environment-variables
+                        (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
+                                             "/lib/NetworkManager/VPN"))))
+              (stop #~(make-kill-destructor))))))))
 
 (define network-manager-service-type
   (let
@@ -953,6 +969,8 @@ dns=" dns "
             (service-extension polkit-service-type config->package)
             (service-extension activation-service-type
                                (const %network-manager-activation))
+            (service-extension session-environment-service-type
+                               network-manager-environment)
             ;; Add network-manager to the system profile.
             (service-extension profile-service-type config->package)))
      (default-value (network-manager-configuration))
diff --git a/gnu/services/rsync.scm b/gnu/services/rsync.scm
new file mode 100644 (file)
index 0000000..621e6c4
--- /dev/null
@@ -0,0 +1,172 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services rsync)
+  #:use-module (gnu services)
+  #:use-module (gnu services base)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu packages rsync)
+  #:use-module (gnu packages admin)
+  #:use-module (guix records)
+  #:use-module (guix gexp)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:export (rsync-configuration
+            rsync-configuration?
+            rsync-service-type))
+
+;;;; Commentary:
+;;;
+;;; This module implements a service that to run instance of Rsync,
+;;; files synchronization tool.
+;;;
+;;;; Code:
+
+(define-record-type* <rsync-configuration>
+  rsync-configuration
+  make-rsync-configuration
+  rsync-configuration?
+  (package       rsync-configuration-package              ; package
+                 (default rsync))
+  (port-number   rsync-configuration-port-number          ; integer
+                 (default 873))
+  (pid-file      rsync-configuration-pid-file             ; string
+                 (default "/var/run/rsyncd/rsyncd.pid"))
+  (lock-file     rsync-configuration-lock-file            ; string
+                 (default "/var/run/rsyncd/rsyncd.lock"))
+  (log-file      rsync-configuration-log-file             ; string
+                 (default "/var/log/rsyncd.log"))
+  (use-chroot?   rsync-configuration-use-chroot?          ; boolean
+                 (default #t))
+  (share-path    rsync-configuration-share-path           ; string
+                 (default "/srv/rsyncd"))
+  (share-comment rsync-configuration-share-comment        ; string
+                 (default "Rsync share"))
+  (read-only?    rsync-configuration-read-only?           ; boolean
+                 (default #f))
+  (timeout       rsync-configuration-timeout              ; integer
+                 (default 300))
+  (user          rsync-configuration-user                 ; string
+                 (default "root"))
+  (group         rsync-configuration-group                ; string
+                 (default "root"))
+  (uid           rsync-configuration-uid                  ; string
+                 (default "rsyncd"))
+  (gid           rsync-configuration-gid                  ; string
+                 (default "rsyncd")))
+
+(define (rsync-account config)
+  "Return the user accounts and user groups for CONFIG."
+  (let ((rsync-user (if (rsync-configuration-uid config)
+                        (rsync-configuration-uid config)
+                        (rsync-configuration-user config)))
+        (rsync-group (if (rsync-configuration-gid config)
+                         (rsync-configuration-gid config)
+                         (rsync-configuration-group config))))
+    (list (user-group (name rsync-group) (system? #t))
+          (user-account
+           (name rsync-user)
+           (system? #t)
+           (group rsync-group)
+           (comment "rsyncd privilege separation user")
+           (home-directory (string-append "/var/run/"
+                                          rsync-user))
+           (shell #~(string-append #$shadow "/sbin/nologin"))))))
+
+(define (rsync-activation config)
+  "Return the activation GEXP for CONFIG."
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (let ((share-directory  #$(rsync-configuration-share-path config))
+              (user  (getpw (if #$(rsync-configuration-uid config)
+                                #$(rsync-configuration-uid config)
+                                #$(rsync-configuration-user config))))
+              (group (getpw (if #$(rsync-configuration-gid config)
+                                #$(rsync-configuration-gid config)
+                                #$(rsync-configuration-group config)))))
+          (mkdir-p (dirname #$(rsync-configuration-pid-file config)))
+          (and=> share-directory mkdir-p)
+          (chown share-directory
+                 (passwd:uid user)
+                 (group:gid group))))))
+
+(define rsync-config-file
+  ;; Return the rsync configuration file corresponding to CONFIG.
+  (match-lambda
+    (($ <rsync-configuration> package port-number pid-file lock-file log-file
+                              use-chroot? share-path share-comment read-only?
+                              timeout user group uid gid)
+     (if (not (string=? user "root"))
+         (cond
+          ((<= port-number 1024)
+           (error (string-append "rsync-service: to run on port "
+                                 (number->string port-number)
+                                 ", user must be root.")))
+          (use-chroot?
+           (error (string-append "rsync-service: to run in a chroot"
+                                 ", user must be root.")))
+          (uid
+           (error "rsync-service: to use uid, user must be root."))
+          (gid
+           (error "rsync-service: to use gid, user must be root."))))
+     (mixed-text-file
+      "rsync.conf"
+      "# Generated by 'rsync-service'.\n\n"
+      "pid file = " pid-file "\n"
+      "lock file = " lock-file "\n"
+      "log file = " log-file "\n"
+      "port = " (number->string port-number) "\n"
+      "use chroot = " (if use-chroot? "true" "false") "\n"
+      (if uid (string-append "uid = " uid "\n") "")
+      "gid = " (if gid gid "nogroup") "\n" ; no group nobody
+      "\n"
+      "[files]\n"
+      "path = " share-path "\n"
+      "comment = " share-comment "\n"
+      "read only = " (if read-only? "true" "false") "\n"
+      "timeout = " (number->string timeout) "\n"))))
+
+(define (rsync-shepherd-service config)
+  "Return a <shepherd-service> for rsync with CONFIG."
+  (let* ((rsync       (rsync-configuration-package config))
+         (pid-file    (rsync-configuration-pid-file config))
+         (port-number (rsync-configuration-port-number config))
+         (user        (rsync-configuration-user config))
+         (group       (rsync-configuration-group config)))
+    (list (shepherd-service
+           (provision '(rsync))
+           (documentation "Run rsync daemon.")
+           (start #~(make-forkexec-constructor
+                     (list (string-append #$rsync "/bin/rsync")
+                           "--config" #$(rsync-config-file config)
+                           "--daemon")
+                     #:pid-file #$pid-file
+                     #:user #$user
+                     #:group #$group))
+           (stop #~(make-kill-destructor))))))
+
+(define rsync-service-type
+  (service-type
+   (name 'rsync)
+   (extensions
+    (list (service-extension shepherd-root-service-type rsync-shepherd-service)
+          (service-extension account-service-type rsync-account)
+          (service-extension activation-service-type rsync-activation)))
+   (default-value (rsync-configuration))))
index b6c087a..8ab4801 100644 (file)
@@ -243,6 +243,11 @@ directly by the user."
       ((? string? device)
        device)))
 
+  (define (ensure-not-/dev device)
+    (if (and (string? device) (string-prefix? "/" device))
+        #f
+        device))
+
   (match (read port)
     (('boot-parameters ('version 0)
                        ('label label) ('root-device root)
@@ -277,17 +282,16 @@ directly by the user."
           file)))
 
       (store-device
-       (match (assq 'store rest)
-         (('store ('device #f) _ ...)
-          root-device)
-         (('store ('device device) _ ...)
-          (device-sexp->device device))
-         (_                                       ;the old format
-          ;; Root might be a device path like "/dev/sda1", which is not a
-          ;; suitable GRUB device identifier.
-          (if (string-prefix? "/" root)
-              #f
-              root))))
+       ;; Linux device names like "/dev/sda1" are not suitable GRUB device
+       ;; identifiers, so we just filter them out.
+       (ensure-not-/dev
+        (match (assq 'store rest)
+          (('store ('device #f) _ ...)
+           root-device)
+          (('store ('device device) _ ...)
+           (device-sexp->device device))
+          (_                                      ;the old format
+           root-device))))
 
       (store-mount-point
        (match (assq 'store rest)
index eedf933..13f76a5 100644 (file)
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -50,6 +50,9 @@
             unix-pam-service
             base-pam-services
 
+            session-environment-service
+            session-environment-service-type
+
             pam-root-service-type
             pam-root-service))
 
@@ -277,6 +280,48 @@ authenticate to run COMMAND."
                  "groupadd" "groupdel" "groupmod"))))
 
 \f
+;;;
+;;; System-wide environment variables.
+;;;
+
+(define (environment-variables->environment-file vars)
+  "Return a file for pam_env(8) that contains environment variables VARS."
+  (apply mixed-text-file "environment"
+         (append-map (match-lambda
+                       ((key . value)
+                        (list key "=" value "\n")))
+                     vars)))
+
+(define session-environment-service-type
+  (service-type
+   (name 'session-environment)
+   (extensions
+    (list (service-extension
+           etc-service-type
+           (lambda (vars)
+             (list `("environment"
+                     ,(environment-variables->environment-file vars)))))))
+   (compose concatenate)
+   (extend append)
+   (description
+    "Populate @file{/etc/environment}, which is honored by @code{pam_env},
+with the specified environment variables.  The value of this service is a list
+of name/value pairs for environments variables, such as:
+
+@example
+'((\"TZ\" . \"Canada/Pacific\"))
+@end example\n")))
+
+(define (session-environment-service vars)
+  "Return a service that builds the @file{/etc/environment}, which can be read
+by PAM-aware applications to set environment variables for sessions.
+
+VARS should be an association list in which both the keys and the values are
+strings or string-valued gexps."
+  (service session-environment-service-type vars))
+
+
+\f
 ;;;
 ;;; PAM root service.
 ;;;
index 1dd6a11..6470abb 100644 (file)
@@ -41,6 +41,7 @@
             string->ext3-uuid
             string->ext4-uuid
             string->btrfs-uuid
+            string->fat32-uuid
             iso9660-uuid->string
 
             ;; XXX: For lack of a better place.
@@ -175,6 +176,22 @@ ISO9660 UUID representation."
         (low (bytevector-uint-ref uuid 2 %fat32-endianness 2)))
     (format #f "~:@(~x-~x~)" low high)))
 
+(define %fat32-uuid-rx
+  (make-regexp "^([[:xdigit:]]{4})-([[:xdigit:]]{4})$"))
+
+(define (string->fat32-uuid str)
+  "Parse STR, which is in FAT32 format, and return a bytevector or #f."
+  (match (regexp-exec %fat32-uuid-rx str)
+    (#f
+     #f)
+    (rx-match
+     (uint-list->bytevector (list (string->number
+                                   (match:substring rx-match 2) 16)
+                                  (string->number
+                                   (match:substring rx-match 1) 16))
+                            %fat32-endianness
+                            2))))
+
 \f
 ;;;
 ;;; Generic interface.
@@ -198,6 +215,7 @@ ISO9660 UUID representation."
 (define %uuid-parsers
   (vhashq
    ('dce 'ext2 'ext3 'ext4 'btrfs 'luks => string->dce-uuid)
+   ('fat32 'fat => string->fat32-uuid)
    ('iso9660 => string->iso9660-uuid)))
 
 (define %uuid-printers
diff --git a/gnu/tests/rsync.scm b/gnu/tests/rsync.scm
new file mode 100644 (file)
index 0000000..c978367
--- /dev/null
@@ -0,0 +1,126 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests rsync)
+  #:use-module (gnu packages rsync)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services rsync)
+  #:use-module (gnu services networking)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:export (%test-rsync))
+
+(define* (run-rsync-test rsync-os #:optional (rsync-port 873))
+  "Run tests in %RSYNC-OS, which has rsync running and listening on
+PORT."
+  (define os
+    (marionette-operating-system
+     rsync-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '())))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "rsync")
+
+          ;; Wait for rsync to be up and running.
+          (test-eq "service running"
+            'running!
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'rsync)
+                'running!)
+             marionette))
+
+          ;; Make sure the PID file is created.
+          (test-assert "PID file"
+            (marionette-eval
+             '(file-exists? "/var/run/rsyncd/rsyncd.pid")
+             marionette))
+
+          (test-assert "Test file copied to share"
+            (marionette-eval
+             '(begin
+                (call-with-output-file "/tmp/input"
+                  (lambda (port)
+                    (display "test-file-contents\n" port)))
+                (zero?
+                 (system* "rsync" "/tmp/input"
+                          (string-append "rsync://localhost:"
+                                         (number->string #$rsync-port)
+                                         "/files/input"))))
+             marionette))
+
+          (test-equal "Test file correctly received from share"
+            "test-file-contents"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 rdelim))
+                (zero?
+                 (system* "rsync"
+                          (string-append "rsync://localhost:"
+                                         (number->string #$rsync-port)
+                                         "/files/input")
+                          "/tmp/output"))
+                (call-with-input-file "/tmp/output"
+                  (lambda (port)
+                    (read-line port))))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "rsync-test" test))
+
+(define* %rsync-os
+  ;; Return operating system under test.
+  (let ((base-os
+         (simple-operating-system
+          (dhcp-client-service)
+          (service rsync-service-type))))
+    (operating-system
+      (inherit base-os)
+      (packages (cons* rsync
+                       (operating-system-packages base-os))))))
+
+(define %test-rsync
+  (system-test
+   (name "rsync")
+   (description "Connect to a running RSYNC server.")
+   (value (run-rsync-test %rsync-os))))
index b7dadd9..6de611d 100644 (file)
@@ -41,6 +41,7 @@
             cc0
             cc-by2.0 cc-by3.0 cc-by4.0
             cc-by-sa2.0 cc-by-sa3.0 cc-by-sa4.0
+            cc-sampling-plus-1.0
             cddl1.0
             cecill cecill-b cecill-c
             artistic2.0 clarified-artistic
@@ -206,6 +207,11 @@ at URI, which may be a file:// URI pointing the package's tree."
            "http://creativecommons.org/licenses/by/2.0/"
            "Creative Commons Attribution 2.0 Generic"))
 
+(define cc-sampling-plus-1.0
+  (license "CC-Sampling+ 1.0"
+           "https://creativecommons.org/licenses/sampling+/1.0"
+           "Creative Commons Sampling Plus 1.0"))
+
 (define cddl1.0
   (license "CDDL 1.0"
            "http://directory.fsf.org/wiki/License:CDDLv1.0"
index c2f15de..aacce77 100644 (file)
@@ -53,4 +53,8 @@
   "1970-01-01-17-14-42-99"
   (uuid->string (uuid "1970-01-01-17-14-42-99" 'iso9660)))
 
+(test-equal "uuid, FAT32, format preserved"
+  "1234-ABCD"
+  (uuid->string (uuid "1234-abcd" 'fat32)))
+
 (test-end)