Merge branch 'master' into staging

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

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

View File

@ -406,19 +406,6 @@ GRUB configuration and OS-DRV as the stuff in it."
;; 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"

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

View File

@ -1073,7 +1073,7 @@ PS, and DAB+.")
(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

View File

@ -157,7 +157,7 @@ C++.")
(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

View File

@ -4064,7 +4064,7 @@ predicts the locations of structural units in the sequences.")
(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 @@ predicts the locations of structural units in the sequences.")
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 @@ application of SortMeRNA is filtering rRNA from metatranscriptomic data.")
#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)))

View File

@ -58,25 +58,25 @@
(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

View File

@ -216,7 +216,7 @@ to recover data more efficiently by only reading the necessary blocks.")
`(#: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

View File

@ -1504,6 +1504,25 @@ work with Emacs 24 and 25.")
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")

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

View File

@ -57,7 +57,7 @@
(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 @@
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 @@
("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 @@
"--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

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 @@ manager for the current system.")
(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'

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 @@ necessary.
;; 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")

View File

@ -2427,17 +2427,19 @@ and a game metadata scraper.")
;; 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 @@ engine. When you start it you will be prompted to download a graphics set.")
;; 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 @@ engine. When you start it you will be prompted to download a graphics set.")
'(#: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 @@ engine. When you start it you will be prompted to download a graphics set.")
;; 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 @@ OpenGFX provides you with...
@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
((#:phases phases) (list (string-append "--with-midi=" (assoc-ref %build-inputs "timidity++")
`(modify-phases ,phases "/bin/timidity"))
(add-after 'install 'install-data ,@(substitute-keyword-arguments (package-arguments openttd-engine)
(lambda* (#:key inputs outputs #:allow-other-keys) ((#:phases phases)
(let* `(modify-phases ,phases
((opengfx (assoc-ref inputs "opengfx")) (add-after 'install 'install-data
(out (assoc-ref outputs "out")) (lambda* (#:key inputs outputs #:allow-other-keys)
(gfx-dir (for-each
(string-append out (lambda (input)
"/share/games/openttd/baseset/opengfx"))) (copy-recursively (assoc-ref inputs input)
(mkdir-p gfx-dir) (assoc-ref outputs "out")))
(copy-recursively opengfx gfx-dir)) (list "opengfx" "openmsx" "opensfx"))
#t)))))) #t)))))))
(inputs
`(("timidity++" ,timidity++)
,@(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

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 @@
#: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 @@ service via the system message bus.")
(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 @@ specified duration and save it as a GIF encoded animated image file.")
(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 @@ specified duration and save it as a GIF encoded animated image file.")
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")

View File

@ -186,14 +186,14 @@ and support for SSL3 and TLS.")
(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 @@ and support for SSL3 and TLS.")
("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 @@ and support for SSL3 and TLS.")
(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

View File

@ -36,6 +36,7 @@
#: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 @@
#: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)

View File

@ -135,7 +135,7 @@ may also simplify input method development.")
(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,15 +143,15 @@ may also simplify input method development.")
(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
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'unpack 'autogen (add-after 'unpack 'autogen
(lambda _ (and (zero? (system* "intltoolize")) (lambda _ (and (zero? (system* "intltoolize"))
(zero? (system* "autoreconf" "-vif"))))) (zero? (system* "autoreconf" "-vif")))))
(add-after 'wrap-program 'wrap-with-additional-paths (add-after 'wrap-program 'wrap-with-additional-paths
(lambda* (#:key inputs outputs #:allow-other-keys) (lambda* (#:key inputs outputs #:allow-other-keys)
;; Make sure 'ibus-setup-libpinyin' runs with the correct ;; Make sure 'ibus-setup-libpinyin' runs with the correct
;; PYTHONPATH and GI_TYPELIB_PATH. ;; PYTHONPATH and GI_TYPELIB_PATH.
@ -170,8 +170,8 @@ may also simplify input method development.")
("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 @@ ZhuYin (Bopomofo) input method based on libpinyin for IBus.")
(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 @@ ZhuYin (Bopomofo) input method based on libpinyin for IBus.")
(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

View File

@ -46,14 +46,14 @@
;; 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")

View File

@ -150,14 +150,14 @@ SILC and ICB protocols via plugins.")
(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)

View 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 %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 @@ It has been modified to remove all non-free binary blobs.")
#: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 @@ It has been modified to remove all non-free binary blobs.")
#: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 @@ time.")
(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

View File

@ -487,6 +487,8 @@ in terms of new algorithms.")
(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

View File

@ -1894,14 +1894,14 @@ computer's keyboard.")
(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

View File

@ -538,7 +538,7 @@ transactions from C or Python.")
("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)

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

View File

@ -65,14 +65,14 @@
(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")

View File

@ -2837,13 +2837,13 @@ cutting and pasting that code over and over.")
(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 @@ cutting and pasting that code over and over.")
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 @@ is designed to have a low barrier to entry.")
(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

View File

@ -500,14 +500,14 @@ nonlinear mixed-effects models.")
(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 @@ statements.")
(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 @@ analysis of large sparse or dense matrices.")
(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)))

View File

@ -1115,7 +1115,7 @@ access to mpv's powerful playback capabilities.")
(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 @@ access to mpv's powerful playback capabilities.")
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 @@ other site that youtube-dl supports.")
(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 @@ other site that youtube-dl supports.")
(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

View File

@ -102,6 +102,27 @@ Vim is perfect for all kinds of text editing, from composing email to editing
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

View File

@ -5893,7 +5893,7 @@ basic eye-candy effects.")
(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 @@ basic eye-candy effects.")
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)

View File

@ -97,7 +97,8 @@
%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:
;;; ;;;

View File

@ -59,8 +59,6 @@
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 @@ to add @var{device} to the kernel's entropy pool. The service will fail if
(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.

View File

@ -25,6 +25,7 @@
#: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 @@ and @command{wicd-curses} user interfaces."
(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,25 +920,38 @@ and @command{wicd-curses} user interfaces."
(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] (list (shepherd-service
dns=" dns " (documentation "Run the NetworkManager.")
")))) (provision '(networking))
(list (shepherd-service (requirement '(user-processes dbus-system wpa-supplicant loopback))
(documentation "Run the NetworkManager.") (start #~(make-forkexec-constructor
(provision '(networking)) (list (string-append #$network-manager
(requirement '(user-processes dbus-system wpa-supplicant loopback)) "/sbin/NetworkManager")
(start #~(make-forkexec-constructor (string-append "--config=" #$conf)
(list (string-append #$network-manager "--no-daemon")
"/sbin/NetworkManager") #:environment-variables
(string-append "--config=" #$conf) (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
"--no-daemon"))) "/lib/NetworkManager/VPN"))))
(stop #~(make-kill-destructor)))))))) (stop #~(make-kill-destructor))))))))
(define network-manager-service-type (define network-manager-service-type
(let (let
@ -953,6 +969,8 @@ dns=" dns "
(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))))

View File

@ -243,6 +243,11 @@ directly by the user."
((? 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 @@ directly by the user."
file))) file)))
(store-device (store-device
(match (assq 'store rest) ;; Linux device names like "/dev/sda1" are not suitable GRUB device
(('store ('device #f) _ ...) ;; identifiers, so we just filter them out.
root-device) (ensure-not-/dev
(('store ('device device) _ ...) (match (assq 'store rest)
(device-sexp->device device)) (('store ('device #f) _ ...)
(_ ;the old format root-device)
;; Root might be a device path like "/dev/sda1", which is not a (('store ('device device) _ ...)
;; suitable GRUB device identifier. (device-sexp->device device))
(if (string-prefix? "/" root) (_ ;the old format
#f root-device))))
root))))
(store-mount-point (store-mount-point
(match (assq 'store rest) (match (assq 'store rest)

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 @@
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 @@ authenticate to run COMMAND."
'("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.

View File

@ -41,6 +41,7 @@
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 @@ ISO9660 UUID representation."
(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 @@ ISO9660 UUID representation."
(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))))

View File

@ -41,6 +41,7 @@
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 @@ at URI, which may be a file:// URI pointing the package's tree."
"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"

View File

@ -53,4 +53,8 @@
"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)