nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' into core-updates

This commit is contained in:
Leo Famulari 2016-10-03 17:08:05 -04:00
parent e543c8a2c6 b38e97e03b
commit 9c2130757c
No known key found for this signature in database
GPG Key ID: 2646FA30BACA7F08
34 changed files with 1775 additions and 446 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
build-aux/compile-all.scm
View File

@ -81,6 +81,9 @@
(let ((files (filter file-needs-compilation? files)))
(for-each load-module-file files)
(let ((mutex (make-mutex)))
;; Make sure compilation related modules are loaded before starting to
;; compile files in parallel.
(compile #f)
(par-for-each (lambda (file)
(compile-file* file mutex))
files)))))

171
doc/guix.texi
View File

@ -26,7 +26,8 @@ Copyright @copyright{} 2016 Ben Woodcroft@*
Copyright @copyright{} 2016 Chris Marusich@*
Copyright @copyright{} 2016 Efraim Flashner@*
Copyright @copyright{} 2016 John Darrington@*
Copyright @copyright{} 2016 ng0
Copyright @copyright{} 2016 ng0@*
Copyright @copyright{} 2016 Jan Nieuwenhuizen
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -213,6 +214,7 @@ Services
* Base Services:: Essential system services.
* Scheduled Job Execution:: The mcron service.
* Log Rotation:: The rottlog service.
* Networking Services:: Network setup, SSH daemon, etc.
* X Window:: Graphical display.
* Desktop Services:: D-Bus and desktop services.
@ -7581,6 +7583,7 @@ declaration.
@menu
* Base Services:: Essential system services.
* Scheduled Job Execution:: The mcron service.
* Log Rotation:: The rottlog service.
* Networking Services:: Network setup, SSH daemon, etc.
* X Window:: Graphical display.
* Desktop Services:: D-Bus and desktop services.
@ -8055,6 +8058,85 @@ specifications,, mcron, GNU@tie{}mcron}).
@end deftp
@node Log Rotation
@subsubsection Log Rotation
@cindex rottlog
@cindex log rotation
Log files such as those found in @file{/var/log} tend to grow endlessly,
so it's a good idea to @dfn{rotate} them once in a while---i.e., archive
their contents in separate files, possibly compressed. The @code{(gnu
services admin)} module provides an interface to GNU@tie{}Rot[t]log, a
log rotation tool (@pxref{Top,,, rottlog, GNU Rot[t]log Manual}).
The example below defines an operating system that provides log rotation
with the default settings.
@lisp
(use-modules (guix) (gnu))
(use-service-modules admin mcron)
(use-package-modules base idutils)
(operating-system
;; @dots{}
(services (cons* (mcron-service)
(service rottlog-service-type (rottlog-configuration))
%base-services)))
@end lisp
@defvr {Scheme Variable} rottlog-service-type
This is the type of the Rottlog service, whose value is a
@code{rottlog-configuration} object.
This service type can define mcron jobs (@pxref{Scheduled Job
Execution}) to run the rottlog service.
@end defvr
@deftp {Data Type} rottlog-configuration
Data type representing the configuration of rottlog.
@table @asis
@item @code{rottlog} (default: @code{rottlog})
The Rottlog package to use.
@item @code{rc-file} (default: @code{(file-append rottlog "/etc/rc")})
The Rottlog configuration file to use (@pxref{Mandatory RC Variables,,,
rottlog, GNU Rot[t]log Manual}).
@item @code{periodic-rotations} (default: @code{`(("weekly" %default-rotatations))})
A list of Rottlog period-name/period-config tuples.
For example, taking an example from the Rottlog manual (@pxref{Period
Related File Examples,,, rottlog, GNU Rot[t]log Manual}), a valid tuple
might be:
@example
("daily" ,(plain-file "daily"
"\
/var/log/apache/* @{
storedir apache-archives
rotate 6
notifempty
nocompress
@}"))
@end example
@item @code{jobs}
This is a list of gexps where each gexp corresponds to an mcron job
specification (@pxref{Scheduled Job Execution}).
@end table
@end deftp
@defvr {Scheme Variable} %default-rotations
Specifies weekly rotation of @var{%rotated-files} and
@code{"/var/log/shepherd.log"}.
@end defvr
@defvr {Scheme Variable} %rotated-files
The list of syslog-controlled files to be rotated. By default it is:
@code{'("/var/log/messages" "/var/log/secure")}.
@end defvr
@node Networking Services
@subsubsection Networking Services
@ -8199,40 +8281,67 @@ root.
The other options should be self-descriptive.
@end deffn
@deffn {Scheme Procedure} openssh-service [#:pid-file "/var/run/sshd.pid"] @
[#:port-number 22] [#:permit-root-login 'without-password] @
[#:allow-empty-passwords #f] [#:password-authentication? #t] @
[#:pubkey-authentication? #t] [#:rsa-authentication? #t] @
[#:x11-forwarding? #f] [#:protocol-number "2"]
Run the @command{sshd} program from @var{openssh} on port
@var{port-number}. @command{sshd} runs an SSH daemon and writes its PID
to @var{pid-file}. It understands SSH protocol
@var{protocol-number}. The @var{protocol-number} can be either 1 or 2.
@deffn {Scheme Variable} openssh-service-type
This is the type for the @uref{http://www.openssh.org, OpenSSH} secure
shell daemon, @command{sshd}. Its value must be an
@code{openssh-configuration} record as in this example:
@var{permit-root-login} takes one of @code{#t}, @code{'without-password}
and @code{#f}. It is used to allow root login through SSH.
@code{'without-password} means that root login is allowed, but not with
password-based authentication.
@example
(service openssh-service-type
(openssh-configuration
(x11-forwarding? #t)
(permit-root-login 'without-password)))
@end example
When @var{allow-empty-passwords?} is true, users with empty passwords
may log in. When false, they may not.
When @var{password-authentication?} is true, users may log in with their
password. When false, they have to use other means of authentication.
When @var{pubkey-authentication?} is true, users may log in using public
key authentication. When false, users have to use other means of
authentication. Authorized public keys are stored in
@file{~/.ssh/authorized_keys}. This is used only by protocol version 2.
When @var{rsa-authentication?} is true, users may log in using pure RSA
authentication. When false, users have to use other means of
authentication. This is used only by protocol 1.
When @var{x11-forwarding?} is true, @command{ssh} options @option{-X}
and @option{-Y} will work.
See below for details about @code{openssh-configuration}.
@end deffn
@deftp {Data Type} openssh-configuration
This is the configuration record for OpenSSH's @command{sshd}.
@table @asis
@item @code{pid-file} (default: @code{"/var/run/sshd.pid"})
Name of the file where @command{sshd} writes its PID.
@item @code{port-number} (default: @code{22})
TCP port on which @command{sshd} listens for incoming connections.
@item @code{permit-root-login} (default: @code{#f})
This field determines whether and when to allow logins as root. If
@code{#f}, root logins are disallowed; if @code{#t}, they are allowed.
If it's the symbol @code{'without-password}, then root logins are
permitted but not with password-based authentication.
@item @code{allow-empty-passwords?} (default: @code{#f})
When true, users with empty passwords may log in. When false, they may
not.
@item @code{password-authentication?} (default: @code{#t})
When true, users may log in with their password. When false, they have
other authentication methods.
@item @code{public-key-authentication?} (default: @code{#t})
When true, users may log in using public key authentication. When
false, users have to use other authentication method.
Authorized public keys are stored in @file{~/.ssh/authorized_keys}.
This is used only by protocol version 2.
@item @code{rsa-authentication?} (default: @code{#t})
When true, users may log in using pure RSA authentication. When false,
users have to use other means of authentication. This is used only by
protocol 1.
@item @code{x11-forwarding?} (default: @code{#f})
When true, forwarding of X11 graphical client connections is
enabled---in other words, @command{ssh} options @option{-X} and
@option{-Y} will work.
@item @code{protocol-number} (default: @code{2})
The SSH protocol number to use.
@end table
@end deftp
@deffn {Scheme Procedure} dropbear-service [@var{config}]
Run the @uref{https://matt.ucc.asn.au/dropbear/dropbear.html,Dropbear SSH
daemon} with the given @var{config}, a @code{<dropbear-configuration>}

10
gnu/local.mk
View File

@ -386,6 +386,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/zip.scm \
\
%D%/services.scm \
%D%/services/admin.scm \
%D%/services/avahi.scm \
%D%/services/base.scm \
%D%/services/databases.scm \
@ -430,7 +431,8 @@ GNU_SYSTEM_MODULES = \
\
%D%/tests.scm \
%D%/tests/base.scm \
%D%/tests/install.scm
%D%/tests/install.scm \
%D%/tests/ssh.scm
patchdir = $(guilemoduledir)/%D%/packages/patches
@ -528,6 +530,7 @@ dist_patch_DATA = \
%D%/packages/patches/gcc-cross-environment-variables.patch \
%D%/packages/patches/gcc-libvtv-runpath.patch \
%D%/packages/patches/gcc-5.0-libvtv-runpath.patch \
%D%/packages/patches/gd-CVE-2016-7568.patch \
%D%/packages/patches/gd-fix-gd2-read-test.patch \
%D%/packages/patches/gd-fix-tests-on-i686.patch \
%D%/packages/patches/gegl-CVE-2012-4433.patch \
@ -620,6 +623,10 @@ dist_patch_DATA = \
%D%/packages/patches/liba52-link-with-libm.patch \
%D%/packages/patches/liba52-set-soname.patch \
%D%/packages/patches/liba52-use-mtune-not-mcpu.patch \
%D%/packages/patches/libarchive-7zip-heap-overflow.patch \
%D%/packages/patches/libarchive-fix-symlink-check.patch \
%D%/packages/patches/libarchive-fix-filesystem-attacks.patch \
%D%/packages/patches/libarchive-safe_fprintf-buffer-overflow.patch \
%D%/packages/patches/libbonobo-activation-test-race.patch \
%D%/packages/patches/libcanberra-sound-theme-freedesktop.patch \
%D%/packages/patches/libcmis-fix-test-onedrive.patch \
@ -781,6 +788,7 @@ dist_patch_DATA = \
%D%/packages/patches/python-paste-remove-timing-test.patch \
%D%/packages/patches/python2-pygobject-2-gi-info-type-error-domain.patch \
%D%/packages/patches/qt4-ldflags.patch \
%D%/packages/patches/quickswitch-fix-dmenu-check.patch \
%D%/packages/patches/rapicorn-isnan.patch \
%D%/packages/patches/ratpoison-shell.patch \
%D%/packages/patches/readline-link-ncurses.patch \

4
gnu/packages/algebra.scm
View File

@ -593,14 +593,14 @@ cosine/ sine transforms or DCT/DST).")
(define-public eigen
(package
(name "eigen")
(version "3.2.8")
(version "3.2.9")
(source (origin
(method url-fetch)
(uri (string-append "https://bitbucket.org/eigen/eigen/get/"
version ".tar.bz2"))
(sha256
(base32
"0mby6my1djsg8681fcvlaq0i4kd17fja9qn5f713j3xpfbb66akj"))
"1zs5b210mq7nyanky07li6456rrd0xv2nxf6sl2lhkzdq5p067jd"))
(file-name (string-append name "-" version ".tar.bz2"))
(modules '((guix build utils)))
(snippet

4
gnu/packages/audio.scm
View File

@ -877,7 +877,7 @@ patches that can be used with softsynths such as Timidity and WildMidi.")
(define-public guitarix
(package
(name "guitarix")
(version "0.35.0")
(version "0.35.1")
(source (origin
(method url-fetch)
(uri (string-append
@ -885,7 +885,7 @@ patches that can be used with softsynths such as Timidity and WildMidi.")
version ".tar.xz"))
(sha256
(base32
"10hijqrrl8xil46kgsac10ysfxysisxlibm2rz133zyig5n63jdw"))))
"066qva1zk63qw60s0vbi9g9jh22ljw67p91pk82kv11gw24h3vg6"))))
(build-system waf-build-system)
(arguments
`(#:tests? #f ; no "check" target

12
gnu/packages/backup.scm
View File

@ -172,6 +172,7 @@ backups (called chunks) to allow easy burning to CD/DVD.")
(define-public libarchive
(package
(name "libarchive")
(replacement libarchive/fixed)
(version "3.2.1")
(source
(origin
@ -227,6 +228,17 @@ archive. In particular, note that there is currently no built-in support for
random access nor for in-place modification.")
(license license:bsd-2)))
(define libarchive/fixed
(package
(inherit libarchive)
(source (origin
(inherit (package-source libarchive))
(patches (search-patches
"libarchive-7zip-heap-overflow.patch"
"libarchive-fix-symlink-check.patch"
"libarchive-fix-filesystem-attacks.patch"
"libarchive-safe_fprintf-buffer-overflow.patch"))))))
(define-public rdup
(package
(name "rdup")

4
gnu/packages/bioinformatics.scm
View File

@ -5571,7 +5571,7 @@ track. The database is exposed as a @code{TxDb} object.")
(define-public vsearch
(package
(name "vsearch")
(version "2.1.1")
(version "2.1.2")
(source
(origin
(method url-fetch)
@ -5581,7 +5581,7 @@ track. The database is exposed as a @code{TxDb} object.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0rn40inkpgv0j1r1j9kmgjkb7nc8v5c9ijvbhzr17iayannxvlq9"))
"1zzfj6ydsfzljyswlwqknpp8s2cf31vimi1aqf9ljsbagjyizc58"))
(modules '((guix build utils)))
(snippet
'(begin

4
gnu/packages/databases.scm
View File

@ -779,7 +779,7 @@ columns, primary keys, unique constraints and relationships.")
(define-public perl-dbd-mysql
(package
(name "perl-dbd-mysql")
(version "4.035")
(version "4.037")
(source
(origin
(method url-fetch)
@ -787,7 +787,7 @@ columns, primary keys, unique constraints and relationships.")
"DBD-mysql-" version ".tar.gz"))
(sha256
(base32
"0dqrnrk8yjl06xl8hld5wyalk77z0h9j5h1gdk4z9g0nx9js7v5p"))))
"1z1wxnzhxfr9awjqb1d8pz9hf50shbk9ip2jmsmgdlwfyb78lmyz"))))
(build-system perl-build-system)
;; Tests require running MySQL server
(arguments `(#:tests? #f))

26
gnu/packages/emacs.scm
View File

@ -12,7 +12,7 @@
;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Matthew Jordan <matthewjordandevops@yandex.com>
;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016 ng0 <ngillmann@runbox.com>
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2016 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2016 Alex Vong <alexvong1995@gmail.com>
@ -2231,6 +2231,30 @@ perspective only its buffers are available by default.")
;; the Expat license.
(license license:gpl3+)))
(define-public emacs-rudel
(package
(name "emacs-rudel")
(version "0.3.1")
(source
(origin
(method url-fetch)
(uri (string-append "http://elpa.gnu.org/packages/rudel-"
version ".tar"))
(sha256
(base32
"0glqa68g509p0s2vcc0i8kzlddnc9brd9jqhnm5rzxz4i050cvnz"))))
(build-system emacs-build-system)
(home-page "http://rudel.sourceforge.net/")
(synopsis "Collaborative editing framework")
(description
"Rudel is a collaborative editing environment for GNU Emacs. Its purpose
is to share buffers with other users in order to edit the contents of those
buffers collaboratively. Rudel supports multiple backends to enable
communication with other collaborative editors using different protocols,
though currently Obby (for use with the Gobby editor) is the only
fully-functional one.")
(license license:gpl3+)))
(define-public emacs-hydra
(package
(name "emacs-hydra")

3
gnu/packages/fontutils.scm
View File

@ -426,8 +426,7 @@ resolution.")
(version "0.9.13")
(source (origin
(method url-fetch)
(uri (string-append
"mirror://savannah/releases/m17n/libotf-"
(uri (string-append "mirror://savannah/m17n/libotf-"
version ".tar.gz"))
(sha256
(base32 "0239zvfan56w7vrppriwy77fzb10ag9llaz15nsraps2a2x6di3v"))))

3
gnu/packages/gd.scm
View File

@ -50,7 +50,8 @@
(sha256
(base32
"0g3xz8jpz1pl2zzmssglrpa9nxiaa7rmcmvgpbrjz8k9cyynqsvl"))
(patches (search-patches "gd-fix-gd2-read-test.patch"
(patches (search-patches "gd-CVE-2016-7568.patch"
"gd-fix-gd2-read-test.patch"
"gd-fix-tests-on-i686.patch"))))
(build-system gnu-build-system)
(native-inputs

552
gnu/packages/haskell.scm
View File

File diff suppressed because it is too large Load Diff

142
gnu/packages/julia.scm
View File

@ -40,16 +40,17 @@
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages textutils)
#:use-module (gnu packages tls)
#:use-module (gnu packages version-control)
#:use-module (gnu packages wget)
#:use-module (ice-9 match))
(define libuv-julia
(let ((commit "efb40768b7c7bd9f173a7868f74b92b1c5a61a0e")
(revision "3"))
(let ((commit "8d5131b6c1595920dd30644cd1435b4f344b46c8")
(revision "4"))
(package (inherit libuv)
(name "libuv-julia")
(version (string-append "0.11.26." revision "-" (string-take commit 8)))
(version (string-append "1.9.0-" revision "." (string-take commit 8)))
(source (origin
(method git-fetch)
(uri (git-reference
@ -58,7 +59,7 @@
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"16k6pm2jl0ymz5j4ldxn94imdimahqqfd2izgr3zf1vwyyay77w3"))))
"1fq0vhiprdryw8iisxxwyld3xdr5za6y8458p22ff56al98h22fv"))))
(build-system gnu-build-system)
(arguments
(substitute-keyword-arguments (package-arguments libuv)
@ -67,10 +68,22 @@
(delete 'autogen)))))
(home-page "https://github.com/JuliaLang/libuv"))))
(define libunwind-for-julia
(package
(inherit libunwind)
(version "1.1-julia2")
(source (origin
(method url-fetch)
(uri (string-append "https://s3.amazonaws.com/julialang/src/"
"libunwind-" version ".tar.gz"))
(sha256
(base32
"0499x7sg2v18a6cry6l8y713cgmic0adnjph8i0xr1db9p7n8qyv"))))))
(define-public julia
(package
(name "julia")
(version "0.4.5")
(version "0.5.0")
(source (origin
(method url-fetch)
(uri (string-append
@ -78,7 +91,7 @@
version "/julia-" version ".tar.gz"))
(sha256
(base32
"09gc6yf3v4in0qwhrbgjrjgvblp941di0mli4zax22mvf4dzc7s4"))))
"0bhickil88lalp9jdj1kmf4is70zinhx8ha9rng0g3z50r4a2qmv"))))
(build-system gnu-build-system)
(arguments
`(#:test-target "test"
@ -86,6 +99,9 @@
(guix build gnu-build-system)
(guix build utils))
;; Do not strip binaries to keep support for full backtraces.
;; See https://github.com/JuliaLang/julia/issues/17831
#:strip-binaries? #f
;; The DSOs use $ORIGIN to refer to each other, but (guix build
;; gremlin) doesn't support it yet, so skip this phase.
@ -96,24 +112,33 @@
(delete 'configure)
(add-after 'unpack 'prepare-deps
(lambda* (#:key inputs #:allow-other-keys)
(copy-file (assoc-ref inputs "rmath-julia")
"deps/Rmath-julia-0.1.tar.gz")
(mkdir "deps/srccache")
(copy-file (assoc-ref inputs "dsfmt")
"deps/dsfmt-2.2.3.tar.gz")
"deps/srccache/dsfmt-2.2.3.tar.gz")
(copy-file (assoc-ref inputs "objconv")
"deps/objconv.zip")
"deps/srccache/objconv.zip")
(copy-file (assoc-ref inputs "suitesparse")
"deps/SuiteSparse-4.4.2.tar.gz")
(copy-file (assoc-ref inputs "virtualenv")
"deps/virtualenv-1.11.6.tar.gz")
"deps/srccache/SuiteSparse-4.4.5.tar.gz")
(copy-file (string-append (assoc-ref inputs "virtualenv")
"/bin/virtualenv")
"julia-env")
#t))
(add-after 'unpack 'fix-llvm-flag
(lambda _
(substitute* "src/Makefile"
(("-lLLVM-\\$\\(shell \\$\\(LLVM_CONFIG_HOST\\) --version\\)")
"$(shell $(LLVM_CONFIG_HOST) --libs)"))
#t))
(add-before 'check 'set-home
;; Some tests require a home directory to be set.
(lambda _ (setenv "HOME" "/tmp") #t))
(add-after 'unpack 'hardcode-soname-map
;; ./src/ccall.cpp creates a map from library names to paths using the
;; output of "/sbin/ldconfig -p". Since ldconfig is not used in Guix,
;; we patch ccall.cpp to contain a static map.
;; ./src/runtime_ccall.cpp creates a map from library names to paths
;; using the output of "/sbin/ldconfig -p". Since ldconfig is not
;; used in Guix, we patch runtime_ccall.cpp to contain a static map.
(lambda* (#:key inputs #:allow-other-keys)
(use-modules (ice-9 match))
(substitute* "src/ccall.cpp"
(substitute* "src/runtime_ccall.cpp"
(("jl_read_sonames.*;")
(string-join
(map (match-lambda
@ -133,6 +158,31 @@
("openspecfun" "libopenspecfun" "libopenspecfun.so")
("fftw" "libfftw3" "libfftw3.so")
("fftwf" "libfftw3f" "libfftw3f.so"))))))
(substitute* "base/fft/FFTW.jl"
(("const libfftw = Base.libfftw_name")
(string-append "const libfftw = \""
(assoc-ref inputs "fftw") "/lib/libfftw3.so"
"\""))
(("const libfftwf = Base.libfftwf_name")
(string-append "const libfftwf = \""
(assoc-ref inputs "fftwf") "/lib/libfftw3f.so"
"\"")))
(substitute* "base/math.jl"
(("const libm = Base.libm_name")
(string-append "const libm = \""
(assoc-ref inputs "openlibm")
"/lib/libopenlibm.so"
"\""))
(("const openspecfun = \"libopenspecfun\"")
(string-append "const openspecfun = \""
(assoc-ref inputs "openspecfun")
"/lib/libopenspecfun.so"
"\"")))
(substitute* "base/pcre.jl"
(("const PCRE_LIB = \"libpcre2-8\"")
(string-append "const PCRE_LIB = \""
(assoc-ref inputs "pcre2")
"/lib/libpcre2-8.so" "\"")))
#t))
(add-before 'build 'fix-include-and-link-paths
(lambda* (#:key inputs #:allow-other-keys)
@ -153,10 +203,6 @@
(assoc-ref %build-inputs "libuv")
"/lib/libuv.so ")))
(substitute* "deps/Makefile"
(("/usr/include/double-conversion")
(string-append (assoc-ref %build-inputs "double-conversion")
"/include/double-conversion")))
(substitute* "base/Makefile"
(("\\$\\(build_includedir\\)/uv-errno.h")
(string-append (assoc-ref inputs "libuv")
@ -176,15 +222,13 @@
(add-before 'check 'disable-broken-tests
(lambda _
(substitute* "test/choosetests.jl"
;; These tests time out. See
;; https://github.com/JuliaLang/julia/issues/14374 for ongoing
;; discussion.
(("\"replcompletions\",") "")
(("\"repl\",") ""))
(substitute* "test/repl.jl"
;; This test fails because we cannot escape the build
;; directory.
(("@test pwd\\(\\) == homedir\\(\\)") "#"))
;; These tests fail, probably because some of the input
;; binaries have been stripped and thus backtraces don't look
;; as expected.
(("\"backtrace\",") "")
(("\"compile\",") "")
(("\"replutil\",") "")
(("\"cmdlineargs\",") ""))
#t)))
#:make-flags
(list
@ -203,9 +247,6 @@
"CONFIG_SHELL=bash" ;needed to build bundled libraries
"USE_SYSTEM_DSFMT=0" ;not packaged for Guix and upstream has no
;build system for a shared library.
"USE_SYSTEM_RMATH=0" ;Julia uses a bundled version of R's math
;library, patched to use the DSFMT RNG.
"USE_SYSTEM_LAPACK=1"
"USE_SYSTEM_BLAS=1"
"USE_BLAS64=0" ;needed when USE_SYSTEM_BLAS=1
@ -222,7 +263,6 @@
;; "/include")
"USE_GPL_LIBS=1" ;proudly
"USE_SYSTEM_GRISU=1" ;for double-conversion
"USE_SYSTEM_UTF8PROC=1"
(string-append "UTF8PROC_INC="
(assoc-ref %build-inputs "utf8proc")
@ -245,15 +285,14 @@
"USE_SYSTEM_LIBGIT2=1"
"USE_SYSTEM_OPENSPECFUN=1")))
(inputs
`(("llvm" ,llvm-3.5)
`(("llvm" ,llvm)
("arpack-ng" ,arpack-ng)
("coreutils" ,coreutils) ;for bindings to "mkdir" and the like
("lapack" ,lapack)
("openblas" ,openblas) ;Julia does not build with Atlas
("libunwind" ,libunwind)
("libunwind" ,libunwind-for-julia)
("openlibm" ,openlibm)
("openspecfun" ,openspecfun)
("double-conversion" ,double-conversion)
("libgit2" ,libgit2)
("fftw" ,fftw)
("fftwf" ,fftwf)
@ -266,24 +305,19 @@
("which" ,which)
("zlib" ,zlib)
("gmp" ,gmp)
("virtualenv" ,python2-virtualenv)
;; FIXME: The following inputs are downloaded from upstream to allow us
;; to use the lightweight Julia release tarball. Ideally, these inputs
;; would eventually be replaced with proper Guix packages.
("rmath-julia"
,(origin
(method url-fetch)
(uri "https://api.github.com/repos/JuliaLang/Rmath-julia/tarball/v0.1")
(file-name "rmath-julia-0.1.tar.gz")
(sha256
(base32
"0ai5dhjc43zcvangz123ryxmlbm51s21rg13bllwyn98w67arhb4"))))
;; TODO: run "make -f contrib/repackage_system_suitesparse4.make" to copy static lib
("suitesparse"
,(origin
(method url-fetch)
(uri "http://faculty.cse.tamu.edu/davis/SuiteSparse/SuiteSparse-4.4.2.tar.gz")
(uri "http://faculty.cse.tamu.edu/davis/SuiteSparse/SuiteSparse-4.4.5.tar.gz")
(sha256
(base32
"1dg0qsv07n71nbn9cgcvn73933rgy1jnxw5bfqkwfq3bidk44cqc"))))
"1jcbxb8jx5wlcixzf6n5dca2rcfx6mlcms1k2rl5gp67ay3bix43"))))
("objconv"
,(origin
(method url-fetch)
@ -299,18 +333,10 @@
"SFMT/dSFMT-src-2.2.3.tar.gz"))
(sha256
(base32
"03kaqbjbi6viz0n33dk5jlf6ayxqlsq4804n7kwkndiga9s4hd42"))))
("virtualenv"
,(origin
(method url-fetch)
(uri (string-append "https://pypi.python.org/packages/24/cc/"
"a3cdf0a49ffcaef483b7e2511476aa520cf7260c199a6928fda6c43ba916/"
"virtualenv-1.11.6.tar.gz"))
(sha256
(base32
"1xq4prmg25n9cz5zcvbqx68lmc3kl39by582vd8pzs9f3qalqyiy"))))))
"03kaqbjbi6viz0n33dk5jlf6ayxqlsq4804n7kwkndiga9s4hd42"))))))
(native-inputs
`(("perl" ,perl)
`(("openssl" ,openssl)
("perl" ,perl)
("patchelf" ,patchelf)
("pkg-config" ,pkg-config)
("python" ,python-2)))

4
gnu/packages/libreoffice.scm
View File

@ -710,7 +710,7 @@ and to return information on pronunciations, meanings and synonyms.")
(define-public libreoffice
(package
(name "libreoffice")
(version "5.1.4.2")
(version "5.1.5.2")
(source
(origin
(method url-fetch)
@ -719,7 +719,7 @@ and to return information on pronunciations, meanings and synonyms.")
"http://download.documentfoundation.org/libreoffice/src/"
(version-prefix version 3) "/libreoffice-" version ".tar.xz"))
(sha256 (base32
"11c30y9gvsy5h3nh9pnciq57gi99plrmr6qp8hhdk2l5xmwlmrfa"))))
"1qg0dj0zwh5ifhmvv4k771nmyqddz4ifn75s9mr1p0nyix8zks8x"))))
(build-system gnu-build-system)
(native-inputs
`(;; autoreconf is run by the LibreOffice build system, since after

12
gnu/packages/linux.scm
View File

@ -321,14 +321,14 @@ It has been modified to remove all non-free binary blobs.")
(define %intel-compatible-systems '("x86_64-linux" "i686-linux"))
(define-public linux-libre
(make-linux-libre "4.7.5"
"1v5xzagc7zmf0dszq623h83rzhn2qwcapg2fwlihrrb6h9317xqx"
(make-linux-libre "4.7.6"
"0716lpzq3w2pdc0nrrx06gqzdfzhkrjq7g37v4ws9wjlzak8hkvy"
%intel-compatible-systems
#:configuration-file kernel-config))
(define-public linux-libre-4.4
(make-linux-libre "4.4.22"
"0pwqp5hain26p3wmiqgq3qasyp4j7nl2ai49sq2n8xdi3g2vnmii"
(make-linux-libre "4.4.23"
"07akixpxlcrpfsadnppyk2hbggqf7j2hzlkg56k0yh3dhyglxv86"
%intel-compatible-systems
#:configuration-file kernel-config))
@ -339,8 +339,8 @@ It has been modified to remove all non-free binary blobs.")
#:configuration-file kernel-config))
;; Avoid rebuilding kernel variants when there is a minor version bump.
(define %linux-libre-version "4.7.5")
(define %linux-libre-hash "1v5xzagc7zmf0dszq623h83rzhn2qwcapg2fwlihrrb6h9317xqx")
(define %linux-libre-version "4.7.6")
(define %linux-libre-hash "0716lpzq3w2pdc0nrrx06gqzdfzhkrjq7g37v4ws9wjlzak8hkvy")
(define-public linux-libre-arm-generic
(make-linux-libre %linux-libre-version

11
gnu/packages/password-utils.scm
View File

@ -109,6 +109,17 @@ algorithms AES or Twofish.")
(base32
"1y43yhgy2zbrk5bqj3qyx9rkcz2bma9sinlrg7dip3jqms9gq4lr"))))
(build-system gnu-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(add-after 'install 'wrap-shroud
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(ccachedir (string-append out "/lib/guile/2.0/ccache"))
(prog (string-append out "/bin/shroud")))
(wrap-program prog
`("GUILE_LOAD_COMPILED_PATH" ":" prefix (,ccachedir)))
#t))))))
(inputs
`(("guile" ,guile-2.0)
("gnupg" ,gnupg)

44
gnu/packages/patches/gd-CVE-2016-7568.patch Normal file
View File

@ -0,0 +1,44 @@
Fix CVE-2016-7568 (integer overflow in gdImageWebpCtx()):
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2016-7568
Patch copied from upstream source repository:
https://github.com/libgd/libgd/commit/2806adfdc27a94d333199345394d7c302952b95f
From 2806adfdc27a94d333199345394d7c302952b95f Mon Sep 17 00:00:00 2001
From: trylab <trylab@users.noreply.github.com>
Date: Tue, 6 Sep 2016 18:35:32 +0800
Subject: [PATCH] Fix integer overflow in gdImageWebpCtx
Integer overflow can be happened in expression gdImageSX(im) * 4 *
gdImageSY(im). It could lead to heap buffer overflow in the following
code. This issue has been reported to the PHP Bug Tracking System. The
proof-of-concept file will be supplied some days later. This issue was
discovered by Ke Liu of Tencent's Xuanwu LAB.
---
src/gd_webp.c | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/src/gd_webp.c b/src/gd_webp.c
index 8eb4dee..9886399 100644
--- a/src/gd_webp.c
+++ b/src/gd_webp.c
@@ -199,6 +199,14 @@ BGD_DECLARE(void) gdImageWebpCtx (gdImagePtr im, gdIOCtx * outfile, int quality)
quality = 80;
}
+ if (overflow2(gdImageSX(im), 4)) {
+ return;
+ }
+
+ if (overflow2(gdImageSX(im) * 4, gdImageSY(im))) {
+ return;
+ }
+
argb = (uint8_t *)gdMalloc(gdImageSX(im) * 4 * gdImageSY(im));
if (!argb) {
return;
--
2.10.0

77
gnu/packages/patches/libarchive-7zip-heap-overflow.patch Normal file
View File

@ -0,0 +1,77 @@
Fix buffer overflow reading 7Zip files:
https://github.com/libarchive/libarchive/issues/761
Patch copied from upstream repository:
https://github.com/libarchive/libarchive/commit/7f17c791dcfd8c0416e2cd2485b19410e47ef126
From 7f17c791dcfd8c0416e2cd2485b19410e47ef126 Mon Sep 17 00:00:00 2001
From: Tim Kientzle <kientzle@acm.org>
Date: Sun, 18 Sep 2016 18:14:58 -0700
Subject: [PATCH] Issue 761: Heap overflow reading corrupted 7Zip files
The sample file that demonstrated this had multiple 'EmptyStream'
attributes. The first one ended up being used to calculate
certain statistics, then was overwritten by the second which
was incompatible with those statistics.
The fix here is to reject any header with multiple EmptyStream
attributes. While here, also reject headers with multiple
EmptyFile, AntiFile, Name, or Attributes markers.
---
libarchive/archive_read_support_format_7zip.c | 10 ++++++++++
1 file changed, 10 insertions(+)
diff --git a/libarchive/archive_read_support_format_7zip.c b/libarchive/archive_read_support_format_7zip.c
index 1dfe52b..c0a536c 100644
--- a/libarchive/archive_read_support_format_7zip.c
+++ b/libarchive/archive_read_support_format_7zip.c
@@ -2431,6 +2431,8 @@ read_Header(struct archive_read *a, struct _7z_header_info *h,
switch (type) {
case kEmptyStream:
+ if (h->emptyStreamBools != NULL)
+ return (-1);
h->emptyStreamBools = calloc((size_t)zip->numFiles,
sizeof(*h->emptyStreamBools));
if (h->emptyStreamBools == NULL)
@@ -2451,6 +2453,8 @@ read_Header(struct archive_read *a, struct _7z_header_info *h,
return (-1);
break;
}
+ if (h->emptyFileBools != NULL)
+ return (-1);
h->emptyFileBools = calloc(empty_streams,
sizeof(*h->emptyFileBools));
if (h->emptyFileBools == NULL)
@@ -2465,6 +2469,8 @@ read_Header(struct archive_read *a, struct _7z_header_info *h,
return (-1);
break;
}
+ if (h->antiBools != NULL)
+ return (-1);
h->antiBools = calloc(empty_streams,
sizeof(*h->antiBools));
if (h->antiBools == NULL)
@@ -2491,6 +2497,8 @@ read_Header(struct archive_read *a, struct _7z_header_info *h,
if ((ll & 1) || ll < zip->numFiles * 4)
return (-1);
+ if (zip->entry_names != NULL)
+ return (-1);
zip->entry_names = malloc(ll);
if (zip->entry_names == NULL)
return (-1);
@@ -2543,6 +2551,8 @@ read_Header(struct archive_read *a, struct _7z_header_info *h,
if ((p = header_bytes(a, 2)) == NULL)
return (-1);
allAreDefined = *p;
+ if (h->attrBools != NULL)
+ return (-1);
h->attrBools = calloc((size_t)zip->numFiles,
sizeof(*h->attrBools));
if (h->attrBools == NULL)
--
2.10.0

445
gnu/packages/patches/libarchive-fix-filesystem-attacks.patch Normal file
View File

@ -0,0 +1,445 @@
This patch fixes two bugs that allow attackers to overwrite or change
the permissions of arbitrary files:
https://github.com/libarchive/libarchive/issues/745
https://github.com/libarchive/libarchive/issues/746
Patch copied from upstream repository:
https://github.com/libarchive/libarchive/commit/dfd6b54ce33960e420fb206d8872fb759b577ad9
From dfd6b54ce33960e420fb206d8872fb759b577ad9 Mon Sep 17 00:00:00 2001
From: Tim Kientzle <kientzle@acm.org>
Date: Sun, 11 Sep 2016 13:21:57 -0700
Subject: [PATCH] Fixes for Issue #745 and Issue #746 from Doran Moppert.
---
libarchive/archive_write_disk_posix.c | 294 ++++++++++++++++++++++++++--------
1 file changed, 227 insertions(+), 67 deletions(-)
diff --git a/libarchive/archive_write_disk_posix.c b/libarchive/archive_write_disk_posix.c
index 8f0421e..abe1a86 100644
--- a/libarchive/archive_write_disk_posix.c
+++ b/libarchive/archive_write_disk_posix.c
@@ -326,12 +326,14 @@ struct archive_write_disk {
#define HFS_BLOCKS(s) ((s) >> 12)
+static int check_symlinks_fsobj(char *path, int *error_number, struct archive_string *error_string, int flags);
static int check_symlinks(struct archive_write_disk *);
static int create_filesystem_object(struct archive_write_disk *);
static struct fixup_entry *current_fixup(struct archive_write_disk *, const char *pathname);
#if defined(HAVE_FCHDIR) && defined(PATH_MAX)
static void edit_deep_directories(struct archive_write_disk *ad);
#endif
+static int cleanup_pathname_fsobj(char *path, int *error_number, struct archive_string *error_string, int flags);
static int cleanup_pathname(struct archive_write_disk *);
static int create_dir(struct archive_write_disk *, char *);
static int create_parent_dir(struct archive_write_disk *, char *);
@@ -2014,6 +2016,10 @@ create_filesystem_object(struct archive_write_disk *a)
const char *linkname;
mode_t final_mode, mode;
int r;
+ /* these for check_symlinks_fsobj */
+ char *linkname_copy; /* non-const copy of linkname */
+ struct archive_string error_string;
+ int error_number;
/* We identify hard/symlinks according to the link names. */
/* Since link(2) and symlink(2) don't handle modes, we're done here. */
@@ -2022,6 +2028,27 @@ create_filesystem_object(struct archive_write_disk *a)
#if !HAVE_LINK
return (EPERM);
#else
+ archive_string_init(&error_string);
+ linkname_copy = strdup(linkname);
+ if (linkname_copy == NULL) {
+ return (EPERM);
+ }
+ /* TODO: consider using the cleaned-up path as the link target? */
+ r = cleanup_pathname_fsobj(linkname_copy, &error_number, &error_string, a->flags);
+ if (r != ARCHIVE_OK) {
+ archive_set_error(&a->archive, error_number, "%s", error_string.s);
+ free(linkname_copy);
+ /* EPERM is more appropriate than error_number for our callers */
+ return (EPERM);
+ }
+ r = check_symlinks_fsobj(linkname_copy, &error_number, &error_string, a->flags);
+ if (r != ARCHIVE_OK) {
+ archive_set_error(&a->archive, error_number, "%s", error_string.s);
+ free(linkname_copy);
+ /* EPERM is more appropriate than error_number for our callers */
+ return (EPERM);
+ }
+ free(linkname_copy);
r = link(linkname, a->name) ? errno : 0;
/*
* New cpio and pax formats allow hardlink entries
@@ -2362,115 +2389,228 @@ current_fixup(struct archive_write_disk *a, const char *pathname)
* recent paths.
*/
/* TODO: Extend this to support symlinks on Windows Vista and later. */
+
+/*
+ * Checks the given path to see if any elements along it are symlinks. Returns
+ * ARCHIVE_OK if there are none, otherwise puts an error in errmsg.
+ */
static int
-check_symlinks(struct archive_write_disk *a)
+check_symlinks_fsobj(char *path, int *error_number, struct archive_string *error_string, int flags)
{
#if !defined(HAVE_LSTAT)
/* Platform doesn't have lstat, so we can't look for symlinks. */
(void)a; /* UNUSED */
+ (void)path; /* UNUSED */
+ (void)error_number; /* UNUSED */
+ (void)error_string; /* UNUSED */
+ (void)flags; /* UNUSED */
return (ARCHIVE_OK);
#else
- char *pn;
+ int res = ARCHIVE_OK;
+ char *tail;
+ char *head;
+ int last;
char c;
int r;
struct stat st;
+ int restore_pwd;
+
+ /* Nothing to do here if name is empty */
+ if(path[0] == '\0')
+ return (ARCHIVE_OK);
/*
* Guard against symlink tricks. Reject any archive entry whose
* destination would be altered by a symlink.
+ *
+ * Walk the filename in chunks separated by '/'. For each segment:
+ * - if it doesn't exist, continue
+ * - if it's symlink, abort or remove it
+ * - if it's a directory and it's not the last chunk, cd into it
+ * As we go:
+ * head points to the current (relative) path
+ * tail points to the temporary \0 terminating the segment we're currently examining
+ * c holds what used to be in *tail
+ * last is 1 if this is the last tail
*/
- /* Whatever we checked last time doesn't need to be re-checked. */
- pn = a->name;
- if (archive_strlen(&(a->path_safe)) > 0) {
- char *p = a->path_safe.s;
- while ((*pn != '\0') && (*p == *pn))
- ++p, ++pn;
- }
+ restore_pwd = open(".", O_RDONLY | O_BINARY | O_CLOEXEC);
+ __archive_ensure_cloexec_flag(restore_pwd);
+ if (restore_pwd < 0)
+ return (ARCHIVE_FATAL);
+ head = path;
+ tail = path;
+ last = 0;
+ /* TODO: reintroduce a safe cache here? */
/* Skip the root directory if the path is absolute. */
- if(pn == a->name && pn[0] == '/')
- ++pn;
- c = pn[0];
- /* Keep going until we've checked the entire name. */
- while (pn[0] != '\0' && (pn[0] != '/' || pn[1] != '\0')) {
+ if(tail == path && tail[0] == '/')
+ ++tail;
+ /* Keep going until we've checked the entire name.
+ * head, tail, path all alias the same string, which is
+ * temporarily zeroed at tail, so be careful restoring the
+ * stashed (c=tail[0]) for error messages.
+ * Exiting the loop with break is okay; continue is not.
+ */
+ while (!last) {
+ /* Skip the separator we just consumed, plus any adjacent ones */
+ while (*tail == '/')
+ ++tail;
/* Skip the next path element. */
- while (*pn != '\0' && *pn != '/')
- ++pn;
- c = pn[0];
- pn[0] = '\0';
+ while (*tail != '\0' && *tail != '/')
+ ++tail;
+ /* is this the last path component? */
+ last = (tail[0] == '\0') || (tail[0] == '/' && tail[1] == '\0');
+ /* temporarily truncate the string here */
+ c = tail[0];
+ tail[0] = '\0';
/* Check that we haven't hit a symlink. */
- r = lstat(a->name, &st);
+ r = lstat(head, &st);
if (r != 0) {
+ tail[0] = c;
/* We've hit a dir that doesn't exist; stop now. */
if (errno == ENOENT) {
break;
} else {
- /* Note: This effectively disables deep directory
+ /* Treat any other error as fatal - best to be paranoid here
+ * Note: This effectively disables deep directory
* support when security checks are enabled.
* Otherwise, very long pathnames that trigger
* an error here could evade the sandbox.
* TODO: We could do better, but it would probably
* require merging the symlink checks with the
* deep-directory editing. */
- return (ARCHIVE_FAILED);
+ if (error_number) *error_number = errno;
+ if (error_string)
+ archive_string_sprintf(error_string,
+ "Could not stat %s",
+ path);
+ res = ARCHIVE_FAILED;
+ break;
+ }
+ } else if (S_ISDIR(st.st_mode)) {
+ if (!last) {
+ if (chdir(head) != 0) {
+ tail[0] = c;
+ if (error_number) *error_number = errno;
+ if (error_string)
+ archive_string_sprintf(error_string,
+ "Could not chdir %s",
+ path);
+ res = (ARCHIVE_FATAL);
+ break;
+ }
+ /* Our view is now from inside this dir: */
+ head = tail + 1;
}
} else if (S_ISLNK(st.st_mode)) {
- if (c == '\0') {
+ if (last) {
/*
* Last element is symlink; remove it
* so we can overwrite it with the
* item being extracted.
*/
- if (unlink(a->name)) {
- archive_set_error(&a->archive, errno,
- "Could not remove symlink %s",
- a->name);
- pn[0] = c;
- return (ARCHIVE_FAILED);
+ if (unlink(head)) {
+ tail[0] = c;
+ if (error_number) *error_number = errno;
+ if (error_string)
+ archive_string_sprintf(error_string,
+ "Could not remove symlink %s",
+ path);
+ res = ARCHIVE_FAILED;
+ break;
}
- a->pst = NULL;
/*
* Even if we did remove it, a warning
* is in order. The warning is silly,
* though, if we're just replacing one
* symlink with another symlink.
*/
- if (!S_ISLNK(a->mode)) {
- archive_set_error(&a->archive, 0,
- "Removing symlink %s",
- a->name);
+ tail[0] = c;
+ /* FIXME: not sure how important this is to restore
+ if (!S_ISLNK(path)) {
+ if (error_number) *error_number = 0;
+ if (error_string)
+ archive_string_sprintf(error_string,
+ "Removing symlink %s",
+ path);
}
+ */
/* Symlink gone. No more problem! */
- pn[0] = c;
- return (0);
- } else if (a->flags & ARCHIVE_EXTRACT_UNLINK) {
+ res = ARCHIVE_OK;
+ break;
+ } else if (flags & ARCHIVE_EXTRACT_UNLINK) {
/* User asked us to remove problems. */
- if (unlink(a->name) != 0) {
- archive_set_error(&a->archive, 0,
- "Cannot remove intervening symlink %s",
- a->name);
- pn[0] = c;
- return (ARCHIVE_FAILED);
+ if (unlink(head) != 0) {
+ tail[0] = c;
+ if (error_number) *error_number = 0;
+ if (error_string)
+ archive_string_sprintf(error_string,
+ "Cannot remove intervening symlink %s",
+ path);
+ res = ARCHIVE_FAILED;
+ break;
}
- a->pst = NULL;
+ tail[0] = c;
} else {
- archive_set_error(&a->archive, 0,
- "Cannot extract through symlink %s",
- a->name);
- pn[0] = c;
- return (ARCHIVE_FAILED);
+ tail[0] = c;
+ if (error_number) *error_number = 0;
+ if (error_string)
+ archive_string_sprintf(error_string,
+ "Cannot extract through symlink %s",
+ path);
+ res = ARCHIVE_FAILED;
+ break;
}
}
- pn[0] = c;
- if (pn[0] != '\0')
- pn++; /* Advance to the next segment. */
+ /* be sure to always maintain this */
+ tail[0] = c;
+ if (tail[0] != '\0')
+ tail++; /* Advance to the next segment. */
}
- pn[0] = c;
- /* We've checked and/or cleaned the whole path, so remember it. */
- archive_strcpy(&a->path_safe, a->name);
- return (ARCHIVE_OK);
+ /* Catches loop exits via break */
+ tail[0] = c;
+#ifdef HAVE_FCHDIR
+ /* If we changed directory above, restore it here. */
+ if (restore_pwd >= 0) {
+ r = fchdir(restore_pwd);
+ if (r != 0) {
+ if(error_number) *error_number = errno;
+ if(error_string)
+ archive_string_sprintf(error_string,
+ "chdir() failure");
+ }
+ close(restore_pwd);
+ restore_pwd = -1;
+ if (r != 0) {
+ res = (ARCHIVE_FATAL);
+ }
+ }
+#endif
+ /* TODO: reintroduce a safe cache here? */
+ return res;
#endif
}
+/*
+ * Check a->name for symlinks, returning ARCHIVE_OK if its clean, otherwise
+ * calls archive_set_error and returns ARCHIVE_{FATAL,FAILED}
+ */
+static int
+check_symlinks(struct archive_write_disk *a)
+{
+ struct archive_string error_string;
+ int error_number;
+ int rc;
+ archive_string_init(&error_string);
+ rc = check_symlinks_fsobj(a->name, &error_number, &error_string, a->flags);
+ if (rc != ARCHIVE_OK) {
+ archive_set_error(&a->archive, error_number, "%s", error_string.s);
+ }
+ archive_string_free(&error_string);
+ a->pst = NULL; /* to be safe */
+ return rc;
+}
+
+
#if defined(__CYGWIN__)
/*
* 1. Convert a path separator from '\' to '/' .
@@ -2544,15 +2684,17 @@ cleanup_pathname_win(struct archive_write_disk *a)
* is set) if the path is absolute.
*/
static int
-cleanup_pathname(struct archive_write_disk *a)
+cleanup_pathname_fsobj(char *path, int *error_number, struct archive_string *error_string, int flags)
{
char *dest, *src;
char separator = '\0';
- dest = src = a->name;
+ dest = src = path;
if (*src == '\0') {
- archive_set_error(&a->archive, ARCHIVE_ERRNO_MISC,
- "Invalid empty pathname");
+ if (error_number) *error_number = ARCHIVE_ERRNO_MISC;
+ if (error_string)
+ archive_string_sprintf(error_string,
+ "Invalid empty pathname");
return (ARCHIVE_FAILED);
}
@@ -2561,9 +2703,11 @@ cleanup_pathname(struct archive_write_disk *a)
#endif
/* Skip leading '/'. */
if (*src == '/') {
- if (a->flags & ARCHIVE_EXTRACT_SECURE_NOABSOLUTEPATHS) {
- archive_set_error(&a->archive, ARCHIVE_ERRNO_MISC,
- "Path is absolute");
+ if (flags & ARCHIVE_EXTRACT_SECURE_NOABSOLUTEPATHS) {
+ if (error_number) *error_number = ARCHIVE_ERRNO_MISC;
+ if (error_string)
+ archive_string_sprintf(error_string,
+ "Path is absolute");
return (ARCHIVE_FAILED);
}
@@ -2590,10 +2734,11 @@ cleanup_pathname(struct archive_write_disk *a)
} else if (src[1] == '.') {
if (src[2] == '/' || src[2] == '\0') {
/* Conditionally warn about '..' */
- if (a->flags & ARCHIVE_EXTRACT_SECURE_NODOTDOT) {
- archive_set_error(&a->archive,
- ARCHIVE_ERRNO_MISC,
- "Path contains '..'");
+ if (flags & ARCHIVE_EXTRACT_SECURE_NODOTDOT) {
+ if (error_number) *error_number = ARCHIVE_ERRNO_MISC;
+ if (error_string)
+ archive_string_sprintf(error_string,
+ "Path contains '..'");
return (ARCHIVE_FAILED);
}
}
@@ -2624,7 +2769,7 @@ cleanup_pathname(struct archive_write_disk *a)
* We've just copied zero or more path elements, not including the
* final '/'.
*/
- if (dest == a->name) {
+ if (dest == path) {
/*
* Nothing got copied. The path must have been something
* like '.' or '/' or './' or '/././././/./'.
@@ -2639,6 +2784,21 @@ cleanup_pathname(struct archive_write_disk *a)
return (ARCHIVE_OK);
}
+static int
+cleanup_pathname(struct archive_write_disk *a)
+{
+ struct archive_string error_string;
+ int error_number;
+ int rc;
+ archive_string_init(&error_string);
+ rc = cleanup_pathname_fsobj(a->name, &error_number, &error_string, a->flags);
+ if (rc != ARCHIVE_OK) {
+ archive_set_error(&a->archive, error_number, "%s", error_string.s);
+ }
+ archive_string_free(&error_string);
+ return rc;
+}
+
/*
* Create the parent directory of the specified path, assuming path
* is already in mutable storage.

60
gnu/packages/patches/libarchive-fix-symlink-check.patch Normal file
View File

@ -0,0 +1,60 @@
Make sure to check for symlinks even if the pathname is very long:
https://github.com/libarchive/libarchive/issues/744
Patch copied from upstream repository:
https://github.com/libarchive/libarchive/commit/1fa9c7bf90f0862036a99896b0501c381584451a
From 1fa9c7bf90f0862036a99896b0501c381584451a Mon Sep 17 00:00:00 2001
From: Tim Kientzle <kientzle@acm.org>
Date: Sun, 21 Aug 2016 17:11:45 -0700
Subject: [PATCH] Issue #744 (part of Issue #743): Enforce sandbox with very
long pathnames
Because check_symlinks is handled separately from the deep-directory
support, very long pathnames cause problems. Previously, the code
ignored most failures to lstat() a path component. In particular,
this led to check_symlinks always passing for very long paths, which
in turn provides a way to evade the symlink checks in the sandboxing
code.
We now fail on unrecognized lstat() failures, which plugs this
hole at the cost of disabling deep directory support when the
user requests sandboxing.
TODO: This probably cannot be completely fixed without
entirely reimplementing the deep directory support to
integrate the symlink checks. I want to reimplement the
deep directory hanlding someday anyway; openat() and
related system calls now provide a much cleaner way to
handle deep directories than the chdir approach used by this
code.
---
libarchive/archive_write_disk_posix.c | 12 +++++++++++-
1 file changed, 11 insertions(+), 1 deletion(-)
diff --git a/libarchive/archive_write_disk_posix.c b/libarchive/archive_write_disk_posix.c
index 39ee3b6..8f0421e 100644
--- a/libarchive/archive_write_disk_posix.c
+++ b/libarchive/archive_write_disk_posix.c
@@ -2401,8 +2401,18 @@ check_symlinks(struct archive_write_disk *a)
r = lstat(a->name, &st);
if (r != 0) {
/* We've hit a dir that doesn't exist; stop now. */
- if (errno == ENOENT)
+ if (errno == ENOENT) {
break;
+ } else {
+ /* Note: This effectively disables deep directory
+ * support when security checks are enabled.
+ * Otherwise, very long pathnames that trigger
+ * an error here could evade the sandbox.
+ * TODO: We could do better, but it would probably
+ * require merging the symlink checks with the
+ * deep-directory editing. */
+ return (ARCHIVE_FAILED);
+ }
} else if (S_ISLNK(st.st_mode)) {
if (c == '\0') {
/*

44
gnu/packages/patches/libarchive-safe_fprintf-buffer-overflow.patch Normal file
View File

@ -0,0 +1,44 @@
Fixes this buffer overflow:
https://github.com/libarchive/libarchive/commit/e37b620fe8f14535d737e89a4dcabaed4517bf1a
Patch copied from upstream source repository:
https://github.com/libarchive/libarchive/commit/e37b620fe8f14535d737e89a4dcabaed4517bf1a
From e37b620fe8f14535d737e89a4dcabaed4517bf1a Mon Sep 17 00:00:00 2001
From: Tim Kientzle <kientzle@acm.org>
Date: Sun, 21 Aug 2016 10:51:43 -0700
Subject: [PATCH] Issue #767: Buffer overflow printing a filename
The safe_fprintf function attempts to ensure clean output for an
arbitrary sequence of bytes by doing a trial conversion of the
multibyte characters to wide characters -- if the resulting wide
character is printable then we pass through the corresponding bytes
unaltered, otherwise, we convert them to C-style ASCII escapes.
The stack trace in Issue #767 suggest that the 20-byte buffer
was getting overflowed trying to format a non-printable multibyte
character. This should only happen if there is a valid multibyte
character of more than 5 bytes that was unprintable. (Each byte
would get expanded to a four-charcter octal-style escape of the form
"\123" resulting in >20 characters for the >5 byte multibyte character.)
I've not been able to reproduce this, but have expanded the conversion
buffer to 128 bytes on the belief that no multibyte character set
has a single character of more than 32 bytes.
---
tar/util.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/tar/util.c b/tar/util.c
index 9ff22f2..2b4aebe 100644
--- a/tar/util.c
+++ b/tar/util.c
@@ -182,7 +182,7 @@ safe_fprintf(FILE *f, const char *fmt, ...)
}
/* If our output buffer is full, dump it and keep going. */
- if (i > (sizeof(outbuff) - 20)) {
+ if (i > (sizeof(outbuff) - 128)) {
outbuff[i] = '\0';
fprintf(f, "%s", outbuff);
i = 0;

32
gnu/packages/patches/quickswitch-fix-dmenu-check.patch Normal file
View File

@ -0,0 +1,32 @@
Fix check for dmenu (open file mode, dependency on which).
See <https://github.com/proxypoke/quickswitch-for-i3/pull/24>.
--- quickswitch-i3-2.2/quickswitch.py 2016-09-18 19:59:10.257765542 +0200
+++ quickswitch-i3-2.2/quickswitch.py 2016-09-21 10:43:01.277577819 +0200
@@ -24,9 +24,10 @@
import argparse
import subprocess
-import os
import re
+from distutils.spawn import find_executable
+
try:
import i3
except ImportError:
@@ -37,11 +38,8 @@
def check_dmenu():
'''Check if dmenu is available.'''
- devnull = open(os.devnull)
- retcode = subprocess.call(["which", "dmenu"],
- stdout=devnull,
- stderr=devnull)
- return True if retcode == 0 else False
+ executable = find_executable("dmenu")
+ return executable != None
def dmenu(options, dmenu):

12
gnu/packages/shells.scm
View File

@ -281,8 +281,18 @@ ksh, and tcsh.")
(uri (pypi-uri "xonsh" version))
(sha256
(base32
"0byxd9kjl99q2pyvjh9jy18l0di1i35wr0qqgnw4i6jh6ig3zcki"))))
"0byxd9kjl99q2pyvjh9jy18l0di1i35wr0qqgnw4i6jh6ig3zcki"))
(modules '((guix build utils)))
(snippet
`(begin
;; Delete bundled ply.
(delete-file-recursively "xonsh/ply")
(substitute* '("setup.py")
(("'xonsh\\.ply',") ""))
#t))))
(build-system python-build-system)
(inputs
`(("python-ply" ,python-ply)))
(home-page "http://xon.sh/")
(synopsis "Python-ish shell")
(description

61
gnu/packages/statistics.scm
View File

@ -3042,6 +3042,31 @@ black-and-white. They are also designed to be perceived by readers with the
most common form of color blindness.")
(license license:x11)))
(define-public r-viridislite
(package
(name "r-viridislite")
(version "0.1.3")
(source
(origin
(method url-fetch)
(uri (cran-uri "viridisLite" version))
(sha256
(base32
"1b0fhj8i1m9jsz91gzag60k7vy7kk5xkdg31rc3h3spq96l66psp"))))
(properties `((upstream-name . "viridisLite")))
(build-system r-build-system)
(home-page "https://github.com/sjmgarnier/viridisLite")
(synopsis "Default color maps from matplotlib")
(description
"This package is a port of the new @code{matplotlib} color maps ('viridis',
'magma', 'plasma' and 'inferno') to R. matplotlib is a popular plotting
library for Python. These color maps are designed in such a way that they
will analytically be perfectly perceptually-uniform, both in regular form and
also when converted to black-and-white. They are also designed to be
perceived by readers with the most common form of color blindness. This is
the 'lite' version of the more complete @code{viridis} package.")
(license license:expat)))
(define-public r-tidyr
(package
(name "r-tidyr")
@ -3094,30 +3119,58 @@ and tidyr provides no margins or aggregation.")
It uses and relies on grid graphics and formal (S4) classes and methods.")
(license license:gpl2+)))
(define-public r-purrr
(package
(name "r-purrr")
(version "0.2.2")
(source
(origin
(method url-fetch)
(uri (cran-uri "purrr" version))
(sha256
(base32
"0lss8q733nv7s154wargm6vnxq55qygnxakib8xdj4jv0y86sxc3"))))
(build-system r-build-system)
(propagated-inputs
`(("r-bh" ,r-bh)
("r-dplyr" ,r-dplyr)
("r-lazyeval" ,r-lazyeval)
("r-magrittr" ,r-magrittr)
("r-rcpp" ,r-rcpp)))
(home-page "https://github.com/hadley/purrr")
(synopsis "Functional programming tools")
(description
"This package completes R's functional programming tools with missing
features present in other programming languages.")
(license license:gpl3+)))
(define-public r-plotly
(package
(name "r-plotly")
(version "3.6.0")
(version "4.5.2")
(source (origin
(method url-fetch)
(uri (cran-uri "plotly" version))
(sha256
(base32
"15hvqa0sf4z6l6vvr614zjszfphwpv66zpc665iyiynq0pd1jv2c"))))
"08shs0qhy9js0fpj3d4rzfbwmw11ki3z5vg8jszfm6m69mfkgzw1"))))
(build-system r-build-system)
(propagated-inputs
`(("r-base64enc" ,r-base64enc)
("r-digest" ,r-digest)
("r-dplyr" ,r-dplyr)
("r-ggplot2" ,r-ggplot2)
("r-hexbin" ,r-hexbin)
("r-htmlwidgets" ,r-htmlwidgets)
("r-httr" ,r-httr)
("r-jsonlite" ,r-jsonlite)
("r-lazyeval" ,r-lazyeval)
("r-magrittr" ,r-magrittr)
("r-plyr" ,r-plyr)
("r-purrr" ,r-purrr)
("r-scales" ,r-scales)
("r-tibble" ,r-tibble)
("r-tidyr" ,r-tidyr)
("r-viridis" ,r-viridis)))
("r-viridislite" ,r-viridislite)))
(home-page "https://plot.ly/r")
(synopsis "Create interactive web graphics")
(description

6
gnu/packages/textutils.scm
View File

@ -102,7 +102,7 @@ libenca and several charset conversion libraries and tools.")
(define-public utf8proc
(package
(name "utf8proc")
(version "1.3.1")
(version "2.0.2")
(source
(origin
(method url-fetch)
@ -111,7 +111,7 @@ libenca and several charset conversion libraries and tools.")
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32 "1k48as5kjkar4yj3dwxyll8ykj4k723ib5a6mnw1g86q3zi0zdl3"))))
(base32 "140vib1m6n5kwzkw1n9fbsi5gl6xymbd7yndwqx1sj15aakak776"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f ;no "check" target
@ -124,7 +124,7 @@ libenca and several charset conversion libraries and tools.")
(synopsis "C library for processing UTF-8 Unicode data")
(description "utf8proc is a small C library that provides Unicode
normalization, case-folding, and other operations for data in the UTF-8
encoding, supporting Unicode version 7.0.")
encoding, supporting Unicode version 9.0.0.")
(license license:expat)))
(define-public libgtextutils

4
gnu/packages/tmux.scm
View File

@ -32,7 +32,7 @@
(define-public tmux
(package
(name "tmux")
(version "2.2")
(version "2.3")
(source (origin
(method url-fetch)
(uri (string-append
@ -40,7 +40,7 @@
version "/tmux-" version ".tar.gz"))
(sha256
(base32
"1r0riry5vw604hc21087ffbkqgr6j4ia1rrsivz2k6grchdm8a5w"))))
"0aw5fcav8pa70ym391n4g6mh5vir34x35xhb09zdwhhg5w9kwcam"))))
(build-system gnu-build-system)
(inputs
`(("libevent" ,libevent)

4
gnu/packages/video.scm
View File

@ -403,14 +403,14 @@ standards (MPEG-2, MPEG-4 ASP/H.263, MPEG-4 AVC/H.264, and VC-1/VMW3).")
(define-public ffmpeg
(package
(name "ffmpeg")
(version "3.1.3")
(version "3.1.4")
(source (origin
(method url-fetch)
(uri (string-append "https://ffmpeg.org/releases/ffmpeg-"
version ".tar.xz"))
(sha256
(base32
"08l8290gipm632dhrqndnphdpkc5ncqc1j3hxdx46r1a3q3mqmzq"))))
"0nvb2k0maj5g8llfg47j8z5xpvp4q3g9pab2pp6vpjd5vmwb6358"))))
(build-system gnu-build-system)
(inputs
`(("fontconfig" ,fontconfig)

89
gnu/packages/wm.scm
View File

@ -11,6 +11,7 @@
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016 doncatnip <gnopap@gmail.com>
;;; Copyright © 2016 Ivan Vilata i Balaguer <ivan@selidor.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -35,6 +36,7 @@
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (guix build-system haskell)
#:use-module (guix build-system python)
#:use-module (gnu packages haskell)
#:use-module (gnu packages base)
#:use-module (gnu packages pkg-config)
@ -59,6 +61,7 @@
#:use-module (gnu packages gperf)
#:use-module (gnu packages imagemagick)
#:use-module (gnu packages lua)
#:use-module (gnu packages suckless)
#:use-module (guix download)
#:use-module (guix git-download))
@ -203,6 +206,92 @@ from scratch. i3 is primarily targeted at advanced users and
developers.")
(license license:bsd-3)))
(define-public python-i3-py
(package
(name "python-i3-py")
(version "0.6.5")
(source
(origin
;; The latest release is not tagged in Git nor has an entry in PyPi,
;; but there is still a clear commit for it, and it's been the last one
;; for years.
(method git-fetch)
(uri (git-reference
(url "https://github.com/ziberna/i3-py.git")
(commit "27f88a616e9ecc340e7d041d3d00782f8a1964c1")))
(sha256
(base32
"1nm719dc2xqlll7vj4c4m7mpjb27lpn3bg3c66gajvnrz2x1nmxs"))
(file-name (string-append name "-" version "-checkout"))))
(build-system python-build-system)
(arguments
`(#:tests? #f ; no tests yet
#:phases (modify-phases %standard-phases
(add-after 'install 'install-doc
;; Copy readme file to documentation directory.
(lambda* (#:key outputs #:allow-other-keys)
(let ((doc (string-append (assoc-ref outputs "out")
"/share/doc/" ,name)))
(install-file "README.md" doc)
;; Avoid unspecified return value.
#t))))))
(propagated-inputs
`(("i3-wm" ,i3-wm)))
(home-page "https://github.com/ziberna/i3-py")
(synopsis "Python interface to the i3 window manager")
(description "This package allows you to interact from a Python program
with the i3 window manager via its IPC socket. It can send commands and other
kinds of messages to i3, select the affected containers, filter results and
subscribe to events.")
(license license:gpl3+)))
(define-public python2-i3-py
(package-with-python2 python-i3-py))
(define-public quickswitch-i3
(let ((commit "ed692b1e8f43b95bd907ced26238ce8ccb2ed28f")
(revision "1")) ; Guix package revision
(package
(name "quickswitch-i3")
(version (string-append "2.2-" revision "."
(string-take commit 7)))
(source
(origin
;; The latest commit is a few years old and just a couple commits
;; after the last tagged release, so we use that latest commit
;; instead of the release.
(method git-fetch)
(uri (git-reference
(url "https://github.com/proxypoke/quickswitch-for-i3.git")
(commit commit)))
(sha256
(base32
"0447077sama80jcdg5p64zjsvafmz5rbdrirhm1adcdjhkh6iqc5"))
(patches (search-patches "quickswitch-fix-dmenu-check.patch"))
(file-name (string-append name "-" version "-checkout"))))
(build-system python-build-system)
(arguments
`(#:tests? #f ; no tests yet
#:phases (modify-phases %standard-phases
(add-after 'install 'install-doc
;; Copy readme file to documentation directory.
(lambda* (#:key outputs #:allow-other-keys)
(let ((doc (string-append (assoc-ref outputs "out")
"/share/doc/" ,name)))
(install-file "README.rst" doc)
;; Avoid unspecified return value.
#t))))))
(inputs
`(("python-i3-py" ,python-i3-py)
("dmenu" ,dmenu)))
(home-page "https://github.com/proxypoke/quickswitch-for-i3")
(synopsis "Quickly change to and locate windows in the i3 window manager")
(description
"This utility for the i3 window manager allows you to quickly switch to
and locate windows on all your workspaces, using an interactive dmenu
prompt.")
(license (license:non-copyleft "http://www.wtfpl.net/txt/copying/")))))
(define-public xmonad
(package
(name "xmonad")

119
gnu/services/admin.scm Normal file
View File

@ -0,0 +1,119 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016 Ludovic Courtès <ludo@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 thye GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services admin)
#:use-module (gnu packages admin)
#:use-module (gnu packages base)
#:use-module (gnu services)
#:use-module (gnu services mcron)
#:use-module (gnu services shepherd)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:export (%default-rotations
%rotated-files
rottlog-configuration
rottlog-configuration?
rottlog-service
rottlog-service-type))
;;; Commentary:
;;;
;;; This module implements configuration of rottlog by writing
;;; /etc/rottlog/{rc,hourly|daily|weekly}. Example usage
;;;
;;; (mcron-service)
;;; (service rottlog-service-type (rottlog-configuration))
;;;
;;; Code:
(define %rotated-files
;; Syslog files subject to rotation.
'("/var/log/messages" "/var/log/secure" "/var/log/maillog"))
(define (syslog-rotation-config files)
#~(string-append #$(string-join files ",")
" {
sharedscripts
postrotate
" #$coreutils "/bin/kill -HUP $(cat /var/run/syslog.pid) 2> /dev/null
endscript
}
"))
(define (simple-rotation-config file)
(string-append file " {
sharedscripts
}
"))
(define %default-rotations
`(("weekly"
,(computed-file "rottlog.weekly"
#~(call-with-output-file #$output
(lambda (port)
(display #$(syslog-rotation-config %rotated-files)
port)
(display #$(simple-rotation-config
"/var/log/shepherd.log")
port)))))))
(define (default-jobs rottlog)
(list #~(job '(next-hour '(0)) ;midnight
(lambda ()
(system* #$(file-append rottlog "/sbin/rottlog"))))
#~(job '(next-hour '(12)) ;noon
(lambda ()
(system* #$(file-append rottlog "/sbin/rottlog"))))))
(define-record-type* <rottlog-configuration>
rottlog-configuration make-rottlog-configuration
rottlog-configuration?
(rottlog rottlog-rottlog ;package
(default rottlog))
(rc-file rottlog-rc-file ;file-like
(default (file-append rottlog "/etc/rc")))
(periodic-rotations rottlog-periodic-rotations ;list of (name file) tuples
(default %default-rotations))
(jobs rottlog-jobs ;list of <mcron-job>
(default #f)))
(define (rottlog-etc config)
`(("rottlog" ,(file-union "rottlog"
(cons `("rc" ,(rottlog-rc-file config))
(rottlog-periodic-rotations config))))))
(define (rottlog-jobs-or-default config)
(or (rottlog-jobs config)
(default-jobs (rottlog-rottlog config))))
(define rottlog-service-type
(service-type
(name 'rottlog)
(extensions (list (service-extension etc-service-type rottlog-etc)
(service-extension mcron-service-type
rottlog-jobs-or-default)
;; Add Rottlog to the global profile so users can access
;; the documentation.
(service-extension profile-service-type
(compose list rottlog-rottlog))))))
;;; admin.scm ends here

4
gnu/services/nfs.scm
View File

@ -38,11 +38,11 @@
(shepherd-service-type
'rpcbind
(lambda (config)
(define pkg
(define nfs-utils
(rpcbind-configuration-rpcbind config))
(define rpcbind-command
#~(list (string-append #$pkg "/bin/rpcbind") "-f"
#~(list (string-append #$nfs-utils "/bin/rpcbind") "-f"
#$@(if (rpcbind-configuration-warm-start? config) '("-w") '())))
(shepherd-service

51
gnu/services/ssh.scm
View File

@ -50,7 +50,6 @@
;;;
;;; Code:
;; TODO: Export.
(define-record-type* <lsh-configuration>
lsh-configuration make-lsh-configuration
lsh-configuration?
@ -261,15 +260,24 @@ The other options should be self-descriptive."
(define-record-type* <openssh-configuration>
openssh-configuration make-openssh-configuration
openssh-configuration?
(pid-file openssh-configuration-pid-file) ;string
(port-number openssh-configuration-port-number) ;integer
(permit-root-login openssh-configuration-permit-root-login) ;Boolean | 'without-password
(allow-empty-passwords? openssh-configuration-allow-empty-passwords?) ;Boolean
(password-authentication? openssh-configuration-password-authentication?) ;Boolean
(pubkey-authentication? openssh-configuration-pubkey-authentication?) ;Boolean
(rsa-authentication? openssh-configuration-rsa-authentication?) ;Boolean
(x11-forwarding? openssh-configuration-x11-forwarding?) ;Boolean
(protocol-number openssh-configuration-protocol-number)) ;integer
(pid-file openssh-configuration-pid-file
(default "/var/run/sshd.pid"))
(port-number openssh-configuration-port-number ;integer
(default 22))
(permit-root-login openssh-configuration-permit-root-login ;Boolean | 'without-password
(default #f))
(allow-empty-passwords? openssh-configuration-allow-empty-passwords? ;Boolean
(default #f))
(password-authentication? openssh-configuration-password-authentication? ;Boolean
(default #t))
(public-key-authentication? openssh-configuration-public-key-authentication?
(default #t)) ;Boolean
(rsa-authentication? openssh-configuration-rsa-authentication? ;Boolean
(default #t))
(x11-forwarding? openssh-configuration-x11-forwarding? ;Boolean
(default #f))
(protocol-number openssh-configuration-protocol-number ;integer
(default 2)))
(define %openssh-accounts
(list (user-group (name "sshd") (system? #t))
@ -314,7 +322,7 @@ The other options should be self-descriptive."
#$(if (openssh-configuration-password-authentication? config)
"yes" "no"))
(format port "PubkeyAuthentication ~a\n"
#$(if (openssh-configuration-pubkey-authentication? config)
#$(if (openssh-configuration-public-key-authentication? config)
"yes" "no"))
(format port "RSAAuthentication ~a\n"
#$(if (openssh-configuration-rsa-authentication? config)
@ -354,27 +362,6 @@ The other options should be self-descriptive."
(service-extension account-service-type
(const %openssh-accounts))))))
(define* (openssh-service #:key
(pid-file "/var/run/sshd.pid")
(port-number 22)
(permit-root-login 'without-password)
(allow-empty-passwords? #f)
(password-authentication? #t)
(pubkey-authentication? #t)
(rsa-authentication? #t)
(x11-forwarding? #f)
(protocol-number 2))
(service openssh-service-type (openssh-configuration
(pid-file pid-file)
(port-number port-number)
(permit-root-login permit-root-login)
(allow-empty-passwords? allow-empty-passwords?)
(password-authentication? password-authentication?)
(pubkey-authentication? pubkey-authentication?)
(rsa-authentication? rsa-authentication?)
(x11-forwarding? x11-forwarding?)
(protocol-number protocol-number))))
;;;
;;; Dropbear.

193
gnu/tests/ssh.scm Normal file
View File

@ -0,0 +1,193 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@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 tests ssh)
#:use-module (gnu tests)
#:use-module (gnu system)
#:use-module (gnu system grub)
#:use-module (gnu system file-systems)
#:use-module (gnu system shadow)
#:use-module (gnu system vm)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu services ssh)
#:use-module (gnu services networking)
#:use-module (gnu packages ssh)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:export (%test-openssh
%test-dropbear))
(define %base-os
(operating-system
(host-name "komputilo")
(timezone "Europe/Berlin")
(locale "en_US.UTF-8")
(bootloader (grub-configuration (device "/dev/sdX")))
(file-systems %base-file-systems)
(firmware '())
(users %base-user-accounts)
(services (cons (dhcp-client-service)
%base-services))))
(define (os-with-service service)
"Return a test operating system that runs SERVICE."
(operating-system
(inherit %base-os)
(services (cons service
(operating-system-user-services %base-os)))))
(define (run-ssh-test name ssh-service pid-file)
"Run a test of an OS running SSH-SERVICE, which writes its PID to PID-FILE.
SSH-SERVICE must be configured to listen on port 22 and to allow for root and
empty-password logins."
(mlet* %store-monad ((os -> (marionette-operating-system
(os-with-service ssh-service)
#:imported-modules '((gnu services herd)
(guix combinators))))
(command (system-qemu-image/shared-store-script
os #:graphic? #f)))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(eval-when (expand load eval)
;; Prepare to use Guile-SSH.
(set! %load-path
(cons (string-append #$guile-ssh "/share/guile/site/"
(effective-version))
%load-path)))
(use-modules (gnu build marionette)
(srfi srfi-26)
(srfi srfi-64)
(ice-9 match)
(ssh session)
(ssh auth)
(ssh channel))
(define marionette
;; Enable TCP forwarding of the guest's port 22.
(make-marionette (list #$command "-net"
"user,hostfwd=tcp::2222-:22")))
(define (wait-for-file file)
;; Wait until FILE exists in the guest; 'read' its content and
;; return it.
(marionette-eval
`(let loop ((i 10))
(cond ((file-exists? ,file)
(call-with-input-file ,file read))
((> i 0)
(sleep 1)
(loop (- i 1)))
(else
(error "file didn't show up" ,file))))
marionette))
(mkdir #$output)
(chdir #$output)
(test-begin "ssh-daemon")
;; Wait for sshd to be up and running.
(test-eq "service running"
'running!
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'ssh-daemon)
'running!)
marionette))
;; Check sshd's PID file.
(test-equal "sshd PID"
(wait-for-file #$pid-file)
(marionette-eval
'(begin
(use-modules (gnu services herd)
(srfi srfi-1))
(live-service-running
(find (lambda (live)
(memq 'ssh-daemon
(live-service-provision live)))
(current-services))))
marionette))
;; Connect to the guest over SSH. We should be able to connect as
;; "root" with an empty password. Make sure we can run a shell
;; command there.
(test-equal "connect"
'hello
(let* ((session (make-session #:user "root"
#:port 2222 #:host "localhost"
#:log-verbosity 'protocol)))
(match (connect! session)
('ok
;; Try the simple authentication methods. Dropbear
;; requires 'none' when there are no passwords, whereas
;; OpenSSH accepts 'password' with an empty password.
(let loop ((methods (list (cut userauth-password! <> "")
(cut userauth-none! <>))))
(match methods
(()
(error "all the authentication methods failed"))
((auth rest ...)
(match (pk 'auth (auth session))
('success
;; FIXME: 'get-server-public-key' segfaults.
;; (get-server-public-key session)
(let ((channel (make-channel session)))
(channel-open-session channel)
(channel-request-exec channel
"echo hello > /root/witness")
(and (zero? (channel-get-exit-status channel))
(wait-for-file "/root/witness"))))
('denied
(loop rest))))))))))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation name test)))
(define %test-openssh
(system-test
(name "openssh")
(description "Connect to a running OpenSSH daemon.")
(value (run-ssh-test name
;; Allow root logins with an empty password to
;; simplify testing.
(service openssh-service-type
(openssh-configuration
(permit-root-login #t)
(allow-empty-passwords? #t)))
"/var/run/sshd.pid"))))
(define %test-dropbear
(system-test
(name "dropbear")
(description "Connect to a running Dropbear SSH daemon.")
(value (run-ssh-test name
(service dropbear-service-type
(dropbear-configuration
(root-login? #t)
(allow-empty-passwords? #t)))
"/var/run/dropbear.pid"))))

3
guix/build/pull.scm
View File

@ -125,6 +125,9 @@ containing the source code. Write any debugging output to DEBUG-PORT."
(newline)
(let ((mutex (make-mutex))
(completed 0))
;; Make sure compilation related modules are loaded before starting to
;; compile files in parallel.
(compile #f)
(par-for-each
(lambda (file)
(with-mutex mutex

6
tests/guix-build.sh
View File

@ -26,9 +26,9 @@ guix build --version
if guix build -e +;
then false; else true; fi
# Should fail because this is a source-less package.
if guix build -e '(@ (gnu packages bootstrap) %bootstrap-glibc)' -S
then false; else true; fi
# Source-less packages are accepted; they just return nothing.
guix build -e '(@ (gnu packages bootstrap) %bootstrap-glibc)' -S
test "`guix build -e '(@ (gnu packages bootstrap) %bootstrap-glibc)' -S`" = ""
# Should pass.
guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' | \