Merge branch 'master' into core-updates
Conflicts: Makefile.am gnu/packages/autotools.scm gnu/packages/guile.scm gnu/packages/python.scm gnu/packages/shishi.scm guix/gnu-maintenance.scm guix/scripts/build.scm guix/scripts/gc.scm guix/scripts/package.scm guix/scripts/substitute-binary.scm guix/ui.scm nix/nix-daemon/guix-daemon.cc test-env.in tests/nar.scm tests/store.scm
This commit is contained in:
Ludovic Courtès
commit
a9db7d10b6
|
|
@ -30,8 +30,10 @@ MODULES = \
|
|||
guix/scripts/import.scm \
|
||||
guix/scripts/package.scm \
|
||||
guix/scripts/gc.scm \
|
||||
guix/scripts/hash.scm \
|
||||
guix/scripts/pull.scm \
|
||||
guix/scripts/substitute-binary.scm \
|
||||
guix/scripts/refresh.scm \
|
||||
guix/base32.scm \
|
||||
guix/utils.scm \
|
||||
guix/serialization.scm \
|
||||
|
|
@ -46,6 +48,8 @@ MODULES = \
|
|||
guix/build-system/perl.scm \
|
||||
guix/build-system/trivial.scm \
|
||||
guix/ftp-client.scm \
|
||||
guix/web.scm \
|
||||
guix/gnupg.scm \
|
||||
guix/store.scm \
|
||||
guix/ui.scm \
|
||||
guix/build/download.scm \
|
||||
|
|
@ -327,6 +331,7 @@ EXTRA_DIST = \
|
|||
.dir-locals.el \
|
||||
hydra.scm \
|
||||
build-aux/download.scm \
|
||||
build-aux/sync-synopses.scm \
|
||||
srfi/srfi-64.scm \
|
||||
srfi/srfi-64.upstream.scm \
|
||||
tests/test.drv \
|
||||
|
|
@ -374,3 +379,7 @@ AM_DISTCHECK_CONFIGURE_FLAGS = \
|
|||
--with-libgcrypt-prefix="$(LIBGCRYPT_PREFIX)" \
|
||||
--with-nix-prefix="$(NIX_PREFIX)" \
|
||||
--enable-daemon
|
||||
|
||||
dist-hook:
|
||||
-$(top_builddir)/pre-inst-env $(GUILE) \
|
||||
$(top_srcdir)/build-aux/sync-synopses.scm
|
||||
|
|
|
|||
10
README
10
README
|
|
@ -51,6 +51,16 @@ The "autoreconf -vi" command can be used to generate the build system
|
|||
infrastructure; it reports an error if an inappropriate version of the
|
||||
above packages is being used.
|
||||
|
||||
* Installing Guix from Guix
|
||||
|
||||
You can re-build and re-install Guix using a system that already runs Guix.
|
||||
To do so:
|
||||
|
||||
- install the dependencies (see 'Requirements' above) using Guix
|
||||
- re-run the configure script passing it the option
|
||||
`--with-libgcrypt-prefix=$HOME/.guix-profile/'
|
||||
- run "make" and "make install"
|
||||
|
||||
* How It Works
|
||||
|
||||
Guix does the high-level preparation of a /derivation/. A derivation is
|
||||
|
|
|
|||
|
|
@ -0,0 +1,62 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;;
|
||||
;;; Report synopses that defer from those found in the GNU Womb.
|
||||
;;;
|
||||
|
||||
(use-modules (guix gnu-maintenance)
|
||||
(guix packages)
|
||||
(guix utils)
|
||||
(guix ui)
|
||||
(gnu packages)
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-26)
|
||||
(ice-9 match))
|
||||
|
||||
(define official
|
||||
;; GNU package descriptors from the Womb.
|
||||
(official-gnu-packages))
|
||||
|
||||
(define gnus
|
||||
;; GNU packages available in the distro.
|
||||
(let ((lookup (lambda (p)
|
||||
(find (lambda (descriptor)
|
||||
(equal? (gnu-package-name descriptor)
|
||||
(package-name p)))
|
||||
official))))
|
||||
(fold-packages (lambda (package result)
|
||||
(or (and=> (lookup package)
|
||||
(cut alist-cons package <> result))
|
||||
result))
|
||||
'())))
|
||||
|
||||
;; Iterate over GNU packages. Report those whose synopsis defers from that
|
||||
;; found upstream.
|
||||
(for-each (match-lambda
|
||||
((package . descriptor)
|
||||
(let ((upstream (gnu-package-doc-summary descriptor))
|
||||
(downstream (package-synopsis package))
|
||||
(loc (or (package-field-location package 'synopsis)
|
||||
(package-location package))))
|
||||
(unless (and upstream (string=? upstream downstream))
|
||||
(format (guix-warning-port)
|
||||
"~a: ~a: proposed synopsis: ~s~%"
|
||||
(location->string loc) (package-name package)
|
||||
upstream)))))
|
||||
gnus)
|
||||
|
|
@ -141,8 +141,10 @@ Distribution}.
|
|||
@node Installation
|
||||
@chapter Installation
|
||||
|
||||
This section describes the software requirements of Guix, as well as how
|
||||
to install it and get ready to use it.
|
||||
GNU Guix is available for download from its website at
|
||||
@url{http://www.gnu.org/software/guix/}. This section describes the
|
||||
software requirements of Guix, as well as how to install it and get
|
||||
ready to use it.
|
||||
|
||||
The build procedure for Guix is the same as for other GNU software, and
|
||||
is not covered here. Please see the files @file{README} and
|
||||
|
|
@ -293,6 +295,10 @@ The following command-line options are supported:
|
|||
Take users from @var{group} to run build processes (@pxref{Setting Up
|
||||
the Daemon, build users}).
|
||||
|
||||
@item --no-substitutes
|
||||
Do not use substitutes for build products. That is, always build things
|
||||
locally instead of allowing downloads of pre-built binaries.
|
||||
|
||||
@item --cache-failures
|
||||
Cache build failures. By default, only successful builds are cached.
|
||||
|
||||
|
|
@ -447,11 +453,8 @@ scripts, etc. This direct correspondence allows users to make sure a
|
|||
given package installation matches the current state of their
|
||||
distribution, and helps maximize @dfn{reproducibility}.
|
||||
|
||||
@c FIXME: Remove footnote when it's implemented.
|
||||
This foundation allows Guix to support @dfn{transparent binary/source
|
||||
deployment}@footnote{This feature is not implemented as of version
|
||||
@value{VERSION}. Please contact @email{bug-guix@@gnu.org} for more
|
||||
details.}. When a pre-built binary for a @file{/nix/store} path is
|
||||
deployment}. When a pre-built binary for a @file{/nix/store} path is
|
||||
available from an external source, Guix just downloads it; otherwise, it
|
||||
builds the package from source, locally.
|
||||
|
||||
|
|
@ -537,9 +540,10 @@ multiple-output package.
|
|||
@itemx -r @var{package}
|
||||
Remove @var{package}.
|
||||
|
||||
@item --upgrade=@var{regexp}
|
||||
@itemx -u @var{regexp}
|
||||
Upgrade all the installed packages matching @var{regexp}.
|
||||
@item --upgrade[=@var{regexp}]
|
||||
@itemx -u [@var{regexp}]
|
||||
Upgrade all the installed packages. When @var{regexp} is specified, upgrade
|
||||
only installed packages whose name matches @var{regexp}.
|
||||
|
||||
Note that this upgrades package to the latest version of packages found
|
||||
in the distribution currently installed. To update your distribution,
|
||||
|
|
@ -810,8 +814,9 @@ the GNU mirrors defined in @code{(guix download)}.
|
|||
The @code{sha256} field specifies the expected SHA256 hash of the file
|
||||
being downloaded. It is mandatory, and allows Guix to check the
|
||||
integrity of the file. The @code{(base32 @dots{})} form introduces the
|
||||
base32 representation of the hash. A convenient way to obtain this
|
||||
information is with the @code{guix download} tool.
|
||||
base32 representation of the hash. You can obtain this information with
|
||||
the @code{guix hash} (@pxref{Invoking guix hash}) and @code{guix
|
||||
download} tools.
|
||||
|
||||
@item
|
||||
@cindex GNU Build System
|
||||
|
|
@ -1090,6 +1095,7 @@ space.
|
|||
|
||||
@menu
|
||||
* Invoking guix build:: Building packages from the command line.
|
||||
* Invoking guix hash:: Computing the cryptographic hash of a file.
|
||||
@end menu
|
||||
|
||||
@node Invoking guix build
|
||||
|
|
@ -1185,6 +1191,37 @@ the @code{package-derivation} procedure of the @code{(guix packages)}
|
|||
module, and to the @code{build-derivations} procedure of the @code{(guix
|
||||
store)} module.
|
||||
|
||||
@node Invoking guix hash
|
||||
@section Invoking @command{guix hash}
|
||||
|
||||
The @command{guix hash} command allows to check the integrity of a file.
|
||||
It is primarily a convenience tool for anyone contributing to the
|
||||
distribution: it computes the cryptographic hash of a file, which can be
|
||||
used in the definition of a package (@pxref{Defining Packages}).
|
||||
|
||||
The general syntax is:
|
||||
|
||||
@example
|
||||
guix hash @var{option} @var{file}
|
||||
@end example
|
||||
|
||||
@command{guix hash} has the following option:
|
||||
|
||||
@table @code
|
||||
|
||||
@item --format=@var{fmt}
|
||||
@itemx -f @var{fmt}
|
||||
Write the hash in the given format.
|
||||
|
||||
Supported formats: @code{nix-base32}, @code{base32}, @code{base16}
|
||||
(@code{hex} and @code{hexadecimal} can be used as well).
|
||||
|
||||
If the @option{--format} option is not specified, @command{guix hash}
|
||||
will output the hash in @code{nix-base32}. This representation is used
|
||||
in the definitions of packages.
|
||||
|
||||
@end table
|
||||
|
||||
@c *********************************************************************
|
||||
@node GNU Distribution
|
||||
@chapter GNU Distribution
|
||||
|
|
|
|||
|
|
@ -19,6 +19,7 @@
|
|||
|
||||
(define-module (gnu packages)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (ice-9 vlist)
|
||||
|
|
@ -90,9 +91,8 @@
|
|||
result)
|
||||
(const #f) ; skip
|
||||
(lambda (path stat errno result)
|
||||
(format (current-error-port)
|
||||
(_ "warning: cannot access `~a': ~a~%")
|
||||
path (strerror errno))
|
||||
(warning (_ "cannot access `~a': ~a~%")
|
||||
path (strerror errno))
|
||||
result)
|
||||
'()
|
||||
%distro-module-directory
|
||||
|
|
@ -110,14 +110,6 @@
|
|||
(false-if-exception (resolve-interface name))))
|
||||
(package-files)))
|
||||
|
||||
(define (fold2 f seed1 seed2 lst)
|
||||
(if (null? lst)
|
||||
(values seed1 seed2)
|
||||
(call-with-values
|
||||
(lambda () (f (car lst) seed1 seed2))
|
||||
(lambda (seed1 seed2)
|
||||
(fold2 f seed1 seed2 (cdr lst))))))
|
||||
|
||||
(define (fold-packages proc init)
|
||||
"Call (PROC PACKAGE RESULT) for each available package, using INIT as
|
||||
the initial value of RESULT. It is guaranteed to never traverse the
|
||||
|
|
|
|||
|
|
@ -92,7 +92,7 @@ solve the shortest vector problem.")
|
|||
"18qf6jzz1r3mzb5qynywv4xx3z9g61hgkbpkdrhbgqh2g7jhgfc5"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://www.gnu.org/software/gsl/")
|
||||
(synopsis "The GNU Scientific Library, a large numerical library")
|
||||
(synopsis "Numerical library for C and C++")
|
||||
(description
|
||||
"The GNU Scientific Library (GSL) is a numerical library for C
|
||||
and C++ programmers. It is free software under the GNU General
|
||||
|
|
@ -177,7 +177,7 @@ PARI is also available as a C library to allow for faster computations.")
|
|||
(string-append "--prefix=" out)))))
|
||||
%standard-phases)))
|
||||
(home-page "http://www.gnu.org/software/bc/")
|
||||
(synopsis "GNU software calculator")
|
||||
(synopsis "Arbitrary precision numeric processing language")
|
||||
(description
|
||||
"bc is an arbitrary precision numeric processing language. Syntax
|
||||
is similar to C, but differs in many substantial areas. It supports
|
||||
|
|
|
|||
|
|
@ -38,8 +38,7 @@
|
|||
(build-system gnu-build-system)
|
||||
(inputs `(("perl" ,perl)))
|
||||
(home-page "http://aspell.net/")
|
||||
(synopsis
|
||||
"GNU Aspell, A spell checker for many languages")
|
||||
(synopsis "Spell checker")
|
||||
(description
|
||||
"GNU Aspell is a free spell checker designed to eventually replace
|
||||
Ispell. It can either be used as a library or as an independent spell
|
||||
|
|
|
|||
|
|
@ -50,8 +50,7 @@
|
|||
(arguments `(#:tests? #f))
|
||||
(home-page
|
||||
"http://www.gnu.org/software/autoconf/")
|
||||
(synopsis
|
||||
"GNU Autoconf, a part of the GNU Build System")
|
||||
(synopsis "Create source code configuration scripts")
|
||||
(description
|
||||
"GNU Autoconf is an extensible package of M4 macros that produce
|
||||
shell scripts to automatically configure software source code
|
||||
|
|
@ -149,8 +148,17 @@ exec ~a --no-auto-compile \"$0\" \"$@\"
|
|||
("perl" ,perl)
|
||||
("patch/skip-amhello"
|
||||
,(search-patch "automake-skip-amhello-tests.patch"))))
|
||||
(native-search-paths
|
||||
(list (search-path-specification
|
||||
(variable "ACLOCAL_PATH")
|
||||
(directories '("share/aclocal")))))
|
||||
(arguments
|
||||
'(#:patches (list (assoc-ref %build-inputs "patch/skip-amhello"))
|
||||
#:modules ((guix build gnu-build-system)
|
||||
(guix build utils)
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-26)
|
||||
(rnrs io ports))
|
||||
#:phases (alist-cons-before
|
||||
'patch-source-shebangs 'patch-tests-shebangs
|
||||
(lambda _
|
||||
|
|
@ -163,15 +171,37 @@ exec ~a --no-auto-compile \"$0\" \"$@\"
|
|||
;; that occur during the test suite.
|
||||
(setenv "SHELL" sh)
|
||||
(setenv "CONFIG_SHELL" sh)))
|
||||
%standard-phases)))
|
||||
(native-search-paths
|
||||
(list (search-path-specification
|
||||
(variable "ACLOCAL_PATH")
|
||||
(directories '("share/aclocal")))))
|
||||
|
||||
;; Files like `install-sh', `mdate.sh', etc. must use
|
||||
;; #!/bin/sh, otherwise users could leak erroneous shebangs
|
||||
;; in the wild. See <http://bugs.gnu.org/14201> for an
|
||||
;; example.
|
||||
(alist-cons-after
|
||||
'install 'unpatch-shebangs
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
(dir (string-append out "/share")))
|
||||
(define (starts-with-shebang? file)
|
||||
(equal? (call-with-input-file file
|
||||
(lambda (p)
|
||||
(list (get-u8 p) (get-u8 p))))
|
||||
(map char->integer '(#\# #\!))))
|
||||
|
||||
(for-each (lambda (file)
|
||||
(when (and (starts-with-shebang? file)
|
||||
(executable-file? file))
|
||||
(format #t "restoring shebang on `~a'~%"
|
||||
file)
|
||||
(substitute* file
|
||||
(("^#!.*/bin/sh")
|
||||
"#!/bin/sh")
|
||||
(("^#!.*/bin/env(.*)$" _ args)
|
||||
(string-append "#!/usr/bin/env"
|
||||
args)))))
|
||||
(find-files dir ".*"))))
|
||||
%standard-phases))))
|
||||
(home-page "http://www.gnu.org/software/automake/")
|
||||
(synopsis
|
||||
"GNU Automake, a GNU standard-compliant makefile generator")
|
||||
(synopsis "Making GNU standards-compliant Makefiles")
|
||||
(description
|
||||
"GNU Automake is a tool for automatically generating
|
||||
`Makefile.in' files compliant with the GNU Coding
|
||||
|
|
@ -225,7 +255,7 @@ Standards. Automake requires the use of Autoconf.")
|
|||
%standard-phases)))
|
||||
(inputs `(("patch/skip-tests"
|
||||
,(search-patch "libtool-skip-tests.patch"))))
|
||||
(synopsis "GNU Libtool, a generic library support script")
|
||||
(synopsis "Generic shared library support tools")
|
||||
(description
|
||||
"GNU libtool is a generic library support script. Libtool hides the
|
||||
complexity of using shared libraries behind a consistent, portable interface.
|
||||
|
|
|
|||
|
|
@ -18,7 +18,8 @@
|
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu packages base)
|
||||
#:use-module (guix licenses)
|
||||
#:use-module ((guix licenses)
|
||||
#:select (gpl3+ lgpl2.0+))
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages acl)
|
||||
#:use-module (gnu packages bash)
|
||||
|
|
@ -61,7 +62,7 @@
|
|||
,(string-append "--with-gawk=" ; for illustration purposes
|
||||
(assoc-ref %build-inputs "gawk")))))
|
||||
(inputs `(("gawk" ,gawk)))
|
||||
(synopsis "GNU Hello")
|
||||
(synopsis "Hello, GNU world: An example GNU package")
|
||||
(description "Yeah...")
|
||||
(home-page "http://www.gnu.org/software/hello/")
|
||||
(license gpl3+)))
|
||||
|
|
@ -78,7 +79,7 @@
|
|||
(base32
|
||||
"1qbjb1l7f9blckc5pqy8jlf6482hpx4awn2acmhyf5mv9wfq03p7"))))
|
||||
(build-system gnu-build-system)
|
||||
(synopsis "GNU implementation of the Unix grep command")
|
||||
(synopsis "Print lines matching a pattern")
|
||||
(description
|
||||
"The grep command searches one or more input files for lines containing a
|
||||
match to a specified pattern. By default, grep prints the matching
|
||||
|
|
@ -98,7 +99,7 @@ lines.")
|
|||
(base32
|
||||
"1myvrmh99jsvk7v3d7crm0gcrq51hmmm1r2kjyyci152in1x2j7h"))))
|
||||
(build-system gnu-build-system)
|
||||
(synopsis "GNU sed, a batch stream editor")
|
||||
(synopsis "Stream editor")
|
||||
(arguments
|
||||
`(#:phases (alist-cons-before
|
||||
'patch-source-shebangs 'patch-test-suite
|
||||
|
|
@ -134,7 +135,7 @@ substituting multiple occurrences of a string within a file.")
|
|||
(inputs `(("patch/gets" ,(search-patch "tar-gets-undeclared.patch"))))
|
||||
(arguments
|
||||
`(#:patches (list (assoc-ref %build-inputs "patch/gets"))))
|
||||
(synopsis "GNU implementation of the `tar' archiver")
|
||||
(synopsis "Managing tar archives")
|
||||
(description
|
||||
"The Tar program provides the ability to create tar archives, as well as
|
||||
various other kinds of manipulation. For example, you can use Tar on
|
||||
|
|
@ -167,7 +168,7 @@ files (as archives).")
|
|||
;; TODO: When cross-compiling, add this:
|
||||
;; '(#:configure-flags '("ac_cv_func_strnlen_working=yes"))
|
||||
)
|
||||
(synopsis "GNU Patch, a program to apply differences to files")
|
||||
(synopsis "Apply differences to originals, with optional backups")
|
||||
(description
|
||||
"GNU Patch takes a patch file containing a difference listing produced by
|
||||
the diff program and applies those differences to one or more original files,
|
||||
|
|
@ -190,7 +191,7 @@ producing patched versions.")
|
|||
(inputs `(("patch/gets"
|
||||
,(search-patch "diffutils-gets-undeclared.patch"))))
|
||||
(arguments `(#:patches (list (assoc-ref %build-inputs "patch/gets"))))
|
||||
(synopsis "Programs to find differences among text files")
|
||||
(synopsis "Comparing and merging files")
|
||||
(description
|
||||
"GNU Diffutils is a package of several programs related to finding
|
||||
differences between files.
|
||||
|
|
@ -243,8 +244,7 @@ You can use the sdiff command to merge two files interactively.")
|
|||
;; `(#:configure-flags '("gl_cv_func_wcwidth_works=yes")
|
||||
;; ,@(arguments cross-system))
|
||||
)
|
||||
(synopsis "Basic directory searching utilities of the GNU operating
|
||||
system")
|
||||
(synopsis "Operating on files matching given criteria")
|
||||
(description
|
||||
"The GNU Find Utilities are the basic directory searching utilities of
|
||||
the GNU operating system. These programs are typically used in conjunction
|
||||
|
|
@ -291,9 +291,7 @@ The tools supplied with this package are:
|
|||
(("#!/bin/sh")
|
||||
(format #f "#!~a/bin/bash" bash)))))
|
||||
%standard-phases)))
|
||||
(synopsis
|
||||
"The basic file, shell and text manipulation utilities of the GNU
|
||||
operating system")
|
||||
(synopsis "Core GNU utilities (file, text, shell)")
|
||||
(description
|
||||
"The GNU Core Utilities are the basic file, shell and text manipulation
|
||||
utilities of the GNU operating system. These are the core utilities which
|
||||
|
|
@ -327,8 +325,7 @@ are expected to exist on every operating system.")
|
|||
(format #f "default_shell[] = \"~a/bin/bash\";\n"
|
||||
bash)))))
|
||||
%standard-phases)))
|
||||
(synopsis "GNU Make, a program controlling the generation of non-source
|
||||
files from sources")
|
||||
(synopsis "Remake files automatically")
|
||||
(description
|
||||
"Make is a tool which controls the generation of executables and other
|
||||
non-source files of a program from the program's source files.
|
||||
|
|
@ -374,8 +371,7 @@ that it is possible to use Make to build and install the program.")
|
|||
;; expression >= 0 is always true" in wchar.h.
|
||||
"--disable-werror")))
|
||||
|
||||
(synopsis "GNU Binutils, tools for manipulating binaries (linker,
|
||||
assembler, etc.)")
|
||||
(synopsis "Binary utilities: bfd gas gprof ld")
|
||||
(description
|
||||
"The GNU Binutils are a collection of binary tools. The main ones are
|
||||
`ld' (the GNU linker) and `as' (the GNU assembler). They also include the
|
||||
|
|
@ -383,6 +379,17 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
|
|||
(license gpl3+)
|
||||
(home-page "http://www.gnu.org/software/binutils/")))
|
||||
|
||||
(define-public binutils-2.23
|
||||
(package (inherit binutils)
|
||||
(version "2.23.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/binutils/binutils-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"15qhbkz3r266xaa52slh857qn3abw7rb2x2jnhpfrafpzrb4x4gy"))))))
|
||||
|
||||
(define-public glibc
|
||||
(package
|
||||
(name "glibc")
|
||||
|
|
@ -958,6 +965,35 @@ store.")
|
|||
,@(fold alist-delete (package-inputs ld-wrapper-boot3)
|
||||
'("guile" "bash"))))))
|
||||
|
||||
(define-public ld-wrapper-2.23 ; TODO: remove when Binutils is updated
|
||||
(package (inherit ld-wrapper)
|
||||
(inputs `(("binutils" ,binutils-2.23)
|
||||
,@(alist-delete "binutils" (package-inputs ld-wrapper))))))
|
||||
|
||||
(define-public gcc-4.8
|
||||
;; FIXME: Move to gcc.scm when Binutils is updated.
|
||||
(package (inherit gcc-4.7)
|
||||
(version "4.8.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/gcc/gcc-"
|
||||
version "/gcc-" version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"0b6cp9d1sas3vq6dj3zrgd134p9b569fqhbixb9cl7mp698zwdxh"))))
|
||||
(inputs `(("gmp" ,gmp)
|
||||
("mpfr" ,mpfr)
|
||||
("mpc" ,mpc)
|
||||
("isl" ,isl)
|
||||
("cloog" ,cloog)
|
||||
("zlib" ,(@ (gnu packages compression) zlib))
|
||||
|
||||
;; With ld from Binutils 2.22, we get the following error while
|
||||
;; linking gcov:
|
||||
;; ld: gcov: hidden symbol `__deregister_frame_info' in /nix/store/47myfniw4x7kfc601d7q1yvz5mixlr00-gcc-4.7.2/lib/gcc/x86_64-unknown-linux-gnu/4.7.2/libgcc_eh.a(unwind-dw2-fde-dip.o) is referenced by DSO
|
||||
;; See <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=57015>.
|
||||
("ld-wrapper" ,ld-wrapper-2.23)))))
|
||||
|
||||
(define-public %final-inputs
|
||||
;; Final derivations used as implicit inputs by `gnu-build-system'.
|
||||
(let ((finalize (cut package-with-explicit-inputs <> %boot4-inputs
|
||||
|
|
|
|||
|
|
@ -76,7 +76,7 @@
|
|||
#:phases (alist-cons-after 'install 'post-install
|
||||
,post-install-phase
|
||||
%standard-phases)))
|
||||
(synopsis "GNU Bourne-Again Shell")
|
||||
(synopsis "The GNU Bourne-Again SHell")
|
||||
(description
|
||||
"Bash is the shell, or command language interpreter, that will appear in
|
||||
the GNU operating system. Bash is an sh-compatible shell that incorporates
|
||||
|
|
|
|||
|
|
@ -40,8 +40,7 @@
|
|||
(inputs `(("perl" ,perl)))
|
||||
(propagated-inputs `(("m4" ,m4)))
|
||||
(home-page "http://www.gnu.org/software/bison/")
|
||||
(synopsis
|
||||
"GNU Bison, a Yacc-compatible parser generator")
|
||||
(synopsis "Parser generator")
|
||||
(description
|
||||
"Bison is a general-purpose parser generator that converts an
|
||||
annotated context-free grammar into an LALR(1) or GLR parser for
|
||||
|
|
|
|||
|
|
@ -78,7 +78,7 @@ caching facility provided by the library.")
|
|||
("pkg-config" ,pkg-config)
|
||||
("libcddb" ,libcddb)))
|
||||
(home-page "http://www.gnu.org/software/libcdio/")
|
||||
(synopsis "A library for OS-independent CD-ROM and CD image access")
|
||||
(synopsis "CD Input and Control library")
|
||||
(description
|
||||
"GNU libcdio is a library for OS-idependent CD-ROM and CD image access.
|
||||
It includes a library for working with ISO-9660 filesystems (libiso9660), as
|
||||
|
|
@ -88,14 +88,14 @@ well as utility programs such as an audio CD player and an extractor.")
|
|||
(define-public xorriso
|
||||
(package
|
||||
(name "xorriso")
|
||||
(version "1.2.4")
|
||||
(version "1.2.8")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/xorriso/xorriso-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1b2xh2x9fz4ihwfrmjzhbkfsrwi9c3zpmchgk7hqlkydzfgydwz8"))))
|
||||
"1h3w9ymhsi0wghcnl7mmlml40rm4yill1c75g90xc7r1a2g8k1mn"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("acl" ,acl)
|
||||
|
|
@ -104,7 +104,7 @@ well as utility programs such as an audio CD player and an extractor.")
|
|||
("zlib" ,zlib)
|
||||
("libcdio" ,libcdio)))
|
||||
(home-page "http://www.gnu.org/software/xorriso/")
|
||||
(synopsis "An ISO 9660 Rock Ridge file system manipulator")
|
||||
(synopsis "Create, manipulate, burn ISO-9660 filesystems")
|
||||
(description
|
||||
"GNU xorriso copies file objects from POSIX compliant filesystems into
|
||||
Rock Ridge enhanced ISO 9660 filesystems and allows session-wise manipulation
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@
|
|||
"1jkbq97ajcf834z68hbn3xfhiz921zhn39gklml1racf0kb3jzh3"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://www.gnu.org/software/cflow/")
|
||||
(synopsis "A tool to analyze the control flow of C programs")
|
||||
(synopsis "Create a graph of control flow within a program")
|
||||
(description
|
||||
"GNU cflow analyzes a collection of C source files and prints a
|
||||
graph, charting control flow within the program.
|
||||
|
|
|
|||
|
|
@ -73,7 +73,7 @@ in compression.")
|
|||
(base32
|
||||
"18rm80kar7n016g8bsyy1a3zk50i2826xdgs874yh64rzj7nxmdm"))))
|
||||
(build-system gnu-build-system)
|
||||
(synopsis "Gzip, the GNU zip compression program")
|
||||
(synopsis "General file (de)compression (using lzw)")
|
||||
(arguments
|
||||
;; FIXME: The test suite wants `less', and optionally Perl.
|
||||
'(#:tests? #f))
|
||||
|
|
|
|||
|
|
@ -42,8 +42,7 @@
|
|||
(inputs
|
||||
`(("patch/gets" ,(search-patch "cpio-gets-undeclared.patch"))))
|
||||
(home-page "https://www.gnu.org/software/cpio/")
|
||||
(synopsis
|
||||
"A program to create or extract from cpio archives")
|
||||
(synopsis "Manage cpio and tar file archives")
|
||||
(description
|
||||
"GNU Cpio copies files into or out of a cpio or tar archive. The
|
||||
archive can be another file on the disk, a magnetic tape, or a pipe.
|
||||
|
|
@ -55,4 +54,4 @@ default, cpio creates binary format archives, for compatibility with
|
|||
older cpio programs. When extracting from archives, cpio automatically
|
||||
recognizes which kind of archive it is reading and can read archives
|
||||
created on machines with a different byte-order.")
|
||||
(license gpl3+)))
|
||||
(license gpl3+)))
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@
|
|||
"1jk42cjaggk71rimjnx3qpmb6hivps0917vl3z7wbxk3i2whb98j"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://www.gnu.org/software/cppi/")
|
||||
(synopsis "A cpp directive indenter")
|
||||
(synopsis "Indent C preprocessor directives to reflect nesting and more")
|
||||
(description
|
||||
"GNU cppi indents C preprocessor directives to reflect their nesting and
|
||||
ensure that there is exactly one space character between each #if, #elif,
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@
|
|||
(build-system gnu-build-system)
|
||||
(home-page
|
||||
"http://www.gnu.org/software/ddrescue/ddrescue.html")
|
||||
(synopsis "GNU Ddrescue, a data recovery tool")
|
||||
(synopsis "Data recovery utility")
|
||||
(description
|
||||
"GNU Ddrescue is a data recovery tool. It copies data from one
|
||||
file or block device (e.g., hard disk, CD-ROM) to another, trying hard to
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@
|
|||
(define-public dejagnu
|
||||
(package
|
||||
(name "dejagnu")
|
||||
(version "1.5")
|
||||
(version "1.5.1")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
|
@ -34,7 +34,7 @@
|
|||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1nx3x3h96a82q92q108q71giv2nz9xmbbn2nrlr3wvvs6l45id68"))))
|
||||
"1lik8h4qi7x0mhsi8xmj91an1yb63rjbk6v4xrmzgiy5lk8lgrv0"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("expect" ,expect)))
|
||||
(arguments
|
||||
|
|
@ -75,7 +75,7 @@
|
|||
%standard-phases))))
|
||||
(home-page
|
||||
"http://www.gnu.org/software/dejagnu/")
|
||||
(synopsis "The DejaGNU testing framework")
|
||||
(synopsis "GNU software testing framework")
|
||||
(description
|
||||
"DejaGnu is a framework for testing other programs. Its purpose
|
||||
is to provide a single front end for all tests. Think of it as a
|
||||
|
|
|
|||
|
|
@ -26,14 +26,14 @@
|
|||
(define-public ed
|
||||
(package
|
||||
(name "ed")
|
||||
(version "1.6")
|
||||
(version "1.8")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/ed/ed-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0rcay0wci2kiwil2h505b674cblmn4nq8pqw9g9pgqmaqjq6f711"))))
|
||||
"0wvj190ky5i0gm0pilx9k75l6alyc6h5s14fm3dbk90y7g9kihb4"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:configure-flags '("CC=gcc")
|
||||
|
|
@ -43,8 +43,7 @@
|
|||
(("/bin/sh") (which "sh"))))
|
||||
%standard-phases)))
|
||||
(home-page "http://www.gnu.org/software/ed/")
|
||||
(synopsis
|
||||
"GNU ed, an implementation of the standard Unix editor")
|
||||
(synopsis "Line-oriented text editor")
|
||||
(description
|
||||
"GNU ed is a line-oriented text editor. It is used to create,
|
||||
display, modify and otherwise manipulate text files, both
|
||||
|
|
|
|||
|
|
@ -90,8 +90,7 @@
|
|||
("patch/epaths" ,(search-patch "emacs-configure-sh.patch"))
|
||||
))
|
||||
(home-page "http://www.gnu.org/software/emacs/")
|
||||
(synopsis
|
||||
"GNU Emacs 24, the extensible, customizable text editor")
|
||||
(synopsis "The extensible, customizable, self-documenting text editor")
|
||||
(description
|
||||
"GNU Emacs is an extensible, customizable text editor—and more. At its
|
||||
core is an interpreter for Emacs Lisp, a dialect of the Lisp
|
||||
|
|
|
|||
|
|
@ -46,9 +46,8 @@
|
|||
("util-linux" ,util-linux)
|
||||
("parted" ,parted)))
|
||||
(home-page "https://www.gnu.org/software/fdisk/")
|
||||
(synopsis
|
||||
"GNU Fdisk, a command-line disk partitioning tool")
|
||||
(synopsis "Low-level disk partitioning and formatting")
|
||||
(description
|
||||
"GNU Fdisk provides alternatives to util-linux fdisk and util-linux
|
||||
cfdisk. It uses GNU Parted.")
|
||||
(license gpl3+)))
|
||||
(license gpl3+)))
|
||||
|
|
|
|||
|
|
@ -51,7 +51,7 @@
|
|||
%standard-phases)))
|
||||
(inputs `(("libsigsegv" ,libsigsegv)))
|
||||
(home-page "http://www.gnu.org/software/gawk/")
|
||||
(synopsis "GNU implementation of the Awk programming language")
|
||||
(synopsis "A text scanning and processing language")
|
||||
(description
|
||||
"Many computer users need to manipulate text files: extract and then
|
||||
operate on data from parts of certain lines while discarding the rest, make
|
||||
|
|
|
|||
|
|
@ -17,7 +17,8 @@
|
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu packages gcc)
|
||||
#:use-module (guix licenses)
|
||||
#:use-module ((guix licenses)
|
||||
#:select (gpl3+ gpl2+ lgpl2.1+ lgpl2.0+))
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (gnu packages compression)
|
||||
|
|
@ -140,7 +141,7 @@
|
|||
(directories '("lib" "lib64")))))
|
||||
|
||||
(properties `((gcc-libc . ,(assoc-ref inputs "libc"))))
|
||||
(synopsis "The GNU Compiler Collection")
|
||||
(synopsis "GNU Compiler Collection")
|
||||
(description
|
||||
"The GNU Compiler Collection includes compiler front ends for C, C++,
|
||||
Objective-C, Fortran, OpenMP for C/C++/Fortran, Java, and Ada, as well as
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@
|
|||
("texinfo" ,texinfo)
|
||||
("dejagnu" ,dejagnu)))
|
||||
(home-page "http://www.gnu.org/software/gdb/")
|
||||
(synopsis "GDB, the GNU Project debugger")
|
||||
(synopsis "The GNU debugger")
|
||||
(description
|
||||
"GDB, the GNU Project debugger, allows you to see what is going
|
||||
on `inside' another program while it executes -- or what another
|
||||
|
|
|
|||
|
|
@ -37,7 +37,8 @@
|
|||
(arguments `(#:configure-flags '("--enable-libgdbm-compat")))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://www.gnu.org/software/gdbm/")
|
||||
(synopsis "GNU dbm key/value database library")
|
||||
(synopsis
|
||||
"Hash library of database functions compatible with traditional dbm")
|
||||
(description
|
||||
"GNU dbm (or GDBM, for short) is a library of database functions
|
||||
that use extensible hashing and work similar to the standard UNIX dbm.
|
||||
|
|
|
|||
|
|
@ -56,8 +56,7 @@
|
|||
,(search-patch "gettext-gets-undeclared.patch"))))
|
||||
(home-page
|
||||
"http://www.gnu.org/software/gettext/")
|
||||
(synopsis
|
||||
"GNU gettext, a well integrated set of translation tools and documentation")
|
||||
(synopsis "Tools and documentation for translation")
|
||||
(description
|
||||
"Usually, programs are written and documented in English, and use
|
||||
English at execution time for interacting with users. Using a common
|
||||
|
|
|
|||
|
|
@ -163,7 +163,7 @@ printing, and psresize, for adjusting page sizes.")
|
|||
(apply install args)
|
||||
(system* "make" "install-so")))
|
||||
%standard-phases)))))
|
||||
(synopsis "GNU Ghostscript, an interpreter for the PostScript language and for PDF")
|
||||
(synopsis "PostScript and PDF interpreter")
|
||||
(description
|
||||
"GNU Ghostscript is an interpreter for PostScript and Portable Document
|
||||
Format (PDF) files.
|
||||
|
|
|
|||
|
|
@ -121,7 +121,7 @@ shared NFS home directories.")
|
|||
#:configure-flags (list (string-append "--with-html-dir="
|
||||
(assoc-ref %outputs "doc")
|
||||
"/share/gtk-doc"))))
|
||||
(synopsis "C library that provides core application building blocks")
|
||||
(synopsis "Thread-safe general utility library; basis of GTK+ and GNOME")
|
||||
(description
|
||||
"GLib provides data structure handling for C, portability wrappers,
|
||||
and interfaces for such runtime functionality as an event loop, threads,
|
||||
|
|
|
|||
|
|
@ -44,7 +44,7 @@
|
|||
(list (string-append "--with-ncurses="
|
||||
(assoc-ref %build-inputs "ncurses")))))
|
||||
(home-page "http://www.gnu.org/software/global/")
|
||||
(synopsis "GNU GLOBAL source code tag system")
|
||||
(synopsis "Cross-environment source code tag system")
|
||||
(description
|
||||
"GNU GLOBAL is a source code tagging system that works the same way
|
||||
across diverse environments (Emacs, vi, less, Bash, web browser, etc).
|
||||
|
|
|
|||
|
|
@ -57,20 +57,19 @@ Daemon and possibly more in the future.")
|
|||
(define-public libgcrypt
|
||||
(package
|
||||
(name "libgcrypt")
|
||||
(version "1.5.1")
|
||||
(version "1.5.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnupg/libgcrypt/libgcrypt-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"09z5zbxhvg6c7n8qcm8h9ygr28qli2n83hfq1f69jsg711cb37md"))))
|
||||
"0gwnzqd64cpwdmk93nll54nidsr74jpimxzj4p4z7502ylwl66p4"))))
|
||||
(build-system gnu-build-system)
|
||||
(propagated-inputs
|
||||
`(("libgpg-error" ,libgpg-error)))
|
||||
(home-page "http://gnupg.org/")
|
||||
(synopsis
|
||||
"GNU Libgcrypt, a general-pupose cryptographic library")
|
||||
(synopsis "Cryptographic function library")
|
||||
(description
|
||||
"GNU Libgcrypt is a general purpose cryptographic library based on
|
||||
the code from GnuPG. It provides functions for all
|
||||
|
|
@ -166,8 +165,7 @@ specifications are building blocks of S/MIME and TLS.")
|
|||
(apply configure args)))
|
||||
%standard-phases)))
|
||||
(home-page "http://gnupg.org/")
|
||||
(synopsis
|
||||
"GNU Privacy Guard (GnuPG), GNU Project's implementation of the OpenPGP standard")
|
||||
(synopsis "GNU Privacy Guard")
|
||||
(description
|
||||
"GnuPG is the GNU project's complete and free implementation of
|
||||
the OpenPGP standard as defined by RFC4880. GnuPG allows to
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@
|
|||
(define-public libtasn1
|
||||
(package
|
||||
(name "libtasn1")
|
||||
(version "3.2")
|
||||
(version "3.3")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
|
@ -39,10 +39,10 @@
|
|||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0gvgndypwicchf7m660zh7jdgmkfj9g9xavpcc08pyd0120y0bk7"))))
|
||||
"1h1sz5py8zlg4yczybr6wa925pyadvjcxrdmhilwaqqgs4n2lrcj"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://www.gnu.org/software/libtasn1/")
|
||||
(synopsis "GNU Libtasn1, an ASN.1 library")
|
||||
(synopsis "ASN.1 library")
|
||||
(description
|
||||
"Libtasn1 is the ASN.1 library used by GnuTLS, GNU Shishi and some
|
||||
other packages. The goal of this implementation is to be highly
|
||||
|
|
@ -73,7 +73,7 @@ portable, and only require an ANSI C89 platform.")
|
|||
("nettle" ,nettle)
|
||||
("which" ,which)))
|
||||
(home-page "http://www.gnu.org/software/gnutls/")
|
||||
(synopsis "The GNU Transport Layer Security Library")
|
||||
(synopsis "Transport layer security library")
|
||||
(description
|
||||
"GnuTLS is a project that aims to develop a library which provides
|
||||
a secure layer, over a reliable transport layer. Currently the GnuTLS
|
||||
|
|
|
|||
|
|
@ -37,8 +37,7 @@
|
|||
(build-system gnu-build-system)
|
||||
(arguments '(#:parallel-tests? #f))
|
||||
(home-page "http://www.gnu.org/software/gperf/")
|
||||
(synopsis
|
||||
"GNU gperf, a perfect hash function generator")
|
||||
(synopsis "Perfect hash function generator")
|
||||
(description
|
||||
"GNU gperf is a perfect hash function generator. For a given
|
||||
list of strings, it produces a hash function and hash table, in
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -25,15 +26,15 @@
|
|||
(define-public gprolog
|
||||
(package
|
||||
(name "gprolog")
|
||||
(version "1.4.2")
|
||||
(version "1.4.3")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://www.gprolog.org/gprolog-"
|
||||
version ".tar.gz"))
|
||||
(uri (string-append "mirror://gnu/gprolog/gprolog-" version
|
||||
".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0y25c2gwz41i6g28qyfjklrmanzgk0c8cr4jn2s7s8qgd9dnm1fm"))))
|
||||
"16yl6q9ydx9d8lphg9xkk53l1m0fq0kpvrhry8njsxhhncazm4j2"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:phases (alist-cons-before
|
||||
|
|
@ -45,9 +46,7 @@
|
|||
(("= /bin/sh") (string-append "= " (which "sh")))))
|
||||
%standard-phases)))
|
||||
(home-page "https://www.gnu.org/software/gprolog/")
|
||||
(synopsis
|
||||
"GNU Prolog, a free Prolog compiler with constraint solving over
|
||||
finite domains")
|
||||
(synopsis "Prolog compiler")
|
||||
(description
|
||||
"GNU Prolog is a free Prolog compiler with constraint solving over
|
||||
finite domains developed by Daniel Diaz.
|
||||
|
|
@ -69,4 +68,4 @@ interface, sockets).
|
|||
GNU Prolog also includes an efficient constraint solver over finite domains.
|
||||
This opens contraint logic programming to the user combining the power of
|
||||
constraint programming to the declarativity of logic programming.")
|
||||
(license (list gpl2+ lgpl3+))))
|
||||
(license (list gpl2+ lgpl3+))))
|
||||
|
|
|
|||
|
|
@ -31,13 +31,13 @@
|
|||
(define-public groff
|
||||
(package
|
||||
(name "groff")
|
||||
(version "1.22.1")
|
||||
(version "1.22.2")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/groff/groff-" version
|
||||
".tar.gz"))
|
||||
(sha256 (base32
|
||||
"1kihja9sj182pqms8lah2nn3y96rqccws7w04f7f7wpy84vs5bvn"))))
|
||||
"0xi07nhj5vdgax37rj25mwxzdmsz1ifx50hjgc6hqbkpqkd6821q"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("bison" ,bison)
|
||||
("ghostscript" ,ghostscript)
|
||||
|
|
@ -45,7 +45,7 @@
|
|||
("perl" ,perl)
|
||||
("psutils" ,psutils)
|
||||
("texinfo" ,texinfo)))
|
||||
(synopsis "GNU Troff text formatting system")
|
||||
(synopsis "Typesetting from plain text mixed with formatting commands")
|
||||
(description
|
||||
"GNU Troff (Groff) is a software typesetting package which reads plain
|
||||
text mixed with formatting commands and produces formatted output.")
|
||||
|
|
|
|||
|
|
@ -73,8 +73,7 @@
|
|||
("qemu" ,qemu)
|
||||
("xorriso" ,xorriso)))
|
||||
(home-page "http://www.gnu.org/software/grub/")
|
||||
(synopsis
|
||||
"GNU GRUB, the Grand Unified Boot Loader (2.x beta)")
|
||||
(synopsis "GRand unified boot loader")
|
||||
(description
|
||||
"GNU GRUB is a Multiboot boot loader. It was derived from GRUB, GRand
|
||||
Unified Bootloader, which was originally designed and implemented by Erich
|
||||
|
|
|
|||
|
|
@ -61,7 +61,7 @@
|
|||
("shishi" ,shishi)
|
||||
("zlib" ,guix:zlib)
|
||||
))
|
||||
(synopsis "GNU GSS (Generic Security Service), a free implementatio of RFC 2743/2744")
|
||||
(synopsis "Generic Security Service library")
|
||||
(description
|
||||
"GNU GSS is an implementation of the Generic Security Service Application
|
||||
Program Interface (GSS-API). GSS-API is used by network servers to provide
|
||||
|
|
@ -87,7 +87,7 @@ SMTP/IMAP servers. GSS consists of a library and a manual.")
|
|||
("gss" ,gss)
|
||||
("zlib" ,guix:zlib)
|
||||
))
|
||||
(synopsis "GNU SASL, an implementation of the Simple Authentication and Security Layer framework")
|
||||
(synopsis "Simple Authentication and Security Layer library")
|
||||
(description
|
||||
"GNU SASL is an implementation of the Simple Authentication and Security
|
||||
Layer framework and a few common SASL mechanisms. SASL is used by network
|
||||
|
|
|
|||
|
|
@ -93,7 +93,7 @@
|
|||
(variable "GUILE_LOAD_PATH")
|
||||
(directories '("share/guile/site")))))
|
||||
|
||||
(synopsis "GNU Guile 1.8, an embeddable Scheme interpreter")
|
||||
(synopsis "Scheme implementation intended especially for extensions")
|
||||
(description
|
||||
"GNU Guile 1.8 is an interpreter for the Scheme programming language,
|
||||
packaged as a library that can be embedded into programs to make them
|
||||
|
|
@ -104,14 +104,14 @@ extensible. It supports many SRFIs.")
|
|||
(define-public guile-2.0
|
||||
(package
|
||||
(name "guile")
|
||||
(version "2.0.7")
|
||||
(version "2.0.9")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/guile/guile-" version
|
||||
".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0f53pxkia4v17n0avwqlcjpy0n89hkazm2xsa6p84lv8k6k8y9vg"))))
|
||||
"0nw9y8vjyz4r61v06p9msks5lm58pd91irmzg4k487vmv743h2pp"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("pkgconfig" ,pkg-config)))
|
||||
(inputs `(("libffi" ,libffi)
|
||||
|
|
@ -150,7 +150,7 @@ extensible. It supports many SRFIs.")
|
|||
(variable "GUILE_LOAD_COMPILED_PATH")
|
||||
(directories '("share/guile/site/2.0")))))
|
||||
|
||||
(synopsis "GNU Guile 2.0, an embeddable Scheme implementation")
|
||||
(synopsis "Scheme implementation intended especially for extensions")
|
||||
(description
|
||||
"GNU Guile is an implementation of the Scheme programming language, with
|
||||
support for many SRFIs, packaged for use in a wide variety of environments.
|
||||
|
|
@ -164,7 +164,15 @@ call interface, and powerful string processing.")
|
|||
(define-public guile-2.0/fixed
|
||||
;; A package of Guile 2.0 that's rarely changed. It is the one used
|
||||
;; in the `base' module, and thus changing it entails a full rebuild.
|
||||
guile-2.0)
|
||||
(package (inherit guile-2.0)
|
||||
(version "2.0.7")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/guile/guile-" version
|
||||
".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0f53pxkia4v17n0avwqlcjpy0n89hkazm2xsa6p84lv8k6k8y9vg"))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -244,8 +252,7 @@ many readers as needed).")
|
|||
out)))))
|
||||
%standard-phases)))
|
||||
(home-page "http://www.gnu.org/software/guile-ncurses/")
|
||||
(synopsis
|
||||
"GNU Guile-Ncurses, Scheme interface to the NCurses libraries")
|
||||
(synopsis "Guile bindings to ncurses")
|
||||
(description
|
||||
"GNU Guile-Ncurses is a library for the Guile Scheme interpreter that
|
||||
provides functions for creating text user interfaces. The text user interface
|
||||
|
|
@ -271,8 +278,7 @@ menu.")
|
|||
`(("ed" ,ed) ("which" ,which) ("guile" ,guile-1.8)
|
||||
("patch/install" ,(search-patch "mcron-install.patch"))))
|
||||
(home-page "http://www.gnu.org/software/mcron/")
|
||||
(synopsis
|
||||
"GNU mcron, a flexible implementation of `cron' in Guile")
|
||||
(synopsis "Run jobs at scheduled times")
|
||||
(description
|
||||
"The GNU package mcron (Mellor's cron) is a 100% compatible replacement
|
||||
for Vixie cron. It is written in pure Guile, and allows configuration files
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@
|
|||
;; ("gettext" ,gettext)
|
||||
))
|
||||
(home-page "http://www.gnu.org/software/help2man/")
|
||||
(synopsis "GNU help2man generates man pages from `--help' output")
|
||||
(synopsis "Automatically generate man pages from program --help")
|
||||
(description
|
||||
"help2man produces simple manual pages from the ‘--help’ and
|
||||
‘--version’ output of other commands.")
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@
|
|||
,(search-patch "diffutils-gets-undeclared.patch"))))
|
||||
(arguments `(#:patches (list (assoc-ref %build-inputs "patch/gets"))))
|
||||
(home-page "http://www.gnu.org/software/idutils/")
|
||||
(synopsis "GNU Idutils, a text searching utility")
|
||||
(synopsis "Identifier database utilities")
|
||||
(description
|
||||
"An \"ID database\" is a binary file containing a list of file
|
||||
names, a list of tokens, and a sparse matrix indicating which
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@
|
|||
(sha256 (base32
|
||||
"0f9655vqdvfwbxvs1gpa7py8k1z71aqh8hp73f65vazwbfz436wa"))))
|
||||
(build-system gnu-build-system)
|
||||
(synopsis "GNU Indent, a program for code indentation and formatting")
|
||||
(synopsis "Code reformatter")
|
||||
(description
|
||||
"GNU Indent can be used to make code easier to read. It can also convert
|
||||
from one style of writing C to another. Indent understands a substantial
|
||||
|
|
|
|||
|
|
@ -38,9 +38,7 @@
|
|||
(build-system gnu-build-system)
|
||||
(inputs `(("ncurses" ,ncurses)))
|
||||
(home-page "https://www.gnu.org/software/less/")
|
||||
(synopsis
|
||||
"GNU less is a program similar to more, but which allows backward
|
||||
movement in the file as well as forward movement")
|
||||
(synopsis "Paginator for terminals")
|
||||
(description
|
||||
"GNU less is a program similar to more, but which allows backward
|
||||
movement in the file as well as forward movement. Also, less does not
|
||||
|
|
@ -48,4 +46,4 @@ have to read the entire input file before starting, so with large input
|
|||
files it starts up faster than text editors like vi. Less uses
|
||||
termcap (or terminfo on some systems), so it can run on a variety of
|
||||
terminals. There is even limited support for hardcopy terminals.")
|
||||
(license gpl3+))) ; some files are under GPLv2+
|
||||
(license gpl3+))) ; some files are under GPLv2+
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@
|
|||
"0g657kv60rh486m7bwyp5k24ljmym4wnb8nmk6d3i3qgr1qlqbqa"))))
|
||||
(build-system gnu-build-system)
|
||||
;; FIXME: No Java and C# libraries are currently built.
|
||||
(synopsis "GNU Libidn, a library to encode and decode internationalised domain names")
|
||||
(synopsis "Internationalized string processing library")
|
||||
(description
|
||||
"GNU Libidn is a fully documented implementation of the Stringprep,
|
||||
Punycode and IDNA specifications. Libidn's purpose is to encode and decode
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@
|
|||
(base32 "16hrs8k3nmc7a8jam5j1fpspd6sdpkamskvsdpcw6m29vnis8q44"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://www.gnu.org/software/libsigsegv/")
|
||||
(synopsis "GNU libsigsegv, a library to handle page faults in user mode")
|
||||
(synopsis "Library for handling page faults")
|
||||
(description
|
||||
"GNU libsigsegv is a library for handling page faults in user mode. A page
|
||||
fault occurs when a program tries to access to a region of memory that is
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@
|
|||
"18q620269xzpw39dwvr9zpilnl2dkw5z5kz3mxaadnpv4k3kw3b1"))))
|
||||
(propagated-inputs '()) ; FIXME: add libiconv when !glibc
|
||||
(build-system gnu-build-system)
|
||||
(synopsis "GNU Libunistring, a Unicode string library")
|
||||
(synopsis "C library for manipulating Unicode strings")
|
||||
(description
|
||||
"This library provides functions for manipulating Unicode strings and for
|
||||
manipulating C strings according to the Unicode standard.
|
||||
|
|
|
|||
|
|
@ -193,7 +193,7 @@
|
|||
'install ,install-phase
|
||||
(alist-delete 'configure %standard-phases)))
|
||||
#:tests? #f))
|
||||
(synopsis "GNU Linux-Libre kernel")
|
||||
(synopsis "100% free redistribution of a cleaned Linux kernel")
|
||||
(description "Linux-Libre operating system kernel.")
|
||||
(license gpl2)
|
||||
(home-page "http://www.gnu.org/software/linux-libre/"))))
|
||||
|
|
|
|||
|
|
@ -117,8 +117,7 @@
|
|||
(which "cat"))))
|
||||
%standard-phases)))
|
||||
(home-page "http://www.lysator.liu.se/~nisse/lsh/")
|
||||
(synopsis
|
||||
"GNU lsh, a GPL'd implementation of the SSH protocol")
|
||||
(synopsis "GNU implementation of the Secure Shell (ssh) protocols")
|
||||
(description
|
||||
"lsh is a free implementation (in the GNU sense) of the ssh
|
||||
version 2 protocol, currently being standardised by the IETF
|
||||
|
|
|
|||
|
|
@ -61,7 +61,7 @@
|
|||
("patch/readlink-EINVAL"
|
||||
,(search-patch "m4-readlink-EINVAL.patch"))
|
||||
("patch/gets" ,(search-patch "m4-gets-undeclared.patch"))))
|
||||
(synopsis "GNU M4, a macro processor")
|
||||
(synopsis "Macro processor")
|
||||
(description
|
||||
"GNU M4 is an implementation of the traditional Unix macro processor. It
|
||||
is mostly SVR4 compatible although it has some extensions (for example,
|
||||
|
|
|
|||
|
|
@ -82,7 +82,7 @@
|
|||
("patch/gets-undeclared"
|
||||
,(search-patch "m4-gets-undeclared.patch"))))
|
||||
(home-page "http://www.gnu.org/software/mailutils/")
|
||||
(synopsis "A rich and powerful protocol-independent mail framework")
|
||||
(synopsis "Utilities and library for reading and serving mail")
|
||||
(description
|
||||
"GNU Mailutils is a rich and powerful protocol-independent mail
|
||||
framework. It contains a series of useful mail libraries, clients, and
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@
|
|||
;; sub-architectures.
|
||||
"--enable-fat"
|
||||
"--enable-cxx")))
|
||||
(synopsis "GMP, the GNU multiple precision arithmetic library")
|
||||
(synopsis "Multiple-precision arithmetic library")
|
||||
(description
|
||||
"GMP is a free library for arbitrary precision arithmetic, operating on
|
||||
signed integers, rational numbers, and floating point numbers. There is no
|
||||
|
|
@ -79,8 +79,7 @@ faster algorithms.")
|
|||
"0fs501qi8l523gs3cpy4jjcnvwxggyfbklcys80wq236xx3hz79r"))))
|
||||
(build-system gnu-build-system)
|
||||
(propagated-inputs `(("gmp" ,gmp))) ; <mpfr.h> refers to <gmp.h>
|
||||
(synopsis "GNU MPFR, a library for multiple-precision floating-point
|
||||
arithmetic")
|
||||
(synopsis "C library for arbitrary precision floating-point arithmetic")
|
||||
(description
|
||||
"The GNU MPFR library is a C library for multiple-precision
|
||||
floating-point computations with correct rounding. MPFR is based on the GMP
|
||||
|
|
@ -106,8 +105,7 @@ double-precision floating-point arithmetic (53-bit mantissa).")
|
|||
(build-system gnu-build-system)
|
||||
(propagated-inputs `(("gmp" ,gmp) ; <mpc.h> refers to both
|
||||
("mpfr" ,mpfr)))
|
||||
(synopsis "GNU MPC, a library for multiprecision complex arithmetic
|
||||
with exact rounding")
|
||||
(synopsis "C library for arbitrary precision complex arithmetic")
|
||||
(description
|
||||
"GNU MPC is a C library for the arithmetic of complex numbers with
|
||||
arbitrarily high precision and correct rounding of the result. It extends
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@
|
|||
(define-public nano
|
||||
(package
|
||||
(name "nano")
|
||||
(version "2.2.6")
|
||||
(version "2.3.2")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
|
@ -36,17 +36,16 @@
|
|||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0yp6pid67k8h7394spzw0067fl2r7rxm2b6kfccg87g8nlry2s5y"))))
|
||||
"1s3b21h5p7r8xafw0gahswj16ai6k2vnjhmd15b491hl0x494c7z"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("gettext" ,guix:gettext)
|
||||
("ncurses" ,ncurses)))
|
||||
(home-page "http://www.nano-editor.org/")
|
||||
(synopsis
|
||||
"A small, user-friendly console text editor")
|
||||
(synopsis "Small, user-friendly console text editor")
|
||||
(description
|
||||
"GNU nano is designed to be a free replacement for the Pico text
|
||||
editor, part of the Pine email suite from The University of
|
||||
Washington. It aims to emulate Pico as closely as possible and perhaps
|
||||
include extra functionality.")
|
||||
(license gpl3+))) ; some files are under GPLv2+
|
||||
(license gpl3+))) ; some files are under GPLv2+
|
||||
|
|
|
|||
|
|
@ -107,8 +107,7 @@
|
|||
,configure-phase
|
||||
%standard-phases)))))
|
||||
(self-native-input? #t)
|
||||
(synopsis
|
||||
"GNU Ncurses, a free software emulation of curses in SVR4 and more")
|
||||
(synopsis "Terminal emulation (termcap, terminfo) library")
|
||||
(description
|
||||
"The Ncurses (new curses) library is a free software emulation of curses
|
||||
in System V Release 4.0, and more. It uses Terminfo format, supports pads
|
||||
|
|
|
|||
|
|
@ -27,19 +27,19 @@
|
|||
(define-public nettle
|
||||
(package
|
||||
(name "nettle")
|
||||
(version "2.6")
|
||||
(version "2.7")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/nettle/nettle-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0mminj3fg0vba8qx4q6dbf0xz6fskamli7z2r8rci5xrcd7n5pv0"))))
|
||||
"1mnl5i1136p47lrklm0mhnnv3gjakza385zvxz12qf057h9ym562"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("m4" ,m4)))
|
||||
(propagated-inputs `(("gmp" ,gmp)))
|
||||
(home-page "http://www.lysator.liu.se/~nisse/nettle/")
|
||||
(synopsis "GNU Nettle, a cryptographic library")
|
||||
(synopsis "C library for low-level crytographic functionality")
|
||||
(description
|
||||
"Nettle is a cryptographic library that is designed to fit easily
|
||||
in more or less any context: In crypto toolkits for object-oriented
|
||||
|
|
|
|||
|
|
@ -94,8 +94,7 @@ polyphonic) audio and music at fixed and variable bitrates from 16 to
|
|||
(build-system gnu-build-system)
|
||||
(inputs `(("libogg" ,libogg)))
|
||||
(home-page "https://gnu.org/software/speex")
|
||||
(synopsis
|
||||
"GNU Speex, a patent-free voice codec")
|
||||
(synopsis "Library for patent-free audio compression format")
|
||||
(description
|
||||
"GNU Speex is a patent-free voice codec. It is designed to
|
||||
compress voice at bitrates in the 2--45 kbps range. Possible
|
||||
|
|
|
|||
|
|
@ -58,8 +58,7 @@
|
|||
("readline" ,readline)
|
||||
("util-linux" ,util-linux)))
|
||||
(home-page "http://www.gnu.org/software/parted/")
|
||||
(synopsis
|
||||
"GNU Parted, a tool to manipulate partitions")
|
||||
(synopsis "Disk partition editor")
|
||||
(description
|
||||
"GNU Parted is an industrial-strength package for creating, destroying,
|
||||
resizing, checking and copying partitions, and the file systems on them. This
|
||||
|
|
@ -68,4 +67,4 @@ usage, copying data on hard disks and disk imaging.
|
|||
|
||||
It contains a library, libparted, and a command-line frontend, parted, which
|
||||
also serves as a sample implementation and script backend.")
|
||||
(license gpl3+)))
|
||||
(license gpl3+)))
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@
|
|||
(build-system gnu-build-system)
|
||||
(arguments '(#:parallel-build? #f))
|
||||
(home-page "http://www.gnu.org/software/pth")
|
||||
(synopsis "The GNU Portable Threads library")
|
||||
(synopsis "Portable thread library")
|
||||
(description
|
||||
"Pth is a very portable POSIX/ANSI-C based library for Unix
|
||||
platforms which provides non-preemptive priority-based scheduling for
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@
|
|||
(define-public python
|
||||
(package
|
||||
(name "python")
|
||||
(version "2.7.3")
|
||||
(version "2.7.4")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
|
@ -39,12 +39,10 @@
|
|||
version "/Python-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"11f9aw855lrmknr6c82gm1ijr3n0smc6idyp94y7774yivjnplv1"))))
|
||||
"0bdn4dylm92n2dsvqvjfyask9jbz88aan5hi4lgkawkxs2v6wqmn"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:tests? #f ; XXX: some tests fail
|
||||
#:patches (list (assoc-ref %build-inputs "patch-dbm"))
|
||||
#:patch-flags '("-p0")
|
||||
#:configure-flags
|
||||
(let ((bz2 (assoc-ref %build-inputs "bzip2"))
|
||||
(gdbm (assoc-ref %build-inputs "gdbm"))
|
||||
|
|
@ -68,8 +66,7 @@
|
|||
("gdbm" ,gdbm)
|
||||
("openssl" ,openssl)
|
||||
("readline" ,readline)
|
||||
("zlib" ,zlib)
|
||||
("patch-dbm" ,(search-patch "python-fix-dbm.patch"))))
|
||||
("zlib" ,zlib)))
|
||||
(native-search-paths
|
||||
(list (search-path-specification
|
||||
(variable "PYTHONPATH")
|
||||
|
|
|
|||
|
|
@ -62,7 +62,7 @@
|
|||
'install 'post-install
|
||||
,post-install-phase
|
||||
%standard-phases)))
|
||||
(synopsis "GNU Readline, a library for interactive line editing")
|
||||
(synopsis "Edit command lines while typing, with history support")
|
||||
(description
|
||||
"The GNU Readline library provides a set of functions for use by
|
||||
applications that allow users to edit command lines as they are typed in.
|
||||
|
|
|
|||
|
|
@ -46,8 +46,7 @@
|
|||
("patch/gets"
|
||||
,(search-patch "diffutils-gets-undeclared.patch"))))
|
||||
(arguments `(#:patches (list (assoc-ref %build-inputs "patch/gets"))))
|
||||
(synopsis "GNU recutils, tools and libraries to access human-editable,
|
||||
text-based databases")
|
||||
(synopsis "Manipulate plain text files as databases")
|
||||
(description
|
||||
"GNU recutils is a set of tools and libraries to access human-editable,
|
||||
text-based databases called recfiles. The data is stored as a sequence of
|
||||
|
|
|
|||
|
|
@ -102,7 +102,7 @@
|
|||
(base32
|
||||
"0pclakzwxbqgy6wqwvs6ml62wgby8ba8xzmwzdwhx1v8wv05yw1j"))))))))
|
||||
(home-page "http://www.gnu.org/software/mit-scheme/")
|
||||
(synopsis "MIT/GNU Scheme, a native code Scheme compiler")
|
||||
(synopsis "Scheme implementation with integrated editor and debugger")
|
||||
(description
|
||||
"MIT/GNU Scheme is an implementation of the Scheme programming
|
||||
language, providing an interpreter, compiler, source-code debugger,
|
||||
|
|
@ -197,7 +197,7 @@ between Scheme and C# programs.")
|
|||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"04fhy5jp9lq12fmdqfjzj1w32f7nxc80fagbj7pfci7xh86nm2c5"))))
|
||||
"1v2r4ga58kk1sx0frn8qa8ccmjpic9csqzpk499wc95y9c4b1wy3"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@
|
|||
`(("ncurses", ncurses)
|
||||
("perl" ,perl)))
|
||||
(home-page "http://www.gnu.org/software/screen/")
|
||||
(synopsis "GNU Screen, a terminal multiplexer")
|
||||
(synopsis "Full-screen window manager providing multiple terminals")
|
||||
(description
|
||||
"GNU screen is a full-screen window manager that multiplexes a physical
|
||||
terminal between several processes, typically interactive shells. Each virtual
|
||||
|
|
|
|||
|
|
@ -46,8 +46,7 @@
|
|||
("libgcrypt" ,libgcrypt)
|
||||
("libtasn1" ,libtasn1)))
|
||||
(home-page "http://www.gnu.org/software/shishi/")
|
||||
(synopsis
|
||||
"GNU Shishi, an implementation of the Kerberos 5 network security system")
|
||||
(synopsis "Implementation of the Kerberos 5 network security system")
|
||||
(description
|
||||
"Shishi contains a library ('libshishi') that can be used by application
|
||||
developers to add support for Kerberos 5. Shishi contains a command line
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@
|
|||
(define-public smalltalk
|
||||
(package
|
||||
(name "smalltalk")
|
||||
(version "3.2.4")
|
||||
(version "3.2.5")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
|
@ -34,7 +34,7 @@
|
|||
version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1bdhbppjv1fswh4ls9q90zix38l1hg9qd4c4bz1pbg1af991xq3a"))))
|
||||
"1k2ssrapfzhngc7bg1zrnd9n2vyxp9c9m70byvsma6wapbvib6l1"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("zip" ,zip)))
|
||||
(arguments
|
||||
|
|
@ -47,8 +47,7 @@
|
|||
(("@LIBC_SO_DIR@") (string-append libc "/lib")))))
|
||||
%standard-phases)))
|
||||
(home-page "https://www.gnu.org/software/smalltalk/")
|
||||
(synopsis
|
||||
"GNU Smalltalk, a free implementation of the Smalltalk-80 language")
|
||||
(synopsis "Smalltalk environment")
|
||||
(description
|
||||
"GNU Smalltalk is a free implementation of the Smalltalk-80 language.
|
||||
|
||||
|
|
|
|||
|
|
@ -38,8 +38,7 @@
|
|||
"18w0dbg77i56cx1bwa789w0qi3l4xkkbascxcv2b6gbm0zmjg1g6"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "http://www.gnu.org/software/pies/")
|
||||
(synopsis
|
||||
"GNU Pies, a program invocation and execution supervisor")
|
||||
(synopsis "Program invocation and execution supervisor")
|
||||
(description
|
||||
"The name Pies (pronounced \"p-yes\") stands for Program Invocation
|
||||
and Execution Supervisor. This utility starts and controls execution of
|
||||
|
|
@ -81,8 +80,7 @@ it can replace the inetd utility!")
|
|||
(inputs `(("patch/gets" ,(search-patch "diffutils-gets-undeclared.patch"))
|
||||
("ncurses" ,ncurses)))
|
||||
(home-page "http://www.gnu.org/software/inetutils/")
|
||||
(synopsis
|
||||
"GNU Inetutils, a collection of common network programs")
|
||||
(synopsis "Basic networking utilities")
|
||||
(description
|
||||
"The GNU network utilities suite provides the following tools:
|
||||
ftp(d), hostname, ifconfig, inetd, logger, ping, rcp, rexec(d),
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@
|
|||
;; TODO: Remove Perl from here when 'patch-shebang' DTRT with /usr/bin/env.
|
||||
(propagated-inputs `(("perl" ,perl))) ; yuck!
|
||||
(home-page "http://www.gnu.org/software/texinfo/")
|
||||
(synopsis "GNU Texinfo, the GNU documentation system")
|
||||
(synopsis "The GNU documentation format")
|
||||
(description
|
||||
"Texinfo is the official documentation format of the GNU project.
|
||||
It was invented by Richard Stallman and Bob Chassell many years
|
||||
|
|
|
|||
|
|
@ -49,9 +49,7 @@
|
|||
(string-append "--prefix=" out)))))
|
||||
%standard-phases)))
|
||||
(home-page "http://www.gnu.org/software/time/")
|
||||
(synopsis
|
||||
"GNU Time, a tool that runs programs and summarizes the system
|
||||
resources they use")
|
||||
(synopsis "Run a command, then display its resource usage")
|
||||
(description
|
||||
"The 'time' command runs another program, then displays information
|
||||
about the resources used by that program, collected by the system while
|
||||
|
|
|
|||
|
|
@ -21,13 +21,14 @@
|
|||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages texinfo)
|
||||
#:use-module (gnu packages screen)
|
||||
#:use-module (gnu packages which))
|
||||
|
||||
(define-public wdiff
|
||||
(package
|
||||
(name "wdiff")
|
||||
(version "1.1.2")
|
||||
(version "1.2.1")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
|
@ -35,7 +36,7 @@
|
|||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0q78y5awvjjmsvizqilbpwany62shlmlq2ayxkjbygmdafpk1k8j"))))
|
||||
"1gb5hpiyikada9bwz63q3g96zs383iskiir0xsqynqnvq1vd4n41"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:phases (alist-cons-before
|
||||
|
|
@ -46,10 +47,12 @@
|
|||
(string-append "#!" (which "sh")))))
|
||||
%standard-phases)))
|
||||
(inputs `(("screen" ,screen)
|
||||
("which" ,which)))
|
||||
("which" ,which)
|
||||
|
||||
;; For some reason wdiff.info gets rebuilt.
|
||||
("texinfo" ,texinfo)))
|
||||
(home-page "https://www.gnu.org/software/wdiff/")
|
||||
(synopsis
|
||||
"GNU Wdiff, a tool for comparing files on a word by word basis")
|
||||
(synopsis "Word difference finder")
|
||||
(description
|
||||
"GNU Wdiff is a front end to 'diff' for comparing files on a word per
|
||||
word basis. A word is anything between whitespace. This is useful for
|
||||
|
|
@ -58,4 +61,4 @@ paragraphs have been refilled. It works by creating two temporary files, one
|
|||
word per line, and then executes 'diff' on these files. It collects the
|
||||
'diff' output and uses it to produce a nicer display of word differences
|
||||
between the original files.")
|
||||
(license gpl3+)))
|
||||
(license gpl3+)))
|
||||
|
|
|
|||
|
|
@ -44,8 +44,7 @@
|
|||
("perl" ,perl)
|
||||
("gettext" ,guix:gettext)))
|
||||
(home-page "http://www.gnu.org/software/wget/")
|
||||
(synopsis
|
||||
"GNU Wget, a tool for retrieving files using HTTP, HTTPS, and FTP")
|
||||
(synopsis "Non-interactive command-line utility for downloading files")
|
||||
(description
|
||||
"GNU Wget is a free software package for retrieving files using HTTP,
|
||||
HTTPS and FTP, the most widely-used Internet protocols. It is a
|
||||
|
|
|
|||
|
|
@ -36,8 +36,7 @@
|
|||
"1y2p50zadb36izzh2zw4dm5hvdiydqf3qa88l8kav20dcmfbc5yl"))))
|
||||
(build-system gnu-build-system)
|
||||
(home-page "https://gnu.org/software/which/")
|
||||
(synopsis
|
||||
"GNU Which shows the full path of (shell) commands")
|
||||
(synopsis "Find full path of shell commands")
|
||||
(description
|
||||
"GNU Which takes one or more arguments. For each of its arguments
|
||||
it prints to stdout the full path of the executables that would have
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@
|
|||
("perl" ,perl)
|
||||
("help2man" ,help2man)))
|
||||
(home-page "http://www.gnu.org/software/zile/")
|
||||
(synopsis "GNU Zile, a lightweight Emacs clone")
|
||||
(synopsis "Zile is lossy Emacs, a lightweight Emacs clone")
|
||||
(description
|
||||
"GNU Zile, which is a lightweight Emacs clone. Zile is short
|
||||
for Zile Is Lossy Emacs. Zile has been written to be as
|
||||
|
|
|
|||
|
|
@ -48,6 +48,7 @@
|
|||
derivation-input?
|
||||
derivation-input-path
|
||||
derivation-input-sub-derivations
|
||||
derivation-input-output-paths
|
||||
|
||||
fixed-output-derivation?
|
||||
derivation-hash
|
||||
|
|
@ -99,6 +100,14 @@ download with a fixed hash (aka. `fetchurl')."
|
|||
#t)
|
||||
(_ #f)))
|
||||
|
||||
(define (derivation-input-output-paths input)
|
||||
"Return the list of output paths corresponding to INPUT, a
|
||||
<derivation-input>."
|
||||
(match input
|
||||
(($ <derivation-input> path sub-drvs)
|
||||
(map (cut derivation-path->output-path path <>)
|
||||
sub-drvs))))
|
||||
|
||||
(define (derivation-prerequisites drv)
|
||||
"Return the list of derivation-inputs required to build DRV, recursively."
|
||||
(let loop ((drv drv)
|
||||
|
|
@ -113,47 +122,85 @@ download with a fixed hash (aka. `fetchurl')."
|
|||
inputs)))))
|
||||
|
||||
(define* (derivation-prerequisites-to-build store drv
|
||||
#:key (outputs
|
||||
(map
|
||||
car
|
||||
(derivation-outputs drv))))
|
||||
"Return the list of derivation-inputs required to build the OUTPUTS of
|
||||
DRV and not already available in STORE, recursively."
|
||||
#:key
|
||||
(outputs
|
||||
(map
|
||||
car
|
||||
(derivation-outputs drv)))
|
||||
(use-substitutes? #t))
|
||||
"Return two values: the list of derivation-inputs required to build the
|
||||
OUTPUTS of DRV and not already available in STORE, recursively, and the list
|
||||
of required store paths that can be substituted. When USE-SUBSTITUTES? is #f,
|
||||
that second value is the empty list."
|
||||
(define (derivation-output-paths drv sub-drvs)
|
||||
(match drv
|
||||
(($ <derivation> outputs)
|
||||
(map (lambda (sub-drv)
|
||||
(derivation-output-path (assoc-ref outputs sub-drv)))
|
||||
sub-drvs))))
|
||||
|
||||
(define built?
|
||||
(cut valid-path? store <>))
|
||||
|
||||
(define substitutable?
|
||||
;; Return true if the given path is substitutable. Call
|
||||
;; `substitutable-paths' upfront, to benefit from parallelism in the
|
||||
;; substituter.
|
||||
(if use-substitutes?
|
||||
(let ((s (substitutable-paths store
|
||||
(append
|
||||
(derivation-output-paths drv outputs)
|
||||
(append-map
|
||||
derivation-input-output-paths
|
||||
(derivation-prerequisites drv))))))
|
||||
(cut member <> s))
|
||||
(const #f)))
|
||||
|
||||
(define input-built?
|
||||
(match-lambda
|
||||
(($ <derivation-input> path sub-drvs)
|
||||
(let ((out (map (cut derivation-path->output-path path <>)
|
||||
sub-drvs)))
|
||||
(any built? out)))))
|
||||
(compose (cut any built? <>) derivation-input-output-paths))
|
||||
|
||||
(define input-substitutable?
|
||||
;; Return true if and only if all of SUB-DRVS are subsitutable. If at
|
||||
;; least one is missing, then everything must be rebuilt.
|
||||
(compose (cut every substitutable? <>) derivation-input-output-paths))
|
||||
|
||||
(define (derivation-built? drv sub-drvs)
|
||||
(match drv
|
||||
(($ <derivation> outputs)
|
||||
(let ((paths (map (lambda (sub-drv)
|
||||
(derivation-output-path
|
||||
(assoc-ref outputs sub-drv)))
|
||||
sub-drvs)))
|
||||
(every built? paths)))))
|
||||
(every built? (derivation-output-paths drv sub-drvs)))
|
||||
|
||||
(let loop ((drv drv)
|
||||
(sub-drvs outputs)
|
||||
(result '()))
|
||||
(if (derivation-built? drv sub-drvs)
|
||||
result
|
||||
(let ((inputs (remove (lambda (i)
|
||||
(or (member i result) ; XXX: quadratic
|
||||
(input-built? i)))
|
||||
(derivation-inputs drv))))
|
||||
(fold loop
|
||||
(append inputs result)
|
||||
(map (lambda (i)
|
||||
(call-with-input-file (derivation-input-path i)
|
||||
read-derivation))
|
||||
inputs)
|
||||
(map derivation-input-sub-derivations inputs))))))
|
||||
(define (derivation-substitutable? drv sub-drvs)
|
||||
(every substitutable? (derivation-output-paths drv sub-drvs)))
|
||||
|
||||
(let loop ((drv drv)
|
||||
(sub-drvs outputs)
|
||||
(build '())
|
||||
(substitute '()))
|
||||
(cond ((derivation-built? drv sub-drvs)
|
||||
(values build substitute))
|
||||
((derivation-substitutable? drv sub-drvs)
|
||||
(values build
|
||||
(append (derivation-output-paths drv sub-drvs)
|
||||
substitute)))
|
||||
(else
|
||||
(let ((inputs (remove (lambda (i)
|
||||
(or (member i build) ; XXX: quadratic
|
||||
(input-built? i)
|
||||
(input-substitutable? i)))
|
||||
(derivation-inputs drv))))
|
||||
(fold2 loop
|
||||
(append inputs build)
|
||||
(append (append-map (lambda (input)
|
||||
(if (and (not (input-built? input))
|
||||
(input-substitutable? input))
|
||||
(derivation-input-output-paths
|
||||
input)
|
||||
'()))
|
||||
(derivation-inputs drv))
|
||||
substitute)
|
||||
(map (lambda (i)
|
||||
(call-with-input-file (derivation-input-path i)
|
||||
read-derivation))
|
||||
inputs)
|
||||
(map derivation-input-sub-derivations inputs)))))))
|
||||
|
||||
(define (%read-derivation drv-port)
|
||||
;; Actually read derivation from DRV-PORT.
|
||||
|
|
|
|||
|
|
@ -21,13 +21,15 @@
|
|||
#:use-module (ice-9 match)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix packages)
|
||||
#:use-module ((guix store) #:select (derivation-path?))
|
||||
#:use-module ((guix store) #:select (derivation-path? add-to-store))
|
||||
#:use-module ((guix build download) #:renamer (symbol-prefix-proc 'build:))
|
||||
#:use-module (guix utils)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (%mirrors
|
||||
url-fetch))
|
||||
url-fetch
|
||||
download-to-store))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
|
@ -230,4 +232,17 @@ must be a list of symbol/URL-list pairs."
|
|||
#:guile-for-build guile-for-build
|
||||
#:env-vars env-vars)))
|
||||
|
||||
(define* (download-to-store store url #:optional (name (basename url))
|
||||
#:key (log (current-error-port)))
|
||||
"Download from URL to STORE, either under NAME or URL's basename if
|
||||
omitted. Write progress reports to LOG."
|
||||
(call-with-temporary-output-file
|
||||
(lambda (temp port)
|
||||
(let ((result
|
||||
(parameterize ((current-output-port log))
|
||||
(build:url-fetch url temp #:mirrors %mirrors))))
|
||||
(close port)
|
||||
(and result
|
||||
(add-to-store store name #f "sha256" temp))))))
|
||||
|
||||
;;; download.scm ends here
|
||||
|
|
|
|||
|
|
@ -28,9 +28,17 @@
|
|||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (system foreign)
|
||||
#:use-module (guix web)
|
||||
#:use-module (guix ftp-client)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix packages)
|
||||
#:use-module ((guix download) #:select (download-to-store))
|
||||
#:use-module (guix gnupg)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (guix base32)
|
||||
#:use-module ((guix build utils)
|
||||
#:select (substitute))
|
||||
#:export (gnu-package-name
|
||||
gnu-package-mundane-name
|
||||
gnu-package-copyright-holder
|
||||
|
|
@ -49,7 +57,10 @@
|
|||
|
||||
releases
|
||||
latest-release
|
||||
gnu-package-name->name+version))
|
||||
gnu-package-name->name+version
|
||||
package-update-path
|
||||
package-update
|
||||
update-package-source))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
|
@ -63,46 +74,11 @@
|
|||
;;; List of GNU packages.
|
||||
;;;
|
||||
|
||||
(define (http-fetch uri)
|
||||
"Return an input port containing the textual data at URI, a string."
|
||||
(let*-values (((resp data)
|
||||
(let ((uri (string->uri uri)))
|
||||
;; Try hard to use the API du jour to get an input port.
|
||||
(if (version>? "2.0.7" (version))
|
||||
(if (defined? 'http-get*)
|
||||
(http-get* uri)
|
||||
(http-get uri)) ; old Guile, returns a string
|
||||
(http-get uri #:streaming? #t)))) ; 2.0.8 or later
|
||||
((code)
|
||||
(response-code resp)))
|
||||
(case code
|
||||
((200)
|
||||
(cond ((not data)
|
||||
(begin
|
||||
;; XXX: Guile 2.0.5 and earlier did not support chunked transfer
|
||||
;; encoding, which is required when fetching %PACKAGE-LIST-URL
|
||||
;; (see <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>).
|
||||
;; Since users may still be using these versions, warn them and
|
||||
;; bail out.
|
||||
(format (current-error-port)
|
||||
"warning: using Guile ~a, ~a ~s encoding~%"
|
||||
(version)
|
||||
"which does not support HTTP"
|
||||
(response-transfer-encoding resp))
|
||||
(error "download failed; use a newer Guile"
|
||||
uri resp)))
|
||||
((string? data) ; old `http-get' returns a string
|
||||
(open-input-string data))
|
||||
(else ; input port
|
||||
data)))
|
||||
(else
|
||||
(error "download failed" uri code
|
||||
(response-reason-phrase resp))))))
|
||||
|
||||
(define %package-list-url
|
||||
(string-append "http://cvs.savannah.gnu.org/"
|
||||
"viewvc/*checkout*/gnumaint/"
|
||||
"gnupackages.txt?root=womb"))
|
||||
(string->uri
|
||||
(string-append "http://cvs.savannah.gnu.org/"
|
||||
"viewvc/*checkout*/gnumaint/"
|
||||
"gnupackages.txt?root=womb")))
|
||||
|
||||
(define-record-type* <gnu-package-descriptor>
|
||||
gnu-package-descriptor
|
||||
|
|
@ -188,7 +164,7 @@
|
|||
"savannah" "fsd" "language" "logo"
|
||||
"doc-category" "doc-summary" "doc-urls"
|
||||
"download-url")))
|
||||
(group-package-fields (http-fetch %package-list-url)
|
||||
(group-package-fields (http-fetch %package-list-url #:text? #t)
|
||||
'(())))))
|
||||
|
||||
(define (find-packages regexp)
|
||||
|
|
@ -201,16 +177,17 @@
|
|||
|
||||
(define gnu-package?
|
||||
(memoize
|
||||
(lambda (package)
|
||||
"Return true if PACKAGE is a GNU package. This procedure may access the
|
||||
(let ((official-gnu-packages (memoize official-gnu-packages)))
|
||||
(lambda (package)
|
||||
"Return true if PACKAGE is a GNU package. This procedure may access the
|
||||
network to check in GNU's database."
|
||||
;; TODO: Find a way to determine that a package is non-GNU without going
|
||||
;; through the network.
|
||||
(let ((url (and=> (package-source package) origin-uri))
|
||||
(name (package-name package)))
|
||||
(or (and (string? url) (string-prefix? "mirror://gnu" url))
|
||||
(and (member name (map gnu-package-name (official-gnu-packages)))
|
||||
#t))))))
|
||||
;; TODO: Find a way to determine that a package is non-GNU without going
|
||||
;; through the network.
|
||||
(let ((url (and=> (package-source package) origin-uri))
|
||||
(name (package-name package)))
|
||||
(or (and (string? url) (string-prefix? "mirror://gnu" url))
|
||||
(and (member name (map gnu-package-name (official-gnu-packages)))
|
||||
#t)))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -234,6 +211,7 @@ stored."
|
|||
("mit-scheme" "ftp.gnu.org" "/gnu/mit-scheme/stable.pkg")
|
||||
("icecat" "ftp.gnu.org" "/gnu/gnuzilla")
|
||||
("source-highlight" "ftp.gnu.org" "/gnu/src-highlite")
|
||||
("glib" "ftp.gnome.org" "/pub/gnome/sources/glib")
|
||||
("TeXmacs" "ftp.texmacs.org" "/TeXmacs/targz")))
|
||||
|
||||
(match (assoc project quirks)
|
||||
|
|
@ -242,30 +220,33 @@ stored."
|
|||
(_
|
||||
(values "ftp.gnu.org" (string-append "/gnu/" project)))))
|
||||
|
||||
(define (sans-extension tarball)
|
||||
"Return TARBALL without its .tar.* extension."
|
||||
(let ((end (string-contains tarball ".tar")))
|
||||
(substring tarball 0 end)))
|
||||
|
||||
(define %tarball-rx
|
||||
(make-regexp "^(.+)-([0-9]|[^-])*(-src)?\\.tar\\."))
|
||||
|
||||
(define %alpha-tarball-rx
|
||||
(make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\."))
|
||||
|
||||
(define (release-file project file)
|
||||
"Return #f if FILE is not a release tarball of PROJECT, otherwise return
|
||||
PACKAGE-VERSION."
|
||||
(and (not (string-suffix? ".sig" file))
|
||||
(and=> (regexp-exec %tarball-rx file)
|
||||
(lambda (match)
|
||||
;; Filter out unrelated files, like `guile-www-1.1.1'.
|
||||
(equal? project (match:substring match 1))))
|
||||
(not (regexp-exec %alpha-tarball-rx file))
|
||||
(let ((s (sans-extension file)))
|
||||
(and (regexp-exec %package-name-rx s) s))))
|
||||
|
||||
(define (releases project)
|
||||
"Return the list of releases of PROJECT as a list of release name/directory
|
||||
pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\"). "
|
||||
;; TODO: Parse something like fencepost.gnu.org:/gd/gnuorg/packages-ftp.
|
||||
(define release-rx
|
||||
(make-regexp (string-append "^" project
|
||||
"-([0-9]|[^-])*(-src)?\\.tar\\.")))
|
||||
|
||||
(define alpha-rx
|
||||
(make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\."))
|
||||
|
||||
(define (sans-extension tarball)
|
||||
(let ((end (string-contains tarball ".tar")))
|
||||
(substring tarball 0 end)))
|
||||
|
||||
(define (release-file file)
|
||||
;; Return #f if FILE is not a release tarball, otherwise return
|
||||
;; PACKAGE-VERSION.
|
||||
(and (not (string-suffix? ".sig" file))
|
||||
(regexp-exec release-rx file)
|
||||
(not (regexp-exec alpha-rx file))
|
||||
(let ((s (sans-extension file)))
|
||||
(and (regexp-exec %package-name-rx s) s))))
|
||||
|
||||
(let-values (((server directory) (ftp-server/directory project)))
|
||||
(define conn (ftp-open server))
|
||||
|
||||
|
|
@ -291,7 +272,7 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
|
|||
;; guile-www; in mit-scheme, filter out binaries.
|
||||
(filter-map (match-lambda
|
||||
((file 'file . _)
|
||||
(and=> (release-file file)
|
||||
(and=> (release-file project file)
|
||||
(cut cons <> directory)))
|
||||
(_ #f))
|
||||
files)
|
||||
|
|
@ -299,14 +280,39 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
|
|||
|
||||
(define (latest-release project)
|
||||
"Return (\"FOO-X.Y\" . \"/bar/foo\") or #f."
|
||||
(let ((releases (releases project)))
|
||||
(and (not (null? releases))
|
||||
(fold (lambda (release latest)
|
||||
(if (version>? (car release) (car latest))
|
||||
release
|
||||
latest))
|
||||
'("" . "")
|
||||
releases))))
|
||||
(define (latest a b)
|
||||
(if (version>? a b) a b))
|
||||
|
||||
(define contains-digit?
|
||||
(cut string-any char-set:digit <>))
|
||||
|
||||
(let-values (((server directory) (ftp-server/directory project)))
|
||||
(define conn (ftp-open server))
|
||||
|
||||
(let loop ((directory directory))
|
||||
(let* ((entries (ftp-list conn directory))
|
||||
(subdirs (filter-map (match-lambda
|
||||
((dir 'directory . _) dir)
|
||||
(_ #f))
|
||||
entries)))
|
||||
(match subdirs
|
||||
(()
|
||||
;; No sub-directories, so assume that tarballs are here.
|
||||
(let ((files (filter-map (match-lambda
|
||||
((file 'file . _)
|
||||
(release-file project file))
|
||||
(_ #f))
|
||||
entries)))
|
||||
(and=> (reduce latest #f files)
|
||||
(cut cons <> directory))))
|
||||
((subdirs ...)
|
||||
;; Assume that SUBDIRS correspond to versions, and jump into the
|
||||
;; one with the highest version number. Filter out sub-directories
|
||||
;; that do not contain digits---e.g., /gnuzilla/lang.
|
||||
(let* ((subdirs (filter contains-digit? subdirs))
|
||||
(target (reduce latest #f subdirs)))
|
||||
(and target
|
||||
(loop (string-append directory "/" target))))))))))
|
||||
|
||||
(define %package-name-rx
|
||||
;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses
|
||||
|
|
@ -320,4 +326,116 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
|
|||
(values name+version #f)
|
||||
(values (match:substring match 1) (match:substring match 2)))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Auto-update.
|
||||
;;;
|
||||
|
||||
(define (package-update-path package)
|
||||
"Return an update path for PACKAGE, or #f if no update is needed."
|
||||
(and (gnu-package? package)
|
||||
(match (latest-release (package-name package))
|
||||
((name+version . directory)
|
||||
(let-values (((_ new-version)
|
||||
(package-name->name+version name+version)))
|
||||
(and (version>? name+version (package-full-name package))
|
||||
`(,new-version . ,directory))))
|
||||
(_ #f))))
|
||||
|
||||
(define* (download-tarball store project directory version
|
||||
#:optional (archive-type "gz"))
|
||||
"Download PROJECT's tarball over FTP and check its OpenPGP signature. On
|
||||
success, return the tarball file name."
|
||||
(let* ((server (ftp-server/directory project))
|
||||
(base (string-append project "-" version ".tar." archive-type))
|
||||
(url (string-append "ftp://" server "/" directory "/" base))
|
||||
(sig-url (string-append url ".sig"))
|
||||
(tarball (download-to-store store url))
|
||||
(sig (download-to-store store sig-url)))
|
||||
(let ((ret (gnupg-verify* sig tarball)))
|
||||
(if ret
|
||||
tarball
|
||||
(begin
|
||||
(warning (_ "signature verification failed for `~a'~%")
|
||||
base)
|
||||
(warning (_ "(could be because the public key is not in your keyring)~%"))
|
||||
#f)))))
|
||||
|
||||
(define (package-update store package)
|
||||
"Return the new version and the file name of the new version tarball for
|
||||
PACKAGE, or #f and #f when PACKAGE is up-to-date."
|
||||
(match (package-update-path package)
|
||||
((version . directory)
|
||||
(let-values (((name)
|
||||
(package-name package))
|
||||
((archive-type)
|
||||
(let ((source (package-source package)))
|
||||
(or (and (origin? source)
|
||||
(file-extension (origin-uri source)))
|
||||
"gz"))))
|
||||
(let ((tarball (download-tarball store name directory version
|
||||
archive-type)))
|
||||
(values version tarball))))
|
||||
(_
|
||||
(values #f #f))))
|
||||
|
||||
(define (update-package-source package version hash)
|
||||
"Modify the source file that defines PACKAGE to refer to VERSION,
|
||||
whose tarball has SHA256 HASH (a bytevector). Return the new version string
|
||||
if an update was made, and #f otherwise."
|
||||
(define (new-line line matches replacement)
|
||||
;; Iterate over MATCHES and return the modified line based on LINE.
|
||||
;; Replace each match with REPLACEMENT.
|
||||
(let loop ((m* matches) ; matches
|
||||
(o 0) ; offset in L
|
||||
(r '())) ; result
|
||||
(match m*
|
||||
(()
|
||||
(let ((r (cons (substring line o) r)))
|
||||
(string-concatenate-reverse r)))
|
||||
((m . rest)
|
||||
(loop rest
|
||||
(match:end m)
|
||||
(cons* replacement
|
||||
(substring line o (match:start m))
|
||||
r))))))
|
||||
|
||||
(define (update-source file old-version version
|
||||
old-hash hash)
|
||||
;; Update source file FILE, replacing occurrences OLD-VERSION by VERSION
|
||||
;; and occurrences of OLD-HASH by HASH (base32 representation thereof).
|
||||
|
||||
;; TODO: Currently this is a bit of a sledgehammer: if VERSION occurs in
|
||||
;; different unrelated places, we may modify it more than needed, for
|
||||
;; instance. We should try to make changes only within the sexp that
|
||||
;; corresponds to the definition of PACKAGE.
|
||||
(let ((old-hash (bytevector->nix-base32-string old-hash))
|
||||
(hash (bytevector->nix-base32-string hash)))
|
||||
(substitute file
|
||||
`((,(regexp-quote old-version)
|
||||
. ,(cut new-line <> <> version))
|
||||
(,(regexp-quote old-hash)
|
||||
. ,(cut new-line <> <> hash))))
|
||||
version))
|
||||
|
||||
(let ((name (package-name package))
|
||||
(loc (package-field-location package 'version)))
|
||||
(if loc
|
||||
(let ((old-version (package-version package))
|
||||
(old-hash (origin-sha256 (package-source package)))
|
||||
(file (and=> (location-file loc)
|
||||
(cut search-path %load-path <>))))
|
||||
(if file
|
||||
(update-source file
|
||||
old-version version
|
||||
old-hash hash)
|
||||
(begin
|
||||
(warning (_ "~a: could not locate source file")
|
||||
(location-file loc))
|
||||
#f)))
|
||||
(begin
|
||||
(format (current-error-port)
|
||||
(_ "~a: ~a: no `version' field in source; skipping~%")
|
||||
name (package-location package))))))
|
||||
|
||||
;;; gnu-maintenance.scm ends here
|
||||
|
|
|
|||
|
|
@ -0,0 +1,152 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2010, 2011, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (guix gnupg)
|
||||
#:use-module (ice-9 popen)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (gnupg-verify
|
||||
gnupg-verify*
|
||||
gnupg-status-good-signature?
|
||||
gnupg-status-missing-key?))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; GnuPG interface.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define %gpg-command "gpg2")
|
||||
(define %openpgp-key-server "keys.gnupg.net")
|
||||
|
||||
(define (gnupg-verify sig file)
|
||||
"Verify signature SIG for FILE. Return a status s-exp if GnuPG failed."
|
||||
|
||||
(define (status-line->sexp line)
|
||||
;; See file `doc/DETAILS' in GnuPG.
|
||||
(define sigid-rx
|
||||
(make-regexp
|
||||
"^\\[GNUPG:\\] SIG_ID ([A-Za-z0-9/]+) ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}) ([[:digit:]]+)"))
|
||||
(define goodsig-rx
|
||||
(make-regexp "^\\[GNUPG:\\] GOODSIG ([[:xdigit:]]+) (.+)$"))
|
||||
(define validsig-rx
|
||||
(make-regexp
|
||||
"^\\[GNUPG:\\] VALIDSIG ([[:xdigit:]]+) ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}) ([[:digit:]]+) .*$"))
|
||||
(define expkeysig-rx ; good signature, but expired key
|
||||
(make-regexp "^\\[GNUPG:\\] EXPKEYSIG ([[:xdigit:]]+) (.*)$"))
|
||||
(define errsig-rx
|
||||
(make-regexp
|
||||
"^\\[GNUPG:\\] ERRSIG ([[:xdigit:]]+) ([^ ]+) ([^ ]+) ([^ ]+) ([[:digit:]]+) ([[:digit:]]+)"))
|
||||
|
||||
(cond ((regexp-exec sigid-rx line)
|
||||
=>
|
||||
(lambda (match)
|
||||
`(signature-id ,(match:substring match 1) ; sig id
|
||||
,(match:substring match 2) ; date
|
||||
,(string->number ; timestamp
|
||||
(match:substring match 3)))))
|
||||
((regexp-exec goodsig-rx line)
|
||||
=>
|
||||
(lambda (match)
|
||||
`(good-signature ,(match:substring match 1) ; key id
|
||||
,(match:substring match 2)))) ; user name
|
||||
((regexp-exec validsig-rx line)
|
||||
=>
|
||||
(lambda (match)
|
||||
`(valid-signature ,(match:substring match 1) ; fingerprint
|
||||
,(match:substring match 2) ; sig creation date
|
||||
,(string->number ; timestamp
|
||||
(match:substring match 3)))))
|
||||
((regexp-exec expkeysig-rx line)
|
||||
=>
|
||||
(lambda (match)
|
||||
`(expired-key-signature ,(match:substring match 1) ; fingerprint
|
||||
,(match:substring match 2)))) ; user name
|
||||
((regexp-exec errsig-rx line)
|
||||
=>
|
||||
(lambda (match)
|
||||
`(signature-error ,(match:substring match 1) ; key id or fingerprint
|
||||
,(match:substring match 2) ; pubkey algo
|
||||
,(match:substring match 3) ; hash algo
|
||||
,(match:substring match 4) ; sig class
|
||||
,(string->number ; timestamp
|
||||
(match:substring match 5))
|
||||
,(let ((rc
|
||||
(string->number ; return code
|
||||
(match:substring match 6))))
|
||||
(case rc
|
||||
((9) 'missing-key)
|
||||
((4) 'unknown-algorithm)
|
||||
(else rc))))))
|
||||
(else
|
||||
`(unparsed-line ,line))))
|
||||
|
||||
(define (parse-status input)
|
||||
(let loop ((line (read-line input))
|
||||
(result '()))
|
||||
(if (eof-object? line)
|
||||
(reverse result)
|
||||
(loop (read-line input)
|
||||
(cons (status-line->sexp line) result)))))
|
||||
|
||||
(let* ((pipe (open-pipe* OPEN_READ %gpg-command "--status-fd=1"
|
||||
"--verify" sig file))
|
||||
(status (parse-status pipe)))
|
||||
;; Ignore PIPE's exit status since STATUS above should contain all the
|
||||
;; info we need.
|
||||
(close-pipe pipe)
|
||||
status))
|
||||
|
||||
(define (gnupg-status-good-signature? status)
|
||||
"If STATUS, as returned by `gnupg-verify', denotes a good signature, return
|
||||
a key-id/user pair; return #f otherwise."
|
||||
(any (lambda (sexp)
|
||||
(match sexp
|
||||
(((or 'good-signature 'expired-key-signature) key-id user)
|
||||
(cons key-id user))
|
||||
(_ #f)))
|
||||
status))
|
||||
|
||||
(define (gnupg-status-missing-key? status)
|
||||
"If STATUS denotes a missing-key error, then return the key-id of the
|
||||
missing key."
|
||||
(any (lambda (sexp)
|
||||
(match sexp
|
||||
(('signature-error key-id _ ...)
|
||||
key-id)
|
||||
(_ #f)))
|
||||
status))
|
||||
|
||||
(define (gnupg-receive-keys key-id server)
|
||||
(system* %gpg-command "--keyserver" server "--recv-keys" key-id))
|
||||
|
||||
(define* (gnupg-verify* sig file #:optional (server %openpgp-key-server))
|
||||
"Like `gnupg-verify', but try downloading the public key if it's missing.
|
||||
Return #t if the signature was good, #f otherwise."
|
||||
(let ((status (gnupg-verify sig file)))
|
||||
(or (gnupg-status-good-signature? status)
|
||||
(let ((missing (gnupg-status-missing-key? status)))
|
||||
(and missing
|
||||
(begin
|
||||
;; Download the missing key and try again.
|
||||
(gnupg-receive-keys missing server)
|
||||
(gnupg-status-good-signature? (gnupg-verify sig file))))))))
|
||||
|
||||
;;; gnupg.scm ends here
|
||||
|
|
@ -64,6 +64,7 @@
|
|||
package-maintainers
|
||||
package-properties
|
||||
package-location
|
||||
package-field-location
|
||||
|
||||
package-transitive-inputs
|
||||
package-transitive-propagated-inputs
|
||||
|
|
@ -182,6 +183,38 @@ corresponds to the arguments expected by `set-path-environment-variable'."
|
|||
package)
|
||||
16)))))
|
||||
|
||||
(define (package-field-location package field)
|
||||
"Return the source code location of the definition of FIELD for PACKAGE, or
|
||||
#f if it could not be determined."
|
||||
(define (goto port line column)
|
||||
(unless (and (= (port-column port) (- column 1))
|
||||
(= (port-line port) (- line 1)))
|
||||
(unless (eof-object? (read-char port))
|
||||
(goto port line column))))
|
||||
|
||||
(match (package-location package)
|
||||
(($ <location> file line column)
|
||||
(catch 'system
|
||||
(lambda ()
|
||||
(call-with-input-file (search-path %load-path file)
|
||||
(lambda (port)
|
||||
(goto port line column)
|
||||
(match (read port)
|
||||
(('package inits ...)
|
||||
(let ((field (assoc field inits)))
|
||||
(match field
|
||||
((_ value)
|
||||
(and=> (or (source-properties value)
|
||||
(source-properties field))
|
||||
source-properties->location))
|
||||
(_
|
||||
#f))))
|
||||
(_
|
||||
#f)))))
|
||||
(lambda _
|
||||
#f)))
|
||||
(_ #f)))
|
||||
|
||||
|
||||
;; Error conditions.
|
||||
|
||||
|
|
|
|||
|
|
@ -43,12 +43,11 @@
|
|||
When SOURCE? is true, return the derivations of the package sources."
|
||||
(let ((p (read/eval-package-expression str)))
|
||||
(if source?
|
||||
(let ((source (package-source p))
|
||||
(loc (package-location p)))
|
||||
(let ((source (package-source p)))
|
||||
(if source
|
||||
(package-source-derivation (%store) source)
|
||||
(leave (_ "~a: error: package `~a' has no source~%")
|
||||
(location->string loc) (package-name p))))
|
||||
(leave (_ "package `~a' has no source~%")
|
||||
(package-name p))))
|
||||
(package-derivation (%store) p system))))
|
||||
|
||||
|
||||
|
|
@ -169,7 +168,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
|
|||
(add-indirect-root (%store) root))
|
||||
((paths ...)
|
||||
(fold (lambda (path count)
|
||||
(let ((root (string-append root "-" (number->string count))))
|
||||
(let ((root (string-append root
|
||||
"-"
|
||||
(number->string count))))
|
||||
(symlink path root)
|
||||
(add-indirect-root (%store) root))
|
||||
(+ 1 count))
|
||||
|
|
@ -177,8 +178,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
|
|||
paths))))
|
||||
(lambda args
|
||||
(leave (_ "failed to create GC root `~a': ~a~%")
|
||||
root (strerror (system-error-errno args)))
|
||||
(exit 1)))))
|
||||
root (strerror (system-error-errno args)))))))
|
||||
|
||||
(define newest-available-packages
|
||||
(memoize find-newest-available-packages))
|
||||
|
|
@ -237,7 +237,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
|
|||
(_ #f))
|
||||
opts)))
|
||||
|
||||
(show-what-to-build (%store) drv (assoc-ref opts 'dry-run?))
|
||||
(show-what-to-build (%store) drv
|
||||
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
||||
#:dry-run? (assoc-ref opts 'dry-run?))
|
||||
|
||||
;; TODO: Add more options.
|
||||
(set-build-options (%store)
|
||||
|
|
|
|||
|
|
@ -21,30 +21,15 @@
|
|||
#:use-module (guix store)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix base32)
|
||||
#:use-module ((guix download) #:select (%mirrors))
|
||||
#:use-module (guix build download)
|
||||
#:use-module (guix download)
|
||||
#:use-module (web uri)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-37)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (rnrs io ports)
|
||||
#:export (guix-download))
|
||||
|
||||
(define (fetch-and-store store fetch name)
|
||||
"Call FETCH for URI, and pass it the name of a file to write to; eventually,
|
||||
copy data from that port to STORE, under NAME. Return the resulting
|
||||
store path."
|
||||
(call-with-temporary-output-file
|
||||
(lambda (temp port)
|
||||
(let ((result
|
||||
(parameterize ((current-output-port (current-error-port)))
|
||||
(fetch temp))))
|
||||
(close port)
|
||||
(and result
|
||||
(add-to-store store name #f "sha256" temp))))))
|
||||
|
||||
;;;
|
||||
;;; Command-line options.
|
||||
|
|
@ -55,11 +40,14 @@ store path."
|
|||
`((format . ,bytevector->nix-base32-string)))
|
||||
|
||||
(define (show-help)
|
||||
(display (_ "Usage: guix download [OPTION]... URL
|
||||
(display (_ "Usage: guix download [OPTION] URL
|
||||
Download the file at URL, add it to the store, and print its store path
|
||||
and the hash of its contents.\n"))
|
||||
and the hash of its contents.
|
||||
|
||||
Supported formats: 'nix-base32' (default), 'base32', and 'base16'
|
||||
('hex' and 'hexadecimal' can be used as well).\n"))
|
||||
(format #t (_ "
|
||||
-f, --format=FMT write the hash in the given format (default: `nix-base32')"))
|
||||
-f, --format=FMT write the hash in the given format"))
|
||||
(newline)
|
||||
(display (_ "
|
||||
-h, --help display this help and exit"))
|
||||
|
|
@ -114,20 +102,18 @@ and the hash of its contents.\n"))
|
|||
(store (open-connection))
|
||||
(arg (assq-ref opts 'argument))
|
||||
(uri (or (string->uri arg)
|
||||
(leave (_ "guix-download: ~a: failed to parse URI~%")
|
||||
(leave (_ "~a: failed to parse URI~%")
|
||||
arg)))
|
||||
(path (case (uri-scheme uri)
|
||||
((file)
|
||||
(add-to-store store (basename (uri-path uri))
|
||||
#f "sha256" (uri-path uri)))
|
||||
(else
|
||||
(fetch-and-store store
|
||||
(cut url-fetch arg <>
|
||||
#:mirrors %mirrors)
|
||||
(basename (uri-path uri))))))
|
||||
(download-to-store store (uri->string uri)
|
||||
(basename (uri-path uri))))))
|
||||
(hash (call-with-input-file
|
||||
(or path
|
||||
(leave (_ "guix-download: ~a: download failed~%")
|
||||
(leave (_ "~a: download failed~%")
|
||||
arg))
|
||||
(compose sha256 get-bytevector-all)))
|
||||
(fmt (assq-ref opts 'format)))
|
||||
|
|
|
|||
|
|
@ -87,9 +87,8 @@ interpreted."
|
|||
("TB" (expt 10 12))
|
||||
("" 1)
|
||||
(_
|
||||
(leave (_ "error: unknown unit: ~a~%") unit)
|
||||
(exit 1))))
|
||||
(leave (_ "error: invalid number: ~a") numstr))))
|
||||
(leave (_ "unknown unit: ~a~%") unit))))
|
||||
(leave (_ "invalid number: ~a~%") numstr))))
|
||||
|
||||
(define %options
|
||||
;; Specification of the command-line options.
|
||||
|
|
@ -110,7 +109,7 @@ interpreted."
|
|||
(let ((amount (size->number arg)))
|
||||
(if arg
|
||||
(alist-cons 'min-freed amount result)
|
||||
(leave (_ "error: invalid amount of storage: ~a~%")
|
||||
(leave (_ "invalid amount of storage: ~a~%")
|
||||
arg))))
|
||||
(#f result)))))
|
||||
(option '(#\d "delete") #f #f
|
||||
|
|
|
|||
|
|
@ -0,0 +1,120 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (guix scripts hash)
|
||||
#:use-module (guix base32)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (rnrs files)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-37)
|
||||
#:export (guix-hash))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Command-line options.
|
||||
;;;
|
||||
|
||||
(define %default-options
|
||||
;; Alist of default option values.
|
||||
`((format . ,bytevector->nix-base32-string)))
|
||||
|
||||
(define (show-help)
|
||||
(display (_ "Usage: guix hash [OPTION] FILE
|
||||
Return the cryptographic hash of FILE.
|
||||
|
||||
Supported formats: 'nix-base32' (default), 'base32', and 'base16'
|
||||
('hex' and 'hexadecimal' can be used as well).\n"))
|
||||
(format #t (_ "
|
||||
-f, --format=FMT write the hash in the given format"))
|
||||
(newline)
|
||||
(display (_ "
|
||||
-h, --help display this help and exit"))
|
||||
(display (_ "
|
||||
-V, --version display version information and exit"))
|
||||
(newline)
|
||||
(show-bug-report-information))
|
||||
|
||||
(define %options
|
||||
;; Specification of the command-line options.
|
||||
(list (option '(#\f "format") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(define fmt-proc
|
||||
(match arg
|
||||
("nix-base32"
|
||||
bytevector->nix-base32-string)
|
||||
("base32"
|
||||
bytevector->base32-string)
|
||||
((or "base16" "hex" "hexadecimal")
|
||||
bytevector->base16-string)
|
||||
(x
|
||||
(leave (_ "unsupported hash format: ~a~%")
|
||||
arg))))
|
||||
|
||||
(alist-cons 'format fmt-proc
|
||||
(alist-delete 'format result))))
|
||||
|
||||
(option '(#\h "help") #f #f
|
||||
(lambda args
|
||||
(show-help)
|
||||
(exit 0)))
|
||||
(option '(#\V "version") #f #f
|
||||
(lambda args
|
||||
(show-version-and-exit "guix hash")))))
|
||||
|
||||
|
||||
|
||||
;;;
|
||||
;;; Entry point.
|
||||
;;;
|
||||
|
||||
(define (guix-hash . args)
|
||||
(define (parse-options)
|
||||
;; Return the alist of option values.
|
||||
(args-fold args %options
|
||||
(lambda (opt name arg result)
|
||||
(leave (_ "unrecognized option: ~a~%")
|
||||
name))
|
||||
(lambda (arg result)
|
||||
(alist-cons 'argument arg result))
|
||||
%default-options))
|
||||
|
||||
(let* ((opts (parse-options))
|
||||
(args (filter-map (match-lambda
|
||||
(('argument . value)
|
||||
value)
|
||||
(_ #f))
|
||||
(reverse opts)))
|
||||
(fmt (assq-ref opts 'format)))
|
||||
|
||||
(match args
|
||||
((file)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(format #t "~a~%"
|
||||
(call-with-input-file file
|
||||
(compose fmt sha256 get-bytevector-all))))
|
||||
(lambda args
|
||||
(leave (_ "~a~%")
|
||||
(strerror (system-error-errno args))))))
|
||||
(_
|
||||
(leave (_ "wrong number of arguments~%"))))))
|
||||
|
|
@ -208,7 +208,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
|
|||
(switch-symlinks profile previous-profile))
|
||||
|
||||
(cond ((not (file-exists? profile)) ; invalid profile
|
||||
(leave (_ "error: profile `~a' does not exist~%")
|
||||
(leave (_ "profile `~a' does not exist~%")
|
||||
profile))
|
||||
((zero? number) ; empty profile
|
||||
(format (current-error-port)
|
||||
|
|
@ -266,19 +266,42 @@ matching packages."
|
|||
(assoc-ref (derivation-outputs drv) sub-drv))))
|
||||
`(,name ,out))))))
|
||||
|
||||
(define %sigint-prompt
|
||||
;; The prompt to jump to upon SIGINT.
|
||||
(make-prompt-tag "interruptible"))
|
||||
|
||||
(define (call-with-sigint-handler thunk handler)
|
||||
"Call THUNK and return its value. Upon SIGINT, call HANDLER with the signal
|
||||
number in the context of the continuation of the call to this function, and
|
||||
return its return value."
|
||||
(call-with-prompt %sigint-prompt
|
||||
(lambda ()
|
||||
(sigaction SIGINT
|
||||
(lambda (signum)
|
||||
(sigaction SIGINT SIG_DFL)
|
||||
(abort-to-prompt %sigint-prompt signum)))
|
||||
(thunk))
|
||||
(lambda (k signum)
|
||||
(handler signum))))
|
||||
|
||||
(define-syntax-rule (waiting exp fmt rest ...)
|
||||
"Display the given message while EXP is being evaluated."
|
||||
(let* ((message (format #f fmt rest ...))
|
||||
(blank (make-string (string-length message) #\space)))
|
||||
(display message (current-error-port))
|
||||
(force-output (current-error-port))
|
||||
(let ((result exp))
|
||||
;; Clear the line.
|
||||
(display #\cr (current-error-port))
|
||||
(display blank (current-error-port))
|
||||
(display #\cr (current-error-port))
|
||||
(force-output (current-error-port))
|
||||
exp)))
|
||||
(call-with-sigint-handler
|
||||
(lambda ()
|
||||
(let ((result exp))
|
||||
;; Clear the line.
|
||||
(display #\cr (current-error-port))
|
||||
(display blank (current-error-port))
|
||||
(display #\cr (current-error-port))
|
||||
(force-output (current-error-port))
|
||||
exp))
|
||||
(lambda (signum)
|
||||
(format (current-error-port) " interrupted by signal ~a~%" SIGINT)
|
||||
#f))))
|
||||
|
||||
(define (check-package-freshness package)
|
||||
"Check whether PACKAGE has a newer version available upstream, and report
|
||||
|
|
@ -328,7 +351,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
|||
(display (_ "
|
||||
-r, --remove=PACKAGE remove PACKAGE"))
|
||||
(display (_ "
|
||||
-u, --upgrade=REGEXP upgrade all the installed packages matching REGEXP"))
|
||||
-u, --upgrade[=REGEXP] upgrade all the installed packages matching REGEXP"))
|
||||
(display (_ "
|
||||
--roll-back roll back to the previous generation"))
|
||||
(newline)
|
||||
|
|
@ -379,7 +402,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
|||
(option '(#\r "remove") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'remove arg result)))
|
||||
(option '(#\u "upgrade") #t #f
|
||||
(option '(#\u "upgrade") #f #t
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'upgrade arg result)))
|
||||
(option '("roll-back") #f #f
|
||||
|
|
@ -454,8 +477,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
|||
(define (ensure-output p sub-drv)
|
||||
(if (member sub-drv (package-outputs p))
|
||||
p
|
||||
(leave (_ "~a: error: package `~a' lacks output `~a'~%")
|
||||
(location->string (package-location p))
|
||||
(leave (_ "package `~a' lacks output `~a'~%")
|
||||
(package-full-name p)
|
||||
sub-drv)))
|
||||
|
||||
|
|
@ -602,7 +624,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
|||
(let* ((installed (manifest-packages (profile-manifest profile)))
|
||||
(upgrade-regexps (filter-map (match-lambda
|
||||
(('upgrade . regexp)
|
||||
(make-regexp regexp))
|
||||
(make-regexp (or regexp "")))
|
||||
(_ #f))
|
||||
opts))
|
||||
(upgrade (if (null? upgrade-regexps)
|
||||
|
|
@ -674,7 +696,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
|||
(ensure-default-profile))
|
||||
|
||||
(show-what-to-remove/install remove* install* dry-run?)
|
||||
(show-what-to-build (%store) drv dry-run?)
|
||||
(show-what-to-build (%store) drv
|
||||
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
||||
#:dry-run? dry-run?)
|
||||
|
||||
(or dry-run?
|
||||
(and (build-derivations (%store) drv)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,182 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (guix scripts refresh)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix utils)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix gnu-maintenance)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module ((gnu packages base) #:select (%final-inputs))
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-37)
|
||||
#:use-module (rnrs io ports)
|
||||
#:export (guix-refresh))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Command-line options.
|
||||
;;;
|
||||
|
||||
(define %default-options
|
||||
;; Alist of default option values.
|
||||
'())
|
||||
|
||||
(define %options
|
||||
;; Specification of the command-line options.
|
||||
(list (option '(#\n "dry-run") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'dry-run? #t result)))
|
||||
(option '(#\s "select") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(match arg
|
||||
((or "core" "non-core")
|
||||
(alist-cons 'select (string->symbol arg)
|
||||
result))
|
||||
(x
|
||||
(leave (_ "~a: invalid selection; expected `core' or `non-core'")
|
||||
arg)))))
|
||||
|
||||
(option '(#\h "help") #f #f
|
||||
(lambda args
|
||||
(show-help)
|
||||
(exit 0)))
|
||||
(option '(#\V "version") #f #f
|
||||
(lambda args
|
||||
(show-version-and-exit "guix refresh")))))
|
||||
|
||||
(define (show-help)
|
||||
(display (_ "Usage: guix refresh [OPTION]... PACKAGE...
|
||||
Update package definitions to match the latest upstream version.
|
||||
|
||||
When PACKAGE... is given, update only the specified packages. Otherwise
|
||||
update all the packages of the distribution, or the subset thereof
|
||||
specified with `--select'.\n"))
|
||||
(display (_ "
|
||||
-n, --dry-run do not build the derivations"))
|
||||
(display (_ "
|
||||
-s, --select=SUBSET select all the packages in SUBSET, one of
|
||||
`core' or `non-core'"))
|
||||
(newline)
|
||||
(display (_ "
|
||||
-h, --help display this help and exit"))
|
||||
(display (_ "
|
||||
-V, --version display version information and exit"))
|
||||
(newline)
|
||||
(show-bug-report-information))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Entry point.
|
||||
;;;
|
||||
|
||||
(define (guix-refresh . args)
|
||||
(define (parse-options)
|
||||
;; Return the alist of option values.
|
||||
(args-fold args %options
|
||||
(lambda (opt name arg result)
|
||||
(leave (_ "~A: unrecognized option~%") name))
|
||||
(lambda (arg result)
|
||||
(alist-cons 'argument arg result))
|
||||
%default-options))
|
||||
|
||||
(define core-package?
|
||||
(let* ((input->package (match-lambda
|
||||
((name (? package? package) _ ...) package)
|
||||
(_ #f)))
|
||||
(final-inputs (map input->package %final-inputs))
|
||||
(core (append final-inputs
|
||||
(append-map (compose (cut filter-map input->package <>)
|
||||
package-transitive-inputs)
|
||||
final-inputs)))
|
||||
(names (delete-duplicates (map package-name core))))
|
||||
(lambda (package)
|
||||
"Return true if PACKAGE is likely a \"core package\"---i.e., one whose
|
||||
update would trigger a complete rebuild."
|
||||
;; Compare by name because packages in base.scm basically inherit
|
||||
;; other packages. So, even if those packages are not core packages
|
||||
;; themselves, updating them would also update those who inherit from
|
||||
;; them.
|
||||
;; XXX: Fails to catch MPFR/MPC, whose *source* is used as input.
|
||||
(member (package-name package) names))))
|
||||
|
||||
(let* ((opts (parse-options))
|
||||
(dry-run? (assoc-ref opts 'dry-run?))
|
||||
(packages (match (concatenate
|
||||
(filter-map (match-lambda
|
||||
(('argument . value)
|
||||
(let ((p (find-packages-by-name value)))
|
||||
(unless p
|
||||
(leave (_ "~a: no package by that name")
|
||||
value))
|
||||
p))
|
||||
(_ #f))
|
||||
opts))
|
||||
(() ; default to all packages
|
||||
(let ((select? (match (assoc-ref opts 'select)
|
||||
('core core-package?)
|
||||
('non-core (negate core-package?))
|
||||
(_ (const #t)))))
|
||||
;; TODO: Keep only the newest of each package.
|
||||
(fold-packages (lambda (package result)
|
||||
(if (select? package)
|
||||
(cons package result)
|
||||
result))
|
||||
'())))
|
||||
(some ; user-specified packages
|
||||
some))))
|
||||
(with-error-handling
|
||||
(if dry-run?
|
||||
(for-each (lambda (package)
|
||||
(match (false-if-exception (package-update-path package))
|
||||
((new-version . directory)
|
||||
(let ((loc (or (package-field-location package 'version)
|
||||
(package-location package))))
|
||||
(format (current-error-port)
|
||||
(_ "~a: ~a would be upgraded from ~a to ~a~%")
|
||||
(location->string loc)
|
||||
(package-name package) (package-version package)
|
||||
new-version)))
|
||||
(_ #f)))
|
||||
packages)
|
||||
(let ((store (open-connection)))
|
||||
(for-each (lambda (package)
|
||||
(let-values (((version tarball)
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(package-update store package))
|
||||
(lambda _
|
||||
(values #f #f))))
|
||||
((loc)
|
||||
(or (package-field-location package
|
||||
'version)
|
||||
(package-location package))))
|
||||
(when version
|
||||
(format (current-error-port)
|
||||
(_ "~a: ~a: updating from version ~a to version ~a...~%")
|
||||
(location->string loc) (package-name package)
|
||||
(package-version package) version)
|
||||
(let ((hash (call-with-input-file tarball
|
||||
(compose sha256 get-bytevector-all))))
|
||||
(update-package-source package version hash)))))
|
||||
packages))))))
|
||||
|
|
@ -22,18 +22,20 @@
|
|||
#:use-module (guix utils)
|
||||
#:use-module (guix config)
|
||||
#:use-module (guix nar)
|
||||
#:use-module ((guix build utils) #:select (mkdir-p))
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 threads)
|
||||
#:use-module (ice-9 format)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (web uri)
|
||||
#:use-module (web client)
|
||||
#:use-module (web response)
|
||||
#:use-module (guix web)
|
||||
#:export (guix-substitute-binary))
|
||||
|
||||
;;; Comment:
|
||||
|
|
@ -47,6 +49,40 @@
|
|||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define %narinfo-cache-directory
|
||||
;; A local cache of narinfos, to avoid going to the network.
|
||||
(or (and=> (getenv "XDG_CACHE_HOME")
|
||||
(cut string-append <> "/guix/substitute-binary"))
|
||||
(string-append %state-directory "/substitute-binary/cache")))
|
||||
|
||||
(define %narinfo-ttl
|
||||
;; Number of seconds during which cached narinfo lookups are considered
|
||||
;; valid.
|
||||
(* 24 3600))
|
||||
|
||||
(define %narinfo-negative-ttl
|
||||
;; Likewise, but for negative lookups---i.e., cached lookup failures.
|
||||
(* 3 3600))
|
||||
|
||||
(define %narinfo-expired-cache-entry-removal-delay
|
||||
;; How often we want to remove files corresponding to expired cache entries.
|
||||
(* 7 24 3600))
|
||||
|
||||
(define (with-atomic-file-output file proc)
|
||||
"Call PROC with an output port for the file that is going to replace FILE.
|
||||
Upon success, FILE is atomically replaced by what has been written to the
|
||||
output port, and PROC's result is returned."
|
||||
(let* ((template (string-append file ".XXXXXX"))
|
||||
(out (mkstemp! template)))
|
||||
(with-throw-handler #t
|
||||
(lambda ()
|
||||
(let ((result (proc out)))
|
||||
(close out)
|
||||
(rename-file template file)
|
||||
result))
|
||||
(lambda (key . args)
|
||||
(false-if-exception (delete-file template))))))
|
||||
|
||||
(define (fields->alist port)
|
||||
"Read recutils-style record from PORT and return them as a list of key/value
|
||||
pairs."
|
||||
|
|
@ -72,6 +108,17 @@ pairs."
|
|||
(let ((args (map (cut assoc-ref alist <>) keys)))
|
||||
(apply make args)))
|
||||
|
||||
(define (object->fields object fields port)
|
||||
"Write OBJECT (typically a record) as a series of recutils-style fields to
|
||||
PORT, according to FIELDS. FIELDS must be a list of field name/getter pairs."
|
||||
(let loop ((fields fields))
|
||||
(match fields
|
||||
(()
|
||||
object)
|
||||
(((field . get) rest ...)
|
||||
(format port "~a: ~a~%" field (get object))
|
||||
(loop rest)))))
|
||||
|
||||
(define (fetch uri)
|
||||
"Return a binary input port to URI and the number of bytes it's expected to
|
||||
provide."
|
||||
|
|
@ -80,28 +127,7 @@ provide."
|
|||
(let ((port (open-input-file (uri-path uri))))
|
||||
(values port (stat:size (stat port)))))
|
||||
((http)
|
||||
(let*-values (((resp port)
|
||||
;; XXX: `http-get*' was introduced in 2.0.7, and deprecated
|
||||
;; in 2.0.8 (!). Assume it is available here.
|
||||
(if (version>? "2.0.7" (version))
|
||||
(http-get* uri #:decode-body? #f)
|
||||
(http-get uri #:streaming? #t)))
|
||||
((code)
|
||||
(response-code resp))
|
||||
((size)
|
||||
(response-content-length resp)))
|
||||
(case code
|
||||
((200) ; OK
|
||||
(values port size))
|
||||
((301 ; moved permanently
|
||||
302) ; found (redirection)
|
||||
(let ((uri (response-location resp)))
|
||||
(format #t "following redirection to `~a'...~%"
|
||||
(uri->string uri))
|
||||
(fetch uri)))
|
||||
(else
|
||||
(error "download failed" (uri->string uri)
|
||||
code (response-reason-phrase resp))))))))
|
||||
(http-fetch uri #:text? #f))))
|
||||
|
||||
(define-record-type <cache>
|
||||
(%make-cache url store-directory wants-mass-query?)
|
||||
|
|
@ -161,22 +187,166 @@ failure."
|
|||
(_ deriver))
|
||||
system)))
|
||||
|
||||
(define* (read-narinfo port #:optional url)
|
||||
"Read a narinfo from PORT in its standard external form. If URL is true, it
|
||||
must be a string used to build full URIs from relative URIs found while
|
||||
reading PORT."
|
||||
(alist->record (fields->alist port)
|
||||
(narinfo-maker url)
|
||||
'("StorePath" "URL" "Compression"
|
||||
"FileHash" "FileSize" "NarHash" "NarSize"
|
||||
"References" "Deriver" "System")))
|
||||
|
||||
(define (write-narinfo narinfo port)
|
||||
"Write NARINFO to PORT."
|
||||
(define (empty-string-if-false x)
|
||||
(or x ""))
|
||||
|
||||
(define (number-or-empty-string x)
|
||||
(if (number? x)
|
||||
(number->string x)
|
||||
""))
|
||||
|
||||
(object->fields narinfo
|
||||
`(("StorePath" . ,narinfo-path)
|
||||
("URL" . ,(compose uri->string narinfo-uri))
|
||||
("Compression" . ,narinfo-compression)
|
||||
("FileHash" . ,(compose empty-string-if-false
|
||||
narinfo-file-hash))
|
||||
("FileSize" . ,(compose number-or-empty-string
|
||||
narinfo-file-size))
|
||||
("NarHash" . ,(compose empty-string-if-false
|
||||
narinfo-hash))
|
||||
("NarSize" . ,(compose number-or-empty-string
|
||||
narinfo-size))
|
||||
("References" . ,(compose string-join narinfo-references))
|
||||
("Deriver" . ,(compose empty-string-if-false
|
||||
narinfo-deriver))
|
||||
("System" . ,narinfo-system))
|
||||
port))
|
||||
|
||||
(define (narinfo->string narinfo)
|
||||
"Return the external representation of NARINFO."
|
||||
(call-with-output-string (cut write-narinfo narinfo <>)))
|
||||
|
||||
(define (string->narinfo str)
|
||||
"Return the narinfo represented by STR."
|
||||
(call-with-input-string str (cut read-narinfo <>)))
|
||||
|
||||
(define (fetch-narinfo cache path)
|
||||
"Return the <narinfo> record for PATH, or #f if CACHE does not hold PATH."
|
||||
(define (download url)
|
||||
;; Download the `nix-cache-info' from URL, and return its contents as an
|
||||
;; list of key/value pairs.
|
||||
(and=> (false-if-exception (fetch (string->uri url)))
|
||||
fields->alist))
|
||||
(false-if-exception (fetch (string->uri url))))
|
||||
|
||||
(and=> (download (string-append (cache-url cache) "/"
|
||||
(store-path-hash-part path)
|
||||
".narinfo"))
|
||||
(lambda (properties)
|
||||
(alist->record properties (narinfo-maker (cache-url cache))
|
||||
'("StorePath" "URL" "Compression"
|
||||
"FileHash" "FileSize" "NarHash" "NarSize"
|
||||
"References" "Deriver" "System")))))
|
||||
(and (string=? (cache-store-directory cache) (%store-prefix))
|
||||
(and=> (download (string-append (cache-url cache) "/"
|
||||
(store-path-hash-part path)
|
||||
".narinfo"))
|
||||
(cute read-narinfo <> (cache-url cache)))))
|
||||
|
||||
(define (obsolete? date now ttl)
|
||||
"Return #t if DATE is obsolete compared to NOW + TTL seconds."
|
||||
(time>? (subtract-duration now (make-time time-duration 0 ttl))
|
||||
(make-time time-monotonic 0 date)))
|
||||
|
||||
(define (lookup-narinfo cache path)
|
||||
"Check locally if we have valid info about PATH, otherwise go to CACHE and
|
||||
check what it has."
|
||||
(define now
|
||||
(current-time time-monotonic))
|
||||
|
||||
(define cache-file
|
||||
(string-append %narinfo-cache-directory "/"
|
||||
(store-path-hash-part path)))
|
||||
|
||||
(define (cache-entry narinfo)
|
||||
`(narinfo (version 0)
|
||||
(date ,(time-second now))
|
||||
(value ,(and=> narinfo narinfo->string))))
|
||||
|
||||
(let*-values (((valid? cached)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(call-with-input-file cache-file
|
||||
(lambda (p)
|
||||
(match (read p)
|
||||
(('narinfo ('version 0) ('date date)
|
||||
('value #f))
|
||||
;; A cached negative lookup.
|
||||
(if (obsolete? date now %narinfo-negative-ttl)
|
||||
(values #f #f)
|
||||
(values #t #f)))
|
||||
(('narinfo ('version 0) ('date date)
|
||||
('value value))
|
||||
;; A cached positive lookup
|
||||
(if (obsolete? date now %narinfo-ttl)
|
||||
(values #f #f)
|
||||
(values #t (string->narinfo value))))))))
|
||||
(lambda _
|
||||
(values #f #f)))))
|
||||
(if valid?
|
||||
cached ; including negative caches
|
||||
(let ((narinfo (and=> (force cache)
|
||||
(cut fetch-narinfo <> path))))
|
||||
(with-atomic-file-output cache-file
|
||||
(lambda (out)
|
||||
(write (cache-entry narinfo) out)))
|
||||
narinfo))))
|
||||
|
||||
(define (remove-expired-cached-narinfos)
|
||||
"Remove expired narinfo entries from the cache. The sole purpose of this
|
||||
function is to make sure `%narinfo-cache-directory' doesn't grow
|
||||
indefinitely."
|
||||
(define now
|
||||
(current-time time-monotonic))
|
||||
|
||||
(define (expired? file)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(call-with-input-file file
|
||||
(lambda (port)
|
||||
(match (read port)
|
||||
(('narinfo ('version 0) ('date date)
|
||||
('value #f))
|
||||
(obsolete? date now %narinfo-negative-ttl))
|
||||
(('narinfo ('version 0) ('date date)
|
||||
('value _))
|
||||
(obsolete? date now %narinfo-ttl))
|
||||
(_ #t)))))
|
||||
(lambda args
|
||||
;; FILE may have been deleted.
|
||||
#t)))
|
||||
|
||||
(for-each (lambda (file)
|
||||
(let ((file (string-append %narinfo-cache-directory
|
||||
"/" file)))
|
||||
(when (expired? file)
|
||||
;; Wrap in `false-if-exception' because FILE might have been
|
||||
;; deleted in the meantime (TOCTTOU).
|
||||
(false-if-exception (delete-file file)))))
|
||||
(scandir %narinfo-cache-directory
|
||||
(lambda (file)
|
||||
(= (string-length file) 32)))))
|
||||
|
||||
(define (maybe-remove-expired-cached-narinfo)
|
||||
"Remove expired narinfo entries from the cache if deemed necessary."
|
||||
(define now
|
||||
(current-time time-monotonic))
|
||||
|
||||
(define expiry-file
|
||||
(string-append %narinfo-cache-directory "/last-expiry-cleanup"))
|
||||
|
||||
(define last-expiry-date
|
||||
(or (false-if-exception
|
||||
(call-with-input-file expiry-file read))
|
||||
0))
|
||||
|
||||
(when (obsolete? last-expiry-date now %narinfo-expired-cache-entry-removal-delay)
|
||||
(remove-expired-cached-narinfos)
|
||||
(call-with-output-file expiry-file
|
||||
(cute write (time-second now) <>))))
|
||||
|
||||
(define (filtered-port command input)
|
||||
"Return an input port (and PID) where data drained from INPUT is filtered
|
||||
|
|
@ -214,9 +384,11 @@ through COMMAND. INPUT must be a file input port."
|
|||
|
||||
(define (guix-substitute-binary . args)
|
||||
"Implement the build daemon's substituter protocol."
|
||||
(mkdir-p %narinfo-cache-directory)
|
||||
(maybe-remove-expired-cached-narinfo)
|
||||
(match args
|
||||
(("--query")
|
||||
(let ((cache (open-cache %cache-url)))
|
||||
(let ((cache (delay (open-cache %cache-url))))
|
||||
(let loop ((command (read-line)))
|
||||
(or (eof-object? command)
|
||||
(begin
|
||||
|
|
@ -225,7 +397,7 @@ through COMMAND. INPUT must be a file input port."
|
|||
;; Return the subset of PATHS available in CACHE.
|
||||
(let ((substitutable
|
||||
(if cache
|
||||
(par-map (cut fetch-narinfo cache <>)
|
||||
(par-map (cut lookup-narinfo cache <>)
|
||||
paths)
|
||||
'())))
|
||||
(for-each (lambda (narinfo)
|
||||
|
|
@ -237,7 +409,7 @@ through COMMAND. INPUT must be a file input port."
|
|||
;; Reply info about PATHS if it's in CACHE.
|
||||
(let ((substitutable
|
||||
(if cache
|
||||
(par-map (cut fetch-narinfo cache <>)
|
||||
(par-map (cut lookup-narinfo cache <>)
|
||||
paths)
|
||||
'())))
|
||||
(for-each (lambda (narinfo)
|
||||
|
|
@ -262,8 +434,8 @@ through COMMAND. INPUT must be a file input port."
|
|||
(loop (read-line)))))))
|
||||
(("--substitute" store-path destination)
|
||||
;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
|
||||
(let* ((cache (open-cache %cache-url))
|
||||
(narinfo (fetch-narinfo cache store-path))
|
||||
(let* ((cache (delay (open-cache %cache-url)))
|
||||
(narinfo (lookup-narinfo cache store-path))
|
||||
(uri (narinfo-uri narinfo)))
|
||||
;; Tell the daemon what the expected hash of the Nar itself is.
|
||||
(format #t "~a~%" (narinfo-hash narinfo))
|
||||
|
|
|
|||
|
|
@ -34,6 +34,7 @@
|
|||
#:use-module (guix utils)
|
||||
#:use-module (guix base32)
|
||||
#:use-module (guix config)
|
||||
#:use-module (guix gnu-maintenance)
|
||||
#:export (open-nixpkgs
|
||||
xml->snix
|
||||
nixpkgs->guix-package))
|
||||
|
|
@ -435,8 +436,16 @@ location of DERIVATION."
|
|||
|
||||
(home-page ,(and=> (find-attribute-by-name "homepage" meta)
|
||||
attribute-value))
|
||||
(synopsis ,(and=> (find-attribute-by-name "description" meta)
|
||||
attribute-value))
|
||||
(synopsis
|
||||
;; For GNU packages, prefer the official synopsis.
|
||||
,(or (false-if-exception
|
||||
(and=> (find (lambda (gnu-package)
|
||||
(equal? (gnu-package-name gnu-package)
|
||||
name))
|
||||
(official-gnu-packages))
|
||||
gnu-package-doc-summary))
|
||||
(and=> (find-attribute-by-name "description" meta)
|
||||
attribute-value)))
|
||||
(description
|
||||
,(and=> (find-attribute-by-name "longDescription" meta)
|
||||
attribute-value))
|
||||
|
|
|
|||
|
|
@ -336,7 +336,10 @@ encoding conversion errors."
|
|||
#f))
|
||||
((= k %stderr-error)
|
||||
(let ((error (read-latin1-string p))
|
||||
(status (if (>= (nix-server-minor-version server) 8)
|
||||
;; Currently the daemon fails to send a status code for early
|
||||
;; errors like DB schema version mismatches, so check for EOF.
|
||||
(status (if (and (>= (nix-server-minor-version server) 8)
|
||||
(not (eof-object? (lookahead-u8 p))))
|
||||
(read-int p)
|
||||
1)))
|
||||
(raise (condition (&nix-protocol-error
|
||||
|
|
|
|||
181
guix/ui.scm
181
guix/ui.scm
|
|
@ -1,6 +1,7 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -40,7 +41,6 @@
|
|||
with-error-handling
|
||||
read/eval-package-expression
|
||||
location->string
|
||||
call-with-temporary-output-file
|
||||
switch-symlinks
|
||||
config-directory
|
||||
fill-paragraph
|
||||
|
|
@ -64,15 +64,50 @@
|
|||
(define _ (cut gettext <> %gettext-domain))
|
||||
(define N_ (cut ngettext <> <> <> %gettext-domain))
|
||||
|
||||
(define-syntax-rule (define-diagnostic name prefix)
|
||||
"Create a diagnostic macro (i.e., NAME), which will prepend PREFIX to all
|
||||
messages."
|
||||
(define-syntax name
|
||||
(lambda (x)
|
||||
(define (augmented-format-string fmt)
|
||||
(string-append "~:[~*~;guix ~a: ~]~a" (syntax->datum fmt)))
|
||||
|
||||
(syntax-case x (N_ _) ; these are literals, yeah...
|
||||
((name (_ fmt) args (... ...))
|
||||
(string? (syntax->datum #'fmt))
|
||||
(with-syntax ((fmt* (augmented-format-string #'fmt))
|
||||
(prefix (datum->syntax x prefix)))
|
||||
#'(format (guix-warning-port) (gettext fmt*)
|
||||
(program-name) (program-name) prefix
|
||||
args (... ...))))
|
||||
((name (N_ singular plural n) args (... ...))
|
||||
(and (string? (syntax->datum #'singular))
|
||||
(string? (syntax->datum #'plural)))
|
||||
(with-syntax ((s (augmented-format-string #'singular))
|
||||
(p (augmented-format-string #'plural))
|
||||
(prefix (datum->syntax x prefix)))
|
||||
#'(format (guix-warning-port)
|
||||
(ngettext s p n %gettext-domain)
|
||||
(program-name) (program-name) prefix
|
||||
args (... ...))))))))
|
||||
|
||||
(define-diagnostic warning "warning: ") ; emit a warning
|
||||
|
||||
(define-diagnostic report-error "error: ")
|
||||
(define-syntax-rule (leave args ...)
|
||||
"Emit an error message and exit."
|
||||
(begin
|
||||
(report-error args ...)
|
||||
(exit 1)))
|
||||
|
||||
(define (install-locale)
|
||||
"Install the current locale settings."
|
||||
(catch 'system-error
|
||||
(lambda _
|
||||
(setlocale LC_ALL ""))
|
||||
(lambda args
|
||||
(format (current-error-port)
|
||||
(_ "warning: failed to install locale: ~a~%")
|
||||
(strerror (system-error-errno args))))))
|
||||
(warning (_ "failed to install locale: ~a~%")
|
||||
(strerror (system-error-errno args))))))
|
||||
|
||||
(define (initialize-guix)
|
||||
"Perform the usual initialization for stand-alone Guix commands."
|
||||
|
|
@ -81,12 +116,6 @@
|
|||
(setvbuf (current-output-port) _IOLBF)
|
||||
(setvbuf (current-error-port) _IOLBF))
|
||||
|
||||
(define-syntax-rule (leave fmt args ...)
|
||||
"Format FMT and ARGS to the error port and exit."
|
||||
(begin
|
||||
(format (current-error-port) fmt args ...)
|
||||
(exit 1)))
|
||||
|
||||
(define* (show-version-and-exit #:optional (command (car (command-line))))
|
||||
"Display version information for COMMAND and `(exit 0)'."
|
||||
(simple-format #t "~a (~a) ~a~%"
|
||||
|
|
@ -111,16 +140,16 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
|
|||
(file (location-file location))
|
||||
(line (location-line location))
|
||||
(column (location-column location)))
|
||||
(leave (_ "~a:~a:~a: error: package `~a' has an invalid input: ~s~%")
|
||||
(leave (_ "~a:~a:~a: package `~a' has an invalid input: ~s~%")
|
||||
file line column
|
||||
(package-full-name package) input)))
|
||||
((nix-connection-error? c)
|
||||
(leave (_ "error: failed to connect to `~a': ~a~%")
|
||||
(leave (_ "failed to connect to `~a': ~a~%")
|
||||
(nix-connection-error-file c)
|
||||
(strerror (nix-connection-error-code c))))
|
||||
((nix-protocol-error? c)
|
||||
;; FIXME: Server-provided error messages aren't i18n'd.
|
||||
(leave (_ "error: build failed: ~a~%")
|
||||
(leave (_ "build failed: ~a~%")
|
||||
(nix-protocol-error-message c))))
|
||||
(thunk)))
|
||||
|
||||
|
|
@ -144,33 +173,66 @@ error."
|
|||
(leave (_ "expression `~s' does not evaluate to a package~%")
|
||||
exp)))))
|
||||
|
||||
(define* (show-what-to-build store drv #:optional dry-run?)
|
||||
(define* (show-what-to-build store drv
|
||||
#:key dry-run? (use-substitutes? #t))
|
||||
"Show what will or would (depending on DRY-RUN?) be built in realizing the
|
||||
derivations listed in DRV. Return #t if there's something to build, #f
|
||||
otherwise."
|
||||
(let* ((req (append-map (lambda (drv-path)
|
||||
(let ((d (call-with-input-file drv-path
|
||||
read-derivation)))
|
||||
(derivation-prerequisites-to-build
|
||||
store d)))
|
||||
drv))
|
||||
(req* (delete-duplicates
|
||||
(append (remove (compose (cute valid-path? store <>)
|
||||
derivation-path->output-path)
|
||||
drv)
|
||||
(map derivation-input-path req)))))
|
||||
otherwise. When USE-SUBSTITUTES?, check and report what is prerequisites are
|
||||
available for download."
|
||||
(let*-values (((build download)
|
||||
(fold2 (lambda (drv-path build download)
|
||||
(let ((drv (call-with-input-file drv-path
|
||||
read-derivation)))
|
||||
(let-values (((b d)
|
||||
(derivation-prerequisites-to-build
|
||||
store drv
|
||||
#:use-substitutes?
|
||||
use-substitutes?)))
|
||||
(values (append b build)
|
||||
(append d download)))))
|
||||
'() '()
|
||||
drv))
|
||||
((build) ; add the DRV themselves
|
||||
(delete-duplicates
|
||||
(append (remove (compose (lambda (out)
|
||||
(or (valid-path? store out)
|
||||
(and use-substitutes?
|
||||
(has-substitutes? store
|
||||
out))))
|
||||
derivation-path->output-path)
|
||||
drv)
|
||||
(map derivation-input-path build))))
|
||||
((download) ; add the references of DOWNLOAD
|
||||
(delete-duplicates
|
||||
(append download
|
||||
(remove (cut valid-path? store <>)
|
||||
(append-map
|
||||
substitutable-references
|
||||
(substitutable-path-info store download)))))))
|
||||
(if dry-run?
|
||||
(format (current-error-port)
|
||||
(N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
|
||||
"~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
|
||||
(length req*))
|
||||
(null? req*) req*)
|
||||
(format (current-error-port)
|
||||
(N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
|
||||
"~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
|
||||
(length req*))
|
||||
(null? req*) req*))
|
||||
(pair? req*)))
|
||||
(begin
|
||||
(format (current-error-port)
|
||||
(N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
|
||||
"~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
|
||||
(length build))
|
||||
(null? build) build)
|
||||
(format (current-error-port)
|
||||
(N_ "~:[the following file would be downloaded:~%~{ ~a~%~}~;~]"
|
||||
"~:[the following files would be downloaded:~%~{ ~a~%~}~;~]"
|
||||
(length download))
|
||||
(null? download) download))
|
||||
(begin
|
||||
(format (current-error-port)
|
||||
(N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
|
||||
"~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
|
||||
(length build))
|
||||
(null? build) build)
|
||||
(format (current-error-port)
|
||||
(N_ "~:[the following file will be downloaded:~%~{ ~a~%~}~;~]"
|
||||
"~:[the following files will be downloaded:~%~{ ~a~%~}~;~]"
|
||||
(length download))
|
||||
(null? download) download)))
|
||||
(pair? build)))
|
||||
|
||||
(define-syntax with-error-handling
|
||||
(syntax-rules ()
|
||||
|
|
@ -187,21 +249,6 @@ otherwise."
|
|||
(($ <location> file line column)
|
||||
(format #f "~a:~a:~a" file line column))))
|
||||
|
||||
(define (call-with-temporary-output-file proc)
|
||||
"Call PROC with a name of a temporary file and open output port to that
|
||||
file; close the file and delete it when leaving the dynamic extent of this
|
||||
call."
|
||||
(let* ((template (string-copy "guix-file.XXXXXX"))
|
||||
(out (mkstemp! template)))
|
||||
(dynamic-wind
|
||||
(lambda ()
|
||||
#t)
|
||||
(lambda ()
|
||||
(proc template out))
|
||||
(lambda ()
|
||||
(false-if-exception (close out))
|
||||
(false-if-exception (delete-file template))))))
|
||||
|
||||
(define (switch-symlinks link target)
|
||||
"Atomically switch LINK, a symbolic link, to point to TARGET. Works
|
||||
both when LINK already exists and when it does not."
|
||||
|
|
@ -342,36 +389,6 @@ WIDTH columns."
|
|||
(define guix-warning-port
|
||||
(make-parameter (current-warning-port)))
|
||||
|
||||
(define-syntax warning
|
||||
(lambda (s)
|
||||
"Emit a warming. The macro assumes that `_' is bound to `gettext'."
|
||||
;; All this just to preserve `-Wformat' warnings. Too much?
|
||||
|
||||
(define (augmented-format-string fmt)
|
||||
(string-append "~:[~;guix ~a: ~]~a" (syntax->datum fmt)))
|
||||
|
||||
(define prefix
|
||||
#'(_ "warning: "))
|
||||
|
||||
(syntax-case s (N_ _) ; these are literals, yeah...
|
||||
((warning (_ fmt) args ...)
|
||||
(string? (syntax->datum #'fmt))
|
||||
(with-syntax ((fmt* (augmented-format-string #'fmt))
|
||||
(prefix prefix))
|
||||
#'(format (guix-warning-port) (gettext fmt*)
|
||||
(program-name) (program-name) prefix
|
||||
args ...)))
|
||||
((warning (N_ singular plural n) args ...)
|
||||
(and (string? (syntax->datum #'singular))
|
||||
(string? (syntax->datum #'plural)))
|
||||
(with-syntax ((s (augmented-format-string #'singular))
|
||||
(p (augmented-format-string #'plural))
|
||||
(b prefix))
|
||||
#'(format (guix-warning-port)
|
||||
(ngettext s p n %gettext-domain)
|
||||
(program-name) (program-name) b
|
||||
args ...))))))
|
||||
|
||||
(define (guix-main arg0 . args)
|
||||
(initialize-guix)
|
||||
(let ()
|
||||
|
|
|
|||
|
|
@ -59,7 +59,10 @@
|
|||
%current-system
|
||||
version-compare
|
||||
version>?
|
||||
package-name->name+version))
|
||||
package-name->name+version
|
||||
file-extension
|
||||
call-with-temporary-output-file
|
||||
fold2))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -463,6 +466,52 @@ introduce the version part."
|
|||
((head tail ...)
|
||||
(loop tail (cons head prefix))))))
|
||||
|
||||
(define (file-extension file)
|
||||
"Return the extension of FILE or #f if there is none."
|
||||
(let ((dot (string-rindex file #\.)))
|
||||
(and dot (substring file (+ 1 dot) (string-length file)))))
|
||||
|
||||
(define (call-with-temporary-output-file proc)
|
||||
"Call PROC with a name of a temporary file and open output port to that
|
||||
file; close the file and delete it when leaving the dynamic extent of this
|
||||
call."
|
||||
(let* ((template (string-copy "guix-file.XXXXXX"))
|
||||
(out (mkstemp! template)))
|
||||
(dynamic-wind
|
||||
(lambda ()
|
||||
#t)
|
||||
(lambda ()
|
||||
(proc template out))
|
||||
(lambda ()
|
||||
(false-if-exception (close out))
|
||||
(false-if-exception (delete-file template))))))
|
||||
|
||||
(define fold2
|
||||
(case-lambda
|
||||
((proc seed1 seed2 lst)
|
||||
"Like `fold', but with a single list and two seeds."
|
||||
(let loop ((result1 seed1)
|
||||
(result2 seed2)
|
||||
(lst lst))
|
||||
(if (null? lst)
|
||||
(values result1 result2)
|
||||
(call-with-values
|
||||
(lambda () (proc (car lst) result1 result2))
|
||||
(lambda (result1 result2)
|
||||
(loop result1 result2 (cdr lst)))))))
|
||||
((proc seed1 seed2 lst1 lst2)
|
||||
"Like `fold', but with a two lists and two seeds."
|
||||
(let loop ((result1 seed1)
|
||||
(result2 seed2)
|
||||
(lst1 lst1)
|
||||
(lst2 lst2))
|
||||
(if (or (null? lst1) (null? lst2))
|
||||
(values result1 result2)
|
||||
(call-with-values
|
||||
(lambda () (proc (car lst1) (car lst2) result1 result2))
|
||||
(lambda (result1 result2)
|
||||
(fold2 proc result1 result2 (cdr lst1) (cdr lst2)))))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Source location.
|
||||
|
|
@ -490,5 +539,6 @@ etc."
|
|||
(let ((file (assq-ref loc 'filename))
|
||||
(line (assq-ref loc 'line))
|
||||
(col (assq-ref loc 'column)))
|
||||
;; In accordance with the GCS, start line and column numbers at 1.
|
||||
(location file (and line (+ line 1)) (and col (+ col 1)))))
|
||||
;; In accordance with the GCS, start line and column numbers at 1. Note
|
||||
;; that unlike LINE and `port-column', COL is actually 1-indexed here...
|
||||
(location file (and line (+ line 1)) col)))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,85 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (guix web)
|
||||
#:use-module (web uri)
|
||||
#:use-module (web client)
|
||||
#:use-module (web response)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (guix utils)
|
||||
#:export (http-fetch))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; Web client portable among Guile versions.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define* (http-fetch uri #:key (text? #f))
|
||||
"Return an input port containing the data at URI, and the expected number of
|
||||
bytes available or #f. If TEXT? is true, the data at URI is considered to be
|
||||
textual. Follow any HTTP redirection."
|
||||
(let loop ((uri uri))
|
||||
(let*-values (((resp data)
|
||||
;; Try hard to use the API du jour to get an input port.
|
||||
;; On Guile 2.0.5 and before, we can only get a string or
|
||||
;; bytevector, and not an input port. Work around that.
|
||||
(if (version>? "2.0.7" (version))
|
||||
(if (defined? 'http-get*)
|
||||
(http-get* uri #:decode-body? text?) ; 2.0.7
|
||||
(http-get uri #:decode-body? text?)) ; 2.0.5-
|
||||
(http-get uri #:streaming? #t))) ; 2.0.9+
|
||||
((code)
|
||||
(response-code resp)))
|
||||
(case code
|
||||
((200)
|
||||
(let ((len (response-content-length resp)))
|
||||
(cond ((not data)
|
||||
(begin
|
||||
;; XXX: Guile 2.0.5 and earlier did not support chunked
|
||||
;; transfer encoding, which is required for instance when
|
||||
;; fetching %PACKAGE-LIST-URL (see
|
||||
;; <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>).
|
||||
;; Since users may still be using these versions, warn them
|
||||
;; and bail out.
|
||||
(warning (_ "using Guile ~a, ~a ~s encoding~%")
|
||||
(version)
|
||||
"which does not support HTTP"
|
||||
(response-transfer-encoding resp))
|
||||
(leave (_ "download failed; use a newer Guile~%")
|
||||
uri resp)))
|
||||
((string? data) ; `http-get' from 2.0.5-
|
||||
(values (open-input-string data) len))
|
||||
((bytevector? data) ; likewise
|
||||
(values (open-bytevector-input-port data) len))
|
||||
(else ; input port
|
||||
(values data len)))))
|
||||
((301 ; moved permanently
|
||||
302) ; found (redirection)
|
||||
(let ((uri (response-location resp)))
|
||||
(format #t "following redirection to `~a'...~%"
|
||||
(uri->string uri))
|
||||
(loop uri)))
|
||||
(else
|
||||
(error "download failed" uri code
|
||||
(response-reason-phrase resp)))))))
|
||||
|
||||
;;; web.scm ends here
|
||||
|
|
@ -65,6 +65,7 @@ builds derivations on behalf of its clients.";
|
|||
#define GUIX_OPT_DEBUG 9
|
||||
#define GUIX_OPT_CHROOT_DIR 10
|
||||
#define GUIX_OPT_LISTEN 11
|
||||
#define GUIX_OPT_NO_SUBSTITUTES 12
|
||||
|
||||
static const struct argp_option options[] =
|
||||
{
|
||||
|
|
@ -90,6 +91,8 @@ static const struct argp_option options[] =
|
|||
},
|
||||
{ "build-users-group", GUIX_OPT_BUILD_USERS_GROUP, "GROUP", 0,
|
||||
"Perform builds as a user of GROUP" },
|
||||
{ "no-substitutes", GUIX_OPT_NO_SUBSTITUTES, 0, 0,
|
||||
"Do not use substitutes" },
|
||||
{ "cache-failures", GUIX_OPT_CACHE_FAILURES, 0, 0,
|
||||
"Cache build failures" },
|
||||
{ "lose-logs", GUIX_OPT_LOSE_LOGS, 0, 0,
|
||||
|
|
@ -152,6 +155,9 @@ parse_opt (int key, char *arg, struct argp_state *state)
|
|||
exit (EXIT_FAILURE);
|
||||
}
|
||||
break;
|
||||
case GUIX_OPT_NO_SUBSTITUTES:
|
||||
settings.useSubstitutes = false;
|
||||
break;
|
||||
case GUIX_OPT_DEBUG:
|
||||
verbosity = lvlDebug;
|
||||
break;
|
||||
|
|
@ -202,18 +208,21 @@ main (int argc, char *argv[])
|
|||
|
||||
/* Use our substituter by default. */
|
||||
settings.substituters.clear ();
|
||||
string subs = getEnv ("NIX_SUBSTITUTERS", "default");
|
||||
if (subs == "default")
|
||||
/* XXX: No substituters until we have something that works. */
|
||||
settings.substituters.clear ();
|
||||
// settings.substituters.push_back (settings.nixLibexecDir
|
||||
// + "/guix/substitute-binary");
|
||||
else
|
||||
settings.substituters = tokenizeString<Strings> (subs, ":");
|
||||
|
||||
settings.useSubstitutes = true;
|
||||
|
||||
argp_parse (&argp, argc, argv, 0, 0, 0);
|
||||
|
||||
if (settings.useSubstitutes)
|
||||
{
|
||||
string subs = getEnv ("NIX_SUBSTITUTERS", "default");
|
||||
|
||||
if (subs == "default")
|
||||
settings.substituters.push_back (settings.nixLibexecDir
|
||||
+ "/guix/substitute-binary");
|
||||
else
|
||||
settings.substituters = tokenizeString<Strings> (subs, ":");
|
||||
}
|
||||
|
||||
if (geteuid () == 0 && settings.buildUsersGroup.empty ())
|
||||
fprintf (stderr, "warning: daemon is running as root, so "
|
||||
"using `--build-users-group' is highly recommended\n");
|
||||
|
|
|
|||
|
|
@ -8,5 +8,8 @@ guix/scripts/build.scm
|
|||
guix/scripts/download.scm
|
||||
guix/scripts/package.scm
|
||||
guix/scripts/gc.scm
|
||||
guix/scripts/hash.scm
|
||||
guix/scripts/pull.scm
|
||||
guix/gnu-maintenance.scm
|
||||
guix/ui.scm
|
||||
guix/web.scm
|
||||
|
|
|
|||
|
|
@ -45,9 +45,13 @@ then
|
|||
rm -rf "$NIX_STATE_DIR/substituter-data"
|
||||
mkdir -p "$NIX_STATE_DIR/substituter-data"
|
||||
|
||||
# Place for the substituter's cache.
|
||||
XDG_CACHE_HOME="$NIX_STATE_DIR/cache-$$"
|
||||
|
||||
export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR \
|
||||
NIX_LOCALSTATE_DIR NIX_LOG_DIR NIX_STATE_DIR NIX_DB_DIR \
|
||||
NIX_ROOT_FINDER NIX_SETUID_HELPER GUIX_BINARY_SUBSTITUTE_URL
|
||||
NIX_ROOT_FINDER NIX_SETUID_HELPER GUIX_BINARY_SUBSTITUTE_URL \
|
||||
XDG_CACHE_HOME
|
||||
|
||||
# Do that because store.scm calls `canonicalize-path' on it.
|
||||
mkdir -p "$NIX_STORE_DIR"
|
||||
|
|
|
|||
|
|
@ -32,6 +32,7 @@
|
|||
#:use-module (srfi srfi-64)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (web uri)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 ftw)
|
||||
|
|
@ -398,6 +399,51 @@
|
|||
;; prerequisite to build because DRV itself is already built.
|
||||
(null? (derivation-prerequisites-to-build %store drv)))))
|
||||
|
||||
(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
|
||||
(test-assert "derivation-prerequisites-to-build and substitutes"
|
||||
(let*-values (((store)
|
||||
(open-connection))
|
||||
((drv-path drv)
|
||||
(build-expression->derivation store "prereq-subst"
|
||||
(%current-system)
|
||||
(random 1000) '()))
|
||||
((output)
|
||||
(derivation-output-path
|
||||
(assoc-ref (derivation-outputs drv) "out")))
|
||||
((dir)
|
||||
(and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
|
||||
(compose uri-path string->uri))))
|
||||
;; Create fake substituter data, to be read by `substitute-binary'.
|
||||
(call-with-output-file (string-append dir "/nix-cache-info")
|
||||
(lambda (p)
|
||||
(format p "StoreDir: ~a\nWantMassQuery: 0\n"
|
||||
(%store-prefix))))
|
||||
(call-with-output-file (string-append dir "/" (store-path-hash-part output)
|
||||
".narinfo")
|
||||
(lambda (p)
|
||||
(format p "StorePath: ~a
|
||||
URL: ~a
|
||||
Compression: none
|
||||
NarSize: 1234
|
||||
References:
|
||||
System: ~a
|
||||
Deriver: ~a~%"
|
||||
output ; StorePath
|
||||
(string-append dir "/example.nar") ; URL
|
||||
(%current-system) ; System
|
||||
(basename drv-path)))) ; Deriver
|
||||
|
||||
(let-values (((build download)
|
||||
(derivation-prerequisites-to-build store drv))
|
||||
((build* download*)
|
||||
(derivation-prerequisites-to-build store drv
|
||||
#:use-substitutes? #f)))
|
||||
(pk build download build* download*)
|
||||
(and (null? build)
|
||||
(equal? download (list output))
|
||||
(null? download*)
|
||||
(null? build*)))))
|
||||
|
||||
(test-assert "build-expression->derivation with expression returning #f"
|
||||
(let* ((builder '(begin
|
||||
(mkdir %output)
|
||||
|
|
|
|||
|
|
@ -62,18 +62,19 @@ then
|
|||
# name and version string.
|
||||
installed="`guix package -p "$profile" --list-installed | cut -f1 | xargs echo | sort`"
|
||||
case "x$installed" in
|
||||
"guile-bootstrap make-boot0")
|
||||
true;;
|
||||
"make-boot0 guile-bootstrap")
|
||||
true;;
|
||||
"*")
|
||||
"guile-bootstrap make-boot0")
|
||||
true;;
|
||||
"make-boot0 guile-bootstrap")
|
||||
true;;
|
||||
"*")
|
||||
false;;
|
||||
esac
|
||||
|
||||
test "`guix package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap"
|
||||
|
||||
# Search.
|
||||
test "`guix package -s "GNU Hello" | grep ^name:`" = "name: hello"
|
||||
test "`guix package -s "An example GNU package" | grep ^name:`" = \
|
||||
"name: hello"
|
||||
test "`guix package -s "n0t4r341p4ck4g3"`" = ""
|
||||
|
||||
# Remove a package.
|
||||
|
|
@ -92,10 +93,10 @@ then
|
|||
# Move to the empty profile.
|
||||
for i in `seq 1 3`
|
||||
do
|
||||
guix package --bootstrap --roll-back -p "$profile"
|
||||
! test -f "$profile/bin"
|
||||
! test -f "$profile/lib"
|
||||
test "`readlink_base "$profile"`" = "$profile-0-link"
|
||||
guix package --bootstrap --roll-back -p "$profile"
|
||||
! test -f "$profile/bin"
|
||||
! test -f "$profile/lib"
|
||||
test "`readlink_base "$profile"`" = "$profile-0-link"
|
||||
done
|
||||
|
||||
# Reinstall after roll-back to the empty profile.
|
||||
|
|
|
|||
|
|
@ -196,7 +196,8 @@
|
|||
(cut restore-file <> output))
|
||||
(file-tree-equal? input output))
|
||||
(lambda ()
|
||||
(false-if-exception (delete-file nar)))))))
|
||||
(false-if-exception (delete-file nar))
|
||||
(false-if-exception (rm-rf output)))))))
|
||||
(lambda ()
|
||||
(rmdir input)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -53,6 +53,28 @@
|
|||
(home-page #f) (license #f)
|
||||
extra-fields ...))
|
||||
|
||||
(test-assert "package-field-location"
|
||||
(let ()
|
||||
(define (goto port line column)
|
||||
(unless (and (= (port-column port) (- column 1))
|
||||
(= (port-line port) (- line 1)))
|
||||
(unless (eof-object? (get-char port))
|
||||
(goto port line column))))
|
||||
|
||||
(define read-at
|
||||
(match-lambda
|
||||
(($ <location> file line column)
|
||||
(call-with-input-file (search-path %load-path file)
|
||||
(lambda (port)
|
||||
(goto port line column)
|
||||
(read port))))))
|
||||
|
||||
(and (equal? (read-at (package-field-location %bootstrap-guile 'name))
|
||||
(package-name %bootstrap-guile))
|
||||
(equal? (read-at (package-field-location %bootstrap-guile 'version))
|
||||
(package-version %bootstrap-guile))
|
||||
(not (package-field-location %bootstrap-guile 'does-not-exist)))))
|
||||
|
||||
(test-assert "package-transitive-inputs"
|
||||
(let* ((a (dummy-package "a"))
|
||||
(b (dummy-package "b"
|
||||
|
|
|
|||
|
|
@ -159,6 +159,12 @@ Deriver: ~a~%"
|
|||
(%current-system) ; System
|
||||
(basename d)))) ; Deriver
|
||||
|
||||
;; Remove entry from the local cache.
|
||||
(false-if-exception
|
||||
(delete-file (string-append (getenv "XDG_CACHE_HOME")
|
||||
"/guix/substitute-binary/"
|
||||
(store-path-hash-part o))))
|
||||
|
||||
;; Make sure `substitute-binary' correctly communicates the above data.
|
||||
(set-build-options s #:use-substitutes? #t)
|
||||
(and (has-substitutes? s o)
|
||||
|
|
|
|||
|
|
@ -64,6 +64,31 @@
|
|||
("nixpkgs" "1.0pre22125_a28fe19")
|
||||
("gtk2" "2.38.0"))))
|
||||
|
||||
(test-equal "fold2, 1 list"
|
||||
(list (reverse (iota 5))
|
||||
(map - (reverse (iota 5))))
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(fold2 (lambda (i r1 r2)
|
||||
(values (cons i r1)
|
||||
(cons (- i) r2)))
|
||||
'() '()
|
||||
(iota 5)))
|
||||
list))
|
||||
|
||||
(test-equal "fold2, 2 lists"
|
||||
(list (reverse '((a . 0) (b . 1) (c . 2) (d . 3)))
|
||||
(reverse '((a . 0) (b . -1) (c . -2) (d . -3))))
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(fold2 (lambda (k v r1 r2)
|
||||
(values (alist-cons k v r1)
|
||||
(alist-cons k (- v) r2)))
|
||||
'() '()
|
||||
'(a b c d)
|
||||
'(0 1 2 3)))
|
||||
list))
|
||||
|
||||
(test-assert "define-record-type*"
|
||||
(begin
|
||||
(define-record-type* <foo> foo make-foo
|
||||
|
|
|
|||
Loading…
Reference in New Issue