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

Merge branch 'master' into core-updates 

Conflicts:
	gnu-system.am
This commit is contained in:
Ludovic Courtès 2014-02-22 00:27:57 +01:00
parent 99662b8dbf 2096ef47aa
commit b2bfa32d25
106 changed files with 4058 additions and 1147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitignore vendored
View File

@ -46,8 +46,8 @@ config.cache
/doc/guix.pdf
/doc/stamp-vti
/doc/version.texi
/gnu/packages/bootstrap/x86_64-linux/guile-2.0.7.tar.xz
/gnu/packages/bootstrap/i686-linux/guile-2.0.7.tar.xz
/gnu/packages/bootstrap/x86_64-linux/guile-2.0.9.tar.xz
/gnu/packages/bootstrap/i686-linux/guile-2.0.9.tar.xz
/gnu/packages/bootstrap/mips64el-linux/guile-2.0.9.tar.xz
/guix/config.scm
/nix/nix-daemon/nix-daemon.cc

2
AUTHORS
View File

@ -13,8 +13,10 @@ alphabetical order):
John Darrington <john@darrington.wattle.id.au>
Andreas Enge <andreas@enge.fr>
Guy Grant <gzg@riseup.net>
Raimon Grau <raimonster@gmail.com>
Nikita Karetnikov <nikita@karetnikov.org>
Aljosha Papsch <misc@rpapsch.de>
Manolis Ragkousis <manolis837@gmail.com>
Cyril Roelandt <tipecaml@gmail.com>
Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
Sree Harsha Totakura <sreeharsha@totakura.in>

3
Makefile.am
View File

@ -34,6 +34,7 @@ MODULES = \
guix/pki.scm \
guix/utils.scm \
guix/download.scm \
guix/git-download.scm \
guix/monads.scm \
guix/profiles.scm \
guix/serialization.scm \
@ -54,6 +55,7 @@ MODULES = \
guix/ui.scm \
guix/build/download.scm \
guix/build/cmake-build-system.scm \
guix/build/git.scm \
guix/build/gnome.scm \
guix/build/gnu-build-system.scm \
guix/build/gnu-dist.scm \
@ -77,6 +79,7 @@ MODULES = \
guix/scripts/substitute-binary.scm \
guix/scripts/authenticate.scm \
guix/scripts/refresh.scm \
guix/scripts/system.scm \
guix.scm \
$(GNU_SYSTEM_MODULES)

170
doc/guix.texi
View File

@ -502,6 +502,30 @@ the daemon makes the new file a hard link to the other file. This
slightly increases the input/output load at the end of a build process.
This option disables this.
@item --gc-keep-outputs[=yes|no]
Tell whether the garbage collector (GC) must keep outputs of live
derivations.
When set to ``yes'', the GC will keep the outputs of any live derivation
available in the store---the @code{.drv} files. The default is ``no'',
meaning that derivation outputs are kept only if they are GC roots.
@item --gc-keep-derivations[=yes|no]
Tell whether the garbage collector (GC) must keep derivations
corresponding to live outputs.
When set to ``yes'', as is the case by default, the GC keeps
derivations---i.e., @code{.drv} files---as long as at least one of their
outputs is live. This allows users to keep track of the origins of
items in their store. Setting it to ``no'' saves a bit of disk space.
Note that when both @code{--gc-keep-derivations} and
@code{--gc-keep-outputs} are used, the effect is to keep all the build
prerequisites (the sources, compiler, libraries, and other build-time
tools) of live objects in the store, regardless of whether these
prerequisites are live. This is convenient for developers since it
saves rebuilds or downloads.
@item --impersonate-linux-2.6
On Linux-based systems, impersonate Linux 2.6. This means that the
kernel's @code{uname} system call will report 2.6 as the release number.
@ -1071,11 +1095,19 @@ the target machine's store. The @code{--missing} option can help figure
out which items are missing from the target's store.
Archives are stored in the ``Nix archive'' or ``Nar'' format, which is
comparable in spirit to `tar'. When exporting, the daemon digitally
signs the contents of the archive, and that digital signature is
appended. When importing, the daemon verifies the signature and rejects
the import in case of an invalid signature or if the signing key is not
authorized.
comparable in spirit to `tar', but with a few noteworthy differences
that make it more appropriate for our purposes. First, rather than
recording all Unix meta-data for each file, the Nar format only mentions
the file type (regular, directory, or symbolic link); Unix permissions
and owner/group are dismissed. Second, the order in which directory
entries are stored always follows the order of file names according to
the C locale collation order. This makes archive production fully
deterministic.
When exporting, the daemon digitally signs the contents of the archive,
and that digital signature is appended. When importing, the daemon
verifies the signature and rejects the import in case of an invalid
signature or if the signing key is not authorized.
@c FIXME: Add xref to daemon doc about signatures.
The main options are:
@ -1454,15 +1486,18 @@ a derivation is the @code{derivation} procedure:
@deffn {Scheme Procedure} derivation @var{store} @var{name} @var{builder} @
@var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @
[#:hash-mode #f] [#:inputs '()] [#:env-vars '()] @
[#:recursive? #f] [#:inputs '()] [#:env-vars '()] @
[#:system (%current-system)] [#:references-graphs #f] @
[#:local-build? #f]
Build a derivation with the given arguments, and return the resulting
@code{<derivation>} object.
When @var{hash}, @var{hash-algo}, and @var{hash-mode} are given, a
When @var{hash} and @var{hash-algo} are given, a
@dfn{fixed-output derivation} is created---i.e., one whose result is
known in advance, such as a file download.
known in advance, such as a file download. If, in addition,
@var{recursive?} is true, then that fixed output may be an executable
file or a directory and @var{hash} must be the hash of an archive
containing this output.
When @var{references-graphs} is true, it must be a list of file
name/store path pairs. In that case, the reference graph of each store
@ -1502,7 +1537,7 @@ the caller to directly pass a Guile expression as the build script:
@var{name} @var{exp} @
[#:system (%current-system)] [#:inputs '()] @
[#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @
[#:env-vars '()] [#:modules '()] @
[#:recursive? #f] [#:env-vars '()] [#:modules '()] @
[#:references-graphs #f] [#:local-build? #f] [#:guile-for-build #f]
Return a derivation that executes Scheme expression @var{exp} as a
builder for derivation @var{name}. @var{inputs} must be a list of
@ -1590,23 +1625,22 @@ in a monad---values that carry this additional context---are called
Consider this ``normal'' procedure:
@example
(define (profile.sh store)
;; Return the name of a shell script in the store that
;; initializes the 'PATH' environment variable.
(let* ((drv (package-derivation store coreutils))
(out (derivation->output-path drv)))
(add-text-to-store store "profile.sh"
(format #f "export PATH=~a/bin" out))))
(define (sh-symlink store)
;; Return a derivation that symlinks the 'bash' executable.
(let* ((drv (package-derivation store bash))
(out (derivation->output-path drv))
(sh (string-append out "/bin/bash")))
(build-expression->derivation store "sh"
`(symlink ,sh %output))))
@end example
Using @code{(guix monads)}, it may be rewritten as a monadic function:
@example
(define (profile.sh)
(define (sh-symlink)
;; Same, but return a monadic value.
(mlet %store-monad ((bin (package-file coreutils "bin")))
(text-file "profile.sh"
(string-append "export PATH=" bin))))
(mlet %store-monad ((sh (package-file bash "bin")))
(derivation-expression "sh" `(symlink ,sh %output))))
@end example
There are two things to note in the second version: the @code{store}
@ -1672,7 +1706,32 @@ open store connection.
@deffn {Monadic Procedure} text-file @var{name} @var{text}
Return as a monadic value the absolute file name in the store of the file
containing @var{text}.
containing @var{text}, a string.
@end deffn
@deffn {Monadic Procedure} text-file* @var{name} @var{text} @dots{}
Return as a monadic value a derivation that builds a text file
containing all of @var{text}. @var{text} may list, in addition to
strings, packages, derivations, and store file names; the resulting
store file holds references to all these.
This variant should be preferred over @code{text-file} anytime the file
to create will reference items from the store. This is typically the
case when building a configuration file that embeds store file names,
like this:
@example
(define (profile.sh)
;; Return the name of a shell script in the store that
;; initializes the 'PATH' environment variable.
(text-file* "profile.sh"
"export PATH=" coreutils "/bin:"
grep "/bin:" sed "/bin\n"))
@end example
In this example, the resulting @file{/nix/store/@dots{}-profile.sh} file
will references @var{coreutils}, @var{grep}, and @var{sed}, thereby
preventing them from being garbage-collected during its lifetime.
@end deffn
@deffn {Monadic Procedure} package-file @var{package} [@var{file}] @
@ -1910,6 +1969,19 @@ 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.
@item --recursive
@itemx -r
Compute the hash on @var{file} recursively.
In this case, the hash is computed on an archive containing @var{file},
including its children if it is a directory. Some of @var{file}'s
meta-data is part of the archive; for instance, when @var{file} is a
regular file, the hash is different depending on whether @var{file} is
executable or not. Meta-data such as time stamps has no impact on the
hash (@pxref{Invoking guix archive}).
@c FIXME: Replace xref above with xref to an ``Archive'' section when
@c it exists.
@end table
@node Invoking guix refresh
@ -2499,8 +2571,9 @@ instantiated. Then we show how this mechanism can be extended, for
instance to support new system services.
@menu
* Using the Configuration System:: Customizing your GNU system.
* Defining Services:: Adding new service definitions.
* Using the Configuration System:: Customizing your GNU system.
* Invoking guix system:: Instantiating a system configuration.
* Defining Services:: Adding new service definitions.
@end menu
@node Using the Configuration System
@ -2513,9 +2586,9 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this:
@findex operating-system
@lisp
(use-modules (gnu system)
(use-modules (gnu services base) ; for '%base-services'
(gnu services ssh) ; for 'lsh-service'
(gnu system shadow) ; for 'user-account'
(gnu system service) ; for 'lsh-service'
(gnu packages base) ; Coreutils, grep, etc.
(gnu packages bash) ; Bash
(gnu packages admin) ; dmd, Inetutils
@ -2542,7 +2615,7 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this:
procps psmisc
zile less))
(services (cons (lsh-service #:port 2222 #:allow-root-login? #t)
%standard-services))))
%base-services))))
@end lisp
This example should be self-describing. The @code{packages} field lists
@ -2552,9 +2625,10 @@ visible on the system, for all user accounts---i.e., in every user's
@code{PATH} environment variable---in addition to the per-user profiles
(@pxref{Invoking guix package}).
@vindex %base-services
The @code{services} field lists @dfn{system services} to be made
available when the system starts. The @var{%standard-services} list,
from the @code{(gnu system)} module, provides the basic services one
available when the system starts. The @var{%base-services} list,
from the @code{(gnu services base)} module, provides the basic services one
would expect from a GNU system: a login service (mingetty) on each tty,
syslogd, libc's name service cache daemon (nscd), etc.
@ -2566,13 +2640,12 @@ daemon listening on port 2222, and allowing remote @code{root} logins
right command-line options, possibly with supporting configuration files
generated as needed (@pxref{Defining Services}).
@c TODO: update when that command exists
Assuming the above snippet is stored in the @file{my-system-config.scm}
file, the (yet unwritten!) @command{guix system --boot
my-system-config.scm} command instantiates that configuration, and makes
it the default GRUB boot entry. The normal way to change the system's
configuration is by updating this file and re-running the @command{guix
system} command.
file, the @command{guix system boot my-system-config.scm} command
instantiates that configuration, and makes it the default GRUB boot
entry (@pxref{Invoking guix system}). The normal way to change the
system's configuration is by updating this file and re-running the
@command{guix system} command.
At the Scheme level, the bulk of an @code{operating-system} declaration
is instantiated with the following monadic procedure (@pxref{The Store
@ -2587,11 +2660,38 @@ the packages, configuration files, and other supporting files needed to
instantiate @var{os}.
@end deffn
@node Invoking guix system
@subsection Invoking @code{guix system}
Once you have written an operating system declaration, as seen in the
previous section, it can be @dfn{instantiated} using the @command{guix
system} command. The synopsis is:
@example
guix system @var{options}@dots{} @var{action} @var{file}
@end example
@var{file} must be the name of a file containing an
@code{operating-system} declaration. @var{action} specifies how the
operating system is instantiate. Currently only one value is supported:
@table @code
@item vm
@cindex virtual machine
Build a virtual machine that contain the operating system declared in
@var{file}, and return a script to run that virtual machine (VM).
The VM shares its store with the host system.
@end table
@var{options} can contain any of the common build options provided by
@command{guix build} (@pxref{Invoking guix build}).
@node Defining Services
@subsection Defining Services
The @code{(gnu system dmd)} module defines several procedures that allow
The @code{(gnu services @dots{})} modules define several procedures that allow
users to declare the operating system's services (@pxref{Using the
Configuration System}). These procedures are @emph{monadic
procedures}---i.e., procedures that return a monadic value in the store

36
gnu-system.am
View File

@ -29,6 +29,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/algebra.scm \
gnu/packages/apl.scm \
gnu/packages/apr.scm \
gnu/packages/asciidoc.scm \
gnu/packages/aspell.scm \
gnu/packages/attr.scm \
gnu/packages/autogen.scm \
@ -39,7 +40,9 @@ GNU_SYSTEM_MODULES = \
gnu/packages/bdb.scm \
gnu/packages/bdw-gc.scm \
gnu/packages/bison.scm \
gnu/packages/boost.scm \
gnu/packages/bootstrap.scm \
gnu/packages/calcurse.scm \
gnu/packages/cdrom.scm \
gnu/packages/cflow.scm \
gnu/packages/check.scm \
@ -68,7 +71,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/fonts.scm \
gnu/packages/fontutils.scm \
gnu/packages/freeipmi.scm \
gnu/packages/games.scm \
gnu/packages/games.scm \
gnu/packages/gawk.scm \
gnu/packages/gcal.scm \
gnu/packages/gcc.scm \
@ -78,6 +81,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/geeqie.scm \
gnu/packages/gettext.scm \
gnu/packages/ghostscript.scm \
gnu/packages/giflib.scm \
gnu/packages/gkrellm.scm \
gnu/packages/gl.scm \
gnu/packages/glib.scm \
@ -100,12 +104,15 @@ GNU_SYSTEM_MODULES = \
gnu/packages/guile.scm \
gnu/packages/guile-wm.scm \
gnu/packages/gv.scm \
gnu/packages/gxmessage.scm \
gnu/packages/help2man.scm \
gnu/packages/hugs.scm \
gnu/packages/hurd.scm \
gnu/packages/icu4c.scm \
gnu/packages/idutils.scm \
gnu/packages/imagemagick.scm \
gnu/packages/indent.scm \
gnu/packages/inkscape.scm \
gnu/packages/irssi.scm \
gnu/packages/iso-codes.scm \
gnu/packages/kde.scm \
@ -125,9 +132,9 @@ GNU_SYSTEM_MODULES = \
gnu/packages/libunistring.scm \
gnu/packages/libusb.scm \
gnu/packages/libunwind.scm \
gnu/packages/libwebsockets.scm \
gnu/packages/lightning.scm \
gnu/packages/linux.scm \
gnu/packages/linux-initrd.scm \
gnu/packages/lout.scm \
gnu/packages/lsh.scm \
gnu/packages/lsof.scm \
@ -138,6 +145,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/make-bootstrap.scm \
gnu/packages/maths.scm \
gnu/packages/mit-krb5.scm \
gnu/packages/moe.scm \
gnu/packages/mp3.scm \
gnu/packages/multiprecision.scm \
gnu/packages/mtools.scm \
@ -179,6 +187,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/scheme.scm \
gnu/packages/screen.scm \
gnu/packages/sdl.scm \
gnu/packages/search.scm \
gnu/packages/serveez.scm \
gnu/packages/shishi.scm \
gnu/packages/skribilo.scm \
@ -186,6 +195,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/smalltalk.scm \
gnu/packages/sqlite.scm \
gnu/packages/ssh.scm \
gnu/packages/stalonetray.scm \
gnu/packages/swig.scm \
gnu/packages/tcl.scm \
gnu/packages/tcsh.scm \
@ -203,7 +213,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/vpn.scm \
gnu/packages/w3m.scm \
gnu/packages/wdiff.scm \
gnu/packages/web.scm \
gnu/packages/web.scm \
gnu/packages/wget.scm \
gnu/packages/which.scm \
gnu/packages/wordnet.scm \
@ -216,10 +226,16 @@ GNU_SYSTEM_MODULES = \
gnu/packages/zile.scm \
gnu/packages/zip.scm \
\
gnu/services.scm \
gnu/services/base.scm \
gnu/services/dmd.scm \
gnu/services/networking.scm \
gnu/services/xorg.scm \
\
gnu/system.scm \
gnu/system/dmd.scm \
gnu/system/grub.scm \
gnu/system/linux.scm \
gnu/system/linux-initrd.scm \
gnu/system/shadow.scm \
gnu/system/vm.scm
@ -236,9 +252,11 @@ dist_patch_DATA = \
gnu/packages/patches/cmake-fix-tests.patch \
gnu/packages/patches/coreutils-dummy-man.patch \
gnu/packages/patches/cpio-gets-undeclared.patch \
gnu/packages/patches/curl-fix-test172.patch \
gnu/packages/patches/dbus-localstatedir.patch \
gnu/packages/patches/diffutils-gets-undeclared.patch \
gnu/packages/patches/dmd-getpw.patch \
gnu/packages/patches/dmd-tests-longer-sleeps.patch \
gnu/packages/patches/emacs-configure-sh.patch \
gnu/packages/patches/findutils-absolute-paths.patch \
gnu/packages/patches/flac-fix-memcmp-not-declared.patch \
@ -246,13 +264,14 @@ dist_patch_DATA = \
gnu/packages/patches/gawk-shell.patch \
gnu/packages/patches/gcc-cross-environment-variables.patch \
gnu/packages/patches/gd-mips64-deplibs-fix.patch \
gnu/packages/patches/gdb-loongson-madd-fix.patch \
gnu/packages/patches/glib-tests-desktop.patch \
gnu/packages/patches/glib-tests-homedir.patch \
gnu/packages/patches/glib-tests-newnet.patch \
gnu/packages/patches/glib-tests-prlimit.patch \
gnu/packages/patches/glibc-bootstrap-system.patch \
gnu/packages/patches/glibc-ldd-x86_64.patch \
gnu/packages/patches/gnunet-fix-scheduler.patch \
gnu/packages/patches/gnunet-fix-tests.patch \
gnu/packages/patches/gobject-introspection-cc.patch \
gnu/packages/patches/grub-gets-undeclared.patch \
gnu/packages/patches/gstreamer-0.10-bison3.patch \
@ -265,6 +284,7 @@ dist_patch_DATA = \
gnu/packages/patches/gtkglext-disable-disable-deprecated.patch \
gnu/packages/patches/gtkglext-remove-pangox-dependency.patch \
gnu/packages/patches/hop-bigloo-4.0b.patch \
gnu/packages/patches/inkscape-stray-comma.patch \
gnu/packages/patches/libevent-dns-tests.patch \
gnu/packages/patches/libffi-mips-n32-fix.patch \
gnu/packages/patches/liboop-mips64-deplibs-fix.patch \
@ -278,6 +298,8 @@ dist_patch_DATA = \
gnu/packages/patches/make-impure-dirs.patch \
gnu/packages/patches/mcron-install.patch \
gnu/packages/patches/mit-krb5-init-fix.patch \
gnu/packages/patches/mpc123-initialize-ao.patch \
gnu/packages/patches/patchelf-page-size.patch \
gnu/packages/patches/perl-no-sys-dirs.patch \
gnu/packages/patches/plotutils-libpng-jmpbuf.patch \
gnu/packages/patches/procps-make-3.82.patch \
@ -287,9 +309,13 @@ dist_patch_DATA = \
gnu/packages/patches/qemu-make-4.0.patch \
gnu/packages/patches/qemu-multiple-smb-shares.patch \
gnu/packages/patches/qt4-tests.patch \
gnu/packages/patches/ratpoison-shell.patch \
gnu/packages/patches/readline-link-ncurses.patch \
gnu/packages/patches/ripperx-libm.patch \
gnu/packages/patches/scheme48-tests.patch \
gnu/packages/patches/slim-session.patch \
gnu/packages/patches/slim-config.patch \
gnu/packages/patches/slim-sigusr1.patch \
gnu/packages/patches/tcsh-fix-autotest.patch \
gnu/packages/patches/teckit-cstdio.patch \
gnu/packages/patches/valgrind-glibc.patch \

11
gnu/packages/admin.scm
View File

@ -49,7 +49,8 @@
(sha256
(base32
"07mddw0p62fcphwjzgb6rfa0pjz5sy6jzbha0sm2vc3rqf459jxg"))
(patches (list (search-patch "dmd-getpw.patch")))))
(patches (list (search-patch "dmd-getpw.patch")
(search-patch "dmd-tests-longer-sleeps.patch")))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--localstatedir=/var")))
@ -349,14 +350,14 @@ connection alive.")
(define-public isc-dhcp
(package
(name "isc-dhcp")
(version "4.3.0a1")
(version "4.3.0")
(source (origin
(method url-fetch)
(uri (string-append "http://ftp.isc.org/isc/dhcp/"
version "/dhcp-" version ".tar.gz"))
(sha256
(base32
"0001n26m4488nl95h53wg60sywbli4d246vz2h8lpv70jlrq9q1p"))))
"12mydvj6x3zcl3gla06bywfkkrgg03g66fijs94mwb7kbiym3dm7"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-after
@ -383,9 +384,9 @@ connection alive.")
(system* "tar" "xf" "bind.tar.gz")
(for-each patch-shebang
(find-files "bind-9.9.5b1" ".*"))
(find-files "bind-9.9.5" ".*"))
(zero? (system* "tar" "cf" "bind.tar.gz"
"bind-9.9.5b1"))))
"bind-9.9.5"))))
(alist-cons-after
'install 'post-install
(lambda* (#:key inputs outputs #:allow-other-keys)

4
gnu/packages/apl.scm
View File

@ -28,14 +28,14 @@
(define-public apl
(package
(name "apl")
(version "1.1")
(version "1.2")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/apl/apl-" version ".tar.gz"))
(sha256
(base32
"1myinxa0m3y4fanpxflfakfk3m1s8641wdlbwbs0vg5yp10xm0m3"))))
"0v9jn4hrg4w3hyw4lsj8cys9aqsmrc1x4k0g5f67psgzgd45a4xb"))))
(build-system gnu-build-system)
(home-page "http://www.gnu.org/software/apl/")
(inputs

52
gnu/packages/asciidoc.scm Normal file
View File

@ -0,0 +1,52 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages asciidoc)
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (gnu packages python)
#:use-module (guix build-system gnu)
#:autoload (gnu packages zip) (unzip))
(define-public asciidoc
(package
(name "asciidoc")
(version "8.6.9")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/asciidoc/asciidoc-"
version ".tar.gz"))
(sha256
(base32
"1w71nk527lq504njmaf0vzr93pgahkgzzxzglrq6bay8cw2rvnvq"))))
(build-system gnu-build-system)
(arguments '(#:tests? #f)) ; no 'check' target
(inputs `(("python" ,python-2)))
(home-page "http://www.methods.co.nz/asciidoc/")
(synopsis "Text-based document generation system")
(description
"AsciiDoc is a text document format for writing notes, documentation,
articles, books, ebooks, slideshows, web pages, man pages and blogs.
AsciiDoc files can be translated to many formats including HTML, PDF,
EPUB, man page.
AsciiDoc is highly configurable: both the AsciiDoc source file syntax and
the backend output markups (which can be almost any type of SGML/XML
markup) can be customized and extended by the user.")
(license gpl2+)))

89
gnu/packages/boost.scm Normal file
View File

@ -0,0 +1,89 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages boost)
#:use-module ((guix licenses)
#:renamer (symbol-prefix-proc 'license:))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages python)
#:use-module (gnu packages tcsh)
#:use-module (gnu packages perl))
(define-public boost
(package
(name "boost")
(version "1.55.0")
(source (origin
(method url-fetch)
(uri (string-append
"mirror://sourceforge/boost/boost_"
(string-map (lambda (x) (if (eq? x #\.) #\_ x)) version)
".tar.bz2"))
(sha256
(base32
"0lkv5dzssbl5fmh2nkaszi8x9qbj80pr4acf9i26sj3rvlih1w7z"))))
(build-system gnu-build-system)
(native-inputs
`(("perl" ,perl)
("python" ,python-2)
("tcsh" ,tcsh)))
(arguments
`(#:phases
(alist-replace
'configure
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(substitute* '("libs/config/configure"
"libs/spirit/classic/phoenix/test/runtest.sh"
"tools/build/v2/doc/bjam.qbk"
"tools/build/v2/engine/execunix.c"
"tools/build/v2/engine/Jambase"
"tools/build/v2/engine/jambase.c")
(("/bin/sh") (which "sh")))
(setenv "SHELL" (which "sh"))
(setenv "CONFIG_SHELL" (which "sh"))
(zero? (system* "./bootstrap.sh"
(string-append "--prefix=" out)
"--with-toolset=gcc"))))
(alist-replace
'build
(lambda _
(zero? (system* "./b2" "threading=multi" "link=shared")))
(alist-replace
'check
(lambda _ #t)
(alist-replace
'install
(lambda _
(zero? (system* "./b2" "install" "threading=multi" "link=shared")))
%standard-phases))))))
(home-page "http://boost.org")
(synopsis "Peer-reviewed portable C++ source libraries")
(description
"A collection of libraries intended to be widely useful, and usable
across a broad spectrum of applications.")
(license (license:x11-style "http://www.boost.org/LICENSE_1_0.txt"
"Some components have other similar licences."))))

49
gnu/packages/calcurse.scm Normal file
View File

@ -0,0 +1,49 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages autogen)
#:use-module (guix packages)
#:use-module (guix licenses)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages ncurses))
(define-public calcurse
(package
(name "calcurse")
(version "3.1.4")
(source
(origin
(method url-fetch)
(uri (string-append "http://calcurse.org/files/calcurse-"
version ".tar.gz"))
(sha256
(base32
"1qwhffwhfg7bjxrviwlcrhnfw0976d39da8kfspq6dgd9nqv68a1"))))
(build-system gnu-build-system)
(inputs `(("ncurses" ,ncurses)))
(home-page "http://www.calcurse.org")
(synopsis "Text-based calendar and scheduling")
(description
"Calcurse is a text-based calendar and scheduling application. It helps
keep track of events, appointments and everyday tasks. A configurable
notification system reminds user of upcoming deadlines, and the curses based
interface can be customized to suit user needs. All of the commands are
documented within an online help system.")
(license bsd-2)))

23
gnu/packages/curl.scm
View File

