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:
Marius Bakke 2017-06-10 02:57:50 +02:00
parent 202342fdda 8caf5bac4c
commit ea45e2c500
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
38 changed files with 1102 additions and 378 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Makefile.am
View File

@ -201,6 +201,13 @@ MODULES += \
endif HAVE_GUILE_SSH
if HAVE_GUILE_GIT
MODULES += \
guix/git.scm
endif HAVE_GUILE_GIT
if BUILD_DAEMON_OFFLOAD
MODULES += \

52
build-aux/build-self.scm
View File

@ -97,6 +97,13 @@ Guile major version (2.0 or 2.2), or #f if none of the packages matches."
"guile2.2-ssh"
"guile2.0-ssh"))
(define guile-git
(package-for-current-guile "guile-git"
"guile2.0-git"))
(define guile-bytestructures
(package-for-current-guile "guile-bytestructures"
"guile2.0-bytestructures"))
;; The actual build procedure.
@ -148,19 +155,42 @@ files."
#~(begin
(use-modules (guix build pull))
(let ((json (string-append #$guile-json "/share/guile/site/"
#$(effective-version))))
(letrec-syntax ((maybe-load-path
(syntax-rules ()
((_ item rest ...)
(let ((tail (maybe-load-path rest ...)))
(if (string? item)
(cons (string-append item
"/share/guile/site/"
#$(effective-version))
tail)
tail)))
((_)
'()))))
(set! %load-path
(cons* json
(string-append #$guile-ssh "/share/guile/site/"
#$(effective-version))
%load-path))
(append
(maybe-load-path #$guile-json #$guile-ssh
#$guile-git #$guile-bytestructures)
%load-path)))
(letrec-syntax ((maybe-load-compiled-path
(syntax-rules ()
((_ item rest ...)
(let ((tail (maybe-load-compiled-path rest ...)))
(if (string? item)
(cons (string-append item
"/lib/guile/"
#$(effective-version)
"/site-ccache")
tail)
tail)))
((_)
'()))))
(set! %load-compiled-path
(cons* json
(string-append #$guile-ssh "/lib/guile/"
#$(effective-version)
"/site-ccache")
%load-compiled-path)))
(append
(maybe-load-compiled-path #$guile-json #$guile-ssh
#$guile-git #$guile-bytestructures)
%load-compiled-path)))
;; XXX: The 'guile-ssh' package prior to Guix commit 92b7258 was
;; broken: libguile-ssh could not be found. Work around that.

4
configure.ac
View File

@ -104,6 +104,10 @@ dnl Guile-JSON is used in various places.
GUILE_MODULE_AVAILABLE([have_guile_json], [(json)])
AM_CONDITIONAL([HAVE_GUILE_JSON], [test "x$have_guile_json" = "xyes"])
dnl Check for Guile-Git.
GUILE_MODULE_AVAILABLE([have_guile_git], [(git)])
AM_CONDITIONAL([HAVE_GUILE_GIT], [test "x$have_guile_git" = "xyes"])
dnl Make sure we have a full-fledged Guile.
GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads])

185
doc/guix.texi
View File

@ -37,7 +37,8 @@ Copyright @copyright{} 2017 Carlo Zancanaro@*
Copyright @copyright{} 2017 Thomas Danckaert@*
Copyright @copyright{} 2017 humanitiesNerd@*
Copyright @copyright{} 2017 Christopher Allan Webber@*
Copyright @copyright{} 2017 Marius Bakke
Copyright @copyright{} 2017 Marius Bakke@*
Copyright @copyright{} 2017 Hartmut Goebel
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -138,7 +139,7 @@ Programming Interface
Defining Packages
* package Reference:: The package data type.
* package Reference :: The package data type.
* origin Reference:: The origin data type.
Utilities
@ -163,6 +164,7 @@ Invoking @command{guix build}
* Common Build Options:: Build options for most commands.
* Package Transformation Options:: Creating variants of packages.
* Additional Build Options:: Options specific to 'guix build'.
* Debugging Build Failures:: Real life packaging experience.
GNU Distribution
@ -199,7 +201,7 @@ System Configuration
* X.509 Certificates:: Authenticating HTTPS servers.
* Name Service Switch:: Configuring libc's name service switch.
* Initial RAM Disk:: Linux-Libre bootstrapping.
* GRUB Configuration:: Configuring the boot loader.
* Bootloader Configuration:: Configuring the boot loader.
* Invoking guix system:: Instantiating a system configuration.
* Running GuixSD in a VM:: How to run GuixSD in a virtual machine.
* Defining Services:: Adding new service definitions.
@ -4866,7 +4868,7 @@ described in the subsections below.
* Common Build Options:: Build options for most commands.
* Package Transformation Options:: Creating variants of packages.
* Additional Build Options:: Options specific to 'guix build'.
* Debugging Build Failures:: Real life packaging experience
* Debugging Build Failures:: Real life packaging experience.
@end menu
@node Common Build Options
@ -7797,7 +7799,7 @@ instance to support new system services.
* X.509 Certificates:: Authenticating HTTPS servers.
* Name Service Switch:: Configuring libc's name service switch.
* Initial RAM Disk:: Linux-Libre bootstrapping.
* GRUB Configuration:: Configuring the boot loader.
* Bootloader Configuration:: Configuring the boot loader.
* Invoking guix system:: Instantiating a system configuration.
* Running GuixSD in a VM:: How to run GuixSD in a virtual machine.
* Defining Services:: Adding new service definitions.
@ -7980,7 +7982,7 @@ system, should you ever need to.
Speaking of roll-back, each time you run @command{guix system
reconfigure}, a new @dfn{generation} of the system is created---without
modifying or deleting previous generations. Old system generations get
an entry in the GRUB boot menu, allowing you to boot them in case
an entry in the bootloader boot menu, allowing you to boot them in case
something went wrong with the latest generation. Reassuring, no? The
@command{guix system list-generations} command lists the system
generations available on disk. It is also possible to roll back the
@ -8036,7 +8038,7 @@ List of strings or gexps representing additional arguments to pass on
the command-line of the kernel---e.g., @code{("console=ttyS0")}.
@item @code{bootloader}
The system bootloader configuration object. @xref{GRUB Configuration}.
The system bootloader configuration object. @xref{Bootloader Configuration}.
@item @code{initrd} (default: @code{base-initrd})
@cindex initrd
@ -15711,32 +15713,52 @@ upon booting. All the derivations referenced by @var{exp} are
automatically copied to the initrd.
@end deffn
@node GRUB Configuration
@subsection GRUB Configuration
@node Bootloader Configuration
@subsection Bootloader Configuration
@cindex GRUB
@cindex bootloader
@cindex boot loader
The operating system uses GNU@tie{}GRUB as its boot loader
(@pxref{Overview, overview of GRUB,, grub, GNU GRUB Manual}). It is
configured using a @code{grub-configuration} declaration. This data type
is exported by the @code{(gnu system grub)} module and described below.
The operating system supports multiple bootloaders. The bootloader is
configured using @code{bootloader-configuration} declaration. All the
fields of this structure are bootloader agnostic except for one field,
@code{bootloader} that indicates the bootloader to be configured and
installed.
@deftp {Data Type} grub-configuration
The type of a GRUB configuration declaration.
Some of the bootloaders do not honor every field of
@code{bootloader-configuration}. For instance, the extlinux
bootloader does not support themes and thus ignores the @code{theme}
field.
@deftp {Data Type} bootloader-configuration
The type of a bootloader configuration declaration.
@table @asis
@item @code{bootloader}
@cindex EFI, bootloader
@cindex UEFI, bootloader
@cindex BIOS, bootloader
The bootloader to use, as a @code{bootloader} object. For now
@code{grub-bootloader}, @code{grub-efi-bootloader} and
@code{extlinux-bootloader} are supported. @code{grub-efi-bootloader},
allows to boot on modern systems using the @dfn{Unified Extensible
Firmware Interface} (UEFI).
Available bootloaders are described in @code{(gnu bootloader @dots{})}
modules.
@item @code{device}
This is a string denoting the boot device. It must be a device name
understood by the @command{grub-install} command, such as
@code{/dev/sda} or @code{(hd0)} (@pxref{Invoking grub-install,,, grub,
understood by the bootloader @command{installer} command, such as
@code{/dev/sda} or @code{(hd0)} (for GRUB, @pxref{Invoking grub-install,,, grub,
GNU GRUB Manual}).
@item @code{menu-entries} (default: @code{()})
A possibly empty list of @code{menu-entry} objects (see below), denoting
entries to appear in the GRUB boot menu, in addition to the current
entries to appear in the bootloader menu, in addition to the current
system entry and the entry pointing to previous system generations.
generations.
@item @code{default-entry} (default: @code{0})
The index of the default boot menu entry. Index 0 is for the entry of the
@ -15746,42 +15768,37 @@ current system.
The number of seconds to wait for keyboard input before booting. Set to
0 to boot immediately, and to -1 to wait indefinitely.
@item @code{theme} (default: @var{%default-theme})
The @code{grub-theme} object describing the theme to use.
@item @code{grub} (default: @code{grub})
@cindex EFI, bootloader
@cindex UEFI, bootloader
@cindex BIOS, bootloader
The GRUB package to use. Currently either @code{grub}, for ``legacy''
x86 BIOS systems, or @code{grub-efi}, for modern systems using the
@dfn{Unified Extensible Firmware Interface} (UEFI).
@item @code{theme} (default: @var{#f})
The bootloader theme object describing the theme to use. If no theme
is provided, some bootloaders might use a default theme, that's true
for GRUB.
@item @code{terminal-outputs} (default: @code{'gfxterm})
The output terminals used for the GRUB boot menu, as a list of symbols.
These values are accepted: @code{console}, @code{serial},
@code{serial_@{0-3@}}, @code{gfxterm}, @code{vga_text}, @code{mda_text},
@code{morse}, and @code{pkmodem}. This field corresponds to the GRUB
variable GRUB_TERMINAL_OUTPUT (@pxref{Simple configuration,,, grub,GNU
GRUB manual}).
The output terminals used for the bootloader boot menu, as a list of
symbols. GRUB accepts the values: @code{console}, @code{serial},
@code{serial_@{0-3@}}, @code{gfxterm}, @code{vga_text},
@code{mda_text}, @code{morse}, and @code{pkmodem}. This field
corresponds to the GRUB variable GRUB_TERMINAL_OUTPUT (@pxref{Simple
configuration,,, grub,GNU GRUB manual}).
@item @code{terminal-inputs} (default: @code{'()})
The input terminals used for the GRUB boot menu, as a list of symbols.
The default is the native platform terminal as determined by GRUB at
run-time. These values are accepted: @code{console}, @code{serial},
@code{serial_@{0-3@}}, @code{at_keyboard}, and @code{usb_keyboard}.
This field corresponds to the GRUB variable GRUB_TERMINAL_INPUT
(@pxref{Simple configuration,,, grub,GNU GRUB manual}).
The input terminals used for the bootloader boot menu, as a list of
symbols. For GRUB, the default is the native platform terminal as
determined at run-time. GRUB accepts the values: @code{console},
@code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
@code{usb_keyboard}. This field corresponds to the GRUB variable
GRUB_TERMINAL_INPUT (@pxref{Simple configuration,,, grub,GNU GRUB
manual}).
@item @code{serial-unit} (default: @code{#f})
The serial unit used by GRUB, as an integer from 0 to 3. The default
value is chosen by GRUB at run-time; currently GRUB chooses 0, which
The serial unit used by the bootloader, as an integer from 0 to 3.
For GRUB it is choosen at run-time; currently GRUB chooses 0, which
corresponds to COM1 (@pxref{Serial terminal,,, grub,GNU GRUB manual}).
@item @code{serial-speed} (default: @code{#f})
The speed of the serial interface, as an integer. The default value is
chosen by GRUB at run-time; currently GRUB chooses 9600@tie{}bps
(@pxref{Serial terminal,,, grub,GNU GRUB manual}).
The speed of the serial interface, as an integer. For GRUB, the
default value is chosen at run-time; currently GRUB chooses
9600@tie{}bps (@pxref{Serial terminal,,, grub,GNU GRUB manual}).
@end table
@end deftp
@ -15805,7 +15822,7 @@ along these lines:
Details below.
@deftp {Data Type} menu-entry
The type of an entry in the GRUB boot menu.
The type of an entry in the bootloader menu.
@table @asis
@ -15819,9 +15836,9 @@ 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:
For GRUB, 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"
@ -15837,33 +15854,30 @@ The list of extra Linux kernel command-line arguments---e.g.,
@item @code{initrd}
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
The device where the kernel and initrd are to be found---i.e., for 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.
bytevector, @pxref{File Systems}), or @code{#f}, in which case
the bootloader 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}.
@end table
@end deftp
@c FIXME: Write documentation once it's stable.
Themes are created using the @code{grub-theme} form, which is not
documented yet.
Fow now only GRUB has theme support. GRUB themes are created using
the @code{grub-theme} form, which is not documented yet.
@defvr {Scheme Variable} %default-theme
This is the default GRUB theme used by the operating system, with a
fancy background image displaying the GNU and Guix logos.
This is the default GRUB theme used by the operating system if no
@code{theme} field is specified in @code{bootloader-configuration}
record.
It comes with a fancy background image displaying the GNU and Guix
logos.
@end defvr
@ -15903,9 +15917,10 @@ list-generations}). If that generation already exists, it will be
overwritten. This behavior mirrors that of @command{guix package}
(@pxref{Invoking guix package}).
It also adds a GRUB menu entry for the new OS configuration, and moves
entries for older configurations to a submenu---unless
@option{--no-bootloader} is passed.
It also adds a bootloader menu entry for the new OS configuration,
---unless @option{--no-bootloader} is passed. For GRUB, it moves
entries for older configurations to a submenu, allowing you to choose
an older system generation at boot time should you need it.
@quotation Note
@c The paragraph below refers to the problem discussed at
@ -15919,11 +15934,16 @@ once @command{reconfigure} has completed.
@item switch-generation
@cindex generations
Switch to an existing system generation. This action atomically
switches the system profile to the specified system generation. It also
rearranges the system's existing GRUB menu entries. It makes the menu
entry for the specified system generation the default, and it moves the
entries for the other generations to a submenu. The next time the
system boots, it will use the specified system generation.
switches the system profile to the specified system generation. It
also rearranges the system's existing bootloader menu entries. It
makes the menu entry for the specified system generation the default,
and it moves the entries for the other generatiors to a submenu, if
supported by the bootloader being used. The next time the system
boots, it will use the specified system generation.
The bootloader itself is not being reinstalled when using this
command. Thus, the installed bootloader is used with an updated
configuration file.
The target generation can be specified explicitly by its generation
number. For example, the following invocation would switch to system
@ -15945,11 +15965,11 @@ guix system switch-generation -- -1
@end example
Currently, the effect of invoking this action is @emph{only} to switch
the system profile to an existing generation and rearrange the GRUB menu
entries. To actually start using the target system generation, you must
reboot after running this action. In the future, it will be updated to
do the same things as @command{reconfigure}, like activating and
deactivating services.
the system profile to an existing generation and rearrange the
bootloader menu entries. To actually start using the target system
generation, you must reboot after running this action. In the future,
it will be updated to do the same things as @command{reconfigure},
like activating and deactivating services.
This action will fail if the specified generation does not exist.
@ -15984,8 +16004,9 @@ files, packages, and so on. It also creates other essential files
needed for the system to operate correctly---e.g., the @file{/etc},
@file{/var}, and @file{/run} directories, and the @file{/bin/sh} file.
This command also installs GRUB on the device specified in
@file{my-os-config}, unless the @option{--no-bootloader} option was passed.
This command also installs bootloader on the device specified in
@file{my-os-config}, unless the @option{--no-bootloader} option was
passed.
@item vm
@cindex virtual machine
@ -16125,7 +16146,7 @@ build users of the daemon (@pxref{Build Environment Setup}).
Once you have built, configured, re-configured, and re-re-configured
your GuixSD installation, you may find it useful to list the operating
system generations available on disk---and that you can choose from the
GRUB boot menu:
bootloader boot menu:
@table @code

20
gnu/artwork.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;;
;;; This file is part of GNU Guix.
;;;
@ -28,13 +29,16 @@
;;; Code:
(define %artwork-repository
(origin
(method git-fetch)
(uri (git-reference
(url "git://git.savannah.gnu.org/guix/guix-artwork.git")
(commit "6998d30")))
(sha256
(base32
"0k7j3pj9s3zqiqmfkapypssvzx3f12yr0cc2rbzxqfii0b4clp1j"))))
(let ((commit "6998d30425289b087c64f63e7415df2241e591db"))
(origin
(method git-fetch)
(uri (git-reference
(url "git://git.savannah.gnu.org/guix/guix-artwork.git")
(commit commit)))
(file-name (string-append "guix-artwork-" (string-take commit 7)
"-checkout"))
(sha256
(base32
"0k7j3pj9s3zqiqmfkapypssvzx3f12yr0cc2rbzxqfii0b4clp1j")))))
;;; artwork.scm ends here

26
gnu/bootloader.scm
View File

@ -23,7 +23,15 @@
#:use-module (guix records)
#:use-module (guix ui)
#:use-module (srfi srfi-1)
#:export (bootloader
#:export (menu-entry
menu-entry?
menu-entry-label
menu-entry-device
menu-entry-linux
menu-entry-linux-arguments
menu-entry-initrd
bootloader
bootloader?
bootloader-name
bootloader-package
@ -48,6 +56,22 @@
%bootloaders
lookup-bootloader-by-name))
;;;
;;; Menu-entry record.
;;;
(define-record-type* <menu-entry>
menu-entry make-menu-entry
menu-entry?
(label menu-entry-label)
(device menu-entry-device ; file system uuid, label, or #f
(default #f))
(linux menu-entry-linux)
(linux-arguments menu-entry-linux-arguments
(default '())) ; list of string-valued gexps
(initrd menu-entry-initrd)) ; file name of the initrd as a gexp
;;;
;;; Bootloader record.

3
gnu/bootloader/extlinux.scm
View File

@ -37,7 +37,8 @@
corresponding to old generations of the system."
(define all-entries
(append entries (bootloader-configuration-menu-entries config)))
(append entries (map menu-entry->boot-parameters
(bootloader-configuration-menu-entries config))))
(define (boot-parameters->gexp params)
(let ((label (boot-parameters-label params))

75
gnu/bootloader/grub.scm
View File

@ -66,12 +66,15 @@
(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))))
(match mount-point
((? string? mount-point)
(if (string=? mount-point "/")
file
#~(let ((file #$file))
(if (string-prefix? #$mount-point file)
(substring #$file #$(string-length mount-point))
file))))
(#f file)))
(define-record-type* <grub-image>
grub-image make-grub-image
@ -103,19 +106,6 @@ denoting a file name."
(color-highlight '((fg . yellow) (bg . black)))
(color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030
(define-record-type* <menu-entry>
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
(initrd menu-entry-initrd)) ; file name of the initrd as a gexp
;;;
;;; Background image & themes.
@ -312,16 +302,6 @@ code."
(#f
#~(format #f "search --file --set ~a" #$file)))))
(define (boot-parameters->menu-entry conf)
"Convert a <boot-parameters> instance to a corresponding <menu-entry>."
(menu-entry
(label (boot-parameters-label conf))
(device (boot-parameters-store-device conf))
(device-mount-point (boot-parameters-store-mount-point conf))
(linux (boot-parameters-kernel conf))
(linux-arguments (boot-parameters-kernel-arguments conf))
(initrd (boot-parameters-initrd conf))))
(define* (grub-configuration-file config entries
#:key
(system (%current-system))
@ -331,33 +311,36 @@ code."
STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
entries corresponding to old generations of the system."
(define all-entries
(map boot-parameters->menu-entry
(append entries
(bootloader-configuration-menu-entries config))))
(append entries (map menu-entry->boot-parameters
(bootloader-configuration-menu-entries config))))
(define entry->gexp
(match-lambda
(($ <menu-entry> label device device-mount-point
linux arguments initrd)
(define (boot-parameters->gexp params)
(let ((device (boot-parameters-store-device params))
(device-mount-point (boot-parameters-store-mount-point params))
(label (boot-parameters-label params))
(kernel (boot-parameters-kernel params))
(arguments (boot-parameters-kernel-arguments params))
(initrd (boot-parameters-initrd params)))
;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
;; Use the right file names for LINUX and INITRD in case
;; Use the right file names for KERNEL 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)))
(let ((kernel (strip-mount-point device-mount-point kernel))
(initrd (strip-mount-point device-mount-point initrd)))
#~(format port "menuentry ~s {
~a
linux ~a ~a
initrd ~a
}~%"
#$label
#$(grub-root-search device linux)
#$linux (string-join (list #$@arguments))
#$initrd)))))
#$(grub-root-search device kernel)
#$kernel (string-join (list #$@arguments))
#$initrd))))
(mlet %store-monad ((sugar (eye-candy config
(menu-entry-device (first all-entries))
(menu-entry-device-mount-point
(boot-parameters-store-device
(first all-entries))
(boot-parameters-store-mount-point
(first all-entries))
#:system system
#:port #~port)))
@ -374,12 +357,12 @@ set default=~a
set timeout=~a~%"
#$(bootloader-configuration-default-entry config)
#$(bootloader-configuration-timeout config))
#$@(map entry->gexp all-entries)
#$@(map boot-parameters->gexp all-entries)
#$@(if (pair? old-entries)
#~((format port "
submenu \"GNU system, old configurations...\" {~%")
#$@(map entry->gexp (map boot-parameters->menu-entry old-entries))
#$@(map boot-parameters->gexp old-entries)
(format port "}~%"))
#~()))))

22
gnu/build/file-systems.scm
View File

@ -43,6 +43,7 @@
uuid->string
string->uuid
string->iso9660-uuid
bind-mount
@ -235,6 +236,27 @@ Trailing spaces are trimmed."
;; <http://www.ecma-international.org/publications/files/ECMA-ST/Ecma-119.pdf>.
(define %iso9660-uuid-rx
;; Y m d H M S ss
(make-regexp "^([[:digit:]]{4})-([[:digit:]]{2})-([[:digit:]]{2})-([[:digit:]]{2})-([[:digit:]]{2})-([[:digit:]]{2})-([[:digit:]]{2})$"))
(define (string->iso9660-uuid str)
"Parse STR as a ISO9660 UUID (which is really a timestamp - see /dev/disk/by-uuid).
Return its contents as a 16-byte bytevector. Return #f if STR is not a valid
ISO9660 UUID representation."
(and=> (regexp-exec %iso9660-uuid-rx str)
(lambda (match)
(letrec-syntax ((match-numerals
(syntax-rules ()
((_ index (name rest ...) body)
(let ((name (match:substring match index)))
(match-numerals (+ 1 index) (rest ...) body)))
((_ index () body)
body))))
(match-numerals 1 (year month day hour minute second hundredths)
(string->utf8 (string-append year month day
hour minute second hundredths)))))))
(define (iso9660-superblock? sblock)
"Return #t when SBLOCK is an iso9660 volume descriptor."
(bytevector=? (sub-bytevector sblock 1 6)

4
gnu/local.mk
View File

@ -256,7 +256,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/man.scm \
%D%/packages/mail.scm \
%D%/packages/make-bootstrap.scm \
%D%/packages/markdown.scm \
%D%/packages/markup.scm \
%D%/packages/marst.scm \
%D%/packages/mate.scm \
%D%/packages/maths.scm \
@ -504,7 +504,6 @@ dist_patch_DATA = \
%D%/packages/patches/agg-am_c_prototype.patch \
%D%/packages/patches/antiword-CVE-2014-8123.patch \
%D%/packages/patches/apr-skip-getservbyname-test.patch \
%D%/packages/patches/artanis-fix-Makefile.in.patch \
%D%/packages/patches/aspell-default-dict-dir.patch \
%D%/packages/patches/ath9k-htc-firmware-binutils.patch \
%D%/packages/patches/ath9k-htc-firmware-gcc.patch \
@ -945,6 +944,7 @@ dist_patch_DATA = \
%D%/packages/patches/qtscript-disable-tests.patch \
%D%/packages/patches/quickswitch-fix-dmenu-check.patch \
%D%/packages/patches/rapicorn-isnan.patch \
%D%/packages/patches/raptor2-heap-overflow.patch \
%D%/packages/patches/ratpoison-shell.patch \
%D%/packages/patches/rcs-5.9.4-noreturn.patch \
%D%/packages/patches/readline-link-ncurses.patch \

6
gnu/packages/astronomy.scm
View File

@ -93,7 +93,7 @@ systems in a FITS image header.")
(define-public gnuastro
(package
(name "gnuastro")
(version "0.2")
(version "0.3")
(source
(origin
(method url-fetch)
@ -101,7 +101,7 @@ systems in a FITS image header.")
version ".tar.gz"))
(sha256
(base32
"0099g7zqg1gr9y94ybhyjgx9pkn9zv4rj1xb00fkybfw8w6ij9iv"))))
"109xjwbs36gbkx5sd5yzf6ailfcldc5d28vl1n19z0ylfzww4nwa"))))
(inputs
`(("cfitsio" ,cfitsio)
("gsl" ,gsl)
@ -109,7 +109,7 @@ systems in a FITS image header.")
("wcslib" ,wcslib)))
(build-system gnu-build-system)
(home-page "https://www.gnu.org/software/gnuastro/")
(synopsis "Astronomical data manipulation programs")
(synopsis "Astronomy utilities")
(description "The GNU Astronomy Utilities (Gnuastro) is a suite of
programs for the manipulation and analysis of astronomical data.")
(license license:gpl3+)))

313
gnu/packages/bioinformatics.scm
View File

@ -85,6 +85,7 @@
#:use-module (gnu packages ruby)
#:use-module (gnu packages serialization)
#:use-module (gnu packages statistics)
#:use-module (gnu packages swig)
#:use-module (gnu packages tbb)
#:use-module (gnu packages tex)
#:use-module (gnu packages texinfo)
@ -2093,7 +2094,7 @@ identify enrichments with functional annotations of the genome.")
(define-public diamond
(package
(name "diamond")
(version "0.9.3")
(version "0.9.6")
(source (origin
(method url-fetch)
(uri (string-append
@ -2102,7 +2103,7 @@ identify enrichments with functional annotations of the genome.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1fs5ilvda50vfdg9wll35w8hcpq3jlkp8q2kim4llkwljkj8bls3"))))
"1y8a10b695pvgn7kk2s87jdwbdf7iszpnr6139pw8ina1ajs4w8y"))))
(build-system cmake-build-system)
(arguments
'(#:tests? #f ; no "check" target
@ -9223,3 +9224,311 @@ working with SAM and BAM files. Current parallelised functionality is
an important subset of samtools functionality, including view, index,
sort, markdup, and depth.")
(license license:gpl2+)))
(define-public ritornello
(package
(name "ritornello")
(version "1.0.0")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/KlugerLab/"
"Ritornello/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"02nik86gq9ljjriv6pamwlmqnfky3ads1fpklx6mc3hx6k40pg38"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; there are no tests
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-samtools-references
(lambda* (#:key inputs #:allow-other-keys)
(substitute* '("src/SamStream.h"
"src/BufferedGenomeReader.h")
(("<sam.h>") "<samtools/sam.h>"))
#t))
(delete 'configure)
(replace 'install
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin/")))
(mkdir-p bin)
(install-file "bin/Ritornello" bin)
#t))))))
(inputs
`(("samtools" ,samtools-0.1)
("fftw" ,fftw)
("boost" ,boost)
("zlib" ,zlib)))
(home-page "https://github.com/KlugerLab/Ritornello")
(synopsis "Control-free peak caller for ChIP-seq data")
(description "Ritornello is a ChIP-seq peak calling algorithm based on
signal processing that can accurately call binding events without the need to
do a pair total DNA input or IgG control sample. It has been tested for use
with narrow binding events such as transcription factor ChIP-seq.")
(license license:gpl3+)))
(define-public trim-galore
(package
(name "trim-galore")
(version "0.4.2")
(source
(origin
(method url-fetch)
(uri (string-append "http://www.bioinformatics.babraham.ac.uk/"
"projects/trim_galore/trim_galore_v"
version ".zip"))
(sha256
(base32
"0b9qdxi4521gsrjvbhgky8g7kry9b5nx3byzaxkgxz7p4k8bn1mn"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no tests
#:phases
(modify-phases %standard-phases
;; The archive contains plain files.
(replace 'unpack
(lambda* (#:key source #:allow-other-keys)
(zero? (system* "unzip" source))))
(delete 'configure)
(delete 'build)
(add-after 'unpack 'hardcode-tool-references
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "trim_galore"
(("\\$path_to_cutadapt = 'cutadapt'")
(string-append "$path_to_cutadapt = '"
(assoc-ref inputs "cutadapt")
"/bin/cutadapt'"))
(("\\| gzip")
(string-append "| "
(assoc-ref inputs "gzip")
"/bin/gzip"))
(("\"gunzip")
(string-append "\""
(assoc-ref inputs "gzip")
"/bin/gunzip")))
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((bin (string-append (assoc-ref outputs "out")
"/bin")))
(mkdir-p bin)
(install-file "trim_galore" bin)
#t))))))
(inputs
`(("gzip" ,gzip)
("perl" ,perl)
("cutadapt" ,cutadapt)))
(native-inputs
`(("unzip" ,unzip)))
(home-page "http://www.bioinformatics.babraham.ac.uk/projects/trim_galore/")
(synopsis "Wrapper around Cutadapt and FastQC")
(description "Trim Galore! is a wrapper script to automate quality and
adapter trimming as well as quality control, with some added functionality to
remove biased methylation positions for RRBS sequence files.")
(license license:gpl3+)))
(define-public gess
(package
(name "gess")
(version "1.0")
(source (origin
(method url-fetch)
(uri (string-append "http://compbio.uthscsa.edu/"
"GESS_Web/files/"
"gess-" version ".src.tar.gz"))
(sha256
(base32
"0hyk403kxscclzfs24pvdgiv0wm03kjcziqdrp5w46cb049gz0d7"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no tests
#:phases
(modify-phases %standard-phases
(delete 'configure)
(delete 'build)
(replace 'install
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((python (assoc-ref inputs "python"))
(out (assoc-ref outputs "out"))
(bin (string-append out "/bin/"))
(target (string-append
out "/lib/python2.7/site-packages/gess/")))
(mkdir-p target)
(copy-recursively "." target)
;; Make GESS.py executable
(chmod (string-append target "GESS.py") #o555)
;; Add Python shebang to the top and make Matplotlib
;; usable.
(substitute* (string-append target "GESS.py")
(("\"\"\"Description:" line)
(string-append "#!" (which "python") "
import matplotlib
matplotlib.use('Agg')
" line)))
;; Make sure GESS has all modules in its path
(wrap-program (string-append target "GESS.py")
`("PYTHONPATH" ":" prefix (,target ,(getenv "PYTHONPATH"))))
(mkdir-p bin)
(symlink (string-append target "GESS.py")
(string-append bin "GESS.py"))
#t))))))
(inputs
`(("python" ,python-2)
("python2-pysam" ,python2-pysam)
("python2-scipy" ,python2-scipy)
("python2-numpy" ,python2-numpy)
("python2-networkx" ,python2-networkx)
("python2-biopython" ,python2-biopython)))
(home-page "http://compbio.uthscsa.edu/GESS_Web/")
(synopsis "Detect exon-skipping events from raw RNA-seq data")
(description
"GESS is an implementation of a novel computational method to detect de
novo exon-skipping events directly from raw RNA-seq data without the prior
knowledge of gene annotation information. GESS stands for the graph-based
exon-skipping scanner detection scheme.")
(license license:bsd-3)))
(define-public phylip
(package
(name "phylip")
(version "3.696")
(source
(origin
(method url-fetch)
(uri (string-append "http://evolution.gs.washington.edu/phylip/"
"download/phylip-" version ".tar.gz"))
(sha256
(base32
"01jar1rayhr2gba2pgbw49m56rc5z4p5wn3ds0m188hrlln4a2nd"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no check target
#:make-flags (list "-f" "Makefile.unx" "install")
#:parallel-build? #f ; not supported
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'enter-dir
(lambda _ (chdir "src") #t))
(delete 'configure)
(replace 'install
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((target (string-append (assoc-ref outputs "out")
"/bin")))
(mkdir-p target)
(for-each (lambda (file)
(install-file file target))
(find-files "../exe" ".*")))
#t)))))
(home-page "http://evolution.genetics.washington.edu/phylip/")
(synopsis "Tools for inferring phylogenies")
(description "PHYLIP (the PHYLogeny Inference Package) is a package of
programs for inferring phylogenies (evolutionary trees).")
(license license:bsd-2)))
(define-public imp
(package
(name "imp")
(version "2.6.2")
(source
(origin
(method url-fetch)
(uri (string-append "https://integrativemodeling.org/"
version "/download/imp-" version ".tar.gz"))
(sha256
(base32
"0lxqx7vh79d771svr611dkilp6sn30qrbw8zvscbrm37v38d2j6h"))))
(build-system cmake-build-system)
(arguments
`(;; FIXME: Some tests fail because they produce warnings, others fail
;; because the PYTHONPATH does not include the modeller's directory.
#:tests? #f
;; Do not place libraries in an architecture-specific directory.
#:configure-flags
(list "-DCMAKE_INSTALL_LIBDIR=lib")))
(inputs
`(("boost" ,boost)
("gsl" ,gsl)
("swig" ,swig)
("hdf5" ,hdf5)
("fftw" ,fftw)
("python" ,python-2)))
(propagated-inputs
`(("python2-numpy" ,python2-numpy)
("python2-scipy" ,python2-scipy)
("python2-pandas" ,python2-pandas)
("python2-scikit-learn" ,python2-scikit-learn)
("python2-networkx" ,python2-networkx)))
(home-page "https://integrativemodeling.org")
(synopsis "Integrative modeling platform")
(description "IMP's broad goal is to contribute to a comprehensive
structural characterization of biomolecules ranging in size and complexity
from small peptides to large macromolecular assemblies, by integrating data
from diverse biochemical and biophysical experiments. IMP provides a C++ and
Python toolbox for solving complex modeling problems, and a number of
applications for tackling some common problems in a user-friendly way.")
;; IMP is largely available under the GNU Lesser GPL; see the file
;; COPYING.LGPL for the full text of this license. Some IMP modules are
;; available under the GNU GPL (see the file COPYING.GPL).
(license (list license:lgpl2.1+
license:gpl3+))))
(define-public tadbit
(package
(name "tadbit")
(version "0.2")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/3DGenomes/TADbit/"
"archive/v" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1cnfqrl4685zar4nnw94j94nhvl2h29jm448nadqi1h05z6fdk4f"))))
(build-system python-build-system)
(arguments
`(;; Tests are included and must be run after installation, but
;; they are incomplete and thus cannot be run.
#:tests? #f
#:python ,python-2
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-problems-with-setup.py
(lambda* (#:key outputs #:allow-other-keys)
;; setup.py opens these files for writing
(chmod "_pytadbit/_version.py" #o664)
(chmod "README.rst" #o664)
;; Don't attempt to install the bash completions to
;; the home directory.
(rename-file "extras/.bash_completion"
"extras/tadbit")
(substitute* "setup.py"
(("\\(path.expanduser\\('~'\\)")
(string-append "(\""
(assoc-ref outputs "out")
"/etc/bash_completion.d\""))
(("extras/\\.bash_completion")
"extras/tadbit"))
#t)))))
(inputs
;; TODO: add Chimera for visualization
`(("imp" ,imp)
("mcl" ,mcl)
("python2-scipy" ,python2-scipy)
("python2-numpy" ,python2-numpy)
("python2-matplotlib" ,python2-matplotlib)
("python2-pysam" ,python2-pysam)))
(home-page "http://3dgenomes.github.io/TADbit/")
(synopsis "Analyze, model, and explore 3C-based data")
(description
"TADbit is a complete Python library to deal with all steps to analyze,
model, and explore 3C-based data. With TADbit the user can map FASTQ files to
obtain raw interaction binned matrices (Hi-C like matrices), normalize and
correct interaction matrices, identify adn compare the so-called
@dfn{Topologically Associating Domains} (TADs), build 3D models from the
interaction matrices, and finally, extract structural properties from the
models. TADbit is complemented by TADkit for visualizing 3D models.")
(license license:gpl3+)))

5
gnu/packages/code.scm
View File

@ -4,6 +4,7 @@
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -191,7 +192,7 @@ COCOMO model or user-provided parameters.")
(define-public the-silver-searcher
(package
(name "the-silver-searcher")
(version "1.0.2")
(version "2.0.0")
(source (origin
(method url-fetch)
(uri (string-append
@ -199,7 +200,7 @@ COCOMO model or user-provided parameters.")
version ".tar.gz"))
(sha256
(base32
"0v54himv65w294l0k4lhdyc6kvpgijn8b9g5356479fzy7hphjkg"))))
"04wm3r5p2mgv8mdkvysak0d5199h5y0yzl032624brfxpzmqfcq0"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))

3
gnu/packages/emacs.scm
View File

@ -4814,7 +4814,8 @@ Emacs.")
;; determined by emacs' standard initialization
;; procedure
(list ""))))
#t))))))
#t))))
#:include (cons* "^reporters/.*\\.el$" %default-include)))
(home-page "https://github.com/rejeep/ert-runner.el")
(synopsis "Opinionated Ert testing workflow")
(description "@code{ert-runner} is a tool for Emacs projects tested

12
gnu/packages/games.scm
View File

@ -959,7 +959,7 @@ match, cannon keep, and grave-itation pit.")
(define minetest-data
(package
(name "minetest-data")
(version "0.4.15")
(version "0.4.16")
(source (origin
(method url-fetch)
(uri (string-append
@ -968,7 +968,7 @@ match, cannon keep, and grave-itation pit.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"12kxklcd1b5n0f369zf3xxhvkrizxj4d9xv0dh8crfqiymaym0zm"))))
"0nibpm600rbv9dg1zgcsl5grlbqx0b5l6cg1lp6sqkwvjialb4ga"))))
(build-system trivial-build-system)
(native-inputs
`(("source" ,source)
@ -1000,7 +1000,7 @@ match, cannon keep, and grave-itation pit.")
(define-public minetest
(package
(name "minetest")
(version "0.4.15")
(version "0.4.16")
(source (origin
(method url-fetch)
(uri (string-append
@ -1009,7 +1009,7 @@ match, cannon keep, and grave-itation pit.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1ag3jcj7kpq3ph12zirk1c0mj9i0g50wmw932f8gi11liq8yd12n"))))
"0mbnf1ma4gsw9ah68ply04059xkfx5psdxwalxp78sgmx4ypkwqf"))))
(build-system cmake-build-system)
(arguments
'(#:configure-flags
@ -4035,7 +4035,7 @@ fish. The whole game is accompanied by quiet, comforting music.")
(define-public crawl
(package
(name "crawl")
(version "0.19.5")
(version "0.20.0")
(source
(origin
(method url-fetch)
@ -4049,7 +4049,7 @@ fish. The whole game is accompanied by quiet, comforting music.")
version "-nodeps.tar.xz")))
(sha256
(base32
"00yl2lb2shglxlxzpyk99zvglfx4amjybqwnzdcasvbiggb4cj18"))))
"0127dgldij2h4m7cf32yy9ndv4vcz03g4km71lmxrsi5mw7ljgpd"))))
(build-system gnu-build-system)
(inputs
`(("lua51" ,lua-5.1)

5
gnu/packages/gnome.scm
View File

@ -2634,6 +2634,7 @@ output devices.")
(("/bin/true") (which "true"))))))))
(native-inputs
`(("pkg-config" ,pkg-config)
("gobject-introspection" ,gobject-introspection)
("intltool" ,intltool)))
(inputs
`(("avahi" ,avahi)
@ -5110,6 +5111,10 @@ properties, screen resolution, and other GNOME parameters.")
("startup-notification" ,startup-notification)
("telepathy-logger" ,telepathy-logger)
("upower" ,upower)
;; XXX: These requirements were added in 3.24, but no mention in NEWS.
;; Missing propagation? See also: <https://bugs.gnu.org/27264>
("librsvg" ,librsvg)
("geoclue" ,geoclue)
;; XXX: required by libgjs.la.
("readline" ,readline)))
(synopsis "Desktop shell for GNOME")

32
gnu/packages/guile.scm
View File

@ -239,7 +239,8 @@ without requiring the source code to be rewritten.")
(snippet '(for-each delete-file
(find-files "prebuilt" "\\.go$")))))
(properties '((timeout . 72000) ;20 hours
(max-silent-time . 10800))) ;3 hours (needed on ARM)
(max-silent-time . 21600))) ;6 hours (needed on ARM
; when heavily loaded)
(native-search-paths
(list (search-path-specification
(variable "GUILE_LOAD_PATH")
@ -393,18 +394,17 @@ program can be installed in one go.")
(define-public artanis
(package
(name "artanis")
(version "0.1.2")
(version "0.2.1")
(source (origin
(method url-fetch)
(uri (string-append "ftp://alpha.gnu.org/gnu/artanis/artanis-"
version ".tar.gz"))
(sha256
(base32
"19m3ak12cqk8js9d2mdg11kh4fjsq8frfpd10qw75h0zpr5cywpp"))
(patches (search-patches "artanis-fix-Makefile.in.patch"))))
"041ajcg2pz918kd9iqcj4inpzddc3impvz3r2nhlpbv8zrz011hn"))))
(build-system gnu-build-system)
;; TODO: Add guile-dbi and guile-dbd optional dependencies.
(inputs `(("guile" ,guile-2.0)))
(inputs `(("guile" ,guile-2.2)))
(native-inputs `(("bash" ,bash) ;for the `source' builtin
("pkgconfig" ,pkg-config)
("util-linux" ,util-linux))) ;for the `script' command
@ -412,15 +412,15 @@ program can be installed in one go.")
'(#:make-flags
;; TODO: The documentation must be built with the `docs' target.
(let* ((out (assoc-ref %outputs "out"))
(dir (string-append out "/share/guile/site/2.0")))
(scm (string-append out "/share/guile/site/2.2"))
(go (string-append out "/lib/guile/2.2/site-ccache")))
;; Don't use (%site-dir) for site paths.
(list (string-append "MOD_PATH=" dir)
(string-append "MOD_COMPILED_PATH=" dir)))
(list (string-append "MOD_PATH=" scm)
(string-append "MOD_COMPILED_PATH=" go)))
#:test-target "test"
#:phases
(modify-phases %standard-phases
(add-before
'install 'substitute-root-dir
(add-before 'install 'substitute-root-dir
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(substitute* "Makefile" ;ignore the execution of bash.bashrc
@ -428,7 +428,17 @@ program can be installed in one go.")
(substitute* "Makefile" ;set the root of config files to OUT
((" /etc") (string-append " " out "/etc")))
(mkdir-p (string-append out "/bin")) ;for the `art' executable
#t))))))
#t)))
(add-after 'install 'wrap-art
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(scm (string-append out "/share/guile/site/2.2"))
(go (string-append out "/lib/guile/2.2/site-ccache")))
(wrap-program (string-append bin "/art")
`("GUILE_LOAD_PATH" ":" prefix (,scm))
`("GUILE_LOAD_COMPILED_PATH" ":" prefix (,go)))
#t))))))
(synopsis "Web application framework written in Guile")
(description "GNU Artanis is a web application framework written in Guile
Scheme. A web application framework (WAF) is a software framework that is

170
gnu/packages/kde-frameworks.scm
View File

@ -43,8 +43,11 @@
#:use-module (gnu packages glib)
#:use-module (gnu packages gnome)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages graphics)
#:use-module (gnu packages gstreamer)
#:use-module (gnu packages image)
#:use-module (gnu packages kerberos)
#:use-module (gnu packages libreoffice)
#:use-module (gnu packages linux)
#:use-module (gnu packages mp3)
#:use-module (gnu packages pdf)
@ -120,6 +123,8 @@ common build settings used in software produced by the KDE community.")
"177647r2jqfm32hqcz2nqfqv6v48hn5ab2vc31svba2wz23fkgk7"))))
(build-system cmake-build-system)
(native-inputs
;; TODO: Add qttools to build the Qt Designer plugin.
;; TODO: Think about adding pulseaudio. Is it required for sound?
`(("extra-cmake-modules" ,extra-cmake-modules)))
(inputs
`(("qtbase" ,qtbase)))
@ -202,7 +207,8 @@ Phonon-GStreamer is a backend based on the GStreamer multimedia library.")
(home-page "https://community.kde.org/Frameworks")
(synopsis "C++ bindings/wrapper for gpgme")
(description "C++ bindings/wrapper for gpgme.")
(license license:lgpl2.1+)))
(license license:lgpl2.1+)
(properties `((superseded . ,gpgme)))))
(define-public kpmcore
(package
@ -292,6 +298,7 @@ http://freedesktop.org/wiki/Specifications/open-collaboration-services/")
`(("dbus" ,dbus)
("extra-cmake-modules" ,extra-cmake-modules)))
(inputs
;; TODO: qtdeclarative (yields one failing test)
`(("qtbase" ,qtbase)))
(arguments
`(#:configure-flags
@ -639,11 +646,16 @@ infrastructure.")
(base32
"1nmlwvy2jdmh0m6bmahvk68vl2rs9s28c10dkncpi6gvhsdkigqx"))))
(build-system cmake-build-system)
;; TODO: Build packages for the Python bindings. Ideally this will be
;; done for all versions of python guix supports. Requires python,
;; python-sip, clang-python, libclang. Requires python-2 in all cases for
;; clang-python.
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
("xorg-server" ,xorg-server)))
("pkg-config" ,pkg-config)))
(inputs
`(("qtbase" ,qtbase)))
`(("qtbase" ,qtbase)
("qtx11extras" ,qtx11extras)))
(arguments
`(#:phases
(modify-phases %standard-phases
@ -743,19 +755,17 @@ or user activity.")
"1liq1ppa7xb1dcncv25c2a0xy3l9bvb2a56cff90c0b0vwr239q5"))))
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
("xorg-server" ,xorg-server)))
`(("extra-cmake-modules" ,extra-cmake-modules)))
(inputs
`(("qtbase" ,qtbase)))
`(("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-before 'check 'start-xorg-server
(lambda* (#:key inputs #:allow-other-keys)
;; The test suite requires a running X server.
(system (string-append (assoc-ref inputs "xorg-server")
"/bin/Xvfb :1 &"))
(setenv "DISPLAY" ":1")
(add-before 'check 'check-setup
(lambda _
;; make Qt render "offscreen", required for tests
(setenv "QT_QPA_PLATFORM" "offscreen")
#t)))))
(home-page "https://community.kde.org/Frameworks")
(synopsis "Set of item models extending the Qt model-view framework")
@ -805,8 +815,7 @@ model to observers
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
("qttools" ,qttools)
("xorg-server" ,xorg-server)))
("qttools" ,qttools)))
(inputs
`(("qtbase" ,qtbase)))
(arguments
@ -815,13 +824,8 @@ model to observers
(add-before 'check 'check-setup
(lambda _
(setenv "DBUS_FATAL_WARNINGS" "0")
#t))
(add-before 'check 'start-xorg-server
(lambda* (#:key inputs #:allow-other-keys)
;; The test suite requires a running X server.
(system (string-append (assoc-ref inputs "xorg-server")
"/bin/Xvfb :1 &"))
(setenv "DISPLAY" ":1")
;; make Qt render "offscreen", required for tests
(setenv "QT_QPA_PLATFORM" "offscreen")
#t)))))
(home-page "https://community.kde.org/Frameworks")
(synopsis "Set of item views extending the Qt model-view framework")
@ -845,19 +849,16 @@ to flat and hierarchical lists.")
"1ffy9b08128ym024wlfgnzk52vpy0mbaa91dhndpr40qcz0i67sh"))))
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
("xorg-server" ,xorg-server)))
`(("extra-cmake-modules" ,extra-cmake-modules)))
(inputs
`(("qtbase" ,qtbase)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-before 'check 'start-xorg-server
(lambda* (#:key inputs #:allow-other-keys)
;; The test suite requires a running X server.
(system (string-append (assoc-ref inputs "xorg-server")
"/bin/Xvfb :1 &"))
(setenv "DISPLAY" ":1")
(add-before 'check 'check-setup
(lambda _ ; kplotting
;; make Qt render "offscreen", required for tests
(setenv "QT_QPA_PLATFORM" "offscreen")
#t)))))
(home-page "https://community.kde.org/Frameworks")
(synopsis "Data plotting library")
@ -976,8 +977,7 @@ represented by a QPoint or a QSize.")
(inputs
`(("qtbase" ,qtbase)))
(arguments
`(#:tests? #f ; FIXME: Regression after update to qt 5.7
#:phases
`(#:phases
(modify-phases %standard-phases
(add-before 'check 'check-setup
(lambda _
@ -1020,6 +1020,7 @@ configuration pages, message boxes, and password requests.")
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
("pkg-config" ,pkg-config)
("dbus" ,dbus) ; for the tests
("qttools" ,qttools)
("xorg-server" ,xorg-server))) ; for the tests
(inputs
@ -1028,7 +1029,31 @@ configuration pages, message boxes, and password requests.")
("qtx11extras" ,qtx11extras)
("xcb-utils-keysyms" ,xcb-util-keysyms)))
(arguments
`(#:tests? #f)) ; FIXME: 8/10 tests fail.
`(#:tests? #f ; FIXME: 3/12 tests fail.
#:phases
(modify-phases %standard-phases
(delete 'check)
(add-after 'install 'check
(lambda* (#:key inputs outputs tests? #:allow-other-keys)
;; TODO: Simplify and use "common" phases when test-suite passes
(if tests?
(begin
(let ((out (assoc-ref outputs "out")))
(setenv "QT_PLUGIN_PATH"
(string-append out "/lib/plugins:"
(getenv "QT_PLUGIN_PATH"))))
;; The test suite requires a running X server, setting
;; QT_QPA_PLATFORM=offscreen does not suffice and even make
;; some tests fail.
(system (string-append (assoc-ref inputs "xorg-server")
"/bin/Xvfb :1 -screen 0 640x480x24 &"))
(setenv "DISPLAY" ":1")
(setenv "CTEST_OUTPUT_ON_FAILURE" "1")
(setenv "DBUS_FATAL_WARNINGS" "0")
(zero? (system* "dbus-launch" "ctest" ".")))
(begin
(format #t "test suite not run~%")
#t)))))))
(home-page "https://community.kde.org/Frameworks")
(synopsis "KDE access to the windowing system")
(description "KWindowSystem provides information about and allows
@ -1175,6 +1200,7 @@ which are used in DBus communication.")
(inputs
`(("qtbase" ,qtbase)
("udev" ,eudev)))
;; TODO: Add runtime-only dependency MediaPlayerInfo
(home-page "https://community.kde.org/Frameworks")
(synopsis "Desktop hardware abstraction")
(description "Solid is a device integration framework. It provides a way of
@ -1200,7 +1226,9 @@ system.")
`(("extra-cmake-modules" ,extra-cmake-modules)
("qttools" ,qttools)))
(inputs
`(("qtbase" ,qtbase)))
`(("hunspell" ,hunspell)
;; TODO: hspell (for Hebrew), Voikko (for Finish)
("qtbase" ,qtbase)))
(home-page "https://community.kde.org/Frameworks")
(synopsis "Multi-language spell checker")
(description "Sonnet is a plugin-based spell checking library for Qt-based
@ -1301,8 +1329,7 @@ utilities.")
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
("qttools" ,qttools)
("xorg-server" ,xorg-server)))
("qttools" ,qttools)))
(inputs
`(("kconfig" ,kconfig)
("kwidgetsaddons" ,kwidgetsaddons)
@ -1337,8 +1364,7 @@ integrated it into your application's other widgets.")
"1cshay7dhbqgh62nq85vd9sm20gq9s9f70mdnzjjh1q7cajybkp3"))))
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
("xorg-server" ,xorg-server)))
`(("extra-cmake-modules" ,extra-cmake-modules)))
(inputs
`(("kcoreaddons" ,kcoreaddons)
("kwindowsystem" ,kwindowsystem)
@ -1347,12 +1373,10 @@ integrated it into your application's other widgets.")
(arguments
`(#:phases
(modify-phases %standard-phases
(add-before 'check 'start-xorg-server
(lambda* (#:key inputs #:allow-other-keys)
;; The test suite requires a running X server.
(system "Xvfb :1 &")
(sleep 2) ;XXX: give the server enough time to start
(setenv "DISPLAY" ":1")
(add-before 'check 'check-setup
(lambda _
;; make Qt render "offscreen", required for tests
(setenv "QT_QPA_PLATFORM" "offscreen")
#t)))))
(home-page "https://community.kde.org/Frameworks")
(synopsis "Graceful handling of application crashes")
@ -1476,19 +1500,26 @@ by applications to write metadata.")
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
("xorg-server" ,xorg-server)))
("pkg-config" ,pkg-config)))
(inputs
`(("qtbase" ,qtbase)))
`(("karchive" ,karchive) ; for Krita and OpenRaster images
("openexr" ,openexr) ; for OpenEXR high dynamic-range images
("qtbase" ,qtbase)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-before 'check 'start-xorg-server
(lambda* (#:key inputs #:allow-other-keys)
;; The test suite requires a running X server.
(system (string-append (assoc-ref inputs "xorg-server")
"/bin/Xvfb :1 &"))
(setenv "DISPLAY" ":1")
#t)))))
(add-before 'check 'check-setup
(lambda _
;; make Qt render "offscreen", required for tests
(setenv "QT_QPA_PLATFORM" "offscreen")
#t)))
;; FIXME: The header files of ilmbase (propagated by openexr) are not
;; found when included by the header files of openexr, and an explicit
;; flag needs to be set.
#:configure-flags
(list (string-append "-DCMAKE_CXX_FLAGS=-I"
(assoc-ref %build-inputs "ilmbase")
"/include/OpenEXR"))))
(home-page "https://community.kde.org/Frameworks")
(synopsis "Plugins to allow QImage to support extra file formats")
(description "This framework provides additional image format plugins for
@ -1550,6 +1581,9 @@ asynchronous jobs.")
("kwindowsystem" ,kwindowsystem)
("phonon" ,phonon)
("qtbase" ,qtbase)
;; TODO: qtspeech (new in Qt 5.9)
;; TODO: Think about adding dbusmenu-qt5 from
;; https://launchpad.net/libdbusmenu-qt
("qtx11extras" ,qtx11extras)))
(arguments
`(#:phases
@ -1588,10 +1622,11 @@ covers feedback and persistent events.")
`(("karchive" ,karchive)
("kconfig" ,kconfig)
("kcoreaddons" ,kcoreaddons)
("kdoctools" ,kdoctools)
("ki18n" ,ki18n)
("qtbase" ,qtbase)))
(arguments
`(#:tests? #f ; FIXME: 1/4 tests fail.
`(#:tests? #f ; FIXME: 3/9 tests fail.
#:phases
(modify-phases %standard-phases
(add-before 'check 'check-setup
@ -1624,6 +1659,7 @@ were traditional plugins.")
(inputs
`(("kcoreaddons" ,kcoreaddons)
("ki18n" ,ki18n)
;; TODO: utempter, for managing UTMP entries
("qtbase" ,qtbase)))
(arguments
`(#:tests? #f ; FIXME: 1/1 tests fail.
@ -1989,7 +2025,8 @@ their settings.")
(modify-phases %standard-phases
(add-before 'check 'start-xorg-server
(lambda* (#:key inputs #:allow-other-keys)
;; The test suite requires a running X server.
;; The test suite requires a running X server, setting
;; QT_QPA_PLATFORM=offscreen does not suffice.
(system (string-append (assoc-ref inputs "xorg-server")
"/bin/Xvfb :1 -screen 0 640x480x24 &"))
(setenv "DISPLAY" ":1")
@ -2219,8 +2256,7 @@ window does not need focus for them to be activated.")
("qtbase" ,qtbase)
("qtsvg" ,qtsvg)))
(arguments
`(#:tests? #f ; FIXME: Test failure
#:phases
`(#:phases
(modify-phases %standard-phases
(add-before 'check 'check-setup
(lambda* (#:key inputs #:allow-other-keys)
@ -2252,7 +2288,8 @@ in applications using the KDE Frameworks.")
"08429kjihpaip73wszr3rsii8sdlwgm3kxx7g0hpjhkj9d2jq3m1"))))
(build-system cmake-build-system)
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)))
`(("extra-cmake-modules" ,extra-cmake-modules)
("pkg-config" ,pkg-config)))
(inputs
`(("kauth" ,kauth)
("kbookmarks" ,kbookmarks)
@ -2262,6 +2299,7 @@ in applications using the KDE Frameworks.")
("kconfigwidgets" ,kconfigwidgets)
("kcoreaddons" ,kcoreaddons)
("kcrash" ,kcrash)
("kdoctools" ,kdoctools)
("kio" ,kio)
("kitemviews" ,kitemviews)
("ki18n" ,ki18n)
@ -2270,6 +2308,7 @@ in applications using the KDE Frameworks.")
("kwidgetsaddons" ,kwidgetsaddons)
("kwindowsystem" ,kwindowsystem)
("kxmlgui" ,kxmlgui)
("libcap" ,libcap) ; to install start_kdeinit with CAP_SYS_RESOURCE
("qtbase" ,qtbase)
("solid" ,solid)))
(home-page "https://community.kde.org/Frameworks")
@ -2310,6 +2349,7 @@ makes starting KDE applications faster and reduces memory consumption.")
("extra-cmake-modules" ,extra-cmake-modules)))
(inputs
`(("acl" ,acl)
("krb5" ,mit-krb5)
("karchive" ,karchive)
("kauth" ,kauth)
("kcodecs" ,kcodecs)
@ -2326,6 +2366,7 @@ makes starting KDE applications faster and reduces memory consumption.")
("libxml2" ,libxml2)
("libxslt" ,libxslt)
("qtbase" ,qtbase)
("qtscript" ,qtscript)
("qtx11extras" ,qtx11extras)
("sonnet" ,sonnet)))
(arguments
@ -2664,9 +2705,11 @@ types or handled by application specific code.")
(propagated-inputs
`(("kparts" ,kparts)))
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)))
`(("extra-cmake-modules" ,extra-cmake-modules)
("pkg-config" ,pkg-config)))
(inputs
`(("karchive" ,karchive)
`(;; TODO: editor-config
("karchive" ,karchive)
("kauth" ,kauth)
("kbookmarks" ,kbookmarks)
("kcodecs" ,kcodecs)
@ -2745,6 +2788,7 @@ library.")
("kservice" ,kservice)
("kwidgetsaddons" ,kwidgetsaddons)
("kwindowsystem" ,kwindowsystem)
;; TODO: qtspeech (new in Qt 5.9)
("qtbase" ,qtbase)))
(arguments
`(#:phases
@ -2778,7 +2822,7 @@ It supports rich text as well as plain text.")
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)))
(inputs
`(("gpgmepp" ,gpgmepp)
`(("gpgme" ,gpgme) ;; TODO: Add gpgme Qt-bindings
("kauth" ,kauth)
("kcodecs" ,kcodecs)
("kconfig" ,kconfig)
@ -2915,7 +2959,8 @@ setUrl, setUserAgent and call.")
`(("kpackage" ,kpackage)
("kservice" ,kservice)))
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)))
`(("extra-cmake-modules" ,extra-cmake-modules)
("pkg-config" ,pkg-config)))
(inputs
`(("kactivities" ,kactivities)
("karchive" ,karchive)
@ -2937,6 +2982,7 @@ setUrl, setUserAgent and call.")
("ki18n" ,ki18n)
("kjobwidgets" ,kjobwidgets)
("knotificantions" ,knotifications)
("kwayland" ,kwayland)
("kwidgetsaddons" ,kwidgetsaddons)
("kwindowsystem" ,kwindowsystem)
("kxmlgui" ,kxmlgui)
@ -2947,7 +2993,7 @@ setUrl, setUserAgent and call.")
("qtx11extras" ,qtx11extras)
("solid" ,solid)))
(arguments
`(#:tests? #f ; FIXME: 13/14 tests fail.
`(#:tests? #f ; FIXME: 9/15 tests fail.
#:phases
(modify-phases %standard-phases
(add-before 'check 'check-setup

2
gnu/packages/kde.scm
View File

@ -293,6 +293,8 @@ used in KDE development tools Kompare and KDevelop.")
(modify-phases %standard-phases
(add-before 'configure 'patch-cmakelists
(lambda _
;; TODO: Verify: This should no longer be necessary, since
;; KF5AuthConfig.cmake.in contains this already.
(substitute* "processcore/CMakeLists.txt"
(("KAUTH_HELPER_INSTALL_DIR") "KDE_INSTALL_LIBEXECDIR"))))
(replace 'check

43
gnu/packages/linux.scm
View File

@ -72,6 +72,7 @@
#:use-module (gnu packages libusb)
#:use-module (gnu packages man)
#:use-module (gnu packages maths)
#:use-module (gnu packages multiprecision)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages networking)
#:use-module (gnu packages ninja)
@ -357,8 +358,8 @@ It has been modified to remove all non-free binary blobs.")
(define %intel-compatible-systems '("x86_64-linux" "i686-linux"))
(define %linux-libre-version "4.11.3")
(define %linux-libre-hash "14fbn9s7n86p5yivr4vmh4axdavny6xw1qk63cfwlcma7426wmva")
(define %linux-libre-version "4.11.4")
(define %linux-libre-hash "11nd9pv18vz3g82ja71dkz9mbs0ffb8yamsd44d381szmmm2kpj8")
(define-public linux-libre
(make-linux-libre %linux-libre-version
@ -367,14 +368,14 @@ It has been modified to remove all non-free binary blobs.")
#:configuration-file kernel-config))
(define-public linux-libre-4.9
(make-linux-libre "4.9.30"
"1m1ii9n65lwkbwx0ifj13vgdfr0mnx8n7sfvhf5mn4r8krhxi77a"
(make-linux-libre "4.9.31"
"0amc35c9f2rym6grb277yscnx8ybn8d4fbc2a59sgkg1lsdv7n4q"
%intel-compatible-systems
#:configuration-file kernel-config))
(define-public linux-libre-4.4
(make-linux-libre "4.4.70"
"1dvcj3mk42m91y1x41yh52frjdcwip1wj57qwlkmrpg02icr0b3s"
(make-linux-libre "4.4.71"
"0nrd165crx9m9s1px98if6q5dcdqwmas9kh8i4rw51gz2xinh0gx"
%intel-compatible-systems
#:configuration-file kernel-config))
@ -3850,6 +3851,36 @@ libnftnl has been previously known as libnftables. This library is currently
used by nftables.")
(license license:gpl2+)))
(define-public nftables
(package
(name "nftables")
(version "0.7")
(source
(origin
(method url-fetch)
(uri (string-append "http://www.nftables.org/projects/nftables"
"/files/nftables-" version ".tar.bz2"))
(sha256
(base32
"0hzdqigdx4i6jbpxbdyq4zy4p4waqn8l6vvz7685ikh1v0wr4qzy"))))
(build-system gnu-build-system)
(inputs `(("bison", bison)
("flex", flex)
("gmp", gmp)
("libmnl", libmnl)
("libnftnl", libnftnl)
("readline", readline)))
(native-inputs `(("pkg-config", pkg-config)))
(home-page "http://www.nftables.org")
(synopsis "Userspace utility for Linux packet filtering")
(description "nftables is the project that aims to replace the existing
{ip,ip6,arp,eb}tables framework. Basically, this project provides a new packet
filtering framework, a new userspace utility and also a compatibility layer for
{ip,ip6}tables. nftables is built upon the building blocks of the Netfilter
infrastructure such as the existing hooks, the connection tracking system, the
userspace queueing component and the logging subsystem.")
(license license:gpl2)))
(define-public proot
(package
(name "proot")

39
gnu/packages/markdown.scm → gnu/packages/markup.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 ng0 <ng0@no-reply.pragmatique.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
@ -18,7 +19,7 @@
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages markdown)
(define-module (gnu packages markup)
#:use-module (guix licenses)
#:use-module (guix download)
#:use-module (guix packages)
@ -130,3 +131,39 @@ for parsing and rendering CommonMark.")
;; licensed. The CommonMark specification is Creative Commons CC-BY-SA 4.0
;; licensed. See 'COPYING' in the source distribution for more information.
(license (list bsd-2 expat cc-by-sa4.0))))
(define-public smu
(package
(name "smu")
(version "1.4")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/Gottox/smu/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0iazl45rkz8ngsb5hpykl76w0ngvdvqqhym1qz5wykgmrzk293rp"))))
(build-system gnu-build-system)
(arguments
`(#:make-flags (list "CC=gcc"
(string-append "PREFIX="
(assoc-ref %outputs "out")))
#:tests? #f ;No tests included
#:phases
(modify-phases %standard-phases
(delete 'configure))))
(home-page "https://github.com/Gottox/smu")
(synopsis "Simple markup")
(description
"Smu is a very simple and minimal markup language. It is
designed for using in wiki-like environments. Smu makes it very
easy to write your documents on the fly and convert them into HTML.
Smu is capable to parse very large documents. As long as you avoid an huge
amount of indents it scales just great.
Smu was started as a rewrite of Markdown but became something more
lightweight and consistent. The biggest difference between Markdown
and smu is that smu doesn't support reference style links.")
(license x11)))

70
gnu/packages/patches/artanis-fix-Makefile.in.patch
View File

@ -1,70 +0,0 @@
Applies until an Artanis release comes with the following patches
applied:
* <https://savannah.gnu.org/patch/?func=detailitem&item_id=9130>
* <https://savannah.gnu.org/patch/?func=detailitem&item_id=9131>
diff -ru artanis-0.1.2/Makefile.in artanis-0.1.2.1/Makefile.in
--- artanis-0.1.2/Makefile.in 2016-02-10 12:35:18.800490571 -0200
+++ artanis-0.1.2.1/Makefile.in 2016-10-15 19:44:35.140907367 -0300
@@ -19,9 +19,18 @@
MOD_OBJ := $(OBJ)/artanis
BIN := bin
TEMP_LIB_PATH := $(OBJ)
-MOD_PATH := $(shell guile -c "(display (%site-dir))")
MOD_COMPILED_PATH := $(shell guile -c "(display (%site-ccache-dir))")
+
+ifdef DESTDIR
+INFO_DIR := $(DESTDIR)/share/info/
+MOD_PATH := $(DESTDIR)/$(shell guile -c "(display (%site-dir))")
MOD_TARGET_PATH := $(DESTDIR)/$(MOD_COMPILED_PATH)
+else
+INFO_DIR := $(PREFIX)/share/info/
+MOD_PATH := $(shell guile -c "(display (%site-dir))")
+MOD_TARGET_PATH := $(MOD_COMPILED_PATH)
+endif
+
GUILE_CFLAGS := -Wunsupported-warning -Wunbound-variable -Warity-mismatch -Wduplicate-case-datum -Wbad-case-datum -Wformat
GUILEC := GUILE_LOAD_COMPILED_PATH=$(TEMP_LIB_PATH) guild compile $(GUILE_CFLAGS)
ARTANIS_ETC := $(SRC)/etc/artanis
@@ -36,7 +45,6 @@
GENDOCS :=$(BUILD_AUX)/gendocs.sh
CHK_TEXINFO := $(BUILD_AUX)/check_texinfo.scm
CP := cp -frd -P
-INFO_DIR := $(PREFIX)/share/info/
TARBALL_NAME := artanis-$(VERSION)
TMP_DIR := $(shell mktemp -d)
ANN_GEN := $(BUILD_AUX)/announce-gen
@@ -124,18 +132,29 @@
-rm -f config.{h,log}
install: $(ALL_TARGETS)
- mkdir -p $(DESTDIR)/$(MOD_PATH)
- $(CP) $(MOD) $(DESTDIR)/$(MOD_PATH)/
+ mkdir -p $(MOD_PATH)
+ $(CP) $(MOD) $(MOD_PATH)/
mkdir -p $(MOD_TARGET_PATH)/
$(CP) $(MOD_OBJ) $(MOD_TARGET_PATH)/
+
+ifdef DESTDIR
$(CP) $(ARTANIS_ETC) $(DESTDIR)/etc/
$(CP) $(ARTANIS_PAGES) $(DESTDIR)/etc/artanis/
- mkdir -p $(DESTDIR)/$(PREFIX)/bin/
- $(CP) $(BIN)/art $(DESTDIR)/$(PREFIX)/bin/
+ mkdir -p $(DESTDIR)/bin/
+ $(CP) $(BIN)/art $(DESTDIR)/bin/
mkdir -p $(DESTDIR)/etc/bash_completion.d/
$(CP) $(CMDCOMP) $(DESTDIR)/etc/bash_completion.d/
+else
+ $(CP) $(ARTANIS_ETC) $(PREFIX)/etc/
+ $(CP) $(ARTANIS_PAGES) $(PREFIX)/etc/artanis/
+ mkdir -p $(PREFIX)/bin/
+ $(CP) $(BIN)/art $(PREFIX)/bin/
+ mkdir -p $(PREFIX)/etc/bash_completion.d/
+ $(CP) $(CMDCOMP) $(PREFIX)/etc/bash_completion.d/
+endif
+
if [ -e /etc/bash.bashrc ]; then source /etc/bash.bashrc; fi
- if [ -e artanis.info ]; then mkdir -p $(DESTDIR)/$(INFO_DIR); $(CP) artanis.info $(DESTDIR)/$(INFO_DIR)/; fi
+ if [ -e artanis.info ]; then mkdir -p $(INFO_DIR); $(CP) artanis.info $(INFO_DIR)/; fi
distclean: distclean-mk clean clean-config clean-tarball
-rm -f $(BIN)/art

51
gnu/packages/patches/raptor2-heap-overflow.patch Normal file
View File

@ -0,0 +1,51 @@
This patch addresses two heap overflow bugs in raptor2:
http://seclists.org/oss-sec/2017/q2/424
Patch copied from libreoffice:
https://github.com/LibreOffice/core/blob/master/external/redland/raptor/0001-Calcualte-max-nspace-declarations-correctly-for-XML-.patch.1
From 590681e546cd9aa18d57dc2ea1858cb734a3863f Mon Sep 17 00:00:00 2001
From: Dave Beckett <dave@dajobe.org>
Date: Sun, 16 Apr 2017 23:15:12 +0100
Subject: [PATCH] Calcualte max nspace declarations correctly for XML writer
(raptor_xml_writer_start_element_common): Calculate max including for
each attribute a potential name and value.
Fixes Issues #0000617 http://bugs.librdf.org/mantis/view.php?id=617
and #0000618 http://bugs.librdf.org/mantis/view.php?id=618
---
src/raptor_xml_writer.c | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/src/raptor_xml_writer.c b/src/raptor_xml_writer.c
index 693b946..0d3a36a 100644
--- a/src/raptor_xml_writer.c
+++ b/src/raptor_xml_writer.c
@@ -181,9 +181,10 @@ raptor_xml_writer_start_element_common(raptor_xml_writer* xml_writer,
size_t nspace_declarations_count = 0;
unsigned int i;
- /* max is 1 per element and 1 for each attribute + size of declared */
if(nstack) {
- int nspace_max_count = element->attribute_count+1;
+ int nspace_max_count = element->attribute_count * 2; /* attr and value */
+ if(element->name->nspace)
+ nspace_max_count++;
if(element->declared_nspaces)
nspace_max_count += raptor_sequence_size(element->declared_nspaces);
if(element->xml_language)
@@ -237,7 +238,7 @@ raptor_xml_writer_start_element_common(raptor_xml_writer* xml_writer,
}
}
- /* Add the attribute + value */
+ /* Add the attribute's value */
nspace_declarations[nspace_declarations_count].declaration=
raptor_qname_format_as_xml(element->attributes[i],
&nspace_declarations[nspace_declarations_count].length);
--
2.9.3

4
gnu/packages/php.scm
View File

@ -53,7 +53,7 @@
(define-public php
(package
(name "php")
(version "7.1.5")
(version "7.1.6")
(home-page "https://secure.php.net/")
(source (origin
(method url-fetch)
@ -61,7 +61,7 @@
name "-" version ".tar.xz"))
(sha256
(base32
"1b7njiqgy66ga5c8wsm78mqqjr7lj3hlpwbbvksi2mn4jv1s6jfi"))
"0nr49gqhk4pv8kcdc60cl1mgwlinawpraq9ba15whzmb472lsn01"))
(modules '((guix build utils)))
(snippet
'(with-directory-excursion "ext"

20
gnu/packages/python.scm
View File

@ -533,26 +533,24 @@ John the Ripper).")
(define-public python-paramiko
(package
(name "python-paramiko")
(version "1.17.4")
(version "2.1.2")
(source
(origin
(method url-fetch)
(uri (pypi-uri "paramiko" version))
(sha256
(base32
"1rs2qcmskcmq66q6g5al08wa41l9am0fad5r719m8wf91msyylqw"))))
"04734n0wy3hxk6rij4fr29in5jmr70nxpc7pqi2ksbjysfz4kbjz"))))
(build-system python-build-system)
(arguments
'(;; FIXME: One test fails with "EOFError not raised by connect".
#:tests? #f))
;; #:phases
;; (modify-phases %standard-phases
;; (replace 'check
;; (lambda _
;; (zero? (system* "python" "test.py")))))))
'(#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
(zero? (system* "python" "test.py")))))))
(propagated-inputs
`(("python-pycrypto" ,python-pycrypto)
("python-ecdsa" ,python-ecdsa)))
`(("python-pyasn1" ,python-pyasn1)
("python-cryptography" ,python-cryptography)))
(home-page "http://www.paramiko.org/")
(synopsis "SSHv2 protocol library")
(description "Paramiko is a python implementation of the SSHv2 protocol,

2
gnu/packages/rdf.scm
View File

@ -53,6 +53,8 @@
(method url-fetch)
(uri (string-append "http://download.librdf.org/source/" name
"-" version ".tar.gz"))
(patches
(search-patches "raptor2-heap-overflow.patch"))
(sha256
(base32
"1vc02im4mpc28zxzgli68k6j0dakh0k3s389bm436yvqajxg19xd"))))

4
gnu/packages/serialization.scm
View File

@ -282,7 +282,7 @@ it a convenient format to store user input files.")
(define-public capnproto
(package
(name "capnproto")
(version "0.6.0")
(version "0.6.1")
(source (origin
(method url-fetch)
(uri (string-append
@ -290,7 +290,7 @@ it a convenient format to store user input files.")
version ".tar.gz"))
(sha256
(base32
"0gpp1cxsb9nfd7qkjjykzknx03y0z0n4bq5q0fmxci7w38ci22g5"))))
"010s9yhq4531wvdfrdf2477zswhck6cjfby79w73rff3v06090l0"))))
(build-system gnu-build-system)
(arguments
`(#:phases

4
gnu/packages/shells.scm
View File

@ -503,11 +503,11 @@ Its features include:
@end enumerate\n")
(license bsd-2)))
(define-public s
(define-public s-shell
(let ((commit "6604341edb3a775ff94415762af3ee9bd86bfb3c")
(revision "1"))
(package
(name "s")
(name "s-shell")
(version (string-append "0.0.0-" revision "." (string-take commit 7)))
(source
(origin

54
gnu/packages/statistics.scm
View File

@ -5231,3 +5231,57 @@ devices that don't have Cairo's capabilities such as alpha support or
anti-aliasing. Backends are modular such that any subset of backends
is supported.")
(license license:gpl2)))
(define-public r-lubridate
(package
(name "r-lubridate")
(version "1.6.0")
(source
(origin
(method url-fetch)
(uri (cran-uri "lubridate" version))
(sha256
(base32
"0ci6rwij9i1inn840m0mlh1nqgh6vm2lada9kdnjpcjp5kyfv1qs"))))
(build-system r-build-system)
(propagated-inputs
`(("r-stringr" ,r-stringr)))
(home-page
"http://cran.r-project.org/web/packages/lubridate")
(synopsis "Make dealing with dates a little easier")
(description
"This package provides functions to work with date-times and time-spans:
fast and user friendly parsing of date-time data, extraction and updating of
components of a date-time (years, months, days, hours, minutes, and seconds),
algebraic manipulation on date-time and time-span objects. The 'lubridate'
package has a consistent and memorable syntax that makes working with dates
easy and fun.")
(license license:gpl2)))
(define-public r-fdrtool
(package
(name "r-fdrtool")
(version "1.2.15")
(source
(origin
(method url-fetch)
(uri (cran-uri "fdrtool" version))
(sha256
(base32
"1h46frlk7d9f4qx0bg6p55nrm9wwwz2sv6d1nz7061wdfsm69yb5"))))
(build-system r-build-system)
(home-page "http://strimmerlab.org/software/fdrtool/")
(synopsis "Estimation of false discovery rates and higher criticism")
(description
"This package provides tools to estimate both tail area-based false
discovery rates (Fdr) as well as local false discovery rates (fdr) for a
variety of null models (p-values, z-scores, correlation coefficients,
t-scores). The proportion of null values and the parameters of the null
distribution are adaptively estimated from the data. In addition, the package
contains functions for non-parametric density estimation (Grenander
estimator), for monotone regression (isotonic regression and antitonic
regression with weights), for computing the greatest convex minorant (GCM) and
the least concave majorant (LCM), for the half-normal and correlation
distributions, and for computing empirical higher criticism (HC) scores and
the corresponding decision threshold.")
(license license:gpl3+)))

30
gnu/packages/tls.scm
View File

@ -103,23 +103,15 @@ in intelligent transportation networks.")
(define-public p11-kit
(package
(name "p11-kit")
(version "0.23.2")
(version "0.23.7")
(source
(origin
(method url-fetch)
(uri (string-append "https://p11-glue.freedesktop.org/releases/p11-kit-"
version ".tar.gz"))
(uri (string-append "https://github.com/p11-glue/p11-kit/releases/"
"download/" version "/p11-kit-" version ".tar.gz"))
(sha256
(base32
"1w7szm190phlkg7qx05ychlj2dbvkgkhx9gw6dx4d5rw62l6wwms"))
(modules '((guix build utils))) ; for substitute*
(snippet
'(begin
;; Drop one test that fails, also when trying to compile manually.
;; Reported upstream at
;; https://bugs.freedesktop.org/show_bug.cgi?id=89027
(substitute* "Makefile.in"
(("test-module\\$\\(EXEEXT\\) ") ""))))))
"0hdy4h8byvcvd4av504xqfqyd1h6xy914j034mq3c6v4ya37r3lq"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
@ -478,25 +470,17 @@ security, and applying best practice development processes.")
(package
(name "python-acme")
;; Remember to update the hash of certbot when updating python-acme.
(version "0.14.2")
(version "0.15.0")
(source (origin
(method url-fetch)
(uri (pypi-uri "acme" version))
(sha256
(base32
"1kbgpjabbly7r757vyr1050ixnm9hyvrbf9n6aq49cgmb147ysqn"))))
"11zwgj663vr575pbqw74ia10wxaw16i8rnkcivsrbsx148rxdbcz"))))
(build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-dependency
;; This module is part of the Python standard library, so we don't
;; need to use an external package.
;; https://github.com/certbot/certbot/pull/2249
(lambda _
(substitute* "setup.py"
(("'argparse',") ""))
#t))
(add-after 'build 'build-documentation
(lambda _
(zero? (system* "make" "-C" "docs" "man" "info"))))
@ -543,7 +527,7 @@ security, and applying best practice development processes.")
(uri (pypi-uri name version))
(sha256
(base32
"1b39hybswzm8mkarg1mwpx47wffqg57jcgi52mz5iz60rxym9j2v"))))
"1srvmjxz75dbafx7xfg1w3n9h3srr9p2ljnfsih9dwwd5cxh9i5q"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2

6
gnu/packages/video.scm
View File

@ -461,14 +461,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.3.1")
(version "3.3.2")
(source (origin
(method url-fetch)
(uri (string-append "https://ffmpeg.org/releases/ffmpeg-"
version ".tar.xz"))
(sha256
(base32
"0bwgm6z6k3khb91qh9xv15inykkfchpkm0lcdckkxhkacpyaf0mp"))))
"11974vcfsy8w0i6f4lfwqmg80xkfybqw7vw6zzrcn5i6ncddx60r"))))
(build-system gnu-build-system)
(inputs
`(("fontconfig" ,fontconfig)
@ -2176,7 +2176,7 @@ many codecs and formats supported by libmediainfo.")
(source (origin
(method url-fetch)
(uri (string-append
"http://www.live555.com/liveMedia/public/live."
"https://download.videolan.org/contrib/live555/live."
version ".tar.gz"))
(sha256
(base32

28
gnu/packages/xdisorg.scm
View File

@ -14,7 +14,7 @@
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2016, 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2016 Petter <petter@mykolab.ch>
;;; Copyright © 2017 Mekeor Melire <mekeor.melire@gmail.com>
;;; Copyright © 2017 ng0 <contact.ng0@cryptolab.net>
@ -47,6 +47,7 @@
#:use-module (gnu packages)
#:use-module (gnu packages documentation)
#:use-module (gnu packages algebra)
#:use-module (gnu packages autotools)
#:use-module (gnu packages compression)
#:use-module (gnu packages image)
#:use-module (gnu packages pkg-config)
@ -117,22 +118,29 @@ program.")
(define-public xclip
(package
(name "xclip")
(version "0.12")
(version "0.13")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://sourceforge/" name "/" name "/" version "/"
name "-" version ".tar.gz"))
(uri (string-append "https://github.com/astrand/xclip"
"/archive/" version ".tar.gz"))
(sha256
(base32
"0ibcf46rldnv0r424qcnai1fa5iq3lm5q5rdd7snsi5sb78gmixp"))))
"0n7pczk9vv30zf8qfln8ba3hnif9yfdxg0m84djac469wc28hnya"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f)) ; There is no test suite
'(#:tests? #f ; There is no test suite
#:phases
(modify-phases %standard-phases
;; Since version 0.13, bootstrapped releases are no longer available.
(add-after 'unpack 'bootstrap
(lambda _ (zero? (system* "autoreconf" "-v")))))))
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)))
(inputs `(("libxmu" ,libxmu)
("libxt" ,libxt)))
(home-page "http://xclip.sourceforge.net/")
(home-page "https://github.com/astrand/xclip")
(synopsis "Command line interface to X11 clipboard")
(description "Xclip is a command line interface to the X11 clipboard. It
can also be used for copying files, as an alternative to sftp/scp, thus
@ -441,7 +449,7 @@ of the screen selected by mouse.")
(define-public slop
(package
(name "slop")
(version "6.3.41")
(version "6.3.43")
(source (origin
(method url-fetch)
(uri (string-append
@ -450,7 +458,7 @@ of the screen selected by mouse.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1yiv0ak1z7zbmcdw0dwx2gpblrh7l7s3l7y7sgpx071dy8s4rqpb"))))
"0kazcnnarc61d3rjysaym9vadf31wisfd3sn076rsjnsldm4y66h"))))
(build-system cmake-build-system)
(arguments
'(#:tests? #f)) ; no "check" target

8
gnu/packages/xorg.scm
View File

@ -2621,7 +2621,7 @@ as USB mice.")
(define-public xf86-video-ati
(package
(name "xf86-video-ati")
(version "7.8.0")
(version "7.9.0")
(source
(origin
(method url-fetch)
@ -2631,7 +2631,7 @@ as USB mice.")
".tar.bz2"))
(sha256
(base32
"1ynnm4v4261xmg94b7jam9hjyym4n2nqba23rv23v3wjfbkms7s0"))))
"0xcq0lncb5p4sas5866qpkjyp1v8ksalw7m1gmqb3brhccp8gb9w"))))
(build-system gnu-build-system)
(inputs `(("mesa" ,mesa)
("xxf86driproto" ,xf86driproto)
@ -3019,7 +3019,7 @@ graphics cards.")
(define-public xf86-video-openchrome
(package
(name "xf86-video-openchrome")
(version "0.5.0")
(version "0.6.0")
(source
(origin
(method url-fetch)
@ -3029,7 +3029,7 @@ graphics cards.")
".tar.bz2"))
(sha256
(base32
"1fsmr455lk89zl795d6b5ypyqjim40j3h2vjch52lcssjw9xdza9"))))
"0x9gq3hw6k661k82ikd1y2kkk4dmgv310xr5q59dwn4k6z37aafs"))))
(build-system gnu-build-system)
(inputs `(("libx11" ,libx11)
("libxext" ,libxext)

14
gnu/system.scm
View File

@ -112,6 +112,7 @@
boot-parameters-initrd
read-boot-parameters
read-boot-parameters-file
menu-entry->boot-parameters
local-host-aliases
%setuid-programs
@ -299,6 +300,19 @@ The object has its kernel-arguments extended in order to make it bootable."
system
root-device)))
#f)))
(define (menu-entry->boot-parameters menu-entry)
"Convert a <menu-entry> instance to a corresponding <boot-parameters>."
(boot-parameters
(label (menu-entry-label menu-entry))
(root-device #f)
(boot-name 'custom)
(store-device #f)
(store-mount-point #f)
(kernel (menu-entry-linux menu-entry))
(kernel-arguments (menu-entry-linux-arguments menu-entry))
(initrd (menu-entry-initrd menu-entry))))
;;;
;;; Services.

12
gnu/system/mapped-devices.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 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2017 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -114,7 +115,16 @@
;; udev-populated /dev/disk/by-id directory but udev may
;; be unavailable at the time we run this.
(if (bytevector? source)
(or (find-partition-by-luks-uuid source)
(or (let loop ((tries-left 10))
(and (positive? tries-left)
(or (find-partition-by-luks-uuid source)
;; If the underlying partition is
;; not found, try again after
;; waiting a second, up to ten
;; times. FIXME: This should be
;; dealt with in a more robust way.
(begin (sleep 1)
(loop (- tries-left 1))))))
(error "LUKS partition not found" source))
source)

11
guix/build-system/emacs.scm
View File

@ -17,6 +17,8 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build-system emacs)
#:use-module ((guix build emacs-build-system)
#:select (%default-include %default-exclude))
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
@ -28,7 +30,10 @@
#:use-module (srfi srfi-26)
#:export (%emacs-build-system-modules
emacs-build
emacs-build-system))
emacs-build-system)
#:re-export (%default-include ;for convenience
%default-exclude))
;; Commentary:
;;
@ -83,8 +88,8 @@
(phases '(@ (guix build emacs-build-system)
%standard-phases))
(outputs '("out"))
(include ''("^[^/]*\\.el$" "^[^/]*\\.info$" "^doc/.*\\.info$"))
(exclude ''("^\\.dir-locals\\.el$" "-pkg\\.el$" "^[^/]*tests?\\.el$"))
(include (quote %default-include))
(exclude (quote %default-exclude))
(search-paths '())
(system (%current-system))
(guile #f)

11
guix/build/emacs-build-system.scm
View File

@ -29,6 +29,8 @@
#:use-module (ice-9 regex)
#:use-module (ice-9 match)
#:export (%standard-phases
%default-include
%default-exclude
emacs-build))
;; Commentary:
@ -42,6 +44,11 @@
;; archive signature.
(define %install-suffix "/share/emacs/site-lisp/guix.d")
;; These are the default inclusion/exclusion regexps for the install phase.
(define %default-include '("^[^/]*\\.el$" "^[^/]*\\.info$" "^doc/.*\\.info$"))
(define %default-exclude '("^\\.dir-locals\\.el$" "-pkg\\.el$"
"^[^/]*tests?\\.el$"))
(define gnu:unpack (assoc-ref gnu:%standard-phases 'unpack))
(define (store-file->elisp-source-file file)
@ -96,8 +103,8 @@ store in '.el' files."
#t))
(define* (install #:key outputs
(include '("^[^/]*\\.el$" "^[^/]*\\.info$" "^doc/.*\\.info$"))
(exclude '("^\\.dir-locals\\.el$" "-pkg\\.el$" "^[^/]*tests?\\.el$"))
(include %default-include)
(exclude %default-exclude)
#:allow-other-keys)
"Install the package contents."

123
guix/git.scm Normal file
View File

@ -0,0 +1,123 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix git)
#:use-module (git)
#:use-module (git object)
#:use-module (guix base32)
#:use-module (guix hash)
#:use-module (guix build utils)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (%repository-cache-directory
latest-repository-commit))
(define %repository-cache-directory
(make-parameter "/var/cache/guix/checkouts"))
(define-syntax-rule (with-libgit2 thunk ...)
(dynamic-wind
(lambda ()
(libgit2-init!))
(lambda ()
thunk ...)
(lambda ()
(libgit2-shutdown))))
(define* (url-cache-directory url
#:optional (cache-directory
(%repository-cache-directory)))
"Return the directory associated to URL in %repository-cache-directory."
(string-append
cache-directory "/"
(bytevector->base32-string (sha256 (string->utf8 url)))))
(define (clone* url directory)
"Clone git repository at URL into DIRECTORY. Upon failure,
make sure no empty directory is left behind."
(with-throw-handler #t
(lambda ()
(mkdir-p directory)
(clone url directory))
(lambda _
(false-if-exception (rmdir directory)))))
(define (repository->head-sha1 repo)
"Return the sha1 of the HEAD commit in REPOSITORY as a string."
(let ((oid (reference-target (repository-head repo))))
(oid->string (commit-id (commit-lookup repo oid)))))
(define (url+commit->name url sha1)
"Return the string \"<REPO-NAME>-<SHA1:7>\" where REPO-NAME is the name of
the git repository, extracted from URL and SHA1:7 the seven first digits
of SHA1 string."
(string-append
(string-replace-substring
(last (string-split url #\/)) ".git" "")
"-" (string-take sha1 7)))
(define* (copy-to-store store cache-directory #:key url repository)
"Copy items in cache-directory to store. URL and REPOSITORY are used
to forge store directory name."
(let* ((commit (repository->head-sha1 repository))
(name (url+commit->name url commit)))
(values (add-to-store store name #t "sha256" cache-directory) commit)))
(define (switch-to-ref repository ref)
"Switch to REPOSITORY's branch, commit or tag specified by REF."
(let* ((oid (match ref
(('branch . branch)
(reference-target
(branch-lookup repository branch BRANCH-REMOTE)))
(('commit . commit)
(string->oid commit))
(('tag . tag)
(reference-name->oid repository
(string-append "refs/tags/" tag)))))
(obj (object-lookup repository oid)))
(reset repository obj RESET_HARD)))
(define* (latest-repository-commit store url
#:key
(cache-directory
(%repository-cache-directory))
(ref '(branch . "origin/master")))
"Return two values: the content of the git repository at URL copied into a
store directory and the sha1 of the top level commit in this directory. The
reference to be checkout, once the repository is fetched, is specified by REF.
REF is pair whose key is [branch | commit | tag] and value the associated
data, respectively [<branch name> | <sha1> | <tag name>].
Git repositories are kept in the cache directory specified by
%repository-cache-directory parameter."
(with-libgit2
(let* ((cache-dir (url-cache-directory url cache-directory))
(cache-exists? (openable-repository? cache-dir))
(repository (if cache-exists?
(repository-open cache-dir)
(clone* url cache-dir))))
;; Only fetch remote if it has not been cloned just before.
(when cache-exists?
(remote-fetch (remote-lookup repository "origin")))
(switch-to-ref repository ref)
(copy-to-store store cache-dir
#:url url
#:repository repository))))