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-30 19:19:21 -04:00
parent a8dd960ac0 b89cbf5832
commit 205f0107bb
No known key found for this signature in database
GPG Key ID: 2646FA30BACA7F08
15 changed files with 286 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
doc/guix.texi
View File

@ -11920,6 +11920,17 @@ The Linux kernel image to boot, for example:
(file-append linux-libre "/bzImage")
@end example
It is also possible to specify a device explicitly in the file path
using GRUB's device naming convention (@pxref{Naming convention,,, grub,
GNU GRUB manual}), for example:
@example
"(hd0,msdos1)/boot/vmlinuz"
@end example
If the device is specified explicitly as above, then the @code{device}
field is ignored entirely.
@item @code{linux-arguments} (default: @code{()})
The list of extra Linux kernel command-line arguments---e.g.,
@code{("console=ttyS0")}.
@ -11928,6 +11939,22 @@ The list of extra Linux kernel command-line arguments---e.g.,
A G-Expression or string denoting the file name of the initial RAM disk
to use (@pxref{G-Expressions}).
@item @code{device} (default: @code{#f})
The device where the kernel and initrd are to be found---i.e., the GRUB
@dfn{root} for this menu entry (@pxref{root,,, grub, GNU GRUB manual}).
This may be a file system label (a string), a file system UUID (a
bytevector, @pxref{File Systems}), or @code{#f}, in which case GRUB will
search the device containing the file specified by the @code{linux}
field (@pxref{search,,, grub, GNU GRUB manual}). It must @emph{not} be
an OS device name such as @file{/dev/sda1}.
@item @code{device-mount-point} (default: @code{"/"})
The mount point of the above device on the system. You probably do not
need to change the default value. GuixSD uses it to strip the prefix of
store file names for systems where @file{/gnu} or @file{/gnu/store} is
on a separate partition.
@end table
@end deftp

1
gnu/local.mk
View File

@ -657,6 +657,7 @@ dist_patch_DATA = \
%D%/packages/patches/libtiff-CVE-2016-5314.patch \
%D%/packages/patches/libtiff-CVE-2016-5321.patch \
%D%/packages/patches/libtiff-CVE-2016-5323.patch \
%D%/packages/patches/libtiff-CVE-2016-5652.patch \
%D%/packages/patches/libtiff-oob-accesses-in-decode.patch \
%D%/packages/patches/libtiff-oob-write-in-nextdecode.patch \
%D%/packages/patches/libtool-skip-tests2.patch \

4
gnu/packages/emacs.scm
View File

@ -1652,14 +1652,14 @@ source code using IPython.")
(define-public emacs-debbugs
(package
(name "emacs-debbugs")
(version "0.9")
(version "0.11")
(source (origin
(method url-fetch)
(uri (string-append "https://elpa.gnu.org/packages/debbugs-"
version ".tar"))
(sha256
(base32
"1wc6kw7hihqqdx8qyl01akygycnan44x400hwrcf54m3hb4isa0k"))))
"10v9s7ayvfzd6j6hqfc9zihxgmsc2j0xhxrgy3ah30qkqn6z8w6n"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-async" ,emacs-async)))

19
gnu/packages/image.scm
View File

@ -186,6 +186,7 @@ extracting icontainer icon files.")
(define-public libtiff
(package
(name "libtiff")
(replacement libtiff/fixed)
(version "4.0.6")
(source (origin
(method url-fetch)
@ -225,6 +226,24 @@ collection of tools for doing simple manipulations of TIFF images.")
"See COPYRIGHT in the distribution."))
(home-page "http://www.remotesensing.org/libtiff/")))
(define libtiff/fixed
(package
(inherit libtiff)
(source (origin
(inherit (package-source libtiff))
(patches (search-patches
"libtiff-oob-accesses-in-decode.patch"
"libtiff-oob-write-in-nextdecode.patch"
"libtiff-CVE-2015-8665+CVE-2015-8683.patch"
"libtiff-CVE-2016-3623.patch"
"libtiff-CVE-2016-3945.patch"
"libtiff-CVE-2016-3990.patch"
"libtiff-CVE-2016-3991.patch"
"libtiff-CVE-2016-5314.patch"
"libtiff-CVE-2016-5321.patch"
"libtiff-CVE-2016-5323.patch"
"libtiff-CVE-2016-5652.patch"))))))
(define-public libwmf
(package
(name "libwmf")

11
gnu/packages/libusb.scm
View File

@ -105,7 +105,8 @@ version of libusb to run with newer libusb.")
(build-system python-build-system)
(arguments
`(#:tests? #f ;no tests
#:modules ((srfi srfi-26)
#:modules ((srfi srfi-1)
(srfi srfi-26)
(guix build utils)
(guix build python-build-system))
#:phases
@ -116,11 +117,9 @@ version of libusb to run with newer libusb.")
(("lib = locate_library\\(candidates, find_library\\)")
(string-append
"lib = \""
(car (find-files (assoc-ref inputs "libusb")
(lambda (file stat)
(and ((file-name-predicate
"^libusb-.*\\.so\\..*") file stat)
(not (symbolic-link? file))))))
(find (negate symbolic-link?)
(find-files (assoc-ref inputs "libusb")
"^libusb-.*\\.so\\..*"))
"\"")))
#t)))))
(inputs

34
gnu/packages/networking.scm
View File

@ -991,3 +991,37 @@ the bandwidth, loss, and other parameters.")
license:ncsa ; src/{units,iperf_locale,tcp_window_size}.c
license:expat ; src/{cjson,net}.[ch]
license:public-domain)))) ; src/portable_endian.h
(define-public nethogs
(package
(name "nethogs")
(version "0.8.5")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/raboof/nethogs/archive/v"
version ".tar.gz"))
(sha256
(base32
"1k4x8r7s4dgcb6n2rjn28h2yyij92mwm69phncl3597cdxr954va"))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system gnu-build-system)
(inputs
`(("libpcap" ,libpcap)
("ncurses" ,ncurses)))
(arguments
`(#:make-flags `("CC=gcc"
,(string-append "PREFIX=" %output))
#:phases
(modify-phases %standard-phases
(delete 'configure)))) ; No ./configure script.
(home-page "https://github.com/raboof/nethogs")
(synopsis "Per-process bandwidth monitor")
(description "NetHogs is a small 'net top' tool for Linux. Instead of
breaking the traffic down per protocol or per subnet, like most tools do, it
groups bandwidth by process.
NetHogs does not rely on a special kernel module to be loaded. If there's
suddenly a lot of network traffic, you can fire up NetHogs and immediately see
which PID is causing this. This makes it easy to identify programs that have
gone wild and are suddenly taking up your bandwidth.")
(license license:gpl2+)))

22
gnu/packages/package-management.scm
View File

@ -159,7 +159,17 @@
#t))))))
(native-inputs `(("pkg-config" ,pkg-config)
("emacs" ,emacs-minimal))) ;for guix.el
("emacs" ,emacs-minimal) ;for guix.el
;; XXX: Keep the development inputs here even though
;; they're unnecessary, just so that 'guix environment
;; guix' always contains them.
("autoconf" ,(autoconf-wrapper))
("automake" ,automake)
("gettext" ,gnu-gettext)
("texinfo" ,texinfo)
("graphviz" ,graphviz)
("help2man" ,help2man)))
(inputs
(let ((boot-guile (lambda (arch hash)
(origin
@ -243,15 +253,7 @@ the Nix package manager.")
(chmod po #o666))
(find-files "." "\\.po$"))
(zero? (system* "sh" "bootstrap"))))))))
(native-inputs
`(("autoconf" ,(autoconf-wrapper))
("automake" ,automake)
("gettext" ,gettext-minimal)
("texinfo" ,texinfo)
("graphviz" ,graphviz)
("help2man" ,help2man)
,@(package-native-inputs guix-0.11.0))))))
(zero? (system* "sh" "bootstrap")))))))))))
(define-public guix guix-devel)