@ -22,6 +22,7 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages compression)
#:use-module (gnu packages gnutls)
#:use-module (gnu packages groff)
@ -30,19 +31,24 @@
#:use-module (gnu packages openldap)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages ssh))
(define-public curl
(package
(name "curl")
(version "7.28.1")
(version "7.35.0")
(source (origin
(method url-fetch)
(uri (string-append "http://curl.haxx.se/download/curl-"
version ".tar.lzma"))
(sha256
(base32
"13bhfs41yf60ys2hrikqxjwfzaj0gm91kqzsgc5fr4grzmpm38nx"))))
"14w5cwh6b1426lxkq6kp6h4vxryr4n7wfrrwhny1r4123q7n8ab9"))
(patches
;; This patch fixes testcase 172 which uses a hardcoded cookie
;; expiration value which is expired as of Feb 1, 2014.
(list (search-patch "curl-fix-test172.patch")))))
(build-system gnu-build-system)
(inputs `(("gnutls" ,gnutls)
("gss" ,gss)
@ -54,9 +60,18 @@
`(("perl" ,perl)
;; to enable the --manual option and make test 1026 pass
("groff" ,groff)
("pkg-config" ,pkg-config)))
("pkg-config" ,pkg-config)
("python" ,python-2)))
(arguments
`(#:configure-flags '("--with-gnutls" "--with-gssapi")))
`(#:configure-flags '("--with-gnutls" "--with-gssapi")
;; Add a phase to patch '/bin/sh' occurances in tests/runtests.pl
#:phases
(alist-cons-before
'check 'patch-runtests
(lambda _
(substitute* "tests/runtests.pl"
(("/bin/sh") (which "sh"))))
%standard-phases)))
(synopsis "curl, command line tool for transferring data with URL syntax")
(description
"curl is a command line tool for transferring data with URL syntax,

8
gnu/packages/dc.scm
View File

@ -28,19 +28,19 @@
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module ((guix licenses)
#:renamer (symbol-prefix-proc 'license:)))
#:renamer (symbol-prefix-proc 'license:)))
(define-public ncdc
(package
(name "ncdc")
(version "1.18.1")
(version "1.19")
(source
(origin
(method url-fetch)
(uri (string-append "http://dev.yorhel.nl/download/ncdc-" version
".tar.gz"))
".tar.gz"))
(sha256 (base32
"11c6z9c3vv2vg01q02r53m28q3cx6x66j1l63f1mbk1crlqpf9fc"))))
"1wgvqwfxq9kc729h2r528n55821w87sfbm4h21mr6pvkpfw30hf2"))))
(build-system gnu-build-system)
(inputs
`(("bzip2" ,bzip2)

4
gnu/packages/elf.scm
View File

@ -21,6 +21,7 @@
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module ((guix licenses) #:select (gpl3+ lgpl3+ lgpl2.0+))
#:use-module (gnu packages)
#:use-module (gnu packages m4)
#:use-module (gnu packages compression))
@ -92,7 +93,8 @@
"/patchelf-" version ".tar.bz2"))
(sha256
(base32
"00bw29vdsscsili65wcb5ay0gvg1w0ljd00sb5xc6br8bylpyzpw"))))
"00bw29vdsscsili65wcb5ay0gvg1w0ljd00sb5xc6br8bylpyzpw"))
(patches (list (search-patch "patchelf-page-size.patch")))))
(build-system gnu-build-system)
(home-page "http://nixos.org/patchelf.html")
(synopsis "Modify the dynamic linker and RPATH of ELF executables")

10
gnu/packages/emacs.scm
View File

@ -33,6 +33,8 @@
#:use-module (gnu packages libjpeg)
#:use-module (gnu packages libtiff)
#:use-module (gnu packages libpng)
#:use-module (gnu packages giflib)
#:use-module (gnu packages linux)
#:use-module ((gnu packages compression)
#:renamer (symbol-prefix-proc 'compression:))
#:use-module (gnu packages xml)
@ -54,8 +56,7 @@
(arguments
'(#:configure-flags
(list (string-append "--with-crt-dir=" (assoc-ref %build-inputs "libc")
"/lib")
"--with-gif=no") ; XXX: add libungif
"/lib"))
#:phases (alist-cons-before
'configure 'fix-/bin/pwd
(lambda _
@ -73,7 +74,7 @@
("gtk+" ,gtk+-2)
("libXft" ,libxft)
("libtiff" ,libtiff)
;; ("libungif" ,libungif)
("giflib" ,giflib)
("libjpeg" ,libjpeg-8)
;; When looking for libpng `configure' links with `-lpng -lz', so we
@ -83,6 +84,9 @@
("libXpm" ,libxpm)
("libxml2" ,libxml2)
("libice" ,libice)
("libsm" ,libsm)
("alsa-lib" ,alsa-lib)
("dbus" ,dbus)))
(native-inputs
`(("pkg-config" ,pkg-config)

4
gnu/packages/file.scm
View File

@ -26,13 +26,13 @@
(define-public file
(package
(name "file")
(version "5.12")
(version "5.16")
(source (origin
(method url-fetch)
(uri (string-append "ftp://ftp.astron.com/pub/file/file-"
version ".tar.gz"))
(sha256 (base32
"08ix4xrvan0k80n0l5lqfmc4azjv5lyhvhwdxny4r09j5smhv78r"))))
"0qcj72mp8fzvh29h70mksxynax9mk5c6p8gzqw5qlyn34rvsrg28"))))
(build-system gnu-build-system)
(native-inputs
;; This package depends upon a native install of itself.

67
gnu/packages/fonts.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -26,6 +27,72 @@
#:select (tar))
#:use-module (gnu packages compression))
(define-public ttf-dejavu
(package
(name "ttf-dejavu")
(version "2.34")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/dejavu/"
version "/dejavu-fonts-ttf-"
version ".tar.bz2"))
(sha256
(base32
"0pgb0a3ngamidacmrvasg51ck3gp8gn93w6sf1s8snwzx4x2r9yh"))))
(build-system trivial-build-system)
(arguments
`(#:modules ((guix build utils))
#:builder (begin
(use-modules (guix build utils))
(let ((tar (string-append (assoc-ref %build-inputs
"tar")
"/bin/tar"))
(PATH (string-append (assoc-ref %build-inputs
"bzip2")
"/bin"))
(font-dir (string-append
%output "/share/fonts/truetype"))
(conf-dir (string-append
%output "/share/fontconfig/conf.avail"))
(doc-dir (string-append
%output "/share/doc/" ,name "-" ,version)))
(setenv "PATH" PATH)
(system* tar "xvf" (assoc-ref %build-inputs "source"))
(mkdir-p font-dir)
(mkdir-p conf-dir)
(mkdir-p doc-dir)
(chdir (string-append "dejavu-fonts-ttf-" ,version))
(for-each (lambda (ttf)
(copy-file ttf
(string-append font-dir "/"
(basename ttf))))
(find-files "ttf" "\\.ttf$"))
(for-each (lambda (conf)
(copy-file conf
(string-append conf-dir "/"
(basename conf))))
(find-files "fontconfig" "\\.conf$"))
(for-each (lambda (doc)
(copy-file doc
(string-append doc-dir "/"
(basename doc))))
(find-files "." "\\.txt$|^[A-Z][A-Z]*$"))))))
(native-inputs `(("source" ,source)
("tar" ,tar)
("bzip2" ,bzip2)))
(home-page "http://dejavu-fonts.org/")
(synopsis "Vera font family derivate with additional characters")
(description "DejaVu provides an expanded version of the Vera font family
aiming for quality and broader Unicode coverage while retaining the original
Vera style. DejaVu currently works towards conformance with the Multilingual
European Standards (MES-1 and MES-2) for Unicode coverage. The DejaVu fonts
provide serif, sans and monospaced variants.")
(license
(license:x11-style
"http://dejavu-fonts.org/"))))
(define-public ttf-bitstream-vera
(package
(name "ttf-bitstream-vera")

7
gnu/packages/gdb.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -33,15 +33,14 @@
(define-public gdb
(package
(name "gdb")
(version "7.6.2")
(version "7.7")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/gdb/gdb-"
version ".tar.bz2"))
(sha256
(base32
"1s6hjqmq7xz10hqx45dgrpfh5mla578shn3zxgnrsv66w4n0wsig"))
(patches (list (search-patch "gdb-loongson-madd-fix.patch")))))
"08vcb97j1b7vxwq6088wb6s3g3bm8iwikd922y0xsgbbxv3d2104"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-after

76
gnu/packages/giflib.scm Normal file
View File

@ -0,0 +1,76 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages giflib)
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (srfi srfi-1)
#:use-module (gnu packages xorg)
#:use-module (gnu packages perl))
(define-public giflib
(package
(name "giflib")
(version "4.2.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/giflib/giflib-"
(first (string-split version #\.))
".x/giflib-" version ".tar.bz2"))
(sha256
(base32 "0rmp7ipzk42r841bggd7bfqk4p8qsssbp4wcck4qnz7p4rkxbj0a"))))
(build-system gnu-build-system)
(outputs '("bin" ; utility programs
"out")) ; library
(inputs `(("libx11" ,libx11)
("libice" ,libice)
("libsm" ,libsm)
("perl" ,perl)))
(arguments
`(#:phases (alist-cons-after
'unpack 'disable-html-doc-gen
(lambda _
(substitute* "doc/Makefile.in"
(("^all: allhtml manpages") "")))
(alist-cons-after
'install 'install-manpages
(lambda* (#:key outputs #:allow-other-keys)
(let* ((bin (assoc-ref outputs "bin"))
(man1dir (string-append bin "/share/man/man1")))
(mkdir-p man1dir)
(for-each (lambda (file)
(let ((base (basename file)))
(format #t "installing `~a' to `~a'~%"
base man1dir)
(copy-file file
(string-append
man1dir "/" base))))
(find-files "doc" "\\.1"))))
%standard-phases))))
(synopsis "Tools and library for working with GIF images")
(description
"giflib is a library for reading and writing GIF images. It is API and
ABI compatible with libungif which was in wide use while the LZW compression
algorithm was patented. Tools are also included to convert, manipulate,
compose, and analyze GIF images.")
(home-page "http://giflib.sourceforge.net/")
(license x11)))
;;; giflib.scm ends here

4
gnu/packages/global.scm
View File

@ -28,14 +28,14 @@
(define-public global ; a global variable
(package
(name "global")
(version "6.2.9")
(version "6.2.10")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/global/global-"
version ".tar.gz"))
(sha256
(base32
"00y38kp0zbpjl9c9phldy7j2ihqc54qn4cdgk0azbjdsv75k3n6q"))))
"15nvz8g9b3s4i4fsa9ynrr8y517nfpy62agcvsl9rlz3j23b5b7f"))))
(build-system gnu-build-system)
(inputs `(("ncurses" ,ncurses)
("libtool" ,libtool)))

27
gnu/packages/gnome.scm
View File

@ -496,3 +496,30 @@ the API")
additional GDK objects which support OpenGL rendering in GTK+ and GtkWidget
API add-ons to make GTK+ widgets OpenGL-capable.")
(license lgpl2.1+)))
(define-public glade3
(package
(name "glade")
(version "3.8.4")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
(substring version 0 (string-rindex version #\.)) "/"
name "3-" version ".tar.xz"))
(sha256
(base32 "021xgq2l18w3rvwms9aq2idm0fk66vwb4f777gs0qh3ap5shgbn7"))))
(build-system gnu-build-system)
(inputs
`(("gtk+" ,gtk+-2)
("libxml2" ,libxml2)))
(native-inputs
`(("intltool" ,intltool)
("python" ,python)
("pkg-config" ,pkg-config)))
(home-page "https://glade.gnome.org")
(synopsis "GTK+ rapid application development tool")
(description "Glade is a rapid application development (RAD) tool to
enable quick & easy development of user interfaces for the GTK+ toolkit and
the GNOME desktop environment.")
(license lgpl2.0+)))

7
gnu/packages/gnu-pw-mgr.scm
View File

@ -27,15 +27,16 @@
(define-public gnu-pw-mgr
(package
(name "gnu-pw-mgr")
(version "1.0")
(version "1.1")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/gnu-pw-mgr/gnu-pw-mgr-"
(uri (string-append "mirror://gnu/gnu-pw-mgr/gpw-"
version "/gnu-pw-mgr-"
version ".tar.gz"))
(sha256
(base32
"0sn9gzngqkrv74iwxzn5ldqx3w73w9paldcdh8rsv9yvgarv2bm4"))))
"1nqkwjsdcif51d1s4dizr1ifx0qpmkjzvi375vc27dwbav4dwalx"))))
(build-system gnu-build-system)
(inputs `(("which" ,which)))
(home-page "http://www.gnu.org/software/gnu-pw-mgr/")

