ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch 'master' into staging

Browse source
This commit is contained in:
Marius Bakke 2017-09-24 19:18:35 +02:00
commit ffcff27272
No known key found for this signature in database
GPG key ID: A2A06DF2A33A54FA
41 changed files with 1051 additions and 192 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

74
doc/guix.texi
View file

@ -10125,6 +10125,11 @@ then update @code{resolv.conf} to point to the local nameserver.
NetworkManager will not modify @code{resolv.conf}. NetworkManager will not modify @code{resolv.conf}.
@end table @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 table
@end deftp @end deftp
@ -10330,6 +10335,75 @@ In addition, @var{extra-settings} specifies a string to append to the
configuration file. configuration file.
@end deffn @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. Furthermore, @code{(gnu services ssh)} provides the following services.
@cindex SSH @cindex SSH
@cindex SSH server @cindex SSH server

13
gnu/build/vm.scm
View file

@ -406,19 +406,6 @@ (define* (make-iso9660-image grub config-file os-drv target
;; filesystem, so create it. ;; filesystem, so create it.
"mnt=/tmp/root/mnt" "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) "-volid" ,(string-upcase volume-id)
,@(if volume-uuid ,@(if volume-uuid
`("-volume_date" "uuid" `("-volume_date" "uuid"

3
gnu/local.mk
View file

@ -140,6 +140,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/enlightenment.scm \ %D%/packages/enlightenment.scm \
%D%/packages/entr.scm \ %D%/packages/entr.scm \
%D%/packages/erlang.scm \ %D%/packages/erlang.scm \
%D%/packages/fabric-management.scm \
%D%/packages/fcitx.scm \ %D%/packages/fcitx.scm \
%D%/packages/figlet.scm \ %D%/packages/figlet.scm \
%D%/packages/file.scm \ %D%/packages/file.scm \
@ -451,6 +452,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/shepherd.scm \ %D%/services/shepherd.scm \
%D%/services/herd.scm \ %D%/services/herd.scm \
%D%/services/pm.scm \ %D%/services/pm.scm \
%D%/services/rsync.scm \
%D%/services/sddm.scm \ %D%/services/sddm.scm \
%D%/services/spice.scm \ %D%/services/spice.scm \
%D%/services/ssh.scm \ %D%/services/ssh.scm \
@ -497,6 +499,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/mail.scm \ %D%/tests/mail.scm \
%D%/tests/messaging.scm \ %D%/tests/messaging.scm \
%D%/tests/networking.scm \ %D%/tests/networking.scm \
%D%/tests/rsync.scm \
%D%/tests/ssh.scm \ %D%/tests/ssh.scm \
%D%/tests/virtualization.scm \ %D%/tests/virtualization.scm \
%D%/tests/web.scm %D%/tests/web.scm

2
gnu/packages/audio.scm
View file

@ -1073,7 +1073,7 @@ (define-public faust-2
(native-inputs (native-inputs
`(("llvm" ,llvm-with-rtti) `(("llvm" ,llvm-with-rtti)
("which" ,which) ("which" ,which)
("xxd" ,vim) ("xxd" ,xxd)
("ctags" ,emacs-minimal) ; for ctags ("ctags" ,emacs-minimal) ; for ctags
("pkg-config" ,pkg-config))) ("pkg-config" ,pkg-config)))
(inputs (inputs

2
gnu/packages/avr.scm
View file

@ -157,7 +157,7 @@ (define-public microscheme
(list (string-append "PREFIX=" (assoc-ref %outputs "out"))))) (list (string-append "PREFIX=" (assoc-ref %outputs "out")))))
(native-inputs (native-inputs
`(("unzip" ,unzip) `(("unzip" ,unzip)
("vim" ,vim))) ; for xxd ("xxd" ,xxd)))
(home-page "http://microscheme.org/") (home-page "http://microscheme.org/")
(synopsis "Scheme subset for Atmel microcontrollers") (synopsis "Scheme subset for Atmel microcontrollers")
(description (description

6
gnu/packages/bioinformatics.scm
View file

@ -4064,7 +4064,7 @@ (define-public prank
(define-public proteinortho (define-public proteinortho
(package (package
(name "proteinortho") (name "proteinortho")
(version "5.16") (version "5.16b")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -4074,7 +4074,7 @@ (define-public proteinortho
version "_src.tar.gz")) version "_src.tar.gz"))
(sha256 (sha256
(base32 (base32
"0z4f5cg0cs8ai62hfvp4q6w66q2phcc55nhs4xj5cyhxxivjv2ai")))) "1wl0dawpssqwfjvr651r4wlww8hhjin8nba6xh71ks7sbypx886j"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:test-target "test" `(#:test-target "test"
@ -5407,7 +5407,7 @@ (define-public star
#t)) #t))
(delete 'configure)))) (delete 'configure))))
(native-inputs (native-inputs
`(("vim" ,vim))) ; for xxd `(("xxd" ,xxd)))
(inputs (inputs
`(("htslib" ,htslib) `(("htslib" ,htslib)
("zlib" ,zlib))) ("zlib" ,zlib)))

8
gnu/packages/crypto.scm
View file

@ -58,25 +58,25 @@ (define-module (gnu packages crypto)
(define-public libsodium (define-public libsodium
(package (package
(name "libsodium") (name "libsodium")
(version "1.0.13") (version "1.0.14")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (list (string-append (uri (list (string-append
"http://download.libsodium.org/libsodium/" "https://download.libsodium.org/libsodium/"
"releases/libsodium-" version ".tar.gz") "releases/libsodium-" version ".tar.gz")
(string-append (string-append
"https://download.libsodium.org/libsodium/" "https://download.libsodium.org/libsodium/"
"releases/old/libsodium-" version ".tar.gz"))) "releases/old/libsodium-" version ".tar.gz")))
(sha256 (sha256
(base32 (base32
"1z93wfg4k5svg8yck6cgdr6ysj91kbpn03nyzwxanncy3b5sq4ww")))) "1rvylybhxyn6ap3hrcingsl737zrqg12l7r91ns93j7xjz889z1w"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(synopsis "Portable NaCl-based crypto library") (synopsis "Portable NaCl-based crypto library")
(description (description
"Sodium is a new easy-to-use high-speed software library for network "Sodium is a new easy-to-use high-speed software library for network
communication, encryption, decryption, signatures, etc.") communication, encryption, decryption, signatures, etc.")
(license license:isc) (license license:isc)
(home-page "http://libsodium.org"))) (home-page "https://libsodium.org")))
(define-public libmd (define-public libmd
(package (package

2
gnu/packages/disk.scm
View file

@ -216,7 +216,7 @@ (define-public dosfstools
`(#:make-flags (list (string-append "PREFIX=" %output) `(#:make-flags (list (string-append "PREFIX=" %output)
"CC=gcc"))) "CC=gcc")))
(native-inputs (native-inputs
`(("xxd" ,vim))) ; for tests `(("xxd" ,xxd))) ; for tests
(home-page "https://github.com/dosfstools/dosfstools") (home-page "https://github.com/dosfstools/dosfstools")
(synopsis "Utilities for making and checking MS-DOS FAT file systems") (synopsis "Utilities for making and checking MS-DOS FAT file systems")
(description (description

19
gnu/packages/emacs.scm
View file

@ -1504,6 +1504,25 @@ (define-public emacs-keyfreq
a command.") a command.")
(license license:gpl3+))) (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 (define-public emacs-undo-tree
(package (package
(name "emacs-undo-tree") (name "emacs-undo-tree")

173
gnu/packages/fabric-management.scm Normal file
View file

@ -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)))

21
gnu/packages/finance.scm
View file

@ -57,7 +57,7 @@ (define-module (gnu packages finance)
(define-public bitcoin-core (define-public bitcoin-core
(package (package
(name "bitcoin-core") (name "bitcoin-core")
(version "0.14.2") (version "0.15.0.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (uri
@ -65,12 +65,13 @@ (define-public bitcoin-core
version "/bitcoin-" version ".tar.gz")) version "/bitcoin-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1jp8vdc25gs46gj1d9mraqa1xnampffpa7mdy0fw80xca77fbi0s")))) "16si3skhm6jhw1pkniv2b9y1kkdhjmhj392palphir0qc1srwzmm"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config) `(("pkg-config" ,pkg-config)
("python" ,python) ; for the tests ("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 (inputs
`(("bdb" ,bdb-5.3) ; with 6.2.23, there is an error: ambiguous overload `(("bdb" ,bdb-5.3) ; with 6.2.23, there is an error: ambiguous overload
("boost" ,boost) ("boost" ,boost)
@ -78,8 +79,7 @@ (define-public bitcoin-core
("miniupnpc" ,miniupnpc) ("miniupnpc" ,miniupnpc)
("openssl" ,openssl) ("openssl" ,openssl)
("protobuf" ,protobuf) ("protobuf" ,protobuf)
;; TODO Build with the modular Qt. ("qtbase" ,qtbase)))
("qt" ,qt)))
(arguments (arguments
`(#:configure-flags `(#:configure-flags
(list (list
@ -87,7 +87,16 @@ (define-public bitcoin-core
"--with-incompatible-bdb" "--with-incompatible-bdb"
;; Boost is not found unless specified manually. ;; Boost is not found unless specified manually.
(string-append "--with-boost=" (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 #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-before 'check 'set-home (add-before 'check 'set-home

7
gnu/packages/freedesktop.scm
View file

@ -3,7 +3,7 @@
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2015, 2017 Andy Wingo <wingo@pobox.com> ;;; Copyright © 2015, 2017 Andy Wingo <wingo@pobox.com>
;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; 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 © 2015 David Hashe <david.hashe@dhashe.com>
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Kei Kebreau <kkebreau@posteo.net> ;;; Copyright © 2016 Kei Kebreau <kkebreau@posteo.net>
@ -366,7 +366,10 @@ (define-public python-pyxdg
(substitute* "test/test-icon.py" (substitute* "test/test-icon.py"
(("/usr/share/icons/hicolor/index.theme") (("/usr/share/icons/hicolor/index.theme")
(string-append (assoc-ref inputs "hicolor-icon-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: ;; One test fails with:
;; AssertionError: 'x-apple-ios-png' != 'png' ;; AssertionError: 'x-apple-ios-png' != 'png'

26
gnu/packages/game-development.scm
View file

@ -11,6 +11,7 @@
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Manolis Fragkiskos Ragkousis <manolis837@gmail.com> ;;; Copyright © 2017 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com> ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -192,6 +193,31 @@ (define-public grfcodec
;; The MD5 implementation contained in GRFID is under the zlib license. ;; The MD5 implementation contained in GRFID is under the zlib license.
(license (list license:gpl2 license:gpl2+ license:zlib)))) (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 (define-public gzochi
(package (package
(name "gzochi") (name "gzochi")

118
gnu/packages/games.scm
View file

@ -2427,17 +2427,19 @@ (define openttd-engine
;; The build process fails if the configure script is passed the ;; The build process fails if the configure script is passed the
;; option "--enable-fast-install". ;; option "--enable-fast-install".
(replace 'configure (replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys) (lambda* (#:key inputs outputs (configure-flags '())
#:allow-other-keys)
(let ((out (assoc-ref outputs "out")) (let ((out (assoc-ref outputs "out"))
(lzo (assoc-ref inputs "lzo"))) (lzo (assoc-ref inputs "lzo")))
(zero? (zero?
(system* "./configure" (apply system* "./configure"
(string-append "--prefix=" out) (string-append "--prefix=" out)
;; Provide the "lzo" path. ;; Provide the "lzo" path.
(string-append "--with-liblzo2=" (string-append "--with-liblzo2="
lzo "/lib/liblzo2.a") lzo "/lib/liblzo2.a")
;; Put the binary in 'bin' instead of 'games'. ;; Put the binary in 'bin' instead of 'games'.
"--binary-dir=bin")))))))) "--binary-dir=bin"
configure-flags))))))))
(native-inputs `(("pkg-config" ,pkg-config))) (native-inputs `(("pkg-config" ,pkg-config)))
(inputs (inputs
`(("allegro" ,allegro-4) `(("allegro" ,allegro-4)
@ -2464,10 +2466,6 @@ (define openttd-engine
;; different terms. ;; different terms.
(license (list license:bsd-3 license:gpl2 license:lgpl2.1+ license:zlib)))) (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 (define openttd-opengfx
(package (package
(name "openttd-opengfx") (name "openttd-opengfx")
@ -2485,7 +2483,7 @@ (define openttd-opengfx
'(#:make-flags (list "CC=gcc" '(#:make-flags (list "CC=gcc"
(string-append "INSTALL_DIR=" (string-append "INSTALL_DIR="
(assoc-ref %outputs "out") (assoc-ref %outputs "out")
"/share/openttd/baseset")) "/share/games/openttd/baseset/opengfx"))
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(replace 'configure (replace 'configure
@ -2503,7 +2501,8 @@ (define openttd-opengfx
;; different software versions than upstream does, some of the md5sums ;; different software versions than upstream does, some of the md5sums
;; are different. However, the package is still reproducible, it's safe ;; are different. However, the package is still reproducible, it's safe
;; to disable this test. ;; to disable this test.
#:tests? #f)) #:tests? #f
#:parallel-build? #f))
(native-inputs `(("dos2unix" ,dos2unix) (native-inputs `(("dos2unix" ,dos2unix)
("gimp" ,gimp) ("gimp" ,gimp)
("grfcodec" ,grfcodec) ("grfcodec" ,grfcodec)
@ -2525,27 +2524,108 @@ (define openttd-opengfx
@end enumerate") @end enumerate")
(license license:gpl2))) (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 (define-public openttd
(package (package
(inherit openttd-engine) (inherit openttd-engine)
(name "openttd") (name "openttd")
(arguments (arguments
(substitute-keyword-arguments (package-arguments openttd-engine) `(#:configure-flags
(list (string-append "--with-midi=" (assoc-ref %build-inputs "timidity++")
"/bin/timidity"))
,@(substitute-keyword-arguments (package-arguments openttd-engine)
((#:phases phases) ((#:phases phases)
`(modify-phases ,phases `(modify-phases ,phases
(add-after 'install 'install-data (add-after 'install 'install-data
(lambda* (#:key inputs outputs #:allow-other-keys) (lambda* (#:key inputs outputs #:allow-other-keys)
(let* (for-each
((opengfx (assoc-ref inputs "opengfx")) (lambda (input)
(out (assoc-ref outputs "out")) (copy-recursively (assoc-ref inputs input)
(gfx-dir (assoc-ref outputs "out")))
(string-append out (list "opengfx" "openmsx" "opensfx"))
"/share/games/openttd/baseset/opengfx"))) #t)))))))
(mkdir-p gfx-dir) (inputs
(copy-recursively opengfx gfx-dir)) `(("timidity++" ,timidity++)
#t)))))) ,@(package-inputs openttd-engine)))
(native-inputs (native-inputs
`(("opengfx" ,openttd-opengfx) `(("opengfx" ,openttd-opengfx)
("openmsx" ,openttd-openmsx)
("opensfx" ,openttd-opensfx)
,@(package-native-inputs openttd-engine))))) ,@(package-native-inputs openttd-engine)))))
(define-public pinball (define-public pinball

79
gnu/packages/gnome.scm
View file

@ -26,6 +26,7 @@
;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 nee <nee-git@hidamari.blue> ;;; Copyright © 2017 nee <nee-git@hidamari.blue>
;;; Copyright © 2017 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2017 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Mohammed Sadiq <sadiq@sadiqpk.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -51,6 +52,7 @@ (define-module (gnu packages gnome)
#:use-module (guix build-system cmake) #:use-module (guix build-system cmake)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system glib-or-gtk) #:use-module (guix build-system glib-or-gtk)
#:use-module (guix build-system meson)
#:use-module (guix build-system trivial) #:use-module (guix build-system trivial)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
@ -2960,11 +2962,20 @@ (define-public libgweather
(substitute* "data/Locations.xml" (substitute* "data/Locations.xml"
(("Asia/Rangoon") (("Asia/Rangoon")
"Asia/Yangon")) "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 (native-inputs
`(("glib:bin" ,glib "bin") ; for glib-mkenums `(("glib:bin" ,glib "bin") ; for glib-mkenums
("gobject-introspection" ,gobject-introspection) ("gobject-introspection" ,gobject-introspection)
("pkg-config" ,pkg-config) ("pkg-config" ,pkg-config)
("vala" ,vala)
("intltool" ,intltool))) ("intltool" ,intltool)))
(propagated-inputs (propagated-inputs
;; gweather-3.0.pc refers to GTK+, GDK-Pixbuf, GLib/GObject, libxml, and ;; gweather-3.0.pc refers to GTK+, GDK-Pixbuf, GLib/GObject, libxml, and
@ -5954,6 +5965,34 @@ (define-public byzanz
(home-page "https://git.gnome.org/browse/byzanz") (home-page "https://git.gnome.org/browse/byzanz")
(license license:gpl2+)))) (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 (define-public libzapojit
(package (package
(name "libzapojit") (name "libzapojit")
@ -5982,6 +6021,44 @@ (define-public libzapojit
Microsoft SkyDrive and Hotmail, using their REST protocols.") Microsoft SkyDrive and Hotmail, using their REST protocols.")
(license license:lgpl2.1+))) (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 (define-public gnome-calendar
(package (package
(name "gnome-calendar") (name "gnome-calendar")

12
gnu/packages/gnunet.scm
View file

@ -186,14 +186,14 @@ (define-public libmicrohttpd
(define-public gnurl (define-public gnurl
(package (package
(name "gnurl") (name "gnurl")
(version "7.55.1-3") (version "7.55.1-4")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://gnunet.org/sites/default/files/" (uri (string-append "https://gnunet.org/sites/default/files/"
name "-" version ".tar.bz2")) name "-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"1p2qdh44hgsxjlzh4d3n51xr66cg2z517vpr818flvcrmpq2vxpq")))) "09c1bfwiwxqlh0dl839lslwhvkf98bvpyg9x4pcn3sagz0i8hxfl"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" (outputs '("out"
"doc")) ; 1.5 MiB of man3 pages "doc")) ; 1.5 MiB of man3 pages
@ -201,9 +201,7 @@ (define-public gnurl
("libidn" ,libidn) ("libidn" ,libidn)
("zlib" ,zlib))) ("zlib" ,zlib)))
(native-inputs (native-inputs
`(("autoconf" ,autoconf) `(("libtool" ,libtool)
("automake" ,automake)
("libtool" ,libtool)
("groff" ,groff) ("groff" ,groff)
("perl" ,perl) ("perl" ,perl)
("pkg-config" ,pkg-config) ("pkg-config" ,pkg-config)
@ -234,10 +232,6 @@ (define-public gnurl
(rename-file (string-append out "/share/man/man3") (rename-file (string-append out "/share/man/man3")
(string-append doc "/share/man/man3")) (string-append doc "/share/man/man3"))
#t))) #t)))
(add-after 'unpack 'autoconf
;; Clear artifacts left (shebangs) from release preparation.
(lambda _
(zero? (system* "sh" "buildconf"))))
(replace 'check (replace 'check
(lambda _ (lambda _
;; It is unclear why test1026 fails, however the content of it ;; It is unclear why test1026 fails, however the content of it

40
gnu/packages/haskell.scm
View file

@ -36,6 +36,7 @@ (define-module (gnu packages haskell)
#:use-module (gnu packages ghostscript) #:use-module (gnu packages ghostscript)
#:use-module (gnu packages gl) #:use-module (gnu packages gl)
#:use-module (gnu packages libffi) #:use-module (gnu packages libffi)
#:use-module (gnu packages lisp)
#:use-module (gnu packages lua) #:use-module (gnu packages lua)
#:use-module (gnu packages maths) #:use-module (gnu packages maths)
#:use-module (gnu packages multiprecision) #:use-module (gnu packages multiprecision)
@ -56,6 +57,45 @@ (define-module (gnu packages haskell)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (ice-9 regex)) #: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 (define ghc-bootstrap-x86_64-7.8.4
(origin (origin
(method url-fetch) (method url-fetch)

12
gnu/packages/ibus.scm
View file

@ -135,7 +135,7 @@ (define-public ibus
(define-public ibus-libpinyin (define-public ibus-libpinyin
(package (package
(name "ibus-libpinyin") (name "ibus-libpinyin")
(version "1.9.0") (version "1.9.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/libpinyin/" (uri (string-append "https://github.com/libpinyin/"
@ -143,7 +143,7 @@ (define-public ibus-libpinyin
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0gly314z6zn2fv52jw0764k66ry97llk009bk1q1iwf6rr829v68")))) "0wpgs0m62l4zlis9f11b7xknhgnw2xw485nc2xrzk880s17pp1mr"))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -170,8 +170,8 @@ (define-public ibus-libpinyin
("libpinyin" ,libpinyin) ("libpinyin" ,libpinyin)
("bdb" ,bdb) ("bdb" ,bdb)
("sqlite" ,sqlite) ("sqlite" ,sqlite)
("python" ,python-2) ("python" ,python)
("pyxdg" ,python2-pyxdg) ("pyxdg" ,python-pyxdg)
("gtk+" ,gtk+))) ("gtk+" ,gtk+)))
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config) `(("pkg-config" ,pkg-config)
@ -190,7 +190,7 @@ (define-public ibus-libpinyin
(define-public libpinyin (define-public libpinyin
(package (package
(name "libpinyin") (name "libpinyin")
(version "2.0.0") (version "2.1.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -199,7 +199,7 @@ (define-public libpinyin
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"17fibx9psrxfiznm4yw8klgbnh3ksyisx0pm1n59kxkrq61v8y0b")))) "1iijpin65cmgawfx7sfdw1anmabljva0af1f9gx8ad6b4slhvknn"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases

4
gnu/packages/imagemagick.scm
View file

@ -46,14 +46,14 @@ (define-public imagemagick
;; The 7 release series has an incompatible API, while the 6 series is still ;; 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 ;; maintained. Don't update to 7 until we've made sure that the ImageMagick
;; users are ready for the 7-series API. ;; users are ready for the 7-series API.
(version "6.9.9-12") (version "6.9.9-15")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://imagemagick/ImageMagick-" (uri (string-append "mirror://imagemagick/ImageMagick-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"10k63nb1wi5fq1xg1wkjfw7ph46ysy8rndgp18knj2zr06zjjrc5")))) "0bxgdc1qiyvag6a2iiqcbwp4ak0m1mzi9qhs51fbrvv6syy12m6c"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:configure-flags '("--with-frozenpaths" "--without-gcc-arch") `(#:configure-flags '("--with-frozenpaths" "--without-gcc-arch")

4
gnu/packages/irc.scm
View file

@ -150,14 +150,14 @@ (define-public irssi
(define-public weechat (define-public weechat
(package (package
(name "weechat") (name "weechat")
(version "1.9") (version "1.9.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://weechat.org/files/src/weechat-" (uri (string-append "https://weechat.org/files/src/weechat-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1zvxz98krq98y7jh3yrjbardg3yxp6y2031rvb7rp5ssk8lyp1fc")) "1z92hprvgp128svfbr25x8j9kd114j9929bzbqasrcd92v31z6f2"))
(patches (search-patches "weechat-python.patch")))) (patches (search-patches "weechat-python.patch"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(native-inputs `(("gettext" ,gettext-minimal) (native-inputs `(("gettext" ,gettext-minimal)

16
gnu/packages/linux.scm
View file

@ -367,8 +367,8 @@ (define* (make-linux-libre version hash supported-systems
(define %intel-compatible-systems '("x86_64-linux" "i686-linux")) (define %intel-compatible-systems '("x86_64-linux" "i686-linux"))
(define %linux-libre-version "4.13.2") (define %linux-libre-version "4.13.3")
(define %linux-libre-hash "166yy7nah2h2ffxqgb92nfwrvihna3kvdx4ryppf34gmybmmfw36") (define %linux-libre-hash "011mjm7kz8sf45zj17qldww34q8wh1sv6j0zqrmrlrj39i0xq1a2")
(define-public linux-libre (define-public linux-libre
(make-linux-libre %linux-libre-version (make-linux-libre %linux-libre-version
@ -377,8 +377,8 @@ (define-public linux-libre
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define-public linux-libre-4.9 (define-public linux-libre-4.9
(make-linux-libre "4.9.50" (make-linux-libre "4.9.51"
"1igjb2qr4znvz9p5ix18lbiv8bkfgn7lprn92gdyff4g4r4kzh72" "168pyrddkfsmwgk4npnlp2hsxmqv6zpwsspyv2ngr9bdnzh45pvj"
%intel-compatible-systems %intel-compatible-systems
#:configuration-file kernel-config)) #:configuration-file kernel-config))
@ -389,8 +389,8 @@ (define-public linux-libre-4.4
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define-public linux-libre-4.1 (define-public linux-libre-4.1
(make-linux-libre "4.1.43" (make-linux-libre "4.1.44"
"0ycqmvczj7lm7czilnwpyp14n2lzilyx7m43rsq1qdm2m5rp4q2w" "1h1v2n8fxnn98y0jz9pnr4xdmc0v4l5d3hfxa5n5r3xmjksf1xs3"
%intel-compatible-systems %intel-compatible-systems
#:configuration-file kernel-config #:configuration-file kernel-config
#:patches #:patches
@ -2099,14 +2099,14 @@ (define-public eudev-with-hwdb
(define-public lvm2 (define-public lvm2
(package (package
(name "lvm2") (name "lvm2")
(version "2.02.171") (version "2.02.174")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "ftp://sources.redhat.com/pub/lvm2/releases/LVM2." (uri (string-append "ftp://sources.redhat.com/pub/lvm2/releases/LVM2."
version ".tgz")) version ".tgz"))
(sha256 (sha256
(base32 (base32
"0r4r9fsvpj9hjmf0zz7h4prz12r6y16jhjhsvk1sbfpsl88sf5dq")) "12qa2yfxnbjdx7kgxqqaglni50b46l5cp1rwjb24mccc830cwvpv"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin

2
gnu/packages/machine-learning.scm
View file

@ -487,6 +487,8 @@ (define-public r-adaptivesparsity
(propagated-inputs (propagated-inputs
`(("r-rcpp" ,r-rcpp) `(("r-rcpp" ,r-rcpp)
("r-rcpparmadillo" ,r-rcpparmadillo))) ("r-rcpparmadillo" ,r-rcpparmadillo)))
(inputs
`(("armadillo" ,armadillo)))
(home-page "http://cran.r-project.org/web/packages/AdaptiveSparsity") (home-page "http://cran.r-project.org/web/packages/AdaptiveSparsity")
(synopsis "Adaptive sparsity models") (synopsis "Adaptive sparsity models")
(description (description

4
gnu/packages/music.scm
View file

@ -1894,14 +1894,14 @@ (define-public cursynth
(define-public qtractor (define-public qtractor
(package (package
(name "qtractor") (name "qtractor")
(version "0.8.3") (version "0.8.4")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://downloads.sourceforge.net/qtractor/" (uri (string-append "http://downloads.sourceforge.net/qtractor/"
"qtractor-" version ".tar.gz")) "qtractor-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0ggqp2pz6r0pvapbbil51fh5185rn0i9kgzm9ff8r8y1135zllk8")))) "17bbjfn94843g5q1h7xh23fwyazpfgg4fw6drrn5wgk2vx7qpkis"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments `(#:tests? #f)) ; no "check" target (arguments `(#:tests? #f)) ; no "check" target
(inputs (inputs

2
gnu/packages/package-management.scm
View file

@ -538,7 +538,7 @@ (define-public diffoscope
("python-libarchive-c" ,python-libarchive-c) ("python-libarchive-c" ,python-libarchive-c)
("python-tlsh" ,python-tlsh) ("python-tlsh" ,python-tlsh)
("colordiff" ,colordiff) ("colordiff" ,colordiff)
("xxd" ,vim) ("xxd" ,xxd)
;; Below are modules used for tests. ;; Below are modules used for tests.
("python-pytest" ,python-pytest) ("python-pytest" ,python-pytest)

6
gnu/packages/parallel.scm
View file

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2013, 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.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 Pjotr Prins <pjotr.guix@thebird.nl>
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
@ -45,7 +45,7 @@ (define-module (gnu packages parallel)
(define-public parallel (define-public parallel
(package (package
(name "parallel") (name "parallel")
(version "20170822") (version "20170922")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -53,7 +53,7 @@ (define-public parallel
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"0j4i0dfbk1i37mcdl7l5ynsldp8biqnbm32sm0cl26by0nivyjc9")))) "0r8mdnmimdf4n6q5k0l8zdql83ka5plrb5qm3rcgkcfwmnk0p0k1"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases

4
gnu/packages/photo.scm
View file

@ -65,14 +65,14 @@ (define-module (gnu packages photo)
(define-public libraw (define-public libraw
(package (package
(name "libraw") (name "libraw")
(version "0.18.4") (version "0.18.5")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://www.libraw.org/data/LibRaw-" (uri (string-append "https://www.libraw.org/data/LibRaw-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"15qc7g5y1m6yi6w9ia79cd6yk0836z7lqw5yigl62n768qdr7x7a")))) "0y519nlvl4bfnnxbwry35f6gbcv6jbbpd2lmiwv6pbyzv4a7saps"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(home-page "https://www.libraw.org") (home-page "https://www.libraw.org")
(synopsis "Raw image decoder") (synopsis "Raw image decoder")

10
gnu/packages/python.scm
View file

@ -2837,13 +2837,13 @@ (define-public python2-kitchen
(define-public python-unidecode (define-public python-unidecode
(package (package
(name "python-unidecode") (name "python-unidecode")
(version "0.04.20") (version "0.04.21")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "Unidecode" version)) (uri (pypi-uri "Unidecode" version))
(sha256 (sha256
(base32 (base32
"1q00i8gpsq3d9r0q8wk4b290fxl0kqlsdk7iadvli45in6s1hi7d")))) "0lfhp9c5xrbpjvbpr12ji52g1lx04404bzzdg6pvabhzisw6l2i8"))))
(build-system python-build-system) (build-system python-build-system)
(home-page "https://pypi.python.org/pypi/Unidecode") (home-page "https://pypi.python.org/pypi/Unidecode")
(synopsis "ASCII transliterations of Unicode text") (synopsis "ASCII transliterations of Unicode text")
@ -2852,7 +2852,7 @@ (define-public python-unidecode
useful when integrating with legacy code that doesn't support Unicode, or for 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 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 machine identifiers from human-readable Unicode strings that should still be
somewhat intelligeble.") somewhat intelligible.")
(license license:gpl2+))) (license license:gpl2+)))
(define-public python2-unidecode (define-public python2-unidecode
@ -3655,14 +3655,14 @@ (define-public python2-rq
(define-public python-cython (define-public python-cython
(package (package
(name "python-cython") (name "python-cython")
(version "0.26") (version "0.27")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "Cython" version)) (uri (pypi-uri "Cython" version))
(sha256 (sha256
(base32 (base32
"0riciynnr0r68cvg6r3gbhi9x7h44pdwb7926m6n5vfs5p1f492c")))) "02y0pp1nx77b8s1mpxc6da2dccl6wd31pp4ksi9via479qcvacmr"))))
(build-system python-build-system) (build-system python-build-system)
;; we need the full python package and not just the python-wrapper ;; we need the full python package and not just the python-wrapper
;; because we need libpython3.3m.so ;; because we need libpython3.3m.so

12
gnu/packages/statistics.scm
View file

@ -500,14 +500,14 @@ (define-public r-nlme
(define-public r-mgcv (define-public r-mgcv
(package (package
(name "r-mgcv") (name "r-mgcv")
(version "1.8-21") (version "1.8-22")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "mgcv" version)) (uri (cran-uri "mgcv" version))
(sha256 (sha256
(base32 (base32
"1vgjz4ihms9kch6fadh0hkzgwv34wzbdmdzm6392cql1mx06x0mi")))) "1546p6aflg3z6xl2mns1n2c3j8q2spr9cjggj9rn33vrrhsv4fss"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-matrix" ,r-matrix) `(("r-matrix" ,r-matrix)
@ -2836,14 +2836,14 @@ (define-public r-futile-logger
(define-public r-segmented (define-public r-segmented
(package (package
(name "r-segmented") (name "r-segmented")
(version "0.5-2.1") (version "0.5-2.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "segmented" version)) (uri (cran-uri "segmented" version))
(sha256 (sha256
(base32 (base32
"1i576xksc761nyv2dmq86nwbgqvp0plz6bjcn69nkdwq2wbizmw8")))) "1wdjxkgqjqw5q2nywmgkf6y21lb0alhvaqg0m0dr2xyxf1ii79rs"))))
(build-system r-build-system) (build-system r-build-system)
(home-page "http://cran.r-project.org/web/packages/segmented") (home-page "http://cran.r-project.org/web/packages/segmented")
(synopsis "Regression models with breakpoints estimation") (synopsis "Regression models with breakpoints estimation")
@ -3086,14 +3086,14 @@ (define-public r-irlba
(define-public r-glmnet (define-public r-glmnet
(package (package
(name "r-glmnet") (name "r-glmnet")
(version "2.0-12") (version "2.0-13")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "glmnet" version)) (uri (cran-uri "glmnet" version))
(sha256 (sha256
(base32 (base32
"1f8j440xi3xq37gvddiq2v610cvpzpg34n43116kixw1zvikm5ra")))) "1zdqp6wnqxzp5qn2ky47phbkrxv3cpgbwmdp896h3xxjvp58sa7k"))))
(build-system r-build-system) (build-system r-build-system)
(inputs (inputs
`(("gfortran" ,gfortran))) `(("gfortran" ,gfortran)))

8
gnu/packages/video.scm
View file

@ -1115,7 +1115,7 @@ (define-public libvpx
(define-public youtube-dl (define-public youtube-dl
(package (package
(name "youtube-dl") (name "youtube-dl")
(version "2017.09.15") (version "2017.09.24")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://yt-dl.org/downloads/" (uri (string-append "https://yt-dl.org/downloads/"
@ -1123,7 +1123,7 @@ (define-public youtube-dl
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1kw8pqzvhbpyxcz2jb692j4cgzd3vmd81mra09xvpzkq974jkx7f")))) "0j2m75j0d1n83i7jzpkcj7ir0bkskj024j9b0yi88zipcg740wbx"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
;; The problem here is that the directory for the man page and completion ;; The problem here is that the directory for the man page and completion
@ -1232,7 +1232,7 @@ (define-public youtube-dl-gui
(define-public you-get (define-public you-get
(package (package
(name "you-get") (name "you-get")
(version "0.4.803") (version "0.4.915")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -1241,7 +1241,7 @@ (define-public you-get
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1rjy809x67dadzvj3midkhcda2kp6rqmbj6rbhjd5f16rvqgn7jp")))) "147qf8kdxjv9003fgx50ws0rmjjq98sv11q6c3sdwd29zylaj1ql"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
;; no tests ;; no tests

21
gnu/packages/vim.scm
View file

@ -102,6 +102,27 @@ (define-public vim
configuration files.") configuration files.")
(license license:vim))) (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 (define-public vim-full
(package (package
;; This package should share its source with Vim, but it doesn't ;; This package should share its source with Vim, but it doesn't

4
gnu/packages/xorg.scm
View file

@ -5893,7 +5893,7 @@ (define-public xcompmgr
(define-public xpra (define-public xpra
(package (package
(name "xpra") (name "xpra")
(version "2.1.1") (version "2.1.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -5901,7 +5901,7 @@ (define-public xpra
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0fgdddhafxnpjlw5nhfyfyimxp43hdn4yhp1vbsjrz3ypfsfhxq7")))) "0a5ffs6gm7j7vzqdbhfmjn9z8qxm9m9as7a1vjmjx63yxv9jqihn"))))
(build-system python-build-system) (build-system python-build-system)
(inputs `(("ffmpeg", ffmpeg) (inputs `(("ffmpeg", ffmpeg)
("flac", flac) ("flac", flac)

3
gnu/services.scm
View file

@ -97,7 +97,8 @@ (define-module (gnu services)
%activation-service %activation-service
etc-service etc-service
file-union)) ;XXX: for lack of a better place file-union ;XXX: for lack of a better place
directory-union))
;;; Comment: ;;; Comment:
;;; ;;;

43
gnu/services/base.scm
View file

@ -59,8 +59,6 @@ (define-module (gnu services base)
user-unmount-service user-unmount-service
swap-service swap-service
user-processes-service user-processes-service
session-environment-service
session-environment-service-type
host-name-service host-name-service
console-keymap-service console-keymap-service
%default-console-font %default-console-font
@ -600,47 +598,6 @@ (define* (rngd-service #:key
(rng-tools rng-tools) (rng-tools rng-tools)
(device device)))) (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))
;;; ;;;
;;; Console & co. ;;; Console & co.

36
gnu/services/networking.scm
View file

@ -25,6 +25,7 @@ (define-module (gnu services networking)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services shepherd) #:use-module (gnu services shepherd)
#:use-module (gnu services dbus) #:use-module (gnu services dbus)
#:use-module (gnu services base)
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu system pam) #:use-module (gnu system pam)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
@ -909,7 +910,9 @@ (define-record-type* <network-manager-configuration>
(network-manager network-manager-configuration-network-manager (network-manager network-manager-configuration-network-manager
(default network-manager)) (default network-manager))
(dns network-manager-configuration-dns (dns network-manager-configuration-dns
(default "default"))) (default "default"))
(vpn-plugins network-manager-vpn-plugins ;list of <package>
(default '())))
(define %network-manager-activation (define %network-manager-activation
;; Activation gexp for NetworkManager. ;; Activation gexp for NetworkManager.
@ -917,15 +920,25 @@ (define %network-manager-activation
(use-modules (guix build utils)) (use-modules (guix build utils))
(mkdir-p "/etc/NetworkManager/system-connections"))) (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 (define network-manager-shepherd-service
(match-lambda (match-lambda
(($ <network-manager-configuration> network-manager dns) (($ <network-manager-configuration> network-manager dns vpn-plugins)
(let (let ((conf (plain-file "NetworkManager.conf"
((conf (plain-file "NetworkManager.conf" (string-append "[main]\ndns=" dns "\n")))
(string-append " (vpn (vpn-plugin-directory vpn-plugins)))
[main]
dns=" dns "
"))))
(list (shepherd-service (list (shepherd-service
(documentation "Run the NetworkManager.") (documentation "Run the NetworkManager.")
(provision '(networking)) (provision '(networking))
@ -934,7 +947,10 @@ (define network-manager-shepherd-service
(list (string-append #$network-manager (list (string-append #$network-manager
"/sbin/NetworkManager") "/sbin/NetworkManager")
(string-append "--config=" #$conf) (string-append "--config=" #$conf)
"--no-daemon"))) "--no-daemon")
#:environment-variables
(list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
"/lib/NetworkManager/VPN"))))
(stop #~(make-kill-destructor)))))))) (stop #~(make-kill-destructor))))))))
(define network-manager-service-type (define network-manager-service-type
@ -953,6 +969,8 @@ (define network-manager-service-type
(service-extension polkit-service-type config->package) (service-extension polkit-service-type config->package)
(service-extension activation-service-type (service-extension activation-service-type
(const %network-manager-activation)) (const %network-manager-activation))
(service-extension session-environment-service-type
network-manager-environment)
;; Add network-manager to the system profile. ;; Add network-manager to the system profile.
(service-extension profile-service-type config->package))) (service-extension profile-service-type config->package)))
(default-value (network-manager-configuration)) (default-value (network-manager-configuration))

172
gnu/services/rsync.scm Normal file
View file

@ -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))))

14
gnu/system.scm
View file

@ -243,6 +243,11 @@ (define device-sexp->device
((? string? device) ((? string? device)
device))) device)))
(define (ensure-not-/dev device)
(if (and (string? device) (string-prefix? "/" device))
#f
device))
(match (read port) (match (read port)
(('boot-parameters ('version 0) (('boot-parameters ('version 0)
('label label) ('root-device root) ('label label) ('root-device root)
@ -277,17 +282,16 @@ (define device-sexp->device
file))) file)))
(store-device (store-device
;; 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) (match (assq 'store rest)
(('store ('device #f) _ ...) (('store ('device #f) _ ...)
root-device) root-device)
(('store ('device device) _ ...) (('store ('device device) _ ...)
(device-sexp->device device)) (device-sexp->device device))
(_ ;the old format (_ ;the old format
;; Root might be a device path like "/dev/sda1", which is not a root-device))))
;; suitable GRUB device identifier.
(if (string-prefix? "/" root)
#f
root))))
(store-mount-point (store-mount-point
(match (assq 'store rest) (match (assq 'store rest)

47
gnu/system/pam.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -50,6 +50,9 @@ (define-module (gnu system pam)
unix-pam-service unix-pam-service
base-pam-services base-pam-services
session-environment-service
session-environment-service-type
pam-root-service-type pam-root-service-type
pam-root-service)) pam-root-service))
@ -276,6 +279,48 @@ (define* (base-pam-services #:key allow-empty-passwords?)
'("useradd" "userdel" "usermod" '("useradd" "userdel" "usermod"
"groupadd" "groupdel" "groupmod")))) "groupadd" "groupdel" "groupmod"))))
;;;
;;; 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))
;;; ;;;
;;; PAM root service. ;;; PAM root service.

18
gnu/system/uuid.scm
View file

@ -41,6 +41,7 @@ (define-module (gnu system uuid)
string->ext3-uuid string->ext3-uuid
string->ext4-uuid string->ext4-uuid
string->btrfs-uuid string->btrfs-uuid
string->fat32-uuid
iso9660-uuid->string iso9660-uuid->string
;; XXX: For lack of a better place. ;; XXX: For lack of a better place.
@ -175,6 +176,22 @@ (define (fat32-uuid->string uuid)
(low (bytevector-uint-ref uuid 2 %fat32-endianness 2))) (low (bytevector-uint-ref uuid 2 %fat32-endianness 2)))
(format #f "~:@(~x-~x~)" low high))) (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))))
;;; ;;;
;;; Generic interface. ;;; Generic interface.
@ -198,6 +215,7 @@ (define-syntax vhashq
(define %uuid-parsers (define %uuid-parsers
(vhashq (vhashq
('dce 'ext2 'ext3 'ext4 'btrfs 'luks => string->dce-uuid) ('dce 'ext2 'ext3 'ext4 'btrfs 'luks => string->dce-uuid)
('fat32 'fat => string->fat32-uuid)
('iso9660 => string->iso9660-uuid))) ('iso9660 => string->iso9660-uuid)))
(define %uuid-printers (define %uuid-printers

126
gnu/tests/rsync.scm Normal file
View file

@ -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))))

6
guix/licenses.scm
View file

@ -41,6 +41,7 @@ (define-module (guix licenses)
cc0 cc0
cc-by2.0 cc-by3.0 cc-by4.0 cc-by2.0 cc-by3.0 cc-by4.0
cc-by-sa2.0 cc-by-sa3.0 cc-by-sa4.0 cc-by-sa2.0 cc-by-sa3.0 cc-by-sa4.0
cc-sampling-plus-1.0
cddl1.0 cddl1.0
cecill cecill-b cecill-c cecill cecill-b cecill-c
artistic2.0 clarified-artistic artistic2.0 clarified-artistic
@ -206,6 +207,11 @@ (define cc-by2.0
"http://creativecommons.org/licenses/by/2.0/" "http://creativecommons.org/licenses/by/2.0/"
"Creative Commons Attribution 2.0 Generic")) "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 (define cddl1.0
(license "CDDL 1.0" (license "CDDL 1.0"
"http://directory.fsf.org/wiki/License:CDDLv1.0" "http://directory.fsf.org/wiki/License:CDDLv1.0"

4
tests/uuid.scm
View file

@ -53,4 +53,8 @@ (define-module (test-uuid)
"1970-01-01-17-14-42-99" "1970-01-01-17-14-42-99"
(uuid->string (uuid "1970-01-01-17-14-42-99" 'iso9660))) (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) (test-end)