47
gnu/packages/patches/libtiff-CVE-2016-5652.patch Normal file
View File

@ -0,0 +1,47 @@
Fix CVE-2016-5652 (buffer overflow in t2p_readwrite_pdf_image_tile()).
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2016-5652
Patches exfiltrated from upstream CVS repo with:
cvs diff -u -r 1.92 -r 1.94 tools/tiff2pdf.c
Index: tools/tiff2pdf.c
===================================================================
RCS file: /cvs/maptools/cvsroot/libtiff/tools/tiff2pdf.c,v
retrieving revision 1.92
retrieving revision 1.94
diff -u -r1.92 -r1.94
--- a/tools/tiff2pdf.c 23 Sep 2016 22:12:18 -0000 1.92
+++ b/tools/tiff2pdf.c 9 Oct 2016 11:03:36 -0000 1.94
@@ -2887,21 +2887,24 @@
return(0);
}
if(TIFFGetField(input, TIFFTAG_JPEGTABLES, &count, &jpt) != 0) {
- if (count > 0) {
- _TIFFmemcpy(buffer, jpt, count);
+ if (count >= 4) {
+ /* Ignore EOI marker of JpegTables */
+ _TIFFmemcpy(buffer, jpt, count - 2);
bufferoffset += count - 2;
+ /* Store last 2 bytes of the JpegTables */
table_end[0] = buffer[bufferoffset-2];
table_end[1] = buffer[bufferoffset-1];
- }
- if (count > 0) {
xuint32 = bufferoffset;
+ bufferoffset -= 2;
bufferoffset += TIFFReadRawTile(
input,
tile,
- (tdata_t) &(((unsigned char*)buffer)[bufferoffset-2]),
+ (tdata_t) &(((unsigned char*)buffer)[bufferoffset]),
-1);
- buffer[xuint32-2]=table_end[0];
- buffer[xuint32-1]=table_end[1];
+ /* Overwrite SOI marker of image scan with previously */
+ /* saved end of JpegTables */
+ buffer[xuint32-2]=table_end[0];
+ buffer[xuint32-1]=table_end[1];
} else {
bufferoffset += TIFFReadRawTile(
input,

29
gnu/packages/python.scm
View File

@ -5307,7 +5307,7 @@ connection to each user.")
(version "1.9.5")
(source (origin
(method url-fetch)
(uri (string-append "http://waf.io/"
(uri (string-append "https://waf.io/"
"waf-" version ".tar.bz2"))
(sha256
(base32
@ -11569,3 +11569,30 @@ useful as a validator for JSON data.")
(define-public python2-pyev
(package-with-python2 python-pyev))
(define-public python-imagesize
(package
(name "python-imagesize")
(version "0.7.1")
(source
(origin
(method url-fetch)
(uri (pypi-uri "imagesize" version))
(sha256
(base32
"0qk07k0z4241lkzzjji7z4da04pcvg7bfc4xz1934zlqhwmwdcha"))))
(build-system python-build-system)
(home-page "https://github.com/shibukawa/imagesize_py")
(synopsis "Gets image size of files in variaous formats in Python")
(description
"This package allows determination of image size from
PNG, JPEG, JPEG2000 and GIF files in pure Python.")
(license license:expat)
(properties `((python2-variant . ,(delay python2-imagesize))))))
(define-public python2-imagesize
(let ((base (package-with-python2 (strip-python2-variant python-imagesize))))
(package
(inherit base)
(native-inputs `(("python2-setuptools" ,python2-setuptools)
,@(package-native-inputs base))))))

8
gnu/packages/samba.scm
View File

@ -98,14 +98,14 @@ anywhere.")
(define-public samba
(package
(name "samba")
(version "4.5.0")
(version "4.5.1")
(source (origin
(method url-fetch)
(uri (string-append "https://download.samba.org/pub/samba/stable/samba-"
version ".tar.gz"))
(uri (string-append "https://download.samba.org/pub/samba/stable/"
"samba-" version ".tar.gz"))
(sha256
(base32
"11mmyqag2i4yy6dikcggw776n0laxxr0rxhry72x5pa6nwws9afk"))))
"11ghsfvqxzfv8gnl62jfnpil9cwd04gak8sx5qcg6zv7d7h079xh"))))
(build-system gnu-build-system)
(arguments
'(#:phases

6
gnu/packages/version-control.scm
View File

@ -112,14 +112,14 @@ as well as the classic centralized workflow.")
(define-public git
(package
(name "git")
(version "2.10.1")
(version "2.10.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://kernel.org/software/scm/git/git-"
version ".tar.xz"))
(sha256
(base32
"1ijd1b6szvfw0dmqa3dz1m5g5hbkl9xkb86a9qcjrz0w0vwjvhx9"))))
"0wc64dzcxrzgi6kwcljz6y3cwm3ajdgf6aws7g58azbhvl1jk04l"))))
(build-system gnu-build-system)
(native-inputs
`(("native-perl" ,perl)
@ -132,7 +132,7 @@ as well as the classic centralized workflow.")
version ".tar.xz"))
(sha256
(base32
"049n4ashc1i0rzg19zw1h4hf1qhv1vhpjr5c3jqdcljj4yp7mzw9"))))))
"0vxaz23vf3ki0q5zgn6mxr9x1hjryqn1hsmgyrgdk6h3yqbs7c43"))))))
(inputs
`(("curl" ,curl)
("expat" ,expat)

49
gnu/system.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -99,6 +100,8 @@
boot-parameters?
boot-parameters-label
boot-parameters-root-device
boot-parameters-store-device
boot-parameters-store-mount-point
boot-parameters-kernel
boot-parameters-kernel-arguments
boot-parameters-initrd
@ -728,6 +731,12 @@ listed in OS. The C library expects to find it under
(file-system-device root-fs)))
(entries -> (list (menu-entry
(label label)
;; The device where the kernel and initrd live.
(device (file-system-device store-fs))
(device-mount-point
(file-system-mount-point store-fs))
(linux kernel)
(linux-arguments
(cons* (string-append "--root=" root-device)
@ -736,8 +745,7 @@ listed in OS. The C library expects to find it under
"/boot")
(operating-system-kernel-arguments os)))
(initrd initrd)))))
(grub-configuration-file (operating-system-bootloader os)
store-fs entries
(grub-configuration-file (operating-system-bootloader os) entries
#:old-entries old-entries)))
(define (operating-system-parameters-file os)
@ -745,16 +753,24 @@ listed in OS. The C library expects to find it under
this file is the reconstruction of GRUB menu entries for old configurations."
(mlet %store-monad ((initrd (operating-system-initrd-file os))
(root -> (operating-system-root-file-system os))
(store -> (operating-system-store-file-system os))
(label -> (kernel->grub-label
(operating-system-kernel os))))
(gexp->file "parameters"
#~(boot-parameters (version 0)
#~(boot-parameters
(version 0)
(label #$label)
(root-device #$(file-system-device root))
(kernel #$(operating-system-kernel-file os))
(kernel-arguments
#$(operating-system-kernel-arguments os))
(initrd #$initrd))
(initrd #$initrd)
(store
(device #$(case (file-system-title store)
((uuid) (file-system-device store))
((label) (file-system-device store))
(else #f)))
(mount-point #$(file-system-mount-point store))))
#:set-load-path? #f)))
@ -765,7 +781,16 @@ this file is the reconstruction of GRUB menu entries for old configurations."
(define-record-type* <boot-parameters>
boot-parameters make-boot-parameters boot-parameters?
(label boot-parameters-label)
;; Because we will use the 'store-device' to create the GRUB search command,
;; the 'store-device' has slightly different semantics than 'root-device'.
;; The 'store-device' can be a file system uuid, a file system label, or #f,
;; but it cannot be a device path such as "/dev/sda3", since GRUB would not
;; understand that. The 'root-device', on the other hand, corresponds
;; exactly to the device field of the <file-system> object representing the
;; OS's root file system, so it might be a device path like "/dev/sda3".
(root-device boot-parameters-root-device)
(store-device boot-parameters-store-device)
(store-mount-point boot-parameters-store-mount-point)
(kernel boot-parameters-kernel)
(kernel-arguments boot-parameters-kernel-arguments)
(initrd boot-parameters-initrd))
@ -799,7 +824,21 @@ this file is the reconstruction of GRUB menu entries for old configurations."
(('initrd ('string-append directory file)) ;the old format
(string-append directory file))
(('initrd (? string? file))
file)))))
file)))
(store-device
(match (assq 'store rest)
(('store ('device device) _ ...)
device)
(_ ;the old format
root)))
(store-mount-point
(match (assq 'store rest)
(('store ('device _) ('mount-point mount-point) _ ...)
mount-point)
(_ ;the old format
"/")))))
(x ;unsupported format
(warning (_ "unrecognized boot parameters for '~a'~%")
system)

75
gnu/system/grub.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -32,6 +33,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (rnrs bytevectors)
#:export (grub-image
grub-image?
grub-image-aspect-ratio
@ -61,16 +63,15 @@
;;;
;;; Code:
(define (strip-mount-point fs file)
"Strip the mount point of FS from FILE, which is a gexp or other lowerable
object denoting a file name."
(let ((mount-point (file-system-mount-point fs)))
(define (strip-mount-point mount-point file)
"Strip MOUNT-POINT from FILE, which is a gexp or other lowerable object
denoting a file name."
(if (string=? mount-point "/")
file
#~(let ((file #$file))
(if (string-prefix? #$mount-point file)
(substring #$file #$(string-length mount-point))
file)))))
file))))
(define-record-type* <grub-image>
grub-image make-grub-image
@ -121,6 +122,10 @@ object denoting a file name."
menu-entry make-menu-entry
menu-entry?
(label menu-entry-label)
(device menu-entry-device ; file system uuid, label, or #f
(default #f))
(device-mount-point menu-entry-device-mount-point
(default "/"))
(linux menu-entry-linux)
(linux-arguments menu-entry-linux-arguments
(default '())) ; list of string-valued gexps
@ -162,12 +167,14 @@ WIDTH/HEIGHT, or #f if none was found."
(with-monad %store-monad
(return #f)))))
(define (eye-candy config root-fs system port)
(define* (eye-candy config store-device store-mount-point
#:key system port)
"Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the
'grub.cfg' part concerned with graphics mode, background images, colors, and
all that. ROOT-FS is a file-system object denoting the root file system where
the store is. SYSTEM must be the target system string---e.g.,
\"x86_64-linux\"."
all that. STORE-DEVICE designates the device holding the store, and
STORE-MOUNT-POINT is its mount point; these are used to determine where the
background image and fonts must be searched for. SYSTEM must be the target
system string---e.g., \"x86_64-linux\"."
(define setup-gfxterm-body
;; Intel systems need to be switched into graphics mode, whereas most
;; other modern architectures have no other mode and therefore don't need
@ -191,7 +198,7 @@ the store is. SYSTEM must be the target system string---e.g.,
(symbol->string (assoc-ref colors 'bg)))))
(define font-file
(strip-mount-point root-fs
(strip-mount-point store-mount-point
(file-append grub "/share/grub/unicode.pf2")))
(mlet* %store-monad ((image (grub-background-image config)))
@ -215,10 +222,10 @@ else
set menu_color_highlight=white/blue
fi~%"
#$setup-gfxterm-body
#$(grub-root-search root-fs font-file)
#$(grub-root-search store-device font-file)
#$font-file
#$(strip-mount-point root-fs image)
#$(strip-mount-point store-mount-point image)
#$(theme-colors grub-theme-color-normal)
#$(theme-colors grub-theme-color-highlight))))))
@ -227,8 +234,8 @@ fi~%"
;;; Configuration file.
;;;
(define (grub-root-search root-fs file)
"Return the GRUB 'search' command to look for ROOT-FS, which contains FILE,
(define (grub-root-search device file)
"Return the GRUB 'search' command to look for DEVICE, which contains FILE,
a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
code."
;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
@ -236,20 +243,18 @@ code."
;; custom menu entries. In the latter case, don't emit a 'search' command.
(if (and (string? file) (not (string-prefix? "/" file)))
""
(case (file-system-title root-fs)
;; Preferably refer to ROOT-FS by its UUID or label. This is more
(match device
;; Preferably refer to DEVICE by its UUID or label. This is more
;; efficient and less ambiguous, see <>.
((uuid)
((? bytevector? uuid)
(format #f "search --fs-uuid --set ~a"
(uuid->string (file-system-device root-fs))))
((label)
(format #f "search --label --set ~a"
(file-system-device root-fs)))
(else
;; As a last resort, look for any device containing FILE.
(uuid->string device)))
((? string? label)
(format #f "search --label --set ~a" label))
(#f
#~(format #f "search --file --set ~a" #$file)))))
(define* (grub-configuration-file config store-fs entries
(define* (grub-configuration-file config entries
#:key
(system (%current-system))
(old-entries '()))
@ -262,22 +267,30 @@ corresponding to old generations of the system."
(define entry->gexp
(match-lambda
(($ <menu-entry> label linux arguments initrd)
;; Use the right file names for LINUX and STORE-FS in case STORE-FS is
;; not the "/" file system.
(let ((linux (strip-mount-point store-fs linux))
(initrd (strip-mount-point store-fs initrd)))
(($ <menu-entry> label device device-mount-point
linux arguments initrd)
;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
;; Use the right file names for LINUX and INITRD in case
;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
;; separate partition.
(let ((linux (strip-mount-point device-mount-point linux))
(initrd (strip-mount-point device-mount-point initrd)))
#~(format port "menuentry ~s {
~a
linux ~a ~a
initrd ~a
}~%"
#$label
#$(grub-root-search store-fs linux)
#$(grub-root-search device linux)
#$linux (string-join (list #$@arguments))
#$initrd)))))
(mlet %store-monad ((sugar (eye-candy config store-fs system #~port)))
(mlet %store-monad ((sugar (eye-candy config
(menu-entry-device (first entries))
(menu-entry-device-mount-point
(first entries))
#:system system
#:port #~port)))
(define builder
#~(call-with-output-file #$output
(lambda (port)

6
guix/profiles.scm
View File

@ -490,12 +490,12 @@ if not found."
inputs))
(define (find-among-store-items items)
(find (lambda (item)
(let-values (((pkg-name pkg-version)
(let-values (((name* version*)
(package-name->name+version
(store-path-package-name item))))
(and (equal? name pkg-name)
(and (string=? name name*)
(if version
(string-prefix? version pkg-version)
(string-prefix? version version*)
#t))))
items))

3
guix/scripts/system.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -384,6 +385,8 @@ it atomically, and then run OS's activation script."
(label (string-append label " (#"
(number->string number) ", "
(seconds->string time) ")"))
(device (boot-parameters-store-device params))
(device-mount-point (boot-parameters-store-mount-point params))
(linux kernel)
(linux-arguments
(cons* (string-append "--root=" root-device)