128
gnu/packages/gnunet.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;;
;;; This file is part of GNU Guix.
;;;
@ -17,6 +18,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages gnunet)
#:use-module (gnu packages)
#:use-module (gnu packages autotools)
#:use-module (gnu packages compression)
#:use-module (gnu packages curl)
@ -25,11 +27,19 @@
#:use-module (gnu packages glib)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages gnutls)
#:use-module (gnu packages groff)
#:use-module (gnu packages gstreamer)
#:use-module (gnu packages libidn)
#:use-module (gnu packages libjpeg)
#:use-module (gnu packages libtiff)
#:use-module (gnu packages libunistring)
#:use-module (gnu packages maths)
#:use-module (gnu packages openssl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages perl)
#:use-module (gnu packages pulseaudio)
#:use-module (gnu packages python)
#:use-module (gnu packages sqlite)
#:use-module (gnu packages video)
#:use-module (gnu packages xiph)
#:use-module ((guix licenses)
@ -123,3 +133,119 @@ also features security features such as basic and digest authentication
and support for SSL3 and TLS.")
(license license:lgpl2.1+)
(home-page "http://www.gnu.org/software/libmicrohttpd/")))
(define-public gnurl
(package
(name "gnurl")
(version "7.35.0")
(source (origin
(method url-fetch)
(uri (string-append "https://gnunet.org/sites/default/files/gnurl-"
version ".tar.bz2"))
(sha256
(base32 "0dzj22f5z6ppjj1aq1bml64iwbzzcd8w1qy3bgpk6gnzqslsxknf"))))
(build-system gnu-build-system)
(inputs `(("gnutls" ,gnutls)
("libidn" ,libidn)
("zlib" ,zlib)))
(native-inputs
`(("groff" ,groff)
("perl" ,perl)
("pkg-config" ,pkg-config)
("python" ,python-2)))
(arguments
`(#:configure-flags '("--enable-ipv6" "--with-gnutls" "--without-libssh2"
"--without-libmetalink" "--without-winidn"
"--without-librtmp" "--without-nghttp2"
"--without-nss" "--without-cyassl"
"--without-polarssl" "--without-ssl"
"--without-winssl" "--without-darwinssl"
"--disable-sspi" "--disable-ntlm-wb"
"--disable-ldap" "--disable-rtsp" "--disable-dict"
"--disable-telnet" "--disable-tftp" "--disable-pop3"
"--disable-imap" "--disable-smtp" "--disable-gopher"
"--disable-file" "--disable-ftp")
#:test-target "test"
#:parallel-tests? #f
;; We have to patch runtests.pl in tests/ directory
#:phases
(alist-cons-before
'check 'patch-runtests
(lambda _
(substitute* "tests/runtests.pl"
(("/bin/sh") (which "sh"))))
%standard-phases)))
(synopsis "Microfork of cURL with support for the HTTP/HTTPS/GnuTLS subset of cURL")
(description
"Gnurl is a microfork of cURL, a command line tool for transferring data
with URL syntax. While cURL supports many crypto backends, libgnurl only
supports HTTPS, HTTPS and GnuTLS.")
(license (license:bsd-style "file://COPYING"
"See COPYING in the distribution."))
(home-page "https://gnunet.org/gnurl")))
(define-public gnunet
(package
(name "gnunet")
(version "0.10.0")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/gnunet/gnunet-" version
".tar.gz"))
(sha256 (base32
"0zqpc47kywhjrpphl0palz849khv00ra2gjrfkysp6p0gfsbvd0i"))
(patches
(list
;; Patch to fix serious bug in scheduler; upstream commit: #31747
(search-patch "gnunet-fix-scheduler.patch")
;; Patch to fix bugs in testcases:
;; * Disable peerinfo-tool tests as they depend on reverse DNS lookups
;; * Allow revocation and integration-tests testcases to run on
;; loopback; upstream: #32130, #32326
;; * Skip GNS testcases requiring DNS lookups; upstream: #32118
(search-patch "gnunet-fix-tests.patch")))
(patch-flags '("-p0"))))
(build-system gnu-build-system)
(inputs
`(("glpk" ,glpk)
("gnurl" ,gnurl)
("gnutls" ,gnutls)
("libextractor" ,libextractor)
("libgcrypt" ,libgcrypt)
("libidn" ,libidn)
("libmicrohttpd" ,libmicrohttpd)
("libtool" ,libtool)
("libunistring" ,libunistring)
("openssl" ,openssl)
("opus" ,opus)
("pulseaudio", pulseaudio)
("sqlite" ,sqlite)
("zlib" ,zlib)))
(native-inputs
`(("pkg-config" ,pkg-config)
("python" ,python-2)))
(arguments
'(#:phases
;; swap check and install phases and set paths to installed binaries
(alist-cons-before
'check 'set-path-for-check
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(setenv "GNUNET_PREFIX" out)
(setenv "PATH" (string-append (getenv "PATH") ":" out "/bin"))))
(alist-cons-after
'install 'check
(assoc-ref %standard-phases 'check)
(alist-delete
'check
%standard-phases)))))
(synopsis "Anonymous peer-to-peer file-sharing framework")
(description
"GNUnet is a framework for secure, peer-to-peer networking. It works in a
decentralized manner and does not rely on any notion of trusted services. One
service implemented on it is censorship-resistant file-sharing. Communication
is encrypted and anonymity is provided by making messages originating from a
peer indistinguishable from those that the peer is routing.")
(license license:gpl3+)
(home-page "https://gnunet.org/")))

45
gnu/packages/gnupg.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -61,14 +62,14 @@ Daemon and possibly more in the future.")
(define-public libgcrypt
(package
(name "libgcrypt")
(version "1.6.0")
(version "1.6.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnupg/libgcrypt/libgcrypt-"
version ".tar.bz2"))
(sha256
(base32
"024plbybsmnxbp39hs92lp6dzvkz2cb70nv69qrwr55d02350bb6"))))
"0w10vhpj1r5nq7qm6jp21p1v1vhf37701cw8yilygzzqd7mfzhx1"))))
(build-system gnu-build-system)
(propagated-inputs
`(("libgpg-error" ,libgpg-error)))
@ -221,10 +222,12 @@ components), libgpg-error (centralized GnuPG error values), and libskba
(base32
"15h429h6pd67iiv580bjmwbkadpxsdppw0xrqpcm4dvm24jc271d"))))
(build-system gnu-build-system)
(propagated-inputs
;; Needs to be propagated because gpgme.h includes gpg-error.h.
`(("libgpg-error" ,libgpg-error)))
(inputs
`(("gnupg" ,gnupg)
("libassuan" ,libassuan)
("libgpg-error" ,libgpg-error)))
("libassuan" ,libassuan)))
(home-page "http://www.gnupg.org/related_software/gpgme/")
(synopsis "library providing simplified access to GnuPG functionality")
(description
@ -418,3 +421,37 @@ including tools for signing keys, keyring analysis, and party preparation.
"Pinentry provides a console and a GTK+ GUI that allows users to
enter a passphrase when `gpg' or `gpg2' is run and needs it.")
(license gpl2+)))
(define-public paperkey
(package
(name "paperkey")
(version "1.3")
(source (origin
(method url-fetch)
(uri (string-append "http://www.jabberwocky.com/"
"software/paperkey/paperkey-"
version ".tar.gz"))
(sha256
(base32
"1yybj8bj68v4lxwpn596b6ismh2fyixw5vlqqg26byrn4d9dfmsv"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(alist-replace
'check
(lambda* (#:key #:allow-other-keys #:rest args)
(let ((check (assoc-ref %standard-phases 'check)))
(substitute* '("checks/roundtrip.sh"
"checks/roundtrip-raw.sh")
(("/bin/echo") "echo"))
(apply check args)))
%standard-phases)))
(home-page "http://www.jabberwocky.com/software/paperkey/")
(synopsis "Backup OpenPGP keys to paper")
(description
"Paperkey extracts the secret bytes from an OpenPGP (GnuPG, PGP, etc) key
for printing with paper and ink, which have amazingly long retention
qualities. To reconstruct a secret key, you re-enter those
bytes (whether by hand, OCR, QR code, or the like) and paperkey can use
them to transform your existing public key into a secret key.")
(license gpl2+)))

14
gnu/packages/gnutls.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -29,7 +30,8 @@
#:use-module (gnu packages perl)
#:use-module (gnu packages which)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages pkg-config))
#:use-module (gnu packages pkg-config)
#:use-module (srfi srfi-1))
(define-public libtasn1
(package
@ -61,17 +63,19 @@ specifications.")
(define-public gnutls
(package
(name "gnutls")
(version "3.2.4")
(version "3.2.11")
(source (origin
(method url-fetch)
(uri
;; Note: Releases are no longer on ftp.gnu.org since the
;; schism (after version 3.1.5).
(string-append "mirror://gnupg/gnutls/v3.2/gnutls-"
version ".tar.xz"))
(string-append "mirror://gnupg/gnutls/v"
(string-join (take (string-split version #\.) 2)
".")
"/gnutls-" version ".tar.xz"))
(sha256
(base32
"0zvhzy87v9dfxfvmg1pl951kw55rp647cqdza8942fxq7spp158i"))))
"1hgk3k8f6wqijca3bsjbfn8pzyfva509y4j2vaxhm4ynfa5cai5q"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))

7
gnu/packages/gstreamer.scm
View File

@ -43,6 +43,10 @@
(base32
"0c0irk85jd2cihm5pmf4zxhlpg08qpxjcqv1l9qn2n3h2gsaj2lf"))))
(build-system gnu-build-system)
(arguments
;; XXX: Temporarily disable tests to work around 'gst/gstbus' test
;; failure: <https://bugzilla.gnome.org/show_bug.cgi?id=724073>.
'(#:tests? #f))
(inputs `(("glib" ,glib)))
(native-inputs
`(("bison" ,bison)
@ -51,8 +55,7 @@
("pkg-config" ,pkg-config)
("python-wrapper" ,python-wrapper)))
(home-page "http://gstreamer.freedesktop.org/")
(synopsis
"Multimedia library")
(synopsis "Multimedia library")
(description
"GStreamer is a library for constructing graphs of media-handling
components. The applications it supports range from simple Ogg/Vorbis

19
gnu/packages/gtk.scm
View File

@ -590,3 +590,22 @@ are easily extensible via inheritance. You can create user interfaces either
in code or with the Glade User Interface designer, using libglademm. There's
extensive documentation, including API reference and a tutorial.")
(license license:lgpl2.1+)))
(define-public gtkmm-2
(package (inherit gtkmm)
(version "2.24.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/gtkmm/"
(string-take version 4) "/gtkmm-"
version ".tar.xz"))
(sha256
(base32
"0gcm91sc1a05c56kzh74l370ggj0zz8nmmjvjaaxgmhdq8lpl369"))))
(propagated-inputs
`(("pangomm" ,pangomm)
("cairomm" ,cairomm)
("atkmm" ,atkmm)
("gtk+" ,gtk+-2)
("glibmm" ,glibmm)))))

6
gnu/packages/guile-wm.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -73,14 +73,14 @@ dependencies.")
(define-public guile-wm
(package
(name "guile-wm")
(version "0.2")
(version "1.0")
(source (origin
(method url-fetch)
(uri (string-append "http://www.markwitmer.com/dist/guile-wm-"
version ".tar.gz"))
(sha256
(base32
"0vv6avpkl6lgrhy2a16z470fqjhvzi4r93qwl87xw9v5dvldf08p"))))
"1l9qcz236jxvryndimjy62cf8zxf8i3f8vg3zpqqjhw15j9mdk3r"))))
(build-system gnu-build-system)
(arguments '(;; The '.scm' files go to $(datadir), so set that to the
;; standard value.

50
gnu/packages/gxmessage.scm Normal file
View File

@ -0,0 +1,50 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages gxmessage)
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages gtk)
#:use-module (gnu packages))
(define-public gxmessage
(package
(name "gxmessage")
(version "2.20.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/gxmessage/gxmessage-"
version ".tar.gz"))
(sha256
(base32 "1nq8r321x3rzcdkjlvj61i9x7smslnis7b05b39xqcjc9xyg4hv0"))))
(build-system gnu-build-system)
(inputs
`(("gtk+" ,gtk+-2)))
(native-inputs
`(("intltool" ,intltool)
("pkg-config" ,pkg-config)))
(home-page "http://www.gnu.org/software/gxmessage/")
(synopsis "Open popup message window with buttons for return")
(description "GNU gxmessage is a program that pops up dialog windows, which display
a message to the user and waits for their action. The program then exits
with an exit code corresponding to the response.")
(license gpl3+)))

88
gnu/packages/hurd.scm Normal file
View File

@ -0,0 +1,88 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages hurd)
#:use-module (guix licenses)
#:use-module (guix download)
#:use-module (guix packages)
#:use-module (guix build-system gnu)
#:use-module (gnu packages flex)
#:use-module (gnu packages bison))
(define-public gnumach-headers
(package
(name "gnumach-headers")
(version "1.4")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/gnumach/gnumach-"
version ".tar.gz"))
(sha256
(base32
"0r371wsm7imx356p0xsls5hifb1gf9y90rm1phr0qkahbmfk9hlv"))))
(build-system gnu-build-system)
(arguments
`(#:phases (alist-replace
'install
(lambda _
(zero?
(system* "make" "install-data")))
(alist-delete
'build
%standard-phases))
;; GNU Mach supports only IA32 currently, so cheat so that we can at
;; least install its headers.
#:configure-flags '("--build=i686-pc-gnu")
#:tests? #f))
(home-page "https://www.gnu.org/software/hurd/microkernel/mach/gnumach.html")
(synopsis "GNU Mach kernel headers")
(description
"Headers of the GNU Mach kernel.")
(license gpl2+)))
(define-public mig
(package
(name "mig")
(version "1.4")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/mig/mig-"
version ".tar.gz"))
(sha256
(base32
"1jgzggnbp22sa8z5dilm43zy12vlf1pjxfb3kh13xrfhcay0l97b"))))
(build-system gnu-build-system)
(inputs `(("gnumach-headers" ,gnumach-headers)))
(native-inputs
`(("flex" ,flex)
("bison" ,bison)))
(arguments `(#:tests? #f))
(home-page "http://www.gnu.org/software/hurd/microkernel/mach/mig/gnu_mig.html")
(synopsis "Mach 3.0 interface generator for the Hurd")
(description
"GNU MIG is the GNU distribution of the Mach 3.0 interface generator
MIG, as maintained by the GNU Hurd developers for the GNU project.
You need this tool to compile the GNU Mach and GNU Hurd distributions,
and to compile the GNU C library for the Hurd. Also,you will need it
for other software in the GNU system that uses Mach-based inter-process
communication.")
(license gpl2+)))

6
gnu/packages/icu4c.scm
View File

@ -28,7 +28,7 @@
(define-public icu4c
(package
(name "icu4c")
(version "50.1.1")
(version "52.1")
(source (origin
(method url-fetch)
(uri (string-append "http://download.icu-project.org/files/icu4c/"
@ -37,7 +37,7 @@
(string-map (lambda (x) (if (char=? x #\.) #\_ x)) version)
"-src.tgz"))
(sha256 (base32
"13yz0kk6zsgj94idnlr3vbg8iph5z4ly4b4xrd5wfja7q3ijdx56"))))
"14l0kl17nirc34frcybzg0snknaks23abhdxkmsqg3k9sil5wk9g"))))
(build-system gnu-build-system)
(inputs
`(("patchelf" ,patchelf)
@ -61,7 +61,7 @@
(lambda* (#:key #:allow-other-keys #:rest args)
(let ((configure (assoc-ref %standard-phases 'configure)))
;; patch out two occurrences of /bin/sh from configure script
;; that might have disappeared in a release later than 50.1.1
;; that might have disappeared in a release later than 52.1
(substitute* "configure"
(("`/bin/sh")
(string-append "`" (which "bash"))))

4
gnu/packages/imagemagick.scm
View File

@ -37,14 +37,14 @@
(define-public imagemagick
(package
(name "imagemagick")
(version "6.8.7-9")
(version "6.8.8-4")
(source (origin
(method url-fetch)
(uri (string-append "mirror://imagemagick/ImageMagick-"
version ".tar.xz"))
(sha256
(base32
"0625hqddc93qjd5923yivy74jyagk3n2bi2kjgykn86g7kxh7fcd"))))
"0bfxhfymkdbvardlr0nbjfmv53m47lcl9kkycipk4hxawfs927jr"))))
(build-system gnu-build-system)
(arguments
`(#:phases (alist-cons-before

79
gnu/packages/inkscape.scm Normal file
View File

@ -0,0 +1,79 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages inkscape)
#:use-module ((guix licenses)
#:renamer (symbol-prefix-proc 'license:))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages aspell)
#:use-module (gnu packages bdw-gc)
#:use-module (gnu packages boost)
#:use-module (gnu packages glib)
#:use-module (gnu packages gtk)
#:use-module (gnu packages maths)
#:use-module (gnu packages perl)
#:use-module (gnu packages pdf)
#:use-module (gnu packages popt)
#:use-module (gnu packages python)
#:use-module (gnu packages xml)
#:use-module (gnu packages ghostscript)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages libpng)
#:use-module (gnu packages pkg-config))
(define-public inkscape
(package
(name "inkscape")
(version "0.48.4")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/inkscape/inkscape-"
version ".tar.gz"))
(sha256
(base32
"0nhxsgrgsx6zrgpkd1akxjvmdqjp8ccnsvlwxh62l0brg84fw6bf"))
(patches (list (search-patch "inkscape-stray-comma.patch")))))
(build-system gnu-build-system)
(inputs
`(("aspell" ,aspell)
("gtkmm" ,gtkmm-2)
("gtk" ,gtk+-2)
("gsl" ,gsl)
("poppler" ,poppler)
("libpng" ,libpng)
("libxml2" ,libxml2)
("libxslt" ,libxslt)
("libgc" ,libgc)
("freetype" ,freetype)
("popt" ,popt)
("python" ,python-2)
("lcms" ,lcms)
("boost" ,boost)))
(native-inputs
`(("intltool" ,intltool)
("perl" ,perl)
("pkg-config" ,pkg-config)))
(home-page "http://inkscape.org/")
(synopsis "Vector graphics editor")
(description "Inkscape is a vector graphics editor. What sets Inkscape
apart is its use of Scalable Vector Graphics (SVG), an XML-based W3C standard,
as the native format.")
(license license:gpl2+)))

83
gnu/packages/libwebsockets.scm Normal file
View File

@ -0,0 +1,83 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages libwebsockets)
#:use-module (guix packages)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module ((guix licenses)
#:select (lgpl2.1))
#:use-module (gnu packages autotools)
#:use-module ((gnu packages compression) #:select (zlib))
#:use-module (gnu packages perl)
#:use-module (gnu packages openssl))
(define-public libwebsockets
(package
(name "libwebsockets")
(version "1.2")
(source (origin
;; The project does not publish tarballs, so we have to take
;; things from Git.
(method git-fetch)
(uri (git-reference
(url "git://git.libwebsockets.org/libwebsockets")
(commit (string-append "v" version
"-chrome26-firefox18"))))
(sha256
(base32
"1293hbz8qj4p27m1qjf8dn97r10xjyiwdpq491m87zi025s558cl"))
(file-name (string-append name "-" version))))
;; The package has both CMake and GNU build systems, but the latter is
;; apparently better supported (CMake-generated makefiles lack an
;; 'install' target, for instance.)
(build-system gnu-build-system)
(arguments
'(#:phases (alist-replace
'unpack
;; FIXME: Remove this when gnu-build-system handles that
;; case correctly.
(lambda* (#:key source #:allow-other-keys)
(mkdir "source")
(chdir "source")
(copy-recursively source ".")
#t)
(alist-cons-before
'configure 'bootstrap
(lambda _
(chmod "libwebsockets-api-doc.html" #o666)
(zero? (system* "./autogen.sh")))
%standard-phases))))
(native-inputs `(("autoconf" ,autoconf)
("automake" ,automake)
("libtool" ,libtool "bin")
("perl" ,perl))) ; to build the HTML doc
(inputs `(("zlib" ,zlib)
("openssl" ,openssl)))
(synopsis "WebSockets library written in C")
(description
"libwebsockets is a library that allows C programs to establish client
and server WebSockets connections---a protocol layered above HTTP that allows
for efficient socket-like bidirectional reliable communication channels.")
(home-page "http://libwebsockets.org/")
;; This is LGPLv2.1-only with extra exceptions specified in 'LICENSE'.
(license lgpl2.1)))

4
gnu/packages/lightning.scm
View File

@ -25,14 +25,14 @@
(define-public lightning
(package
(name "lightning")
(version "2.0.2")
(version "2.0.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/lightning/lightning-"
version ".tar.gz"))
(sha256
(base32
"100ya7dx12403gimif7p2q7ahd8vxqrxpxqzqr1zqci825nb0b43"))))
"1mbbqia7ypvyrl15b15h0wxqbr153j7vlapjsv57lid88rr7c7ia"))))
(build-system gnu-build-system)
(synopsis "Library for generating assembly code at runtime")
(description

403
gnu/packages/linux-initrd.scm
View File

@ -1,403 +0,0 @@
;;; 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 (gnu packages linux-initrd)
#:use-module (guix utils)
#:use-module (guix licenses)
#:use-module (guix build-system)
#:use-module ((guix derivations)
#:select (imported-modules compiled-modules %guile-for-build))
#:use-module (gnu packages)
#:use-module (gnu packages cpio)
#:use-module (gnu packages compression)
#:use-module (gnu packages linux)
#:use-module (gnu packages guile)
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system trivial))
;;; Commentary:
;;;
;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in
;;; particular initrd's that run Guile.
;;;
;;; Code:
(define-syntax-rule (raw-build-system (store system name inputs) body ...)
"Lift BODY to a package build system."
;; TODO: Generalize.
(build-system
(name "raw")
(description "Raw build system")
(build (lambda* (store name source inputs #:key system #:allow-other-keys)
(parameterize ((%guile-for-build (package-derivation store
guile-2.0)))
body ...)))))
(define (module-package modules)
"Return a package that contains all of MODULES, a list of Guile module
names."
(package
(name "guile-modules")
(version "0")
(source #f)
(build-system (raw-build-system (store system name inputs)
(imported-modules store modules
#:name name
#:system system)))
(synopsis "Set of Guile modules")
(description synopsis)
(license gpl3+)
(home-page "http://www.gnu.org/software/guix/")))
(define (compiled-module-package modules)
"Return a package that contains the .go files corresponding to MODULES, a
list of Guile module names."
(package
(name "guile-compiled-modules")
(version "0")
(source #f)
(build-system (raw-build-system (store system name inputs)
(compiled-modules store modules
#:name name
#:system system)))
(synopsis "Set of compiled Guile modules")
(description synopsis)
(license gpl3+)
(home-page "http://www.gnu.org/software/guix/")))
(define* (expression->initrd exp
#:key
(guile %guile-static-stripped)
(cpio cpio)
(gzip gzip)
(name "guile-initrd")
(system (%current-system))
(modules '())
(linux #f)
(linux-modules '()))
"Return a package that contains a Linux initrd (a gzipped cpio archive)
containing GUILE and that evaluates EXP upon booting. LINUX-MODULES is a list
of `.ko' file names to be copied from LINUX into the initrd. MODULES is a
list of Guile module names to be embedded in the initrd."
;; General Linux overview in `Documentation/early-userspace/README' and
;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
(define builder
`(begin
(use-modules (guix build utils)
(ice-9 pretty-print)
(ice-9 popen)
(ice-9 match)
(ice-9 ftw)
(srfi srfi-26)
(system base compile)
(rnrs bytevectors)
((system foreign) #:select (sizeof)))
(let ((guile (assoc-ref %build-inputs "guile"))
(cpio (string-append (assoc-ref %build-inputs "cpio")
"/bin/cpio"))
(gzip (string-append (assoc-ref %build-inputs "gzip")
"/bin/gzip"))
(modules (assoc-ref %build-inputs "modules"))
(gos (assoc-ref %build-inputs "modules/compiled"))
(scm-dir (string-append "share/guile/" (effective-version)))
(go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a"
(effective-version)
(if (eq? (native-endianness) (endianness little))
"LE"
"BE")
(sizeof '*)
(effective-version)))
(out (assoc-ref %outputs "out")))
(mkdir out)
(mkdir "contents")
(with-directory-excursion "contents"
(copy-recursively guile ".")
(call-with-output-file "init"
(lambda (p)
(format p "#!/bin/guile -ds~%!#~%" guile)
(pretty-print ',exp p)))
(chmod "init" #o555)
(chmod "bin/guile" #o555)
;; Copy Guile modules.
(chmod scm-dir #o777)
(copy-recursively modules scm-dir
#:follow-symlinks? #t)
(copy-recursively gos (string-append "lib/guile/"
(effective-version) "/ccache")
#:follow-symlinks? #t)
;; Compile `init'.
(mkdir-p go-dir)
(set! %load-path (cons modules %load-path))
(set! %load-compiled-path (cons gos %load-compiled-path))
(compile-file "init"
#:opts %auto-compilation-options
#:output-file (string-append go-dir "/init.go"))
;; Copy Linux modules.
(let* ((linux (assoc-ref %build-inputs "linux"))
(module-dir (and linux
(string-append linux "/lib/modules"))))
(mkdir "modules")
,@(map (lambda (module)
`(match (find-files module-dir ,module)
((file)
(format #t "copying '~a'...~%" file)
(copy-file file (string-append "modules/"
,module)))
(()
(error "module not found" ,module module-dir))
((_ ...)
(error "several modules by that name"
,module module-dir))))
linux-modules))
;; Reset the timestamps of all the files that will make it in the
;; initrd.
(for-each (cut utime <> 0 0 0 0)
(find-files "." ".*"))
(system* cpio "--version")
(let ((pipe (open-pipe* OPEN_WRITE cpio "-o"
"-O" (string-append out "/initrd")
"-H" "newc" "--null")))
(define print0
(let ((len (string-length "./")))
(lambda (file)
(format pipe "~a\0" (string-drop file len)))))
;; Note: as per `ramfs-rootfs-initramfs.txt', always add
;; directory entries before the files that are inside of it: "The
;; Linux kernel cpio extractor won't create files in a directory
;; that doesn't exist, so the directory entries must go before
;; the files that go in those directories."
(file-system-fold (const #t)
(lambda (file stat result) ; leaf
(print0 file))
(lambda (dir stat result) ; down
(unless (string=? dir ".")
(print0 dir)))
(const #f) ; up
(const #f) ; skip
(const #f)
#f
".")
(and (zero? (close-pipe pipe))
(with-directory-excursion out
(and (zero? (system* gzip "--best" "initrd"))
(rename-file "initrd.gz" "initrd")))))))))
(package
(name name)
(version "0")
(source #f)
(build-system trivial-build-system)
(arguments `(#:modules ((guix build utils))
#:builder ,builder))
(inputs `(("guile" ,guile)
("cpio" ,cpio)
("gzip" ,gzip)
("modules" ,(module-package modules))
("modules/compiled" ,(compiled-module-package modules))
,@(if linux
`(("linux" ,linux))
'())))
(synopsis "An initial RAM disk (initrd) for the Linux kernel")
(description
"An initial RAM disk (initrd), really a gzipped cpio archive, for use by
the Linux kernel.")
(license gpl3+)
(home-page "http://www.gnu.org/software/guix/")))
(define-public qemu-initrd
(expression->initrd
'(begin
(use-modules (srfi srfi-1)
(srfi srfi-26)
(ice-9 match)
((system base compile) #:select (compile-file))
(guix build utils)
(guix build linux-initrd))
(display "Welcome, this is GNU's early boot Guile.\n")
(display "Use '--repl' for an initrd REPL.\n\n")
(mount-essential-file-systems)
(let* ((args (linux-command-line))
(option (lambda (opt)
(let ((opt (string-append opt "=")))
(and=> (find (cut string-prefix? opt <>)
args)
(lambda (arg)
(substring arg (+ 1 (string-index arg #\=))))))))
(to-load (option "--load"))
(root (option "--root")))
(when (member "--repl" args)
((@ (system repl repl) start-repl)))
(display "loading CIFS and companion modules...\n")
(for-each (compose load-linux-module*
(cut string-append "/modules/" <>))
(list "md4.ko" "ecb.ko" "cifs.ko"))
(unless (configure-qemu-networking)
(display "network interface is DOWN\n"))
;; Make /dev nodes.
(make-essential-device-nodes)
;; Prepare the real root file system under /root.
(unless (file-exists? "/root")
(mkdir "/root"))
(if root
(mount root "/root" "ext3")
(mount "none" "/root" "tmpfs"))
(mount-essential-file-systems #:root "/root")
(mkdir "/root/xchg")
(mkdir-p "/root/nix/store")
(unless (file-exists? "/root/dev")
(mkdir "/root/dev")
(make-essential-device-nodes #:root "/root"))
;; Mount the host's store and exchange directory.
(mount-qemu-smb-share "/store" "/root/nix/store")
(mount-qemu-smb-share "/xchg" "/root/xchg")
;; Copy the directories that contain .scm and .go files so that the
;; child process in the chroot can load modules (we would bind-mount
;; them but for some reason that fails with EINVAL -- XXX).
(mkdir "/root/share")
(mkdir "/root/lib")
(mount "none" "/root/share" "tmpfs")
(mount "none" "/root/lib" "tmpfs")
(copy-recursively "/share" "/root/share"
#:log (%make-void-port "w"))
(copy-recursively "/lib" "/root/lib"
#:log (%make-void-port "w"))
(if to-load
(begin
(format #t "loading boot file '~a'...\n" to-load)
(compile-file (string-append "/root/" to-load)
#:output-file "/root/loader.go"
#:opts %auto-compilation-options)
(match (primitive-fork)
(0
(chroot "/root")
(load-compiled "/loader.go")
;; TODO: Remove /lib, /share, and /loader.go.
)
(pid
(format #t "boot file loaded under PID ~a~%" pid)
(let ((status (waitpid pid)))
(reboot)))))
(begin
(display "no boot file passed via '--load'\n")
(display "entering a warm and cozy REPL\n")
((@ (system repl repl) start-repl))))))
#:name "qemu-initrd"
#:modules '((guix build utils)
(guix build linux-initrd))
#:linux linux-libre
#:linux-modules '("cifs.ko" "md4.ko" "ecb.ko")))
(define-public gnu-system-initrd
;; Initrd for the GNU system itself, with nothing QEMU-specific.
(expression->initrd
'(begin
(use-modules (srfi srfi-1)
(srfi srfi-26)
(ice-9 match)
(guix build utils)
(guix build linux-initrd))
(display "Welcome, this is GNU's early boot Guile.\n")
(display "Use '--repl' for an initrd REPL.\n\n")
(mount-essential-file-systems)
(let* ((args (linux-command-line))
(option (lambda (opt)
(let ((opt (string-append opt "=")))
(and=> (find (cut string-prefix? opt <>)
args)
(lambda (arg)
(substring arg (+ 1 (string-index arg #\=))))))))
(to-load (option "--load"))
(root (option "--root")))
(when (member "--repl" args)
((@ (system repl repl) start-repl)))
;; Make /dev nodes.
(make-essential-device-nodes)
;; Prepare the real root file system under /root.
(mkdir-p "/root")
(if root
;; Assume ROOT has a usable /dev tree.
(mount root "/root" "ext3")
(begin
(mount "none" "/root" "tmpfs")
(make-essential-device-nodes #:root "/root")))
(mount-essential-file-systems #:root "/root")
(mkdir-p "/root/tmp")
(mount "none" "/root/tmp" "tmpfs")
;; XXX: We don't copy our fellow Guile modules to /root (see
;; 'qemu-initrd'), so if TO-LOAD tries to load a module (which can
;; happen if it throws, to display the exception!), then we're
;; screwed. Hopefully TO-LOAD is a simple expression that just does
;; '(execlp ...)'.
(if to-load
(begin
(format #t "loading '~a'...\n" to-load)
(chroot "/root")
(primitive-load to-load)
(format (current-error-port)
"boot program '~a' terminated, rebooting~%"
to-load)
(sleep 2)
(reboot))
(begin
(display "no init file passed via '--exec'\n")
(display "entering a warm and cozy REPL\n")
((@ (system repl repl) start-repl))))))
#:name "qemu-system-initrd"
#:modules '((guix build linux-initrd)
(guix build utils))
#:linux linux-libre))
;;; linux-initrd.scm ends here

88
gnu/packages/linux.scm
View File

@ -30,6 +30,7 @@
#:use-module (gnu packages bdb)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages algebra)
#:use-module (gnu packages gettext)
#:use-module (gnu packages pulseaudio)
@ -38,7 +39,8 @@
#:use-module (gnu packages autotools)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
#:use-module (guix build-system gnu)
#:use-module (guix build-system python))
(define-public (system->linux-architecture arch)
"Return the Linux architecture name for ARCH, a Guix system name such as
@ -146,7 +148,7 @@
(license gpl2+)))
(define-public linux-libre
(let* ((version "3.12")
(let* ((version "3.13")
(build-phase
'(lambda* (#:key system #:allow-other-keys #:rest args)
(let ((arch (car (string-split system #\-))))
@ -161,7 +163,24 @@
(format #t "enabling additional modules...~%")
(substitute* ".config"
(("^# CONFIG_CIFS.*$")
"CONFIG_CIFS=m\n"))
"CONFIG_CIFS=m\n")
(("^# CONFIG_([[:graph:]]*)VIRTIO([[:graph:]]*) .*$"
_ before after)
(string-append "CONFIG_" before "VIRTIO"
after "=m\n")))
;; XXX: For some reason, some virtio modules need to be
;; explicitly added.
(let ((port (open-file ".config" "a")))
(display (string-append "CONFIG_NET_9P_VIRTIO=m\n"
"CONFIG_NET_9P=m\n"
"CONFIG_9P_FS=m\n"
"CONFIG_VIRTIO_NET=m\n"
"CONFIG_VIRTIO_BLK=m\n"
"CONFIG_VIRTIO_BALLOON=m\n")
port)
(close-port port))
(zero? (system* "make" "oldconfig")))
;; Call the default `build' phase so `-j' is correctly
@ -192,7 +211,7 @@
(uri (linux-libre-urls version))
(sha256
(base32
"0drjxm9h2k9bik2mhrqqqi6cm5rn2db647wf0zvb58xldj0zmhb6"))))
"15pdizzxnnvpxmdb1lbi01kpingmdvj17b01vzbyjymi4vwfws3f"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)
("bc" ,bc)
@ -840,3 +859,64 @@ settings.")
"Aumix adjusts an audio mixer from X, the console, a terminal,
the command line or a script.")
(license gpl2+)))
(define-public iotop
(package
(name "iotop")
(version "0.6")
(source
(origin
(method url-fetch)
(uri (string-append "http://guichaz.free.fr/iotop/files/iotop-"
version ".tar.gz"))
(sha256 (base32
"1kp8mqg2pbxq4xzpianypadfxcsyfgwcaqgqia6h9fsq6zyh4z0s"))))
(build-system python-build-system)
(arguments
;; The setup.py script expects python-2.
`(#:python ,python-2
;; There are currently no checks in the package.
#:tests? #f))
(native-inputs `(("python" ,python-2)))
(home-page "http://guichaz.free.fr/iotop/")
(synopsis
"Displays the IO activity of running processes")
(description
"Iotop is a Python program with a top like user interface to show the
processes currently causing I/O.")
(license gpl2+)))
(define-public fuse
(package
(name "fuse")
(version "2.9.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/fuse/fuse-"
version ".tar.gz"))
(sha256
(base32
"071r6xjgssy8vwdn6m28qq1bqxsd2bphcd2mzhq0grf5ybm87sqb"))))
(build-system gnu-build-system)
(native-inputs `(("util-linux" ,util-linux)))
(arguments
'(#:configure-flags (list (string-append "MOUNT_FUSE_PATH="
(assoc-ref %outputs "out")
"/sbin")
(string-append "INIT_D_PATH="
(assoc-ref %outputs "out")
"/etc/init.d")
(string-append "UDEV_RULES_PATH="
(assoc-ref %outputs "out")
"/etc/udev"))))
(home-page "http://fuse.sourceforge.net/")
(synopsis "Support file systems implemented in user space")
(description
"As a consequence of its monolithic design, file system code for Linux
normally goes into the kernel itself---which is not only a robustness issue,
but also an impediment to system extensibility. FUSE, for \"file systems in
user space\", is a kernel module and user-space library that tries to address
part of this problem by allowing users to run file system implementations as
user-space processes.")
(license (list lgpl2.1 ; library
gpl2+)))) ; command-line utilities

8
gnu/packages/lout.scm
View File

@ -37,14 +37,14 @@
(("^LOUTLIBDIR[[:blank:]]*=.*$")
(string-append "LOUTLIBDIR = " out "/lib/lout\n"))
(("^LOUTDOCDIR[[:blank:]]*=.*$")
(string-append "LOUTDOCDIR = " doc "/doc/lout\n"))
(string-append "LOUTDOCDIR = " doc "/share/doc/lout\n"))
(("^MANDIR[[:blank:]]*=.*$")
(string-append "MANDIR = " out "/man\n")))
(mkdir out)
(mkdir (string-append out "/bin"))
(mkdir (string-append out "/lib"))
(mkdir (string-append out "/man"))
(mkdir-p (string-append doc "/doc/lout")))))
(mkdir-p (string-append doc "/share/doc/lout")))))
(install-man-phase
'(lambda* (#:key outputs #:allow-other-keys)
(zero? (system* "make" "installman"))))
@ -60,7 +60,7 @@
(every (lambda (doc)
(format #t "doc: building `~a'...~%" doc)
(with-directory-excursion doc
(let ((file (string-append out "/doc/lout/"
(let ((file (string-append out "/share/doc/lout/"
doc ".ps")))
(and (or (file-exists? "outfile.ps")
(zero? (system* "lout" "-r4" "-o"
@ -72,7 +72,7 @@
"-dPDFSETTINGS=/prepress"
"-sPAPERSIZE=a4"
file
(string-append out "/doc/lout/"
(string-append out "/share/doc/lout/"
doc ".pdf")))))))
'("design" "expert" "slides" "user")))))
(package

25
gnu/packages/lua.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Raimon Grau <raimonster@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -61,3 +62,27 @@ runs by interpreting bytecode for a register-based virtual machine, and has
automatic memory management with incremental garbage collection, making it ideal
for configuration, scripting, and rapid prototyping.")
(license x11)))
(define-public luajit
(package
(name "luajit")
(version "2.0.2")
(source (origin
(method url-fetch)
(uri (string-append "http://luajit.org/download/LuaJIT-"
version ".tar.gz"))
(sha256
(base32 "0f3cykihfdn3gi6na9p0xjd4jnv26z18m441n5vyg42q9abh4ln0"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f ;luajit is distributed without tests
#:phases (alist-delete 'configure %standard-phases)
#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")))))
(home-page "http://www.luajit.org/")
(synopsis "Just in time compiler for Lua programming language version 5.1")
(description
"LuaJIT is a Just-In-Time Compiler (JIT) for the Lua
programming language. Lua is a powerful, dynamic and light-weight programming
language. It may be embedded or used as a general-purpose, stand-alone
language.")
(license x11)))

54
gnu/packages/mail.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -33,11 +34,15 @@
#:use-module (gnu packages perl)
#:use-module (gnu packages readline)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages compression)
#:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config)
#:use-module ((guix licenses)
#:select (gpl2+ gpl3+ lgpl3+))
#:select (gpl2+ gpl3+ lgpl2.1+ lgpl3+))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
#:use-module (guix build-system gnu)
#:use-module (srfi srfi-1))
(define-public mailutils
(package
@ -162,3 +167,48 @@ aliasing facilities to work just as they would on normal mail.")
"Mutt is a small but very powerful text-based mail client for Unix
operating systems.")
(license gpl2+)))
(define-public gmime
(package
(name "gmime")
(version "2.6.19")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/gmime/"
(string-join (take (string-split version #\.)
2)
".")
"/gmime-" version ".tar.xz"))
(sha256
(base32
"0jm1fgbjgh496rsc0il2y46qd4bqq2ln9168p4zzh68mk4ml1yxg"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
("gnupg" ,gnupg))) ; for tests only
(inputs `(("glib" ,glib)
("gpgme" ,gpgme)
("zlib" ,zlib)))
(arguments
`(#:phases
(alist-cons-after
'unpack 'patch-paths-in-tests
(lambda _
;; The test programs run several programs using 'system'
;; with hard-coded paths. Here we patch them all. We also
;; change "gpg" to "gpg2".
(substitute* (find-files "tests" "\\.c$")
(("(system *\\(\")(/[^ ]*)" all pre prog-path)
(let* ((base (basename prog-path))
(prog (which (if (string=? base "gpg") "gpg2" base))))
(string-append pre (or prog (error "not found: " base)))))))
%standard-phases)))
(home-page "http://spruce.sourceforge.net/gmime/")
(synopsis "MIME message parser and creator library")
(description
"GMime provides a core library and set of utilities which may be used for
the creation and parsing of messages using the Multipurpose Internet Mail
Extension (MIME).")
(license (list lgpl2.1+ gpl2+ gpl3+))))
;;; mail.scm ends here

141
gnu/packages/maths.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -26,15 +27,25 @@
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (gnu packages compression)
#:use-module (gnu packages curl)
#:use-module (gnu packages fltk)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages gettext)
#:use-module (gnu packages gcc)
#:use-module (gnu packages gd)
#:use-module (gnu packages ghostscript)
#:use-module (gnu packages gtk)
#:use-module (gnu packages less)
#:use-module (gnu packages xorg)
#:use-module (gnu packages gl)
#:use-module (gnu packages multiprecision)
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages readline)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages texlive)
#:use-module (gnu packages xml))
(define-public units
@ -163,7 +174,7 @@ output in text, PostScript, PDF or HTML.")
(define-public lapack
(package
(name "lapack")
(version "3.4.2")
(version "3.5.0")
(source
(origin
(method url-fetch)
@ -171,16 +182,7 @@ output in text, PostScript, PDF or HTML.")
version ".tgz"))
(sha256
(base32
"1w7sf8888m7fi2kyx1fzgbm22193l8c2d53m8q1ibhvfy6m5v9k0"))
(snippet
;; Remove non-free files.
;; See <http://icl.cs.utk.edu/lapack-forum/archives/lapack/msg01383.html>.
'(for-each (lambda (file)
(format #t "removing '~a'~%" file)
(delete-file file))
'("lapacke/example/example_DGESV_rowmajor.c"
"lapacke/example/example_ZGESV_rowmajor.c"
"DOCS/psfig.tex")))))
"0lk3f97i9imqascnlf6wr5mjpyxqcdj73pgj97dj2mgvyg9z1n4s"))))
(build-system cmake-build-system)
(home-page "http://www.netlib.org/lapack/")
(inputs `(("fortran" ,gfortran-4.8)
@ -202,3 +204,120 @@ output in text, PostScript, PDF or HTML.")
problems in numerical linear algebra.")
(license (license:bsd-style "file://LICENSE"
"See LICENSE in the distribution."))))
(define-public gnuplot
(package
(name "gnuplot")
(version "4.6.3")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/gnuplot/gnuplot/"
version "/gnuplot-" version ".tar.gz"))
(sha256
(base32
"1xd7gqdhlk7k1p9yyqf9vkk811nadc7m4si0q3nb6cpv4pxglpyz"))))
(build-system gnu-build-system)
(inputs `(("readline" ,readline)
("cairo" ,cairo)
("pango" ,pango)
("gd" ,gd)))
(native-inputs `(("texlive" ,texlive)
("pkg-config" ,pkg-config)))
(home-page "http://www.gnuplot.info")
(synopsis "Command-line driven graphing utility")
(description "Gnuplot is a portable command-line driven graphing
utility. It was originally created to allow scientists and students to
visualize mathematical functions and data interactively, but has grown to
support many non-interactive uses such as web scripting. It is also used as a
plotting engine by third-party applications like Octave.")
;; X11 Style with the additional restriction that derived works may only be
;; distributed as patches to the original.
(license (license:fsf-free
"http://gnuplot.cvs.sourceforge.net/gnuplot/gnuplot/Copyright"))))
(define-public hdf5
(package
(name "hdf5")
(version "1.8.12")
(source
(origin
(method url-fetch)
(uri (string-append "http://www.hdfgroup.org/ftp/HDF5/current/src/hdf5-"
version ".tar.bz2"))
(sha256
(base32 "0f9n0v3p3lwc7564791a39c6cn1d3dbrn7d1j3ikqsi27a8hy23d"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(alist-replace
'configure
(lambda* (#:key target system outputs #:allow-other-keys #:rest args)
(let ((configure (assoc-ref %standard-phases 'configure)))
(substitute* "configure"
(("/bin/mv") "mv"))
(apply configure args)))
%standard-phases)))
(outputs '("out" "bin" "lib" "include"))
(home-page "http://www.hdfgroup.org")
(synopsis "Management suite for extremely large and complex data")
(description "HDF5 is a suite that makes possible the management of
extremely large and complex data collections.")
(license (license:x11-style "http://www.hdfgroup.org/ftp/HDF5/current/src/unpacked/COPYING"))))
;; For a fully featured Octave, users are strongly recommended also to install
;; the following packages: texinfo, less, ghostscript, gnuplot.
(define-public octave
(package
(name "octave")
(version "3.8.0")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/octave/octave-"
version ".tar.gz"))
(sha256
(base32
"0ks9pr154syw0vb3jn6xsnrkkrbvf9y7i7gaxa28rz6ngxbxvq9l"))))
(build-system gnu-build-system)
(inputs
`(("lapack" ,lapack)
("readline" ,readline)
("glpk" ,glpk)
("curl" ,curl)
("pcre" ,pcre)
("fltk" ,fltk)
("fontconfig" ,fontconfig)
("freetype" ,freetype)
("hdf5-lib" ,hdf5 "lib")
("hdf5-include" ,hdf5 "include")
("libxft" ,libxft)
("mesa" ,mesa)
("zlib" ,zlib)))
(native-inputs
`(("gfortran" ,gfortran-4.8)
("pkg-config" ,pkg-config)
("perl" ,perl)
;; The following inputs are not actually used in the build process. However, the
;; ./configure gratuitously tests for their existence and assumes that programs not
;; present at build time are also not, and can never be, available at run time!
;; If these inputs are therefore not present, support for them will be built out.
;; However, Octave will still run without them, albeit without the features they
;; provide.
("less" ,less)
("texinfo" ,texinfo)
("ghostscript" ,ghostscript)
("gnuplot" ,gnuplot)))
(arguments
`(#:configure-flags (list (string-append "--with-shell="
(assoc-ref %build-inputs "bash")
"/bin/sh"))))
(home-page "http://www.gnu.org/software/octave/")
(synopsis "High-level language for numerical computation")
(description "GNU Octave is a high-level interpreted language that is specialized
for numerical computations. It can be used for both linear and non-linear
applications and it provides great support for visualizing results. Work may
be performed both at the interactive command-line as well as via script
files.")
(license license:gpl3+)))

52
gnu/packages/moe.scm Normal file
View File

@ -0,0 +1,52 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages moe)
#:use-module (guix licenses)
#:use-module (gnu packages ncurses)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
(define-public moe
(package
(name "moe")
(version "1.5")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/moe/moe-"
version ".tar.gz"))
(sha256
(base32
"0hqag8022x68jmii1v6n7jb4fhp9icjkapgcpd2j3p9nzc8xch7s"))))
(build-system gnu-build-system)
(inputs
`(("ncurses" ,ncurses)))
(home-page "https://www.gnu.org/software/moe/moe.html")
(synopsis "Modeless, multiple-buffer, user-friendly 8-bit text editor")
(description
"GNU Moe is a powerful-but-simple-to-use text editor. It works in a
modeless manner, and features an intuitive set of key-bindings that
assign a degree of severity to each key; for example, key
combinations with the Alt key are for harmless commands like cursor
movements while combinations with the Control key are for commands
that will modify the text. Moe features multiple windows, unlimited
undo/redo, unlimited line length, global search and replace, and
more.")
(license gpl3+)))

3
gnu/packages/mp3.scm
View File

@ -298,7 +298,8 @@ format.")
version "/mpc123-" version ".tar.gz"))
(sha256
(base32
"0sf4pns0245009z6mbxpx7kqy4kwl69bc95wz9v23wgappsvxgy1"))))
"0sf4pns0245009z6mbxpx7kqy4kwl69bc95wz9v23wgappsvxgy1"))
(patches (list (search-patch "mpc123-initialize-ao.patch")))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-replace

4
gnu/packages/openssl.scm
View File

@ -27,13 +27,13 @@
(define-public openssl
(package
(name "openssl")
(version "1.0.1c")
(version "1.0.1f")
(source (origin
(method url-fetch)
(uri (string-append "ftp://ftp.openssl.org/source/openssl-" version
".tar.gz"))
(sha256 (base32
"1gjy6a7d8nszi9wq8jdzx3cffn0nss23h3cw2ywlw4cb9v6v77ia"))))
"0nnbr70dg67raqsqvlypzxa1v5xsv9gp91f9pavyckfn2w5sihkc"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)))
(arguments

4
gnu/packages/parallel.scm
View File

@ -27,7 +27,7 @@
(define-public parallel
(package
(name "parallel")
(version "20131222")
(version "20140122")
(source
(origin
(method url-fetch)
@ -35,7 +35,7 @@
version ".tar.bz2"))
(sha256
(base32
"08ggxb4id263623mr14clafsdl1n1zhfx13z3mn6kqbd4d6vwwk7"))))
"17y72p7qwr7n0qy9nzxwhcn3q47829fd0d69gql2x6szlsxkk0xi"))))
(build-system gnu-build-system)
(inputs `(("perl" ,perl)))
(home-page "http://www.gnu.org/software/parallel/")

4
gnu/packages/patches/bigloo-gc-shebangs.patch
View File

@ -1,7 +1,7 @@
Patch shebangs in source that gets unpacked by `configure'.
--- bigloo4.0b/gc/install-gc-7.3alpha3-20130330 2013-08-19 10:45:20.000000000 +0200
+++ bigloo4.0b/gc/install-gc-7.3alpha3-20130330 2013-08-19 10:46:36.000000000 +0200
--- bigloo4.1a/gc/install-gc-7.4.0 2014-02-04 14:55:03.000000000 +0100
+++ bigloo4.1a/gc/install-gc-7.4.0 2014-02-04 14:55:36.000000000 +0100
@@ -29,10 +29,12 @@ fi
# untar the two versions of the GC

12
gnu/packages/patches/curl-fix-test172.patch Normal file
View File

@ -0,0 +1,12 @@
diff --git a/tests/data/test172 b/tests/data/test172
index b3efae9..3d53418 100644
--- a/tests/data/test172
+++ b/tests/data/test172
@@ -36,7 +36,7 @@ http://%HOSTIP:%HTTPPORT/we/want/172 -b log/jar172.txt -b "tool=curl; name=fool"
.%HOSTIP TRUE /silly/ FALSE 0 ismatch this
.%HOSTIP TRUE / FALSE 0 partmatch present
-%HOSTIP FALSE /we/want/ FALSE 1391252187 nodomain value
+%HOSTIP FALSE /we/want/ FALSE 2139150993 nodomain value
</file>
</client>

52
gnu/packages/patches/dmd-tests-longer-sleeps.patch Normal file
View File

@ -0,0 +1,52 @@
Increase sleep times in tests, for slower machines.
Patch by Mark H Weaver <mhw@netris.org>.
--- dmd/tests/basic.sh 2013-11-30 17:22:00.000000000 -0500
+++ dmd/tests/basic.sh 2014-02-16 02:18:34.036376953 -0500
@@ -46,7 +46,7 @@
dmd -I -s "$socket" -c "$conf" -l "$log" &
dmd_pid=$!
-sleep 1 # XXX: wait till it's up
+sleep 3 # XXX: wait till it's up
kill -0 $dmd_pid
test -S "$socket"
$deco status dmd | grep -E '(Start.*dmd|Stop.*test)'
--- dmd/tests/respawn.sh 2013-12-01 16:50:37.000000000 -0500
+++ dmd/tests/respawn.sh 2014-02-16 02:19:16.958251953 -0500
@@ -39,7 +39,7 @@
i=0
while ! test -f "$1" && test $i -lt 20
do
- sleep 0.3
+ sleep 1
i=`expr $i + 1`
done
test -f "$1"
@@ -65,14 +65,14 @@
#:provides '(test1)
#:start (make-forkexec-constructor
"$SHELL" "-c"
- "echo \$\$ > $service1_pid ; while true ; do sleep 1 ; done")
+ "echo \$\$ > $service1_pid ; while true ; do sleep 3 ; done")
#:stop (make-kill-destructor)
#:respawn? #t)
(make <service>
#:provides '(test2)
#:start (make-forkexec-constructor
"$SHELL" "-c"
- "echo \$\$ > $service2_pid ; while true ; do sleep 1 ; done")
+ "echo \$\$ > $service2_pid ; while true ; do sleep 3 ; done")
#:stop (make-kill-destructor)
#:respawn? #t))
(start 'test1)
@@ -82,7 +82,7 @@
dmd -I -s "$socket" -c "$conf" -l "$log" &
dmd_pid=$!
-sleep 1 # XXX: wait till it's up
+sleep 3 # XXX: wait till it's up
kill -0 $dmd_pid
test -S "$socket"
$deco status test1 | grep started

44
gnu/packages/patches/gdb-loongson-madd-fix.patch
View File

@ -1,44 +0,0 @@
Fix the Loongson 2F specific fused multiply-add instructions on paired singles to
use the encoding recognized by the processor, as opposed to the mistaken english
Loongson 2F documentation.
Patch by Mark H Weaver <mhw@netris.org>.
--- gdb/opcodes/mips-opc.c.orig 2013-02-09 05:24:18.000000000 -0500
+++ gdb/opcodes/mips-opc.c 2013-10-27 23:35:20.191997541 -0400
@@ -956,7 +956,7 @@
{"madd.s", "D,S,T", 0x4600001c, 0xffe0003f, RD_S|RD_T|WR_D|FP_S, 0, EE },
{"madd.ps", "D,R,S,T", 0x4c000026, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I5_33 },
{"madd.ps", "D,S,T", 0x45600018, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E },
-{"madd.ps", "D,S,T", 0x71600018, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
+{"madd.ps", "D,S,T", 0x72c00018, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
{"madd", "s,t", 0x0000001c, 0xfc00ffff, RD_s|RD_t|WR_HILO, 0, L1 },
{"madd", "s,t", 0x70000000, 0xfc00ffff, RD_s|RD_t|MOD_HILO, 0, I32|N55 },
{"madd", "s,t", 0x70000000, 0xfc00ffff, RD_s|RD_t|WR_HILO|IS_M, 0, G1 },
@@ -1084,7 +1084,7 @@
{"msub.s", "D,S,T", 0x4600001d, 0xffe0003f, RD_S|RD_T|WR_D|FP_S, 0, EE },
{"msub.ps", "D,R,S,T", 0x4c00002e, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I5_33 },
{"msub.ps", "D,S,T", 0x45600019, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E },
-{"msub.ps", "D,S,T", 0x71600019, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
+{"msub.ps", "D,S,T", 0x72c00019, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
{"msub", "s,t", 0x0000001e, 0xfc00ffff, RD_s|RD_t|WR_HILO, 0, L1 },
{"msub", "s,t", 0x70000004, 0xfc00ffff, RD_s|RD_t|MOD_HILO, 0, I32|N55 },
{"msub", "7,s,t", 0x70000004, 0xfc00e7ff, MOD_a|RD_s|RD_t, 0, D32 },
@@ -1218,7 +1218,7 @@
{"nmadd.s", "D,S,T", 0x7200001a, 0xffe0003f, RD_S|RD_T|WR_D|FP_S, 0, IL2F },
{"nmadd.ps","D,R,S,T", 0x4c000036, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I5_33 },
{"nmadd.ps", "D,S,T", 0x4560001a, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E },
-{"nmadd.ps", "D,S,T", 0x7160001a, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
+{"nmadd.ps", "D,S,T", 0x72c0001a, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
{"nmsub.d", "D,R,S,T", 0x4c000039, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I4_33 },
{"nmsub.d", "D,S,T", 0x4620001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E },
{"nmsub.d", "D,S,T", 0x7220001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
@@ -1227,7 +1227,7 @@
{"nmsub.s", "D,S,T", 0x7200001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_S, 0, IL2F },
{"nmsub.ps","D,R,S,T", 0x4c00003e, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I5_33 },
{"nmsub.ps", "D,S,T", 0x4560001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E },
-{"nmsub.ps", "D,S,T", 0x7160001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
+{"nmsub.ps", "D,S,T", 0x72c0001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F },
/* nop is at the start of the table. */
{"nor", "d,v,t", 0x00000027, 0xfc0007ff, WR_d|RD_s|RD_t, 0, I1 },
{"nor", "t,r,I", 0, (int) M_NOR_I, INSN_MACRO, 0, I1 },

13
gnu/packages/patches/gnunet-fix-scheduler.patch Normal file
View File

@ -0,0 +1,13 @@
Index: src/util/scheduler.c
===================================================================
--- src/util/scheduler.c (revision 31745)
+++ src/util/scheduler.c (working copy)
@@ -1599,7 +1599,7 @@
int real_fd;
GNUNET_DISK_internal_file_handle_ (fd, &real_fd, sizeof (int));
- GNUNET_assert (real_fd > 0);
+ GNUNET_assert (real_fd >= 0);
return add_without_sets (
delay, priority,
on_read ? real_fd : -1,

58
gnu/packages/patches/gnunet-fix-tests.patch Normal file
View File

@ -0,0 +1,58 @@
diff -ru a/src/peerinfo-tool/Makefile.in b/src/peerinfo-tool/Makefile.in
--- src/peerinfo-tool/Makefile.in 2013-12-24 13:55:04.000000000 +0100
+++ src/peerinfo-tool/Makefile.in 2014-01-30 13:07:52.275965484 +0100
@@ -335,9 +335,6 @@
$(top_builddir)/src/statistics/libgnunetstatistics.la \
$(top_builddir)/src/util/libgnunetutil.la
-@HAVE_PYTHON_TRUE@check_SCRIPTS = \
-@HAVE_PYTHON_TRUE@ test_gnunet_peerinfo.py
-
@ENABLE_TEST_RUN_TRUE@TESTS = $(check_SCRIPTS)
do_subst = $(SED) -e 's,[@]PYTHON[@],$(PYTHON),g'
EXTRA_DIST = \
diff -ru a/src/revocation/test_revocation.conf b/src/revocation/test_revocation.conf
--- src/revocation/test_revocation.conf 2013-12-21 18:57:06.000000000 +0100
+++ src/revocation/test_revocation.conf 2014-01-30 15:00:02.841340556 +0100
@@ -20,6 +20,9 @@
[transport-udp]
BROADCAST = NO
+[nat]
+RETURN_LOCAL_ADDRESSES = YES
+
[peerinfo]
USE_INCLUDED_HELLOS = NO
Index: src/gns/test_gns_cname_lookup.sh
===================================================================
--- src/gns/test_gns_cname_lookup.sh (revision 32117)
+++ src/gns/test_gns_cname_lookup.sh (revision 32118)
@@ -13,6 +13,15 @@
exit 77
fi
+# permissive DNS resolver we will use for the test
+DNS_RESOLVER="8.8.8.8"
+if ! nslookup gnunet.org $DNS_RESOLVER &> /dev/null
+then
+ echo "Cannot reach DNS, skipping test"
+ exit 77
+fi
+
+
rm -rf /tmp/test-gnunet-gns-peer-1/
TEST_DOMAIN_PLUS="www.gnu"
Index: src/integration-tests/confs/test_defaults.conf
===================================================================
--- src/integration-tests/confs/test_defaults.conf (revision 32320)
+++ src/integration-tests/confs/test_defaults.conf (working copy)
@@ -17,6 +17,7 @@
EXTERNAL_ADDRESS = 127.0.0.1
INTERNAL_ADDRESS = 127.0.0.1
BINDTO = 127.0.0.1
+RETURN_LOCAL_ADDRESSES = YES
[hostlist]
SERVERS =

13
gnu/packages/patches/inkscape-stray-comma.patch Normal file
View File

@ -0,0 +1,13 @@
This is verbatim from Upstream: http://bazaar.launchpad.net/~inkscape.dev/inkscape/RELEASE_0_48_BRANCH/diff/9943
--- a/src/widgets/desktop-widget.h 2011-06-06 06:43:00 +0000
+++ b/src/widgets/desktop-widget.h 2013-01-05 14:34:09 +0000
@@ -239,7 +239,7 @@
private:
GtkWidget *tool_toolbox;
GtkWidget *aux_toolbox;
- GtkWidget *commands_toolbox,;
+ GtkWidget *commands_toolbox;
GtkWidget *snap_toolbox;
static void init(SPDesktopWidget *widget);

19
gnu/packages/patches/mpc123-initialize-ao.patch Normal file
View File

@ -0,0 +1,19 @@
Description: Zero ao_sample_format structure to cope with libao 1.0.0
Author: Colin Watson <cjwatson@debian.org>
Bug-Debian: http://bugs.debian.org/591396
Bug-Ubuntu: https://bugs.launchpad.net/bugs/710268
Forwarded: no
Last-Update: 2013-05-07
Index: b/ao.c
===================================================================
--- a/ao.c
+++ b/ao.c
@@ -123,6 +123,7 @@
/* initialize ao_format struct */
/* XXX VERY WRONG */
+ memset(&ao_fmt, 0, sizeof(ao_fmt));
ao_fmt.bits=16; /*tmp_stream_info.average_bitrate;*/
ao_fmt.rate=streaminfo->sample_freq;
ao_fmt.channels=streaminfo->channels;

69
gnu/packages/patches/patchelf-page-size.patch Normal file
View File

@ -0,0 +1,69 @@
Improve the determination of pageSize in patchelf.cc.
Patch by Mark H Weaver <mhw@netris.org>.
--- patchelf/src/patchelf.cc.orig 1969-12-31 19:00:01.000000000 -0500
+++ patchelf/src/patchelf.cc 2014-02-16 20:15:06.283203125 -0500
@@ -21,11 +21,19 @@
using namespace std;
-#ifdef MIPSEL
-/* The lemote fuloong 2f kernel defconfig sets a page size of 16KB */
-const unsigned int pageSize = 4096*4;
-#else
+/* Note that some platforms support multiple page sizes. Therefore,
+ it is not enough to query the current page size. 'pageSize' must
+ be the maximum architectural page size for the platform, which is
+ typically defined in the corresponding ABI document.
+
+ XXX FIXME: This won't work when we're cross-compiling. */
+
+#if defined __MIPSEL__ || defined __MIPSEB__ || defined __aarch64__
+const unsigned int pageSize = 65536;
+#elif defined __x86_64__ || defined __i386__ || defined __arm__
const unsigned int pageSize = 4096;
+#else
+# error maximum architectural page size unknown for this platform
#endif
--- patchelf/tests/no-rpath.sh.orig 1969-12-31 19:00:01.000000000 -0500
+++ patchelf/tests/no-rpath.sh 2014-02-16 20:44:12.036376953 -0500
@@ -1,22 +1,22 @@
#! /bin/sh -e
-rm -rf scratch
-mkdir -p scratch
+if [ "$(uname -m)" = i686 -a "$(uname -s)" = Linux ]; then
+ rm -rf scratch
+ mkdir -p scratch
-cp no-rpath scratch/
+ cp no-rpath scratch/
-oldRPath=$(../src/patchelf --print-rpath scratch/no-rpath)
-if test -n "$oldRPath"; then exit 1; fi
-../src/patchelf \
- --set-interpreter "$(../src/patchelf --print-interpreter ../src/patchelf)" \
- --set-rpath /foo:/bar:/xxxxxxxxxxxxxxx scratch/no-rpath
+ oldRPath=$(../src/patchelf --print-rpath scratch/no-rpath)
+ if test -n "$oldRPath"; then exit 1; fi
+ ../src/patchelf \
+ --set-interpreter "$(../src/patchelf --print-interpreter ../src/patchelf)" \
+ --set-rpath /foo:/bar:/xxxxxxxxxxxxxxx scratch/no-rpath
-newRPath=$(../src/patchelf --print-rpath scratch/no-rpath)
-if ! echo "$newRPath" | grep -q '/foo:/bar'; then
- echo "incomplete RPATH"
- exit 1
-fi
+ newRPath=$(../src/patchelf --print-rpath scratch/no-rpath)
+ if ! echo "$newRPath" | grep -q '/foo:/bar'; then
+ echo "incomplete RPATH"
+ exit 1
+ fi
-if [ "$(uname -m)" = i686 -a "$(uname -s)" = Linux ]; then
cd scratch && ./no-rpath
fi

91
gnu/packages/patches/ratpoison-shell.patch Normal file
View File

@ -0,0 +1,91 @@
Use $SHELL instead of hardcoding /bin/sh in ratpoison.
Patch by Mark H Weaver <mhw@netris.org>.
--- ratpoison/src/actions.c.orig 2013-04-06 21:37:43.000000000 -0400
+++ ratpoison/src/actions.c 2014-02-13 00:34:10.992553710 -0500
@@ -19,6 +19,7 @@
*/
#include <unistd.h>
+#include <stdlib.h>
#include <ctype.h> /* for isspace */
#include <sys/wait.h>
#include <X11/keysym.h>
@@ -223,12 +223,12 @@
add_command ("escape", cmd_escape, 1, 1, 1,
"Key: ", arg_KEY);
add_command ("exec", cmd_exec, 1, 1, 1,
- "/bin/sh -c ", arg_SHELLCMD);
+ "$SHELL -c ", arg_SHELLCMD);
add_command ("execa", cmd_execa, 1, 1, 1,
- "/bin/sh -c ", arg_SHELLCMD);
+ "$SHELL -c ", arg_SHELLCMD);
add_command ("execf", cmd_execf, 2, 2, 2,
"frame to execute in:", arg_FRAME,
- "/bin/sh -c ", arg_SHELLCMD);
+ "$SHELL -c ", arg_SHELLCMD);
add_command ("fdump", cmd_fdump, 1, 0, 0,
"", arg_NUMBER);
add_command ("focus", cmd_next_frame, 0, 0, 0);
@@ -359,7 +359,7 @@
add_command ("unsetenv", cmd_unsetenv, 1, 1, 1,
"Variable: ", arg_STRING);
add_command ("verbexec", cmd_verbexec, 1, 1, 1,
- "/bin/sh -c ", arg_SHELLCMD);
+ "$SHELL -c ", arg_SHELLCMD);
add_command ("version", cmd_version, 0, 0, 0);
add_command ("vsplit", cmd_v_split, 1, 0, 0,
"Split: ", arg_STRING);
@@ -2627,6 +2627,9 @@
pid = fork();
if (pid == 0)
{
+ char *shell_path;
+ char *shell_name;
+
/* Some process setup to make sure the spawned process runs
in its own session. */
putenv(current_screen()->display_string);
@@ -2641,7 +2644,18 @@
/* raw means don't run it through sh. */
if (raw)
execl (cmd, cmd, NULL);
- execl("/bin/sh", "sh", "-c", cmd, NULL);
+
+ shell_path = getenv ("SHELL");
+ if (shell_path == NULL)
+ shell_path = "/bin/sh";
+
+ shell_name = strrchr (shell_path, '/');
+ if (shell_name == NULL)
+ shell_name = shell_path;
+ else
+ shell_name++;
+
+ execl(shell_path, shell_name, "-c", cmd, NULL);
_exit(EXIT_FAILURE);
}
--- ratpoison/src/events.c.orig 2013-04-06 20:05:48.000000000 -0400
+++ ratpoison/src/events.c 2014-02-13 00:34:39.327758789 -0500
@@ -920,7 +920,7 @@
{
/* Report any child that didn't return 0. */
if (cur->status != 0)
- marked_message_printf (0,0, "/bin/sh -c \"%s\" finished (%d)",
+ marked_message_printf (0,0, "$SHELL -c \"%s\" finished (%d)",
cur->cmd, cur->status);
list_del (&cur->node);
free (cur->cmd);
--- ratpoison/src/messages.h.orig 2012-07-20 20:25:33.000000000 -0400
+++ ratpoison/src/messages.h 2014-02-13 00:34:28.608398437 -0500
@@ -41,7 +41,7 @@
#define MESSAGE_PROMPT_SWITCH_TO_WINDOW "Switch to window: "
#define MESSAGE_PROMPT_NEW_WINDOW_NAME "Set window's title to: "
-#define MESSAGE_PROMPT_SHELL_COMMAND "/bin/sh -c "
+#define MESSAGE_PROMPT_SHELL_COMMAND "$SHELL -c "
#define MESSAGE_PROMPT_COMMAND ":"
#define MESSAGE_PROMPT_SWITCH_WM "Switch to wm: "
#define MESSAGE_PROMPT_XTERM_COMMAND MESSAGE_PROMPT_SHELL_COMMAND TERM_PROG " -e "

27
gnu/packages/patches/slim-config.patch Normal file
View File

@ -0,0 +1,27 @@
Allow the configuration file and theme directory to be specified at run time.
Patch by Eelco Dolstra, from Nixpkgs.
--- slim-1.3.6/app.cpp 2013-10-02 00:38:05.000000000 +0200
+++ slim-1.3.6/app.cpp 2013-10-15 11:02:55.629263422 +0200
@@ -200,7 +200,9 @@
/* Read configuration and theme */
cfg = new Cfg;
- cfg->readConf(CFGFILE);
+ char *cfgfile = getenv("SLIM_CFGFILE");
+ if (!cfgfile) cfgfile = CFGFILE;
+ cfg->readConf(cfgfile);
string themebase = "";
string themefile = "";
string themedir = "";
@@ -208,7 +210,9 @@
if (testing) {
themeName = testtheme;
} else {
- themebase = string(THEMESDIR) + "/";
+ char *themesdir = getenv("SLIM_THEMESDIR");
+ if (!themesdir) themesdir = THEMESDIR;
+ themebase = string(themesdir) + "/";
themeName = cfg->getOption("current_theme");
string::size_type pos;
if ((pos = themeName.find(",")) != string::npos) {

17
gnu/packages/patches/slim-session.patch Normal file
View File

@ -0,0 +1,17 @@
Exit after the user's session has finished. This works around slim's broken
PAM session handling (see
http://developer.berlios.de/bugs/?func=detailbug&bug_id=19102&group_id=2663).
Patch by Eelco Dolstra, from Nixpkgs.
--- slim-1.3.6/app.cpp 2013-10-15 11:02:55.629263422 +0200
+++ slim-1.3.6/app.cpp 2013-10-15 13:00:10.141210784 +0200
@@ -816,7 +822,7 @@
StopServer();
RemoveLock();
while (waitpid(-1, NULL, WNOHANG) > 0); /* Collects all dead childrens */
- Run();
+ exit(OK_EXIT);
}
void App::KillAllClients(Bool top) {

33
gnu/packages/patches/slim-sigusr1.patch Normal file
View File

@ -0,0 +1,33 @@
This patch fixes SLiM so it really waits for the X server to be ready
before attempting to connect to it. Indeed, the X server notices that
its parent process has a handler for SIGUSR1, and consequently sends it
SIGUSR1 when it's ready to accept connections.
The problem was that SLiM doesn't pay attention to SIGUSR1. So in practice,
if X starts slowly, then SLiM gets ECONNREFUSED a couple of time on
/tmp/.X11-unix/X0, then goes on trying to connect to localhost:6000,
where nobody answers; eventually, it times out and tries again on
/tmp/.X11-unix/X0, and finally it shows up on the screen.
Patch by L. Courtès.
--- slim-1.3.6/app.cpp 2014-02-05 15:27:20.000000000 +0100
+++ slim-1.3.6/app.cpp 2014-02-09 22:42:04.000000000 +0100
@@ -119,7 +119,9 @@ void CatchSignal(int sig) {
exit(ERR_EXIT);
}
+static volatile int got_sigusr1 = 0;
void User1Signal(int sig) {
+ got_sigusr1 = 1;
signal(sig, User1Signal);
}
@@ -884,6 +886,7 @@ int App::WaitForServer() {
int ncycles = 120;
int cycles;
+ while (!got_sigusr1);
for(cycles = 0; cycles < ncycles; cycles++) {
if((Dpy = XOpenDisplay(DisplayName))) {
XSetIOErrorHandler(xioerror);

20
gnu/packages/python.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
@ -323,24 +323,28 @@ datetime module, available in Python 2.3+.")
(define-public python2-pysqlite
(package
(name "python2-pysqlite")
(version "2.6.3")
(version "2.6.3a") ; see below
(source
(origin
(method url-fetch)
(uri (string-append "http://pysqlite.googlecode.com/files/pysqlite-"
version ".tar.gz"))
;; During the switch from code.google.com to pypi.python.org, the 2.6.3
;; tarball was modified, but the version number was kept:
;; <https://lists.gnu.org/archive/html/guix-devel/2014-02/msg00077.html>.
;; Here we want to refer to the pypi-hosted 2.6.3 tarball.
(uri (string-append
"https://pypi.python.org/packages/source/p/pysqlite/pysqlite-"
"2.6.3" ".tar.gz"))
(sha256
(base32
"0nsqqfp072rgqbls100rdvbzkjkin7li3kprhfxlfqvzf608hlqd"))))
"13djzgnbi71znjjyaw4nybg6smilgszcid646j5qav7mdchkb77y"))))
(build-system python-build-system)
(inputs
`(("sqlite" ,sqlite)))
(arguments
`(#:python ,python-2 ; incompatible with Python 3
#:tests? #f)) ; no test target
(home-page "http://labix.org/python-dateutil")
(synopsis
"SQLite bindings for Python.")
(home-page "https://pypi.python.org/pypi/pysqlite")
(synopsis "SQLite bindings for Python")
(description
"Pysqlite provides SQLite bindings for Python that comply to the
Database API 2.0T.")

6
gnu/packages/qemu.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -73,6 +73,7 @@
(zero?
(system* "./configure"
(string-append "--cc=" (which "gcc"))
"--disable-debug-info" ; save build space
(string-append "--prefix=" out)
(string-append "--smbd=" samba
"/sbin/smbd")))))
@ -132,6 +133,9 @@ server and embedded PowerPC, and S390 guests.")
(define-public qemu/smb-shares
;; A patched QEMU where `-net smb' yields two shares instead of one: one for
;; the store, and another one for exchanges with the host.
;; TODO: Use 9p/-virtfs instead of this SMB hack:
;; <http://wiki.qemu.org/Documentation/9psetup>.
(package (inherit qemu-headless)
(name "qemu-with-multiple-smb-shares")
(source (origin (inherit (package-source qemu-headless))

4
gnu/packages/ratpoison.scm
View File

@ -21,6 +21,7 @@
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module ((guix licenses) #:select (gpl2+))
#:use-module (gnu packages)
#:use-module (gnu packages xorg)
#:use-module (gnu packages perl)
#:use-module (gnu packages readline)
@ -37,7 +38,8 @@
version ".tar.xz"))
(sha256
(base32
"0v4mh8d3vsh5xbbycfdl3g8zfygi1rkslh1x7k5hi1d05bfq3cdr"))))
"0v4mh8d3vsh5xbbycfdl3g8zfygi1rkslh1x7k5hi1d05bfq3cdr"))
(patches (list (search-patch "ratpoison-shell.patch")))))
(build-system gnu-build-system)
(inputs
`(("libXi" ,libxi)

9
gnu/packages/scheme.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -116,14 +116,14 @@ features an integrated Emacs-like editor and a large runtime library.")
(define-public bigloo
(package
(name "bigloo")
(version "4.0b")
(version "4.1a")
(source (origin
(method url-fetch)
(uri (string-append "ftp://ftp-sop.inria.fr/indes/fp/Bigloo/bigloo"
version ".tar.gz"))
(sha256
(base32
"1fck2h48f0bvh8fl437cagmp0syfxy9lqacy1zwsis20fc76jvzi"))
"170q7nh08n4v20xl81fxb0xcdxphqqacfa643hsa8i2ar6pki04c"))
(patches (list (search-patch "bigloo-gc-shebangs.patch")))))
(build-system gnu-build-system)
(arguments
@ -163,6 +163,9 @@ features an integrated Emacs-like editor and a large runtime library.")
(zero?
(system* "./configure"
(string-append "--prefix=" out)
;; FIXME: Currently fails, see
;; <http://article.gmane.org/gmane.lisp.scheme.bigloo/6126>.
;; "--customgc=no" ; use our libgc
(string-append"--mv=" (which "mv"))
(string-append "--rm=" (which "rm"))))))
(alist-cons-after

11
gnu/packages/sdl.scm
View File

@ -55,14 +55,21 @@
(base32
"005d993xcac8236fpvd1iawkz4wqjybkpn8dbwaliqz5jfkidlyn"))))
(build-system gnu-build-system)
(arguments '(#:tests? #f)) ; no check target
(arguments
'(;; Explicitly link against Xext because SDL tries to dlopen it and
;; doesn't go very far otherwise (see
;; <https://lists.gnu.org/archive/html/guix-devel/2013-11/msg00088.html>
;; for details.)
#:configure-flags '("LDFLAGS=-lXext")
#:tests? #f)) ; no check target
(propagated-inputs
;; SDL headers include X11 headers.
`(("libx11" ,libx11)))
(native-inputs `(("pkg-config" ,pkg-config)))
(inputs `(("libxrandr" ,libxrandr)
("mesa" ,mesa)
("alsa-lib" ,alsa-lib)
("pkg-config" ,pkg-config)
("pulseaudio" ,pulseaudio)))
(synopsis "Cross platform game development library")
(description "Simple DirectMedia Layer is a cross-platform development

58
gnu/packages/search.scm Normal file
View File

@ -0,0 +1,58 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages search)
#:use-module ((guix licenses)
#:select (gpl2+ bsd-3 x11))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages compression)
#:use-module (gnu packages linux)
#:export (xapian))
(define-public xapian
(package
(name "xapian")
(version "1.2.17")
(source (origin
(method url-fetch)
(uri (string-append "http://oligarchy.co.uk/xapian/" version
"/xapian-core-" version ".tar.xz"))
(sha256
(base32 "1pn65h06c23imck2pb42zhrrngch3clk39wl2bjwyqhfyfq4b7g7"))))
(build-system gnu-build-system)
(inputs `(("zlib" ,zlib)
("util-linux" ,util-linux)))
(arguments
`(#:phases (alist-cons-after
'unpack 'patch-remotetcp-harness
(lambda _
(substitute* "tests/harness/backendmanager_remotetcp.cc"
(("/bin/sh") (which "bash"))))
%standard-phases)))
(synopsis "Search Engine Library")
(description
"Xapian is a highly adaptable toolkit which allows developers to easily
add advanced indexing and search facilities to their own applications. It
supports the Probabilistic Information Retrieval model and also supports a
rich set of boolean query operators.")
(home-page "http://xapian.org/")
(license (list gpl2+ bsd-3 x11))))
;;; search.scm ends here

7
gnu/packages/shishi.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,6 +23,9 @@
#:use-module (gnu packages)
#:use-module (gnu packages gnutls)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages libidn)
#:use-module (gnu packages linux)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages compression)
#:use-module (guix packages)
#:use-module (guix download)
@ -40,8 +44,11 @@
(base32
"032qf72cpjdfffq1yq54gz3ahgqf2ijca4vl31sfabmjzq9q370d"))))
(build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config)))
(inputs
`(("gnutls" ,gnutls)
("libidn" ,libidn)
("linux-pam" ,linux-pam)
("zlib" ,zlib)
;; libgcrypt 1.6 fails because of the following test:
;; #include <gcrypt.h>

32
gnu/packages/slim.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Guy Grant <gzg@riseup.net>
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -23,6 +24,7 @@
#:use-module (guix download)
#:use-module (guix build-system cmake)
#:use-module (guix packages)
#:use-module (gnu packages)
#:use-module (gnu packages gl)
#:use-module (gnu packages xorg)
#:use-module (gnu packages libpng)
@ -34,13 +36,18 @@
(define-public slim
(package
(name "slim")
(version "1.3.3")
(version "1.3.6")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/project/slim.berlios/slim-"
;; Used to be available from
;; mirror://sourceforge/project/slim.berlios/.
(uri (string-append "http://download.berlios.de/slim/slim-"
version ".tar.gz"))
(sha256
(base32 "1fdvipj3658s8dm78djmfr8xhg6l8rr7kc4qcb34bjrnkkclhln1"))))
(base32 "1pqhk22jb4aja4hkrm7rjgbgzjyh7i4zswdgf5nw862l2znzxpi1"))
(patches (map search-patch
(list "slim-config.patch" "slim-session.patch"
"slim-sigusr1.patch")))))
(build-system cmake-build-system)
(inputs `(("linux-pam" ,linux-pam)
("libpng" ,libpng)
@ -62,12 +69,23 @@
(lambda _
(substitute* "CMakeLists.txt"
(("/etc")
(string-append
(assoc-ref %outputs "out") "/etc"))))
(string-append (assoc-ref %outputs "out") "/etc"))
(("install.*systemd.*")
;; The build system's logic here is: if "Linux", then
;; "systemd". Strip that.
"")))
%standard-phases)
#:configure-flags '("-DUSE_PAM=yes" "-DUSE_CONSOLEKIT=no")
#:configure-flags '("-DUSE_PAM=yes" "-DUSE_CONSOLEKIT=no"
;; Don't build libslim.so, because then the build
;; system is unable to set the right RUNPATH on the
;; 'slim' binary.
"-DBUILD_SHARED_LIBS=OFF"
;; Leave a valid RUNPATH upon install.
"-DCMAKE_SKIP_BUILD_RPATH=ON")
#:tests? #f))
(home-page "http://www.slim.berlios.de/")
(home-page "http://slim.berlios.de/")
(synopsis "Desktop-independent graphcal login manager for X11")
(description
"SLiM is a Desktop-independent graphical login manager for X11, derived

6
gnu/packages/ssh.scm
View File

@ -120,14 +120,14 @@ a server that supports the SSH-2 protocol.")
(define-public openssh
(package
(name "openssh")
(version "6.1p1")
(version "6.5p1")
(source (origin
(method url-fetch)
(uri (string-append
"ftp://ftp.fr.openbsd.org/pub/OpenBSD/OpenSSH/portable/openssh-"
version ".tar.gz"))
(sha256 (base32
"04f4l4vx6f964v5qjm03nhyixdc3llc90z6cj70r0bl5q3v5ghfi"))))
"09wh7mi65aahyxd2xvq1makckhd5laid8c0pb8njaidrbpamw6d1"))))
(build-system gnu-build-system)
(inputs `(("groff" ,groff)
("openssl" ,openssl)
@ -150,7 +150,7 @@ a server that supports the SSH-2 protocol.")
(let ((check (assoc-ref %standard-phases 'check)))
;; remove tests that require the user sshd
(substitute* "regress/Makefile"
(("t9 t-exec") "t9"))
(("t10 t-exec") "t10"))
(apply check args)))
(alist-replace
'install

48
gnu/packages/stalonetray.scm Normal file
View File

@ -0,0 +1,48 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Raimon Grau <raimonster@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages stalonetray)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module ((guix licenses) #:select (gpl2+))
#:use-module (gnu packages xorg))
(define-public stalonetray
(package
(name "stalonetray")
(version "0.8.1")
(source
(origin
(method url-fetch)
(uri
(string-append "mirror://sourceforge/stalonetray/stalonetray-"
version "/stalonetray-" version ".tar.bz2"))
(sha256
(base32
"1wp8pnlv34w7xizj1vivnc3fkwqq4qgb9dbrsg15598iw85gi8ll"))))
(inputs `(("libx11" ,libx11)))
(build-system gnu-build-system)
(home-page "stalonetray")
(synopsis "Standalone freedesktop.org and KDE systray implementation")
(description
"Stalonetray is a stand-alone freedesktop.org and KDE system
tray (notification area) for X Window System/X11 (e.g. X.Org or XFree86). It
has full XEMBED support and minimal dependencies: an X11 lib only. Stalonetray
works with virtually any EWMH-compliant window manager.")
(license gpl2+)))

14
gnu/packages/texinfo.scm
View File

@ -50,3 +50,17 @@ package includes both the tools necessary to produce Info documents from
their source and the command-line Info reader. The emphasis of the language
is on expressing the content semantically, avoiding physical markup commands.")
(license gpl3+)))
(define-public texinfo-4
(package (inherit texinfo)
(version "4.13a")
(source (origin
(method url-fetch)
(uri (string-append
"mirror://gnu/texinfo/texinfo-"
version
".tar.lzma"))
(sha256
(base32
"1rf9ckpqwixj65bw469i634897xwlgkm5i9g2hv3avl6mv7b0a3d"))))
(inputs `(("ncurses" ,ncurses) ("xz" ,xz)))))

4
gnu/packages/tor.scm
View File

@ -31,14 +31,14 @@
(define-public tor
(package
(name "tor")
(version "0.2.4.19")
(version "0.2.4.20")
(source (origin
(method url-fetch)
(uri (string-append "https://www.torproject.org/dist/tor-"
version ".tar.gz"))
(sha256
(base32
"08g1g6wkvg1a5hpjbjzr31sabqp65h9hrkjar4lif5pmqdw898jk"))))
"17sd54pfz1w2x5bd0j83vac8d1lazy9wdm9liijqzyfbrd3igifc"))))
(build-system gnu-build-system)
(inputs
`(("zlib" ,zlib)

55
gnu/packages/xorg.scm
View File

@ -38,7 +38,8 @@
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages xml))
#:use-module (gnu packages xml)
#:use-module (gnu packages ncurses))
@ -4377,7 +4378,10 @@ tracking.")
; the compiled keyboard maps go?
(string-append "--with-xkb-bin-directory="
(assoc-ref %build-inputs "xkbcomp")
"/bin"))
"/bin")
;; For the log file, etc.
"--localstatedir=/var")
#:phases
(alist-replace
'configure
@ -4385,6 +4389,12 @@ tracking.")
(let ((configure (assoc-ref %standard-phases 'configure)))
(substitute* (find-files "." "\\.c$")
(("/bin/sh") (which "sh")))
;; Don't try to 'mkdir /var'.
(substitute* "hw/xfree86/Makefile.in"
(("mkdir(.*)logdir.*")
"true\n"))
(apply configure args)))
%standard-phases)))
(home-page "http://www.x.org/wiki/")
@ -4700,3 +4710,44 @@ icccm: Both client and window-manager helpers for ICCCM.")
(synopsis "xorg implementation of the X Window System")
(description "X.org provides an implementation of the X Window System")
(license license:x11)))
(define-public xterm
(package
(name "xterm")
(version "301")
(source (origin
(method url-fetch)
(uri ; XXX: constant URL!
"http://invisible-island.net/datafiles/release/xterm.tar.gz")
(sha256
(base32
"040rarvv18zg0lk7qy0m3n7gv10mh40jic708wvng01z4rlbpfhz"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--enable-wide-chars" "--enable-256-color"
"--enable-load-vt-fonts" "--enable-i18n"
"--enable-doublechars" "--enable-luit"
"--enable-mini-luit")
#:tests? #f))
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("luit" ,luit)
("libXft" ,libxft)
("fontconfig" ,fontconfig)
("freetype" ,freetype)
("ncurses" ,ncurses)
("libICE" ,libice)
("libSM" ,libsm)
("libX11" ,libx11)
("libXext" ,libxext)
("libXt" ,libxt)
("xproto" ,xproto)
("libXaw" ,libxaw)))
(home-page "http://invisible-island.net/xterm")
(synopsis "Terminal emulator for the X Window System")
(description
"The xterm program is a terminal emulator for the X Window System. It
provides DEC VT102/VT220 (VTxxx) and Tektronix 4014 compatible terminals for
programs that cannot use the window system directly.")
(license license:x11)))

62
gnu/services.scm Normal file
View File

@ -0,0 +1,62 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services)
#:use-module (guix records)
#:export (service?
service
service-documentation
service-provision
service-requirement
service-respawn?
service-start
service-stop
service-inputs
service-user-accounts
service-user-groups
service-pam-services))
;;; Commentary:
;;;
;;; System services as cajoled by dmd.
;;;
;;; Code:
(define-record-type* <service>
service make-service
service?
(documentation service-documentation ; string
(default "[No documentation.]"))
(provision service-provision) ; list of symbols
(requirement service-requirement ; list of symbols
(default '()))
(respawn? service-respawn? ; Boolean
(default #t))
(start service-start) ; expression
(stop service-stop ; expression
(default #f))
(inputs service-inputs ; list of inputs
(default '()))
(user-accounts service-user-accounts ; list of <user-account>
(default '()))
(user-groups service-user-groups ; list of <user-groups>
(default '()))
(pam-services service-pam-services ; list of <pam-service>
(default '())))
;;; services.scm ends here.

181
gnu/system/dmd.scm → gnu/services/base.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -16,75 +16,32 @@
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system dmd)
#:use-module (guix store)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix records)
(define-module (gnu services base)
#:use-module (gnu services)
#:use-module (gnu system shadow) ; 'user-account', etc.
#:use-module (gnu system linux) ; 'pam-service', etc.
#:use-module (gnu packages admin)
#:use-module ((gnu packages base)
#:select (glibc-final))
#:use-module ((gnu packages admin)
#:select (mingetty inetutils shadow))
#:use-module ((gnu packages package-management)
#:select (guix))
#:use-module ((gnu packages linux)
#:select (net-tools))
#:use-module (gnu system shadow) ; for user accounts/groups
#:use-module (gnu system linux) ; for PAM services
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (gnu packages package-management)
#:use-module (guix monads)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (guix monads)
#:export (service?
service
service-provision
service-requirement
service-respawn?
service-start
service-stop
service-inputs
service-user-accounts
service-user-groups
service-pam-services
host-name-service
syslog-service
#:use-module (ice-9 format)
#:export (host-name-service
mingetty-service
nscd-service
syslog-service
guix-service
static-networking-service
dmd-configuration-file))
%base-services))
;;; Commentary:
;;;
;;; System services as cajoled by dmd.
;;; Base system services---i.e., services that 99% of the users will want to
;;; use.
;;;
;;; Code:
(define-record-type* <service>
service make-service
service?
(documentation service-documentation ; string
(default "[No documentation.]"))
(provision service-provision) ; list of symbols
(requirement service-requirement ; list of symbols
(default '()))
(respawn? service-respawn? ; Boolean
(default #t))
(start service-start) ; expression
(stop service-stop ; expression
(default #f))
(inputs service-inputs ; list of inputs
(default '()))
(user-accounts service-user-accounts ; list of <user-account>
(default '()))
(user-groups service-user-groups ; list of <user-groups>
(default '()))
(pam-services service-pam-services ; list of <pam-service>
(default '())))
(define (host-name-service name)
"Return a service that sets the host name to NAME."
(with-monad %store-monad
@ -217,100 +174,18 @@ BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
(members (map user-account-name
user-accounts)))))))))
(define* (static-networking-service interface ip
#:key
gateway
(name-servers '())
(inetutils inetutils)
(net-tools net-tools))
"Return a service that starts INTERFACE with address IP. If GATEWAY is
true, it must be a string specifying the default network gateway."
(define %base-services
;; Convenience variable holding the basic services.
(let ((motd (text-file "motd" "
This is the GNU operating system, welcome!\n\n")))
(list (mingetty-service "tty1" #:motd motd)
(mingetty-service "tty2" #:motd motd)
(mingetty-service "tty3" #:motd motd)
(mingetty-service "tty4" #:motd motd)
(mingetty-service "tty5" #:motd motd)
(mingetty-service "tty6" #:motd motd)
(syslog-service)
(guix-service)
(nscd-service))))
;; TODO: Eventually we should do this using Guile's networking procedures,
;; like 'configure-qemu-networking' does, but the patch that does this is
;; not yet in stock Guile.
(mlet %store-monad ((ifconfig (package-file inetutils "bin/ifconfig"))
(route (package-file net-tools "sbin/route")))
(return
(service
(documentation
(string-append "Set up networking on the '" interface
"' interface using a static IP address."))
(provision '(networking))
(start `(lambda _
;; Return #t if successfully started.
(and (zero? (system* ,ifconfig ,interface ,ip "up"))
,(if gateway
`(zero? (system* ,route "add" "-net" "default"
"gw" ,gateway))
#t)
,(if (pair? name-servers)
`(call-with-output-file "/etc/resolv.conf"
(lambda (port)
(display
"# Generated by 'static-networking-service'.\n"
port)
(for-each (lambda (server)
(format port "nameserver ~a~%"
server))
',name-servers)))
#t))))
(stop `(lambda _
;; Return #f is successfully stopped.
(not (and (system* ,ifconfig ,interface "down")
(system* ,route "del" "-net" "default")))))
(respawn? #f)
(inputs `(("inetutils" ,inetutils)
,@(if gateway
`(("net-tools" ,net-tools))
'())))))))
(define (dmd-configuration-file services etc)
"Return the dmd configuration file for SERVICES, that initializes /etc from
ETC on startup."
(define config
`(begin
(use-modules (ice-9 ftw))
(register-services
,@(map (match-lambda
(($ <service> documentation provision requirement
respawn? start stop)
`(make <service>
#:docstring ,documentation
#:provides ',provision
#:requires ',requirement
#:respawn? ,respawn?
#:start ,start
#:stop ,stop)))
services))
;; /etc is a mixture of static and dynamic settings. Here is where we
;; initialize it from the static part.
(format #t "populating /etc from ~a...~%" ,etc)
(let ((rm-f (lambda (f)
(false-if-exception (delete-file f)))))
(rm-f "/etc/static")
(symlink ,etc "/etc/static")
(for-each (lambda (file)
;; TODO: Handle 'shadow' specially so that changed
;; password aren't lost.
(let ((target (string-append "/etc/" file))
(source (string-append "/etc/static/" file)))
(rm-f target)
(symlink source target)))
(scandir ,etc
(lambda (file)
(not (member file '("." ".."))))))
;; Prevent ETC from being GC'd.
(rm-f "/var/nix/gcroots/etc-directory")
(symlink ,etc "/var/nix/gcroots/etc-directory"))
(format #t "starting services...~%")
(for-each start ',(append-map service-provision services))))
(text-file "dmd.conf" (object->string config)))
;;; dmd.scm ends here
;;; base.scm ends here

77
gnu/services/dmd.scm Normal file
View File

@ -0,0 +1,77 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services dmd)
#:use-module (guix monads)
#:use-module (gnu services)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (dmd-configuration-file))
;;; Commentary:
;;;
;;; Instantiating system services as a dmd configuration file.
;;;
;;; Code:
(define (dmd-configuration-file services etc)
"Return the dmd configuration file for SERVICES, that initializes /etc from
ETC (the name of a directory in the store) on startup."
(define config
`(begin
(use-modules (ice-9 ftw))
(register-services
,@(map (lambda (service)
`(make <service>
#:docstring ',(service-documentation service)
#:provides ',(service-provision service)
#:requires ',(service-requirement service)
#:respawn? ',(service-respawn? service)
#:start ,(service-start service)
#:stop ,(service-stop service)))
services))
;; /etc is a mixture of static and dynamic settings. Here is where we
;; initialize it from the static part.
(format #t "populating /etc from ~a...~%" ,etc)
(let ((rm-f (lambda (f)
(false-if-exception (delete-file f)))))
(rm-f "/etc/static")
(symlink ,etc "/etc/static")
(for-each (lambda (file)
;; TODO: Handle 'shadow' specially so that changed
;; password aren't lost.
(let ((target (string-append "/etc/" file))
(source (string-append "/etc/static/" file)))
(rm-f target)
(symlink source target)))
(scandir ,etc
(lambda (file)
(not (member file '("." ".."))))))
;; Prevent ETC from being GC'd.
(rm-f "/var/nix/gcroots/etc-directory")
(symlink ,etc "/var/nix/gcroots/etc-directory"))
(format #t "starting services...~%")
(for-each start ',(append-map service-provision services))))
(text-file "dmd.conf" (object->string config)))
;;; dmd.scm ends here

80
gnu/services/networking.scm Normal file
View File

@ -0,0 +1,80 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services networking)
#:use-module (gnu services)
#:use-module (gnu packages admin)
#:use-module (gnu packages linux)
#:use-module (guix monads)
#:export (static-networking-service))
;;; Commentary:
;;;
;;; Networking services.
;;;
;;; Code:
(define* (static-networking-service interface ip
#:key
gateway
(name-servers '())
(inetutils inetutils)
(net-tools net-tools))
"Return a service that starts INTERFACE with address IP. If GATEWAY is
true, it must be a string specifying the default network gateway."
;; TODO: Eventually we should do this using Guile's networking procedures,
;; like 'configure-qemu-networking' does, but the patch that does this is
;; not yet in stock Guile.
(mlet %store-monad ((ifconfig (package-file inetutils "bin/ifconfig"))
(route (package-file net-tools "sbin/route")))
(return
(service
(documentation
(string-append "Set up networking on the '" interface
"' interface using a static IP address."))
(provision '(networking))
(start `(lambda _
;; Return #t if successfully started.
(and (zero? (system* ,ifconfig ,interface ,ip "up"))
,(if gateway
`(zero? (system* ,route "add" "-net" "default"
"gw" ,gateway))
#t)
,(if (pair? name-servers)
`(call-with-output-file "/etc/resolv.conf"
(lambda (port)
(display
"# Generated by 'static-networking-service'.\n"
port)
(for-each (lambda (server)
(format port "nameserver ~a~%"
server))
',name-servers)))
#t))))
(stop `(lambda _
;; Return #f is successfully stopped.
(not (and (system* ,ifconfig ,interface "down")
(system* ,route "del" "-net" "default")))))
(respawn? #f)
(inputs `(("inetutils" ,inetutils)
,@(if gateway
`(("net-tools" ,net-tools))
'())))))))
;;; networking.scm ends here

186
gnu/services/xorg.scm Normal file
View File

@ -0,0 +1,186 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services xorg)
#:use-module (gnu services)
#:use-module (gnu system linux) ; 'pam-service'
#:use-module ((gnu packages base) #:select (guile-final))
#:use-module (gnu packages xorg)
#:use-module (gnu packages gl)
#:use-module (gnu packages slim)
#:use-module (gnu packages ratpoison)
#:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (guix monads)
#:use-module (guix derivations)
#:export (xorg-start-command
slim-service))
;;; Commentary:
;;;
;;; Services that relate to the X Window System.
;;;
;;; Code:
(define* (xorg-start-command #:key
(guile guile-final)
(xorg-server xorg-server))
"Return a derivation that builds a GUILE script to start the X server from
XORG-SERVER. Usually the X server is started by a login manager."
(define (xserver.conf)
(text-file* "xserver.conf" "
Section \"Files\"
FontPath \"" font-adobe75dpi "/share/font/X11/75dpi\"
ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\"
ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\"
ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\"
ModulePath \"" xorg-server "/lib/xorg/modules\"
ModulePath \"" xorg-server "/lib/xorg/modules/extensions\"
ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\"
EndSection
Section \"ServerFlags\"
Option \"AllowMouseOpenFail\" \"on""
EndSection
Section \"Monitor\"
Identifier \"Monitor[0]\"
EndSection
Section \"InputClass\"
Identifier \"Generic keyboard\"
MatchIsKeyboard \"on\"
Option \"XkbRules\" \"base\"
Option \"XkbModel\" \"pc104\"
EndSection
Section \"ServerLayout\"
Identifier \"Layout\"
Screen \"Screen-vesa\"
EndSection
Section \"Device\"
Identifier \"Device-vesa\"
Driver \"vesa\"
EndSection
Section \"Screen\"
Identifier \"Screen-vesa\"
Device \"Device-vesa\"
EndSection"))
(mlet %store-monad ((guile-bin (package-file guile "bin/guile"))
(xorg-bin (package-file xorg-server "bin/X"))
(dri (package-file mesa "lib/dri"))
(xkbcomp-bin (package-file xkbcomp "bin"))
(xkb-dir (package-file xkeyboard-config
"share/X11/xkb"))
(config (xserver.conf)))
(define builder
;; Write a small wrapper around the X server.
`(let ((out (assoc-ref %outputs "out")))
(call-with-output-file out
(lambda (port)
(format port "#!~a --no-auto-compile~%!#~%" ,guile-bin)
(write '(begin
(setenv "XORG_DRI_DRIVER_PATH" ,dri)
(setenv "XKB_BINDIR" ,xkbcomp-bin)
(apply execl
,xorg-bin "-ac" "-logverbose" "-verbose"
"-xkbdir" ,xkb-dir
"-config" ,(derivation->output-path config)
"-nolisten" "tcp" "-terminate"
;; Note: SLiM and other display managers add the
;; '-auth' flag by themselves.
(cdr (command-line))))
port)))
(chmod out #o555)
#t))
(mlet %store-monad ((inputs (lower-inputs
`(("xorg" ,xorg-server)
("xkbcomp" ,xkbcomp)
("xkeyboard-config" ,xkeyboard-config)
("mesa" ,mesa)
("guile" ,guile)
("xorg.conf" ,config)))))
(derivation-expression "start-xorg" builder
#:inputs inputs))))
(define* (slim-service #:key (slim slim)
(allow-empty-passwords? #t) auto-login?
(default-user "")
(xauth xauth) (dmd dmd) (bash bash)
startx)
"Return a service that spawns the SLiM graphical login manager, which in
turn start the X display server with STARTX, a command as returned by
'xorg-start-command'.
When ALLOW-EMPTY-PASSWORDS? is true, allow logins with an empty password.
When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER."
(define (slim.cfg)
;; TODO: Run "bash -login ~/.xinitrc %session".
(mlet %store-monad ((startx (or startx (xorg-start-command))))
(text-file* "slim.cfg" "
default_path /run/current-system/bin
default_xserver " startx "
xserver_arguments :0 vt7
xauth_path " xauth "/bin/xauth
authfile /var/run/slim.auth
# The login command. '%session' is replaced by the chosen session name, one
# of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc.
login_cmd exec " ratpoison "/bin/ratpoison
halt_cmd " dmd "/sbin/halt
reboot_cmd " dmd "/sbin/reboot
" (if auto-login?
(string-append "auto_login yes\ndefault_user " default-user)
""))))
(mlet %store-monad ((slim-bin (package-file slim "bin/slim"))
(bash-bin (package-file bash "bin/bash"))
(slim.cfg (slim.cfg)))
(return
(service
(documentation "Xorg display server")
(provision '(xorg-server))
(requirement '(host-name))
(start
;; XXX: Work around the inability to specify env. vars. directly.
`(make-forkexec-constructor
,bash-bin "-c"
,(string-append "SLIM_CFGFILE=" (derivation->output-path slim.cfg)
" " slim-bin
" -nodaemon")))
(stop `(make-kill-destructor))
(inputs `(("slim" ,slim)
("slim.cfg" ,slim.cfg)
("bash" ,bash)))
(respawn? #t)
(pam-services
;; Tell PAM about 'slim'.
(list (unix-pam-service
"slim"
#:allow-empty-passwords? allow-empty-passwords?)))))))
;;; xorg.scm ends here

93
gnu/system.scm
View File

@ -22,15 +22,17 @@
#:use-module (guix records)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (gnu packages linux-initrd)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages admin)
#:use-module (gnu packages package-management)
#:use-module (gnu system dmd)
#:use-module (gnu services)
#:use-module (gnu services dmd)
#:use-module (gnu services base)
#:use-module (gnu system grub)
#:use-module (gnu system shadow)
#:use-module (gnu system linux)
#:use-module (gnu system linux-initrd)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@ -38,7 +40,18 @@
operating-system?
operating-system-services
operating-system-packages
operating-system-bootloader-entries
operating-system-host-name
operating-system-kernel
operating-system-initrd
operating-system-users
operating-system-groups
operating-system-packages
operating-system-timezone
operating-system-locale
operating-system-services
operating-system-profile-directory
operating-system-derivation))
;;; Commentary:
@ -58,8 +71,8 @@
(default grub))
(bootloader-entries operating-system-bootloader-entries ; list
(default '()))
(initrd operating-system-initrd
(default gnu-system-initrd))
(initrd operating-system-initrd ; monadic derivation
(default (gnu-system-initrd)))
(host-name operating-system-host-name) ; string
@ -92,23 +105,7 @@
(locale operating-system-locale) ; string
(services operating-system-services ; list of monadic services
(default
(let ((motd (text-file "motd" "
This is the GNU operating system, welcome!\n\n")))
(list (mingetty-service "tty1" #:motd motd)
(mingetty-service "tty2" #:motd motd)
(mingetty-service "tty3" #:motd motd)
(mingetty-service "tty4" #:motd motd)
(mingetty-service "tty5" #:motd motd)
(mingetty-service "tty6" #:motd motd)
(syslog-service)
(guix-service)
(nscd-service)
;; QEMU networking settings.
(static-networking-service "eth0" "10.0.2.10"
#:name-servers '("10.0.2.3")
#:gateway "10.0.2.2"))))))
(default %base-services)))
@ -233,6 +230,11 @@ directories or regular files."
(group (group-file groups))
(pam.d (pam-services->directory pam-services))
(login.defs (text-file "login.defs" "# Empty for now.\n"))
(shells (text-file "shells" ; used by xterm and others
"\
/bin/sh
/run/current-system/bin/sh
/run/current-system/bin/bash\n"))
(issue (text-file "issue" "
This is an alpha preview of the GNU system. Welcome.
@ -243,40 +245,53 @@ GNU dmd (http://www.gnu.org/software/dmd/).
You can log in as 'guest' or 'root' with no password.
"))
;; Assume TZDATA is installed---e.g., as part of the system packages.
;; Users can choose not to have it.
(tzdir (package-file tzdata "share/zoneinfo"))
;; TODO: Generate bashrc from packages' search-paths.
(bashrc (text-file "bashrc" (string-append "
(bashrc (text-file* "bashrc" "
export PS1='\\u@\\h\\$ '
export LC_ALL=\"" locale "\"
export TZ=\"" timezone "\"
export TZDIR=\"" tzdir "\"
export TZDIR=\"" tzdata "/share/zoneinfo\"
export PATH=$HOME/.guix-profile/bin:" profile "/bin:" profile "/sbin
export CPATH=$HOME/.guix-profile/include:" profile "/include
export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
alias ls='ls -p --color'
alias ll='ls -l'
")))
"))
(tz-file (package-file tzdata
(string-append "share/zoneinfo/" timezone)))
(files -> `(("services" ,services)
("protocols" ,protocols)
("rpc" ,rpc)
("pam.d" ,(derivation->output-path pam.d))
("login.defs" ,login.defs)
("issue" ,issue)
("profile" ,bashrc)
("shells" ,shells)
("profile" ,(derivation->output-path bashrc))
("localtime" ,tz-file)
("passwd" ,passwd)
("shadow" ,shadow)
("group" ,group))))
(file-union files
#:inputs `(("net" ,net-base)
("pam.d" ,pam.d))
("pam.d" ,pam.d)
("bashrc" ,bashrc)
("tzdata" ,tzdata))
#:name "etc")))
(define (operating-system-profile-derivation os)
"Return a derivation that builds the default profile of OS."
;; TODO: Replace with a real profile with a manifest.
(union (operating-system-packages os)
#:name "default-profile"))
(define (operating-system-profile-directory os)
"Return the directory name of the default profile of OS."
(mlet %store-monad ((drv (operating-system-profile-derivation os)))
(return (derivation->output-path drv))))
(define (operating-system-derivation os)
"Return a derivation that builds OS."
(mlet* %store-monad
@ -297,23 +312,20 @@ alias ll='ls -l'
(password "")
(uid 0) (gid 0)
(comment "System administrator")
(home-directory "/"))
(home-directory "/root"))
(append (operating-system-users os)
(append-map service-user-accounts
services))))
(groups -> (append (operating-system-groups os)
(append-map service-user-groups services)))
(packages -> (operating-system-packages os))
;; TODO: Replace with a real profile with a manifest.
(profile-drv (union packages
#:name "default-profile"))
(profile-drv (operating-system-profile-derivation os))
(profile -> (derivation->output-path profile-drv))
(etc-drv (etc-directory #:accounts accounts #:groups groups
#:pam-services pam-services
#:locale (operating-system-locale os)
#:timezone (operating-system-timezone os)
#:profile profile))
#:profile profile-drv))
(etc -> (derivation->output-path etc-drv))
(dmd-conf (dmd-configuration-file services etc))
@ -324,17 +336,18 @@ alias ll='ls -l'
"--config" ,dmd-conf))))
(kernel -> (operating-system-kernel os))
(kernel-dir (package-file kernel))
(initrd -> (operating-system-initrd os))
(initrd-file (package-file initrd))
(initrd (operating-system-initrd os))
(initrd-file -> (string-append (derivation->output-path initrd)
"/initrd"))
(entries -> (list (menu-entry
(label (string-append
"GNU system with "
(package-full-name kernel)
" (technology preview)"))
(linux kernel)
(linux-arguments `("--root=/dev/vda1"
(linux-arguments `("--root=/dev/sda1"
,(string-append "--load=" boot)))
(initrd initrd))))
(initrd initrd-file))))
(grub.cfg (grub-configuration-file entries))
(extras (links (delete-duplicates
(append (append-map service-inputs services)

7
gnu/system/grub.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -41,7 +41,7 @@
(linux menu-entry-linux)
(linux-arguments menu-entry-linux-arguments
(default '()))
(initrd menu-entry-initrd))
(initrd menu-entry-initrd)) ; file name of the initrd
(define* (grub-configuration-file entries
#:key (default-entry 1) (timeout 5)
@ -66,10 +66,7 @@ search.file ~a~%"
(match-lambda
(($ <menu-entry> label linux arguments initrd)
(mlet %store-monad ((linux (package-file linux "bzImage"
#:system system))
(initrd (package-file initrd "initrd"
#:system system)))
;; XXX: Assume that INITRD is a directory containing an 'initrd' file.
(return (format #f "menuentry ~s {
linux ~a ~a
initrd ~a

248
gnu/system/linux-initrd.scm Normal file
View File

@ -0,0 +1,248 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system linux-initrd)
#:use-module (guix monads)
#:use-module (guix utils)
#:use-module ((guix store)
#:select (%store-prefix))
#:use-module (gnu packages cpio)
#:use-module (gnu packages compression)
#:use-module (gnu packages linux)
#:use-module (gnu packages guile)
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped))
#:use-module (ice-9 regex)
#:export (expression->initrd
qemu-initrd
gnu-system-initrd))
;;; Commentary:
;;;
;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in
;;; particular initrd's that run Guile.
;;;
;;; Code:
(define* (expression->initrd exp
#:key
(guile %guile-static-stripped)
(cpio cpio)
(gzip gzip)
(name "guile-initrd")
(system (%current-system))
(modules '())
(linux #f)
(linux-modules '()))
"Return a package that contains a Linux initrd (a gzipped cpio archive)
containing GUILE and that evaluates EXP upon booting. LINUX-MODULES is a list
of `.ko' file names to be copied from LINUX into the initrd. MODULES is a
list of Guile module names to be embedded in the initrd."
;; General Linux overview in `Documentation/early-userspace/README' and
;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
(define (string->regexp str)
;; Return a regexp that matches STR exactly.
(string-append "^" (regexp-quote str) "$"))
(define builder
`(begin
(use-modules (guix build utils)
(ice-9 pretty-print)
(ice-9 popen)
(ice-9 match)
(ice-9 ftw)
(srfi srfi-26)
(system base compile)
(rnrs bytevectors)
((system foreign) #:select (sizeof)))
(let ((guile (assoc-ref %build-inputs "guile"))
(cpio (string-append (assoc-ref %build-inputs "cpio")
"/bin/cpio"))
(gzip (string-append (assoc-ref %build-inputs "gzip")
"/bin/gzip"))
(modules (assoc-ref %build-inputs "modules"))
(gos (assoc-ref %build-inputs "modules/compiled"))
(scm-dir (string-append "share/guile/" (effective-version)))
(go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a"
(effective-version)
(if (eq? (native-endianness) (endianness little))
"LE"
"BE")
(sizeof '*)
(effective-version)))
(out (assoc-ref %outputs "out")))
(mkdir out)
(mkdir "contents")
(with-directory-excursion "contents"
(copy-recursively guile ".")
(call-with-output-file "init"
(lambda (p)
(format p "#!/bin/guile -ds~%!#~%" guile)
(pretty-print ',exp p)))
(chmod "init" #o555)
(chmod "bin/guile" #o555)
;; Copy Guile modules.
(chmod scm-dir #o777)
(copy-recursively modules scm-dir
#:follow-symlinks? #t)
(copy-recursively gos (string-append "lib/guile/"
(effective-version) "/ccache")
#:follow-symlinks? #t)
;; Compile `init'.
(mkdir-p go-dir)
(set! %load-path (cons modules %load-path))
(set! %load-compiled-path (cons gos %load-compiled-path))
(compile-file "init"
#:opts %auto-compilation-options
#:output-file (string-append go-dir "/init.go"))
;; Copy Linux modules.
(let* ((linux (assoc-ref %build-inputs "linux"))
(module-dir (and linux
(string-append linux "/lib/modules"))))
(mkdir "modules")
,@(map (lambda (module)
`(match (find-files module-dir
,(string->regexp module))
((file)
(format #t "copying '~a'...~%" file)
(copy-file file (string-append "modules/"
,module)))
(()
(error "module not found" ,module module-dir))
((_ ...)
(error "several modules by that name"
,module module-dir))))
linux-modules))
;; Reset the timestamps of all the files that will make it in the
;; initrd.
(for-each (cut utime <> 0 0 0 0)
(find-files "." ".*"))
(system* cpio "--version")
(let ((pipe (open-pipe* OPEN_WRITE cpio "-o"
"-O" (string-append out "/initrd")
"-H" "newc" "--null")))
(define print0
(let ((len (string-length "./")))
(lambda (file)
(format pipe "~a\0" (string-drop file len)))))
;; Note: as per `ramfs-rootfs-initramfs.txt', always add
;; directory entries before the files that are inside of it: "The
;; Linux kernel cpio extractor won't create files in a directory
;; that doesn't exist, so the directory entries must go before
;; the files that go in those directories."
(file-system-fold (const #t)
(lambda (file stat result) ; leaf
(print0 file))
(lambda (dir stat result) ; down
(unless (string=? dir ".")
(print0 dir)))
(const #f) ; up
(const #f) ; skip
(const #f)
#f
".")
(and (zero? (close-pipe pipe))
(with-directory-excursion out
(and (zero? (system* gzip "--best" "initrd"))
(rename-file "initrd.gz" "initrd")))))))))
(mlet* %store-monad
((source (imported-modules modules))
(compiled (compiled-modules modules))
(inputs (lower-inputs
`(("guile" ,guile)
("cpio" ,cpio)
("gzip" ,gzip)
("modules" ,source)
("modules/compiled" ,compiled)
,@(if linux
`(("linux" ,linux))
'())))))
(derivation-expression name builder
#:modules '((guix build utils))
#:inputs inputs)))
(define* (qemu-initrd #:key
guile-modules-in-chroot?
volatile-root?
(mounts `((cifs "/store" ,(%store-prefix))
(cifs "/xchg" "/xchg"))))
"Return a monadic derivation that builds an initrd for use in a QEMU guest
where the store is shared with the host. MOUNTS is a list of file systems to
be mounted atop the root file system, where each item has the form:
(FILE-SYSTEM-TYPE SOURCE TARGET)
When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in
the new root. This is necessary is the file specified as '--load' needs
access to these modules (which is the case if it wants to even just print an
exception and backtrace!).
When VOLATILE-ROOT? is true, the root file system is writable but any changes
to it are lost."
(define cifs-modules
;; Modules needed to mount CIFS file systems.
'("md4.ko" "ecb.ko" "cifs.ko"))
(define virtio-9p-modules
;; Modules for the 9p paravirtualized file system.
'("9pnet.ko" "9p.ko" "9pnet_virtio.ko"))
(define linux-modules
;; Modules added to the initrd and loaded from the initrd.
`("virtio.ko" "virtio_ring.ko" "virtio_pci.ko"
"virtio_balloon.ko" "virtio_blk.ko" "virtio_net.ko"
,@(if (assoc-ref mounts 'cifs)
cifs-modules
'())
,@(if (assoc-ref mounts '9p)
virtio-9p-modules
'())))
(expression->initrd
`(begin
(use-modules (guix build linux-initrd))
(boot-system #:mounts ',mounts
#:linux-modules ',linux-modules
#:qemu-guest-networking? #t
#:guile-modules-in-chroot? ',guile-modules-in-chroot?
#:volatile-root? ',volatile-root?))
#:name "qemu-initrd"
#:modules '((guix build utils)
(guix build linux-initrd))
#:linux linux-libre
#:linux-modules linux-modules))
(define (gnu-system-initrd)
"Initrd for the GNU system itself, with nothing QEMU-specific."
(qemu-initrd #:guile-modules-in-chroot? #f))
;;; linux-initrd.scm ends here

201
gnu/system/vm.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -35,7 +35,6 @@
#:use-module (gnu packages zile)
#:use-module (gnu packages grub)
#:use-module (gnu packages linux)
#:use-module (gnu packages linux-initrd)
#:use-module (gnu packages package-management)
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped))
@ -43,9 +42,10 @@
#:use-module (gnu system shadow)
#:use-module (gnu system linux)
#:use-module (gnu system linux-initrd)
#:use-module (gnu system grub)
#:use-module (gnu system dmd)
#:use-module (gnu system)
#:use-module (gnu services)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@ -53,7 +53,9 @@
#:export (expression->derivation-in-linux-vm
qemu-image
system-qemu-image))
system-qemu-image
system-qemu-image/shared-store
system-qemu-image/shared-store-script))
;;; Commentary:
@ -67,7 +69,7 @@
(system (%current-system))
(inputs '())
(linux linux-libre)
(initrd qemu-initrd)
initrd
(qemu qemu/smb-shares)
(env-vars '())
(modules '())
@ -78,10 +80,10 @@
(references-graphs #f)
(disk-image-size
(* 100 (expt 2 20))))
"Evaluate EXP in a QEMU virtual machine running LINUX with INITRD. In the
virtual machine, EXP has access to all of INPUTS from the store; it should put
its output files in the `/xchg' directory, which is copied to the derivation's
output when the VM terminates.
"Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a
derivation). In the virtual machine, EXP has access to all of INPUTS from the
store; it should put its output files in the `/xchg' directory, which is
copied to the derivation's output when the VM terminates.
When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of
DISK-IMAGE-SIZE bytes and return it.
@ -154,7 +156,7 @@ made available under the /xchg CIFS share."
(#f '())))
(and (zero?
(system* qemu "-nographic" "-no-reboot"
(system* qemu "-enable-kvm" "-nographic" "-no-reboot"
"-net" "nic,model=e1000"
"-net" (string-append "user,smb=" (getcwd))
"-kernel" linux
@ -178,6 +180,9 @@ made available under the /xchg CIFS share."
(user-builder (text-file "builder-in-linux-vm"
(object->string exp*)))
(coreutils -> (car (assoc-ref %final-inputs "coreutils")))
(initrd (if initrd ; use the default initrd?
(return initrd)
(qemu-initrd #:guile-modules-in-chroot? #t)))
(inputs (lower-inputs `(("qemu" ,qemu)
("linux" ,linux)
("initrd" ,initrd)
@ -185,6 +190,7 @@ made available under the /xchg CIFS share."
("builder" ,user-builder)
,@inputs))))
(derivation-expression name builder
;; TODO: Require the "kvm" feature.
#:system system
#:inputs inputs
#:env-vars env-vars
@ -290,18 +296,18 @@ such as /etc files."
(assoc-ref %build-inputs "gawk") "/bin"))
(display "creating partition table...\n")
(and (zero? (system* parted "/dev/vda" "mklabel" "msdos"
(and (zero? (system* parted "/dev/sda" "mklabel" "msdos"
"mkpart" "primary" "ext2" "1MiB"
,(format #f "~aB"
(- disk-image-size
(* 5 (expt 2 20))))))
(begin
(display "creating ext3 partition...\n")
(and (zero? (system* mkfs "-F" "/dev/vda1"))
(and (zero? (system* mkfs "-F" "/dev/sda1"))
(let ((store (string-append "/fs" ,%store-directory)))
(display "mounting partition...\n")
(mkdir "/fs")
(mount "/dev/vda1" "/fs" "ext3")
(mount "/dev/sda1" "/fs" "ext3")
(mkdir-p "/fs/boot/grub")
(symlink grub.cfg "/fs/boot/grub/grub.cfg")
@ -319,8 +325,9 @@ such as /etc files."
;; Optionally, register the inputs in the image's store.
(let* ((guix (assoc-ref %build-inputs "guix"))
(register (string-append guix
"/sbin/guix-register")))
(register (and guix
(string-append guix
"/sbin/guix-register"))))
,@(if initialize-store?
(match inputs-to-copy
(((graph-files . _) ...)
@ -375,7 +382,7 @@ such as /etc files."
(and (zero?
(system* grub "--no-floppy"
"--boot-directory" "/fs/boot"
"/dev/vda"))
"/dev/sda"))
(zero? (system* umount "/fs"))
(reboot))))))))
#:system system
@ -407,37 +414,52 @@ such as /etc files."
;;; Stand-alone VM image.
;;;
(define %demo-operating-system
(operating-system
(host-name "gnu")
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
(users (list (user-account
(name "guest")
(password "")
(uid 1000) (gid 100)
(comment "Guest of GNU")
(home-directory "/home/guest"))))
(packages (list coreutils
bash
guile-2.0
dmd
gcc-final
ld-wrapper ; must come before BINUTILS
binutils-final
glibc-final
inetutils
findutils
grep
sed
procps
psmisc
zile
less
tzdata
guix))))
(define (operating-system-build-gid os)
"Return as a monadic value the group id for build users of OS, or #f."
(anym %store-monad
(lambda (service)
(and (equal? '(guix-daemon)
(service-provision service))
(match (service-user-groups service)
((group)
(user-group-id group)))))
(operating-system-services os)))
(define* (system-qemu-image #:optional (os %demo-operating-system)
(define (operating-system-default-contents os)
"Return a list of directives suitable for 'system-qemu-image' describing the
basic contents of the root file system of OS."
(define (user-directories user)
(let ((home (user-account-home-directory user))
;; XXX: Deal with automatically allocated ids.
(uid (or (user-account-uid user) 0))
(gid (or (user-account-gid user) 0))
(root (string-append "/var/nix/profiles/per-user/"
(user-account-name user))))
`((directory ,root ,uid ,gid)
(directory ,home ,uid ,gid))))
(mlet* %store-monad ((os-drv (operating-system-derivation os))
(os-dir -> (derivation->output-path os-drv))
(build-gid (operating-system-build-gid os))
(profile (operating-system-profile-directory os)))
(return `((directory "/nix/store" 0 ,(or build-gid 0))
(directory "/etc")
(directory "/var/log") ; for dmd
(directory "/var/run/nscd")
(directory "/var/nix/gcroots")
("/var/nix/gcroots/system" -> ,os-dir)
(directory "/run")
("/run/current-system" -> ,profile)
(directory "/bin")
("/bin/sh" -> "/run/current-system/bin/bash")
(directory "/tmp")
(directory "/var/nix/profiles/per-user/root" 0 0)
(directory "/root" 0 0) ; an exception
,@(append-map user-directories
(operating-system-users os))))))
(define* (system-qemu-image os
#:key (disk-image-size (* 900 (expt 2 20))))
"Return the derivation of a QEMU image of DISK-IMAGE-SIZE bytes of the GNU
system as described by OS."
@ -445,29 +467,78 @@ system as described by OS."
((os-drv (operating-system-derivation os))
(os-dir -> (derivation->output-path os-drv))
(grub.cfg -> (string-append os-dir "/grub.cfg"))
(build-user-gid (anym %store-monad ; XXX
(lambda (service)
(and (equal? '(guix-daemon)
(service-provision service))
(match (service-user-groups service)
((group)
(user-group-id group)))))
(operating-system-services os)))
(populate -> `((directory "/nix/store" 0 ,build-user-gid)
(directory "/etc")
(directory "/var/log") ; for dmd
(directory "/var/run/nscd")
(directory "/var/nix/gcroots")
("/var/nix/gcroots/system" -> ,os-dir)
(directory "/tmp")
(directory "/var/nix/profiles/per-user/root" 0 0)
(directory "/var/nix/profiles/per-user/guest"
1000 100)
(directory "/home/guest" 1000 100))))
(populate (operating-system-default-contents os)))
(qemu-image #:grub-configuration grub.cfg
#:populate populate
#:disk-image-size disk-image-size
#:initialize-store? #t
#:inputs-to-copy `(("system" ,os-drv)))))
(define* (system-qemu-image/shared-store
os
#:key (disk-image-size (* 15 (expt 2 20))))
"Return a derivation that builds a QEMU image of OS that shares its store
with the host."
(mlet* %store-monad
((os-drv (operating-system-derivation os))
(os-dir -> (derivation->output-path os-drv))
(grub.cfg -> (string-append os-dir "/grub.cfg"))
(populate (operating-system-default-contents os)))
;; TODO: Initialize the database so Guix can be used in the guest.
(qemu-image #:grub-configuration grub.cfg
#:populate populate
#:disk-image-size disk-image-size)))
(define* (system-qemu-image/shared-store-script
os
#:key
(qemu (package (inherit qemu)
;; FIXME/TODO: Use 9p instead of this hack.
(source (package-source qemu/smb-shares))))
(graphic? #t))
"Return a derivation that builds a script to run a virtual machine image of
OS that shares its store with the host."
(let* ((initrd (qemu-initrd #:mounts `((cifs "/store" ,(%store-prefix)))
#:volatile-root? #t))
(os (operating-system (inherit os) (initrd initrd))))
(define builder
(mlet %store-monad ((image (system-qemu-image/shared-store os))
(qemu (package-file qemu
"bin/qemu-system-x86_64"))
(bash (package-file bash "bin/sh"))
(kernel (package-file (operating-system-kernel os)
"bzImage"))
(initrd initrd)
(os-drv (operating-system-derivation os)))
(return `(let ((out (assoc-ref %outputs "out")))
(call-with-output-file out
(lambda (port)
(display
(string-append "#!" ,bash "
# TODO: -virtfs local,path=XXX,security_model=none,mount_tag=store
exec " ,qemu " -enable-kvm -no-reboot -net nic,model=virtio \
-net user,smb=$PWD \
-kernel " ,kernel " -initrd "
,(string-append (derivation->output-path initrd) "/initrd") " \
-append \"" ,(if graphic? "" "console=ttyS0 ")
"--load=" ,(derivation->output-path os-drv) "/boot --root=/dev/vda1\" \
-drive file=" ,(derivation->output-path image)
",if=virtio,cache=writeback,werror=report,readonly\n")
port)))
(chmod out #o555)
#t))))
(mlet %store-monad ((image (system-qemu-image/shared-store os))
(initrd initrd)
(qemu (package->derivation qemu))
(bash (package->derivation bash))
(os (operating-system-derivation os))
(builder builder))
(derivation-expression "run-vm.sh" builder
#:inputs `(("qemu" ,qemu)
("image" ,image)
("bash" ,bash)
("initrd" ,initrd)
("os" ,os))))))
;;; vm.scm ends here

17
guix/build/download.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -201,6 +201,12 @@ which is not available during bootstrap."
(string>? (micro-version) "7")
(string>? (version) "2.0.7")))
(define headers
;; Some web sites, such as http://dist.schmorp.de, would block you if
;; there's no 'User-Agent' header, presumably on the assumption that
;; you're a spammer. So work around that.
'((User-Agent . "GNU Guile")))
(let*-values (((connection)
(open-connection-for-uri uri))
((resp bv-or-port)
@ -210,11 +216,14 @@ which is not available during bootstrap."
;; version. So keep this compatibility hack for now.
(if post-2.0.7?
(http-get uri #:port connection #:decode-body? #f
#:streaming? #t)
#:streaming? #t
#:headers headers)
(if (module-defined? (resolve-interface '(web client))
'http-get*)
(http-get* uri #:port connection #:decode-body? #f)
(http-get uri #:port connection #:decode-body? #f))))
(http-get* uri #:port connection #:decode-body? #f
#:headers headers)
(http-get uri #:port connection #:decode-body? #f
#:extra-headers headers))))
((code)
(response-code resp))
((size)

45
guix/build/git.scm Normal file
View File

@ -0,0 +1,45 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 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 build git)
#:use-module (guix build utils)
#:export (git-fetch))
;;; Commentary:
;;;
;;; This is the build-side support code of (guix git-download). It allows a
;;; Git repository to be cloned and checked out at a specific commit.
;;;
;;; Code:
(define* (git-fetch url commit directory
#:key (git-command "git"))
"Fetch COMMIT from URL into DIRECTORY. COMMIT must be a valid Git commit
identifier. Return #t on success, #f otherwise."
(and (zero? (system* git-command "clone" url directory))
(with-directory-excursion directory
(system* git-command "tag" "-l")
(and (zero? (system* git-command "checkout" commit))
(begin
;; The contents of '.git' vary as a function of the current
;; status of the Git repo. Since we want a fixed output, this
;; directory needs to be taken out.
(delete-file-recursively ".git")
#t)))))
;;; git.scm ends here

197
guix/build/linux-initrd.scm
View File

@ -19,14 +19,23 @@
(define-module (guix build linux-initrd)
#:use-module (rnrs io ports)
#:use-module (system foreign)
#:autoload (system repl repl) (start-repl)
#:autoload (system base compile) (compile-file)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 ftw)
#:use-module (guix build utils)
#:export (mount-essential-file-systems
linux-command-line
make-essential-device-nodes
configure-qemu-networking
mount-qemu-smb-share
mount-qemu-9p
bind-mount
load-linux-module*
device-number))
device-number
boot-system))
;;; Commentary:
;;;
@ -74,10 +83,26 @@
(unless (file-exists? (scope "dev"))
(mkdir (scope "dev")))
;; Make the device nodes for QEMU's hard disk and partitions.
(mknod (scope "dev/vda") 'block-special #o644 (device-number 8 0))
(mknod (scope "dev/vda1") 'block-special #o644 (device-number 8 1))
(mknod (scope "dev/vda2") 'block-special #o644 (device-number 8 2))
;; Make the device nodes for SCSI disks.
(mknod (scope "dev/sda") 'block-special #o644 (device-number 8 0))
(mknod (scope "dev/sda1") 'block-special #o644 (device-number 8 1))
(mknod (scope "dev/sda2") 'block-special #o644 (device-number 8 2))
;; The virtio (para-virtualized) block devices, as supported by QEMU/KVM.
(mknod (scope "dev/vda") 'block-special #o644 (device-number 252 0))
(mknod (scope "dev/vda1") 'block-special #o644 (device-number 252 1))
(mknod (scope "dev/vda2") 'block-special #o644 (device-number 252 2))
;; Memory (used by Xorg's VESA driver.)
(mknod (scope "dev/mem") 'char-special #o640 (device-number 1 1))
(mknod (scope "dev/kmem") 'char-special #o640 (device-number 1 2))
;; Inputs (used by Xorg.)
(unless (file-exists? (scope "dev/input"))
(mkdir (scope "dev/input")))
(mknod (scope "dev/input/mice") 'char-special #o640 (device-number 13 63))
(mknod (scope "dev/input/mouse0") 'char-special #o640 (device-number 13 32))
(mknod (scope "dev/input/event0") 'char-special #o640 (device-number 13 64))
;; TTYs.
(mknod (scope "dev/tty") 'char-special #o600
@ -133,6 +158,17 @@ Vanilla QEMU's `-smb' option just exports a /qemu share, whereas our
(mount (string-append "//" server share) mount-point "cifs" 0
(string->pointer "guest,sec=none"))))
(define (mount-qemu-9p source mount-point)
"Mount QEMU's 9p file system from SOURCE at MOUNT-POINT.
This uses the 'virtio' transport, which requires the various virtio Linux
modules to be loaded."
(format #t "mounting QEMU's 9p share '~a'...\n" source)
(let ((server "10.0.2.4"))
(mount source mount-point "9p" 0
(string->pointer "trans=virtio"))))
(define (bind-mount source target)
"Bind-mount SOURCE at TARGET."
(define MS_BIND 4096) ; from libc's <sys/mount.h>
@ -151,4 +187,155 @@ Vanilla QEMU's `-smb' option just exports a /qemu share, whereas our
the last argument of `mknod'."
(+ (* major 256) minor))
(define* (boot-system #:key
(linux-modules '())
qemu-guest-networking?
guile-modules-in-chroot?
volatile-root?
(mounts '()))
"This procedure is meant to be called from an initrd. Boot a system by
first loading LINUX-MODULES, then setting up QEMU guest networking if
QEMU-GUEST-NETWORKING? is true, mounting the file systems specified in MOUNTS,
and finally booting into the new root if any. The initrd supports kernel
command-line options '--load', '--root', and '--repl'.
MOUNTS must be a list of elements of the form:
(FILE-SYSTEM-TYPE SOURCE TARGET)
When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in
the new root.
When VOLATILE-ROOT? is true, the root file system is writable but any changes
to it are lost."
(define (resolve file)
;; If FILE is a symlink to an absolute file name, resolve it as if we were
;; under /root.
(let ((st (lstat file)))
(if (eq? 'symlink (stat:type st))
(let ((target (readlink file)))
(resolve (string-append "/root" target)))
file)))
(define MS_RDONLY 1)
(display "Welcome, this is GNU's early boot Guile.\n")
(display "Use '--repl' for an initrd REPL.\n\n")
(mount-essential-file-systems)
(let* ((args (linux-command-line))
(option (lambda (opt)
(let ((opt (string-append opt "=")))
(and=> (find (cut string-prefix? opt <>)
args)
(lambda (arg)
(substring arg (+ 1 (string-index arg #\=))))))))
(to-load (option "--load"))
(root (option "--root")))
(when (member "--repl" args)
(start-repl))
(display "loading kernel modules...\n")
(for-each (compose load-linux-module*
(cut string-append "/modules/" <>))
linux-modules)
(when qemu-guest-networking?
(unless (configure-qemu-networking)
(display "network interface is DOWN\n")))
;; Make /dev nodes.
(make-essential-device-nodes)
;; Prepare the real root file system under /root.
(unless (file-exists? "/root")
(mkdir "/root"))
(if root
(catch #t
(lambda ()
(if volatile-root?
(begin
;; XXX: For lack of a union file system...
(mkdir-p "/real-root")
(mount root "/real-root" "ext3" MS_RDONLY)
(mount "none" "/root" "tmpfs")
;; XXX: 'copy-recursively' cannot deal with device nodes, so
;; explicitly avoid /dev.
(for-each (lambda (file)
(unless (string=? "dev" file)
(copy-recursively (string-append "/real-root/"
file)
(string-append "/root/"
file)
#:log (%make-void-port
"w"))))
(scandir "/real-root"
(lambda (file)
(not (member file '("." ".."))))))
;; TODO: Unmount /real-root.
)
(mount root "/root" "ext3")))
(lambda args
(format (current-error-port) "exception while mounting '~a': ~s~%"
root args)
(start-repl)))
(mount "none" "/root" "tmpfs"))
(mount-essential-file-systems #:root "/root")
(unless (file-exists? "/root/dev")
(mkdir "/root/dev")
(make-essential-device-nodes #:root "/root"))
;; Mount the specified file systems.
(for-each (match-lambda
(('cifs source target)
(let ((target (string-append "/root/" target)))
(mkdir-p target)
(mount-qemu-smb-share source target)))
(('9p source target)
(let ((target (string-append "/root/" target)))
(mkdir-p target)
(mount-qemu-9p source target))))
mounts)
(when guile-modules-in-chroot?
;; Copy the directories that contain .scm and .go files so that the
;; child process in the chroot can load modules (we would bind-mount
;; them but for some reason that fails with EINVAL -- XXX).
(mkdir-p "/root/share")
(mkdir-p "/root/lib")
(mount "none" "/root/share" "tmpfs")
(mount "none" "/root/lib" "tmpfs")
(copy-recursively "/share" "/root/share"
#:log (%make-void-port "w"))
(copy-recursively "/lib" "/root/lib"
#:log (%make-void-port "w")))
(if to-load
(begin
(format #t "loading '~a'...\n" to-load)
(chdir "/root")
(chroot "/root")
;; TODO: Remove /lib, /share, and /loader.go.
(catch #t
(lambda ()
(primitive-load to-load))
(lambda args
(format (current-error-port) "'~a' raised an exception: ~s~%"
to-load args)
(start-repl)))
(format (current-error-port)
"boot program '~a' terminated, rebooting~%"
to-load)
(sleep 2)
(reboot))
(begin
(display "no boot file passed via '--load'\n")
(display "entering a warm and cozy REPL\n")
(start-repl)))))
;;; linux-initrd.scm ends here

37
guix/build/union.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -103,21 +103,26 @@ single leaf."
(leaf leaf))))
(define (file=? file1 file2)
"Return #t if the contents of FILE1 and FILE2 are identical, #f otherwise."
(and (= (stat:size (stat file1)) (stat:size (stat file2)))
(call-with-input-file file1
(lambda (port1)
(call-with-input-file file2
(lambda (port2)
(define len 8192)
(define buf1 (make-bytevector len))
(define buf2 (make-bytevector len))
(let loop ()
(let ((n1 (get-bytevector-n! port1 buf1 0 len))
(n2 (get-bytevector-n! port2 buf2 0 len)))
(and (equal? n1 n2)
(or (eof-object? n1)
(loop)))))))))))
"Return #t if FILE1 and FILE2 are regular files and their contents are
identical, #f otherwise."
(let ((st1 (stat file1))
(st2 (stat file2)))
(and (eq? (stat:type st1) 'regular)
(eq? (stat:type st2) 'regular)
(= (stat:size st1) (stat:size st2))
(call-with-input-file file1
(lambda (port1)
(call-with-input-file file2
(lambda (port2)
(define len 8192)
(define buf1 (make-bytevector len))
(define buf2 (make-bytevector len))
(let loop ()
(let ((n1 (get-bytevector-n! port1 buf1 0 len))
(n2 (get-bytevector-n! port2 buf2 0 len)))
(and (equal? n1 n2)
(or (eof-object? n1)
(loop))))))))))))
(define* (union-build output directories
#:key (log-port (current-error-port)))

73
guix/derivations.scm
View File

@ -47,6 +47,7 @@
derivation-output-path
derivation-output-hash-algo
derivation-output-hash
derivation-output-recursive?
<derivation-input>
derivation-input?
@ -91,11 +92,12 @@
(file-name derivation-file-name)) ; the .drv file name
(define-record-type <derivation-output>
(make-derivation-output path hash-algo hash)
(make-derivation-output path hash-algo hash recursive?)
derivation-output?
(path derivation-output-path) ; store path
(hash-algo derivation-output-hash-algo) ; symbol | #f
(hash derivation-output-hash)) ; bytevector | #f
(hash derivation-output-hash) ; bytevector | #f
(recursive? derivation-output-recursive?)) ; Boolean
(define-record-type <derivation-input>
(make-derivation-input path sub-derivations)
@ -241,14 +243,19 @@ that second value is the empty list."
(match output
((name path "" "")
(alist-cons name
(make-derivation-output path #f #f)
(make-derivation-output path #f #f #f)
result))
((name path hash-algo hash)
;; fixed-output
(let ((algo (string->symbol hash-algo))
(hash (base16-string->bytevector hash)))
(let* ((rec? (string-prefix? "r:" hash-algo))
(algo (string->symbol
(if rec?
(string-drop hash-algo 2)
hash-algo)))
(hash (base16-string->bytevector hash)))
(alist-cons name
(make-derivation-output path algo hash)
(make-derivation-output path algo
hash rec?)
result)))))
'()
x))
@ -368,9 +375,12 @@ that form."
(define (write-output output port)
(match output
((name . ($ <derivation-output> path hash-algo hash))
((name . ($ <derivation-output> path hash-algo hash recursive?))
(write-tuple (list name path
(or (and=> hash-algo symbol->string) "")
(if hash-algo
(string-append (if recursive? "r:" "")
(symbol->string hash-algo))
"")
(or (and=> hash bytevector->base16-string)
""))
write
@ -476,11 +486,14 @@ in SIZE bytes."
"Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
(match drv
(($ <derivation> ((_ . ($ <derivation-output> path
(? symbol? hash-algo) (? bytevector? hash)))))
(? symbol? hash-algo) (? bytevector? hash)
(? boolean? recursive?)))))
;; A fixed-output derivation.
(sha256
(string->utf8
(string-append "fixed:out:" (symbol->string hash-algo)
(string-append "fixed:out:"
(if recursive? "r:" "")
(symbol->string hash-algo)
":" (bytevector->base16-string hash)
":" path))))
(($ <derivation> outputs inputs sources
@ -527,17 +540,33 @@ the derivation called NAME with hash HASH."
name
(string-append name "-" output))))
(define (fixed-output-path output hash-algo hash recursive? name)
"Return an output path for the fixed output OUTPUT defined by HASH of type
HASH-ALGO, of the derivation NAME. RECURSIVE? has the same meaning as for
'add-to-store'."
(if (and recursive? (eq? hash-algo 'sha256))
(store-path "source" hash name)
(let ((tag (string-append "fixed:" output ":"
(if recursive? "r:" "")
(symbol->string hash-algo) ":"
(bytevector->base16-string hash) ":")))
(store-path (string-append "output:" output)
(sha256 (string->utf8 tag))
name))))
(define* (derivation store name builder args
#:key
(system (%current-system)) (env-vars '())
(inputs '()) (outputs '("out"))
hash hash-algo hash-mode
hash hash-algo recursive?
references-graphs
local-build?)
"Build a derivation with the given arguments, and return the resulting
<derivation> object. When HASH, HASH-ALGO, and HASH-MODE are given, a
<derivation> object. When HASH and HASH-ALGO are given, a
fixed-output derivation is created---i.e., one whose result is known in
advance, such as a file download.
advance, such as a file download. If, in addition, RECURSIVE? is true, then
that fixed output may be an executable file or a directory and HASH must be
the hash of an archive containing this output.
When REFERENCES-GRAPHS is true, it must be a list of file name/store path
pairs. In that case, the reference graph of each store path is exported in
@ -555,12 +584,16 @@ derivations where the costs of data transfers would outweigh the benefits."
(let* ((drv-hash (derivation-hash drv))
(outputs (map (match-lambda
((output-name . ($ <derivation-output>
_ algo hash))
(let ((path (output-path output-name
drv-hash name)))
_ algo hash rec?))
(let ((path (if hash
(fixed-output-path output-name
algo hash
rec? name)
(output-path output-name
drv-hash name))))
(cons output-name
(make-derivation-output path algo
hash)))))
hash rec?)))))
outputs)))
(make-derivation outputs inputs sources system builder args
(map (match-lambda
@ -618,7 +651,8 @@ derivations where the costs of data transfers would outweigh the benefits."
(let* ((outputs (map (lambda (name)
;; Return outputs with an empty path.
(cons name
(make-derivation-output "" hash-algo hash)))
(make-derivation-output "" hash-algo
hash recursive?)))
outputs))
(inputs (map (match-lambda
(((? derivation? drv))
@ -911,7 +945,7 @@ they can refer to each other."
(system (%current-system))
(inputs '())
(outputs '("out"))
hash hash-algo
hash hash-algo recursive?
(env-vars '())
(modules '())
guile-for-build
@ -1058,6 +1092,7 @@ LOCAL-BUILD?."
env-vars)
#:hash hash #:hash-algo hash-algo
#:recursive? recursive?
#:outputs outputs
#:references-graphs references-graphs
#:local-build? local-build?)))

7
guix/download.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
@ -108,7 +108,10 @@
"ftp://gd.tuwien.ac.at/pub/infosys/servers/http/apache/dist/"
"http://apache.belnet.be/"
"http://mirrors.ircam.fr/pub/apache/"
"http://apache-mirror.rbc.ru/pub/apache/")
"http://apache-mirror.rbc.ru/pub/apache/"
;; As a last resort, try the archive.
"http://archive.apache.org/dist/")
(xorg ; from http://www.x.org/wiki/Releases/Download
"http://www.x.org/releases/" ; main mirrors
"ftp://mirror.csclub.uwaterloo.ca/x.org/" ; North America

89
guix/git-download.scm Normal file
View File

@ -0,0 +1,89 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 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 git-download)
#:use-module (guix records)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (ice-9 match)
#:export (git-reference
git-reference?
git-reference-url
git-reference-commit
git-fetch))
;;; Commentary:
;;;
;;; An <origin> method that fetches a specific commit from a Git repository.
;;; The repository URL and commit hash are specified with a <git-reference>
;;; object.
;;;
;;; Code:
(define-record-type* <git-reference>
git-reference make-git-reference
git-reference?
(url git-reference-url)
(commit git-reference-commit))
(define* (git-fetch store ref hash-algo hash
#:optional name
#:key (system (%current-system)) guile git)
"Return a fixed-output derivation in STORE that fetches REF, a
<git-reference> object. The output is expected to have recursive hash HASH of
type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if
#f."
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages base)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
(define git-for-build
(match git
((? package?)
(package-derivation store git system))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages version-control)))
(git (module-ref distro 'git)))
(package-derivation store git system)))))
(let* ((command (string-append (derivation->output-path git-for-build)
"/bin/git"))
(builder `(begin
(use-modules (guix build git))
(git-fetch ',(git-reference-url ref)
',(git-reference-commit ref)
%output
#:git-command ',command))))
(build-expression->derivation store (or name "git-checkout") builder
#:system system
#:local-build? #t
#:inputs `(("git" ,git-for-build))
#:hash-algo hash-algo
#:hash hash
#:recursive? #t
#:modules '((guix build git)
(guix build utils))
#:guile-for-build guile-for-build)))
;;; git-download.scm ends here

67
guix/monads.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -23,6 +23,7 @@
#:use-module ((system syntax)
#:select (syntax-local-binding))
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:export (;; Monads.
@ -53,11 +54,14 @@
store-lift
run-with-store
text-file
text-file*
package-file
package->derivation
built-derivations
derivation-expression
lower-inputs))
lower-inputs)
#:replace (imported-modules
compiled-modules))
;;; Commentary:
;;;
@ -303,14 +307,63 @@ in the store monad."
(define* (text-file name text)
"Return as a monadic value the absolute file name in the store of the file
containing TEXT."
containing TEXT, a string."
(lambda (store)
(add-text-to-store store name text '())))
(define* (text-file* name #:rest text)
"Return as a monadic value a derivation that builds a text file containing
all of TEXT. TEXT may list, in addition to strings, packages, derivations,
and store file names; the resulting store file holds references to all these."
(define inputs
;; Transform packages and derivations from TEXT into a valid input list.
(filter-map (match-lambda
((? package? p) `("x" ,p))
((? derivation? d) `("x" ,d))
((x ...) `("x" ,@x))
((? string? s)
(and (direct-store-path? s) `("x" ,s)))
(x x))
text))
(define (computed-text text inputs)
;; Using the lowered INPUTS, return TEXT with derivations replaced with
;; their output file name.
(define (real-string? s)
(and (string? s) (not (direct-store-path? s))))
(let loop ((inputs inputs)
(text text)
(result '()))
(match text
(()
(string-concatenate-reverse result))
(((? real-string? head) rest ...)
(loop inputs rest (cons head result)))
((_ rest ...)
(match inputs
(((_ (? derivation? drv) sub-drv ...) inputs ...)
(loop inputs rest
(cons (apply derivation->output-path drv
sub-drv)
result)))
(((_ file) inputs ...)
;; FILE is the result of 'add-text-to-store' or so.
(loop inputs rest (cons file result))))))))
(define (builder inputs)
`(call-with-output-file (assoc-ref %outputs "out")
(lambda (port)
(display ,(computed-text text inputs) port))))
(mlet %store-monad ((inputs (lower-inputs inputs)))
(derivation-expression name (builder inputs)
#:inputs inputs)))
(define* (package-file package
#:optional file
#:key (system (%current-system)) (output "out"))
"Return as a monadic value in the absolute file name of FILE within the
"Return as a monadic value the absolute file name of FILE within the
OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the
OUTPUT directory of PACKAGE."
(lambda (store)
@ -342,6 +395,12 @@ input list as a monadic value."
(define package->derivation
(store-lift package-derivation))
(define imported-modules
(store-lift (@ (guix derivations) imported-modules)))
(define compiled-modules
(store-lift (@ (guix derivations) compiled-modules)))
(define built-derivations
(store-lift build-derivations))

16
guix/nar.scm
View File

@ -112,7 +112,8 @@
(write-long-long size p)
(call-with-binary-input-file file
;; Use `sendfile' when available (Guile 2.0.8+).
(if (compile-time-value (defined? 'sendfile))
(if (and (compile-time-value (defined? 'sendfile))
(file-port? p))
(cut sendfile p <> size 0)
(cut dump <> p size)))
(write-padding size p))
@ -176,8 +177,13 @@ sub-directories of FILE as needed."
((directory)
(write-string "type" p)
(write-string "directory" p)
(let ((entries (remove (cut member <> '("." ".."))
(scandir f))))
(let* ((select? (negate (cut member <> '("." ".."))))
;; 'scandir' defaults to 'string-locale<?' to sort files, but
;; this happens to be case-insensitive (at least in 'en_US'
;; locale on libc 2.18.) Conversely, we want files to be
;; sorted in a case-sensitive fashion.
(entries (scandir f select? string<?)))
(for-each (lambda (e)
(let ((f (string-append f "/" e)))
(write-string "entry" p)
@ -194,8 +200,8 @@ sub-directories of FILE as needed."
(write-string "target" p)
(write-string (readlink f) p))
(else
(raise (condition (&message (message "ENOSYS"))
(&nar-error)))))
(raise (condition (&message (message "unsupported file type"))
(&nar-error (file f) (port port))))))
(write-string ")" p))))
(define (restore-file port file)

4
guix/packages.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -106,7 +106,7 @@
origin make-origin
origin?
(uri origin-uri) ; string
(method origin-method) ; symbol
(method origin-method) ; procedure
(sha256 origin-sha256) ; bytevector
(file-name origin-file-name (default #f)) ; optional file name
(patches origin-patches (default '())) ; list of file names

147
guix/scripts/archive.scm
View File

@ -71,17 +71,10 @@ Export/import one or more packages from/to the store.\n"))
-s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\""))
(display (_ "
--target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
(display (_ "
-n, --dry-run do not build the derivations"))
(display (_ "
--fallback fall back to building when the substituter fails"))
(display (_ "
--no-substitutes build instead of resorting to pre-built substitutes"))
(display (_ "
--max-silent-time=SECONDS
mark the build as failed after SECONDS of silence"))
(display (_ "
-c, --cores=N allow the use of up to N CPU cores for the build"))
(newline)
(show-build-options-help)
(newline)
(display (_ "
-h, --help display this help and exit"))
@ -92,81 +85,60 @@ Export/import one or more packages from/to the store.\n"))
(define %options
;; Specifications of the command-line options.
(list (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix build")))
(cons* (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix build")))
(option '("export") #f #f
(lambda (opt name arg result)
(alist-cons 'export #t result)))
(option '("import") #f #f
(lambda (opt name arg result)
(alist-cons 'import #t result)))
(option '("missing") #f #f
(lambda (opt name arg result)
(alist-cons 'missing #t result)))
(option '("generate-key") #f #t
(lambda (opt name arg result)
(catch 'gcry-error
(lambda ()
(let ((params
(string->canonical-sexp
(or arg "(genkey (rsa (nbits 4:4096)))"))))
(alist-cons 'generate-key params result)))
(lambda args
(leave (_ "invalid key generation parameters: ~s~%")
arg)))))
(option '("authorize") #f #f
(lambda (opt name arg result)
(alist-cons 'authorize #t result)))
(option '("export") #f #f
(lambda (opt name arg result)
(alist-cons 'export #t result)))
(option '("import") #f #f
(lambda (opt name arg result)
(alist-cons 'import #t result)))
(option '("missing") #f #f
(lambda (opt name arg result)
(alist-cons 'missing #t result)))
(option '("generate-key") #f #t
(lambda (opt name arg result)
(catch 'gcry-error
(lambda ()
(let ((params
(string->canonical-sexp
(or arg "(genkey (rsa (nbits 4:4096)))"))))
(alist-cons 'generate-key params result)))
(lambda args
(leave (_ "invalid key generation parameters: ~s~%")
arg)))))
(option '("authorize") #f #f
(lambda (opt name arg result)
(alist-cons 'authorize #t result)))
(option '(#\S "source") #f #f
(lambda (opt name arg result)
(alist-cons 'source? #t result)))
(option '(#\s "system") #t #f
(lambda (opt name arg result)
(alist-cons 'system arg
(alist-delete 'system result eq?))))
(option '("target") #t #f
(lambda (opt name arg result)
(alist-cons 'target arg
(alist-delete 'target result eq?))))
(option '(#\e "expression") #t #f
(lambda (opt name arg result)
(alist-cons 'expression arg result)))
(option '(#\c "cores") #t #f
(lambda (opt name arg result)
(let ((c (false-if-exception (string->number arg))))
(if c
(alist-cons 'cores c result)
(leave (_ "~a: not a number~%") arg)))))
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t result)))
(option '("fallback") #f #f
(lambda (opt name arg result)
(alist-cons 'fallback? #t
(alist-delete 'fallback? result))))
(option '("no-substitutes") #f #f
(lambda (opt name arg result)
(alist-cons 'substitutes? #f
(alist-delete 'substitutes? result))))
(option '("max-silent-time") #t #f
(lambda (opt name arg result)
(alist-cons 'max-silent-time (string->number* arg)
result)))
(option '(#\r "root") #t #f
(lambda (opt name arg result)
(alist-cons 'gc-root arg result)))
(option '("verbosity") #t #f
(lambda (opt name arg result)
(let ((level (string->number arg)))
(alist-cons 'verbosity level
(alist-delete 'verbosity result)))))))
(option '(#\S "source") #f #f
(lambda (opt name arg result)
(alist-cons 'source? #t result)))
(option '(#\s "system") #t #f
(lambda (opt name arg result)
(alist-cons 'system arg
(alist-delete 'system result eq?))))
(option '("target") #t #f
(lambda (opt name arg result)
(alist-cons 'target arg
(alist-delete 'target result eq?))))
(option '(#\e "expression") #t #f
(lambda (opt name arg result)
(alist-cons 'expression arg result)))
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t result)))
(option '(#\r "root") #t #f
(lambda (opt name arg result)
(alist-cons 'gc-root arg result)))
%standard-build-options))
(define (options->derivations+files store opts)
"Given OPTS, the result of 'args-fold', return a list of derivations to
@ -219,16 +191,11 @@ build and a list of store files to transfer."
resulting archive to the standard output port."
(let-values (((drv files)
(options->derivations+files store opts)))
(set-build-options-from-command-line store opts)
(show-what-to-build store drv
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:dry-run? (assoc-ref opts 'dry-run?))
(set-build-options store
#:build-cores (or (assoc-ref opts 'cores) 0)
#:fallback? (assoc-ref opts 'fallback?)
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:max-silent-time (assoc-ref opts 'max-silent-time))
(if (or (assoc-ref opts 'dry-run?)
(build-derivations store drv))
(export-paths store files (current-output-port))

206
guix/scripts/build.scm
View File

@ -34,6 +34,11 @@
#:use-module (srfi srfi-37)
#:autoload (gnu packages) (find-best-packages-by-name)
#:export (derivation-from-expression
%standard-build-options
set-build-options-from-command-line
show-build-options-help
guix-build))
(define (derivation-from-expression store str package-derivation
@ -99,6 +104,79 @@ present, return the preferred newest version."
(leave (_ "failed to create GC root `~a': ~a~%")
root (strerror (system-error-errno args)))))))
;;;
;;; Standard command-line build options.
;;;
(define (show-build-options-help)
"Display on the current output port help about the standard command-line
options handled by 'set-build-options-from-command-line', and listed in
'%standard-build-options'."
(display (_ "
-K, --keep-failed keep build tree of failed builds"))
(display (_ "
-n, --dry-run do not build the derivations"))
(display (_ "
--fallback fall back to building when the substituter fails"))
(display (_ "
--no-substitutes build instead of resorting to pre-built substitutes"))
(display (_ "
--no-build-hook do not attempt to offload builds via the build hook"))
(display (_ "
--max-silent-time=SECONDS
mark the build as failed after SECONDS of silence"))
(display (_ "
--verbosity=LEVEL use the given verbosity LEVEL"))
(display (_ "
-c, --cores=N allow the use of up to N CPU cores for the build")))
(define (set-build-options-from-command-line store opts)
"Given OPTS, an alist as returned by 'args-fold' given
'%standard-build-options', set the corresponding build options on STORE."
;; TODO: Add more options.
(set-build-options store
#:keep-failed? (assoc-ref opts 'keep-failed?)
#:build-cores (or (assoc-ref opts 'cores) 0)
#:fallback? (assoc-ref opts 'fallback?)
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:use-build-hook? (assoc-ref opts 'build-hook?)
#:max-silent-time (assoc-ref opts 'max-silent-time)
#:verbosity (assoc-ref opts 'verbosity)))
(define %standard-build-options
;; List of standard command-line options for tools that build something.
(list (option '(#\K "keep-failed") #f #f
(lambda (opt name arg result)
(alist-cons 'keep-failed? #t result)))
(option '("fallback") #f #f
(lambda (opt name arg result)
(alist-cons 'fallback? #t
(alist-delete 'fallback? result))))
(option '("no-substitutes") #f #f
(lambda (opt name arg result)
(alist-cons 'substitutes? #f
(alist-delete 'substitutes? result))))
(option '("no-build-hook") #f #f
(lambda (opt name arg result)
(alist-cons 'build-hook? #f
(alist-delete 'build-hook? result))))
(option '("max-silent-time") #t #f
(lambda (opt name arg result)
(alist-cons 'max-silent-time (string->number* arg)
result)))
(option '("verbosity") #t #f
(lambda (opt name arg result)
(let ((level (string->number arg)))
(alist-cons 'verbosity level
(alist-delete 'verbosity result)))))
(option '(#\c "cores") #t #f
(lambda (opt name arg result)
(let ((c (false-if-exception (string->number arg))))
(if c
(alist-cons 'cores c result)
(leave (_ "~a: not a number~%") arg)))))))
;;;
;;; Command-line options.
@ -126,28 +204,13 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(display (_ "
-d, --derivations return the derivation paths of the given packages"))
(display (_ "
-K, --keep-failed keep build tree of failed builds"))
(display (_ "
-n, --dry-run do not build the derivations"))
(display (_ "
--fallback fall back to building when the substituter fails"))
(display (_ "
--no-substitutes build instead of resorting to pre-built substitutes"))
(display (_ "
--no-build-hook do not attempt to offload builds via the build hook"))
(display (_ "
--max-silent-time=SECONDS
mark the build as failed after SECONDS of silence"))
(display (_ "
-c, --cores=N allow the use of up to N CPU cores for the build"))
(display (_ "
-r, --root=FILE make FILE a symlink to the result, and register it
as a garbage collector root"))
(display (_ "
--verbosity=LEVEL use the given verbosity LEVEL"))
(display (_ "
--log-file return the log file names for the given derivations"))
(newline)
(show-build-options-help)
(newline)
(display (_ "
-h, --help display this help and exit"))
(display (_ "
@ -157,70 +220,42 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(define %options
;; Specifications of the command-line options.
(list (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix build")))
(cons* (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix build")))
(option '(#\S "source") #f #f
(lambda (opt name arg result)
(alist-cons 'source? #t result)))
(option '(#\s "system") #t #f
(lambda (opt name arg result)
(alist-cons 'system arg
(alist-delete 'system result eq?))))
(option '("target") #t #f
(lambda (opt name arg result)
(alist-cons 'target arg
(alist-delete 'target result eq?))))
(option '(#\d "derivations") #f #f
(lambda (opt name arg result)
(alist-cons 'derivations-only? #t result)))
(option '(#\e "expression") #t #f
(lambda (opt name arg result)
(alist-cons 'expression arg result)))
(option '(#\K "keep-failed") #f #f
(lambda (opt name arg result)
(alist-cons 'keep-failed? #t result)))
(option '(#\c "cores") #t #f
(lambda (opt name arg result)
(let ((c (false-if-exception (string->number arg))))
(if c
(alist-cons 'cores c result)
(leave (_ "~a: not a number~%") arg)))))
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t result)))
(option '("fallback") #f #f
(lambda (opt name arg result)
(alist-cons 'fallback? #t
(alist-delete 'fallback? result))))
(option '("no-substitutes") #f #f
(lambda (opt name arg result)
(alist-cons 'substitutes? #f
(alist-delete 'substitutes? result))))
(option '("no-build-hook") #f #f
(lambda (opt name arg result)
(alist-cons 'build-hook? #f
(alist-delete 'build-hook? result))))
(option '("max-silent-time") #t #f
(lambda (opt name arg result)
(alist-cons 'max-silent-time (string->number* arg)
result)))
(option '(#\r "root") #t #f
(lambda (opt name arg result)
(alist-cons 'gc-root arg result)))
(option '("verbosity") #t #f
(lambda (opt name arg result)
(let ((level (string->number arg)))
(alist-cons 'verbosity level
(alist-delete 'verbosity result)))))
(option '("log-file") #f #f
(lambda (opt name arg result)
(alist-cons 'log-file? #t result)))))
(option '(#\S "source") #f #f
(lambda (opt name arg result)
(alist-cons 'source? #t result)))
(option '(#\s "system") #t #f
(lambda (opt name arg result)
(alist-cons 'system arg
(alist-delete 'system result eq?))))
(option '("target") #t #f
(lambda (opt name arg result)
(alist-cons 'target arg
(alist-delete 'target result eq?))))
(option '(#\d "derivations") #f #f
(lambda (opt name arg result)
(alist-cons 'derivations-only? #t result)))
(option '(#\e "expression") #t #f
(lambda (opt name arg result)
(alist-cons 'expression arg result)))
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t result)))
(option '(#\r "root") #t #f
(lambda (opt name arg result)
(alist-cons 'gc-root arg result)))
(option '("log-file") #f #f
(lambda (opt name arg result)
(alist-cons 'log-file? #t result)))
%standard-build-options))
(define (options->derivations store opts)
"Given OPTS, the result of 'args-fold', return a list of derivations to
@ -279,21 +314,12 @@ build."
(_ #f))
opts)))
(set-build-options-from-command-line store opts)
(unless (assoc-ref opts 'log-file?)
(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
#:keep-failed? (assoc-ref opts 'keep-failed?)
#:build-cores (or (assoc-ref opts 'cores) 0)
#:fallback? (assoc-ref opts 'fallback?)
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:use-build-hook? (assoc-ref opts 'build-hook?)
#:max-silent-time (assoc-ref opts 'max-silent-time)
#:verbosity (assoc-ref opts 'verbosity))
(cond ((assoc-ref opts 'log-file?)
(for-each (lambda (file)
(let ((log (log-file store file)))

33
guix/scripts/hash.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;;
;;; This file is part of GNU Guix.
@ -20,12 +20,14 @@
(define-module (guix scripts hash)
#:use-module (guix base32)
#:use-module (guix hash)
#:use-module (guix nar)
#: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-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:export (guix-hash))
@ -43,10 +45,12 @@
(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"))
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"))
(format #t (_ "
-r, --recursive compute the hash on FILE recursively"))
(newline)
(display (_ "
-h, --help display this help and exit"))
@ -73,6 +77,9 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
(alist-cons 'format fmt-proc
(alist-delete 'format result))))
(option '(#\r "recursive") #f #f
(lambda (opt name arg result)
(alist-cons 'recursive? #t result)))
(option '(#\h "help") #f #f
(lambda args
@ -99,11 +106,6 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
(alist-cons 'argument arg result))
%default-options))
(define (eof->null x)
(if (eof-object? x)
#vu8()
x))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
(('argument . value)
@ -112,13 +114,22 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
(reverse opts)))
(fmt (assq-ref opts 'format)))
(define (file-hash file)
;; Compute the hash of FILE.
;; Catch and gracefully report possible '&nar-error' conditions.
(with-error-handling
(if (assoc-ref opts 'recursive?)
(let-values (((port get-hash) (open-sha256-port)))
(write-file file port)
(flush-output-port port)
(get-hash))
(call-with-input-file file port-sha256))))
(match args
((file)
(catch 'system-error
(lambda ()
(format #t "~a~%"
(call-with-input-file file
(compose fmt sha256 eof->null get-bytevector-all))))
(format #t "~a~%" (fmt (file-hash file))))
(lambda args
(leave (_ "~a~%")
(strerror (system-error-errno args))))))

51
guix/scripts/offload.scm
View File

@ -108,7 +108,7 @@ determined."
(save-module-excursion
(lambda ()
(set-current-module %user-module)
(primitive-load %machine-file))))
(primitive-load file))))
(lambda args
(match args
(('system-error . _)
@ -117,10 +117,10 @@ determined."
(if (= ENOENT err)
'()
(leave (_ "failed to open machine file '~a': ~a~%")
%machine-file (strerror err)))))
file (strerror err)))))
(_
(leave (_ "failed to load machine file '~a': ~s~%")
%machine-file args))))))
file args))))))
(define (open-ssh-gateway machine)
"Initiate an SSH connection gateway to MACHINE, and return the PID of the
@ -170,9 +170,9 @@ running lsh gateway upon success, or #f on failure."
(define* (offload drv machine
#:key print-build-trace? (max-silent-time 3600)
(build-timeout 7200))
(build-timeout 7200) (log-port (current-output-port)))
"Perform DRV on MACHINE, assuming DRV and its prerequisites are available
there. Return a read pipe from where to read the build log."
there, and write the build log to LOG-PORT. Return the exit status."
(format (current-error-port) "offloading '~a' to '~a'...~%"
(derivation-file-name drv) (build-machine-name machine))
(format (current-error-port) "@ build-remote ~a ~a~%"
@ -185,7 +185,13 @@ there. Return a read pipe from where to read the build log."
,(format #f "--max-silent-time=~a"
max-silent-time)
,(derivation-file-name drv)))))
pipe))
(let loop ((line (read-line pipe)))
(unless (eof-object? line)
(display line log-port)
(newline log-port)
(loop (read-line pipe))))
(close-pipe pipe)))
(define (send-files files machine)
"Send the subset of FILES that's missing to MACHINE's store. Return #t on
@ -291,20 +297,25 @@ success, #f otherwise."
(outputs (string-tokenize (read-line))))
(when (send-files (cons (derivation-file-name drv) inputs)
machine)
(let ((log (offload drv machine
#:print-build-trace? print-build-trace?
#:max-silent-time max-silent-time
#:build-timeout build-timeout)))
(let loop ((line (read-line log)))
(if (eof-object? line)
(close-pipe log)
(begin
(display line) (newline)
(loop (read-line log))))))
(retrieve-files outputs machine)))
(format (current-error-port) "done with offloaded '~a'~%"
(derivation-file-name drv))
(kill pid SIGTERM))
(let ((status (offload drv machine
#:print-build-trace? print-build-trace?
#:max-silent-time max-silent-time
#:build-timeout build-timeout)))
(kill pid SIGTERM)
(if (zero? status)
(begin
(retrieve-files outputs machine)
(format (current-error-port)
"done with offloaded '~a'~%"
(derivation-file-name drv)))
(begin
(format (current-error-port)
"derivation '~a' offloaded to '~a' failed \
with exit code ~a~%"
(derivation-file-name drv)
(build-machine-name machine)
(status:exit-val status))
(primitive-exit (status:exit-val status))))))))
(#f
(display "# decline\n")))
(display "# decline\n"))))

148
guix/scripts/system.scm Normal file
View File

@ -0,0 +1,148 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 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 system)
#:use-module (guix ui)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (guix monads)
#:use-module (guix scripts build)
#:use-module (gnu system vm)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:export (guix-system))
(define %user-module
;; Module in which the machine description file is loaded.
(let ((module (make-fresh-user-module)))
(for-each (lambda (iface)
(module-use! module (resolve-interface iface)))
'((gnu system)
(gnu services)
(gnu system shadow)))
module))
(define (read-operating-system file)
"Read the operating-system declaration from FILE and return it."
;; TODO: Factorize.
(catch #t
(lambda ()
;; Avoid ABI incompatibility with the <operating-system> record.
(set! %fresh-auto-compile #t)
(save-module-excursion
(lambda ()
(set-current-module %user-module)
(primitive-load file))))
(lambda args
(match args
(('system-error . _)
(let ((err (system-error-errno args)))
(leave (_ "failed to open operating system file '~a': ~a~%")
file (strerror err))))
(_
(leave (_ "failed to load machine file '~a': ~s~%")
file args))))))
;;;
;;; Options.
;;;
(define (show-help)
(display (_ "Usage: guix system [OPTION] ACTION FILE
Build the operating system declared in FILE according to ACTION.\n"))
(display (_ "Currently the only valid value for ACTION is 'vm', which builds
a virtual machine of the given operating system.\n"))
(show-build-options-help)
(newline)
(display (_ "
-h, --help display this help and exit"))
(display (_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(define %options
;; Specifications of the command-line options.
(cons* (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix system")))
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t result)))
%standard-build-options))
(define %default-options
;; Alist of default option values.
`((system . ,(%current-system))
(substitutes? . #t)
(build-hook? . #t)
(max-silent-time . 3600)
(verbosity . 0)))
;;;
;;; Entry point.
;;;
(define (guix-system . 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)
(if (assoc-ref result 'action)
(let ((previous (assoc-ref result 'argument)))
(if previous
(leave (_ "~a: extraneous argument~%") previous)
(alist-cons 'argument arg result)))
(let ((action (string->symbol arg)))
(case action
((vm) (alist-cons 'action action result))
(else (leave (_ "~a: unknown action~%")
action))))))
%default-options))
(with-error-handling
(let* ((opts (parse-options))
(file (assoc-ref opts 'argument))
(os (if file
(read-operating-system file)
(leave (_ "no configuration file specified~%"))))
(mdrv (system-qemu-image/shared-store-script os))
(store (open-connection))
(dry? (assoc-ref opts 'dry-run?))
(drv (run-with-store store mdrv)))
(set-build-options-from-command-line store opts)
(show-what-to-build store (list drv)
#:dry-run? dry?
#:use-substitutes? (assoc-ref opts 'substitutes?))
(unless dry?
(build-derivations store (list drv))
(display (derivation->output-path drv))
(newline)))))

10
guix/store.scm
View File

@ -100,8 +100,8 @@
(define %protocol-version #x10c)
(define %worker-magic-1 #x6e697863)
(define %worker-magic-2 #x6478696f)
(define %worker-magic-1 #x6e697863) ; "nixc"
(define %worker-magic-2 #x6478696f) ; "dxio"
(define (protocol-major magic)
(logand magic #xff00))
@ -732,10 +732,10 @@ is raised if the set of paths read from PORT is not signed (as per
(= 1 (read-int s))))
(define* (export-paths server paths port #:key (sign? #t))
"Export the store paths listed in PATHS to PORT, signing them if SIGN?
is true."
"Export the store paths listed in PATHS to PORT, in topological order,
signing them if SIGN? is true."
(let ((s (nix-server-socket server)))
(let loop ((paths paths))
(let loop ((paths (topologically-sorted server paths)))
(match paths
(()
(write-int 0 port))

6
guix/ui.scm
View File

@ -31,6 +31,7 @@
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:autoload (ice-9 ftw) (scandir)
#:use-module (ice-9 match)
@ -186,7 +187,10 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
((nix-protocol-error? c)
;; FIXME: Server-provided error messages aren't i18n'd.
(leave (_ "build failed: ~a~%")
(nix-protocol-error-message c))))
(nix-protocol-error-message c)))
((message-condition? c)
;; Normally '&message' error conditions have an i18n'd message.
(leave (_ "~a~%") (gettext (condition-message c)))))
;; Catch EPIPE and the likes.
(catch 'system-error
thunk

33
nix/nix-daemon/guix-daemon.cc
View File

@ -30,6 +30,7 @@
#include <unistd.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <strings.h>
#include <exception>
/* Variables used by `nix-daemon.cc'. */
@ -68,6 +69,8 @@ builds derivations on behalf of its clients.";
#define GUIX_OPT_LISTEN 11
#define GUIX_OPT_NO_SUBSTITUTES 12
#define GUIX_OPT_NO_BUILD_HOOK 13
#define GUIX_OPT_GC_KEEP_OUTPUTS 14
#define GUIX_OPT_GC_KEEP_DERIVATIONS 15
static const struct argp_option options[] =
{
@ -111,6 +114,14 @@ static const struct argp_option options[] =
" (this option has no effect in this configuration)"
#endif
},
{ "gc-keep-outputs", GUIX_OPT_GC_KEEP_OUTPUTS,
"yes/no", OPTION_ARG_OPTIONAL,
"Tell whether the GC must keep outputs of live derivations" },
{ "gc-keep-derivations", GUIX_OPT_GC_KEEP_DERIVATIONS,
"yes/no", OPTION_ARG_OPTIONAL,
"Tell whether the GC must keep derivations corresponding \
to live outputs" },
{ "listen", GUIX_OPT_LISTEN, "SOCKET", 0,
"Listen for connections on SOCKET" },
{ "debug", GUIX_OPT_DEBUG, 0, 0,
@ -118,6 +129,22 @@ static const struct argp_option options[] =
{ 0, 0, 0, 0, 0 }
};
/* Convert ARG to a Boolean value, or throw an error if it does not denote a
Boolean. */
static bool
string_to_bool (const char *arg, bool dflt = true)
{
if (arg == NULL)
return dflt;
else if (strcasecmp (arg, "yes") == 0)
return true;
else if (strcasecmp (arg, "no") == 0)
return false;
else
throw nix::Error (format ("'%1%': invalid Boolean value") % arg);
}
/* Parse a single option. */
static error_t
parse_opt (int key, char *arg, struct argp_state *state)
@ -168,6 +195,12 @@ parse_opt (int key, char *arg, struct argp_state *state)
case GUIX_OPT_DEBUG:
verbosity = lvlDebug;
break;
case GUIX_OPT_GC_KEEP_OUTPUTS:
settings.gcKeepOutputs = string_to_bool (arg);
break;
case GUIX_OPT_GC_KEEP_DERIVATIONS:
settings.gcKeepDerivations = string_to_bool (arg);
break;
case 'c':
settings.buildCores = atoi (arg);
break;

2
po/Makevars
View File

@ -6,7 +6,7 @@ subdir = po
top_builddir = ..
# These options get passed to xgettext. We want to catch standard
# gettext uses, package synopses and descriptions, and SRFI-34 error
# gettext uses, package synopses and descriptions, and SRFI-35 error
# condition messages.
XGETTEXT_OPTIONS = \
--language=Scheme --from-code=UTF-8 \

1
po/POTFILES.in
View File

@ -12,6 +12,7 @@ guix/scripts/hash.scm
guix/scripts/pull.scm
guix/scripts/substitute-binary.scm
guix/scripts/authenticate.scm
guix/scripts/system.scm
guix/gnu-maintenance.scm
guix/ui.scm
guix/http-client.scm

5
pre-inst-env.in
View File

@ -45,7 +45,10 @@ NIX_ROOT_FINDER="$abs_top_builddir/nix/scripts/list-runtime-roots"
NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary"
NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper"
NIX_BUILD_HOOK="$abs_top_builddir/nix/scripts/offload"
export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS NIX_BUILD_HOOK
NIX_LIBEXEC_DIR="@abs_top_builddir@/nix/scripts" # for 'guix-authenticate'
export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS \
NIX_BUILD_HOOK NIX_LIBEXEC_DIR
# The 'guix-register' program.
GUIX_REGISTER="$abs_top_builddir/guix-register"

Some files were not shown because too many files have changed in this diff Show More