diff options
| author | Mark H Weaver <mhw@netris.org> | 2015-06-10 17:50:27 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2015-06-10 17:50:27 -0400 |
| commit | 14928016556300a6763334d4279c3d117902caaf (patch) | |
| tree | d0dc262b14164b82f97dd6e896ca9e93a1fabeea | |
| parent | 1511e0235525358abb52cf62abeb9457605b5093 (diff) | |
| parent | 57cd353d87d6e9e6e882327be70b4d7b5ce863ba (diff) | |
| download | patches-14928016556300a6763334d4279c3d117902caaf.tar patches-14928016556300a6763334d4279c3d117902caaf.tar.gz | |
Merge branch 'master' into core-updates
246 files changed, 13195 insertions, 3935 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index 7aef853625..cbcb120edf 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -13,7 +13,9 @@ . ((indent-tabs-mode . nil) (eval . (put 'eval-when 'scheme-indent-function 1)) + (eval . (put 'call-with-prompt 'scheme-indent-function 1)) (eval . (put 'test-assert 'scheme-indent-function 1)) + (eval . (put 'test-assertm 'scheme-indent-function 1)) (eval . (put 'test-equal 'scheme-indent-function 1)) (eval . (put 'test-eq 'scheme-indent-function 1)) (eval . (put 'call-with-input-string 'scheme-indent-function 1)) @@ -44,7 +46,7 @@ (eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1)) (eval . (put 'emacs-substitute-variables 'scheme-indent-function 1)) (eval . (put 'with-derivation-narinfo 'scheme-indent-function 1)) - (eval . (put 'with-derivation-substitute 'scheme-indent-function 1)) + (eval . (put 'with-derivation-substitute 'scheme-indent-function 2)) (eval . (put 'syntax-parameterize 'scheme-indent-function 1)) (eval . (put 'with-monad 'scheme-indent-function 1)) diff --git a/.gitignore b/.gitignore index eaa7dbd51a..a0f19d7612 100644 --- a/.gitignore +++ b/.gitignore @@ -62,6 +62,7 @@ config.cache /pre-inst-env /doc/.dirstamp /doc/guix.info +/doc/guix.info-[0-9] /doc/guix.pdf /doc/stamp-vti /doc/version.texi @@ -112,3 +113,6 @@ GTAGS /emacs/guix-helper.scm /emacs/guix-init.el /emacs/guix-profiles.el +/doc/os-config-bare-bones.texi +/doc/os-config-desktop.texi +/doc/*.1 @@ -2,7 +2,7 @@ #+TITLE: Hacking GNU Guix and Its Incredible Distro -Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> Copyright © 2014 Pierre-Antoine Rault <par@rigelk.eu> @@ -20,6 +20,7 @@ addition to those mentioned in the installation instructions: - [[http://www.gnu.org/software/automake/][GNU Automake]] - [[http://www.gnu.org/software/gettext/][GNU Gettext]] - [[http://www.graphviz.org/][Graphviz]] + - [[http://www.gnu.org/software/help2man/][GNU Help2man]] (optional) Run ‘./bootstrap’ to download the Nix daemon source code and to generate the build system infrastructure using autoconf. It reports an error if an @@ -46,17 +47,7 @@ take a look at “info '(guix) Installation'” or send a message to * Running Guix before it is installed -Command-line tools can be used even if you have not run "make install". -To do that, prefix each command with ‘./pre-inst-env’, as in: - - ./pre-inst-env guix build --help - -Similarly, for a Guile session using the Guix modules: - - ./pre-inst-env guile -c '(use-modules (guix utils)) (pk (%current-system))' - -The ‘pre-inst-env’ script sets up all the environment variables -necessary to support this. +See the same-named section in the manual. * The Perfect Setup diff --git a/Makefile.am b/Makefile.am index aa412bda2b..2b84467b0c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -79,6 +79,7 @@ MODULES = \ guix/build/store-copy.scm \ guix/build/utils.scm \ guix/build/union.scm \ + guix/build/profiles.scm \ guix/build/pull.scm \ guix/build/rpath.scm \ guix/build/cvs.scm \ @@ -87,10 +88,13 @@ MODULES = \ guix/build/gremlin.scm \ guix/build/emacs-utils.scm \ guix/build/graft.scm \ + guix/search-paths.scm \ guix/packages.scm \ guix/import/utils.scm \ guix/import/gnu.scm \ guix/import/snix.scm \ + guix/import/cabal.scm \ + guix/import/hackage.scm \ guix/scripts/download.scm \ guix/scripts/build.scm \ guix/scripts/archive.scm \ @@ -106,6 +110,7 @@ MODULES = \ guix/scripts/lint.scm \ guix/scripts/import/gnu.scm \ guix/scripts/import/nix.scm \ + guix/scripts/import/hackage.scm \ guix/scripts/environment.scm \ guix/scripts/publish.scm \ guix.scm \ @@ -133,7 +138,8 @@ KCONFIGS = \ # Templates, examples. EXAMPLES = \ - gnu/system/os-config.tmpl + gnu/system/examples/bare-bones.tmpl \ + gnu/system/examples/desktop.tmpl GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go guix/tests.go @@ -175,6 +181,7 @@ SCM_TESTS = \ tests/build-utils.scm \ tests/packages.scm \ tests/snix.scm \ + tests/hackage.scm \ tests/store.scm \ tests/monads.scm \ tests/gexp.scm \ @@ -10,6 +10,378 @@ Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> Please send Guix bug reports to bug-guix@gnu.org. +* Changes in 0.8.2 (since 0.8.1) + +** Package management + +*** New “binary tarball” installation method is available + +See “Binary Installation” in the manual. + +*** New ‘guix publish’ command, to publish one’s store + +See “Invoking guix publish” in the manual. + +*** ‘guix package’ runs “profile creation hooks” as needed + +It creates X.509 certificate bundles in the profile’s etc/ssl directory, if +needed, generates a package database cache for GHC if the profile includes GHC +(the Haskell compiler), and generates an Info ‘dir’ file (this part was +already done before.) + +*** ‘guix package’ creates an ‘etc/profile’ file in the profile + +See “Invoking guix package” in the manual. + +*** Commands understand version prefixes, such as ‘gcc-5’ for ‘gcc-5.1.0’ + +*** ‘guix package --search’ now sorts packages by name and version + +*** Substitute information is now fetched using HTTP pipelining + +Before that the “substituter” used threads. Using HTTP pipelining means that +resource consumption is reduced on both the client and server sides. As a +side effect, a progress report is displayed as substitute info is downloaded. + +*** ‘guix package’ warns when a $GUIX_PACKAGE_PATH module cannot be loaded + +*** New ‘--sources’ option to ‘guix build’ + +*** New Bash completion file, installed in $sysconfdir/bash_completion.d + +*** New ‘guix import hackage’ command + +See “Invoking guix import” in the manual. + +*** ‘guix lint’ supports FTP for the ‘source’ and ‘home-page’ checkers + +*** ‘guix lint’ has a new ‘derivation’ checker + +*** ‘guix import cpan’ better handles dependencies and licenses + +*** Packages are now build in an environment with a UTF-8 locale + +** Distribution + +*** C library's name service switch (NSS) is now fully configurable + +See “Name Service Switch” in the manual. + +*** New services: wicd, lirc, colord, upower, console-keymap, postgresql + +*** Xorg service supports new drivers, such as Nouveau + +*** lsh service has new options, initializes its seed by default + +*** /etc/ssl symlink is created, for X.509 certificates + +See “X.509 Certificates” in the manual. + +*** ‘guix system’ reports duplicate service identifiers + +*** New /etc/bashrc file that loads Bash completion when available + +*** SLiM service uses sessions from /run/current-system/profile/share/xsessions + +See “X Window” in the manual. + +*** The Linux “YAMA” restricting policy on PTRACE_ATTACH is now disabled + +*** /etc/shells now lists all the user accounts’ shells + +*** /gnu/store is now remounted read-only, to avoid accidental modification + +*** /etc/profile is sources each profile’s ‘etc/profile’ file + +*** 718 new packages + +aalib, aarddict, acpid, agg, aisleriot, alsa-modular-synth, ant, ardour, +ardour, argtable, arpack-ng, aspell-dict-ru, aubio, audacity, avidemux, +avidemux, azr3, bamtools, bash-completion, bedops, bind-utils, bluez, bool, +brdf-explorer, bwa, calf, calibre, catch, ccl, chibi-scheme, chmlib, +clalsadrv, clipper, clisp, clustal-omega, colord, colordiff, cpufrequtils, +crossmap, csound, ctl, cunit, cutadapt, desktop-file-utils, djvulibre, +dnsmasq, dosfstools, double-conversion, dovecot, ecl, efl, elementary, +elogind, emacs-no-x, emotion-generic-players, enca, enlightenment, +evas-generic-loaders, exim, express, extremetuxracer, faad2, fastx-toolkit, +fcitx, fdupes, flexbar, fluidsynth, font-adobe-source-han-sans, +font-wqy-zenhei, freepats, gambit-c, ganv, geda-gaf, geoclue, geocode-glib, +ghc, ghc-case-insensitive, ghc-containers, ghc-fgl, ghc-hashable, ghc-http, +ghc-hunit, ghc-mtl, ghc-network, ghc-network-uri, ghc-parallel, ghc-parsec, +ghc-paths, ghc-primitive, ghc-quickcheck, ghc-random, ghc-split, ghc-stm, +ghc-syb, ghc-text, ghc-tf-random, ghc-unordered-containers, ghc-vector, +ghc-zlib, girara, gitolite, glib-networking, glibc-locales, +glibc-utf8-locales, glibc-utf8-locales, glm, gnome-mines, +gnome-settings-daemon, gnome-terminal, gnucash, gnugo, grit, gst-libav, +guile-minikanren, guile-reader, hdparm, hisat, htseq, htsjdk, hunspell, +hyphen, i2c-tools, ibus, icecast, icedtea6, icedtea7, ilmbase, ir, isync, +ixion, jack2, jalv, jansson, jemalloc, julia, key-mon, ladspa, lash, +leptonica, liba52, libabw, libaio, libass, libavc1394, libbluray, libbs2b, +libcaca, libcap-ng, libcdio-paranoia, libcdr, libdca, libdv, libdvdcss, +libe-book, libedit, libepoxy, libetonyek, libexttextcat, libffcall, +libfreehand, libgnomecanvasmm, libgtextutils, libgweather, libical, +libiec61883, libinput, liblo, libmodplug, libmspack, libmspub, libmtp, +libmwaw, libodfgen, libpagemaker, libqtxdg, libquvi, libquvi-scripts, +libraw1394, librecad, librep, librevenge, libsbsms, libsecret, libshout, +libsoup, libsrtp, libtocc, libungif, libva, libvisio, libwacom, libwebp, +libwpd, libwpg, libwps, libxklavier, libxmp, libyaml, lilv, lilypond, lirc, +livestreamer, ltrace, lv2, lv2-mda-epiano, lv2-mda-piano, lvtk, macs, mariadb, +markdown, mdadm, mdds, mesa-headers, mesa-utils, miredo, miso, moreutils, +mpd-mpc, mpdscribble, mplayer2, mpv, muparser, mythes, ncbi-vdb, ngircd, +ngs-java, ngs-sdk, npth, nss-certs, openblas, openexr, openlibm, openntpd, +openspecfun, openvpn, orc, orcus, p11-kit, patchage, pbtranscript-tofu, pcb, +perl-algorithm-c3, perl-algorithm-diff, perl-aliased, +perl-apache-logformat-compiler, perl-appconfig, perl-b-hooks-endofscope, +perl-base, perl-bit-vector, perl-boolean, perl-cache-cache, +perl-cache-fastmmap, perl-capture-tiny, perl-carp-assert, +perl-carp-assert-more, perl-carp-clan, perl-catalyst-action-renderview, +perl-catalyst-action-rest, perl-catalyst-component-instancepercontext, +perl-catalyst-devel, perl-catalyst-dispatchtype-regex, +perl-catalyst-model-dbic-schema, perl-catalyst-plugin-accesslog, +perl-catalyst-plugin-authentication, perl-catalyst-plugin-captcha, +perl-catalyst-plugin-configloader, perl-catalyst-plugin-session, +perl-catalyst-plugin-session-state-cookie, +perl-catalyst-plugin-session-store-fastmmap, perl-catalyst-plugin-stacktrace, +perl-catalyst-plugin-static-simple, perl-catalyst-runtime, +perl-catalyst-traitfor-request-proxybase, perl-catalyst-view-download, +perl-catalyst-view-json, perl-catalyst-view-tt, +perl-catalystx-component-traits, perl-catalystx-roleapplicator, +perl-catalystx-script-server-starman, perl-cgi-simple, perl-cgi-struct, +perl-class-accessor, perl-class-accessor-chained, perl-class-accessor-grouped, +perl-class-c3, perl-class-c3-adopt-next, perl-class-c3-componentised, +perl-class-data-inheritable, perl-class-date, perl-class-factory-util, +perl-class-inspector, perl-class-load, perl-class-load-xs, +perl-class-method-modifiers, perl-class-methodmaker, perl-class-singleton, +perl-class-tiny, perl-class-unload, perl-class-xsaccessor, perl-common-sense, +perl-compress-raw-bzip2, perl-compress-raw-zlib, perl-config-any, +perl-config-autoconf, perl-config-general, perl-context-preserve, +perl-cpan-meta, perl-cpan-meta-check, perl-cpan-meta-requirements, +perl-cpan-meta-yaml, perl-cpanel-json-xs, perl-crypt-randpasswd, +perl-data-dump, perl-data-dumper-concise, perl-data-optlist, perl-data-page, +perl-data-stream-bulk, perl-data-tumbler, perl-data-visitor, perl-date-calc, +perl-date-calc-xs, perl-datetime, perl-datetime-event-ical, +perl-datetime-event-recurrence, perl-datetime-format-builder, +perl-datetime-format-flexible, perl-datetime-format-http, +perl-datetime-format-ical, perl-datetime-format-natural, +perl-datetime-format-strptime, perl-datetime-locale, perl-datetime-set, +perl-datetime-timezone, perl-datetimex-easy, perl-dbd-pg, perl-dbix-class, +perl-dbix-class-cursor-cached, perl-dbix-class-introspectablem2m, +perl-dbix-class-schema-loader, perl-devel-caller, perl-devel-checkbin, +perl-devel-globaldestruction, perl-devel-lexalias, perl-devel-overloadinfo, +perl-devel-partialdump, perl-devel-stacktrace, perl-devel-stacktrace-ashtml, +perl-devel-symdump, perl-digest-hmac, perl-digest-md5-file, +perl-dist-checkconflicts, perl-email-abstract, perl-email-address, +perl-email-date-format, perl-email-messageid, perl-email-mime, +perl-email-mime-contenttype, perl-email-mime-encodings, perl-email-sender, +perl-email-simple, perl-error, perl-eval-closure, perl-exception-class, +perl-exporter-tiny, perl-extutils-config, perl-extutils-helpers, +perl-extutils-installpaths, perl-file-changenotify, perl-file-copy-recursive, +perl-file-find-rule, perl-file-find-rule-perl, perl-file-homedir, +perl-file-remove, perl-file-sharedir, perl-file-sharedir-install, +perl-file-slurp, perl-file-temp, perl-gd, perl-gd-securityimage, +perl-getopt-long-descriptive, perl-hash-merge, perl-hash-multivalue, +perl-html-form, perl-html-lint, perl-html-tree, perl-http-body, +perl-http-cookiejar, perl-http-parser, perl-http-parser-xs, +perl-http-request-ascgi, perl-http-server-simple, perl-http-tiny, +perl-image-magick, perl-import-into, perl-inc-latest, perl-io-compress, +perl-io-interactive, perl-io-socket-ip, perl-io-stringy, perl-ipc-run, +perl-ipc-sharelite, perl-json, perl-json-any, perl-json-maybexs, perl-json-xs, +perl-lingua-en-findnumber, perl-lingua-en-inflect, +perl-lingua-en-inflect-number, perl-lingua-en-inflect-phrase, +perl-lingua-en-number-isordinal, perl-lingua-en-tagger, +perl-lingua-en-words2nums, perl-lingua-pt-stemmer, perl-lingua-stem, +perl-lingua-stem-fr, perl-lingua-stem-it, perl-lingua-stem-ru, +perl-lingua-stem-snowball-da, perl-list-allutils, perl-list-moreutils, +perl-lwp-protocol-https, perl-lwp-useragent-determined, +perl-memoize-expirelru, perl-mime-types, perl-module-build, +perl-module-build-tiny, perl-module-find, perl-module-implementation, +perl-module-install, perl-module-runtime, perl-module-runtime-conflicts, +perl-module-scandeps, perl-module-util, perl-moo, perl-moose, +perl-moosex-emulate-class-accessor-fast, perl-moosex-getopt, +perl-moosex-markasmethods, perl-moosex-methodattributes, perl-moosex-nonmoose, +perl-moosex-params-validate, perl-moosex-relatedclassroles, +perl-moosex-role-parameterized, perl-moosex-role-withoverloading, +perl-moosex-semiaffordanceaccessor, perl-moosex-strictconstructor, +perl-moosex-traits-pluggable, perl-moosex-types, perl-moosex-types-datetime, +perl-moosex-types-datetime-morecoercions, perl-moosex-types-loadableclass, +perl-moox-types-mooselike, perl-mro-compat, perl-namespace-autoclean, +perl-namespace-clean, perl-net-amazon-s3, perl-net-server, +perl-number-compare, perl-object-signature, perl-package-anon, +perl-package-deprecationmanager, perl-package-stash, perl-package-stash-xs, +perl-padwalker, perl-par-dist, perl-params-util, perl-params-validate, +perl-parent, perl-parse-cpan-meta, perl-path-class, perl-plack, +perl-plack-middleware-fixmissingbodyinredirect, +perl-plack-middleware-methodoverride, +perl-plack-middleware-removeredundantbody, perl-plack-middleware-reverseproxy, +perl-plack-test-externalserver, perl-pod-coverage, +perl-posix-strftime-compiler, perl-readonly, perl-role-tiny, perl-safe-isa, +perl-scalar-list-utils, perl-scope-guard, perl-set-infinite, perl-set-scalar, +perl-snowball-norwegian, perl-snowball-swedish, perl-spiffy, +perl-sql-abstract, perl-sql-splitstatement, perl-sql-tokenizer, +perl-stream-buffered, perl-strictures, perl-string-camelcase, +perl-string-rewriteprefix, perl-string-toidentifier-en, perl-sub-exporter, +perl-sub-exporter-progressive, perl-sub-identify, perl-sub-install, +perl-sub-name, perl-sub-uplevel, perl-svg, perl-sys-hostname-long, +perl-task-weaken, perl-template-timer, perl-template-toolkit, +perl-term-encoding, perl-term-progressbar, perl-term-progressbar-quiet, +perl-term-progressbar-simple, perl-term-readkey, perl-test-base, +perl-test-cleannamespaces, perl-test-differences, perl-test-directory, +perl-test-exception, perl-test-fatal, perl-test-harness, perl-test-leaktrace, +perl-test-longstring, perl-test-mockobject, perl-test-mocktime, +perl-test-most, perl-test-output, perl-test-pod, perl-test-pod-coverage, +perl-test-requires, perl-test-sharedfork, perl-test-tcp, perl-test-trap, +perl-test-utf8, perl-test-warn, perl-test-warnings, perl-test-without-module, +perl-test-writevariants, perl-test-www-mechanize, +perl-test-www-mechanize-catalyst, perl-test-www-mechanize-psgi, +perl-test-yaml, perl-text-aligner, perl-text-balanced, perl-text-csv, +perl-text-diff, perl-text-german, perl-text-glob, perl-text-simpletable, +perl-text-table, perl-text-unidecode, perl-throwable, perl-tie-ixhash, +perl-tie-toobject, perl-time-duration, perl-time-duration-parse, +perl-time-local, perl-time-mock, perl-timedate, perl-tree-simple, +perl-tree-simple-visitorfactory, perl-try-tiny, perl-types-serialiser, +perl-universal-can, perl-universal-isa, perl-uri-find, perl-uri-ws, +perl-variable-magic, perl-www-mechanize, perl-xml-libxml, +perl-xml-namespacesupport, perl-xml-sax, perl-xml-sax-base, perl-yaml, +perl-yaml-tiny, ploticus, polipo, portaudio, pumpa, python-apsw, +python-biopython, python-cssselect, python-dbus, python-decorator, +python-drmaa, python-h5py, python-lxml, python-netifaces, python-networkx, +python-pyxdg, python-pyyaml, python-requests, python-scikit-learn, +python-singledispatch, python-sphinx-rtd-theme, python-sympy, python-testlib, +python-tornado, python-urwid, python-waf, python2-apsw, +python2-backport-ssl-match-hostname, python2-biopython, python2-bx-python, +python2-cssselect, python2-cssutils, python2-dbus, python2-decorator, +python2-drmaa, python2-h5py, python2-lxml, python2-netifaces, +python2-networkx, python2-pbcore, python2-pil, python2-pybedtools, +python2-pycairo, python2-pyxdg, python2-pyyaml, python2-rdflib, python2-rsvg, +python2-scikit-learn, python2-singledispatch, python2-six, +python2-sphinx-rtd-theme, python2-sympy, python2-testlib, python2-tornado, +python2-urwid, python2-waf, python2-xlib, quvi, r, rdesktop, recode, rep-gtk, +rseqc, rsound, rubberband, ruby-hoe, rxvt-unicode, s2tc, sawfish, sbcl, seqan, +serd, serf, sfml, shogun, sloccount, smartmontools, snakemake, soil, solfege, +sord, soundtouch, soxr, sra-tools, sratom, srt2vtt, star, starman, stow, +subread, suil, suitesparse, swt, sysfsutils, sysfsutils, taskwarrior, tbb, +terminology, tesseract-ocr, texlive-bin, texlive-texmf, the-silver-searcher, +tidy, tig, timidity++, tocc, totem-pl-parser, tree, tuxguitar, tvtime, +twolame, txt2man, unqlite, upower, utf8proc, vamp, vapoursynth, vcftools, +vigra, wavpack, webkitgtk, webkitgtk, weex, wicd, wpa-supplicant-light, +wxwidgets, wxwidgets, xbindkeys, xcape, xdg-utils, xf86-input-libinput, +xf86-input-wacom, xf86-video-nouveau, xfce, xmp, xosd, xournal, xvid, zathura, +zathura-cb, zathura-djvu, zathura-pdf-poppler, zathura-ps, zeromq, +zita-alsa-pcmi, zita-convolver + +*** 189 package updates + +acpica-20150410, apl-1.5, apr-1.5.2, arb-2.3.0, at-spi2-atk-2.16.0, +at-spi2-core-2.16.0, atk-2.16.0, autogen-5.18.5, bison-3.0.4, boost-1.57.0, +cairo-1.14.2, ccrtp-2.1.2, check-0.9.14, clang-3.6.0, cmake-3.2.2, +complexity-1.2, cups-filters-1.0.68, curl-7.42.1, dbus-1.8.16, +dbus-glib-0.104, dejagnu-1.5.3, docbook-xml-4.4, docbook-xml-4.5, +e2fsck-static-1.42.12, e2fsprogs-1.42.12, ed-1.11, eigen-3.2.4, +elfutils-0.161, emacs-24.5, emacs-no-x-toolkit-24.5, exo-0.10.3, ffmpeg-2.6.2, +fish-2.1.2, flac-1.3.1, flint-2.4.5, fltk-1.3.3, freetype-2.5.5, garcon-0.4.0, +gcc-5.1.0, gcc-toolchain-5.1.0, gdb-7.9, geiser-0.7, glib-2.44.0, glibc-2.21, +glibc-2.21, glibc-stripped-tarball-2.21, glibmm-2.44.0, global-6.4, +gnome-desktop-3.16.0, gnome-icon-theme-3.12.0, gnome-themes-standard-3.16.0, +gnu-pw-mgr-1.3, gnubik-2.4.2, gnumach-headers-1.5, gnunet-0.10.1, +gnupg-1.4.19, gnupg-2.0.27, gnupg-2.1.4, gnutls-3.4.0, +gobject-introspection-1.44.0, gpgme-1.5.4, gsettings-desktop-schemas-3.16.0, +gst-plugins-base-1.4.5, gst-plugins-good-1.4.5, gstreamer-1.4.5, gtk+-3.16.2, +gtkmm-2.24.4, gtkmm-3.16.0, guile-ssh-0.7.2, guix-0.8.1, guix-0.8.1.fc34dee, +help2man-1.46.6, httpd-2.4.12, hurd-headers-0.6, icecat-31.6.0-gnu1, +icu4c-55.1, imagemagick-6.9.0-4, imlib2-1.4.7, inetutils-1.9.3, inkscape-0.91, +isc-dhcp-4.3.1, itstool-2.0.2, kbd-2.0.2, libgcrypt-1.6.3, libgpg-error-1.18, +libidn-1.30, libltdl-2.4.6, libmicrohttpd-0.9.40, libmikmod-3.3.7, +libotr-4.1.0, libsigc++-2.4.1, libtasn1-4.5, libtool-2.4.6, +libunistring-0.9.5, libuv-1.4.2, libvorbis-1.3.5, libxfce4ui-4.12.0, +libxfce4util-4.12.1, libxfont-1.5.1, lightning-2.1.0, linux-libre-4.0.2, +linux-libre-headers-3.14.37, llvm-3.6.0, lua-5.2.3, man-pages-3.82, +mesa-10.5.4, mig-1.5, minetest-0.4.12, moe-1.7, mpc-1.0.3, mpd-0.19.9, +mu-0.9.12, nano-2.4.1, ncmpcpp-0.6.2, nettle-3.1, nginx-1.8.0, node-0.12.2, +notmuch-0.19, nspr-4.10.8, nss-3.18, ntp-4.2.8p2, ocrad-0.25, octave-3.8.2, +openconnect-7.05, openjpeg-2.0.1, openjpeg-2.1.0, openldap-2.4.40, +openssh-6.8p1, openssl-1.0.2a, pangomm-2.36.0, parallel-20150422, +pari-gp-2.7.3, patch-2.7.5, perf-4.0.2, perl-libwww-6.13, perl-net-http-6.07, +perl-net-ssleay-1.68, perl-test-simple-1.001014, perl-uri-1.67, +pinentry-0.9.0, pius-2.0.11, podofo-0.9.3, poppler-0.32.0, postgresql-9.3.6, +pulseaudio-6.0, python-3.4.3, python-pillow-2.7.0, python-pygobject-3.16.1, +python-setuptools-12.1, python-wrapper-3.4.3, python2-dateutil-2.2, +python2-pillow-2.7.0, python2-pygobject-3.16.1, python2-setuptools-12.1, +qt-5.4.1, ruby-2.2.2, samba-3.6.25, scons-2.3.4, sdl2-2.0.3, sharutils-4.15.1, +sipwitch-1.9.7, slock-1.2, source-highlight-3.1.8, sqlite-3.8.9, +subversion-1.8.13, texinfo-5.2, thunar-1.6.6, thunar-volman-0.8.1, +tor-0.2.5.12, tumbler-0.1.31, tzdata-2015c, ucommon-6.3.1, vala-0.28.0, +valgrind-3.10.1, vlc-2.2.0, vte-0.40.0, wget-1.16.3, wine-1.7.40, +wpa-supplicant-2.4, xboard-4.8.0, xfce4-appfinder-4.12.0, xfce4-panel-4.12.0, +xfce4-session-4.12.0, xfce4-settings-4.12.0, xfconf-4.12.0, xfdesktop-4.12.0, +xfwm4-4.12.0, xorg-server-1.16.4, xterm-317 + +** Programming interfaces + +*** New (guix build gremlin) to parse and validate ELF dynamic link info + +*** (guix build-system gnu) has a new ‘validate-runpath’ phase + +This phase reads the dynamic entries of ELF files and reports libraries listed +as NEEDED that are not found in the RUNPATH. + +*** New (gnu services desktop) module and ‘%desktop-services’ variable + +*** New (guix cvs-download) module, for CVS checkouts + +*** New (guix build-system waf) module, for the Waf build system + +*** New (guix build-system haskell) module, to build Haskell packages + +*** (guix build-system gnu) now supports zip archives + +*** New convenience syntax ‘modify-phases’ added in (guix build utils) + +*** The ‘ld’ wrapper more finely determines whether to use ‘-rpath’ + +*** (guix gexp) exports ‘gexp-input’ to describe input unambiguously + +*** The ‘define-gexp-compiler’ form allows (guix gexp) to be extended + +*** New ‘local-file’ constructor exported by (guix gexp) + +** Noteworthy bug fixes + +*** Profiles created with ‘guix package -p’ as indirect GC roots + +Before that they were made permanent GC roots–i.e., uncollectable. + +*** ‘guix package’ distinguishes downgrades from upgrades + +*** Handle HTTP redirects to relative URI references + (<http://bugs.gnu.org/19840>) + +*** Downloads now honor the ‘http_proxy’ environment variable + (<http://bugs.gnu.org/20402>) + +*** ‘--no-*’ options are now always correctly handled + (<http://lists.gnu.org/archive/html/guix-devel/2015-02/msg00702.html>) + +*** SLiM no longer leaks open file descriptors + +*** Don't compare <pam-service> objects with 'equal?' + (<http://bugs.gnu.org/20037>) + +*** x86_64 and i686 bootstrap binaries updated (<http://bugs.gnu.org/19780>) + +*** ‘find-files’ no longer follows symlinks (<http://bugs.gnu.org/20081>) + +*** libc message catalog (‘libc.mo’) is now installed + +*** libstdc++ has appropriate RUNPATH (<http://bugs.gnu.org/20358>) + +*** ‘dhcp-client-service’ now correctly tracks dhclient’s PID + +** Native language support + +*** New translations: da (Danish) + +*** Updated translations: eo + * Changes in 0.8.1 (since 0.8) ** Package management @@ -20,8 +20,9 @@ Guix is based on the [[http://nixos.org/nix/][Nix]] package manager. GNU Guix currently depends on the following packages: - - [[http://gnu.org/software/guile/][GNU Guile 2.0.x]], version 2.0.5 or later + - [[http://gnu.org/software/guile/][GNU Guile 2.0.x]], version 2.0.7 or later - [[http://gnupg.org/][GNU libgcrypt]] + - [[http://www.gnu.org/software/make/][GNU Make]] - optionally [[http://savannah.nongnu.org/projects/guile-json/][Guile-JSON]], for the 'guix import pypi' command - optionally [[http://www.gnutls.org][GnuTLS]] compiled with guile support enabled, for HTTPS support in the 'guix download' command. Note that 'guix import pypi' requires @@ -53,18 +54,9 @@ file. You can re-build and re-install Guix using a system that already runs Guix. To do so: - - Install the dependencies (see 'Requirements' above) and build tools using - Guix: + - Start a shell with the development environment for Guix: - guix package --install autoconf automake bzip2 gcc-toolchain gettext \ - guile libgcrypt pkg-config sqlite - - - Set the environment variables that Guix recommends you to set during the - package installation process: - ACLOCAL_PATH, CPATH, LIBRARY_PATH, PKG_CONFIG_PATH - - - Set the PATH environment variable to refer to the profile: - PATH=$HOME/.guix-profile/bin:$PATH + guix environment guix - Re-run the 'configure' script passing it the option '--with-libgcrypt-prefix=$HOME/.guix-profile/', as well as @@ -35,6 +35,7 @@ infrastructure help: Bruno Félix Rezende Ribeiro <oitofelix@gnu.org> Cyrill Schenkel <cyrill.schenkel@gmail.com> Benno Schulenberg <coordinator@translationproject.org> + Thomas Schwinge <thomas@codesourcery.com> Alen Skondro <askondro@gmail.com> Matthias Wachs <wachs@net.in.tum.de> Andy Wingo <wingo@pobox.com> diff --git a/build-aux/check-final-inputs-self-contained.scm b/build-aux/check-final-inputs-self-contained.scm index ba85c876d2..9b791f2e2d 100644 --- a/build-aux/check-final-inputs-self-contained.scm +++ b/build-aux/check-final-inputs-self-contained.scm @@ -77,5 +77,5 @@ refer to the bootstrap tools." (set-build-options store #:use-substitutes? #t) (for-each (cut test-final-inputs store <>) - %supported-systems))) + %hydra-supported-systems))) diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index c612ff1f12..83cc6fb177 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -78,10 +78,8 @@ (license . ,(package-license package)) (home-page . ,(package-home-page package)) (maintainers . ("bug-guix@gnu.org")) - - ;; Work around versions of 'hydra-eval-guile-jobs' before Hydra commit - ;; 61448ca (27 Feb. 2014) which used a default timeout of 2h. - (timeout . 72000))) + (timeout . ,(or (assoc-ref (package-properties package) 'timeout) + 72000)))) ; 20 hours by default (define (package-job store job-name package system) "Return a job called JOB-NAME that builds PACKAGE on SYSTEM." @@ -159,7 +157,7 @@ system.") (set-guile-for-build (default-guile)) (system-disk-image installation-os #:disk-image-size - (* 850 MiB)))))) + (* 860 MiB)))))) '())) (define (tarball-jobs store system) diff --git a/build-aux/hydra/guix.scm b/build-aux/hydra/guix.scm index 3996a0b422..1035f81b4a 100644 --- a/build-aux/hydra/guix.scm +++ b/build-aux/hydra/guix.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -68,25 +68,10 @@ (home-page . ,(package-home-page package)) (maintainers . ("bug-guix@gnu.org")))) -(define (tarball-package checkout nix-checkout) +(define (tarball-package checkout) "Return a package that does `make distcheck' from CHECKOUT, a directory containing a Git checkout of Guix." - (let ((dist (dist-package guix checkout))) - (package (inherit dist) - (location (source-properties->location (current-source-location))) - (arguments (substitute-keyword-arguments (package-arguments dist) - ((#:phases p) - `(alist-cons-before - 'autoreconf 'set-nix-submodule - (lambda _ - ;; Tell Git to use the Nix checkout that Hydra gave us. - (zero? - (system* "git" "config" "submodule.nix-upstream.url" - ,nix-checkout))) - ,p)))) - (native-inputs `(("git" ,git) - ("graphviz" ,graphviz) - ,@(package-native-inputs dist)))))) + (dist-package guix checkout)) (define (hydra-jobs store arguments) "Return Hydra jobs." @@ -104,13 +89,9 @@ containing a Git checkout of Guix." (define guix-checkout (assq-ref arguments 'guix)) - (define nix-checkout - (assq-ref arguments 'nix)) - - (format (current-error-port) "using checkout ~s (Nix: ~s)~%" - guix-checkout nix-checkout) - (let ((guix (assq-ref guix-checkout 'file-name)) - (nix (assq-ref nix-checkout 'file-name))) + (let ((guix (assq-ref guix-checkout 'file-name))) + (format (current-error-port) "using checkout ~s (~s)~%" + guix-checkout guix) `((tarball . ,(cute package->alist store - (tarball-package guix nix) + (tarball-package guix) (%current-system)))))) diff --git a/build-aux/make-binary-tarball.scm b/build-aux/make-binary-tarball.scm index 0b5dbaf1de..e12bec476c 100644 --- a/build-aux/make-binary-tarball.scm +++ b/build-aux/make-binary-tarball.scm @@ -27,9 +27,6 @@ (gnu system install) (ice-9 match)) -(define show-what-to-build* - (store-lift show-what-to-build)) - (define copy-file* (lift2 copy-file %store-monad)) diff --git a/config-daemon.ac b/config-daemon.ac index fb80c754c9..f96cc8f7ac 100644 --- a/config-daemon.ac +++ b/config-daemon.ac @@ -5,9 +5,12 @@ AC_MSG_RESULT([$guix_build_daemon]) dnl C++ environment. This macro must be used unconditionnaly. AC_PROG_CXX +AC_LANG([C++]) if test "x$guix_build_daemon" = "xyes"; then + GUIX_ASSERT_CXX11 + AC_PROG_RANLIB AC_CONFIG_HEADER([nix/config.h]) @@ -73,7 +76,7 @@ if test "x$guix_build_daemon" = "xyes"; then dnl Chroot support. AC_CHECK_FUNCS([chroot unshare]) - AC_CHECK_HEADERS([sched.h sys/param.h sys/mount.h tr1/unordered_set]) + AC_CHECK_HEADERS([sched.h sys/param.h sys/mount.h sys/syscall.h]) if test "x$ac_cv_func_chroot" != "xyes"; then AC_MSG_ERROR(['chroot' function missing, bailing out]) diff --git a/configure.ac b/configure.ac index 5a9cea6fe2..50b65fdac1 100644 --- a/configure.ac +++ b/configure.ac @@ -2,7 +2,7 @@ # Process this file with autoconf to produce a configure script. AC_PREREQ(2.68) -AC_INIT([GNU Guix], [0.8.2], [bug-guix@gnu.org], [guix], +AC_INIT([GNU Guix], [0.8.3], [bug-guix@gnu.org], [guix], [http://www.gnu.org/software/guix/]) AC_CONFIG_AUX_DIR([build-aux]) @@ -67,7 +67,7 @@ dnl Make sure they are available. m4_pattern_forbid([PKG_CHECK_MODULES]) m4_pattern_forbid([GUILE_MODULE_AVAILABLE]) -PKG_CHECK_MODULES([GUILE], [guile-2.0 >= 2.0.5]) +PKG_CHECK_MODULES([GUILE], [guile-2.0 >= 2.0.7]) AC_PATH_PROG([GUILE], [guile]) AC_PATH_PROG([GUILD], [guild]) if test "x$GUILD" = "x"; then @@ -182,6 +182,9 @@ dnl `dot' (from the Graphviz package) is only needed for maintainers. dnl See `HACKING' for more info. AM_MISSING_PROG([DOT], [dot]) +dnl Manual pages. +AM_MISSING_PROG([HELP2MAN], [help2man]) + AC_CONFIG_FILES([Makefile po/guix/Makefile.in po/packages/Makefile.in @@ -25,8 +25,8 @@ CLEANFILES += $(BUILT_SOURCES) noinst_LIBRARIES = libformat.a libutil.a libstore.a -# Use '-std=c++0x' for 'std::shared_ptr'. -AM_CXXFLAGS = -Wall -std=c++0x +# Use '-std=c++11' for 'std::shared_ptr', 'auto', lambdas, and more. +AM_CXXFLAGS = -Wall -std=c++11 libformat_a_SOURCES = \ nix/boost/format/free_funcs.cc \ @@ -112,7 +112,8 @@ libstore_a_CPPFLAGS = \ -DNIX_CONF_DIR=\"$(sysconfdir)/guix\" \ -DNIX_LIBEXEC_DIR=\"$(libexecdir)\" \ -DNIX_BIN_DIR=\"$(bindir)\" \ - -DOPENSSL_PATH="\"guix-authenticate\"" + -DOPENSSL_PATH="\"guix-authenticate\"" \ + -DDEFAULT_CHROOT_DIRS="\"\"" libstore_a_CXXFLAGS = $(AM_CXXFLAGS) \ $(SQLITE3_CFLAGS) $(LIBGCRYPT_CFLAGS) @@ -125,6 +126,7 @@ guix_daemon_SOURCES = \ nix/nix-daemon/guix-daemon.cc guix_daemon_CPPFLAGS = \ + -DLOCALEDIR=\"$(localedir)\" \ $(libutil_a_CPPFLAGS) \ -I$(top_srcdir)/nix/libstore @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> # Copyright © 2013 Andreas Enge <andreas@enge.fr> # # This file is part of GNU Guix. @@ -25,12 +25,16 @@ EXTRA_DIST += \ doc/images/bootstrap-graph.eps \ doc/images/bootstrap-graph.pdf +OS_CONFIG_EXAMPLES_TEXI = \ + doc/os-config-bare-bones.texi \ + doc/os-config-desktop.texi + # Bundle this file so that makeinfo finds it in out-of-source-tree builds. -BUILT_SOURCES += doc/os-config.texi -EXTRA_DIST += doc/os-config.texi -MAINTAINERCLEANFILES = doc/os-config.texi +BUILT_SOURCES += $(OS_CONFIG_EXAMPLES_TEXI) +EXTRA_DIST += $(OS_CONFIG_EXAMPLES_TEXI) +MAINTAINERCLEANFILES = $(OS_CONFIG_EXAMPLES_TEXI) -doc/os-config.texi: gnu/system/os-config.tmpl +doc/os-config-%.texi: gnu/system/examples/%.tmpl $(MKDIR_P) "`dirname "$@"`" cp "$<" "$@" @@ -61,3 +65,45 @@ DOT_OPTIONS = \ pdf-local: $(top_srcdir)/doc/images/bootstrap-graph.pdf info-local: $(top_srcdir)/doc/images/bootstrap-graph.png ps-local: $(top_srcdir)/doc/images/bootstrap-graph.eps + + +# Manual pages. + +doc/guix.1: scripts/guix + -LANGUAGE= $(top_builddir)/pre-inst-env \ + $(HELP2MAN) --output="$@" guix + +doc/guix-daemon.1: guix-daemon + -LANGUAGE= $(top_builddir)/pre-inst-env \ + $(HELP2MAN) --output="$@" guix-daemon + +define subcommand-manual-target + +doc/guix-$(1).1: scripts/guix guix/scripts/$(1).go + -LANGUAGE= $(top_builddir)/pre-inst-env \ + $(HELP2MAN) --output="$$@" "guix $(1)" + +endef + +SUBCOMMANDS := \ + archive \ + build \ + download \ + environment \ + gc \ + hash \ + import \ + lint \ + package \ + publish \ + pull \ + refresh \ + system + +$(eval $(foreach subcommand,$(SUBCOMMANDS), \ + $(call subcommand-manual-target,$(subcommand)))) + +dist_man1_MANS = \ + doc/guix.1 \ + doc/guix-daemon.1 \ + $(SUBCOMMANDS:%=doc/guix-%.1) diff --git a/doc/emacs.texi b/doc/emacs.texi index 93d0c86b42..17682c3a51 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -19,6 +19,7 @@ guix package}). Specifically, ``guix.el'' makes it easy to: * Usage: Emacs Usage. Using the interface. * Configuration: Emacs Configuration. Configuring the interface. * Prettify Mode: Emacs Prettify. Abbreviating @file{/gnu/store/@dots{}} file names. +* Completions: Emacs Completions. Completing @command{guix} shell command. @end menu @node Emacs Initial Setup @@ -29,7 +30,7 @@ is ready to use, provided Guix is installed system-wide, which is the case by default. So if that is what you're using, you can happily skip this section and read about the fun stuff. -If you're not yet a happy user of GSD, a little bit of setup is needed. +If you're not yet a happy user of GuixSD, a little bit of setup is needed. To be able to use ``guix.el'', you need to install the following packages: @@ -44,23 +45,49 @@ used for interacting with the Guile process. @end itemize -When it is done, add the following into your init file (@pxref{Init -File,,, emacs, The GNU Emacs Manual}): +When it is done ``guix.el'' may be configured by requiring a special +@code{guix-init} file---i.e., by adding the following code into your +init file (@pxref{Init File,,, emacs, The GNU Emacs Manual}): @example +(add-to-list 'load-path "/path/to/directory-with-guix.el") (require 'guix-init nil t) @end example -However there is a chance that @code{load-path} of your Emacs does not -contain a directory with ``guix.el'' (usually it is -@file{/usr/share/emacs/site-lisp/}). In that case you need to add it -before requiring (@pxref{Lisp Libraries,,, emacs, The GNU Emacs -Manual}): +So the only thing you need to figure out is where the directory with +elisp files for Guix is placed. It depends on how you installed Guix: + +@itemize +@item +If it was installed by a package manager of your distribution or by a +usual @code{./configure && make && make install} command sequence, then +elisp files are placed in a standard directory with Emacs packages +(usually it is @file{/usr/share/emacs/site-lisp/}), which is already in +@code{load-path}, so there is no need to add that directory there. + +@item +If you used a binary installation method (@pxref{Binary Installation}), +then Guix is installed somewhere in the store, so the elisp files are +placed in @file{/gnu/store/@dots{}-guix-0.8.2/share/emacs/site-lisp/} or +alike. However it is not recommended to refer directly to a store +directory. Instead you can install Guix using Guix itself with +@command{guix package -i guix} command (@pxref{Invoking guix package}) +and add @file{~/.guix-profile/share/emacs/site-lisp/} directory to +@code{load-path} variable. + +@item +If you did not install Guix at all and prefer a hacking way +(@pxref{Running Guix Before It Is Installed}), along with augmenting +@code{load-path} you need to set @code{guix-load-path} variable to the +same directory, so your final configuration will look like this: @example -(add-to-list 'load-path "/path/to/directory-with-guix.el") -(require 'guix-init) +(let ((dir "/path/to/your-guix-git-tree/emacs")) + (add-to-list 'load-path dir) + (setq guix-load-path dir)) +(require 'guix-init nil t) @end example +@end itemize By default, along with autoloading (@pxref{Autoload,,, elisp, The GNU Emacs Lisp Reference Manual}) the main interactive commands for @@ -183,6 +210,11 @@ packages/generations and redisplay it. @item R Redisplay current buffer (without updating information). +@item M +Apply manifest to the current profile or to a specified profile, if +prefix argument is used. This has the same meaning as @code{--manifest} +option (@pxref{Invoking guix package}). + @item C-c C-z Go to the Guix REPL (@pxref{The REPL,,, geiser, Geiser User Manual}). @@ -213,9 +245,7 @@ Default key bindings available for both ``package-list'' and @table @kbd @item m -Mark the current entry. -@item M -Mark all entries. +Mark the current entry (with prefix, mark all entries). @item u Unmark the current entry (with prefix, unmark all entries). @item @key{DEL} @@ -486,3 +516,34 @@ mode hooks (@pxref{Hooks,,, emacs, The GNU Emacs Manual}), for example: (add-hook 'shell-mode-hook 'guix-prettify-mode) (add-hook 'dired-mode-hook 'guix-prettify-mode) @end example + + +@node Emacs Completions +@subsection Shell Completions + +Another feature that becomes available after configuring Emacs interface +(@pxref{Emacs Initial Setup}) is completing of @command{guix} +subcommands, options, packages and other things in @code{shell} +(@pxref{Interactive Shell,,, emacs, The GNU Emacs Manual}) and +@code{eshell} (@pxref{Top,,, eshell, Eshell: The Emacs Shell}). + +It works the same way as other completions do. Just press @key{TAB} +when your intuition tells you. + +And here are some examples, where pressing @key{TAB} may complete +something: + +@itemize @w{} + +@item @code{guix pa}@key{TAB} +@item @code{guix package -}@key{TAB} +@item @code{guix package --}@key{TAB} +@item @code{guix package -i gei}@key{TAB} +@item @code{guix build -L/tm}@key{TAB} +@item @code{guix build --sy}@key{TAB} +@item @code{guix build --system=i}@key{TAB} +@item @code{guix system rec}@key{TAB} +@item @code{guix lint --checkers=sy}@key{TAB} +@item @code{guix lint --checkers=synopsis,des}@key{TAB} + +@end itemize diff --git a/doc/guix.texi b/doc/guix.texi index dd6af80965..be7a292f08 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12,7 +12,8 @@ @copying Copyright @copyright{} 2012, 2013, 2014, 2015 Ludovic Courtès@* Copyright @copyright{} 2013, 2014 Andreas Enge@* -Copyright @copyright{} 2013 Nikita Karetnikov +Copyright @copyright{} 2013 Nikita Karetnikov@* +Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -82,10 +83,12 @@ package management tool written for the GNU system. Installation +* Binary Installation:: Getting Guix running in no time! * Requirements:: Software needed to build and run Guix. * Running the Test Suite:: Testing Guix. * Setting Up the Daemon:: Preparing the build daemon's environment. * Invoking guix-daemon:: Running the build daemon. +* Running Guix Before It Is Installed:: Hacker tricks. Setting Up the Daemon @@ -112,6 +115,11 @@ Programming Interface * The Store Monad:: Purely functional interface to the store. * G-Expressions:: Manipulating build expressions. +Defining Packages + +* package Reference:: The package data type. +* origin Reference:: The origin data type. + Utilities * Invoking guix build:: Building packages from the command line. @@ -144,6 +152,7 @@ System Configuration * Locales:: Language and cultural convention settings. * Services:: Specifying system services. * Setuid Programs:: Programs running with root privileges. +* X.509 Certificates:: Authenticating HTTPS servers. * Name Service Switch:: Configuring libc's name service switch. * Initial RAM Disk:: Linux-Libre bootstrapping. * GRUB Configuration:: Configuring the boot loader. @@ -155,6 +164,8 @@ Services * Base Services:: Essential system services. * Networking Services:: Network setup, SSH daemon, etc. * X Window:: Graphical display. +* Desktop Services:: D-Bus and desktop services. +* Database Services:: SQL databases. * Various Services:: Other services. Packaging Guidelines @@ -213,11 +224,11 @@ Guix has a command-line interface, which allows users to build, install, upgrade, and remove packages, as well as a Scheme programming interface. @cindex Guix System Distribution -@cindex GSD +@cindex GuixSD Last but not least, Guix is used to build a distribution of the GNU system, with many GNU and non-GNU free software packages. The Guix -System Distribution, or GNU@tie{}GSD, takes advantage of the core -properties of Guix at the system level. With GNU@tie{}GSD, users +System Distribution, or GNU@tie{}GuixSD, takes advantage of the core +properties of Guix at the system level. With GuixSD, users @emph{declare} all aspects of the operating system configuration, and Guix takes care of instantiating that configuration in a reproducible, stateless fashion. @xref{GNU Distribution}. @@ -242,6 +253,7 @@ instead, you want to install the complete GNU operating system, * Running the Test Suite:: Testing Guix. * Setting Up the Daemon:: Preparing the build daemon's environment. * Invoking guix-daemon:: Running the build daemon. +* Running Guix Before It Is Installed:: Hacker tricks. @end menu @node Binary Installation @@ -258,7 +270,7 @@ Installing goes along these lines: @enumerate @item Download the binary tarball from -@code{ftp://alpha.gnu.org/gnu/guix/guix-binary-@value{VERSION}.@var{system}.tar.xz}@footnote{As +@indicateurl{ftp://alpha.gnu.org/gnu/guix/guix-binary-@value{VERSION}.@var{system}.tar.xz}@footnote{As usual, make sure to download the associated @file{.sig} file and to verify the authenticity of the tarball against it!}, where @var{system} is @code{x86_64-linux} for an @code{x86_64} machine already running the @@ -268,23 +280,31 @@ kernel Linux, and so on. As @code{root}, run: @example -# cd / +# cd /tmp # tar xf guix-binary-@value{VERSION}.@var{system}.tar.xz +# mv var/guix /var/ && mv gnu / @end example -This creates @file{/gnu/store} (@pxref{The Store}), @file{/var/guix}, -and @file{/root/.guix-profile}. @file{/root/.guix-profile} is a -ready-to-use profile for @code{root} where Guix is installed. +This creates @file{/gnu/store} (@pxref{The Store}) and @file{/var/guix}. +The latter contains a ready-to-use profile for @code{root} (see next +step.) Do @emph{not} unpack the tarball on a working Guix system since that would overwrite its own essential files. @item -Set up the daemon as explained below (@pxref{Setting Up the Daemon}), and -run it: +Make @code{root}'s profile available under @file{~/.guix-profile}: + +@example +# ln -sf /var/guix/profiles/per-user/root/guix-profile \ + ~root/.guix-profile +@end example + +@item +Run the daemon: @example -# /root/.guix-profile/bin/guix-daemon --build-users-group=guix-builder +# ~root/.guix-profile/bin/guix-daemon --build-users-group=guixbuild @end example @item @@ -294,7 +314,15 @@ for instance with: @example # mkdir -p /usr/local/bin # cd /usr/local/bin -# ln -s /root/.guix-profile/bin/guix +# ln -s /var/guix/profiles/per-user/root/guix-profile/bin/guix +@end example + +@item +To use substitutes from @code{hydra.gnu.org} (@pxref{Substitutes}), +authorize them: + +@example +# guix archive --authorize < ~root/.guix-profile/share/guix/hydra.gnu.org.pub @end example @end enumerate @@ -305,8 +333,8 @@ profile, or it would become subject to garbage collection---in which case you would find yourself badly handicapped by the lack of the @command{guix} command. -The tarball in question can be (re)produced simply by running the -following command in the Guix source tree: +The tarball in question can be (re)produced and verified simply by +running the following command in the Guix source tree: @example make guix-binary.@var{system}.tar.xz @@ -324,8 +352,9 @@ in the Guix source tree for additional details. GNU Guix depends on the following packages: @itemize -@item @url{http://gnu.org/software/guile/, GNU Guile}, version 2.0.5 or later; +@item @url{http://gnu.org/software/guile/, GNU Guile}, version 2.0.7 or later; @item @url{http://gnupg.org/, GNU libgcrypt}; +@item @url{http://www.gnu.org/software/make/, GNU Make}. @end itemize The following dependencies are optional: @@ -350,9 +379,10 @@ Unless @code{--disable-daemon} was passed to @command{configure}, the following packages are also needed: @itemize -@item @url{http://sqlite.org, SQLite 3} -@item @url{http://www.bzip.org, libbz2} -@item @url{http://gcc.gnu.org, GCC's g++} +@item @url{http://sqlite.org, SQLite 3}; +@item @url{http://www.bzip.org, libbz2}; +@item @url{http://gcc.gnu.org, GCC's g++}, with support for the +C++11 standard. @end itemize When a working installation of @url{http://nixos.org/nix/, the Nix package @@ -446,27 +476,30 @@ Bash syntax and the @code{shadow} commands): @c See http://lists.gnu.org/archive/html/bug-guix/2013-01/msg00239.html @c for why `-G' is needed. @example -# groupadd guix-builder -# for i in `seq 1 10`; +# groupadd --system guixbuild +# for i in `seq -w 1 10`; do - useradd -g guix-builder -G guix-builder \ - -d /var/empty -s `which nologin` \ - -c "Guix build user $i" --system \ - guix-builder$i; + useradd -g guixbuild -G guixbuild \ + -d /var/empty -s `which nologin` \ + -c "Guix build user $i" --system \ + guixbuilder$i; done @end example @noindent +The number of build users determines how many build jobs may run in +parallel, as specified by the @option{--max-jobs} option +(@pxref{Invoking guix-daemon, @option{--max-jobs}}). The @code{guix-daemon} program may then be run as @code{root} with: @example -# guix-daemon --build-users-group=guix-builder +# guix-daemon --build-users-group=guixbuild @end example @cindex chroot @noindent This way, the daemon starts build processes in a chroot, under one of -the @code{guix-builder} users. On GNU/Linux, by default, the chroot +the @code{guixbuilder} users. On GNU/Linux, by default, the chroot environment contains nothing but: @c Keep this list in sync with libstore/build.cc! ----------------------- @@ -496,12 +529,13 @@ user @file{nobody}; a writable @file{/tmp} directory. @end itemize -If you are installing Guix as an unprivileged user, it is still -possible to run @command{guix-daemon}. However, build processes will -not be isolated from one another, and not from the rest of the system. -Thus, build processes may interfere with each other, and may access -programs, libraries, and other files available on the system---making it -much harder to view them as @emph{pure} functions. +If you are installing Guix as an unprivileged user, it is still possible +to run @command{guix-daemon} provided you pass @code{--disable-chroot}. +However, build processes will not be isolated from one another, and not +from the rest of the system. Thus, build processes may interfere with +each other, and may access programs, libraries, and other files +available on the system---making it much harder to view them as +@emph{pure} functions. @node Daemon Offload Setup @@ -628,7 +662,7 @@ garbage collector, querying the availability of a build result, etc. It is normally run as @code{root} like this: @example -# guix-daemon --build-users-group=guix-builder +# guix-daemon --build-users-group=guixbuild @end example @noindent @@ -686,7 +720,7 @@ remote procedure call (@pxref{The Store}). @item --substitute-urls=@var{urls} Consider @var{urls} the default whitespace-separated list of substitute -source URLs. When this option is omitted, @code{http://hydra.gnu.org} +source URLs. When this option is omitted, @indicateurl{http://hydra.gnu.org} is used. This means that substitutes may be downloaded from @var{urls}, as long @@ -743,7 +777,9 @@ needs. Disable chroot builds. Using this option is not recommended since, again, it would allow build -processes to gain access to undeclared dependencies. +processes to gain access to undeclared dependencies. It is necessary, +though, when @command{guix-daemon} is running under an unprivileged user +account. @item --disable-log-compression Disable compression of the build logs. @@ -811,6 +847,44 @@ useful in exceptional circumstances, such as if you need to run several daemons on the same machine. @end table +@node Running Guix Before It Is Installed +@section Running Guix Before It Is Installed + +If you are hacking Guix itself---which is a good idea!---you will find +it useful to test the changes made in your local source tree checkout +without actually installing them. + +To that end, all the command-line tools can be used even if you have not +run @command{make install}. To do that, prefix each command with +@command{./pre-inst-env} (the @file{pre-inst-env} script lives in the +top build tree of Guix), as in: + +@example +$ sudo ./pre-inst-env guix-daemon --build-users-group=guixbuild +$ ./pre-inst-env guix build hello +@end example + +@noindent +Similarly, for a Guile session using the Guix modules: + +@example +$ ./pre-inst-env guile -c '(use-modules (guix utils)) (pk (%current-system))' +@end example + +The @command{pre-inst-env} script sets up all the environment variables +necessary to support this, including @code{PATH} and +@code{GUILE_LOAD_PATH}. + +If you are hacking Guix from Emacs using the wonderful Geiser +(@pxref{Introduction,,, geiser, Geiser User Manual}), make sure to +augment Guile's load path so that it finds source files from your +checkout: + +@lisp +;; Assuming the Guix checkout is in ~/src/guix. +(add-to-list 'geiser-guile-load-path "~/src/guix") +@end lisp + @c ********************************************************************* @node Package Management @@ -927,7 +1001,7 @@ guix package @var{options} Primarily, @var{options} specifies the operations to be performed during the transaction. Upon completion, a new profile is created, but -previous generations of the profile remain available, should the user +previous @dfn{generations} of the profile remain available, should the user want to roll back. For example, to remove @code{lua} and install @code{guile} and @@ -937,11 +1011,26 @@ For example, to remove @code{lua} and install @code{guile} and guix package -r lua -i guile guile-cairo @end example +@command{guix package} also supports a @dfn{declarative approach} +whereby the user specifies the exact set of packages to be available and +passes it @i{via} the @option{--manifest} option +(@pxref{profile-manifest, @option{--manifest}}). + For each user, a symlink to the user's default profile is automatically created in @file{$HOME/.guix-profile}. This symlink always points to the current generation of the user's default profile. Thus, users can add @file{$HOME/.guix-profile/bin} to their @code{PATH} environment variable, and so on. +@cindex search paths +If you are not using the Guix System Distribution, consider adding the +following lines to your @file{~/.bash_profile} (@pxref{Bash Startup +Files,,, bash, The GNU Bash Reference Manual}) so that newly-spawned +shells get all the right environment variable definitions: + +@example +GUIX_PROFILE="$HOME/.guix-profile" \ +source "$HOME/.guix-profile/etc/profile" +@end example In a multi-user setup, user profiles are stored in a place registered as a @dfn{garbage-collector root}, which @file{$HOME/.guix-profile} points @@ -976,8 +1065,12 @@ distribution modules (@pxref{Package Modules}). @cindex propagated inputs Sometimes packages have @dfn{propagated inputs}: these are dependencies -that automatically get installed along with the required package. +that automatically get installed along with the required package +(@pxref{package-propagated-inputs, @code{propagated-inputs} in +@code{package} objects}, for information about propagated inputs in +package definitions). +@anchor{package-cmd-propagated-inputs} An example is the GNU MPC library: its C header files refer to those of the GNU MPFR library, which in turn refer to those of the GMP library. Thus, when installing MPC, the MPFR and GMP libraries also get installed @@ -1038,6 +1131,34 @@ substring ``emacs'': $ guix package --upgrade . --do-not-upgrade emacs @end example +@item @anchor{profile-manifest}--manifest=@var{file} +@itemx -m @var{file} +@cindex profile declaration +@cindex profile manifest +Create a new generation of the profile from the manifest object +returned by the Scheme code in @var{file}. + +This allows you to @emph{declare} the profile's contents rather than +constructing it through a sequence of @code{--install} and similar +commands. The advantage is that @var{file} can be put under version +control, copied to different machines to reproduce the same profile, and +so on. + +@c FIXME: Add reference to (guix profile) documentation when available. +@var{file} must return a @dfn{manifest} object, which is roughly a list +of packages: + +@findex packages->manifest +@example +(use-package-modules guile emacs) + +(packages->manifest + (list emacs + guile-2.0 + ;; Use a specific package output. + (list guile-2.0 "debug"))) +@end example + @item --roll-back Roll back to the previous @dfn{generation} of the profile---i.e., undo the last transaction. @@ -1068,7 +1189,7 @@ The difference between @code{--roll-back} and not make a zeroth generation, so if a specified generation does not exist, the current generation will not be changed. -@item --search-paths +@item --search-paths[=@var{kind}] @cindex search paths Report environment variable definitions, in Bash syntax, that may be needed in order to use the set of installed packages. These environment @@ -1083,6 +1204,18 @@ library are installed in the profile, then @code{--search-paths} will suggest setting these variables to @code{@var{profile}/include} and @code{@var{profile}/lib}, respectively. +The typical use case is to define these environment variables in the +shell: + +@example +$ eval `guix package --search-paths` +@end example + +@var{kind} may be one of @code{exact}, @code{prefix}, or @code{suffix}, +meaning that the returned environment variable definitions will either +be exact settings, or prefixes or suffixes of the current value of these +variables. When omitted, @var{kind} defaults to @code{exact}. + @item --profile=@var{profile} @itemx -p @var{profile} Use @var{profile} instead of the user's default profile. @@ -1330,7 +1463,9 @@ determination to subvert the computing infrastructure and exploit its weaknesses. While using @code{hydra.gnu.org} substitutes can be convenient, we encourage users to also build on their own, or even run their own build farm, such that @code{hydra.gnu.org} is less of an -interesting target. +interesting target. One way to help is by publishing the software you +build using @command{guix publish} so that others have one more choice +of server to download substitutes from (@pxref{Invoking guix publish}). Guix has the foundations to maximize build reproducibility (@pxref{Features}). In most cases, independent builds of a given @@ -1418,8 +1553,9 @@ is achieved by running @code{guix package --delete-generations} The @command{guix gc} command has three modes of operation: it can be used to garbage-collect any dead files (the default), to delete specific -files (the @code{--delete} option), or to print garbage-collector -information. The available options are listed below: +files (the @code{--delete} option), to print garbage-collector +information, or for more advanced queries. The garbage collection +options are as follows: @table @code @item --collect-garbage[=@var{min}] @@ -1468,6 +1604,47 @@ of these, recursively. In other words, the returned list is the @end table +Lastly, the following options allow you to check the integrity of the +store and to control disk usage. + +@table @option + +@item --verify[=@var{options}] +@cindex integrity, of the store +@cindex integrity checking +Verify the integrity of the store. + +By default, make sure that all the store items marked as valid in the +daemon's database actually exist in @file{/gnu/store}. + +When provided, @var{options} must a comma-separated list containing one +or more of @code{contents} and @code{repair}. + +When passing @option{--verify=contents}, the daemon will compute the +content hash of each store item and compare it against its hash in the +database. Hash mismatches are reported as data corruptions. Because it +traverses @emph{all the files in the store}, this command can take a +long time, especially on systems with a slow disk drive. + +@cindex repairing the store +Using @option{--verify=repair} or @option{--verify=contents,repair} +causes the daemon to try to repair corrupt store items by fetching +substitutes for them (@pxref{Substitutes}). Because repairing is not +atomic, and thus potentially dangerous, it is available only to the +system administrator. + +@item --optimize +@cindex deduplication +Optimize the store by hard-linking identical files---this is +@dfn{deduplication}. + +The daemon performs deduplication after each successful build or archive +import, unless it was started with @code{--disable-deduplication} +(@pxref{Invoking guix-daemon, @code{--disable-deduplication}}). Thus, +this option is primarily useful when the daemon was running with +@code{--disable-deduplication}. + +@end table @node Invoking guix pull @section Invoking @command{guix pull} @@ -1724,7 +1901,8 @@ There are a few points worth noting in the above package definition: @itemize @item -The @code{source} field of the package is an @code{<origin>} object. +The @code{source} field of the package is an @code{<origin>} object +(@pxref{origin Reference}, for the complete reference). Here, the @code{url-fetch} method from @code{(guix download)} is used, meaning that the source is a file to be downloaded over FTP or HTTP. @@ -1772,6 +1950,8 @@ However, any other dependencies need to be specified in the unavailable to the build process, possibly leading to a build failure. @end itemize +@xref{package Reference}, for a full description of possible fields. + Once a package definition is in place, the package may actually be built using the @code{guix build} command-line tool (@pxref{Invoking guix build}). @xref{Packaging Guidelines}, for @@ -1816,6 +1996,194 @@ and operating system, such as @code{"mips64el-linux-gnu"} Configure and Build System}). @end deffn +@menu +* package Reference :: The package data type. +* origin Reference:: The origin data type. +@end menu + + +@node package Reference +@subsection @code{package} Reference + +This section summarizes all the options available in @code{package} +declarations (@pxref{Defining Packages}). + +@deftp {Data Type} package +This is the data type representing a package recipe. + +@table @asis +@item @code{name} +The name of the package, as a string. + +@item @code{version} +The version of the package, as a string. + +@item @code{source} +An origin object telling how the source code for the package should be +acquired (@pxref{origin Reference}). + +@item @code{build-system} +The build system that should be used to build the package (@pxref{Build +Systems}). + +@item @code{arguments} (default: @code{'()}) +The arguments that should be passed to the build system. This is a +list, typically containing sequential keyword-value pairs. + +@item @code{inputs} (default: @code{'()}) +Package or derivation inputs to the build. This is a list of lists, +where each list has the name of the input (a string) as its first +element, a package or derivation object as its second element, and +optionally the name of the output of the package or derivation that +should be used, which defaults to @code{"out"}. + +@item @anchor{package-propagated-inputs}@code{propagated-inputs} (default: @code{'()}) +@cindex propagated inputs +This field is like @code{inputs}, but the specified packages will be +force-installed alongside the package they belong to +(@pxref{package-cmd-propagated-inputs, @command{guix package}}, for +information on how @command{guix package} deals with propagated inputs.) + +For example this is necessary when a library needs headers of another +library to compile, or needs another shared library to be linked +alongside itself when a program wants to link to it. + +@item @code{native-inputs} (default: @code{'()}) +This field is like @code{inputs}, but in case of a cross-compilation it +will be ensured that packages for the architecture of the build machine +are present, such that executables from them can be used during the +build. + +This is typically where you would list tools needed at build time but +not at run time, such as Autoconf, Automake, pkg-config, Gettext, or +Bison. @command{guix lint} can report likely mistakes in this area +(@pxref{Invoking guix lint}). + +@item @code{self-native-input?} (default: @code{#f}) +This is a Boolean field telling whether the package should use itself as +a native input when cross-compiling. + +@item @code{outputs} (default: @code{'("out")}) +The list of output names of the package. @xref{Packages with Multiple +Outputs}, for typical uses of additional outputs. + +@item @code{native-search-paths} (default: @code{'()}) +@itemx @code{search-paths} (default: @code{'()}) +A list of @code{search-path-specification} objects describing +search-path environment variables honored by the package. + +@item @code{replacement} (default: @code{#f}) +This must either @code{#f} or a package object that will be used as a +@dfn{replacement} for this package. @xref{Security Updates, grafts}, +for details. + +@item @code{synopsis} +A one-line description of the package. + +@item @code{description} +A more elaborate description of the package. + +@item @code{license} +The license of the package; a value from @code{(guix licenses)}. + +@item @code{home-page} +The URL to the home-page of the package, as a string. + +@item @code{supported-systems} (default: @var{%supported-systems}) +The list of systems supported by the package, as strings of the form +@code{architecture-kernel}, for example @code{"x86_64-linux"}. + +@item @code{maintainers} (default: @code{'()}) +The list of maintainers of the package, as @code{maintainer} objects. + +@item @code{location} (default: source location of the @code{package} form) +The source location of the package. It's useful to override this when +inheriting from another package, in which case this field is not +automatically corrected. +@end table +@end deftp + + +@node origin Reference +@subsection @code{origin} Reference + +This section summarizes all the options available in @code{origin} +declarations (@pxref{Defining Packages}). + +@deftp {Data Type} origin +This is the data type representing a source code origin. + +@table @asis +@item @code{uri} +An object containing the URI of the source. The object type depends on +the @code{method} (see below). For example, when using the +@var{url-fetch} method of @code{(guix download)}, the valid @code{uri} +values are: a URL represented as a string, or a list thereof. + +@item @code{method} +A procedure that will handle the URI. + +Examples include: + +@table @asis +@item @var{url-fetch} from @code{(guix download)} +download a file the HTTP, HTTPS, or FTP URL specified in the +@code{uri} field; + +@item @var{git-fetch} from @code{(guix git-download)} +clone the Git version control repository, and check out the revision +specified in the @code{uri} field as a @code{git-reference} object; a +@code{git-reference} looks like this: + +@example +(git-reference + (url "git://git.debian.org/git/pkg-shadow/shadow") + (commit "v4.1.5.1")) +@end example +@end table + +@item @code{sha256} +A bytevector containing the SHA-256 hash of the source. Typically the +@code{base32} form is used here to generate the bytevector from a +base-32 string. + +@item @code{file-name} (default: @code{#f}) +The file name under which the source code should be saved. When this is +@code{#f}, a sensible default value will be used in most cases. In case +the source is fetched from a URL, the file name from the URL will be +used. For version control checkouts, it's recommended to provide the +file name explicitly because the default is not very descriptive. + +@item @code{patches} (default: @code{'()}) +A list of file names containing patches to be applied to the source. + +@item @code{snippet} (default: @code{#f}) +A quoted piece of code that will be run in the source directory to make +any modifications, which is sometimes more convenient than a patch. + +@item @code{patch-flags} (default: @code{'("-p1")}) +A list of command-line flags that should be passed to the @code{patch} +command. + +@item @code{patch-inputs} (default: @code{#f}) +Input packages or derivations to the patching process. When this is +@code{#f}, the usual set of inputs necessary for patching are provided, +such as GNU@tie{}Patch. + +@item @code{modules} (default: @code{'()}) +A list of Guile modules that should be loaded during the patching +process and while running the code in the @code{snippet} field. + +@item @code{imported-modules} (default: @code{'()}) +The list of Guile modules to import in the patch derivation, for use by +the @code{snippet}. + +@item @code{patch-guile} (default: @code{#f}) +The Guile package that should be used in the patching process. When +this is @code{#f}, a sensible default is used. +@end table +@end deftp + @node Build Systems @section Build Systems @@ -2056,7 +2424,7 @@ the @code{#:haddock-flags} parameter. If the file @code{Setup.hs} is not found, the build system looks for @code{Setup.lhs} instead. Which Haskell compiler is used can be specified with the @code{#:haskell} -parameter which defaults to @code{ghc}. +parameter which defaults to @code{ghc}. @end defvr Lastly, for packages that do not need anything as sophisticated, a @@ -2338,28 +2706,41 @@ Consider this ``normal'' procedure: `(symlink ,sh %output)))) @end example -Using @code{(guix monads)}, it may be rewritten as a monadic function: +Using @code{(guix monads)} and @code{(guix gexp)}, it may be rewritten +as a monadic function: -@c FIXME: Find a better example, one that uses 'mlet'. @example (define (sh-symlink) ;; Same, but return a monadic value. - (gexp->derivation "sh" - #~(symlink (string-append #$bash "/bin/bash") #$output))) + (mlet %store-monad ((drv (package->derivation bash))) + (gexp->derivation "sh" + #~(symlink (string-append #$drv "/bin/bash") + #$output)))) @end example -There are two things to note in the second version: the @code{store} -parameter is now implicit, and the monadic value returned by -@code{package-file}---a wrapper around @code{package-derivation} and -@code{derivation->output-path}---is @dfn{bound} using @code{mlet} -instead of plain @code{let}. +There several things to note in the second version: the @code{store} +parameter is now implicit and is ``threaded'' in the calls to the +@code{package->derivation} and @code{gexp->derivation} monadic +procedures, and the monadic value returned by @code{package->derivation} +is @dfn{bound} using @code{mlet} instead of plain @code{let}. -Calling the monadic @code{profile.sh} has no effect. To get the desired +As it turns out, the call to @code{package->derivation} can even be +omitted since it will take place implicitly, as we will see later +(@pxref{G-Expressions}): + +@example +(define (sh-symlink) + (gexp->derivation "sh" + #~(symlink (string-append #$bash "/bin/bash") + #$output))) +@end example + +Calling the monadic @code{sh-symlink} has no effect. To get the desired effect, one must use @code{run-with-store}: @example -(run-with-store (open-connection) (profile.sh)) -@result{} /gnu/store/...-profile.sh +(run-with-store (open-connection) (sh-symlink)) +@result{} /gnu/store/...-sh-symlink @end example Note that the @code{(guix monad-repl)} module extends Guile's REPL with @@ -2401,12 +2782,25 @@ in @var{monad}. Return a monadic value that encapsulates @var{val}. @end deffn -@deffn {Scheme Syntax} >>= @var{mval} @var{mproc} +@deffn {Scheme Syntax} >>= @var{mval} @var{mproc} ... @dfn{Bind} monadic value @var{mval}, passing its ``contents'' to monadic -procedure @var{mproc}@footnote{This operation is commonly referred to as -``bind'', but that name denotes an unrelated procedure in Guile. Thus -we use this somewhat cryptic symbol inherited from the Haskell -language.}. +procedures @var{mproc}@dots{}@footnote{This operation is commonly +referred to as ``bind'', but that name denotes an unrelated procedure in +Guile. Thus we use this somewhat cryptic symbol inherited from the +Haskell language.}. There can be one @var{mproc} or several of them, as +in this example: + +@example +(run-with-state + (with-monad %state-monad + (>>= (return 1) + (lambda (x) (return (+ 1 x))) + (lambda (x) (return (* 2 x))))) + 'some-state) + +@result{} 4 +@result{} some-state +@end example @end deffn @deffn {Scheme Syntax} mlet @var{monad} ((@var{var} @var{mval}) ...) @ @@ -2604,13 +2998,14 @@ and these dependencies are automatically added as inputs to the build processes that use them. @end itemize -Actually this mechanism is not limited to package and derivation -objects; @dfn{compilers} able to ``lower'' other high-level objects to +This mechanism is not limited to package and derivation +objects: @dfn{compilers} able to ``lower'' other high-level objects to derivations can be defined, such that these objects can also be inserted -into gexps. Another useful type of high-level object that can be -inserted in a gexp is @dfn{local files}, which allows files from the -local file system to be added to the store and referred to by -derivations and such (see @code{local-file} below.) +into gexps. For example, a useful type of high-level object that can be +inserted in a gexp is ``file-like objects'', which make it easy to +add files to the store and refer to them in +derivations and such (see @code{local-file} and @code{plain-file} +below.) To illustrate the idea, here is an example of a gexp: @@ -2774,6 +3169,24 @@ refer to. Any reference to another store item will lead to a build error. The other arguments are as for @code{derivation} (@pxref{Derivations}). @end deffn +@cindex file-like objects +The @code{local-file} and @code{plain-file} procedures below return +@dfn{file-like objects}. That is, when unquoted in a G-expression, +these objects lead to a file in the store. Consider this G-expression: + +@example +#~(system* (string-append #$glibc "/sbin/nscd") "-f" + #$(local-file "/tmp/my-nscd.conf")) +@end example + +The effect here is to ``intern'' @file{/tmp/my-nscd.conf} by copying it +to the store. Once expanded, for instance @i{via} +@code{gexp->derivation}, the G-expression refers to that copy under +@file{/gnu/store}; thus, modifying or removing the file in @file{/tmp} +does not have any effect on what the G-expression does. +@code{plain-file} can be used similarly; it differs in that the file +content is directly passed as a string. + @deffn {Scheme Procedure} local-file @var{file} [@var{name}] @ [#:recursive? #t] Return an object representing local file @var{file} to add to the store; this @@ -2788,6 +3201,13 @@ This is the declarative counterpart of the @code{interned-file} monadic procedure (@pxref{The Store Monad, @code{interned-file}}). @end deffn +@deffn {Scheme Procedure} plain-file @var{name} @var{content} +Return an object representing a text file called @var{name} with the given +@var{content} (a string) to be added to the store. + +This is the declarative counterpart of @code{text-file}. +@end deffn + @deffn {Monadic Procedure} gexp->script @var{name} @var{exp} Return an executable script @var{name} that runs @var{exp} using @var{guile} with @var{modules} in its search path. @@ -2932,6 +3352,49 @@ The returned source tarball is the result of applying any patches and code snippets specified in the package's @code{origin} (@pxref{Defining Packages}). +@item --sources +Fetch and return the source of @var{package-or-derivation} and all their +dependencies, recursively. This is a handy way to obtain a local copy +of all the source code needed to build @var{packages}, allowing you to +eventually build them even without network access. It is an extension +of the @code{--source} option and can accept one of the following +optional argument values: + +@table @code +@item package +This value causes the @code{--sources} option to behave in the same way +as the @code{--source} option. + +@item all +Build all packages' source derivations, including any source that might +be listed as @code{inputs}. This is the default value. + +@example +$ guix build --sources tzdata +The following derivations will be built: + /gnu/store/@dots{}-tzdata2015b.tar.gz.drv + /gnu/store/@dots{}-tzcode2015b.tar.gz.drv +@end example + +@item transitive +Build all packages' source derivations, as well as all source +derivations for packages' transitive inputs. This can be used e.g. to +prefetch package source for later offline building. + +@example +$ guix build --sources=transitive tzdata +The following derivations will be built: + /gnu/store/@dots{}-tzcode2015b.tar.gz.drv + /gnu/store/@dots{}-findutils-4.4.2.tar.xz.drv + /gnu/store/@dots{}-grep-2.21.tar.xz.drv + /gnu/store/@dots{}-coreutils-8.23.tar.xz.drv + /gnu/store/@dots{}-make-4.1.tar.xz.drv + /gnu/store/@dots{}-bash-4.3.tar.xz.drv +@dots{} +@end example + +@end table + @item --system=@var{system} @itemx -s @var{system} Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of @@ -3291,16 +3754,30 @@ dependencies. Specific command-line options are: @table @code +@item --stdin +@itemx -s +Read a Cabal file from the standard input. @item --no-test-dependencies @itemx -t -Do not include dependencies only required to run the test suite. +Do not include dependencies required by the test suites only. +@item --cabal-environment=@var{alist} +@itemx -e @var{alist} +@var{alist} is a Scheme alist defining the environment in which the +Cabal conditionals are evaluated. The accepted keys are: @code{os}, +@code{arch}, @code{impl} and a string representing the name of a flag. +The value associated with a flag has to be either the symbol +@code{true} or @code{false}. The value associated with other keys +has to conform to the Cabal file format definition. The default value +associated with the keys @code{os}, @code{arch} and @code{impl} is +@samp{linux}, @samp{x86_64} and @samp{ghc} respectively. @end table The command below imports meta-data for the latest version of the -@code{HTTP} Haskell package without including test dependencies: +@code{HTTP} Haskell package without including test dependencies and +specifying the value of the flag @samp{network-uri} as @code{false}: @example -guix import hackage -t HTTP +guix import hackage -t -e "'((\"network-uri\" . false))" HTTP @end example A specific package version may optionally be specified by following the @@ -3309,8 +3786,6 @@ package name by a hyphen and a version number as in the following example: @example guix import hackage mtl-2.1.3.1 @end example - -Currently only indentation structured Cabal files are supported. @end table The structure of the @command{guix import} code is modular. It would be @@ -3551,6 +4026,21 @@ evaluates to. @item -E @var{command} Execute @var{command} in the new environment. +@item --ad-hoc +Include all specified packages in the resulting environment, as if an +@i{ad hoc} package were defined with them as inputs. This option is +useful for quickly creating an environment without having to write a +package expression to contain the desired inputs. + +For instance, the command: + +@example +guix environment --ad-hoc guile guile-sdl -E guile +@end example + +runs @command{guile} in an environment where Guile and Guile-SDL are +available. + @item --pure Unset existing environment variables when building the new environment. This has the effect of creating an environment in which search paths @@ -3568,16 +4058,20 @@ build} supports (@pxref{Invoking guix build, common build options}). @section Invoking @command{guix publish} The purpose of @command{guix publish} is to enable users to easily share -their store with others. When @command{guix publish} runs, it spawns an -HTTP server which allows anyone with network access to obtain -substitutes from it. This means that any machine running Guix can also -act as if it were a build farm, since the HTTP interface is -Hydra-compatible. +their store with others, which can then use it as a substitute server +(@pxref{Substitutes}). + +When @command{guix publish} runs, it spawns an HTTP server which allows +anyone with network access to obtain substitutes from it. This means +that any machine running Guix can also act as if it were a build farm, +since the HTTP interface is compatible with Hydra, the software behind +the @code{hydra.gnu.org} build farm. For security, each substitute is signed, allowing recipients to check their authenticity and integrity (@pxref{Substitutes}). Because @command{guix publish} uses the system's signing key, which is only -readable by the system administrator, it must run as root. +readable by the system administrator, it must be started as root; the +@code{--user} option makes it drop root privileges early on. The general syntax is: @@ -3606,10 +4100,20 @@ The following options are available: @itemx -p @var{port} Listen for HTTP requests on @var{port}. +@item --listen=@var{host} +Listen on the network interface for @var{host}. The default is to +accept connections from any interface. + +@item --user=@var{user} +@itemx -u @var{user} +Change privileges to @var{user} as soon as possible---i.e., once the +server socket is open and the signing key has been read. + @item --repl[=@var{port}] @itemx -r [@var{port}] Spawn a Guile REPL server (@pxref{REPL Servers,,, guile, GNU Guile -Reference Manual}) on @var{port} (37146 by default). +Reference Manual}) on @var{port} (37146 by default). This is used +primarily for debugging a running @command{guix publish} server. @end table @c ********************************************************************* @@ -3617,7 +4121,7 @@ Reference Manual}) on @var{port} (37146 by default). @chapter GNU Distribution @cindex Guix System Distribution -@cindex GSD +@cindex GuixSD Guix comes with a distribution of the GNU system consisting entirely of free software@footnote{The term ``free'' here refers to the @url{http://www.gnu.org/philosophy/free-sw.html,freedom provided to @@ -3626,7 +4130,7 @@ distribution can be installed on its own (@pxref{System Installation}), but it is also possible to install Guix as a package manager on top of an installed GNU/Linux system (@pxref{Installation}). To distinguish between the two, we refer to the standalone distribution as the Guix -System Distribution, or GNU@tie{}GSD. +System Distribution, or GuixSD. The distribution provides core GNU packages such as GNU libc, GCC, and Binutils, as well as many GNU and non-GNU applications. The complete @@ -3663,7 +4167,7 @@ n32 application binary interface (ABI), and Linux-Libre kernel. @end table -GSD itself is currently only available on @code{i686} and @code{x86_64}. +GuixSD itself is currently only available on @code{i686} and @code{x86_64}. @noindent For information on porting to other architectures or kernels, @@ -3703,13 +4207,13 @@ link that follows: @pxref{Help,,, info, Info: An Introduction}. Hit @subsection Limitations -As of version @value{VERSION}, the Guix System Distribution (GSD) is +As of version @value{VERSION}, the Guix System Distribution (GuixSD) is not production-ready. It may contain bugs and lack important features. Thus, if you are looking for a stable production system that respects your freedom as a computer user, a good solution at this point is to consider @url{http://www.gnu.org/distros/free-distros.html, one of more established GNU/Linux distributions}. We hope you can soon switch -to the GSD without fear, of course. In the meantime, you can +to the GuixSD without fear, of course. In the meantime, you can also keep using your distribution and try out the package manager on top of it (@pxref{Installation}). @@ -3734,7 +4238,7 @@ Few system services are currently supported out-of-the-box (@pxref{Services}). @item -On the order of 1,200 packages are available, which means that you may +On the order of 1,900 packages are available, which means that you may occasionally find that a useful package is missing. @end itemize @@ -3745,7 +4249,7 @@ to report issues (and success stories!), and join us in improving it. @subsection USB Stick Installation An installation image for USB sticks can be downloaded from -@code{ftp://alpha.gnu.org/gnu/guix/gsd-usb-install-@value{VERSION}.@var{system}.xz}, +@indicateurl{ftp://alpha.gnu.org/gnu/guix/guixsd-usb-install-@value{VERSION}.@var{system}.xz}, where @var{system} is one of: @table @code @@ -3767,7 +4271,7 @@ To copy the image to a USB stick, follow these steps: Decompress the image using the @command{xz} command: @example -xz -d gsd-usb-install-@value{VERSION}.@var{system}.xz +xz -d guixsd-usb-install-@value{VERSION}.@var{system}.xz @end example @item @@ -3776,7 +4280,7 @@ its device name. Assuming that USB stick is known as @file{/dev/sdX}, copy the image with: @example -dd if=gsd-usb-install-@value{VERSION}.x86_64 of=/dev/sdX +dd if=guixsd-usb-install-@value{VERSION}.x86_64 of=/dev/sdX @end example Access to @file{/dev/sdX} usually requires root privileges. @@ -3799,9 +4303,9 @@ To install the system, you would: @enumerate @item -Configure the network, by running @command{dhclient eno1} (to get an -automatically assigned IP address from the wired network interface -controller@footnote{ +Configure the network, by running @command{ifconfig eno1 up && dhclient +eno1} (to get an automatically assigned IP address from the wired +network interface controller@footnote{ @c http://cgit.freedesktop.org/systemd/systemd/tree/src/udev/udev-builtin-net_id.c#n20 The name @code{eno1} is for the first on-board Ethernet controller. The interface name for an Ethernet controller that is in the first slot of @@ -3851,20 +4355,14 @@ that end, the installation system comes with two text editors: GNU nano It is better to store that file on the target root file system, say, as @file{/mnt/etc/config.scm}. -A minimal operating system configuration, with just the bare minimum and -only a root account would look like this (on the installation system, -this example is available as @file{/etc/configuration-template.scm}): +@xref{Using the Configuration System}, for examples of operating system +configurations. These examples are available under +@file{/etc/configuration} in the installation image, so you can copy +them and use them as a starting point for your own configuration. -@example -@include os-config.texi -@end example - -@noindent -For more information on @code{operating-system} declarations, -@pxref{Using the Configuration System}. - -Once that is done, the new system must be initialized (remember that the -target root file system is mounted under @file{/mnt}): +Once you are done preparing the configuration file, the new system must +be initialized (remember that the target root file system is mounted +under @file{/mnt}): @example guix system init /mnt/etc/config.scm /mnt @@ -3929,6 +4427,7 @@ instance to support new system services. * Locales:: Language and cultural convention settings. * Services:: Specifying system services. * Setuid Programs:: Programs running with root privileges. +* X.509 Certificates:: Authenticating HTTPS servers. * Name Service Switch:: Configuring libc's name service switch. * Initial RAM Disk:: Linux-Libre bootstrapping. * GRUB Configuration:: Configuring the boot loader. @@ -3947,29 +4446,7 @@ kernel, initial RAM disk, and boot loader looks like this: @findex operating-system @lisp -(use-modules (gnu) ; for 'user-account', '%base-services', etc. - (gnu packages emacs) ; for 'emacs' - (gnu services ssh)) ; for 'lsh-service' - -(operating-system - (host-name "komputilo") - (timezone "Europe/Paris") - (locale "fr_FR.utf8") - (bootloader (grub-configuration - (device "/dev/sda"))) - (file-systems (cons (file-system - (device "/dev/sda1") ; or partition label - (mount-point "/") - (type "ext3")) - %base-file-systems)) - (users (list (user-account - (name "alice") - (group "users") - (comment "Bob's sister") - (home-directory "/home/alice")))) - (packages (cons emacs %base-packages)) - (services (cons (lsh-service #:port 2222 #:root-login? #t) - %base-services))) +@include os-config-bare-bones.texi @end lisp This example should be self-describing. Some of the fields defined @@ -4002,6 +4479,18 @@ generated as needed (@pxref{Defining Services}). @xref{operating-system Reference}, for details about the available @code{operating-system} fields. +The configuration for a typical ``desktop'' usage, with the X11 display +server, a desktop environment, network management, an SSH server, and +more, would look like this: + +@lisp +@include os-config-desktop.texi +@end lisp + +@xref{Desktop Services}, for the exact list of services provided by +@var{%desktop-services}. @xref{X.509 Certificates}, for background +information about the @code{nss-certs} package that is used here. + Assuming the above snippet is stored in the @file{my-system-config.scm} file, the @command{guix system reconfigure my-system-config.scm} command instantiates that configuration, and makes it the default GRUB boot @@ -4036,7 +4525,7 @@ configuration (@pxref{Using the Configuration System}). @table @asis @item @code{kernel} (default: @var{linux-libre}) -The package object of the operating system to use@footnote{Currently +The package object of the operating system kernel to use@footnote{Currently only the Linux-libre kernel is supported. In the future, it will be possible to use the GNU@tie{}Hurd.}. @@ -4059,9 +4548,9 @@ The host name. @item @code{hosts-file} @cindex hosts file -A zero-argument monadic procedure that returns a text file for use as +A file-like object (@pxref{G-Expressions, file-like objects}) for use as @file{/etc/hosts} (@pxref{Host Names,,, libc, The GNU C Library -Reference Manual}). The default is to produce a file with entries for +Reference Manual}). The default is a file with entries for @code{localhost} and @var{host-name}. @item @code{mapped-devices} (default: @code{'()}) @@ -4076,7 +4565,7 @@ A list of strings identifying devices to be used for ``swap space'' (@pxref{Memory Concepts,,, libc, The GNU C Library Reference Manual}). For example, @code{'("/dev/sda3")}. -@item @code{users} (default: @code{'()}) +@item @code{users} (default: @code{%base-user-accounts}) @itemx @code{groups} (default: @var{%base-groups}) List of user accounts and groups. @xref{User Accounts}. @@ -4135,7 +4624,8 @@ List of string-valued G-expressions denoting setuid programs. @item @code{sudoers} (default: @var{%sudoers-specification}) @cindex sudoers -The contents of the @file{/etc/sudoers} file as a string. +The contents of the @file{/etc/sudoers} file as a file-like object +(@pxref{G-Expressions, @code{local-file} and @code{plain-file}}). This file specifies which users can use the @command{sudo} command, what they are allowed to do, and what privileges they may gain. The default @@ -4455,6 +4945,14 @@ to be present on the system. This includes groups such as ``root'', specific devices such as ``audio'', ``disk'', and ``cdrom''. @end defvr +@defvr {Scheme Variable} %base-user-accounts +This is the list of basic system accounts that programs may expect to +find on a GNU/Linux system, such as the ``nobody'' account. + +Note that the ``root'' account is not included here. It is a +special-case and is automatically added whether or not it is specified. +@end defvr + @node Locales @subsection Locales @@ -4577,6 +5075,8 @@ declaration. * Base Services:: Essential system services. * Networking Services:: Network setup, SSH daemon, etc. * X Window:: Graphical display. +* Desktop Services:: D-Bus and desktop services. +* Database Services:: SQL databases. * Various Services:: Other services. @end menu @@ -4745,6 +5245,11 @@ passed to @command{guix-daemon}. Run @var{udev}, which populates the @file{/dev} directory dynamically. @end deffn +@deffn {Monadic Procedure} console-keymap-service @var{file} +Return a service to load console keymap from @var{file} using +@command{loadkeys} command. +@end deffn + @node Networking Services @subsubsection Networking Services @@ -4862,15 +5367,39 @@ This variable is typically used in the @code{hosts-file} field of an (hosts-file ;; Create a /etc/hosts file with aliases for "localhost" ;; and "mymachine", as well as for Facebook servers. - (text-file "hosts" - (string-append (local-host-aliases host-name) - %facebook-host-aliases)))) + (plain-file "hosts" + (string-append (local-host-aliases host-name) + %facebook-host-aliases)))) @end example This mechanism can prevent programs running locally, such as Web browsers, from accessing Facebook. @end defvr +The @code{(gnu services avahi)} provides the following definition. + +@deffn {Monadic Procedure} avahi-service [#:avahi @var{avahi}] @ + [#:host-name #f] [#:publish? #t] [#:ipv4? #t] @ + [#:ipv6? #t] [#:wide-area? #f] @ + [#:domains-to-browse '()] +Return a service that runs @command{avahi-daemon}, a system-wide +mDNS/DNS-SD responder that allows for service discovery and +"zero-configuration" host name lookups (see @uref{http://avahi.org/}). + +If @var{host-name} is different from @code{#f}, use that as the host name to +publish for this machine; otherwise, use the machine's actual host name. + +When @var{publish?} is true, publishing of host names and services is allowed; +in particular, avahi-daemon will publish the machine's host name and IP +address via mDNS on the local network. + +When @var{wide-area?} is true, DNS-SD over unicast DNS is enabled. + +Boolean values @var{ipv4?} and @var{ipv6?} determine whether to use IPv4/IPv6 +sockets. +@end deffn + + @node X Window @subsubsection X Window @@ -4887,6 +5416,19 @@ Return a service that spawns the SLiM graphical login manager, which in turn starts the X display server with @var{startx}, a command as returned by @code{xorg-start-command}. +@cindex X session + +SLiM automatically looks for session types described by the @file{.desktop} +files in @file{/run/current-system/profile/share/xsessions} and allows users +to choose a session from the log-in screen using @kbd{F1}. Packages such as +@var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files; +adding them to the system-wide set of packages automatically makes them +available at the log-in screen. + +In addition, @file{~/.xsession} files are honored. When available, +@file{~/.xsession} must be an executable that starts a window manager +and/or other X clients. + When @var{allow-empty-passwords?} is true, allow logins with an empty password. When @var{auto-login?} is true, log in automatically as @var{default-user}. @@ -4903,39 +5445,78 @@ The G-Expression denoting the default SLiM theme and its name. @end defvr @deffn {Monadic Procedure} xorg-start-command [#:guile] @ - [#:drivers '()] [#:resolutions '()] [#:xorg-server @var{xorg-server}] + [#:configuration-file #f] [#:xorg-server @var{xorg-server}] Return a derivation that builds a @var{guile} script to start the X server -from @var{xorg-server}. Usually the X server is started by a login manager. +from @var{xorg-server}. @var{configuration-file} is the server configuration +file or a derivation that builds it; when omitted, the result of +@code{xorg-configuration-file} is used. + +Usually the X server is started by a login manager. +@end deffn + +@deffn {Monadic Procedure} xorg-configuration-file @ + [#:drivers '()] [#:resolutions '()] [#:extra-config '()] +Return a configuration file for the Xorg server containing search paths for +all the common drivers. @var{drivers} must be either the empty list, in which case Xorg chooses a graphics driver automatically, or a list of driver names that will be tried in -this order---e.g., @code{("modesetting" "vesa")}. +this order---e.g., @code{(\"modesetting\" \"vesa\")}. Likewise, when @var{resolutions} is the empty list, Xorg chooses an appropriate screen resolution; otherwise, it must be a list of resolutions---e.g., @code{((1024 768) (640 480))}. + +Last, @var{extra-config} is a list of strings or objects appended to the +@code{text-file*} argument list. It is used to pass extra text to be added +verbatim to the configuration file. @end deffn -@node Various Services -@subsubsection Various Services +@node Desktop Services +@subsubsection Desktop Services -The @code{(gnu services lirc)} module provides the following service. +The @code{(gnu services desktop)} module provides services that are +usually useful in the context of a ``desktop'' setup---that is, on a +machine running a graphical display server, possibly with graphical user +interfaces, etc. -@deffn {Monadic Procedure} lirc-service [#:lirc lirc] @ - [#:device #f] [#:driver #f] [#:config-file #f] @ - [#:extra-options '()] -Return a service that runs @url{http://www.lirc.org,LIRC}, a daemon that -decodes infrared signals from remote controls. +To simplify things, the module defines a variable containing the set of +services that users typically expect on a machine with a graphical +environment and networking: -Optionally, @var{device}, @var{driver} and @var{config-file} -(configuration file name) may be specified. See @command{lircd} manual -for details. +@defvr {Scheme Variable} %desktop-services +This is a list of services that builds upon @var{%base-services} and +adds or adjust services for a typical ``desktop'' setup. -Finally, @var{extra-options} is a list of additional command-line options -passed to @command{lircd}. -@end deffn +In particular, it adds a graphical login manager (@pxref{X Window, +@code{slim-service}}), a network management tool (@pxref{Networking +Services, @code{wicd-service}}), energy and color management services, +an NTP client and an SSH server (@pxref{Networking Services}), the Avahi +daemon, and has the name service switch service configured to be able to +use @code{nss-mdns} (@pxref{Name Service Switch, mDNS}). +@end defvr + +The @var{%desktop-services} variable can be used as the @code{services} +field of an @code{operating-system} declaration (@pxref{operating-system +Reference, @code{services}}). + +The actual service definitions provided by @code{(gnu services desktop)} +are described below. -@code{(gnu services upower)} provides a power-management daemon: +@deffn {Monadic Procedure} dbus-service @var{services} @ + [#:dbus @var{dbus}] +Return a service that runs the ``system bus'', using @var{dbus}, with +support for @var{services}. + +@uref{http://dbus.freedesktop.org/, D-Bus} is an inter-process communication +facility. Its system bus is used to allow system services to communicate +and be notified of system-wide events. + +@var{services} must be a list of packages that provide an +@file{etc/dbus-1/system.d} directory containing additional D-Bus configuration +and policy files. For example, to allow avahi-daemon to use the system bus, +@var{services} must be equal to @code{(list avahi)}. +@end deffn @deffn {Monadic Procedure} upower-service [#:upower @var{upower}] @ [#:watts-up-pro? #f] @ @@ -4956,8 +5537,6 @@ levels, with the given configuration settings. It implements the GNOME. @end deffn -@code{(gnu services colord)} provides a color management service: - @deffn {Monadic Procedure} colord-service [#:colord @var{colord}] Return a service that runs @command{colord}, a system service with a D-Bus interface to manage the color profiles of input and output devices such as @@ -4966,6 +5545,41 @@ tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web site} for more information. @end deffn +@node Database Services +@subsubsection Database Services + +The @code{(gnu services databases)} module provides the following service. + +@deffn {Monadic Procedure} postgresql-service [#:postgresql postgresql] @ + [#:config-file] [#:data-directory ``/var/lib/postgresql/data''] +Return a service that runs @var{postgresql}, the PostgreSQL database +server. + +The PostgreSQL daemon loads its runtime configuration from +@var{config-file} and stores the database cluster in +@var{data-directory}. +@end deffn + +@node Various Services +@subsubsection Various Services + +The @code{(gnu services lirc)} module provides the following service. + +@deffn {Monadic Procedure} lirc-service [#:lirc lirc] @ + [#:device #f] [#:driver #f] [#:config-file #f] @ + [#:extra-options '()] +Return a service that runs @url{http://www.lirc.org,LIRC}, a daemon that +decodes infrared signals from remote controls. + +Optionally, @var{device}, @var{driver} and @var{config-file} +(configuration file name) may be specified. See @command{lircd} manual +for details. + +Finally, @var{extra-options} is a list of additional command-line options +passed to @command{lircd}. +@end deffn + + @node Setuid Programs @subsection Setuid Programs @@ -5012,6 +5626,48 @@ Under the hood, the actual setuid programs are created in the files in this directory refer to the ``real'' binaries, which are in the store. +@node X.509 Certificates +@subsection X.509 Certificates + +@cindex HTTPS, certificates +@cindex X.509 certificates +@cindex TLS +Web servers available over HTTPS (that is, HTTP over the transport-layer +security mechanism, TLS) send client programs an @dfn{X.509 certificate} +that the client can then use to @emph{authenticate} the server. To do +that, clients verify that the server's certificate is signed by a +so-called @dfn{certificate authority} (CA). But to verify the CA's +signature, clients must have first acquired the CA's certificate. + +Web browsers such as GNU@tie{}IceCat include their own set of CA +certificates, such that they are able to verify CA signatures +out-of-the-box. + +However, most other programs that can talk HTTPS---@command{wget}, +@command{git}, @command{w3m}, etc.---need to be told where CA +certificates can be found. + +@cindex @code{nss-certs} +In GuixSD, this is done by adding a package that provides certificates +to the @code{packages} field of the @code{operating-system} declaration +(@pxref{operating-system Reference}). GuixSD includes one such package, +@code{nss-certs}, which is a set of CA certificates provided as part of +Mozilla's Network Security Services. + +Note that it is @emph{not} part of @var{%base-packages}, so you need to +explicitly add it. The @file{/etc/ssl/certs} directory, which is where +most applications and libraries look for certificates by default, points +to the certificates installed globally. + +Unprivileged users can also install their own certificate package in +their profile. A number of environment variables need to be defined so +that applications and libraries know where to find them. Namely, the +OpenSSL library honors the @code{SSL_CERT_DIR} and @code{SSL_CERT_FILE} +variables. Some applications add their own environment variables; for +instance, the Git version control system honors the certificate bundle +pointed to by the @code{GIT_SSL_CAINFO} environment variable. + + @node Name Service Switch @subsection Name Service Switch @@ -5064,6 +5720,10 @@ for host names ending in @code{.local}: (name "mdns"))))) @end example +Don't worry: the @code{%mdns-host-lookup-nss} variable (see below) +contains this configuration, so you won't have to type it if all you +want is to have @code{.local} host lookup working. + Note that, in this case, in addition to setting the @code{name-service-switch} of the @code{operating-system} declaration, @code{nscd-service} must be told where to find the @code{nss-mdns} @@ -5091,6 +5751,21 @@ configuration file: @noindent @dots{} and then refer to @var{%my-base-services} instead of @var{%base-services} in the @code{operating-system} declaration. +Lastly, this relies on the availability of the Avahi service +(@pxref{Networking Services, @code{avahi-service}}). + +For convenience, the following variables provide typical NSS +configurations. + +@defvr {Scheme Variable} %default-nss +This is the default name service switch configuration, a +@code{name-service-switch} object. +@end defvr + +@defvr {Scheme Variable} %mdns-host-lookup-nss +This is the name service switch configuration with support for host name +lookup over multicast DNS (mDNS) for host names ending in @code{.local}. +@end defvr The reference for name service switch configuration is given below. It is a direct mapping of the C library's configuration file format, so @@ -5101,11 +5776,6 @@ not only of adding this warm parenthetic feel that we like, but also static checks: you'll know about syntax errors and typos as soon as you run @command{guix system}. -@defvr {Scheme Variable} %default-nss -This is the default name service switch configuration, a -@code{name-service-switch} object. -@end defvr - @deftp {Data Type} name-service-switch This is the data type representation the configuration of libc's name @@ -5355,7 +6025,7 @@ This action does not actually install anything. @item init Populate the given directory with all the files necessary to run the operating system specified in @var{file}. This is useful for first-time -installations of GSD. For instance: +installations of GuixSD. For instance: @example guix system init my-os-config.scm /mnt @@ -5438,6 +6108,25 @@ For the @code{vm-image} and @code{disk-image} actions, create an image of the given @var{size}. @var{size} may be a number of bytes, or it may include a unit as a suffix (@pxref{Block size, size specifications,, coreutils, GNU Coreutils}). + +@item --on-error=@var{strategy} +Apply @var{strategy} when an error occurs when reading @var{file}. +@var{strategy} may be one of the following: + +@table @code +@item nothing-special +Report the error concisely and exit. This is the default strategy. + +@item backtrace +Likewise, but also display a backtrace. + +@item debug +Report the error and enter Guile's debugger. From there, you can run +commands such as @code{,bt} to get a backtrace, @code{,locals} to +display local variable values, and more generally inspect the program's +state. @xref{Debug Commands,,, guile, GNU Guile Reference Manual}, for +a list of available debugging commands. +@end table @end table Note that all the actions above, except @code{build} and @code{init}, @@ -5650,11 +6339,15 @@ facility is implemented in the @code{(gnu packages)} module. @cindex package module search path Users can store package definitions in modules with different names---e.g., @code{(my-packages emacs)}@footnote{Note that the file -name and module name must match. @xref{Modules and the File System,,, -guile, GNU Guile Reference Manual}, for details.} These package definitions +name and module name must match. For instance, the @code{(my-packages +emacs)} module must be stored in a @file{my-packages/emacs.scm} file +relative to the load path specified with @option{--load-path} or +@code{GUIX_PACKAGE_PATH}. @xref{Modules and the File System,,, +guile, GNU Guile Reference Manual}, for details.}. These package definitions will not be visible by default. Thus, users can invoke commands such as @command{guix package} and @command{guix build} have to be used with the -@code{-e} option so that they know where to find the package, or use the +@code{-e} option so that they know where to find the package. Better +yet, they can use the @code{-L} option of these commands to make those modules visible (@pxref{Invoking guix build, @code{--load-path}}), or define the @code{GUIX_PACKAGE_PATH} environment variable. This environment @@ -5702,7 +6395,8 @@ creating packages. For more information on package definitions, Once a package definition is in place, stored in a file in the Guix source tree, it can be tested using the @command{guix build} command (@pxref{Invoking guix build}). For example, assuming the new package is -called @code{gnew}, you may run this command from the Guix build tree: +called @code{gnew}, you may run this command from the Guix build tree +(@pxref{Running Guix Before It Is Installed}): @example ./pre-inst-env guix build gnew --keep-failed @@ -26,6 +26,7 @@ ELFILES = \ emacs/guix-info.el \ emacs/guix-list.el \ emacs/guix-messages.el \ + emacs/guix-pcomplete.el \ emacs/guix-prettify.el \ emacs/guix-utils.el \ emacs/guix.el diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 5129c87a5d..851ee895b9 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -439,6 +439,7 @@ following keywords are available: (define-key map (kbd "r") 'guix-history-forward) (define-key map (kbd "g") 'revert-buffer) (define-key map (kbd "R") 'guix-redisplay-buffer) + (define-key map (kbd "M") 'guix-apply-manifest) (define-key map (kbd "C-c C-z") 'guix-switch-to-repl))))) (put 'guix-define-buffer-type 'lisp-indent-function 'defun) @@ -1022,6 +1023,32 @@ Ask a user with PROMPT for continuing an operation." :dry-run? (or guix-dry-run 'f)) nil 'source-download))) +;;;###autoload +(defun guix-apply-manifest (profile file &optional operation-buffer) + "Apply manifest from FILE to PROFILE. +This function has the same meaning as 'guix package --manifest' command. +See Info node `(guix) Invoking guix package' for details. + +Interactively, use the current profile and prompt for manifest +FILE. With a prefix argument, also prompt for PROFILE." + (interactive + (let* ((default-profile (or guix-profile guix-current-profile)) + (profile (if current-prefix-arg + (guix-profile-prompt) + default-profile)) + (file (read-file-name "File with manifest: ")) + (buffer (and guix-profile (current-buffer)))) + (list profile file buffer))) + (when (or (not guix-operation-confirm) + (y-or-n-p (format "Apply manifest from '%s' to profile '%s'? " + file profile))) + (guix-eval-in-repl + (guix-make-guile-expression + 'guix-package + (concat "--profile=" profile) + (concat "--manifest=" file)) + operation-buffer))) + ;;; Pull diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 600f2bd9bd..279de818c6 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -292,13 +292,11 @@ See `guix-list-marked' for the meaning of ARGS." See `guix-list-get-marked' for details." (mapcar #'car (apply #'guix-list-get-marked mark-names))) -(defun guix-list-mark (mark-name &optional advance &rest args) +(defun guix-list--mark (mark-name &optional advance &rest args) "Put a mark on the current line. Also add the current entry to `guix-list-marked' using its ID and ARGS. MARK-NAME is a symbol from `guix-list-mark-alist'. -If ADVANCE is non-nil, move forward by one line after marking. -Interactively, put a general mark and move to the next line." - (interactive '(general t)) +If ADVANCE is non-nil, move forward by one line after marking." (let ((id (guix-list-current-id))) (if (eq mark-name 'empty) (setq guix-list-marked (assq-delete-all id guix-list-marked)) @@ -310,12 +308,21 @@ Interactively, put a general mark and move to the next line." (tabulated-list-put-tag (guix-list-get-mark-string mark-name) advance)) -(defun guix-list-mark-all (mark-name) +(defun guix-list-mark (&optional arg) + "Mark the current line and move to the next line. +With ARG, mark all lines." + (interactive "P") + (if arg + (guix-list-mark-all) + (guix-list--mark 'general t))) + +(defun guix-list-mark-all (&optional mark-name) "Mark all lines with MARK-NAME mark. MARK-NAME is a symbol from `guix-list-mark-alist'. Interactively, put a general mark on all lines." - (interactive '(general)) - (guix-list-for-each-line #'guix-list-mark mark-name)) + (interactive) + (or mark-name (setq mark-name 'general)) + (guix-list-for-each-line #'guix-list--mark mark-name)) (defun guix-list-unmark (&optional arg) "Unmark the current line and move to the next line. @@ -323,13 +330,13 @@ With ARG, unmark all lines." (interactive "P") (if arg (guix-list-unmark-all) - (guix-list-mark 'empty t))) + (guix-list--mark 'empty t))) (defun guix-list-unmark-backward () "Move up one line and unmark it." (interactive) (forward-line -1) - (guix-list-mark 'empty)) + (guix-list--mark 'empty)) (defun guix-list-unmark-all () "Unmark all lines." @@ -360,7 +367,6 @@ Same as `tabulated-list-sort', but also restore marks after sorting." (define-key map (kbd "RET") 'guix-list-describe) (define-key map (kbd "m") 'guix-list-mark) (define-key map (kbd "*") 'guix-list-mark) - (define-key map (kbd "M") 'guix-list-mark-all) (define-key map (kbd "u") 'guix-list-unmark) (define-key map (kbd "DEL") 'guix-list-unmark-backward) (define-key map [remap tabulated-list-sort] 'guix-list-sort) @@ -417,7 +423,7 @@ This macro defines the following functions: ,(concat "Put '" mark-name-str "' mark and move to the next line.\n" "Also add the current entry to `guix-list-marked'.") (interactive) - (guix-list-mark ',mark-name t)))) + (guix-list--mark ',mark-name t)))) marks-val) (defun ,init-fun () @@ -531,7 +537,7 @@ AVAILABLE list, otherwise mark all DEFAULT outputs." (guix-completing-read-multiple prompt available nil t) default))) - (apply #'guix-list-mark mark t outputs))) + (apply #'guix-list--mark mark t outputs))) (defun guix-package-list-mark-install (&optional arg) "Mark the current package for installation and move to the next line. @@ -606,7 +612,7 @@ accept an entry as argument." (interactive) (guix-list-mark-package-upgrades (lambda (entry) - (apply #'guix-list-mark + (apply #'guix-list--mark 'upgrade nil (guix-get-installed-outputs entry))))) @@ -661,7 +667,7 @@ The specification is suitable for `guix-process-package-actions'." (installed (guix-get-key-val entry 'installed))) (if installed (user-error "This output is already installed") - (guix-list-mark 'install t)))) + (guix-list--mark 'install t)))) (defun guix-output-list-mark-delete () "Mark the current output for deletion and move to the next line." @@ -670,7 +676,7 @@ The specification is suitable for `guix-process-package-actions'." (let* ((entry (guix-list-current-entry)) (installed (guix-get-key-val entry 'installed))) (if installed - (guix-list-mark 'delete t) + (guix-list--mark 'delete t) (user-error "This output is not installed")))) (defun guix-output-list-mark-upgrade () @@ -683,13 +689,13 @@ The specification is suitable for `guix-process-package-actions'." (user-error "This output is not installed")) (when (or (guix-get-key-val entry 'obsolete) (y-or-n-p "This output is not obsolete. Try to upgrade it anyway? ")) - (guix-list-mark 'upgrade t)))) + (guix-list--mark 'upgrade t)))) (defun guix-output-list-mark-upgrades () "Mark all obsolete package outputs for upgrading." (interactive) (guix-list-mark-package-upgrades - (lambda (_) (guix-list-mark 'upgrade)))) + (lambda (_) (guix-list--mark 'upgrade)))) (defun guix-output-list-execute () "Perform actions on the marked outputs." @@ -850,7 +856,7 @@ With ARG, mark all generations for deletion." (interactive "P") (if arg (guix-list-mark-all 'delete) - (guix-list-mark 'delete t))) + (guix-list--mark 'delete t))) (defun guix-generation-list-execute () "Delete marked generations." diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index b1662fbb80..c6e4a8259b 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -878,7 +878,8 @@ OUTPUTS is a list of package outputs (may be an empty list)." (format #t (N_ "~a package in profile~%" "~a packages in profile~%" count) - count)))))))))) + count) + (display-search-paths entries profile)))))))))) (define (delete-generations* profile generations) "Delete GENERATIONS from PROFILE. diff --git a/emacs/guix-pcomplete.el b/emacs/guix-pcomplete.el new file mode 100644 index 0000000000..fa71dd5e21 --- /dev/null +++ b/emacs/guix-pcomplete.el @@ -0,0 +1,392 @@ +;;; guix-pcomplete.el --- Functions for completing guix commands -*- lexical-binding: t -*- + +;; Copyright © 2015 Alex Kost <alezost@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 this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file provides completions for "guix" command that may be used in +;; `shell', `eshell' and wherever `pcomplete' works. + +;;; Code: + +(require 'pcomplete) +(require 'pcmpl-unix) +(require 'cl-lib) +(require 'guix-utils) + + +;;; Regexps for parsing various "guix ..." outputs + +(defvar guix-pcomplete-parse-package-regexp + (rx bol (group (one-or-more (not blank)))) + "Regexp used to find names of the packages.") + +(defvar guix-pcomplete-parse-command-regexp + (rx bol " " + (group wordchar (one-or-more (or wordchar "-")))) + "Regexp used to find guix commands. +'Command' means any option not prefixed with '-'. For example, +guix subcommand, system action, importer, etc.") + +(defvar guix-pcomplete-parse-long-option-regexp + (rx (or " " ", ") + (group "--" (one-or-more (or wordchar "-")) + (zero-or-one "="))) + "Regexp used to find long options.") + +(defvar guix-pcomplete-parse-short-option-regexp + (rx bol (one-or-more blank) + "-" (group (not (any "- ")))) + "Regexp used to find short options.") + +(defvar guix-pcomplete-parse-linter-regexp + (rx bol "- " (group (one-or-more (or wordchar "-")))) + "Regexp used to find 'lint' checkers.") + +(defvar guix-pcomplete-parse-regexp-group 1 + "Parenthesized expression of regexps used to find commands and +options.") + + +;;; Non-receivable completions + +(defvar guix-pcomplete-systems + '("x86_64-linux" "i686-linux" "armhf-linux" "mips64el-linux") + "List of supported systems.") + +(defvar guix-pcomplete-hash-formats + '("nix-base32" "base32" "base16" "hex" "hexadecimal") + "List of supported hash formats.") + +(defvar guix-pcomplete-refresh-subsets + '("core" "non-core") + "List of supported 'refresh' subsets.") + +(defvar guix-pcomplete-key-policies + '("interactive" "always" "never") + "List of supported key download policies.") + + +;;; Interacting with guix + +(defcustom guix-pcomplete-guix-program (executable-find "guix") + "Name of the 'guix' program. +It is used to find guix commands, options, packages, etc." + :type 'file + :group 'pcomplete + :group 'guix) + +(defun guix-pcomplete-run-guix (&rest args) + "Run `guix-pcomplete-guix-program' with ARGS. +Insert the output to the current buffer." + (apply #'call-process + guix-pcomplete-guix-program nil t nil args)) + +(defun guix-pcomplete-run-guix-and-search (regexp &optional group + &rest args) + "Run `guix-pcomplete-guix-program' with ARGS and search for matches. +Return a list of strings matching REGEXP. +GROUP specifies a parenthesized expression used in REGEXP." + (with-temp-buffer + (apply #'guix-pcomplete-run-guix args) + (goto-char (point-min)) + (let (result) + (while (re-search-forward regexp nil t) + (push (match-string-no-properties group) result)) + (nreverse result)))) + +(defmacro guix-pcomplete-define-options-finder (name docstring regexp + &optional filter) + "Define function NAME to receive guix options and commands. + +The defined function takes an optional COMMAND argument. This +function will run 'guix COMMAND --help' (or 'guix --help' if +COMMAND is nil) using `guix-pcomplete-run-guix-and-search' and +return its result. + +If FILTER is specified, it should be a function. The result is +passed to this FILTER as argument and the result value of this +function call is returned." + (declare (doc-string 2) (indent 1)) + `(guix-memoized-defun ,name (&optional command) + ,docstring + (let* ((args '("--help")) + (args (if command (cons command args) args)) + (res (apply #'guix-pcomplete-run-guix-and-search + ,regexp guix-pcomplete-parse-regexp-group args))) + ,(if filter + `(funcall ,filter res) + 'res)))) + +(guix-pcomplete-define-options-finder guix-pcomplete-commands + "If COMMAND is nil, return a list of available guix commands. +If COMMAND is non-nil (it should be a string), return available +subcommands, actions, etc. for this guix COMMAND." + guix-pcomplete-parse-command-regexp) + +(guix-pcomplete-define-options-finder guix-pcomplete-long-options + "Return a list of available long options for guix COMMAND." + guix-pcomplete-parse-long-option-regexp) + +(guix-pcomplete-define-options-finder guix-pcomplete-short-options + "Return a string with available short options for guix COMMAND." + guix-pcomplete-parse-short-option-regexp + (lambda (list) + (mapconcat #'identity list ""))) + +(guix-memoized-defun guix-pcomplete-all-packages () + "Return a list of all available Guix packages." + (guix-pcomplete-run-guix-and-search + guix-pcomplete-parse-package-regexp + guix-pcomplete-parse-regexp-group + "package" "--list-available")) + +(guix-memoized-defun guix-pcomplete-installed-packages (&optional profile) + "Return a list of Guix packages installed in PROFILE." + (let* ((args (and profile + (list (concat "--profile=" profile)))) + (args (append '("package" "--list-installed") args))) + (apply #'guix-pcomplete-run-guix-and-search + guix-pcomplete-parse-package-regexp + guix-pcomplete-parse-regexp-group + args))) + +(guix-memoized-defun guix-pcomplete-lint-checkers () + "Return a list of all available lint checkers." + (guix-pcomplete-run-guix-and-search + guix-pcomplete-parse-linter-regexp + guix-pcomplete-parse-regexp-group + "lint" "--list-checkers")) + + +;;; Completing + +(defvar guix-pcomplete-option-regexp (rx string-start "-") + "Regexp to match an option.") + +(defvar guix-pcomplete-long-option-regexp (rx string-start "--") + "Regexp to match a long option.") + +(defvar guix-pcomplete-long-option-with-arg-regexp + (rx string-start + (group "--" (one-or-more any)) "=" + (group (zero-or-more any))) + "Regexp to match a long option with its argument. +The first parenthesized group defines the option and the second +group - the argument.") + +(defvar guix-pcomplete-short-option-with-arg-regexp + (rx string-start + (group "-" (not (any "-"))) + (group (zero-or-more any))) + "Regexp to match a short option with its argument. +The first parenthesized group defines the option and the second +group - the argument.") + +(defun guix-pcomplete-match-option () + "Return non-nil, if the current argument is an option." + (pcomplete-match guix-pcomplete-option-regexp 0)) + +(defun guix-pcomplete-match-long-option () + "Return non-nil, if the current argument is a long option." + (pcomplete-match guix-pcomplete-long-option-regexp 0)) + +(defun guix-pcomplete-match-long-option-with-arg () + "Return non-nil, if the current argument is a long option with value." + (pcomplete-match guix-pcomplete-long-option-with-arg-regexp 0)) + +(defun guix-pcomplete-match-short-option-with-arg () + "Return non-nil, if the current argument is a short option with value." + (pcomplete-match guix-pcomplete-short-option-with-arg-regexp 0)) + +(defun guix-pcomplete-long-option-arg (option args) + "Return a long OPTION's argument from a list of arguments ARGS." + (let* ((re (concat "\\`" option "=\\(.*\\)")) + (args (cl-member-if (lambda (arg) + (string-match re arg)) + args)) + (cur (car args))) + (when cur + (match-string-no-properties 1 cur)))) + +(defun guix-pcomplete-short-option-arg (option args) + "Return a short OPTION's argument from a list of arguments ARGS." + (let* ((re (concat "\\`" option "\\(.*\\)")) + (args (cl-member-if (lambda (arg) + (string-match re arg)) + args)) + (cur (car args))) + (when cur + (let ((arg (match-string-no-properties 1 cur))) + (if (string= "" arg) + (cadr args) ; take the next arg + arg))))) + +(defun guix-pcomplete-complete-comma-args (entries) + "Complete comma separated arguments using ENTRIES." + (let ((index pcomplete-index)) + (while (= index pcomplete-index) + (let* ((args (if (or (guix-pcomplete-match-long-option-with-arg) + (guix-pcomplete-match-short-option-with-arg)) + (pcomplete-match-string 2 0) + (pcomplete-arg 0))) + (input (if (string-match ".*,\\(.*\\)" args) + (match-string-no-properties 1 args) + args))) + (pcomplete-here* entries input))))) + +(defun guix-pcomplete-complete-command-arg (command) + "Complete argument for guix COMMAND." + (cond + ((member command + '("archive" "build" "environment" "lint" "refresh")) + (while t + (pcomplete-here (guix-pcomplete-all-packages)))) + (t (pcomplete-here* (pcomplete-entries))))) + +(defun guix-pcomplete-complete-option-arg (command option &optional input) + "Complete argument for COMMAND's OPTION. +INPUT is the current partially completed string." + (cl-flet ((option? (short long) + (or (string= option short) + (string= option long))) + (command? (&rest commands) + (member command commands)) + (complete (entries) + (pcomplete-here entries input nil t)) + (complete* (entries) + (pcomplete-here* entries input t))) + (cond + ((option? "-L" "--load-path") + (complete* (pcomplete-dirs))) + ((string= "--key-download" option) + (complete* guix-pcomplete-key-policies)) + + ((command? "package") + (cond + ;; For '--install[=]' and '--remove[=]', try to complete a package + ;; name (INPUT) after the "=" sign, and then the rest packages + ;; separated with spaces. + ((option? "-i" "--install") + (complete (guix-pcomplete-all-packages)) + (while (not (guix-pcomplete-match-option)) + (pcomplete-here (guix-pcomplete-all-packages)))) + ((option? "-r" "--remove") + (let* ((profile (or (guix-pcomplete-short-option-arg + "-p" pcomplete-args) + (guix-pcomplete-long-option-arg + "--profile" pcomplete-args))) + (profile (and profile (expand-file-name profile)))) + (complete (guix-pcomplete-installed-packages profile)) + (while (not (guix-pcomplete-match-option)) + (pcomplete-here (guix-pcomplete-installed-packages profile))))) + ((string= "--show" option) + (complete (guix-pcomplete-all-packages))) + ((option? "-p" "--profile") + (complete* (pcomplete-dirs))) + ((option? "-m" "--manifest") + (complete* (pcomplete-entries))))) + + ((and (command? "archive" "build") + (option? "-s" "--system")) + (complete* guix-pcomplete-systems)) + + ((and (command? "build") + (option? "-r" "--root")) + (complete* (pcomplete-entries))) + + ((and (command? "environment") + (option? "-l" "--load")) + (complete* (pcomplete-entries))) + + ((and (command? "hash" "download") + (option? "-f" "--format")) + (complete* guix-pcomplete-hash-formats)) + + ((and (command? "lint") + (option? "-c" "--checkers")) + (guix-pcomplete-complete-comma-args + (guix-pcomplete-lint-checkers))) + + ((and (command? "publish") + (option? "-u" "--user")) + (complete* (pcmpl-unix-user-names))) + + ((and (command? "refresh") + (option? "-s" "--select")) + (complete* guix-pcomplete-refresh-subsets))))) + +(defun guix-pcomplete-complete-options (command) + "Complete options (with their arguments) for guix COMMAND." + (while (guix-pcomplete-match-option) + (let ((index pcomplete-index)) + (if (guix-pcomplete-match-long-option) + + ;; Long options. + (if (guix-pcomplete-match-long-option-with-arg) + (let ((option (pcomplete-match-string 1 0)) + (arg (pcomplete-match-string 2 0))) + (guix-pcomplete-complete-option-arg + command option arg)) + + (pcomplete-here* (guix-pcomplete-long-options command)) + ;; We support '--opt arg' style (along with '--opt=arg'), + ;; because 'guix package --install/--remove' may be used this + ;; way. So try to complete an argument after the option has + ;; been completed. + (unless (guix-pcomplete-match-option) + (guix-pcomplete-complete-option-arg + command (pcomplete-arg 0 -1)))) + + ;; Short options. + (let ((arg (pcomplete-arg 0))) + (if (> (length arg) 2) + ;; Support specifying an argument after a short option without + ;; spaces (for example, '-L/tmp/foo'). + (guix-pcomplete-complete-option-arg + command + (substring-no-properties arg 0 2) + (substring-no-properties arg 2)) + (pcomplete-opt (guix-pcomplete-short-options command)) + (guix-pcomplete-complete-option-arg + command (pcomplete-arg 0 -1))))) + + ;; If there were no completions, move to the next argument and get + ;; out if the last argument is achieved. + (when (= index pcomplete-index) + (if (= pcomplete-index pcomplete-last) + (throw 'pcompleted nil) + (pcomplete-next-arg)))))) + +;;;###autoload +(defun pcomplete/guix () + "Completion for `guix'." + (let ((commands (guix-pcomplete-commands))) + (pcomplete-here* (cons "--help" commands)) + (let ((command (pcomplete-arg 'first 1))) + (when (member command commands) + (guix-pcomplete-complete-options command) + (let ((subcommands (guix-pcomplete-commands command))) + (when subcommands + (pcomplete-here* subcommands))) + (guix-pcomplete-complete-options command) + (guix-pcomplete-complete-command-arg command))))) + +(provide 'guix-pcomplete) + +;;; guix-pcomplete.el ends here diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el index 823c646610..dc0c58a114 100644 --- a/emacs/guix-utils.el +++ b/emacs/guix-utils.el @@ -1,6 +1,6 @@ -;;; guix-utils.el --- General utility functions +;;; guix-utils.el --- General utility functions -*- lexical-binding: t -*- -;; Copyright © 2014 Alex Kost <alezost@gmail.com> +;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> ;; This file is part of GNU Guix. @@ -170,6 +170,35 @@ accessed with KEYS." "Same as `diff', but use `guix-diff-switches' as default." (diff old new (or switches guix-diff-switches) no-async)) + +;;; Memoizing + +(defun guix-memoize (function) + "Return a memoized version of FUNCTION." + (let ((cache (make-hash-table :test 'equal))) + (lambda (&rest args) + (let ((result (gethash args cache 'not-found))) + (if (eq result 'not-found) + (let ((result (apply function args))) + (puthash args result cache) + result) + result))))) + +(defmacro guix-memoized-defun (name arglist docstring &rest body) + "Define a memoized function NAME. +See `defun' for the meaning of arguments." + (declare (doc-string 3) (indent 2)) + `(defalias ',name + (guix-memoize (lambda ,arglist ,@body)) + ;; Add '(name args ...)' string with real arglist to the docstring, + ;; because *Help* will display '(name &rest ARGS)' for a defined + ;; function (since `guix-memoize' returns a lambda with '(&rest + ;; args)'). + ,(format "(%S %s)\n\n%s" + name + (mapconcat #'symbol-name arglist " ") + docstring))) + (provide 'guix-utils) ;;; guix-utils.el ends here diff --git a/gnu-system.am b/gnu-system.am index d4631d6c9e..206c87680e 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -124,6 +124,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/gl.scm \ gnu/packages/glib.scm \ gnu/packages/gnome.scm \ + gnu/packages/gnucash.scm \ gnu/packages/gnunet.scm \ gnu/packages/gnupg.scm \ gnu/packages/gnustep.scm \ @@ -173,6 +174,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/libffcall.scm \ gnu/packages/libffi.scm \ gnu/packages/libftdi.scm \ + gnu/packages/calendar.scm \ gnu/packages/libidn.scm \ gnu/packages/libphidget.scm \ gnu/packages/libreoffice.scm \ @@ -217,6 +219,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/ncurses.scm \ gnu/packages/netpbm.scm \ gnu/packages/nettle.scm \ + gnu/packages/networking.scm \ gnu/packages/ninja.scm \ gnu/packages/node.scm \ gnu/packages/noweb.scm \ @@ -273,13 +276,13 @@ GNU_SYSTEM_MODULES = \ gnu/packages/slang.scm \ gnu/packages/slim.scm \ gnu/packages/smalltalk.scm \ - gnu/packages/socat.scm \ gnu/packages/ssh.scm \ gnu/packages/stalonetray.scm \ gnu/packages/statistics.scm \ gnu/packages/swig.scm \ gnu/packages/sxiv.scm \ gnu/packages/synergy.scm \ + gnu/packages/task-management.scm \ gnu/packages/tbb.scm \ gnu/packages/tcl.scm \ gnu/packages/tcsh.scm \ @@ -291,6 +294,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/tmux.scm \ gnu/packages/tor.scm \ gnu/packages/tre.scm \ + gnu/packages/tv.scm \ gnu/packages/unrtf.scm \ gnu/packages/upnp.scm \ gnu/packages/uucp.scm \ @@ -327,13 +331,12 @@ GNU_SYSTEM_MODULES = \ gnu/services.scm \ gnu/services/avahi.scm \ gnu/services/base.scm \ - gnu/services/colord.scm \ - gnu/services/dbus.scm \ + gnu/services/databases.scm \ + gnu/services/desktop.scm \ gnu/services/dmd.scm \ gnu/services/lirc.scm \ gnu/services/networking.scm \ gnu/services/ssh.scm \ - gnu/services/upower.scm \ gnu/services/xorg.scm \ \ gnu/system.scm \ @@ -384,6 +387,7 @@ dist_patch_DATA = \ gnu/packages/patches/bigloo-gc-shebangs.patch \ gnu/packages/patches/binutils-ld-new-dtags.patch \ gnu/packages/patches/binutils-loongson-workaround.patch \ + gnu/packages/patches/bitlbee-configure-doc-fix.patch \ gnu/packages/patches/calibre-drop-unrar.patch \ gnu/packages/patches/calibre-no-updates-dialog.patch \ gnu/packages/patches/cdparanoia-fpic.patch \ @@ -403,8 +407,6 @@ dist_patch_DATA = \ gnu/packages/patches/cssc-missing-include.patch \ gnu/packages/patches/clucene-contribs-lib.patch \ gnu/packages/patches/cursynth-wave-rand.patch \ - gnu/packages/patches/curl-support-capath-on-gnutls.patch \ - gnu/packages/patches/curl-support-capath-on-gnutls-conf.patch \ gnu/packages/patches/dbus-localstatedir.patch \ gnu/packages/patches/diffutils-gets-undeclared.patch \ gnu/packages/patches/dfu-programmer-fix-libusb.patch \ @@ -419,10 +421,13 @@ dist_patch_DATA = \ gnu/packages/patches/findutils-localstatedir.patch \ gnu/packages/patches/flashrom-use-libftdi1.patch \ gnu/packages/patches/flex-bison-tests.patch \ + gnu/packages/patches/fltk-shared-lib-defines.patch \ + gnu/packages/patches/fuse-CVE-2015-3202.patch \ gnu/packages/patches/gawk-shell.patch \ gnu/packages/patches/gcc-arm-link-spec-fix.patch \ gnu/packages/patches/gcc-cross-environment-variables.patch \ gnu/packages/patches/gcc-libvtv-runpath.patch \ + gnu/packages/patches/gcc-5.0-libvtv-runpath.patch \ gnu/packages/patches/geoclue-config.patch \ gnu/packages/patches/ghostscript-runpath.patch \ gnu/packages/patches/gitolite-openssh-6.8-compat.patch \ @@ -435,7 +440,6 @@ dist_patch_DATA = \ gnu/packages/patches/glibc-ldd-x86_64.patch \ gnu/packages/patches/glibc-locales.patch \ gnu/packages/patches/gmp-arm-asm-nothumb.patch \ - gnu/packages/patches/gnutls-fix-duplicate-manpages.patch \ gnu/packages/patches/gobject-introspection-absolute-shlib-path.patch \ gnu/packages/patches/gobject-introspection-cc.patch \ gnu/packages/patches/gobject-introspection-girepository.patch \ @@ -447,10 +451,9 @@ dist_patch_DATA = \ gnu/packages/patches/guile-default-utf8.patch \ gnu/packages/patches/guile-linux-syscalls.patch \ gnu/packages/patches/guile-relocatable.patch \ - gnu/packages/patches/guix-test-networking.patch \ gnu/packages/patches/gtkglext-disable-disable-deprecated.patch \ gnu/packages/patches/hop-bigloo-4.0b.patch \ - gnu/packages/patches/inetutils-syslogd.patch \ + gnu/packages/patches/hop-linker-flags.patch \ gnu/packages/patches/irrlicht-mesa-10.patch \ gnu/packages/patches/jbig2dec-ignore-testtest.patch \ gnu/packages/patches/kmod-module-directory.patch \ @@ -464,13 +467,11 @@ dist_patch_DATA = \ gnu/packages/patches/liboop-mips64-deplibs-fix.patch \ gnu/packages/patches/libmad-mips-newgcc.patch \ gnu/packages/patches/libtheora-config-guess.patch \ - gnu/packages/patches/libtool-skip-tests.patch \ gnu/packages/patches/libtool-skip-tests2.patch \ gnu/packages/patches/libssh-CVE-2014-0017.patch \ gnu/packages/patches/libvpx-fix-armhf-link.patch \ gnu/packages/patches/libvpx-fix-ssse3-quantize.patch \ gnu/packages/patches/libvpx-vp9-out-of-bounds-access.patch \ - gnu/packages/patches/linux-libre-libreboot-fix.patch \ gnu/packages/patches/lirc-localstatedir.patch \ gnu/packages/patches/lm-sensors-hwmon-attrs.patch \ gnu/packages/patches/lua51-liblua-so.patch \ @@ -479,6 +480,7 @@ dist_patch_DATA = \ gnu/packages/patches/luit-posix.patch \ gnu/packages/patches/m4-gets-undeclared.patch \ gnu/packages/patches/make-impure-dirs.patch \ + gnu/packages/patches/maxima-defsystem-mkdir.patch \ gnu/packages/patches/mc-fix-ncurses-build.patch \ gnu/packages/patches/mcron-install.patch \ gnu/packages/patches/mhash-keygen-test-segfault.patch \ @@ -523,14 +525,16 @@ dist_patch_DATA = \ gnu/packages/patches/pyqt-configure.patch \ gnu/packages/patches/python-fix-tests.patch \ gnu/packages/patches/python-libffi-mips-n32-fix.patch \ - gnu/packages/patches/python-sqlite-3.8.4-test-fix.patch \ gnu/packages/patches/python2-rdflib-drop-sparqlwrapper.patch \ gnu/packages/patches/python2-sqlite-3.8.4-test-fix.patch \ gnu/packages/patches/python2-pygobject-2-gi-info-type-error-domain.patch \ + gnu/packages/patches/qemu-CVE-2015-3209.patch \ + gnu/packages/patches/qemu-CVE-2015-3456.patch \ gnu/packages/patches/qt4-ldflags.patch \ gnu/packages/patches/qt4-tests.patch \ gnu/packages/patches/qt5-conflicting-typedefs.patch \ gnu/packages/patches/qt5-runpath.patch \ + gnu/packages/patches/r-fix-15899.patch \ gnu/packages/patches/ratpoison-shell.patch \ gnu/packages/patches/readline-link-ncurses.patch \ gnu/packages/patches/ripperx-libm.patch \ @@ -538,17 +542,23 @@ dist_patch_DATA = \ gnu/packages/patches/scheme48-tests.patch \ gnu/packages/patches/scotch-test-threading.patch \ gnu/packages/patches/sdl-libx11-1.6.patch \ + gnu/packages/patches/serf-comment-style-fix.patch \ + gnu/packages/patches/serf-deflate-buckets-test-fix.patch \ gnu/packages/patches/slim-session.patch \ gnu/packages/patches/slim-config.patch \ gnu/packages/patches/slim-sigusr1.patch \ gnu/packages/patches/soprano-find-clucene.patch \ + gnu/packages/patches/subversion-sqlite-3.8.9-fix.patch \ gnu/packages/patches/superlu-dist-scotchmetis.patch \ gnu/packages/patches/tar-d_ino_in_dirent-fix.patch \ gnu/packages/patches/tcsh-fix-autotest.patch \ gnu/packages/patches/teckit-cstdio.patch \ gnu/packages/patches/texi2html-document-encoding.patch \ gnu/packages/patches/texi2html-i18n.patch \ - gnu/packages/patches/udev-gir-libtool.patch \ + gnu/packages/patches/tvtime-gcc41.patch \ + gnu/packages/patches/tvtime-pngoutput.patch \ + gnu/packages/patches/tvtime-videodev2.patch \ + gnu/packages/patches/tvtime-xmltv.patch \ gnu/packages/patches/unzip-CVE-2014-8139.patch \ gnu/packages/patches/unzip-CVE-2014-8140.patch \ gnu/packages/patches/unzip-CVE-2014-8141.patch \ @@ -559,9 +569,17 @@ dist_patch_DATA = \ gnu/packages/patches/vtk-mesa-10.patch \ gnu/packages/patches/w3m-fix-compile.patch \ gnu/packages/patches/weex-vacopy.patch \ + gnu/packages/patches/wicd-template-instantiation.patch \ gnu/packages/patches/wicd-urwid-1.3.patch \ gnu/packages/patches/wmctrl-64-fix.patch \ gnu/packages/patches/wpa-supplicant-CVE-2015-1863.patch \ + gnu/packages/patches/wpa-supplicant-2015-2-fix.patch \ + gnu/packages/patches/wpa-supplicant-2015-3-fix.patch \ + gnu/packages/patches/wpa-supplicant-2015-4-fix-pt1.patch \ + gnu/packages/patches/wpa-supplicant-2015-4-fix-pt2.patch \ + gnu/packages/patches/wpa-supplicant-2015-4-fix-pt3.patch \ + gnu/packages/patches/wpa-supplicant-2015-4-fix-pt4.patch \ + gnu/packages/patches/wpa-supplicant-2015-4-fix-pt5.patch \ gnu/packages/patches/xf86-video-ark-remove-mibstore.patch \ gnu/packages/patches/xf86-video-ast-remove-mibstore.patch \ gnu/packages/patches/xf86-video-geode-glibc-2.20.patch \ diff --git a/gnu/artwork.scm b/gnu/artwork.scm index c3b1695ba7..94c89143a6 100644 --- a/gnu/artwork.scm +++ b/gnu/artwork.scm @@ -32,9 +32,9 @@ (method git-fetch) (uri (git-reference (url "git://git.savannah.gnu.org/guix/guix-artwork.git") - (commit "61ae7c8"))) + (commit "6998d30"))) (sha256 (base32 - "102fxk2l6b0ibry3n430q8ljhwrnbml9qgalzkz6v09r7sx6a532")))) + "0k7j3pj9s3zqiqmfkapypssvzx3f12yr0cc2rbzxqfii0b4clp1j")))) ;;; artwork.scm ends here diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index 0c60355a1c..352e736050 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -78,6 +78,11 @@ (define (dot-or-dot-dot? file) (member file '("." ".."))) +(define (make-file-writable file) + "Make FILE writable for its owner.." + (let ((stat (lstat file))) ;XXX: symlinks + (chmod file (logior #o600 (stat:perms stat))))) + (define* (copy-account-skeletons home #:optional (directory %skeleton-directory)) "Copy the account skeletons from DIRECTORY to HOME." @@ -85,8 +90,21 @@ string<?))) (mkdir-p home) (for-each (lambda (file) - (copy-file (string-append directory "/" file) - (string-append home "/" file))) + (let ((target (string-append home "/" file))) + (copy-file (string-append directory "/" file) target) + (make-file-writable target))) + files))) + +(define* (make-skeletons-writable home + #:optional (directory %skeleton-directory)) + "Make sure that the files that have been copied from DIRECTORY to HOME are +owner-writable in HOME." + (let ((files (scandir directory (negate dot-or-dot-dot?) + string<?))) + (for-each (lambda (file) + (let ((target (string-append home "/" file))) + (when (file-exists? target) + (make-file-writable target)))) files))) (define* (add-user name group @@ -128,7 +146,14 @@ properties. Return #t on success." ,@(if password `("-p" ,password) '()) ,@(if system? '("--system") '()) ,name))) - (zero? (apply system* "useradd" args))))) + (and (zero? (apply system* "useradd" args)) + (begin + ;; Since /etc/skel is a link to a directory in the store where + ;; all files have the writable bit cleared, and since 'useradd' + ;; preserves permissions when it copies them, explicitly make + ;; them writable. + (make-skeletons-writable home) + #t))))) (define* (modify-user name group #:key uid comment home shell password system? @@ -344,9 +369,11 @@ found in Linux 3.4 onward that prevents users from attaching to their own processes--see Yama.txt in the Linux source tree for the rationale. This sounds like an unacceptable restriction for little or no security improvement." - (call-with-output-file "/proc/sys/kernel/yama/ptrace_scope" - (lambda (port) - (display 0 port)))) + (let ((file "/proc/sys/kernel/yama/ptrace_scope")) + (when (file-exists? file) + (call-with-output-file file + (lambda (port) + (display 0 port)))))) (define %current-system diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 76536daf49..32fbe8efbc 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -133,9 +133,19 @@ includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM." (directives (%store-directory))) ;; Add system generation 1. - (false-if-exception (delete-file "/var/guix/profiles/system-1-link")) - (symlink system - (string-append target "/var/guix/profiles/system-1-link"))) + (let ((generation-1 (string-append target + "/var/guix/profiles/system-1-link"))) + (let try () + (catch 'system-error + (lambda () + (symlink system generation-1)) + (lambda args + ;; If GENERATION-1 already exists, overwrite it. + (if (= EEXIST (system-error-errno args)) + (begin + (delete-file generation-1) + (try)) + (apply throw args))))))) (define (reset-timestamps directory) "Reset the timestamps of all the files under DIRECTORY, so that they appear diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm index f54e3d3a35..3081a93a97 100644 --- a/gnu/build/linux-boot.scm +++ b/gnu/build/linux-boot.scm @@ -418,7 +418,6 @@ to it are lost." (switch-root "/root") (format #t "loading '~a'...\n" to-load) - ;; TODO: Remove /lib, /share, and /loader.go. (primitive-load to-load) (format (current-error-port) diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index ffaf6b4fc7..a96ce9cdfb 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -152,25 +152,20 @@ re-executing them as necessary.") (define-public inetutils (package (name "inetutils") - (version "1.9.2") + (version "1.9.3") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/inetutils/inetutils-" version ".tar.gz")) (sha256 (base32 - "04wrm0v7l4890mmbaawd6wjwdv08bkglgqhpz0q4dkb0l50fl8q4")) - (patches (list (search-patch "inetutils-syslogd.patch"))))) + "06dshajjpyi9sxi7qfki9gnp5r3nxvyvf81r81gx0x2qkqzqcxlj")))) (build-system gnu-build-system) (arguments `(;; FIXME: `tftp.sh' relies on `netstat' from utils-linux, ;; which is currently missing. #:tests? #f)) (inputs `(("ncurses" ,ncurses) ("readline" ,readline))) ; for 'ftp' - - ;; Help2man is needed because of the patch that modifies syslogd.c. - (native-inputs `(("help2man" ,help2man))) - (home-page "http://www.gnu.org/software/inetutils/") (synopsis "Basic networking utilities") (description @@ -693,7 +688,7 @@ commands and their arguments.") (define-public wpa-supplicant-light (package (name "wpa-supplicant-light") - (version "2.3") + (version "2.4") (source (origin (method url-fetch) (uri (string-append @@ -702,9 +697,16 @@ commands and their arguments.") ".tar.gz")) (sha256 (base32 - "0skvkl6c10ls4s48b2wmf47h9j1y40nlzxnzn8hyaw2j0prmpapa")) + "08li21q1wjn5chrv289w666il9ah1w419y3dkq2rl4wnq0rci385")) (patches - (list (search-patch "wpa-supplicant-CVE-2015-1863.patch"))))) + (map search-patch '("wpa-supplicant-CVE-2015-1863.patch" + "wpa-supplicant-2015-2-fix.patch" + "wpa-supplicant-2015-3-fix.patch" + "wpa-supplicant-2015-4-fix-pt1.patch" + "wpa-supplicant-2015-4-fix-pt2.patch" + "wpa-supplicant-2015-4-fix-pt3.patch" + "wpa-supplicant-2015-4-fix-pt4.patch" + "wpa-supplicant-2015-4-fix-pt5.patch"))))) (build-system gnu-build-system) (arguments '(#:phases (alist-replace @@ -872,7 +874,7 @@ module slots, and the list of I/O ports (e.g. serial, parallel, USB).") (define-public acpica (package (name "acpica") - (version "20140724") + (version "20150410") (source (origin (method url-fetch) (uri (string-append @@ -880,7 +882,7 @@ module slots, and the list of I/O ports (e.g. serial, parallel, USB).") version ".tar.gz")) (sha256 (base32 - "01vdgrh7dsxrrvg5yd8sxm63cw8210pnsi5qg9g15ac53gn243ac")))) + "0q1fjwkyw9x6gsva6fd0zbn7ly4fx0ha4853f416np9kf2irillw")))) (build-system gnu-build-system) (native-inputs `(("flex" ,flex) ("bison" ,bison))) diff --git a/gnu/packages/apr.scm b/gnu/packages/apr.scm index ed9c62819d..8c57ee3ab2 100644 --- a/gnu/packages/apr.scm +++ b/gnu/packages/apr.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> -;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> +;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,25 +18,26 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu packages apr) - #:use-module (guix licenses) + #:use-module ((guix licenses) #:prefix l:) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module (gnu packages) #:use-module (gnu packages perl) + #:use-module (gnu packages xml) #:use-module (gnu packages autotools)) (define-public apr (package (name "apr") - (version "1.5.1") + (version "1.5.2") (source (origin (method url-fetch) (uri (string-append "mirror://apache/apr/apr-" version ".tar.bz2")) (sha256 (base32 - "1b4qw686bwjn19iyb0lg918q23xxd6s2gnyczhjq992d3m1vwjp9")) + "0ypn51xblix5ys9xy7da3ngdydip0qqh9rdq8nz54w9aq8lys0vx")) (patches (list (search-patch "apr-skip-getservbyname-test.patch"))) (patch-flags '("-p0")))) @@ -59,7 +60,7 @@ an API to which software developers may code and be assured of predictable if not identical behaviour regardless of the platform on which their software is built, relieving them of the need to code special-case conditions to work around or take advantage of platform-specific deficiencies or features.") - (license asl2.0))) + (license l:asl2.0))) (define-public apr-util (package @@ -74,19 +75,23 @@ around or take advantage of platform-specific deficiencies or features.") "0bn81pfscy9yjvbmyx442svf43s6dhrdfcsnkpxz43fai5qk5kx6")))) (build-system gnu-build-system) (inputs - `(("apr" ,apr))) + `(("apr" ,apr))) + (propagated-inputs + `(("expat" ,expat))) (arguments '(#:phases (alist-replace 'configure (lambda* (#:key inputs outputs #:allow-other-keys) - (let ((out (assoc-ref outputs "out")) - (apr (assoc-ref inputs "apr"))) + (let ((out (assoc-ref outputs "out")) + (apr (assoc-ref inputs "apr")) + (expat (assoc-ref inputs "expat"))) (setenv "CONFIG_SHELL" (which "bash")) (zero? (system* "./configure" (string-append "--prefix=" out) - (string-append "--with-apr=" apr))))) + (string-append "--with-apr=" apr) + (string-append "--with-expat=" expat))))) %standard-phases) ;; There are race conditions during 'make check'. Typically, the @@ -98,4 +103,4 @@ around or take advantage of platform-specific deficiencies or features.") (synopsis "One of the Apache Portable Runtime Library companions") (description "APR-util provides a number of helpful abstractions on top of APR.") - (license asl2.0))) + (license l:asl2.0))) diff --git a/gnu/packages/audio.scm b/gnu/packages/audio.scm index 6cba704b6d..fdc783a455 100644 --- a/gnu/packages/audio.scm +++ b/gnu/packages/audio.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com> +;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +22,7 @@ #:use-module (guix packages) #:use-module (guix download) #:use-module (guix git-download) + #:use-module (guix utils) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix build-system gnu) #:use-module (guix build-system waf) @@ -128,7 +130,23 @@ attacks, performing pitch detection, tapping the beat and producing MIDI streams from live audio.") (license license:gpl3+))) -(define-public ardour +(define (ardour-rpath-phase major-version) + `(lambda* (#:key outputs #:allow-other-keys) + (let ((libdir (string-append (assoc-ref outputs "out") + "/lib/ardour" ,major-version))) + (substitute* "wscript" + (("linker_flags = \\[\\]") + (string-append "linker_flags = [\"" + "-Wl,-rpath=" + libdir ":" + libdir "/backends" ":" + libdir "/engines" ":" + libdir "/panners" ":" + libdir "/surfaces" ":" + libdir "/vamp" "\"]")))) + #t)) + +(define-public ardour-3 (package (name "ardour") (version "3.5.403") @@ -140,6 +158,9 @@ streams from live audio.") (url "git://git.ardour.org/ardour/ardour.git") (commit version))) (snippet + ;; Ardour expects this file to exist at build time. It can be + ;; created from a git checkout with: + ;; ./waf create_stored_revision '(call-with-output-file "libs/ardour/revision.cc" (lambda (port) @@ -151,7 +172,12 @@ namespace ARDOUR { const char* revision = \"3.5-403-gec2cb31\" ; }")))) (file-name (string-append name "-" version)))) (build-system waf-build-system) (arguments - `(#:tests? #f ; no check target + `(#:phases + (modify-phases %standard-phases + (add-after + 'unpack 'set-rpath-in-LDFLAGS + ,(ardour-rpath-phase (version-prefix version 1)))) + #:tests? #f ; no check target #:python ,python-2)) (inputs `(("alsa-lib" ,alsa-lib) @@ -183,8 +209,6 @@ namespace ARDOUR { const char* revision = \"3.5-403-gec2cb31\" ; }")))) ("sratom" ,sratom) ("suil" ,suil) ("lilv" ,lilv) - ("rasqal" ,rasqal) - ("raptor2" ,raptor2) ("redland" ,redland) ("rubberband" ,rubberband) ("taglib" ,taglib) @@ -200,6 +224,35 @@ record, edit, mix and master audio and MIDI projects. It is targeted at audio engineers, musicians, soundtrack editors and composers.") (license license:gpl2+))) +(define-public ardour + (package (inherit ardour-3) + (name "ardour") + (version "4.0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "git://git.ardour.org/ardour/ardour.git") + (commit version))) + (snippet + ;; Ardour expects this file to exist at build time. It can be + ;; created from a git checkout with: + ;; ./waf create_stored_revision + '(call-with-output-file + "libs/ardour/revision.cc" + (lambda (port) + (format port "#include \"ardour/revision.h\" +namespace ARDOUR { const char* revision = \"4.0\" ; }")))) + (sha256 + (base32 + "0a8bydc24xv0cahdqfaxdmi1f43cyr9psiyshxpbrkdqw2c7a4xi")) + (file-name (string-append name "-" version)))) + (arguments + (substitute-keyword-arguments (package-arguments ardour-3) + ((#:phases phases) + `(modify-phases ,phases + (replace 'set-rpath-in-LDFLAGS + ,(ardour-rpath-phase (version-prefix version 1))))))))) + (define-public azr3 (package (name "azr3") @@ -466,6 +519,46 @@ patches that can be used with softsynths such as Timidity and WildMidi.") ;; GPLv2+ with exception for compositions using these patches. (license license:gpl2+))) +(define-public ir + (package + (name "ir") + (version "1.3.2") + (source (origin + (method url-fetch) + (uri (string-append + "http://factorial.hu/system/files/ir.lv2-" + version ".tar.gz")) + (sha256 + (base32 + "1jh2z01l9m4ar7yz0n911df07dygc7n4cl59p7qdjbh0nvkm747g")))) + (build-system gnu-build-system) + (arguments + `(#:tests? #f ;no "check" target + #:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))) + #:phases + ;; no configure script + (alist-delete 'configure %standard-phases))) + (inputs + `(("libsndfile" ,libsndfile) + ("libsamplerate" ,libsamplerate) + ("lv2" ,lv2) + ("glib" ,glib) + ("gtk+" ,gtk+-2) + ("zita-convolver" ,zita-convolver))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (native-search-paths + (list (search-path-specification + (variable "LV2_PATH") + (files '("lib/lv2"))))) + (home-page "http://factorial.hu/plugins/lv2/ir") + (synopsis "LV2 convolution reverb") + (description + "IR is a low-latency, real-time, high performance signal convolver +especially for creating reverb effects. It supports impulse responses with 1, +2 or 4 channels, in any soundfile format supported by libsndfile.") + (license license:gpl2+))) + (define-public jack-1 (package (name "jack") @@ -898,10 +991,8 @@ buffers, and audio capture.") ("boost" ,boost) ("jack" ,jack-1) ("ganv" ,ganv) - ("glib" ,glib) ("glibmm" ,glibmm) ("gtkmm" ,gtkmm-2) - ("dbus" ,dbus) ("dbus-glib" ,dbus-glib))) (native-inputs `(("pkg-config" ,pkg-config))) @@ -1386,6 +1477,48 @@ directly to a different computer on your LAN network. It is an audio daemon with a much different focus than most other audio daemons.") (license license:gpl3+))) +(define-public zita-convolver + (package + (name "zita-convolver") + (version "3.1.0") + (source (origin + (method url-fetch) + (uri (string-append + "http://kokkinizita.linuxaudio.org" + "/linuxaudio/downloads/zita-convolver-" + version ".tar.bz2")) + (sha256 + (base32 + "14qrnczhp5mbwhky64il7kxc4hl1mmh495v60va7i2qnhasr6zmz")))) + (build-system gnu-build-system) + (arguments + `(#:tests? #f ; no "check" target + #:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))) + #:phases + (alist-cons-after + 'unpack 'patch-makefile-and-enter-directory + (lambda _ + (substitute* "libs/Makefile" + (("ldconfig") "true") + (("^LIBDIR =.*") "LIBDIR = lib\n")) + (chdir "libs") #t) + (alist-cons-after + 'install + 'install-symlink + (lambda _ + (symlink "libzita-convolver.so" + (string-append (assoc-ref %outputs "out") + "/lib/libzita-convolver.so.3"))) + ;; no configure script + (alist-delete 'configure %standard-phases))))) + (inputs `(("fftwf" ,fftwf))) + (home-page "http://kokkinizita.linuxaudio.org") + (synopsis "Fast, partitioned convolution engine library") + (description + "Zita convolver is a C++ library providing a real-time convolution +engine.") + (license license:gpl3+))) + (define-public zita-alsa-pcmi (package (name "zita-alsa-pcmi") diff --git a/gnu/packages/autogen.scm b/gnu/packages/autogen.scm index c27ea15e70..45b7cb81cc 100644 --- a/gnu/packages/autogen.scm +++ b/gnu/packages/autogen.scm @@ -23,13 +23,14 @@ #:use-module (guix build-system gnu) #:use-module (gnu packages) #:use-module (gnu packages perl) + #:use-module (gnu packages pkg-config) #:use-module (gnu packages base) #:use-module (gnu packages guile)) (define-public autogen (package (name "autogen") - (version "5.18.4") + (version "5.18.5") (source (origin (method url-fetch) @@ -38,9 +39,10 @@ version ".tar.gz")) (sha256 (base32 - "0pbjzwgvmjvi6nl1bcyhfc9kl93s6321dgmvp5dqdip7i8dgin9w")))) + "1flnbnmkbqmbfgammkl8m36wrlk6rhpgnf9pdm6gdfhqalxvggbv")))) (build-system gnu-build-system) - (native-inputs `(("perl" ,perl))) ;for doc generator mdoc + (native-inputs `(("perl" ,perl) ;for doc generator mdoc + ("pkg-config" ,pkg-config))) (inputs `(("which" ,which) ("guile" ,guile-2.0))) (arguments diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index bcb7eba48f..c7836f173e 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -24,6 +24,7 @@ #:use-module (guix git-download) #:use-module (guix build-system gnu) #:use-module (guix build-system cmake) + #:use-module (guix build-system perl) #:use-module (guix build-system python) #:use-module (guix build-system trivial) #:use-module (gnu packages) @@ -45,6 +46,7 @@ #:use-module (gnu packages tbb) #:use-module (gnu packages textutils) #:use-module (gnu packages vim) + #:use-module (gnu packages web) #:use-module (gnu packages xml) #:use-module (gnu packages zip)) @@ -62,7 +64,17 @@ (base32 "1brry29bw2xr2l9pqn240rkqwayg85b8qq78zk2zs6nlspk4d018")))) (build-system cmake-build-system) - (arguments `(#:tests? #f)) ;no "check" target + (arguments + `(#:tests? #f ;no "check" target + #:phases + (modify-phases %standard-phases + (add-before + 'configure 'set-ldflags + (lambda* (#:key outputs #:allow-other-keys) + (setenv "LDFLAGS" + (string-append + "-Wl,-rpath=" + (assoc-ref outputs "out") "/lib/bamtools"))))))) (inputs `(("zlib" ,zlib))) (home-page "https://github.com/pezmaster31/bamtools") (synopsis "C++ API and command-line toolkit for working with BAM data") @@ -532,6 +544,74 @@ file formats including SAM/BAM, Wiggle/BigWig, BED, GFF/GTF, VCF.") other types of unwanted sequence from high-throughput sequencing reads.") (license license:expat))) +(define-public edirect + (package + (name "edirect") + (version "2.50") + (source (origin + (method url-fetch) + ;; Note: older versions are not retained. + (uri "ftp://ftp.ncbi.nlm.nih.gov/entrez/entrezdirect/edirect.zip") + (sha256 + (base32 + "08afhz2ph66h8h381hl1mqyxkdi5nbvzsyj9gfw3jfbdijnpi4qj")))) + (build-system perl-build-system) + (arguments + `(#:tests? #f ;no "check" target + #:phases + (modify-phases %standard-phases + (delete 'configure) + (delete 'build) + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let ((target (string-append (assoc-ref outputs "out") + "/bin"))) + (mkdir-p target) + (copy-file "edirect.pl" + (string-append target "/edirect.pl")) + #t))) + (add-after + 'install 'wrap-program + (lambda* (#:key inputs outputs #:allow-other-keys) + ;; Make sure 'edirect.pl' finds all perl inputs at runtime. + (let* ((out (assoc-ref outputs "out")) + (path (getenv "PERL5LIB"))) + (wrap-program (string-append out "/bin/edirect.pl") + `("PERL5LIB" ":" prefix (,path))))))))) + (inputs + `(("perl-html-parser" ,perl-html-parser) + ("perl-encode-locale" ,perl-encode-locale) + ("perl-file-listing" ,perl-file-listing) + ("perl-html-tagset" ,perl-html-tagset) + ("perl-html-tree" ,perl-html-tree) + ("perl-http-cookies" ,perl-http-cookies) + ("perl-http-date" ,perl-http-date) + ("perl-http-message" ,perl-http-message) + ("perl-http-negotiate" ,perl-http-negotiate) + ("perl-lwp-mediatypes" ,perl-lwp-mediatypes) + ("perl-lwp-protocol-https" ,perl-lwp-protocol-https) + ("perl-net-http" ,perl-net-http) + ("perl-uri" ,perl-uri) + ("perl-www-robotrules" ,perl-www-robotrules) + ("perl" ,perl))) + (native-inputs + `(("unzip" ,unzip))) + (home-page "http://www.ncbi.nlm.nih.gov/books/NBK179288") + (synopsis "Tools for accessing the NCBI's set of databases") + (description + "Entrez Direct (EDirect) is a method for accessing the National Center +for Biotechnology Information's (NCBI) set of interconnected +databases (publication, sequence, structure, gene, variation, expression, +etc.) from a terminal. Functions take search terms from command-line +arguments. Individual operations are combined to build multi-step queries. +Record retrieval and formatting normally complete the process. + +EDirect also provides an argument-driven function that simplifies the +extraction of data from document summaries or other results that are returned +in structured XML format. This can eliminate the need for writing custom +software to answer ad hoc questions.") + (license license:public-domain))) + (define-public express (package (name "express") @@ -839,6 +919,41 @@ sequencing (HTS) data. There are also an number of useful utilities for manipulating HTS data.") (license license:expat))) +(define-public htslib + (package + (name "htslib") + (version "1.2.1") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/samtools/htslib/releases/download/" + version "/htslib-" version ".tar.bz2")) + (sha256 + (base32 + "1c32ssscbnjwfw3dra140fq7riarp2x990qxybh34nr1p5r17nxx")))) + (build-system gnu-build-system) + (arguments + `(#:phases + (modify-phases %standard-phases + (add-after + 'unpack 'patch-tests + (lambda _ + (substitute* "test/test.pl" + (("/bin/bash") (which "bash"))) + #t))))) + (inputs + `(("zlib" ,zlib))) + (native-inputs + `(("perl" ,perl))) + (home-page "http://www.htslib.org") + (synopsis "C library for reading/writing high-throughput sequencing data") + (description + "HTSlib is a C library for reading/writing high-throughput sequencing +data. It also provides the bgzip, htsfile, and tabix utilities.") + ;; Files under cram/ are released under the modified BSD license; + ;; the rest is released under the Expat license + (license (list license:expat license:bsd-3)))) + (define-public macs (package (name "macs") @@ -1003,6 +1118,84 @@ files and writing bioinformatics applications.") generated using the PacBio Iso-Seq protocol.") (license license:bsd-3)))) +(define-public rsem + (package + (name "rsem") + (version "1.2.20") + (source + (origin + (method url-fetch) + (uri + (string-append "http://deweylab.biostat.wisc.edu/rsem/src/rsem-" + version ".tar.gz")) + (sha256 + (base32 "0nzdc0j0hjllhsd5f2xli95dafm3nawskigs140xzvjk67xh0r9q")) + (patches (list (search-patch "rsem-makefile.patch"))) + (modules '((guix build utils))) + (snippet + '(begin + ;; remove bundled copy of boost + (delete-file-recursively "boost") + #t)))) + (build-system gnu-build-system) + (arguments + `(#:tests? #f ;no "check" target + #:phases + (modify-phases %standard-phases + ;; No "configure" script. + ;; Do not build bundled samtools library. + (replace 'configure + (lambda _ + (substitute* "Makefile" + (("^all : sam/libbam.a") "all : ")) + #t)) + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (string-append (assoc-ref outputs "out"))) + (bin (string-append out "/bin/")) + (perl (string-append out "/lib/perl5/site_perl"))) + (mkdir-p bin) + (mkdir-p perl) + (for-each (lambda (file) + (copy-file file + (string-append bin (basename file)))) + (find-files "." "rsem-.*")) + (copy-file "rsem_perl_utils.pm" + (string-append perl "/rsem_perl_utils.pm"))) + #t)) + (add-after + 'install 'wrap-program + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (for-each (lambda (prog) + (wrap-program (string-append out "/bin/" prog) + `("PERL5LIB" ":" prefix + (,(string-append out "/lib/perl5/site_perl"))))) + '("rsem-plot-transcript-wiggles" + "rsem-calculate-expression" + "rsem-generate-ngvector" + "rsem-run-ebseq" + "rsem-prepare-reference"))) + #t))))) + (inputs + `(("boost" ,boost) + ("ncurses" ,ncurses) + ("r" ,r) + ("perl" ,perl) + ("samtools" ,samtools-0.1) + ("zlib" ,zlib))) + (home-page "http://deweylab.biostat.wisc.edu/rsem/") + (synopsis "Estimate gene expression levels from RNA-Seq data") + (description + "RSEM is a software package for estimating gene and isoform expression +levels from RNA-Seq data. The RSEM package provides a user-friendly +interface, supports threads for parallel computation of the EM algorithm, +single-end and paired-end read data, quality scores, variable-length reads and +RSPD estimation. In addition, it provides posterior mean and 95% credibility +interval estimates for expression levels. For visualization, it can generate +BAM and Wiggle files in both transcript-coordinate and genomic-coordinate.") + (license license:gpl3+))) + (define-public rseqc (package (name "rseqc") @@ -1068,32 +1261,31 @@ distribution, coverage uniformity, strand specificity, etc.") ;; systems. #:tests? ,(string=? (or (%current-system) (%current-target-system)) "x86_64-linux") - #:make-flags (list (string-append "prefix=" (assoc-ref %outputs "out"))) + #:make-flags (list "LIBCURSES=-lncurses" + (string-append "prefix=" (assoc-ref %outputs "out"))) #:phases (alist-cons-after 'unpack - 'patch-makefile-curses - (lambda _ - (substitute* "Makefile" - (("-lcurses") "-lncurses"))) + 'patch-tests + (lambda* (#:key inputs #:allow-other-keys) + (let ((bash (assoc-ref inputs "bash"))) + (substitute* "test/test.pl" + ;; The test script calls out to /bin/bash + (("/bin/bash") + (string-append bash "/bin/bash")) + ;; There are two failing tests upstream relating to the "stats" + ;; subcommand in test_usage_subcommand ("did not have Usage" + ;; and "usage did not mention samtools stats"), so we disable + ;; them. + (("(test_usage_subcommand\\(.*\\);)" cmd) + (string-append "unless ($subcommand eq 'stats') {" cmd "};"))))) (alist-cons-after - 'unpack - 'patch-tests - (lambda* (#:key inputs #:allow-other-keys) - (let ((bash (assoc-ref inputs "bash"))) - (substitute* "test/test.pl" - ;; The test script calls out to /bin/bash - (("/bin/bash") - (string-append bash "/bin/bash")) - ;; There are two failing tests upstream relating to the "stats" - ;; subcommand in test_usage_subcommand ("did not have Usage" - ;; and "usage did not mention samtools stats"), so we disable - ;; them. - (("(test_usage_subcommand\\(.*\\);)" cmd) - (string-append "unless ($subcommand eq 'stats') {" cmd "};"))))) - (alist-delete - 'configure - %standard-phases))))) + 'install 'install-library + (lambda* (#:key outputs #:allow-other-keys) + (let ((lib (string-append (assoc-ref outputs "out") "/lib"))) + (mkdir-p lib) + (copy-file "libbam.a" (string-append lib "/libbam.a")))) + (alist-delete 'configure %standard-phases))))) (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("ncurses" ,ncurses) ("perl" ,perl) @@ -1108,6 +1300,34 @@ variant calling (in conjunction with bcftools), and a simple alignment viewer.") (license license:expat))) +(define-public samtools-0.1 + ;; This is the most recent version of the 0.1 line of samtools. The input + ;; and output formats differ greatly from that used and produced by samtools + ;; 1.x and is still used in many bioinformatics pipelines. + (package (inherit samtools) + (version "0.1.19") + (source + (origin + (method url-fetch) + (uri + (string-append "mirror://sourceforge/samtools/" + version "/samtools-" version ".tar.bz2")) + (sha256 + (base32 "1m33xsfwz0s8qi45lylagfllqg7fphf4dr0780rsvw75av9wk06h")))) + (arguments + (substitute-keyword-arguments (package-arguments samtools) + ((#:tests? tests) #f) ;no "check" target + ((#:phases phases) + `(modify-phases ,phases + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let ((bin (string-append + (assoc-ref outputs "out") "/bin"))) + (mkdir-p bin) + (copy-file "samtools" + (string-append bin "/samtools"))))) + (delete 'patch-tests))))))) + (define-public ngs-sdk (package (name "ngs-sdk") @@ -1266,11 +1486,16 @@ simultaneously.") (assoc-ref inputs "hdf5")))))) (alist-cons-after 'install 'install-interfaces - (lambda* (#:key system outputs #:allow-other-keys) - ;; Install interface libraries + (lambda* (#:key outputs #:allow-other-keys) + ;; Install interface libraries. On i686 the interface libraries + ;; are installed to "linux/gcc/i386", so we need to use the Linux + ;; architecture name ("i386") instead of the target system prefix + ;; ("i686"). (mkdir (string-append (assoc-ref outputs "out") "/ilib")) (copy-recursively (string-append "build/ncbi-vdb/linux/gcc/" - (car (string-split system #\-)) + ,(system->linux-architecture + (or (%current-target-system) + (%current-system))) "/rel/ilib") (string-append (assoc-ref outputs "out") "/ilib")) @@ -1513,7 +1738,40 @@ against local background noises.") "/sources/shogun-" version ".tar.bz2")) (sha256 (base32 - "159nlijnb7mnrv9za80wnm1shwvy45hgrqzn51hxy7gw4z6d6fdb")))) + "159nlijnb7mnrv9za80wnm1shwvy45hgrqzn51hxy7gw4z6d6fdb")) + (modules '((guix build utils) + (ice-9 rdelim))) + (snippet + '(begin + ;; Remove non-free sources and files referencing them + (for-each delete-file + (find-files "src/shogun/classifier/svm/" + "SVMLight\\.(cpp|h)")) + (for-each delete-file + (find-files "examples/undocumented/libshogun/" + (string-append + "(classifier_.*svmlight.*|" + "evaluation_cross_validation_locked_comparison).cpp"))) + ;; Remove non-free functions. + (define (delete-ifdefs file) + (with-atomic-file-replacement file + (lambda (in out) + (let loop ((line (read-line in 'concat)) + (skipping? #f)) + (if (eof-object? line) + #t + (let ((skip-next? + (or (and skipping? + (not (string-prefix? + "#endif //USE_SVMLIGHT" line))) + (string-prefix? + "#ifdef USE_SVMLIGHT" line)))) + (when (or (not skipping?) + (and skipping? (not skip-next?))) + (display line out)) + (loop (read-line in 'concat) skip-next?))))))) + (for-each delete-ifdefs (find-files "src/shogun/kernel/" + "^Kernel\\.(cpp|h)")))))) (build-system cmake-build-system) (arguments '(#:tests? #f ;no check target @@ -1621,6 +1879,7 @@ in terms of new algorithms.") (arguments `(#:tests? #f ; no "check" target #:make-flags (list + "CFLAGS=-O2" ; override "-m64" flag (string-append "PREFIX=" (assoc-ref %outputs "out")) (string-append "MANDIR=" (assoc-ref %outputs "out") "/share/man/man1")) diff --git a/gnu/packages/busybox.scm b/gnu/packages/busybox.scm index d200cd7ad5..13630b39dc 100644 --- a/gnu/packages/busybox.scm +++ b/gnu/packages/busybox.scm @@ -53,8 +53,9 @@ ;; There is no /usr/bin or /bin - replace it with /gnu/store (substitute* "testsuite/cpio.tests" - (("/usr/bin") "/gnu/store") - (("usr") "gnu")) + (("/usr/bin") (%store-directory)) + (("usr") (car (filter (negate string-null?) + (string-split (%store-directory) #\/))))) (substitute* "testsuite/date/date-works-1" (("/bin/date") (which "date"))) diff --git a/gnu/packages/calendar.scm b/gnu/packages/calendar.scm new file mode 100644 index 0000000000..7e87fbbfe4 --- /dev/null +++ b/gnu/packages/calendar.scm @@ -0,0 +1,52 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 David Thompson <davet@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 calendar) + #:use-module (gnu packages) + #:use-module (guix licenses) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system cmake) + #:use-module (gnu packages icu4c) + #:use-module (gnu packages perl)) + +(define-public libical + (package + (name "libical") + (version "1.0.1") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/libical/libical/releases/download/v" + version "/libical-" version ".tar.gz")) + (sha256 + (base32 + "14lmjj63zyx88rf1z71l0v9ms4c2vpdhmixksjjxgywp5p2f7708")))) + (build-system cmake-build-system) + (arguments + '(#:tests? #f)) ; test suite appears broken + (native-inputs + `(("perl" ,perl))) + (inputs + `(("icu4c" ,icu4c))) + (home-page "https://libical.github.io/libical/") + (synopsis "iCalendar protocols and data formats implementation") + (description + "Libical is an implementation of the iCalendar protocols and protocol +data units.") + (license lgpl2.1))) diff --git a/gnu/packages/cdrom.scm b/gnu/packages/cdrom.scm index 3383fb653d..8ecc909c79 100644 --- a/gnu/packages/cdrom.scm +++ b/gnu/packages/cdrom.scm @@ -95,7 +95,9 @@ caching facility provided by the library.") for CD-ROM and CD image file access. It allows the developer to add CD access to an application without having to worry about the OS- and device-dependent properties of CD-ROM or the specific details of CD image -formats.") +formats. It includes pycdio, a Python interface to libcdio, and +libcdio-paranoia, a library providing jitter-free and error-free audio +extraction from CDs.") (license gpl3+))) (define-public libcdio-paranoia @@ -122,14 +124,14 @@ libcdio.") (define-public xorriso (package (name "xorriso") - (version "1.3.8") + (version "1.4.0") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/xorriso/xorriso-" version ".tar.gz")) (sha256 (base32 - "0zhhj9lr9z7hnb2alac54mc28w1l0mbanphhpmy3ylsi8rih84lh")))) + "0mhfxn2idkrw1i65a5y4gnb1fig85zpnszb9ax7w4a2v062y1l8b")))) (build-system gnu-build-system) (inputs `(("acl" ,acl) diff --git a/gnu/packages/check.scm b/gnu/packages/check.scm index 3e686cc743..5349ede0fa 100644 --- a/gnu/packages/check.scm +++ b/gnu/packages/check.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org> ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org> +;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -89,12 +90,18 @@ with a flexible variety of user interfaces.") (version "1.12.1") (source (origin (method url-fetch) - (uri (string-append "mirror://sourceforge/cppunit/" name "/" + (uri (string-append "mirror://sourceforge/cppunit/" name "/" name "-" version ".tar.gz")) (sha256 (base32 "0jm49v5rmc5qw34vqs56gy8xja1dhci73bmh23cig4kcir6a0a5c")))) + ;; Explicitly link with libdl. This is expected to be done by packages + ;; relying on cppunit for their tests. However, not all of them do. + ;; If we added the linker flag to such packages, we would pollute all + ;; binaries, not only those used for testing. + (arguments + `(#:make-flags '("LDFLAGS=-ldl"))) (build-system gnu-build-system) (home-page "http://sourceforge.net/projects/cppunit/") (synopsis "Unit testing framework for C++") diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm index 6a48fb640b..14af09395a 100644 --- a/gnu/packages/commencement.scm +++ b/gnu/packages/commencement.scm @@ -783,16 +783,26 @@ COREUTILS-FINAL vs. COREUTILS, etc." '(#:modules ((guix build union)) #:builder (begin (use-modules (ice-9 match) + (srfi srfi-26) (guix build union)) - (match %build-inputs - (((names . directories) ...) - (union-build (assoc-ref %outputs "out") - directories))) + (let ((out (assoc-ref %outputs "out"))) - (union-build (assoc-ref %outputs "debug") - (list (assoc-ref %build-inputs - "libc-debug")))))) + (match %build-inputs + (((names . directories) ...) + (union-build out directories))) + + ;; Remove the 'sh' and 'bash' binaries that come with + ;; libc to avoid polluting the user's profile (these are + ;; statically-linked binaries with no locale support and + ;; so on.) + (for-each (lambda (file) + (delete-file (string-append out "/bin/" file))) + '("sh" "bash")) + + (union-build (assoc-ref %outputs "debug") + (list (assoc-ref %build-inputs + "libc-debug"))))))) (native-search-paths (package-native-search-paths gcc)) (search-paths (package-search-paths gcc)) diff --git a/gnu/packages/compression.scm b/gnu/packages/compression.scm index 4684fce130..78f967c3cb 100644 --- a/gnu/packages/compression.scm +++ b/gnu/packages/compression.scm @@ -297,7 +297,7 @@ archiving. Lzip is a clean implementation of the LZMA algorithm.") (define-public sharutils (package (name "sharutils") - (version "4.15") + (version "4.15.2") (source (origin (method url-fetch) @@ -305,7 +305,7 @@ archiving. Lzip is a clean implementation of the LZMA algorithm.") version ".tar.xz")) (sha256 (base32 - "19gqb6qbqmpgh6xlpgpj0ayw2nshllxg9d01qb5z8bnkhfcla8ka")))) + "16isapn8f39lnffc3dp4dan05b7x6mnc76v6q5nn8ysxvvvwy19b")))) (build-system gnu-build-system) (inputs `(("which" ,which))) diff --git a/gnu/packages/cups.scm b/gnu/packages/cups.scm index 3acf9dfd46..05b129d6a9 100644 --- a/gnu/packages/cups.scm +++ b/gnu/packages/cups.scm @@ -106,14 +106,14 @@ filters for the PDF-centric printing workflow introduced by OpenPrinting.") (define-public cups-minimal (package (name "cups-minimal") - (version "2.0.1") + (version "2.0.3") (source (origin (method url-fetch) (uri (string-append "http://www.cups.org/software/" version "/cups-" version "-source.tar.gz")) (sha256 (base32 - "1kbc85kwhm1vyzahblrg3qih9yypggs91d13gdrbnaac8q7jd9jr")))) + "1kq1kpny0hghqgbjvashlv6qw1xn0c1p3d4r3cx8qxdzd2ifk4lf")))) (build-system gnu-build-system) (arguments `(#:configure-flags diff --git a/gnu/packages/curl.scm b/gnu/packages/curl.scm index 526514b815..ab22645971 100644 --- a/gnu/packages/curl.scm +++ b/gnu/packages/curl.scm @@ -38,17 +38,14 @@ (define-public curl (package (name "curl") - (version "7.41.0") + (version "7.42.1") (source (origin (method url-fetch) (uri (string-append "http://curl.haxx.se/download/curl-" version ".tar.lzma")) (sha256 (base32 - "08n7vrhdfzziy3a7n93r7qjhzk8p26q464hxg8w9irdk3v60pi62")) - (patches - (list (search-patch "curl-support-capath-on-gnutls.patch") - (search-patch "curl-support-capath-on-gnutls-conf.patch"))))) + "0ircrhi4i9iviq0d9044rq288sdrww19d0ci6vmb4fh8nmm1jv1x")))) (build-system gnu-build-system) (inputs `(("gnutls" ,gnutls) ("gss" ,gss) diff --git a/gnu/packages/databases.scm b/gnu/packages/databases.scm index 5daf7ecba1..3e3fd1a560 100644 --- a/gnu/packages/databases.scm +++ b/gnu/packages/databases.scm @@ -49,6 +49,7 @@ #:use-module (guix build-system gnu) #:use-module (guix build-system perl) #:use-module (guix build-system cmake) + #:use-module (guix utils) #:use-module (srfi srfi-26) #:use-module (ice-9 match)) @@ -100,53 +101,47 @@ SQL, Key/Value, XML/XQuery or Java Object storage for their data model.") (define-public mysql (package (name "mysql") - (version "5.1.73") + (version "5.6.25") (source (origin (method url-fetch) (uri (string-append - "http://dev.mysql.com/get/Downloads/MySQL-5.1/mysql-" - version ".tar.gz")) + "http://dev.mysql.com/get/Downloads/MySQL-" + (version-major+minor version) "/" + name "-" version ".tar.gz")) (sha256 (base32 - "1dfwi4ck0vq6sdci6gz0031s7zz5lc3pddqlgm0292s00l9y5sq5")))) - (build-system gnu-build-system) + "1gbz5i1z3nswpq3q8f477vrx7g15j8n41pyb94k0jfnkhc5rq1qm")))) + (build-system cmake-build-system) + (arguments + '(#:configure-flags + '("-DBUILD_CONFIG=mysql_release" + "-DWITH_SSL=system" + "-DWITH_ZLIB=system" + "-DDEFAULT_CHARSET=utf8" + "-DDEFAULT_COLLATION=utf8_general_ci" + "-DMYSQL_DATADIR=/var/lib/mysql" + "-DMYSQL_UNIX_ADDR=/run/mysqld/mysqld.sock" + "-DINSTALL_INFODIR=share/mysql/docs" + "-DINSTALL_MANDIR=share/man" + "-DINSTALL_PLUGINDIR=lib/mysql/plugin" + "-DINSTALL_SCRIPTDIR=bin" + "-DINSTALL_INCLUDEDIR=include/mysql" + "-DINSTALL_DOCREADMEDIR=share/mysql/docs" + "-DINSTALL_SUPPORTFILESDIR=share/mysql" + "-DINSTALL_MYSQLSHAREDIR=share/mysql" + "-DINSTALL_DOCDIR=share/mysql/docs" + "-DINSTALL_SHAREDIR=share/mysql" + ;; Get rid of test data. + "-DINSTALL_MYSQLTESTDIR=" + "-DINSTALL_SQLBENCHDIR="))) + (native-inputs + `(("bison" ,bison) + ("perl" ,perl))) (inputs - `(("procps" ,procps) + `(("libaio" ,libaio) ("openssl" ,openssl) - ("perl" ,perl) ("zlib" ,zlib) ("ncurses" ,ncurses))) - (arguments - '(#:modules ((guix build gnu-build-system) - (guix build utils) - (ice-9 ftw)) ; for "rm -rf" - #:phases (alist-cons-after - 'install 'clean-up - (lambda* (#:key outputs #:allow-other-keys) - ;; Remove the 112 MiB of tests that get installed. - (let ((out (assoc-ref outputs "out"))) - (define (rm-rf dir) - (file-system-fold (const #t) ; enter? - (lambda (file stat result) ; leaf - (delete-file file)) - (const #t) ; down - (lambda (dir stat result) ; up - (rmdir dir)) - (const #t) - (lambda (file stat errno result) - (format (current-error-port) - "error: ~a: ~a~%" - file (strerror errno))) - #t - (string-append out "/" dir))) - (rm-rf "mysql-test") - (rm-rf "sql-bench") - - ;; Compress the 14 MiB Info file. - (zero? - (system* "gzip" "--best" - (string-append out "/share/info/mysql.info"))))) - %standard-phases))) (home-page "http://www.mysql.com/") (synopsis "Fast, easy to use, and popular database") (description @@ -158,7 +153,7 @@ Language.") (define-public mariadb (package (name "mariadb") - (version "10.0.17") + (version "10.0.18") (source (origin (method url-fetch) (uri (string-append "https://downloads.mariadb.org/f/" @@ -166,7 +161,7 @@ Language.") name "-" version ".tar.gz")) (sha256 (base32 - "04ckq67qgkghh7yzrbzwidk7wn7yjml15gzj2c5p1hs2k7lr9lww")))) + "1xcs391cm0vnl9bvx1470v8z4d77zqv16n6iaqi12jm0ma8fwvv8")))) (build-system cmake-build-system) (arguments '(#:configure-flags @@ -226,14 +221,14 @@ as a drop-in replacement of MySQL.") (define-public postgresql (package (name "postgresql") - (version "9.3.6") + (version "9.3.7") (source (origin (method url-fetch) (uri (string-append "http://ftp.postgresql.org/pub/source/v" version "/postgresql-" version ".tar.bz2")) (sha256 (base32 - "056ass7nnfyv7blv02anv795kgpz77gipdpxggd835cdwrhwns13")))) + "0ggz0i91znv053zx9qas7pjf93s5by3dk84z1jxbjkg8yyrnlx4b")))) (build-system gnu-build-system) (inputs `(("readline" ,readline) @@ -289,7 +284,7 @@ types are supported, as is encryption.") (define-public sqlite (package (name "sqlite") - (version "3.8.8.3") + (version "3.8.9") (source (origin (method url-fetch) ;; TODO: Download from sqlite.org once this bug : @@ -309,7 +304,7 @@ types are supported, as is encryption.") "/sqlite-autoconf-" numeric-version ".tar.gz"))) (sha256 (base32 - "04dl53iv5q0srv4jcgjfzsrdzkq6dg1sgmlmpw9lrd4xrmj6jmvl")))) + "18k90bbfvvgc5204nm1hzw0vsj9ygzv7zbq3z6zrya6j5hwvdsvn")))) (build-system gnu-build-system) (inputs `(("readline" ,readline))) (arguments diff --git a/gnu/packages/dejagnu.scm b/gnu/packages/dejagnu.scm index 203bd6ea2c..60fd2124f0 100644 --- a/gnu/packages/dejagnu.scm +++ b/gnu/packages/dejagnu.scm @@ -26,7 +26,7 @@ (define-public dejagnu (package (name "dejagnu") - (version "1.5.2") + (version "1.5.3") (source (origin (method url-fetch) @@ -34,7 +34,7 @@ version ".tar.gz")) (sha256 (base32 - "18ikblg4x4y5fkw8sg0c2zmqgxdqqycswmws17sxx8m4sz6g7dch")))) + "069z3qrdv35cm2sbnfr5yjzplrqj9f61cchxis7j9mm19hv8x6q9")))) (build-system gnu-build-system) (inputs `(("expect" ,expect))) (arguments diff --git a/gnu/packages/disk.scm b/gnu/packages/disk.scm index 6a7fdcfb19..22fdd290a0 100644 --- a/gnu/packages/disk.scm +++ b/gnu/packages/disk.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org> +;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -119,3 +120,30 @@ from one file to another, working to rescue data in case of read errors. The program also includes a tool for manipulating its log files, which are used to recover data more efficiently by only reading the necessary blocks.") (license gpl3+))) + +(define-public dosfstools + (package + (name "dosfstools") + (version "3.0.27") + (source + (origin + (method url-fetch) + (uri (string-append "https://github.com/" name "/" name + "/releases/download/v" version "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "1a2qs5g2zqbk1gzaaf4v3fw3yny6jgbzddpgcamkp3fjifn8wxl5")))) + (build-system gnu-build-system) + (arguments + `(#:make-flags (list (string-append "PREFIX=" %output) + "CC=gcc") + #:tests? #f ;no tests + #:phases (modify-phases %standard-phases + (delete 'configure)))) + (home-page "https://github.com/dosfstools/dosfstools") + (synopsis "Utilities for making and checking MS-DOS FAT filesystems") + (description + "The dosfstools package includes the mkfs.fat and fsck.fat utilities, +which respectively make and check MS-DOS FAT filesystems.") + (license gpl3+))) diff --git a/gnu/packages/ebook.scm b/gnu/packages/ebook.scm index 101c5bad37..2be5ea351a 100644 --- a/gnu/packages/ebook.scm +++ b/gnu/packages/ebook.scm @@ -25,7 +25,6 @@ #:use-module (guix build-system python) #:use-module (gnu packages) #:use-module (gnu packages databases) - #:use-module (gnu packages ebook) #:use-module (gnu packages fontutils) #:use-module (gnu packages freedesktop) #:use-module (gnu packages glib) @@ -33,6 +32,7 @@ #:use-module (gnu packages image) #:use-module (gnu packages imagemagick) #:use-module (gnu packages libusb) + #:use-module (gnu packages openssl) #:use-module (gnu packages pdf) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) @@ -60,7 +60,7 @@ (define-public calibre (package (name "calibre") - (version "2.25.0") + (version "2.29.0") (source (origin (method url-fetch) @@ -69,7 +69,7 @@ version ".tar.xz")) (sha256 (base32 - "0h7cnwdd9phk4n5hl6xggkn7szvqsds5847mnk2wg2j2j1lzp2r0")) + "1n3cfnjnghhhsgzcbcvbr0gh191lhl6az09q1s68jhlcc2lski6l")) ;; Remove non-free or doubtful code, see ;; https://lists.gnu.org/archive/html/guix-devel/2015-02/msg00478.html (modules '((guix build utils))) @@ -106,6 +106,7 @@ ("libpng" ,libpng) ("libusb" ,libusb) ("libxrender" ,libxrender) + ("openssl" ,openssl) ("podofo" ,podofo) ("python" ,python-2) ("python2-apsw" ,python2-apsw) diff --git a/gnu/packages/emacs.scm b/gnu/packages/emacs.scm index 8d3df368b1..fbddff1cf6 100644 --- a/gnu/packages/emacs.scm +++ b/gnu/packages/emacs.scm @@ -23,10 +23,12 @@ #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix git-download) #:use-module (guix build-system gnu) #:use-module (guix build-system glib-or-gtk) #:use-module (guix build-system trivial) #:use-module (gnu packages) + #:use-module (gnu packages guile) #:use-module (gnu packages gtk) #:use-module (gnu packages gnome) #:use-module (gnu packages ncurses) @@ -146,6 +148,35 @@ editor (without an X toolkit)" ) (arguments (append '(#:configure-flags '("--with-x-toolkit=no")) (package-arguments emacs))))) +(define-public guile-emacs + (package (inherit emacs) + (name "guile-emacs") + (version "20150512.41120e0") + (source (origin + (method git-fetch) + (uri (git-reference + (url "git://git.hcoop.net/git/bpt/emacs.git") + (commit "41120e0f595b16387eebfbf731fff70481de1b4b"))) + (sha256 + (base32 + "0lvcvsz0f4mawj04db35p1dvkffdqkz8pkhc0jzh9j9x2i63kcz6")))) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("guile" ,guile-for-guile-emacs) + ,@(package-native-inputs emacs))) + (arguments + (substitute-keyword-arguments `(;; Build fails if we allow parallel build. + #:parallel-build? #f + ;; Tests aren't passing for now. + #:tests? #f + ,@(package-arguments emacs)) + ((#:phases phases) + `(modify-phases ,phases + (add-after 'unpack 'autogen + (lambda _ + (zero? (system* "sh" "autogen.sh")))))))))) + ;;; ;;; Emacs hacking. @@ -230,52 +261,115 @@ for those who may want transient periods of unbalanced parentheses, such as when typing parentheses directly or commenting out code line by line.") (license license:gpl3+))) +(define-public git-modes + (package + (name "git-modes") + (version "1.0.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/magit/git-modes/archive/" + version ".tar.gz")) + (sha256 + (base32 + "1biiss75bswx4alk85k3g9p0a3q3sc9i74h4mnrxc2rsk2iwhws0")))) + (build-system gnu-build-system) + (arguments + `(#:modules ((guix build gnu-build-system) + (guix build emacs-utils) + (guix build utils)) + #:imported-modules (,@%gnu-build-system-modules + (guix build emacs-utils)) + + #:make-flags (list (string-append "PREFIX=" + (assoc-ref %outputs "out")) + ;; Don't put .el files in a 'git-modes' + ;; sub-directory. + (string-append "LISPDIR=" + (assoc-ref %outputs "out") + "/share/emacs/site-lisp")) + #:test-target "test" + #:phases (modify-phases %standard-phases + (delete 'configure) + (add-after 'install 'emacs-autoloads + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (lisp (string-append + out "/share/emacs/site-lisp/"))) + (emacs-generate-autoloads ,name lisp))))))) + (native-inputs `(("emacs" ,emacs-no-x))) + (home-page "https://github.com/magit/git-modes") + (synopsis "Emacs major modes for Git configuration files") + (description + "This package provides Emacs major modes for editing various Git +configuration files, such as .gitattributes, .gitignore, and .git/config.") + (license license:gpl3+))) + (define-public magit (package (name "magit") - (version "1.2.1") + (version "1.4.1") (source (origin (method url-fetch) (uri (string-append "https://github.com/magit/magit/releases/download/" version "/" name "-" version ".tar.gz")) (sha256 - (base32 "1in48g5l5xdc9cf2apnpgx73mqlz2njrpi1w52dgql4qxv3kg6gr")))) + (base32 + "0bbvz6cma5vj6qxx9v2m60zqkjwgwjrdf9kp04iacybvrcm8vcg7")))) (build-system gnu-build-system) - (native-inputs `(("texinfo" ,texinfo))) - (inputs `(("emacs" ,emacs-no-x) - ("git" ,git) + (native-inputs `(("texinfo" ,texinfo) + ("emacs" ,emacs-no-x))) + (inputs `(("git" ,git) ("git:gui" ,git "gui"))) + (propagated-inputs `(("git-modes" ,git-modes))) (arguments `(#:modules ((guix build gnu-build-system) (guix build utils) (guix build emacs-utils)) #:imported-modules (,@%gnu-build-system-modules (guix build emacs-utils)) - #:tests? #f ; no check target + + #:test-target "test" + #:tests? #f ;'tests/magit-tests.el' is missing + + #:make-flags (list + ;; Don't put .el files in a sub-directory. + (string-append "lispdir=" (assoc-ref %outputs "out") + "/share/emacs/site-lisp")) + #:phases - (alist-replace - 'configure - (lambda* (#:key outputs #:allow-other-keys) - (let ((out (assoc-ref outputs "out"))) - (substitute* "Makefile" - (("/usr/local") out) - (("/etc") (string-append out "/etc"))))) - (alist-cons-before - 'build 'patch-exec-paths - (lambda* (#:key inputs #:allow-other-keys) - (let ((git (assoc-ref inputs "git")) - (git:gui (assoc-ref inputs "git:gui"))) - (emacs-substitute-variables "magit.el" - ("magit-git-executable" (string-append git "/bin/git")) - ("magit-gitk-executable" (string-append git:gui "/bin/gitk"))))) - (alist-cons-after + (modify-phases %standard-phases + (replace + 'configure + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (substitute* "Makefile" + (("/usr/local") out) + (("/etc") (string-append out "/etc")))))) + (add-before + 'build 'patch-exec-paths + (lambda* (#:key inputs #:allow-other-keys) + (let ((git (assoc-ref inputs "git")) + (git:gui (assoc-ref inputs "git:gui"))) + (emacs-substitute-variables "magit.el" + ("magit-git-executable" (string-append git "/bin/git")) + ("magit-gitk-executable" (string-append git:gui + "/bin/gitk")))))) + (add-before + 'build 'augment-load-path + (lambda* (#:key inputs #:allow-other-keys) + ;; Allow git-commit-mode.el & co. to be found. + (let ((git-modes (assoc-ref inputs "git-modes"))) + (setenv "EMACSLOADPATH" + (string-append ":" git-modes "/share/emacs/site-lisp")) + #t))) + (add-after 'install 'post-install (lambda* (#:key outputs #:allow-other-keys) (emacs-generate-autoloads ,name (string-append (assoc-ref outputs "out") - "/share/emacs/site-lisp/"))) - %standard-phases))))) + "/share/emacs/site-lisp/"))))))) (home-page "http://magit.github.io/") (synopsis "Emacs interface for the Git version control system") (description @@ -286,6 +380,56 @@ cherry picking, reverting, merging, rebasing, and other common Git operations.") (license license:gpl3+))) +(define-public magit-svn + (package + (name "magit-svn") + (version "b69b79") + (source (origin + (method git-fetch) + (uri (git-reference + (commit version) + (url "https://github.com/magit/magit-svn.git"))) + (sha256 + (base32 + "07xxszd12r38s46sz8fn2qz26b7s88i022cqp3gmkmmj3j57kqv6")))) + (build-system trivial-build-system) + (inputs `(("emacs" ,emacs-no-x) + ("magit" ,magit))) + (arguments + `(#:modules ((guix build utils) + (guix build emacs-utils)) + + #:builder + (begin + (use-modules (guix build utils) + (guix build emacs-utils)) + + (let* ((emacs (string-append (assoc-ref %build-inputs "emacs") + "/bin/emacs")) + (magit (string-append (assoc-ref %build-inputs "magit") + "/share/emacs/site-lisp")) + (commit (string-append (assoc-ref %build-inputs + "magit/git-modes") + "/share/emacs/site-lisp")) + (source (assoc-ref %build-inputs "source")) + (lisp-dir (string-append %output "/share/emacs/site-lisp"))) + (mkdir-p lisp-dir) + (copy-file (string-append source "/magit-svn.el") + (string-append lisp-dir "/magit-svn.el")) + + (with-directory-excursion lisp-dir + (parameterize ((%emacs emacs)) + (emacs-generate-autoloads ,name lisp-dir) + (setenv "EMACSLOADPATH" + (string-append ":" magit ":" commit)) + (emacs-batch-eval '(byte-compile-file "magit-svn.el")))))))) + (home-page "https://github.com/magit/magit-svn") + (synopsis "Git-SVN extension to Magit") + (description + "This package is an extension to Magit, the Git Emacs mode, providing +support for Git-SVN.") + (license license:gpl3+))) + ;;; ;;; Web browsing. diff --git a/gnu/packages/feh.scm b/gnu/packages/feh.scm index 84edad419e..ae7c820011 100644 --- a/gnu/packages/feh.scm +++ b/gnu/packages/feh.scm @@ -29,7 +29,7 @@ (define-public feh (package (name "feh") - (version "2.12") + (version "2.13") (home-page "https://feh.finalrewind.org/") (source (origin (method url-fetch) @@ -37,7 +37,7 @@ name "-" version ".tar.bz2")) (sha256 (base32 - "0ckhidmsms2l5jycp0qf71jzmb3bpbhjq3bcgfpvfvszah7pmq30")))) + "06fa9zh1zpi63l90kw3l9a0sfavf424j7ksi396ifg9669gx35gn")))) (build-system gnu-build-system) (arguments '(#:phases (alist-delete 'configure %standard-phases) diff --git a/gnu/packages/fltk.scm b/gnu/packages/fltk.scm index 1ac1f2507e..7a41460325 100644 --- a/gnu/packages/fltk.scm +++ b/gnu/packages/fltk.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 John Darrington <jmd@gnu.org> +;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,7 +18,10 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu packages fltk) - #:use-module (guix licenses) + #:use-module ((guix licenses) #:select (lgpl2.0)) + #:use-module (gnu packages) + #:use-module (gnu packages compression) + #:use-module (gnu packages image) #:use-module (gnu packages xorg) #:use-module (gnu packages gl) #:use-module (guix packages) @@ -35,11 +39,15 @@ "/fltk-" version "-source.tar.gz")) (sha256 (base32 - "15qd7lkz5d5ynz70xhxhigpz3wns39v9xcf7ggkl0792syc8sfgq")))) + "15qd7lkz5d5ynz70xhxhigpz3wns39v9xcf7ggkl0792syc8sfgq")) + (patches (list (search-patch "fltk-shared-lib-defines.patch"))))) (build-system gnu-build-system) - (inputs - `(("libx11" ,libx11) - ("mesa" ,mesa))) + (inputs + `(("libjpeg" ,libjpeg-8) ;jpeg_read_header argument error in libjpeg-9 + ("libpng" ,libpng) + ("libx11" ,libx11) + ("mesa" ,mesa) + ("zlib" ,zlib))) (arguments `(#:tests? #f ;TODO: compile programs in "test" dir #:configure-flags @@ -51,7 +59,22 @@ (lambda _ (substitute* "makeinclude.in" (("/bin/sh") (which "sh")))) - %standard-phases))) + (alist-cons-after + 'install 'patch-config + ;; Provide -L flags for image libraries when querying fltk-config to + ;; avoid propagating inputs. + (lambda* (#:key inputs outputs #:allow-other-keys) + (use-modules (srfi srfi-26)) + (let* ((conf (string-append (assoc-ref outputs "out") + "/bin/fltk-config")) + (jpeg (assoc-ref inputs "libjpeg")) + (png (assoc-ref inputs "libpng")) + (zlib (assoc-ref inputs "zlib"))) + (substitute* conf + (("-ljpeg") (string-append "-L" jpeg "/lib -ljpeg")) + (("-lpng") (string-append "-L" png "/lib -lpng")) + (("-lz") (string-append "-L" zlib "/lib -lz"))))) + %standard-phases)))) (home-page "http://www.fltk.org") (synopsis "3D C++ GUI library") (description "FLTK is a C++ GUI toolkit providing modern GUI functionality diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm index 386f4c5972..c5b55f30a2 100644 --- a/gnu/packages/freedesktop.scm +++ b/gnu/packages/freedesktop.scm @@ -1,6 +1,9 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> +;;; Copyright © 2015 Andy Wingo <wingo@pobox.com> +;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,12 +21,22 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu packages freedesktop) - #:use-module ((guix licenses) #:select (expat x11)) + #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix git-download) #:use-module (guix build-system gnu) + #:use-module (guix build-system python) + #:use-module (gnu packages gnome) + #:use-module (gnu packages python) #:use-module (gnu packages linux) #:use-module (gnu packages pkg-config) + #:use-module (gnu packages autotools) + #:use-module (gnu packages gettext) + #:use-module (gnu packages gperf) + #:use-module (gnu packages xml) + #:use-module (gnu packages docbook) + #:use-module (gnu packages glib) ;intltool #:use-module (gnu packages xdisorg) #:use-module (gnu packages xorg)) @@ -48,7 +61,7 @@ (description "The xdg-utils package is a set of simple scripts that provide basic desktop integration functions in the framework of the freedesktop.org project.") - (license expat))) + (license license:expat))) (define-public libinput (package @@ -74,4 +87,113 @@ freedesktop.org project.") (description "Libinput is a library to handle input devices for display servers and other applications that need to directly deal with input devices.") - (license x11))) + (license license:x11))) + +(define-public elogind + (let ((commit "14405a9")) + (package + (name "elogind") + (version (string-append "219." commit)) + (source (origin + (method git-fetch) + (uri (git-reference + (url "http://git.elephly.net/software/elogind.git") + (commit commit))) + (sha256 + (base32 + "1wz5lxj95qg64x2q5hf4zcb35hpxlw3wfswx6sb2srvsg50y3y72")) + (file-name (string-append name "-checkout-" commit)) + (modules '((guix build utils))) + (snippet + '(begin + (use-modules (guix build utils)) + (substitute* "Makefile.am" + ;; Avoid validation against DTD because the DTDs for + ;; both doctype 4.2 and 4.5 are needed. + (("XSLTPROC_FLAGS = ") "XSLTPROC_FLAGS = --novalid")))))) + (build-system gnu-build-system) + (arguments + `(#:configure-flags + (list + ;; pam_elogind fails because of bus-error.c hackery + "--disable-pam" + (string-append "--with-rootprefix=" (assoc-ref %outputs "out"))) + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'autogen + (lambda _ + (and (zero? (system* "intltoolize" "--force" "--automake")) + (zero? (system* "autoreconf" "-vif")))))))) + (native-inputs + `(("intltool" ,intltool) + ("gettext" ,gnu-gettext) + ("docbook-xsl" ,docbook-xsl) + ("docbook-xml" ,docbook-xml) + ("xsltproc" ,libxslt) + ("libxml2" ,libxml2) ;for XML_CATALOG_FILES + ("pkg-config", pkg-config) + ("autoconf" ,autoconf) + ("automake" ,automake) + ("libtool" ,libtool) + ("gperf" ,gperf))) + (inputs + `(("linux-pam" ,linux-pam) + ("linux-libre-headers" ,linux-libre-headers) + ("libcap" ,libcap) + ("dbus" ,dbus) + ("eudev" ,eudev))) + (home-page "https://github.com/andywingo/elogind") + (synopsis "User, seat, and session management service") + (description "Elogind is the systemd project's \"logind\" service, +extracted out as a separate project. Elogind integrates with PAM to provide +the org.freedesktop.login1 interface over the system bus, allowing other parts +of a the system to know what users are logged in, and where.") + (license license:lgpl2.1+)))) + +(define-public python-pyxdg + (package + (name "python-pyxdg") + (version "0.25") + (source + (origin + (method url-fetch) + (uri (string-append + "https://pypi.python.org/packages/source/p/pyxdg/pyxdg-" + version ".tar.gz")) + (sha256 + (base32 + "179767h8m634ydlm4v8lnz01ba42gckfp684id764zaip7h87s41")))) + (build-system python-build-system) + (arguments + '(#:phases + (alist-replace + 'check + (lambda* (#:key inputs #:allow-other-keys) + (setenv "XDG_DATA_DIRS" + (string-append (assoc-ref inputs "shared-mime-info") + "/share/")) + (substitute* "test/test-icon.py" + (("/usr/share/icons/hicolor/index.theme") + (string-append (assoc-ref inputs "hicolor-icon-theme") + "/share/icons/hicolor/index.theme"))) + + ;; One test fails with: + ;; AssertionError: 'x-apple-ios-png' != 'png' + (substitute* "test/test-mime.py" + (("self.check_mimetype\\(imgpng, 'image', 'png'\\)") "#")) + (zero? (system* "nosetests" "-v"))) + %standard-phases))) + (native-inputs + `(("shared-mime-info" ,shared-mime-info) ;for tests + ("hicolor-icon-theme" ,hicolor-icon-theme) ;for tests + ("python-nose" ,python-nose) + ("python-setuptools" ,python-setuptools))) + (home-page "http://freedesktop.org/wiki/Software/pyxdg") + (synopsis "Implementations of freedesktop.org standards in Python") + (description + "PyXDG is a collection of implementations of freedesktop.org standards in +Python") + (license license:lgpl2.0))) + +(define-public python2-pyxdg + (package-with-python2 python-pyxdg)) diff --git a/gnu/packages/ftp.scm b/gnu/packages/ftp.scm index 22ea1af965..790ffc66c2 100644 --- a/gnu/packages/ftp.scm +++ b/gnu/packages/ftp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; @@ -36,8 +36,10 @@ (version "4.6.1") (source (origin (method url-fetch) - (uri (string-append "http://lftp.yar.ru/ftp/lftp-" - version ".tar.xz")) + (uri (list (string-append "http://lftp.yar.ru/ftp/lftp-" + version ".tar.xz") + (string-append "http://lftp.yar.ru/ftp/old/lftp-" + version ".tar.xz"))) (sha256 (base32 "1grmp8zg7cjgjinz66mrh53whigkqzl90nlxj05hapnhk3ns3vni")) diff --git a/gnu/packages/game-development.scm b/gnu/packages/game-development.scm index 219176722a..14209f4b7e 100644 --- a/gnu/packages/game-development.scm +++ b/gnu/packages/game-development.scm @@ -33,7 +33,11 @@ #:use-module (gnu packages fontutils) #:use-module (gnu packages image) #:use-module (gnu packages audio) - #:use-module (gnu packages pulseaudio)) + #:use-module (gnu packages pulseaudio) + #:use-module (gnu packages gnome) + #:use-module (gnu packages gtk) + #:use-module (gnu packages sdl) + #:use-module (gnu packages pkg-config)) (define-public bullet (package @@ -127,3 +131,40 @@ clone.") to ease the development of games and multimedia applications. It is composed of five modules: system, window, graphics, audio and network.") (license license:zlib))) + +(define-public sfxr + (package + (name "sfxr") + (version "1.2.1") + (source (origin + (method url-fetch) + (uri (string-append "http://www.drpetter.se/files/sfxr-sdl-1.2.1.tar.gz")) + (sha256 + (base32 + "0dfqgid6wzzyyhc0ha94prxax59wx79hqr25r6if6by9cj4vx4ya")))) + (build-system gnu-build-system) + (arguments + `(#:phases (modify-phases %standard-phases + (delete 'configure) ; no configure script + (add-before 'build 'patch-makefile + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (substitute* "Makefile" + (("\\$\\(DESTDIR\\)/usr") out)) + (substitute* "main.cpp" + (("/usr/share") + (string-append out "/share"))) + #t)))) + #:tests? #f)) ; no tests + (native-inputs + `(("pkg-config" ,pkg-config) + ("desktop-file-utils" ,desktop-file-utils))) + (inputs + `(("sdl" ,sdl) + ("gtk+" ,gtk+))) + (synopsis "Simple sound effect generator") + (description "Sfxr is a tool for quickly generating simple sound effects. +Originally created for use in video game prototypes, it can generate random +sounds from presets such as \"explosion\" or \"powerup\".") + (home-page "http://www.drpetter.se/project_sfxr.html") + (license license:expat))) diff --git a/gnu/packages/games.scm b/gnu/packages/games.scm index d86e151a85..8f495f7b32 100644 --- a/gnu/packages/games.scm +++ b/gnu/packages/games.scm @@ -108,7 +108,7 @@ representation of the playing board.") (define-public gnubik (package (name "gnubik") - (version "2.4.1") + (version "2.4.2") (source (origin (method url-fetch) @@ -116,7 +116,7 @@ representation of the playing board.") version ".tar.gz")) (sha256 (base32 - "0mfpwz341i1qpzi2qgslpc5i7d4fv7i01kv392m11pczqdc7i7m5")))) + "0mhpfnxzbns0wfrsjv5vafqr34770rbvkmdzxk0x0aq67hb3zyl5")))) (build-system gnu-build-system) (inputs `(("gtk+" ,gtk+-2) ("mesa" ,mesa) @@ -748,6 +748,43 @@ some of the restrictions in the venerable Z-machine format. This is the reference interpreter, using Glk API.") (license (license:fsf-free "file://README")))) +(define-public fizmo + (package + (name "fizmo") + (version "0.7.9") + (source (origin + (method url-fetch) + (uri (string-append "https://christoph-ender.de/fizmo/source/" + name "-" version ".tar.gz")) + (sha256 + (base32 + "1w7cgyjrhgkadjrazijzhq7zh0pl5bfc6wl7mdpgh020y4kp46d7")))) + (build-system gnu-build-system) + (arguments + '(#:configure-flags + (let ((libjpeg (assoc-ref %build-inputs "libjpeg")) + (ncurses (assoc-ref %build-inputs "ncurses"))) + (list (string-append "jpeg_CFLAGS=-I" libjpeg "/include") + (string-append "jpeg_LIBS=-ljpeg") + (string-append "ncursesw_CFLAGS=-I" ncurses "/include") + (string-append "ncursesw_LIBS=-lncursesw"))))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (inputs + `(("libjpeg" ,libjpeg) + ("libpng" ,libpng) + ("libsndfile" ,libsndfile) + ("libxml2" ,libxml2) + ("ncurses" ,ncurses) + ("sdl" ,sdl))) + (home-page "https://christoph-ender.de/fizmo/") + (synopsis "Z-machine interpreter") + (description + "Fizmo is a console-based Z-machine interpreter. It is used to play +interactive ficiton, also known as textadventures, which were implemented +either by Infocom or created using the Inform compiler.") + (license license:bsd-3))) + (define-public retroarch (package (name "retroarch") @@ -879,3 +916,37 @@ bones. This game is based on the GPL version of the famous game TuxRacer.") (home-page "http://sourceforge.net/projects/extremetuxracer/") (license license:gpl2+))) + +(define-public gnujump + (package + (name "gnujump") + (version "1.0.8") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnu/gnujump/gnujump-" + version ".tar.gz")) + (sha256 + (base32 + "05syy9mzbyqcfnm0hrswlmhwlwx54f0l6zhcaq8c1c0f8dgzxhqk")))) + (build-system gnu-build-system) + (arguments + '(#:phases + (modify-phases %standard-phases + (add-before + 'configure 'link-libm + (lambda _ (setenv "LIBS" "-lm")))))) + (inputs + `(("glu" ,glu) + ("mesa", mesa) + ("sdl" ,sdl) + ("sdl-image" ,sdl-image) + ("sdl-mixer" ,sdl-mixer))) + (home-page "http://gnujump.es.gnu.org/") + (synopsis + "Game of jumping to the next floor, trying not to fall") + (description + "GNUjump is a simple, yet addictive game in which you must jump from +platform to platform to avoid falling, while the platforms drop at faster rates +the higher you go. The game features multiplayer, unlimited FPS, smooth floor +falling, themeable graphics and sounds, and replays.") + (license license:gpl3+))) diff --git a/gnu/packages/gcc.scm b/gnu/packages/gcc.scm index 48ef72933d..414f31cb3c 100644 --- a/gnu/packages/gcc.scm +++ b/gnu/packages/gcc.scm @@ -335,7 +335,9 @@ Go. It also includes runtime support libraries for these languages.") (sha256 (base32 "1bd5vj4px3s8nlakbgrh38ynxq4s654m6nxz7lrj03mvkkwgvnmp")) - (patches (origin-patches (package-source gcc-4.9))))))) + (patches (map search-patch + '("gcc-arm-link-spec-fix.patch" + "gcc-5.0-libvtv-runpath.patch"))))))) (define* (custom-gcc gcc name languages #:key (separate-lib-output? #t)) "Return a custom version of GCC that supports LANGUAGES." @@ -405,38 +407,57 @@ Go. It also includes runtime support libraries for these languages.") "--enable-languages=java" ,@(remove (cut string-match "--enable-languages.*" <>) ,flags)))) - ((#:phases phases) - `(alist-cons-after - 'install 'install-javac-and-javap-wrappers - (lambda _ - (let* ((javac (assoc-ref %build-inputs "javac.in")) - (ecj (assoc-ref %build-inputs "ecj-bootstrap")) - (gcj (assoc-ref %outputs "out")) - (gcjbin (string-append gcj "/bin/")) - (jvm (string-append gcj "/lib/jvm/")) - (target (string-append jvm "/bin/javac"))) - - (symlink (string-append gcjbin "jcf-dump") - (string-append jvm "/bin/javap")) - - (copy-file ecj (string-append gcj "/share/java/ecj.jar")) - - ;; Create javac wrapper from the template javac.in by - ;; replacing the @VARIABLES@ with paths. - (copy-file javac target) - (patch-shebang target) - (substitute* target - (("@JAVA@") - (string-append jvm "/bin/java")) - (("@ECJ_JAR@") - (string-append gcj "/share/java/ecj.jar")) - (("@RT_JAR@") - (string-append jvm "/jre/lib/rt.jar")) - (("@TOOLS_JAR@") - (string-append jvm "/lib/tools.jar"))) - (chmod target #o755) - #t)) - ,phases)))))) + ((#:phases phases) + `(modify-phases ,phases + (add-after + 'unpack 'add-lib-output-to-rpath + (lambda _ + (substitute* "libjava/Makefile.in" + (("libgcj_bc_dummy_LINK = .* -shared" line) + (string-append line " -Wl,-rpath=$(libdir)")) + (("libgcj(_bc)?_la_LDFLAGS =" ldflags _) + (string-append ldflags " -Wl,-rpath=$(libdir)"))))) + (add-after + 'install 'install-javac-and-javap-wrappers + (lambda _ + (let* ((javac (assoc-ref %build-inputs "javac.in")) + (ecj (assoc-ref %build-inputs "ecj-bootstrap")) + (gcj (assoc-ref %outputs "out")) + (gcjbin (string-append gcj "/bin/")) + (jvm (string-append gcj "/lib/jvm/")) + (target (string-append jvm "/bin/javac"))) + + (symlink (string-append gcjbin "jcf-dump") + (string-append jvm "/bin/javap")) + + (copy-file ecj (string-append gcj "/share/java/ecj.jar")) + + ;; Create javac wrapper from the template javac.in by + ;; replacing the @VARIABLES@ with paths. + (copy-file javac target) + (patch-shebang target) + (substitute* target + (("@JAVA@") + (string-append jvm "/bin/java")) + (("@ECJ_JAR@") + (string-append gcj "/share/java/ecj.jar")) + (("@RT_JAR@") + (string-append jvm "/jre/lib/rt.jar")) + (("@TOOLS_JAR@") + (string-append jvm "/lib/tools.jar"))) + (chmod target #o755) + #t))) + (add-after + 'install 'remove-broken-or-conflicting-files + (lambda _ + (let ((out (assoc-ref %outputs "out"))) + (for-each + delete-file + (append (find-files (string-append out "/lib/jvm/jre/lib") + "libjawt.so") + (find-files (string-append out "/bin") + ".*(c\\+\\+|cpp|g\\+\\+|gcc.*)")))) + #t)))))))) (define ecj-bootstrap-4.8 (origin diff --git a/gnu/packages/gdb.scm b/gnu/packages/gdb.scm index 018f564e67..9c0b3ea307 100644 --- a/gnu/packages/gdb.scm +++ b/gnu/packages/gdb.scm @@ -36,14 +36,14 @@ (define-public gdb (package (name "gdb") - (version "7.9") + (version "7.9.1") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/gdb/gdb-" version ".tar.xz")) (sha256 (base32 - "14l3hhsy7fmpn2dk7ivc67gnbjdhkxlq90kxijpzfa35l58mcccv")))) + "0h5sfg4ndhb8q4fxbq0hdxfjp35n6ih96f6x8yvb418s84x5976d")))) (build-system gnu-build-system) (arguments '(#:tests? #f ; FIXME "make check" fails on single-processor systems. diff --git a/gnu/packages/gimp.scm b/gnu/packages/gimp.scm index 25a41690dd..35c55dc2f9 100644 --- a/gnu/packages/gimp.scm +++ b/gnu/packages/gimp.scm @@ -32,6 +32,7 @@ #:use-module (gnu packages compression) #:use-module (gnu packages xml) #:use-module (gnu packages photo) + #:use-module (gnu packages python) #:use-module (gnu packages xorg) #:use-module (gnu packages imagemagick)) @@ -127,10 +128,6 @@ buffers.") (base32 "0bdj0l7a94jqhjnj40m9rqaf622wj905iximivb55iy98639aanq")))) (build-system gnu-build-system) - (arguments - `(#:configure-flags - ;; We don't have pygtk which seems to be needed for this feature - `("--disable-python"))) (inputs `(("babl" ,babl) ("glib" ,glib) @@ -141,6 +138,8 @@ buffers.") ("exif" ,libexif) ;optional, EXIF + XMP support ("lcms" ,lcms) ;optional, color management ("librsvg" ,librsvg) ;optional, SVG support + ("python" ,python-2) ;optional, Python support + ("python2-pygtk" ,python2-pygtk) ;optional, Python support ("gegl" ,gegl))) (native-inputs `(("pkg-config" ,pkg-config) diff --git a/gnu/packages/gl.scm b/gnu/packages/gl.scm index afda76d792..d1503e1730 100644 --- a/gnu/packages/gl.scm +++ b/gnu/packages/gl.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> +;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Joshua Grant <tadni@riseup.net> ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> @@ -40,7 +40,8 @@ #:use-module (gnu packages fontutils) #:use-module (gnu packages guile) #:use-module (gnu packages video) - #:use-module (gnu packages xdisorg)) + #:use-module (gnu packages xdisorg) + #:use-module (gnu packages zip)) (define-public glu (package @@ -53,7 +54,8 @@ (sha256 (base32 "0r72yyhj09x3krn3kn629jqbwyq50ji8w5ri2pn6zwrk35m4g1s3")))) (build-system gnu-build-system) - (inputs `(("mesa" ,mesa))) + (propagated-inputs + `(("mesa" ,mesa))) ; according to glu.pc (home-page "http://www.opengl.org/archives/resources/faq/technical/glu.htm") (synopsis "Mesa OpenGL Utility library") (description @@ -219,7 +221,7 @@ also known as DXTn or DXTC) for Mesa.") (arguments `(#:configure-flags '(;; drop r300 from default gallium drivers, as it requires llvm - "--with-gallium-drivers=r600,svga,swrast" + "--with-gallium-drivers=r600,svga,swrast,nouveau" ;; Enable various optional features. TODO: opencl requires libclc, ;; omx requires libomxil-bellagio "--with-egl-platforms=x11,drm" @@ -403,6 +405,7 @@ extension functionality is exposed in a single header file.") (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("guile" ,guile-2.0) ("mesa" ,mesa) + ("glu" ,glu) ("freeglut" ,freeglut))) (arguments '(#:phases (alist-cons-before @@ -417,7 +420,7 @@ extension functionality is exposed in a single header file.") ;; Replace dynamic-link calls for libGL, libGLU, and ;; libglut with absolute paths to the store. (dynamic-link-substitute "glx/runtime.scm" "GL" "mesa") - (dynamic-link-substitute "glu/runtime.scm" "GLU" "mesa") + (dynamic-link-substitute "glu/runtime.scm" "GLU" "glu") (dynamic-link-substitute "glut/runtime.scm" "glut" "freeglut")) %standard-phases))) @@ -484,3 +487,45 @@ OpenGL graphics API.") (description "A library for handling OpenGL function pointer management.") (license l:x11))) + +(define-public soil + (package + (name "soil") + (version "1.0.7") + (source (origin + (method url-fetch) + ;; No versioned archive available. + (uri "http://www.lonesock.net/files/soil.zip") + (sha256 + (base32 + "00gpwp9dldzhsdhksjvmbhsd2ialraqbv6v6dpikdmpncj6mnc52")))) + (build-system gnu-build-system) + (arguments + '(#:tests? #f ; no tests + #:phases (modify-phases %standard-phases + (delete 'configure) + (add-before 'build 'init-build + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (setenv "CFLAGS" "-fPIC") ; needed for shared library + ;; Use alternate Makefile + (copy-file "projects/makefile/alternate Makefile.txt" + "src/Makefile") + (chdir "src") + (substitute* '("Makefile") + (("INCLUDEDIR = /usr/include/SOIL") + (string-append "INCLUDEDIR = " out "/include/SOIL")) + (("LIBDIR = /usr/lib") + (string-append "LIBDIR = " out "/lib")) + ;; Remove these flags from 'install' commands. + (("-o root -g root") "")))))))) + (native-inputs + `(("unzip" ,unzip))) + (inputs + `(("mesa" ,mesa))) + (home-page "http://www.lonesock.net/soil.html") + (synopsis "OpenGL texture loading library") + (description + "SOIL is a tiny C library used primarily for uploading textures into +OpenGL.") + (license l:public-domain))) diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm index 1d43895f5c..305c89c022 100644 --- a/gnu/packages/glib.scm +++ b/gnu/packages/glib.scm @@ -353,10 +353,11 @@ translated.") (base32 "1xi1v1msz75qs0s4lkyf1psrksdppa3hwkg0mznc6gpw5flg3hdz")))) (build-system gnu-build-system) - (inputs + (propagated-inputs ; according to dbus-glib-1.pc `(("dbus" ,dbus) - ("expat" ,expat) ("glib" ,glib))) + (inputs + `(("expat" ,expat))) (native-inputs `(("glib" ,glib "bin") ("pkg-config" ,pkg-config))) diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index 871cde8491..4af1d13495 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -6,6 +6,8 @@ ;;; Copyright © 2014, 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com> +;;; Copyright © 2015 David Hashe <david.hashe@dhashe.com> +;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,14 +38,15 @@ #:use-module (gnu packages cups) #:use-module (gnu packages curl) #:use-module (gnu packages databases) + #:use-module (gnu packages djvu) #:use-module (gnu packages flex) - #:use-module (gnu packages databases) #:use-module (gnu packages docbook) #:use-module (gnu packages glib) #:use-module (gnu packages gnupg) #:use-module (gnu packages gnuzilla) #:use-module (gnu packages gstreamer) #:use-module (gnu packages gtk) + #:use-module (gnu packages guile) #:use-module (gnu packages pdf) #:use-module (gnu packages polkit) #:use-module (gnu packages popt) @@ -59,13 +62,20 @@ #:use-module (gnu packages pulseaudio) #:use-module (gnu packages python) #:use-module (gnu packages scanner) + #:use-module (gnu packages ssh) #:use-module (gnu packages xml) #:use-module (gnu packages gl) #:use-module (gnu packages compression) + #:use-module (gnu packages texlive) #:use-module (gnu packages web) + #:use-module (gnu packages webkit) #:use-module (gnu packages xorg) #:use-module (gnu packages xdisorg) - #:use-module (gnu packages ncurses)) + #:use-module (gnu packages mail) + #:use-module (gnu packages backup) + #:use-module (gnu packages nettle) + #:use-module (gnu packages ncurses) + #:use-module (srfi srfi-1)) (define-public brasero (package @@ -176,6 +186,50 @@ Gnome project. It includes xml2po tool which makes it easier to translate and keep up to date translations of documentation.") (license license:gpl2+))) ; xslt under lgpl +(define-public gcr + (package + (name "gcr") + (version "3.16.0") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/" + (version-major+minor version) "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "0xfhi0w358lvca1jjx24x2gm67mif33dsnmi9cv5i0f83ks8vzpc")))) + (build-system gnu-build-system) + (arguments + '(#:tests? #f ;25 of 598 tests fail because /var/lib/dbus/machine-id does + ;not exist + #:phases (modify-phases %standard-phases + (add-before + 'check 'pre-check + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "build/tap-driver" + (("/usr/bin/env python") (which "python")))))))) + (inputs + `(("dbus" ,dbus) + ("gnupg" ,gnupg) ;called as a child process during tests + ("libgcrypt" ,libgcrypt))) + (native-inputs + `(("python" ,python-2) ;for tests + ("pkg-config" ,pkg-config) + ("glib" ,glib "bin") + ("intltool" ,intltool))) + ;; mentioned in gck.pc, gcr.pc and gcr-ui.pc + (propagated-inputs + `(("p11-kit" ,p11-kit) + ("glib" ,glib) + ("gtk+" ,gtk+))) + (home-page "http://www.gnome.org") + (synopsis "Libraries for displaying certificates and accessing key stores") + (description + "The GCR package contains libraries used for displaying certificates and +accessing key stores. It also provides the viewer for crypto files on the +GNOME Desktop.") + (license license:lgpl2.1+))) + (define-public libgnome-keyring (package (name "libgnome-keyring") @@ -207,10 +261,77 @@ and keep up to date translations of documentation.") ;; Though a couple of files are LGPLv2.1+. (license license:lgpl2.0+))) +(define-public gnome-keyring + (package + (name "gnome-keyring") + (version "3.16.0") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/" + (version-major+minor version) "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "1xg1xha3x3hzlmvdq2zm90hc61pj7pnf9yxxvgq4ynl5af6bp8qm")))) + (build-system gnu-build-system) + (arguments + `(#:tests? #f ;48 of 603 tests fail because /var/lib/dbus/machine-id does + ;not exist + #:configure-flags + (list + (string-append "--with-pkcs11-config=" + (assoc-ref %outputs "out") "/share/p11-kit/modules/") + (string-append "--with-pkcs11-modules=" + (assoc-ref %outputs "out") "/share/p11-kit/modules/")) + #:phases + (modify-phases %standard-phases + (add-before + 'check 'pre-check + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "build/tap-driver" + (("/usr/bin/env python") (which "python"))))) + (add-before + 'configure 'fix-docbook + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "docs/Makefile.am" + (("http://docbook.sourceforge.net/release/xsl/current/manpages/docbook.xsl") + (string-append (assoc-ref inputs "docbook-xsl") + "/xml/xsl/docbook-xsl-" + ,(package-version docbook-xsl) + "/manpages/docbook.xsl"))) + (setenv "XML_CATALOG_FILES" + (string-append (assoc-ref inputs "docbook-xml") + "/xml/dtd/docbook/catalog.xml"))))))) + (inputs + `(("libgcrypt" ,libgcrypt) + ("dbus" ,dbus) + ("gcr" ,gcr))) + (native-inputs + `(("pkg-config" ,pkg-config) + ("glib" ,glib "bin") + ("python" ,python-2) ;for tests + ("intltool" ,intltool) + ("autoconf" ,autoconf) + ("automake" ,automake) + ("libxslt" ,libxslt) ;for documentation + ("docbook-xml" ,docbook-xml-4.2) + ("docbook-xsl" ,docbook-xsl))) + (home-page "http://www.gnome.org") + (synopsis "Daemon to store passwords and encryption keys") + (description + "gnome-keyring is a program that keeps passwords and other secrets for +users. It is run as a daemon in the session, similar to ssh-agent, and other +applications locate it via an environment variable or D-Bus. + +The program can manage several keyrings, each with its own master password, +and there is also a session keyring which is never stored to disk, but +forgotten when the session ends.") + (license license:lgpl2.1+))) + (define-public evince (package (name "evince") - (version "3.6.1") + (version "3.16.1") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -218,7 +339,7 @@ and keep up to date translations of documentation.") name "-" version ".tar.xz")) (sha256 (base32 - "1da1pij030dh8mb0pr0jnyszgsbjnh8lc17rj5ii52j3kmbv51qv")))) + "0c31pwfzfm5x036f018q31k33vl8xb96nbs0iiccsc1abc37bzq6")))) (build-system glib-or-gtk-build-system) (arguments `(#:configure-flags '("--disable-nautilus") @@ -229,12 +350,18 @@ and keep up to date translations of documentation.") #:tests? #f)) (inputs `(("libspectre" ,libspectre) - ;; ("djvulibre" ,djvulibre) + ("djvulibre" ,djvulibre) ("ghostscript" ,ghostscript) ("poppler" ,poppler) + ("libtiff" ,libtiff) + ;; TODO: + ;; Add libgxps for XPS support. + ;; Build libkpathsea as a shared library for DVI support. + ;; ("libkpathsea" ,texlive-bin) + ("gnome-desktop" ,gnome-desktop) ("gsettings-desktop-schemas" ,gsettings-desktop-schemas) ("libgnome-keyring" ,libgnome-keyring) - ("gnome-icon-theme" ,gnome-icon-theme) + ("adwaita-icon-theme" ,adwaita-icon-theme) ("itstool" ,itstool) ("gdk-pixbuf" ,gdk-pixbuf) ("atk" ,atk) @@ -247,7 +374,8 @@ and keep up to date translations of documentation.") ("shared-mime-info" ,shared-mime-info) ("dconf" ,dconf) ("libcanberra" ,libcanberra) - + ("libsecret" ,libsecret) + ;; For tests. ("dogtail" ,python2-dogtail))) (native-inputs @@ -365,7 +493,7 @@ update-desktop-database: updates the database containing a cache of MIME types (define-public gnome-icon-theme (package (name "gnome-icon-theme") - (version "3.10.0") + (version "3.12.0") (source (origin (method url-fetch) @@ -374,14 +502,13 @@ update-desktop-database: updates the database containing a cache of MIME types name "-" version ".tar.xz")) (sha256 (base32 - "1xinbgkkvlhazj887ajcl13i7kdc1wcca02jwxzvjrvchjsp4m66")))) + "0fjh9qmmgj34zlgxb09231ld7khys562qxbpsjlaplq2j85p57im")))) (build-system gnu-build-system) - (inputs - `(("gtk+" ,gtk+) - ("icon-naming-utils" ,icon-naming-utils))) (native-inputs - `(("intltool" ,intltool) - ("pkg-config" ,pkg-config))) + `(("gtk+" ,gtk+) ; for gtk-update-icon-cache + ("icon-naming-utils" ,icon-naming-utils) + ("intltool" ,intltool) + ("pkg-config" ,pkg-config))) (home-page "http://art.gnome.org/") (synopsis "GNOME icon theme") @@ -389,6 +516,20 @@ update-desktop-database: updates the database containing a cache of MIME types "Icons for the GNOME desktop.") (license license:lgpl3))) ; or Creative Commons BY-SA 3.0 +;; gnome-icon-theme was renamed to adwaita-icon-theme after version 3.12.0. +(define-public adwaita-icon-theme + (package (inherit gnome-icon-theme) + (name "adwaita-icon-theme") + (version "3.16.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/" + (version-major+minor version) "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "1hmlw7kvhr7c2asc5y77adpymi9ka17gaf76zz835nwwffnn4rlw")))))) + (define-public shared-mime-info (package (name "shared-mime-info") @@ -629,7 +770,7 @@ dealing with different structured file formats.") (define-public librsvg (package (name "librsvg") - (version "2.40.6") + (version "2.40.9") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -637,7 +778,7 @@ dealing with different structured file formats.") name "-" version ".tar.xz")) (sha256 (base32 - "01jgb11779080b80k2ncrhdphgillqrrnszal6vh8yv787r4kwwa")))) + "0fplymmqqr28y24vcnb01szn62pfbqhk8p1ngns54x9m6mflr5hk")))) (build-system gnu-build-system) (arguments `(#:phases @@ -657,15 +798,15 @@ dealing with different structured file formats.") (alist-cons-after 'install 'generate-full-cache (lambda* (#:key inputs outputs #:allow-other-keys) - (let ((loaders-directory + (let ((loaders-directory (string-append (assoc-ref outputs "out") "/lib/gdk-pixbuf-2.0/2.10.0/loaders"))) (zero? - (system - (string-append - "gdk-pixbuf-query-loaders " + (system + (string-append + "gdk-pixbuf-query-loaders " loaders-directory "/libpixbufloader-svg.so " - (string-join (find-files (assoc-ref inputs "gdk-pixbuf") + (string-join (find-files (assoc-ref inputs "gdk-pixbuf") "libpixbufloader-.*\\.so") " ") "> " loaders-directory ".cache"))))) %standard-phases)))) @@ -716,7 +857,7 @@ library.") Definition Language (idl) files, which is a specification for defining portable interfaces. libidl was initially written for orbit (the orb from the GNOME project, and the primary means of libidl distribution). However, the -functionality was designed to be as reusable and portable as possible.") +functionality was designed to be as reusable and portable as possible.") (license license:lgpl2.0+))) @@ -726,7 +867,7 @@ functionality was designed to be as reusable and portable as possible.") (version "2.14.19") (source (origin (method url-fetch) - (uri (let ((upstream-name "ORBit2")) + (uri (let ((upstream-name "ORBit2")) (string-append "mirror://gnome/sources/" upstream-name "/" (version-major+minor version) "/" upstream-name "-" version ".tar.bz2"))) @@ -751,11 +892,11 @@ functionality was designed to be as reusable and portable as possible.") (home-page "https://projects.gnome.org/orbit2/") (synopsis "CORBA 2.4-compliant Object Request Broker") (description "ORBit2 is a CORBA 2.4-compliant Object Request Broker (orb) -featuring mature C, C++ and Python bindings.") +featuring mature C, C++ and Python bindings.") ;; Licence notice is unclear. The Web page simply say "GPL" without giving a version. ;; SOME of the code files have licence notices for GPLv2+ ;; The tarball contains files of the text of GPLv2 and LGPLv2 - (license license:gpl2+))) + (license license:gpl2+))) (define-public libbonobo @@ -798,7 +939,7 @@ featuring mature C, C++ and Python bindings.") (home-page "https://developer.gnome.org/libbonobo/") (synopsis "Framework for creating reusable components for use in GNOME applications") (description "Bonobo is a framework for creating reusable components for -use in GNOME applications, built on top of CORBA.") +use in GNOME applications, built on top of CORBA.") ;; Licence not explicitly stated. Source files contain no licence notices. ;; Tarball contains text of both GPLv2 and LGPLv2 ;; GPLv2 covers both conditions @@ -811,7 +952,7 @@ use in GNOME applications, built on top of CORBA.") (version "3.2.6") (source (origin (method url-fetch) - (uri + (uri (let ((upstream-name "GConf")) (string-append "mirror://gnome/sources/" upstream-name "/" (version-major+minor version) "/" @@ -819,11 +960,10 @@ use in GNOME applications, built on top of CORBA.") (sha256 (base32 "0k3q9nh53yhc9qxf1zaicz4sk8p3kzq4ndjdsgpaa2db0ccbj4hr")))) (build-system gnu-build-system) - (inputs `(("glib" ,glib) - ("dbus" ,dbus) - ("dbus-glib" ,dbus-glib) + (inputs `(("dbus-glib" ,dbus-glib) ("libxml2" ,libxml2))) - (propagated-inputs `(("orbit2" ,orbit2))) ; referred to in the .pc file + (propagated-inputs `(("glib" ,glib) ; referred to in the .pc file + ("orbit2" ,orbit2))) (native-inputs `(("intltool" ,intltool) ("glib" ,glib "bin") ; for glib-genmarshal, etc. @@ -832,7 +972,7 @@ use in GNOME applications, built on top of CORBA.") (synopsis "Store application preferences") (description "Gconf is a system for storing application preferences. It is intended for user preferences; not arbitrary data storage.") - (license license:lgpl2.0+))) + (license license:lgpl2.0+))) (define-public gnome-mime-data @@ -887,10 +1027,8 @@ designed to be accessed through the MIME functions in GnomeVFS.") (substitute* "test/test-async-cancel.c" (("EXIT_FAILURE") "77"))) %standard-phases)))) - (inputs `(("glib" ,glib) - ("libxml2" ,libxml2) + (inputs `(("libxml2" ,libxml2) ("dbus-glib" ,dbus-glib) - ("dbus" ,dbus) ("gconf" ,gconf) ("gnome-mime-data" ,gnome-mime-data) ("zlib" ,zlib))) @@ -925,7 +1063,7 @@ to access local and remote files with a single consistent API.") `(#:phases (alist-cons-before 'configure 'enable-deprecated - (lambda _ + (lambda _ (substitute* "libgnome/Makefile.in" (("-DG_DISABLE_DEPRECATED") "-DGLIB_DISABLE_DEPRECATION_WARNINGS"))) %standard-phases))) @@ -943,8 +1081,7 @@ to access local and remote files with a single consistent API.") `(("libcanberra" ,libcanberra) ("libbonobo" ,libbonobo) ("gconf" ,gconf) - ("gnome-vfs" ,gnome-vfs) - ("glib" ,glib))) + ("gnome-vfs" ,gnome-vfs))) (home-page "https://developer.gnome.org/libgnome/") (synopsis "Useful routines for building applications") (description "The libgnome library provides a number of useful routines @@ -971,7 +1108,7 @@ files and URIs, and displaying help.") `(("pkg-config" ,pkg-config))) (home-page "https://people.gnome.org/~mathieu/libart") (synopsis "2D drawing library") - (description "Libart is a 2D drawing library intended as a + (description "Libart is a 2D drawing library intended as a high-quality vector-based 2D library with antialiasing and alpha composition.") (license license:lgpl2.0+))) @@ -1143,7 +1280,7 @@ since ca. 2006, when GTK+ itself incorporated printing support.") ("glib" ,glib) ("gnome-icon-theme" ,gnome-icon-theme) ("libgnomecanvas" ,libgnomecanvas) - ("libxml2" ,libxml2))) + ("libxml2" ,libxml2))) (native-inputs `(("intltool" ,intltool) ("pkg-config" ,pkg-config))) @@ -1172,7 +1309,7 @@ since ca. 2006, when GTK+ itself incorporated printing support.") (lambda* (#:key inputs #:allow-other-keys) (let ((xorg-server (assoc-ref inputs "xorg-server")) (disp ":1")) - + (setenv "HOME" (getcwd)) (setenv "DISPLAY" disp) ;; There must be a running X server and make check doesn't start one. @@ -1269,11 +1406,38 @@ Hints specification (EWMH).") (home-page "https://developer.gnome.org/goffice/") (synopsis "Document-centric objects and utilities") (description "A GLib/GTK+ set of document-centric objects and utilities.") - (license + (license ;; Dual licensed under GPLv2 or GPLv3 (both without "or later") ;; Note: NOT LGPL (list license:gpl2 license:gpl3)))) +(define-public goffice-0.8 + (package (inherit goffice) + (version "0.8.17") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" (package-name goffice) "/" + (version-major+minor version) "/" + (package-name goffice) "-" version ".tar.xz")) + (sha256 + (base32 "05fvzbs5bin05bbsr4dp79aiva3lnq0a3a40zq55i13vnsz70l0n")))) + (arguments + `(#:phases + (alist-cons-after + 'unpack 'fix-pcre-check + (lambda _ + ;; Only glib.h can be included directly. See + ;; https://bugzilla.gnome.org/show_bug.cgi?id=670316 + (substitute* "configure" + (("glib/gregex\\.h") "glib.h")) #t) + %standard-phases))) + (propagated-inputs + ;; libgoffice-0.8.pc mentions libgsf-1 + `(("libgsf" ,libgsf))) + (inputs + `(("gtk" ,gtk+-2) + ,@(alist-delete "gtk" (package-inputs goffice)))))) + (define-public gnumeric (package (name "gnumeric") @@ -1290,7 +1454,7 @@ Hints specification (EWMH).") (arguments `(;; The gnumeric developers don't worry much about failing tests. ;; See https://bugzilla.gnome.org/show_bug.cgi?id=732387 - #:tests? #f + #:tests? #f #:phases (alist-cons-before 'configure 'pre-conf @@ -1299,9 +1463,9 @@ Hints specification (EWMH).") ;; I am informed that this only affects the possibility to embed a ;; spreadsheet inside an Abiword document. So presumably when we ;; package Abiword we'll have to refer it to this directory. - (substitute* "configure" + (substitute* "configure" (("^GOFFICE_PLUGINS_DIR=.*") - (string-append "GOFFICE_PLUGINS_DIR=" + (string-append "GOFFICE_PLUGINS_DIR=" (assoc-ref outputs "out") "/goffice/plugins")))) %standard-phases))) (inputs @@ -1336,7 +1500,7 @@ engineering.") (source (origin (method url-fetch) - (uri (string-append "mirror://gnome/sources/" name "/" + (uri (string-append "mirror://gnome/sources/" name "/" (version-major+minor version) "/" name "-" version ".tar.xz")) (sha256 @@ -1361,8 +1525,8 @@ engineering.") ;; gdk-pixbuf because the latter does not include support for SVG ;; files. (lambda* (#:key inputs #:allow-other-keys) - (setenv "GDK_PIXBUF_MODULE_FILE" - (car (find-files (assoc-ref inputs "librsvg") + (setenv "GDK_PIXBUF_MODULE_FILE" + (car (find-files (assoc-ref inputs "librsvg") "loaders\\.cache")))) %standard-phases))) (home-page "https://launchpad.net/gnome-themes-standard") @@ -1371,6 +1535,39 @@ engineering.") "The default GNOME 3 themes (Adwaita and some accessibility themes).") (license license:lgpl2.1+))) +(define-public seahorse + (package + (name "seahorse") + (version "3.16.0") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/" + (version-major+minor version) "/" name "-" + version ".tar.xz")) + (sha256 + (base32 + "0cg1grgpwbfkiny5148n17rzpc8kswyr5yff0kpm8l3lp01my2kp")))) + (build-system glib-or-gtk-build-system) + (inputs + `(("gtk+" ,gtk+) + ("gcr" ,gcr) + ("gnupg" ,gnupg-1) + ("gpgme" ,gpgme) + ("openssh" ,openssh) + ("libsecret" ,libsecret))) + (native-inputs + `(("intltool" ,intltool) + ("glib:bin" ,glib "bin") + ("itstool" ,itstool) + ("pkg-config" ,pkg-config))) + (home-page "https://launchpad.net/gnome-themes-standard") + (synopsis "Manage encryption keys and passwords in the GNOME keyring") + (description + "Seahorse is a GNOME application for managing encryption keys and +passwords in the GNOME keyring.") + (license license:gpl2+))) + (define-public vala (package (name "vala") @@ -1471,7 +1668,7 @@ editors, IDEs, etc.") (source (origin (method url-fetch) (uri (string-append - "mirror://gnome/sources/" name "/" + "mirror://gnome/sources/" name "/" (version-major+minor version) "/" name "-" version ".tar.xz")) (sha256 @@ -1493,7 +1690,7 @@ editors, IDEs, etc.") ; or /etc/machine-id. #:configure-flags ;; Set the correct RUNPATH in binaries. - (list (string-append "LDFLAGS=-Wl,-rpath=" + (list (string-append "LDFLAGS=-Wl,-rpath=" (assoc-ref %outputs "out") "/lib") "--disable-gtk-doc-html") ; FIXME: requires gtk-doc #:phases @@ -1502,12 +1699,12 @@ editors, IDEs, etc.") (lambda* (#:key inputs #:allow-other-keys) (substitute* "docs/Makefile.in" (("http://docbook.sourceforge.net/release/xsl/current/manpages/docbook.xsl") - (string-append (assoc-ref inputs "docbook-xsl") + (string-append (assoc-ref inputs "docbook-xsl") "/xml/xsl/docbook-xsl-" ,(package-version docbook-xsl) "/manpages/docbook.xsl"))) - (setenv "XML_CATALOG_FILES" - (string-append (assoc-ref inputs "docbook-xml") + (setenv "XML_CATALOG_FILES" + (string-append (assoc-ref inputs "docbook-xml") "/xml/dtd/docbook/catalog.xml"))) %standard-phases))) (home-page "https://developer.gnome.org/dconf") @@ -1906,7 +2103,6 @@ keyboard shortcuts.") ("intltool" ,intltool))) (inputs `(("eudev" ,eudev) - ("dbus" ,dbus) ("dbus-glib" ,dbus-glib) ("libusb" ,libusb) ("lcms" ,lcms) @@ -1923,7 +2119,7 @@ output devices.") (define-public geoclue (package (name "geoclue") - (version "2.1.10") + (version "2.2.0") (source (origin (method url-fetch) @@ -1932,7 +2128,7 @@ output devices.") name "-" version ".tar.xz")) (sha256 (base32 - "0s0ws2bx5g1cbjamxmm448r4n4crha2fwpzm8zbx6cq6qslygmzi")) + "0inlqx0zar498fhi9hh92p2g4kp8qy3zdl4z3vw6bjwp9w6xx454")) (patches (list (search-patch "geoclue-config.patch"))))) (build-system glib-or-gtk-build-system) (arguments @@ -2040,7 +2236,6 @@ faster results and to avoid unnecessary server load.") ("python" ,python))) (inputs `(("eudev" ,eudev) - ("dbus" ,dbus) ("dbus-glib" ,dbus-glib) ("libusb" ,libusb))) (home-page "http://upower.freedesktop.org/") @@ -2153,3 +2348,99 @@ parameters of a GNOME session and the applications that run under it. It handles settings such keyboard layout, shortcuts, and accessibility, clipboard settings, themes, mouse settings, and startup of other daemons.") (license license:gpl2+))) + +(define-public totem-pl-parser + (package + (name "totem-pl-parser") + (version "3.10.5") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/totem-pl-parser/3.10/" + "totem-pl-parser-" version ".tar.xz")) + (sha256 + (base32 + "0dw1kiwmjwdjrighri0j9nagsnj44dllm0mamnfh4y5nc47mhim7")))) + (build-system gnu-build-system) + (arguments + ;; FIXME: Tests require gvfs. + `(#:tests? #f)) + (native-inputs + `(("intltool" ,intltool) + ("glib" ,glib "bin") + ("pkg-config" ,pkg-config))) + (inputs + `(("glib" ,glib) + ("gmime" ,gmime) + ("libarchive" ,libarchive) + ("libgcrypt" ,libgcrypt) + ("nettle" ,nettle) + ("libsoup" ,libsoup) + ("libxml2" ,libxml2))) + (home-page "https://projects.gnome.org/totem") + (synopsis "Library to parse and save media playlists for GNOME") + (description "Totem-pl-parser is a GObjects-based library to parse and save +playlists in a variety of formats.") + (license license:lgpl2.0+))) + +(define-public aisleriot + (package + (name "aisleriot") + (version "3.16.1") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/" + (version-major+minor version) "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "19k483x9dkq8vjbq8f333pk9qil64clpsfg20q8xk9bgmk38aj8h")))) + (build-system glib-or-gtk-build-system) + (arguments + '(#:configure-flags + '("--with-platform=gtk-only" + "--with-card-theme-formats=svg"))) + (native-inputs + `(("desktop-file-utils" ,desktop-file-utils) + ("glib:bin" ,glib "bin") ; for glib-compile-schemas, etc. + ("intltool" ,intltool) + ("itstool" ,itstool) + ("pkg-config" ,pkg-config) + ("xmllint" ,libxml2))) + (inputs + `(("gtk+" ,gtk+) + ("guile" ,guile-2.0) + ("libcanberra" ,libcanberra) + ("librsvg" ,librsvg))) + (home-page "https://wiki.gnome.org/Apps/Aisleriot") + (synopsis "Solitaire card games") + (description + "Aisleriot (also known as Solitaire or sol) is a collection of card games +which are easy to play with the aid of a mouse.") + (license license:gpl3+))) + +(define-public devhelp + (package + (name "devhelp") + (version "3.16.1") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/" + (version-major+minor version) "/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "0i8kyh86hzwxs8dm047ivghl2b92vigdxa3x4pk4ha0whpk38g37")))) + (build-system glib-or-gtk-build-system) + (native-inputs + `(("intltool" ,intltool) + ("pkg-config" ,pkg-config))) + (inputs + `(("gsettings-desktop-schemas" ,gsettings-desktop-schemas) + ("webkitgtk" ,webkitgtk))) + (home-page "https://wiki.gnome.org/Apps/Devhelp") + (synopsis "API documentation browser for GNOME") + (description + "Devhelp is an API documentation browser for GTK+ and GNOME. It works +natively with GTK-Doc (the API reference system developed for GTK+ and used +throughout GNOME for API documentation).") + (license license:gpl2+))) diff --git a/gnu/packages/gnu-pw-mgr.scm b/gnu/packages/gnu-pw-mgr.scm index e0f223d7d6..7a9b0b9810 100644 --- a/gnu/packages/gnu-pw-mgr.scm +++ b/gnu/packages/gnu-pw-mgr.scm @@ -23,22 +23,25 @@ #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module (gnu packages) - #:use-module (gnu packages base)) + #:use-module (gnu packages base) + #:use-module (gnu packages autogen)) (define-public gnu-pw-mgr (package (name "gnu-pw-mgr") - (version "1.3") + (version "1.4") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/gnu-pw-mgr/gnu-pw-mgr-" - version ".tar.gz")) + version ".tar.xz")) (sha256 (base32 - "0rbnv5wszpr35py97vwylqkdlf06qpd2x9j9aqlmgkd4mr1n4hf0")))) + "0a352y1m33vp6zmdbn96fdrq9gr9lchc9vcrj14mfx7g0dsvxjns")))) (build-system gnu-build-system) - (inputs `(("which" ,which))) + (native-inputs + `(("which" ,which) + ("autogen" ,autogen))) (home-page "http://www.gnu.org/software/gnu-pw-mgr/") (synopsis "Retrieve login credentials without recording passwords") (description diff --git a/gnu/packages/gnucash.scm b/gnu/packages/gnucash.scm new file mode 100644 index 0000000000..6ab8f09ce6 --- /dev/null +++ b/gnu/packages/gnucash.scm @@ -0,0 +1,72 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> +;;; +;;; 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 gnucash) + #:use-module (guix licenses) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages) + #:use-module (gnu packages gnome) + #:use-module (gnu packages glib) + #:use-module (gnu packages gtk) + #:use-module (gnu packages guile) + #:use-module (gnu packages icu4c) + #:use-module (gnu packages pkg-config) + #:use-module (gnu packages webkit) + #:use-module (gnu packages xml)) + +(define-public gnucash + (package + (name "gnucash") + (version "2.6.6") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/gnucash/gnucash-" + version ".tar.bz2")) + (sha256 + (base32 + "103ir5qg6k8m2mmg9b99c3gn8myxh1gsqyr0mfhmrhqya68wfdr3")))) + (build-system gnu-build-system) + (arguments + `(#:tests? #f ;FIXME: failing at /qof/gnc-date/qof print date dmy buff + #:configure-flags '("--disable-dbi"))) + (inputs + `(("guile" ,guile-2.0) + ("icu4c" ,icu4c) + ("glib" ,glib) + ("gtk" ,gtk+-2) + ("goffice" ,goffice-0.8) + ("libgnomecanvas" ,libgnomecanvas) + ("libxml2" ,libxml2) + ("libxslt" ,libxslt) + ("webkitgtk" ,webkitgtk/gtk+-2))) + (native-inputs + `(("glib" ,glib "bin") ; glib-compile-schemas, etc. + ("intltool" ,intltool) + ("pkg-config" ,pkg-config))) + (home-page "https://gnu.org/software/gnucash") + (synopsis "Personal and small business financial accounting software") + (description + "GnuCash is personal and professional financial-accounting software. +It can be used to track bank accounts, stocks, income and expenses, based on +the double-entry accounting practice. It includes support for QIF/OFX/HBCI +import and transaction matching. It also automates several tasks, such as +financial calculations or scheduled transactions.") + (license gpl3+))) diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index 3b29d1abfa..5724bc8348 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -190,14 +190,14 @@ compatible to GNU Pth.") (define-public gnupg (package (name "gnupg") - (version "2.1.2") + (version "2.1.4") (source (origin (method url-fetch) (uri (string-append "mirror://gnupg/gnupg/gnupg-" version ".tar.bz2")) (sha256 (base32 - "14k7c5spai3yppz6izf1ggbnffskl54ln87v1wgy9pwism1mlks0")))) + "1c3c89b7ziknz6h1dnwmfjhgyy28g982rcncrhmhylb8v3npw4k4")))) (build-system gnu-build-system) (inputs `(("bzip2" ,bzip2) @@ -231,14 +231,14 @@ libskba (working with X.509 certificates and CMS data).") (define-public gnupg-2.0 (package (inherit gnupg) - (version "2.0.27") + (version "2.0.28") (source (origin (method url-fetch) (uri (string-append "mirror://gnupg/gnupg/gnupg-" version ".tar.bz2")) (sha256 (base32 - "1wihx7dphacg9fy5wfj93h236lr1w5gwzh7ir3js37wi9cz6sr2p")))) + "0k2k399fnhfhhr4dvm8d6vs4ihq6gg06191lzfwikzaqmgj2w2ff")))) (inputs `(("bzip2" ,bzip2) ("curl" ,curl) @@ -300,7 +300,7 @@ libskba (working with X.509 certificates and CMS data).") ;; Needs to be propagated because gpgme.h includes gpg-error.h. `(("libgpg-error" ,libgpg-error))) (inputs - `(("gnupg" ,gnupg) + `(("gnupg" ,gnupg-2.0) ("libassuan" ,libassuan))) (arguments '(#:make-flags '("GPG=gpg2"))) (home-page "http://www.gnupg.org/related_software/gpgme/") diff --git a/gnu/packages/gnutls.scm b/gnu/packages/gnutls.scm index 17cd4582ff..4ed339a09b 100644 --- a/gnu/packages/gnutls.scm +++ b/gnu/packages/gnutls.scm @@ -39,7 +39,7 @@ (define-public libtasn1 (package (name "libtasn1") - (version "4.4") + (version "4.5") (source (origin (method url-fetch) @@ -47,7 +47,7 @@ version ".tar.gz")) (sha256 (base32 - "0p8c5s1gm3z3nn4s9qc6gs18grbk45mx44byqw2l2qzynjqrsd7q")))) + "1nhvnznhg2aqfrfjxc8v008hjlzkh5831jsfahqk89qrw7fbbcw9")))) (build-system gnu-build-system) (native-inputs `(("perl" ,perl) @@ -104,7 +104,7 @@ living in the same process.") (define-public gnutls (package (name "gnutls") - (version "3.4.0") + (version "3.4.1") (source (origin (method url-fetch) (uri @@ -115,9 +115,7 @@ living in the same process.") "/gnutls-" version ".tar.xz")) (sha256 (base32 - "0bj7ydvsyvml59b6040wg7694iz37rwnqnv09bic9ddz652588ml")) - (patches - (list (search-patch "gnutls-fix-duplicate-manpages.patch"))))) + "0bmih0zyiplr4v8798w0v9g3215zmganq18n8935cizkxj5zbdg9")))) (build-system gnu-build-system) (arguments '(#:configure-flags diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm index 522404f280..7caa7314a9 100644 --- a/gnu/packages/gnuzilla.scm +++ b/gnu/packages/gnuzilla.scm @@ -124,7 +124,7 @@ in the Mozilla clients.") (define-public nss (package (name "nss") - (version "3.18") + (version "3.19.1") (source (origin (method url-fetch) (uri (let ((version-with-underscores @@ -135,7 +135,7 @@ in the Mozilla clients.") "nss-" version ".tar.gz"))) (sha256 (base32 - "0h0xy9kvd2s8r438q4dfn25cgvv5dc1hkm9lb4bgrxpr5bxv13b1")) + "1zrgqlli01gsg2a5w4bk2p0q3aagi5dhd31yirnj04zca6ap1gmp")) ;; Create nss.pc and nss-config. (patches (list (search-patch "nss-pkgconfig.patch"))))) (build-system gnu-build-system) @@ -205,6 +205,12 @@ in the Mozilla clients.") ("zlib" ,zlib))) (propagated-inputs `(("nspr" ,nspr))) ; required by nss.pc. (native-inputs `(("perl" ,perl))) + + ;; The NSS test suite takes over 28 hours on Loongson 3A (MIPS), and + ;; possibly longer when another build is happening concurrently on the + ;; same machine. + (properties '((timeout . 144000))) ; 40 hours + (home-page "https://developer.mozilla.org/en-US/docs/Mozilla/Projects/NSS") (synopsis "Network Security Services") @@ -219,7 +225,7 @@ standards.") (define-public icecat (package (name "icecat") - (version "31.6.0-gnu1") + (version "31.7.0-gnu1") (source (origin (method url-fetch) @@ -228,15 +234,13 @@ standards.") name "-" version ".tar.bz2")) (sha256 (base32 - "1a4l23msg4cpc4yp59q2z6xv63r6advlbnjy65v4djv6yhgnqf1i")))) + "0a25jp5afla2dxzj7i4cyvqpa5smsn7ns3xvpzqw6pc7naixkpap")))) (build-system gnu-build-system) (inputs `(("alsa-lib" ,alsa-lib) ("bzip2" ,bzip2) ("cairo" ,cairo) - ("dbus" ,dbus) ("dbus-glib" ,dbus-glib) - ("glib" ,glib) ("gstreamer" ,gstreamer) ("gst-plugins-base" ,gst-plugins-base) ("gtk+" ,gtk+-2) diff --git a/gnu/packages/gstreamer.scm b/gnu/packages/gstreamer.scm index 03aecdfa53..24dc41b703 100644 --- a/gnu/packages/gstreamer.scm +++ b/gnu/packages/gstreamer.scm @@ -171,6 +171,10 @@ This package provides the core library and elements.") ;; for g-ir-scanner. (setenv "CC" "gcc")) %standard-phases))) + (native-search-paths + (list (search-path-specification + (variable "GST_PLUGIN_SYSTEM_PATH") + (files '("lib/gstreamer-1.0"))))) (home-page "http://gstreamer.freedesktop.org/") (synopsis "Plugins for the GStreamer multimedia library") diff --git a/gnu/packages/gtk.scm b/gnu/packages/gtk.scm index 8a5a3099bf..f518992498 100644 --- a/gnu/packages/gtk.scm +++ b/gnu/packages/gtk.scm @@ -138,24 +138,28 @@ affine transformation (scale, rotation, shear, etc.)") (define-public harfbuzz (package (name "harfbuzz") - (version "0.9.22") + (version "0.9.40") (source (origin (method url-fetch) (uri (string-append "http://www.freedesktop.org/software/harfbuzz/release/harfbuzz-" version ".tar.bz2")) (sha256 (base32 - "1nkimwadri6v2kzrmz8y0crmy59gw0kg4i4f6cc786bngs0815lq")))) + "07rjp05axas96fp23lpf8l2yyfdj9yib4m0qjv592vdyhcsxaw8p")))) (build-system gnu-build-system) (inputs `(("cairo" ,cairo) ("graphite2" ,graphite2) ("icu4c" ,icu4c))) + (propagated-inputs + `(("glib" ,glib))) ; required by harfbuzz-gobject.pc (native-inputs - `(("pkg-config" ,pkg-config) - ("python" ,python-wrapper))) + `(("gobject-introspection" ,gobject-introspection) + ("pkg-config" ,pkg-config) + ("python" ,python-2))) ; incompatible with Python 3 (print syntax) (arguments - `(#:configure-flags `("--with-graphite2=yes"))) + `(#:configure-flags `("--with-graphite2" + "--with-gobject"))) (synopsis "OpenType text shaping engine") (description "HarfBuzz is an OpenType text shaping engine.") @@ -426,7 +430,7 @@ is part of the GNOME accessibility project.") (define-public gtk+-2 (package (name "gtk+") - (version "2.24.27") + (version "2.24.28") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -434,7 +438,7 @@ is part of the GNOME accessibility project.") name "-" version ".tar.xz")) (sha256 (base32 - "1x14rnjvqslpa1q19fp1qalz5sxds72amsgjk8m7769rwk511jr0")))) + "0mj6xn40py9r9lvzg633fal81xfwfm89d9mvz7jk4lmwk0g49imj")))) (build-system gnu-build-system) (outputs '("out" "doc")) (propagated-inputs @@ -482,7 +486,7 @@ application suites.") (define-public gtk+ (package (inherit gtk+-2) (name "gtk+") - (version "3.16.2") + (version "3.16.3") (source (origin (method url-fetch) (uri (string-append "mirror://gnome/sources/" name "/" @@ -490,7 +494,7 @@ application suites.") name "-" version ".tar.xz")) (sha256 (base32 - "1yhwg2l72l3khfkprydcjlpxjrg11ccqfc80sjl56llz3jk66fd0")))) + "195ykv53sl2gsc847wcnd79zilm1yzcc2cfjxnrakhh2dd5gshr9")))) (propagated-inputs `(("at-spi2-atk" ,at-spi2-atk) ("atk" ,atk) @@ -501,7 +505,8 @@ application suites.") ("libxdamage" ,libxdamage) ("pango" ,pango))) (inputs - `(("libxml2" ,libxml2) + `(("librsvg" ,librsvg) ;for gtk-encode-symbolic-svg + ("libxml2" ,libxml2) ("cups" ,cups))) ;for printing support (native-inputs `(("perl" ,perl) @@ -533,7 +538,18 @@ application suites.") "demos/gtk-demo/Makefile.in") (("gtk-update-icon-cache") "$(bindir)/gtk-update-icon-cache")) #t) - %standard-phases))))) + (alist-cons-after + 'install 'wrap-gtk-encode-symbolic-svg + ;; By using GdkPixbuf, gtk-encode-symbolic-svg needs to know + ;; librsvg's loaders.cache to handle SVG files. + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (prog (string-append out "/bin/gtk-encode-symbolic-svg")) + (librsvg (assoc-ref inputs "librsvg")) + (loaders.cache (find-files librsvg "^loaders\\.cache$"))) + (wrap-program prog + `("GDK_PIXBUF_MODULE_FILE" = ,loaders.cache)))) + %standard-phases)))))) ;;; ;;; Guile bindings. @@ -844,7 +860,7 @@ write GNOME applications.") (define-public girara (package (name "girara") - (version "0.2.3") + (version "0.2.4") (source (origin (method url-fetch) (uri @@ -852,7 +868,7 @@ write GNOME applications.") version ".tar.gz")) (sha256 (base32 - "1phfmqp8y17zcy9yi6pm2f80x8ldbk60iswpm4bmjz5217jwqzxh")))) + "0pnfdsg435b5vc4x8l9pgm77aj7ram1q0bzrp9g4a3bh1r64xq1f")))) (native-inputs `(("pkg-config" ,pkg-config) ("gettext" ,gnu-gettext))) (inputs `(("gtk+" ,gtk+) diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index 751002f54c..d8c1a8ca35 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -27,6 +27,7 @@ #:use-module (gnu packages gperf) #:use-module (gnu packages libffi) #:use-module (gnu packages autotools) + #:use-module (gnu packages flex) #:use-module (gnu packages libunistring) #:use-module (gnu packages m4) #:use-module (gnu packages multiprecision) @@ -35,6 +36,9 @@ #:use-module (gnu packages ncurses) #:use-module (gnu packages ed) #:use-module (gnu packages base) + #:use-module (gnu packages texinfo) + #:use-module (gnu packages gettext) + #:use-module (gnu packages gdbm) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix git-download) @@ -181,6 +185,42 @@ without requiring the source code to be rewritten.") ;; in the `base' module, and thus changing it entails a full rebuild. guile-2.0) +(define-public guile-for-guile-emacs + (package (inherit guile-2.0) + (name "guile-for-guile-emacs") + (version "20150510.d8d9a8d") + (source (origin + (method git-fetch) + (uri (git-reference + (url "git://git.hcoop.net/git/bpt/guile.git") + (commit "d8d9a8da05ec876acba81a559798eb5eeceb5a17"))) + (sha256 + (base32 + "00sprsshy16y8pxjy126hr2adqcvvzzz96hjyjwgg8swva1qh6b0")))) + (arguments + (substitute-keyword-arguments `(;; Tests aren't passing for now. + ;; Obviously we should re-enable this! + #:tests? #f + ,@(package-arguments guile-2.0)) + ((#:phases phases) + `(modify-phases ,phases + (add-after 'unpack 'autogen + (lambda _ + (zero? (system* "sh" "autogen.sh")))) + (add-before 'autogen 'patch-/bin/sh + (lambda _ + (substitute* "build-aux/git-version-gen" + (("#!/bin/sh") (string-append "#!" (which "sh")))) + #t)))))) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("libtool" ,libtool) + ("flex" ,flex) + ("texinfo" ,texinfo) + ("gettext" ,gnu-gettext) + ,@(package-native-inputs guile-2.0))))) + ;;; ;;; Extensions. @@ -189,25 +229,19 @@ without requiring the source code to be rewritten.") (define-public guile-reader (package (name "guile-reader") - (version "0.6") + (version "0.6.1") (source (origin (method url-fetch) (uri (string-append "mirror://savannah/guile-reader/guile-reader-" version ".tar.gz")) (sha256 (base32 - "1svlyk5pm4fsdp2g7n6qffdl6fdggxnlicj0jn9s4lxd63gzxy1n")))) + "020wz5w8z6g79nbqifg2n496wxwkcjzh8xizpv6mz0hczpl155ma")))) (build-system gnu-build-system) (native-inputs `(("pkgconfig" ,pkg-config) ("gperf" ,gperf))) (inputs `(("guile" ,guile-2.0))) - (arguments `(;; The extract-*.sh scripts really expect to run in the C - ;; locale. Failing to do that, we end up with a build - ;; failure while extracting doc. (Fixed in Guile-Reader's - ;; repo.) - #:locale "C" - - #:configure-flags + (arguments `(#:configure-flags (let ((out (assoc-ref %outputs "out"))) (list (string-append "--with-guilemoduledir=" out "/share/guile/site/2.0"))))) @@ -436,4 +470,69 @@ slightly from miniKanren mainline. See http://minikanren.org/ for more on miniKanren generally.") (license expat))) + +;; There are two guile-gdbm packages, one using the FFI and one with +;; direct C bindings, hence the verbose name. + +(define-public guile-gdbm-ffi + (package + (name "guile-gdbm-ffi") + (version "20120209.fa1d5b6") + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/ijp/guile-gdbm.git") + (commit "fa1d5b6231d0e4d096687b378c025f2148c5f246"))) + (sha256 + (base32 + "1j8wrsw7v9w6qkl47xz0rdikg50v16nn6kbs3lgzcymjzpa7babj")))) + (build-system trivial-build-system) + (arguments + `(#:modules + ((guix build utils)) + #:builder + (begin + (use-modules (guix build utils) + (system base compile)) + + (let* ((out (assoc-ref %outputs "out")) + (module-dir (string-append out "/share/guile/site/2.0")) + (source (assoc-ref %build-inputs "source")) + (doc (string-append out "/share/doc")) + (guild (string-append (assoc-ref %build-inputs "guile") + "/bin/guild")) + (gdbm.scm-dest + (string-append module-dir "/gdbm.scm")) + (gdbm.go-dest + (string-append module-dir "/gdbm.go"))) + ;; Make installation directories. + (mkdir-p module-dir) + (mkdir-p doc) + + ;; Switch directory for compiling and installing + (chdir source) + + ;; copy the source + (copy-file "gdbm.scm" gdbm.scm-dest) + + ;; Patch the FFI + (substitute* gdbm.scm-dest + (("\\(dynamic-link \"libgdbm\"\\)") + (format #f "(dynamic-link \"~a/lib/libgdbm.so\")" + (assoc-ref %build-inputs "gdbm")))) + + ;; compile to the destination + (compile-file gdbm.scm-dest + #:output-file gdbm.go-dest))))) + (inputs + `(("guile" ,guile-2.0))) + (propagated-inputs + `(("gdbm" ,gdbm))) + (home-page "https://github.com/ijp/guile-gdbm") + (synopsis "Guile bindings to the GDBM library via Guile's FFI") + (description + "Guile bindings to the GDBM key-value storage system, using +Guile's foreign function interface.") + (license gpl3+))) + ;;; guile.scm ends here diff --git a/gnu/packages/haskell.scm b/gnu/packages/haskell.scm index 3bb5e3074a..ac87de540e 100644 --- a/gnu/packages/haskell.scm +++ b/gnu/packages/haskell.scm @@ -373,14 +373,13 @@ access to the full zlib feature set.") (arguments `(#:tests? #f)) ; FIXME: currently missing libraries used for tests. (home-page "https://github.com/bos/text") - (synopsis - "Efficient packed Unicode text type library.") + (synopsis "Efficient packed Unicode text type library") (description "An efficient packed, immutable Unicode text type (both strict and lazy), with a powerful loop fusion optimization framework. The 'Text' type represents Unicode character strings, in a time and -space-efficient manner. This package provides text processing +space-efficient manner. This package provides text processing capabilities that are optimized for performance critical use, both in terms of large data quantities and high speed.") (license bsd-3))) @@ -870,7 +869,7 @@ package into this package.") (home-page "https://github.com/haskell/HTTP") (synopsis "Library for client-side HTTP") (description - "The HTTP package supports client-side web programming in Haskell. It + "The HTTP package supports client-side web programming in Haskell. It lets you set up HTTP connections, transmitting requests and processing the responses coming back.") (license bsd-3))) diff --git a/gnu/packages/ibus.scm b/gnu/packages/ibus.scm index 813d0040ee..1abe70a1ab 100644 --- a/gnu/packages/ibus.scm +++ b/gnu/packages/ibus.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -72,7 +73,6 @@ `(("dbus" ,dbus) ("dconf" ,dconf) ("gconf" ,gconf) - ("glib" ,glib) ("gtk2" ,gtk+-2) ("intltool" ,intltool) ("libnotify" ,libnotify) diff --git a/gnu/packages/icu4c.scm b/gnu/packages/icu4c.scm index a575e91c8c..a753a22b20 100644 --- a/gnu/packages/icu4c.scm +++ b/gnu/packages/icu4c.scm @@ -28,7 +28,7 @@ (define-public icu4c (package (name "icu4c") - (version "54.1") + (version "55.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 "1cwapgjmvrcv1n2wjspj3vahidg596gjfp4jn1gcb4baralcjayl")))) + (base32 "0ys5f5spizg45qlaa31j2lhgry0jka2gfha527n4ndfxxz5j4sz1")))) (build-system gnu-build-system) (inputs `(("perl" ,perl))) diff --git a/gnu/packages/image.scm b/gnu/packages/image.scm index c24ec99375..89590cc5ad 100644 --- a/gnu/packages/image.scm +++ b/gnu/packages/image.scm @@ -555,10 +555,10 @@ multi-dimensional image processing.") (synopsis "Lossless and lossy image compression") (description "WebP is a new image format that provides lossless and lossy compression -for images. WebP lossless images are 26% smaller in size compared to -PNGs. WebP lossy images are 25-34% smaller in size compared to JPEG images at -equivalent SSIM index. WebP supports lossless transparency (also known as -alpha channel) with just 22% additional bytes. Transparency is also supported +for images. WebP lossless images are 26% smaller in size compared to +PNGs. WebP lossy images are 25-34% smaller in size compared to JPEG images at +equivalent SSIM index. WebP supports lossless transparency (also known as +alpha channel) with just 22% additional bytes. Transparency is also supported with lossy compression and typically provides 3x smaller file sizes compared to PNG when lossy compression is acceptable for the red/green/blue color channels.") diff --git a/gnu/packages/imagemagick.scm b/gnu/packages/imagemagick.scm index ab663b5a41..b52237f992 100644 --- a/gnu/packages/imagemagick.scm +++ b/gnu/packages/imagemagick.scm @@ -37,14 +37,14 @@ (define-public imagemagick (package (name "imagemagick") - (version "6.9.0-4") + (version "6.9.1-3") (source (origin (method url-fetch) (uri (string-append "mirror://imagemagick/ImageMagick-" version ".tar.xz")) (sha256 (base32 - "0ms9lxrm3hvgghv8k7rj6kvk40xkc6lgr41xyaxz7lyf3l4ahslr")))) + "18wbsjfccxlgsdsd6h9wvhcjrsglyi086jk4bk029ik07rh81laz")))) (build-system gnu-build-system) (arguments `(#:phases (alist-cons-before diff --git a/gnu/packages/java.scm b/gnu/packages/java.scm index 26fc3eccf5..ea8de9e2cf 100644 --- a/gnu/packages/java.scm +++ b/gnu/packages/java.scm @@ -250,6 +250,11 @@ build process and its dependencies, whereas Make uses Makefile format.") ;; gremlin) doesn't support it yet, so skip this phase. #:validate-runpath? #f + #:modules ((guix build utils) + (guix build gnu-build-system) + (ice-9 popen) + (ice-9 rdelim)) + #:configure-flags (let* ((gcjdir (assoc-ref %build-inputs "gcj")) (ecj (string-append gcjdir "/share/java/ecj.jar")) @@ -378,9 +383,16 @@ build process and its dependencies, whereas Make uses Makefile format.") (lambda* (#:key inputs #:allow-other-keys) (let* ((gcjdir (assoc-ref %build-inputs "gcj")) (gcjlib (string-append gcjdir "/lib")) - (antpath (string-append (getcwd) "/../apache-ant-1.9.4"))) + (antpath (string-append (getcwd) "/../apache-ant-1.9.4")) + ;; Get target-specific include directory so that + ;; libgcj-config.h is found when compiling hotspot. + (gcjinclude (let* ((port (open-input-pipe "gcj -print-file-name=include")) + (str (read-line port))) + (close-pipe port) + str))) (setenv "CPATH" - (string-append (assoc-ref %build-inputs "libxrender") + (string-append gcjinclude ":" + (assoc-ref %build-inputs "libxrender") "/include/X11/extensions" ":" (assoc-ref %build-inputs "libxtst") "/include/X11/extensions" ":" diff --git a/gnu/packages/kde.scm b/gnu/packages/kde.scm index c6556865c2..1409e7c0b1 100644 --- a/gnu/packages/kde.scm +++ b/gnu/packages/kde.scm @@ -224,6 +224,6 @@ calculation of sha1 for every file crawled (arguments `(#:tests? #f)) ; no test target (home-page "http://www.kde.org/") - (synopsis "oxygen icon theme for the KDE desktop") + (synopsis "Oxygen icon theme for the KDE desktop") (description "KDE desktop environment") (license lgpl3+))) diff --git a/gnu/packages/libedit.scm b/gnu/packages/libedit.scm index fcf5ab4c74..1d7b5b6a5f 100644 --- a/gnu/packages/libedit.scm +++ b/gnu/packages/libedit.scm @@ -42,7 +42,7 @@ (synopsis "NetBSD Editline library") (description "This is an autotool- and libtoolized port of the NetBSD Editline -library (libedit). This Berkeley-style licensed command line editor library +library (libedit). This Berkeley-style licensed command line editor library provides generic line editing, history, and tokenization functions, similar to those found in GNU Readline.") (license bsd-3))) diff --git a/gnu/packages/libreoffice.scm b/gnu/packages/libreoffice.scm index cbe1c75eeb..4cd78f68cc 100644 --- a/gnu/packages/libreoffice.scm +++ b/gnu/packages/libreoffice.scm @@ -18,14 +18,51 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu packages libreoffice) - #:use-module (guix packages) - #:use-module (guix download) - #:use-module ((guix licenses) #:select (mpl2.0)) #:use-module (guix build-system gnu) + #:use-module (guix download) + #:use-module ((guix licenses) + #:select (gpl2+ lgpl2.1+ mpl1.1 mpl2.0 + non-copyleft x11-style)) + #:use-module (guix packages) + #:use-module (guix utils) + #:use-module (gnu packages autotools) + #:use-module (gnu packages base) + #:use-module (gnu packages bison) #:use-module (gnu packages boost) + #:use-module (gnu packages check) #:use-module (gnu packages compression) + #:use-module (gnu packages cups) + #:use-module (gnu packages curl) + #:use-module (gnu packages cyrus-sasl) + #:use-module (gnu packages databases) + #:use-module (gnu packages doxygen) + #:use-module (gnu packages flex) + #:use-module (gnu packages fontutils) + #:use-module (gnu packages ghostscript) + #:use-module (gnu packages gl) + #:use-module (gnu packages glib) + #:use-module (gnu packages gnome) + #:use-module (gnu packages gperf) + #:use-module (gnu packages gnuzilla) + #:use-module (gnu packages gstreamer) + #:use-module (gnu packages gtk) + #:use-module (gnu packages icu4c) + #:use-module (gnu packages image) + #:use-module (gnu packages java) + #:use-module (gnu packages linux) + #:use-module (gnu packages maths) + #:use-module (gnu packages openldap) + #:use-module (gnu packages openssl) + #:use-module (gnu packages pdf) + #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) - #:use-module (gnu packages python)) + #:use-module (gnu packages python) + #:use-module (gnu packages rdf) + #:use-module (gnu packages scanner) + #:use-module (gnu packages version-control) + #:use-module (gnu packages xml) + #:use-module (gnu packages xorg) + #:use-module (gnu packages zip)) (define-public ixion (package @@ -79,3 +116,711 @@ Microsoft Excel 2007 XML, Microsoft Excel 2003 XML, Open Document Spreadsheet, Plain Text, Gnumeric XML, Generic XML. It also includes low-level parsers for CSV, CSS and XML.") (license mpl2.0))) + +(define-public librevenge + (package + (name "librevenge") + (version "0.0.2") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/libwpd/" name "/" name "-" + version ".tar.xz")) + (sha256 (base32 + "03ygxyb0vfjv8raif5q62sl33b54wkr5rzgadb8slijm6k281wpn")))) + (build-system gnu-build-system) + (native-inputs + `(("boost" ,boost) + ("cppunit" ,cppunit) + ("doxygen" ,doxygen) + ("pkg-config" ,pkg-config))) + (inputs + `(("zlib" ,zlib))) + (arguments + ;; avoid triggering configure errors by simple inclusion of boost headers + `(#:configure-flags '("--disable-werror"))) + (home-page "http://sourceforge.net/p/libwpd/wiki/librevenge/") + (synopsis "Document importer for office suites") + (description "Librevenge is a base library for writing document import +filters. It has interfaces for text documents, vector graphics, +spreadsheets and presentations.") + (license (list mpl2.0 lgpl2.1+)))) ;dual licensed + +(define-public libwpd + (package + (name "libwpd") + (version "0.10.0") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/libwpd/" name "/" name "-" + version ".tar.xz")) + (sha256 (base32 + "0b6krzr6kxzm89g6bapn805kdayq70hn16n5b5wfs2lwrf0ag2wx")))) + (build-system gnu-build-system) + (native-inputs + `(("doxygen" ,doxygen) + ("pkg-config" ,pkg-config))) + (propagated-inputs + `(("librevenge" ,librevenge))) ; in Requires field of .pkg + (inputs + `(("zlib" ,zlib))) + (home-page "http://libwpd.sourceforge.net/") + (synopsis "Library for importing WordPerfect documents") + (description "Libwpd is a C++ library designed to help process +WordPerfect documents. It is most commonly used to import such documents +into other word processors.") + (license (list mpl2.0 lgpl2.1+)))) ;dual licensed + +(define-public libe-book + (package + (name "libe-book") + (version "0.1.2") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/libebook/libe-book-" + version "/libe-book-" version ".tar.xz")) + (sha256 + (base32 + "1v48pd32r2pfysr3a3igc4ivcf6vvb26jq4pdkcnq75p70alp2bz")))) + (build-system gnu-build-system) + (native-inputs + `(("cppunit" ,cppunit) + ("gperf" ,gperf) + ("pkg-config" ,pkg-config))) + (propagated-inputs ; in Requires or Requires.private field of .pkg + `(("icu4c" ,icu4c) + ("librevenge" ,librevenge) + ("libxml2" ,libxml2))) + (inputs + `(("boost" ,boost))) + (arguments + ;; avoid triggering configure errors by simple inclusion of boost headers + `(#:configure-flags '("--disable-werror"))) + (home-page "http://libebook.sourceforge.net") + (synopsis "Library for import of reflowable e-book formats") + (description "Libe-book is a library and a set of tools for reading and +converting various reflowable e-book formats. Currently supported are: +Broad Band eBook, eReader .pdb, FictionBook v. 2 (including zipped files), +PalmDoc Ebook, Plucker .pdb, QiOO (mobile format, for java-enabled +cellphones), TCR (simple compressed text format), TealDoc, zTXT, +ZVR (simple compressed text format).") + (license mpl2.0))) + +(define-public libwpg + (package + (name "libwpg") + (version "0.3.0") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/libwpg/" name "/" name "-" + version ".tar.xz")) + (sha256 (base32 + "097jx8a638fwwfrzf6v29r1yhc34rq9526py7wf0ck2z4fcr2w3g")))) + (build-system gnu-build-system) + (native-inputs + `(("doxygen" ,doxygen) + ("pkg-config" ,pkg-config))) + (propagated-inputs + `(("libwpd" ,libwpd))) ; in Requires field of .pkg + (inputs + `(("perl" ,perl) + ("zlib" ,zlib))) + (home-page "http://libwpg.sourceforge.net/") + (synopsis "Library and tools for the WordPerfect Graphics format") + (description "The libwpg project provides a library and tools for +working with graphics in the WPG (WordPerfect Graphics) format.") + (license (list mpl2.0 lgpl2.1+)))) ;dual licensed + +(define-public libcmis + (package + (name "libcmis") + (version "0.5.0") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/" name "/" name "-" + version ".tar.gz")) + (sha256 (base32 + "1dprvk4fibylv24l7gr49gfqbkfgmxynvgssvdcycgpf7n8h4zm8")))) + (build-system gnu-build-system) + (native-inputs + `(("cppunit" ,cppunit) + ("pkg-config" ,pkg-config))) + (propagated-inputs ; in Requires field of .pkg + `(("curl" ,curl) + ("libxml2" ,libxml2))) + (inputs + `(("boost" ,boost) + ("cyrus-sasl" ,cyrus-sasl) + ("openssl" ,openssl))) + (arguments + `(#:configure-flags + (list + ;; FIXME: Man pages generation requires docbook-to-man; reenable + ;; it once this is available. + "--without-man" + ;; avoid triggering configure errors by simple inclusion of + ;; boost headers + "--disable-werror" + ;; During configure, the boost headers are found, but linking + ;; fails without the following flag. + (string-append "--with-boost=" + (assoc-ref %build-inputs "boost"))))) + (home-page "http://sourceforge.net/projects/libcmis/") + (synopsis "CMIS client library") + (description "LibCMIS is a C++ client library for the CMIS interface. It +allows C++ applications to connect to any ECM behaving as a CMIS server such +as Alfresco or Nuxeo.") + (license (list mpl1.1 gpl2+ lgpl2.1+)))) ; triple license + +(define-public libabw + (package + (name "libabw") + (version "0.1.1") + (source + (origin + (method url-fetch) + (uri (string-append "http://dev-www.libreoffice.org/src/" name "/" + name "-" version ".tar.xz")) + (sha256 (base32 + "0zi1zj4fpxgpglbbb5n1kg3dmhqq5rpf46lli89r5daavp19iing")))) + (build-system gnu-build-system) + (native-inputs + `(("doxygen" ,doxygen) + ("gperf" ,gperf) + ("perl" ,perl) + ("pkg-config" ,pkg-config))) + (propagated-inputs ; in Requires or Requires.private field of .pkg + `(("librevenge" ,librevenge) + ("libxml2" ,libxml2))) + (inputs + `(("boost" ,boost))) + (arguments + ;; avoid triggering configure errors by simple inclusion of boost headers + `(#:configure-flags '("--disable-werror"))) + (home-page "https://wiki.documentfoundation.org/DLP/Libraries/libabw") + (synopsis "Library for parsing the AbiWord format") + (description "Libabw is a library that parses the file format of +AbiWord documents.") + (license mpl2.0))) + +(define-public libcdr + (package + (name "libcdr") + (version "0.1.1") + (source + (origin + (method url-fetch) + (uri (string-append "http://dev-www.libreoffice.org/src/" name "/" + name "-" version ".tar.xz")) + (sha256 (base32 + "07yzb1yr5kzv0binzj5swz3zzay2gw3xb0fbkc2zwdssgrkf19nh")))) + (build-system gnu-build-system) + (native-inputs + `(("doxygen" ,doxygen) + ("pkg-config" ,pkg-config))) + (propagated-inputs ; in Requires or Requires.private field of .pkg + `(("icu4c" ,icu4c) + ("lcms" ,lcms) + ("librevenge" ,librevenge) + ("zlib" ,zlib))) + (inputs + `(("boost" ,boost))) + (arguments + ;; avoid triggering a build failure due to warnings + `(#:configure-flags '("--disable-werror"))) + (home-page "https://wiki.documentfoundation.org/DLP/Libraries/libcdr") + (synopsis "Library for parsing the CorelDRAW format") + (description "Libcdr is a library that parses the file format of +CorelDRAW documents of all versions.") + (license mpl2.0))) + +(define-public libetonyek + (package + (name "libetonyek") + (version "0.1.1") + (source + (origin + (method url-fetch) + (uri (string-append "http://dev-www.libreoffice.org/src/" name "/" + name "-" version ".tar.xz")) + (sha256 (base32 + "0gn8v24jb9r9kxppbws6xlc7knpd9mk2n9xjvziccv5f2l7mlslw")))) + (build-system gnu-build-system) + (native-inputs + `(("cppunit" ,cppunit) + ("doxygen" ,doxygen) + ("gperf" ,gperf) + ("pkg-config" ,pkg-config))) + (propagated-inputs ; in Requires or Requires.private field of .pkg + `(("librevenge" ,librevenge) + ("libxml2" ,libxml2))) + (inputs + `(("boost" ,boost))) + (home-page "https://wiki.documentfoundation.org/DLP/Libraries/libetonyek") + (synopsis "Library for parsing the Apple Keynote format") + (description "Libetonyek is a library that parses the file format of +Apple Keynote documents. It currently supports Keynote versions 2 to 5.") + (license mpl2.0))) + +(define-public libexttextcat + (package + (name "libexttextcat") + (version "3.4.4") + (source + (origin + (method url-fetch) + (uri (string-append "http://dev-www.libreoffice.org/src/" name "/" + name "-" version ".tar.xz")) + (sha256 (base32 + "14v2hkygnmf1zgahfm1fha47cr67iikrz2ymiqi28d2jydn0hk7j")))) + (build-system gnu-build-system) + (home-page "http://www.freedesktop.org/wiki/Software/libexttextcat/") + (synopsis "Text Categorization library") + (description "Libexttextcat is an N-Gram-Based Text Categorization +library primarily intended for language guessing.") + (license (non-copyleft "file://LICENSE" + "See LICENSE in the distribution.")))) + +(define-public libfreehand + (package + (name "libfreehand") + (version "0.1.0") + (source + (origin + (method url-fetch) + (uri (string-append "http://dev-www.libreoffice.org/src/" name "/" + name "-" version ".tar.xz")) + (sha256 (base32 + "01j7mxi4lmf72w1mv2r098p8l0csdd94w2gq0ncp93djn34al6ai")))) + (build-system gnu-build-system) + (native-inputs + `(("doxygen" ,doxygen) + ("gperf" ,gperf) + ("perl" ,perl) + ("pkg-config" ,pkg-config))) + (propagated-inputs ; in Requires or Requires.private field of .pkg + `(("librevenge" ,librevenge) + ("zlib" ,zlib))) + (home-page "https://wiki.documentfoundation.org/DLP/Libraries/libfreehand") + (synopsis "Library for parsing the FreeHand format") + (description "Libfreehand is a library that parses the file format of +Aldus/Macromedia/Adobe FreeHand documents.") + (license mpl2.0))) + +(define-public libmspub + (package + (name "libmspub") + (version "0.1.2") + (source + (origin + (method url-fetch) + (uri (string-append "http://dev-www.libreoffice.org/src/" name "/" + name "-" version ".tar.xz")) + (sha256 (base32 + "03sn6lxpr49sdq6j8q7fw7yjybyfahhs03z80388mh105pwapfmh")))) + (build-system gnu-build-system) + (native-inputs + `(("doxygen" ,doxygen) + ("pkg-config" ,pkg-config))) + (propagated-inputs ; in Requires or Requires.private field of .pkg + `(("icu4c" ,icu4c) + ("librevenge" ,librevenge) + ("zlib" ,zlib))) + (inputs + `(("boost" ,boost))) + (home-page "https://wiki.documentfoundation.org/DLP/Libraries/libmspub") + (synopsis "Library for parsing the Microsoft Publisher format") + (description "Libmspub is a library that parses the file format of +Microsoft Publisher documents of all versions.") + (license mpl2.0))) + +(define-public libpagemaker + (package + (name "libpagemaker") + (version "0.0.2") + (source + (origin + (method url-fetch) + (uri (string-append "http://dev-www.libreoffice.org/src/" name "/" + name "-" version ".tar.xz")) + (sha256 (base32 + "05zgj5ngg9z4b7dnrfs59nm0macm99lzyxv4mg53jcvp0mkgigfd")))) + (build-system gnu-build-system) + (native-inputs + `(("doxygen" ,doxygen) + ("pkg-config" ,pkg-config))) + (propagated-inputs ; in Requires field of .pkg + `(("librevenge" ,librevenge))) + (inputs + `(("boost" ,boost) + ("zlib" ,zlib))) + (arguments + ;; avoid triggering a build failure due to warnings + `(#:configure-flags '("--disable-werror"))) + (home-page "https://wiki.documentfoundation.org/DLP/Libraries/libpagemaker") + (synopsis "Library for parsing the PageMaker format") + (description "Libpagemaker is a library that parses the file format of +Aldus/Adobe PageMaker documents. Currently it only understands documents +created by PageMaker version 6.x and 7.") + (license mpl2.0))) + +(define-public libvisio + (package + (name "libvisio") + ;; FIXME: The newer version 0.1.1 fails its tests. + (version "0.1.0") + (source + (origin + (method url-fetch) + (uri (string-append "http://dev-www.libreoffice.org/src/" name "/" + name "-" version ".tar.xz")) + (sha256 (base32 + "0vvd2wyp4rw6s9xnj1dc9vgdpfvm45gnb5b9hhzif0fdnx4iskqf")))) + (build-system gnu-build-system) + (native-inputs + `(("cppunit" ,cppunit) + ("doxygen" ,doxygen) + ("gperf" ,gperf) + ("perl" ,perl) + ("pkg-config" ,pkg-config))) + (propagated-inputs ; in Requires or Requires.private field of .pkg + `(("icu4c" ,icu4c) + ("librevenge" ,librevenge) + ("libxml2" ,libxml2))) + (inputs + `(("boost" ,boost))) + ;; FIXME: Not needed any more for newer version 0.1.1. + (arguments + ;; avoid triggering a build failure due to warnings + `(#:configure-flags '("--disable-werror"))) + (home-page "https://wiki.documentfoundation.org/DLP/Libraries/libvisio") + (synopsis "Library for parsing the Microsoft Visio format") + (description "Libvisio is a library that parses the file format of +Microsoft Visio documents of all versions.") + (license mpl2.0))) + +(define-public libodfgen + (package + (name "libodfgen") + (version "0.1.3") + (source + (origin + (method url-fetch) + (uri (string-append "http://dev-www.libreoffice.org/src/" + name "-" version ".tar.bz2")) + (sha256 (base32 + "074qsav86ixwi9zm1f77g9vxdf1ihm6n930vxjg8q3lwzd8g7lb6")))) + (build-system gnu-build-system) + (native-inputs + `(("doxygen" ,doxygen) + ("pkg-config" ,pkg-config))) + (propagated-inputs ; in Requires field of .pkg + `(("librevenge" ,librevenge))) + (inputs + `(("boost" ,boost) + ("zlib" ,zlib))) + (arguments + ;; avoid triggering configure errors by simple inclusion of boost headers + `(#:configure-flags '("--disable-werror"))) + (home-page "http://sourceforge.net/p/libwpd/wiki/libodfgen/") + (synopsis "ODF (Open Document Format) library") + (description "Libodfgen is a library for generating documents in the +Open Document Format (ODF). It provides generator implementations for all +document interfaces supported by librevenge: +text documents, vector drawings, presentations and spreadsheets.") + (license (list mpl2.0 lgpl2.1+)))) ; dual license + +(define-public libmwaw + (package + (name "libmwaw") + (version "0.3.4") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/" name "/" name "/" + name "-" version ".tar.xz")) + (sha256 (base32 + "1sn95flxrh85qjsg1kk700c1ggxaaccr9j1nnw7x4daw8lky25ac")))) + (build-system gnu-build-system) + (native-inputs + `(("doxygen" ,doxygen) + ("pkg-config" ,pkg-config))) + (propagated-inputs ; in Requires field of .pkg + `(("librevenge" ,librevenge))) + (inputs + `(("boost" ,boost) + ("zlib" ,zlib))) + (arguments + ;; avoid triggering configure errors by simple inclusion of boost headers + `(#:configure-flags '("--disable-werror"))) + (home-page "http://sourceforge.net/p/libmwaw/wiki/Home/") + (synopsis "Import library for some old Macintosh text documents") + (description "Libmwaw contains some import filters for old Macintosh +text documents (MacWrite, ClarisWorks, ... ) and for some graphics and +spreadsheet documents.") + (license (list mpl2.0 lgpl2.1+)))) ; dual license + +(define-public libwps + (package + (name "libwps") + (version "0.3.1") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/" name "/" name "/" + name "-" version ".tar.xz")) + (sha256 (base32 + "14wfhw1ahavhx4hrdzc4hdwxjlffrm939kswf2x1250jnmyjlb5v")))) + (build-system gnu-build-system) + (native-inputs + `(("doxygen" ,doxygen) + ("pkg-config" ,pkg-config))) + (propagated-inputs ; in Requires field of .pkg + `(("librevenge" ,librevenge))) + (inputs + `(("boost" ,boost) + ("zlib" ,zlib))) + (arguments + ;; avoid triggering configure errors by simple inclusion of boost headers + `(#:configure-flags '("--disable-werror"))) + (home-page "http://libwps.sourceforge.net/") + (synopsis "Import library for Microsoft Works text documents") + (description "Libwps is a library for importing files in the Microsoft +Works word processor file format.") + (license (list mpl2.0 lgpl2.1+)))) ; dual license + +(define-public hunspell + (package + (name "hunspell") + (version "1.3.3") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/" name "/" + name "-" version ".tar.gz")) + (sha256 (base32 + "0v14ff9s37vkh45diaddndcrj0hmn67arh8xh8k79q9c1vgc1cm7")))) + (build-system gnu-build-system) + (home-page "http://hunspell.sourceforge.net/") + (synopsis "Spell checker") + (description "Hunspell is a spell checker and morphological analyzer +library and program designed for languages with rich morphology and complex +word compounding or character encoding.") + ;; triple license, including "mpl1.1 or later" + (license (list mpl1.1 gpl2+ lgpl2.1+)))) + +(define-public hyphen + (package + (name "hyphen") + (version "2.8.8") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/hunspell/" + name "-" version ".tar.gz")) + (sha256 (base32 + "01ap9pr6zzzbp4ky0vy7i1983fwyqy27pl0ld55s30fdxka3ciih")))) + (build-system gnu-build-system) + (inputs + `(("perl" ,perl))) + (home-page "http://hunspell.sourceforge.net/") + (synopsis "Hyphenation library") + (description "Hyphen is a hyphenation library using TeX hyphenation +patterns, which are pre-processed by a perl script.") + ;; triple license, including "mpl1.1 or later" + (license (list mpl1.1 mpl2.0 gpl2+ lgpl2.1+)))) + +(define-public mythes + (package + (name "mythes") + (version "1.2.4") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/hunspell/" + name "-" version ".tar.gz")) + (sha256 (base32 + "0prh19wy1c74kmzkkavm9qslk99gz8h8wmjvwzjc6lf8v2az708y")))) + (build-system gnu-build-system) + (native-inputs + `(("pkg-config" ,pkg-config))) + (inputs + `(("hunspell" ,hunspell) + ("perl" ,perl))) + (home-page "http://hunspell.sourceforge.net/") + (synopsis "Thesaurus") + (description "MyThes is a simple thesaurus that uses a structured text +data file and an index file with binary search to look up words and phrases +and to return information on pronunciations, meaningss and synonyms.") + (license (non-copyleft "file://COPYING" + "See COPYING in the distribution.")))) + +;; LibreOffice requires an xmlsec source tarball; it does not even check +;; for the presence of an externally compiled library. +(define xmlsec-src-libreoffice + (origin + (method url-fetch) + (uri + (string-append + "http://dev-www.libreoffice.org/src/" + "1f24ab1d39f4a51faf22244c94a6203f-xmlsec1-1.2.14.tar.gz")) + (sha256 (base32 + "0jnxxygg6z5zi6za94dvxmg1bfar1wh8p5xa2bzbha0qcn2m02ir")))) + +(define-public libreoffice + (package + (name "libreoffice") + (version "4.4.3.2") + (source + (origin + (method url-fetch) + (uri + (string-append + "http://download.documentfoundation.org/libreoffice/src/" + (version-prefix version 3) "/libreoffice-" version ".tar.xz")) + (sha256 (base32 + "0rl9x01ngxwnqwzxkrqy4vks4rb024m75z0w4zidwyp0az0m8qdd")))) + (build-system gnu-build-system) + (native-inputs + `(;; autoreconf is run by the LibreOffice build system, since after + ;; unpacking the external xmlsec tarball, it applies a series of + ;; patches to Makefile.am, configure.in, config.guess and config.sub. + ("autoconf" ,autoconf) + ("automake" ,automake) + ("bison" ,bison) + ("cppunit" ,cppunit) + ("flex" ,flex) + ("pkg-config" ,pkg-config) + ("python" ,python) + ("which" ,which))) + (inputs + `(("bluez" ,bluez) + ("boost" ,boost) + ("clucene" ,clucene) + ("cups" ,cups) + ("dbus-glib" ,dbus-glib) + ("fontconfig" ,fontconfig) + ("gconf" ,gconf) + ("glew" ,glew) + ("glm" ,glm) + ("gperf" ,gperf) + ("graphite2" ,graphite2) + ("gst-plugins-base" ,gst-plugins-base) + ("gtk+" ,gtk+-2) + ("harfbuzz" ,harfbuzz) + ("hunspell" ,hunspell) + ("hyphen" ,hyphen) + ("libabw" ,libabw) + ("libcdr" ,libcdr) + ("libcmis" ,libcmis) + ("libjpeg" ,libjpeg) + ("libe-book" ,libe-book) + ("libetonyek" ,libetonyek) + ("libexttextcat" ,libexttextcat) + ("libfreehand" ,libfreehand) + ("libmspub" ,libmspub) + ("libmwaw" ,libmwaw) + ("libodfgen" ,libodfgen) + ("libpagemaker" ,libpagemaker) + ("libvisio" ,libvisio) + ("libwpg" ,libwpg) + ("libwps" ,libwps) + ("libxrandr" ,libxrandr) + ("libxrender" ,libxrender) + ("libxslt" ,libxslt) + ("libxt" ,libxt) + ("lpsolve" ,lpsolve) + ("mdds" ,mdds) + ("mythes" ,mythes) + ("neon" ,neon) + ("nspr" ,nspr) + ("nss" ,nss) + ("openldap" ,openldap) + ("openssl" ,openssl) + ("orcus" ,orcus) + ("perl" ,perl) + ("perl-zip" ,perl-zip) + ("poppler" ,poppler) + ("postgresql" ,postgresql) + ("python" ,python) + ("redland" ,redland) + ("sane-backends" ,sane-backends) + ("unixodbc" ,unixodbc) + ("unzip" ,unzip) + ("vigra" ,vigra) + ("xmlsec-src" ,xmlsec-src-libreoffice) + ("zip" ,zip))) + (arguments + `(#:parallel-build? #f ; Otherwise the build fails. + #:tests? #f ; Building the tests already fails. + #:make-flags '("build-nocheck") ; Do not build unit tests, which fails. + #:phases + (modify-phases %standard-phases + (add-before 'configure 'prepare-src + (lambda* (#:key inputs #:allow-other-keys) + (let ((xmlsec (assoc-ref inputs "xmlsec-src"))) + (substitute* + (list "sysui/CustomTarget_share.mk" + "solenv/gbuild/gbuild.mk" + "solenv/gbuild/platform/unxgcc.mk" + "external/libxmlsec/xmlsec1-oldlibtool.patch") + (("/bin/sh") (which "bash"))) + (mkdir "external/tarballs") + (symlink + xmlsec + (string-append "external/tarballs/" + "1f24ab1d39f4a51faf22244c94a6203f-" + "xmlsec1-1.2.14.tar.gz")) + ;; The following is required for building xmlsec from the + ;; unpatched external tarball; since "configure" starts with + ;; "/bin/sh", it needs to be executed by a command invoking + ;; the shell. + (setenv "SHELL" (which "bash")) + (setenv "CONFIG_SHELL" (which "bash")) + (substitute* "external/libxmlsec/ExternalProject_xmlsec.mk" + (("./configure") "$(CONFIG_SHELL) ./configure" )) + #t))) + (add-after 'install 'bin-install + ;; Create a symlink bin/soffice to the executable script. + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin"))) + (mkdir bin) + (symlink + (string-append out "/lib/libreoffice/program/soffice") + (string-append bin "/soffice"))) + #t))) + #:configure-flags + (list + "--enable-release-build" + "--enable-verbose" + "--without-parallelism" ; otherwise the build fails + "--disable-fetch-external" ; disable downloads + "--with-system-libs" ; enable all --with-system-* flags + (string-append "--with-boost-libdir=" + (assoc-ref %build-inputs "boost") "/lib") + ;; Avoid a dependency on ucpp. + "--with-idlc-cpp=cpp" + ;; The fonts require an external tarball (crosextrafonts). + ;; They should not be needed when system fonts are available. + "--without-fonts" + ;; With java, the build fails since sac.jar is missing. + "--without-java" + ;; FIXME: Enable once the corresponding inputs are packaged. + "--without-system-npapi-headers" + "--disable-coinmp" + "--disable-firebird-sdbc" ; embedded firebird + "--disable-gltf" + "--disable-liblangtag"))) + (home-page "https://www.libreoffice.org/") + (synopsis "Office suite") + (description "LibreOffice is a comprehensive office suite. It contains +a number of components: Writer, a word processor; Calc, a spreadsheet +application; Impress, a presentation engine; Draw, a drawing and +flowcharting application; Base, a database and database frontend; +Math for editing mathematics.") + (license mpl2.0))) diff --git a/gnu/packages/libusb.scm b/gnu/packages/libusb.scm index 62eb753d24..dd8a2ff23b 100644 --- a/gnu/packages/libusb.scm +++ b/gnu/packages/libusb.scm @@ -24,12 +24,13 @@ #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module (gnu packages gnupg) + #:use-module (gnu packages linux) #:use-module (gnu packages pkg-config)) (define-public libusb (package (name "libusb") - (version "1.0.9") + (version "1.0.19") (source (origin (method url-fetch) @@ -37,8 +38,14 @@ "libusb-" version "/libusb-" version ".tar.bz2")) (sha256 (base32 - "16sz34ix6hw2wwl3kqx6rf26fg210iryr68wc439dc065pffw879")))) + "0h38p9rxfpg9vkrbyb120i1diq57qcln82h5fr7hvy82c20jql3c")))) (build-system gnu-build-system) + + ;; XXX: Enabling udev is now recommended, but eudev indirectly depends on + ;; libusb. + (arguments `(#:configure-flags '("--disable-udev"))) + ;; (inputs `(("eudev" ,eudev))) + (home-page "http://www.libusb.org") (synopsis "User-space USB library") (description diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 262c5bdb34..1b220c4e32 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr> +;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> @@ -55,6 +55,8 @@ #:use-module (gnu packages gtk) #:use-module (gnu packages docbook) #:use-module (gnu packages asciidoc) + #:use-module (gnu packages readline) + #:use-module (gnu packages calendar) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix utils) @@ -208,7 +210,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM." #f))) (define-public linux-libre - (let* ((version "4.0") + (let* ((version "4.0.5") (build-phase '(lambda* (#:key system inputs #:allow-other-keys #:rest args) ;; Apply the neat patch. @@ -281,9 +283,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM." (uri (linux-libre-urls version)) (sha256 (base32 - "12nkzn1n4si2zcp10b645qri83m2y7iwp29vs2rjmy612azdab8f")) - (patches - (list (search-patch "linux-libre-libreboot-fix.patch"))))) + "0g8a4h8gjw51pp02hjfrp6bk2nkrclm3krp9mpjh3iwbf4vfh2al")))) (build-system gnu-build-system) (native-inputs `(("perl" ,perl) ("bc" ,bc) @@ -318,7 +318,7 @@ It has been modified to remove all non-free binary blobs.") (license gpl2) (home-page "http://www.gnu.org/software/linux-libre/")))) - + ;;; ;;; Pluggable authentication modules (PAM). ;;; @@ -364,7 +364,7 @@ be used through the PAM API to perform tasks, like authenticating a user at login. Local and dynamic reconfiguration are its key features") (license bsd-3))) - + ;;; ;;; Miscellaneous. ;;; @@ -587,8 +587,21 @@ slabtop, and skill.") (string-append "#!" (which "sh"))))) (alist-cons-after 'install 'install-libs - (lambda _ - (zero? (system* "make" "install-libs"))) + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (lib (string-append out "/lib"))) + (and (zero? (system* "make" "install-libs")) + + ;; Make the .a writable so that 'strip' works. + ;; Failing to do that, due to debug symbols, we + ;; retain a reference to the final + ;; linux-libre-headers, which refer to the + ;; bootstrap binaries. + (let ((archives (find-files lib "\\.a$"))) + (for-each (lambda (file) + (chmod file #o666)) + archives) + #t)))) %standard-phases)) ;; FIXME: Tests work by comparing the stdout/stderr of programs, that @@ -1041,6 +1054,17 @@ Linux-based operating systems.") '(#:phases (alist-cons-after 'unpack 'bootstrap (lambda _ + ;; Fix "field ‘ip6’ has incomplete type" errors. + (substitute* "libbridge/libbridge.h" + (("#include <linux/if_bridge.h>") + "#include <linux/in6.h>\n#include <linux/if_bridge.h>")) + + ;; Ensure that the entire build fails if one of the + ;; sub-Makefiles fails. + (substitute* "Makefile.in" + (("\\$\\(MAKE\\) \\$\\(MFLAGS\\) -C \\$\\$x ;") + "$(MAKE) $(MFLAGS) -C $$x || exit 1;")) + (zero? (system* "autoreconf" "-vf"))) %standard-phases) #:tests? #f)) ; no 'check' target @@ -1198,7 +1222,8 @@ processes currently causing I/O.") version ".tar.gz")) (sha256 (base32 - "071r6xjgssy8vwdn6m28qq1bqxsd2bphcd2mzhq0grf5ybm87sqb")))) + "071r6xjgssy8vwdn6m28qq1bqxsd2bphcd2mzhq0grf5ybm87sqb")) + (patches (list (search-patch "fuse-CVE-2015-3202.patch"))))) (build-system gnu-build-system) (inputs `(("util-linux" ,util-linux))) (arguments @@ -1567,7 +1592,7 @@ from the module-init-tools project.") ;; Work around undefined reference to ;; 'mq_getattr' in sc-daemon.c. "LDFLAGS=-lrt") - #:phases + #:phases (alist-cons-before 'build 'pre-build ;; The program 'g-ir-scanner' (part of the package @@ -2171,3 +2196,40 @@ arrays when needed.") system calls, important for the performance of databases and other advanced applications.") (license lgpl2.1+))) + +(define-public bluez + (package + (name "bluez") + (version "5.30") + (source (origin + (method url-fetch) + (uri (string-append + "https://www.kernel.org/pub/linux/bluetooth/bluez-" + version ".tar.xz")) + (sha256 + (base32 + "0b1qbnq1xzcdw5rajg9yyg31bf21jnff0n6gnf1snz89bbdllfhy")))) + (build-system gnu-build-system) + (arguments + '(#:configure-flags + (let ((out (assoc-ref %outputs "out"))) + (list "--enable-library" + "--disable-systemd" + ;; Install dbus/udev files to the correct location. + (string-append "--with-dbusconfdir=" out "/etc") + (string-append "--with-udevdir=" out "/lib/udev"))))) + (native-inputs + `(("pkg-config" ,pkg-config) + ("gettext" ,gnu-gettext))) + (inputs + `(("glib" ,glib) + ("dbus" ,dbus) + ("eudev" ,eudev) + ("libical" ,libical) + ("readline" ,readline))) + (home-page "http://www.bluez.org/") + (synopsis "Linux Bluetooth protocol stack") + (description + "BlueZ provides support for the core Bluetooth layers and protocols. It +is flexible, efficient and uses a modular implementation.") + (license gpl2+))) diff --git a/gnu/packages/m4.scm b/gnu/packages/m4.scm index b3b3a00fde..d1ba928768 100644 --- a/gnu/packages/m4.scm +++ b/gnu/packages/m4.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,11 +36,10 @@ "0w0da1chh12mczxa5lnwzjk9czi3dq6gnnndbpa6w4rj76b1yklf")))) (build-system gnu-build-system) (arguments - ;; XXX: Disable tests on those platforms with know issues. - `(#:tests? ,(not (member (%current-system) - '("x86_64-darwin" - "i686-cygwin" - "i686-sunos"))) + `(;; Explicitly disable tests when cross-compiling, otherwise 'make check' + ;; proceeds and fails, unsurprisingly. + #:tests? ,(not (%current-target-system)) + #:phases (alist-cons-before 'check 'pre-check (lambda* (#:key inputs #:allow-other-keys) diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index 170fbe4921..70b0b0298d 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com> ;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org> ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org> +;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -66,7 +67,8 @@ #:use-module (gnu packages xml) #:use-module (gnu packages xorg) #:use-module ((guix licenses) - #:select (gpl2 gpl2+ gpl3+ lgpl2.1+ lgpl3+ non-copyleft)) + #:select (gpl2 gpl2+ gpl3+ lgpl2.1 lgpl2.1+ lgpl3+ non-copyleft + (expat . license:expat))) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix utils) @@ -492,7 +494,6 @@ MailCore 2.") (inputs `(("bogofilter" ,bogofilter) ("curl" ,curl) ("dbus-glib" ,dbus-glib) - ("dbus" ,dbus) ("enchant" ,enchant) ("expat" ,expat) ("ghostscript" ,ghostscript) @@ -639,6 +640,49 @@ deal of flexibility in the way mail can be routed, and there are extensive facilities for checking incoming mail.") (license gpl2+))) +(define-public dovecot + (package + (name "dovecot") + (version "2.2.16") + (source + (origin + (method url-fetch) + (uri (string-append "http://www.dovecot.org/releases/" + (version-major+minor version) "/" + name "-" version ".tar.gz")) + (sha256 (base32 + "1w6gg4h9mxg3i8faqpmgj19imzyy001b0v8ihch8ma3zl63i5kjn")))) + (build-system gnu-build-system) + (native-inputs + `(("pkg-config" ,pkg-config))) + (inputs + `(("openssl" ,openssl) + ("zlib" ,zlib) + ("bzip2" ,bzip2) + ("sqlite" ,sqlite))) + (arguments + `(#:configure-flags '("--sysconfdir=/etc" + "--localstatedir=/var") + #:phases (modify-phases %standard-phases + (add-before + 'configure 'pre-configure + (lambda _ + ;; Simple hack to avoid installing in /etc + (substitute* '("doc/Makefile.in" + "doc/example-config/Makefile.in") + (("pkgsysconfdir = .*") + "pkgsysconfdir = /tmp/etc")) + #t))))) + (home-page "http://www.dovecot.org") + (synopsis "Secure POP3/IMAP server") + (description + "Dovecot is a mail server whose major goals are security and reliability. +It supports mbox/Maildir and its own dbox/mdbox formats.") + ;; Most source files are covered by either lgpl2.1 or expat. The SHA code + ;; is covered by a variant of BSD-3, and UnicodeData.txt is covered by the + ;; Unicode, Inc. License Agreement for Data Files and Software. + (license (list lgpl2.1 license:expat (non-copyleft "file://COPYING"))))) + (define-public isync (package (name "isync") diff --git a/gnu/packages/man.scm b/gnu/packages/man.scm index a92c6dd132..fb43db9de9 100644 --- a/gnu/packages/man.scm +++ b/gnu/packages/man.scm @@ -153,7 +153,7 @@ Linux kernel and C library interfaces employed by user-space programs.") (define-public help2man (package (name "help2man") - (version "1.46.5") + (version "1.46.6") (source (origin (method url-fetch) @@ -161,7 +161,7 @@ Linux kernel and C library interfaces employed by user-space programs.") version ".tar.xz")) (sha256 (base32 - "1gqfqgxq3qgwnldjz3i5mxvzyx2w3j042r3fw1wygic3f6327nha")))) + "1brccgnjf09f2zg70s6gv6gn68mi59kp3zf50wvxp79n72ngapv1")))) (build-system gnu-build-system) (arguments `(;; There's no `check' target. #:tests? #f)) diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index 417af4a91b..4d837c85e2 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2014 Mathieu Lirzin <mathieu.lirzin@openmailbox.org> ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> +;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -68,6 +69,7 @@ #:use-module (gnu packages tcl) #:use-module (gnu packages texinfo) #:use-module (gnu packages texlive) + #:use-module (gnu packages wxwidgets) #:use-module (gnu packages xml) #:use-module (gnu packages zip)) @@ -382,6 +384,9 @@ extremely large and complex data collections.") `(("lapack" ,lapack) ("readline" ,readline) ("glpk" ,glpk) + ("fftw" ,fftw) + ("fftwf" ,fftwf) + ("arpack" ,arpack-ng) ("curl" ,curl) ("pcre" ,pcre) ("fltk" ,fltk) @@ -390,16 +395,18 @@ extremely large and complex data collections.") ("hdf5" ,hdf5) ("libxft" ,libxft) ("mesa" ,mesa) + ("glu" ,glu) ("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 + ;; 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) @@ -411,11 +418,11 @@ extremely large and complex data collections.") "/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.") + (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+))) (define-public gmsh @@ -917,7 +924,7 @@ to BMP, JPEG or PNG image formats.") (define-public maxima (package (name "maxima") - (version "5.34.1") + (version "5.36.1") (source (origin (method url-fetch) @@ -925,7 +932,8 @@ to BMP, JPEG or PNG image formats.") version "-source/" name "-" version ".tar.gz")) (sha256 (base32 - "1dw9vfzldpj7lv303xbw0wpyn6ra6i2yzwlrjbcx7j0jm5n43ji0")))) + "0x1rk659sn3cq0n5c90848ilzr1gb1wf0072fl6jhkdq00qgh2s0")) + (patches (list (search-patch "maxima-defsystem-mkdir.patch"))))) (build-system gnu-build-system) (inputs `(("gcl" ,gcl) @@ -946,8 +954,8 @@ to BMP, JPEG or PNG image formats.") (let ((v ,(package-version tk))) (string-take v (string-index-right v #\.))))) ;; By default Maxima attempts to write temporary files to - ;; '/tmp/nix-build-maxima-5.34.1', which doesn't exist. Work around - ;; that. + ;; '/tmp/nix-build-maxima-*', which won't exist at run time. + ;; Work around that. #:make-flags (list "TMPDIR=/tmp") #:phases (alist-cons-before 'check 'pre-check @@ -992,6 +1000,49 @@ point numbers") ;; GPLv2 only is therefore the smallest subset. (license license:gpl2))) +(define-public wxmaxima + (package + (name "wxmaxima") + (version "15.04.0") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/wxmaxima/wxMaxima/" + version "/" name "-" version ".tar.gz")) + (sha256 + (base32 + "1fm47ah4aw5qdjqhkz67w5fwhy8yfffa5z896crp0d3hk2bh4180")))) + (build-system gnu-build-system) + (inputs + `(("wxwidgets" ,wxwidgets) + ("maxima" ,maxima))) + (arguments + `(#:phases (modify-phases %standard-phases + (add-after + 'install 'wrap-program + (lambda* (#:key inputs outputs #:allow-other-keys) + (wrap-program (string-append (assoc-ref outputs "out") + "/bin/wxmaxima") + `("PATH" ":" prefix + (,(string-append (assoc-ref inputs "maxima") + "/bin")))) + #t))))) + (home-page "https://andrejv.github.io/wxmaxima/") + (synopsis "Graphical user interface for the Maxima computer algebra system") + (description + "wxMaxima is a graphical user interface for the Maxima computer algebra +system. It eases the use of Maxima by making most of its commands available +through a menu system and by providing input dialogs for commands that require +more than one argument. It also implements its own display engine that +outputs mathematical symbols directly instead of depicting them with ASCII +characters. + +wxMaxima also features 2D and 3D inline plots, simple animations, mixing of +text and mathematical calculations to create documents, exporting of input and +output to TeX, and a browser for Maxima's manual including command index and +full text searching.") + (license license:gpl2+))) + (define-public muparser (package (name "muparser") @@ -1020,7 +1071,7 @@ constant parts of it.") (define-public openblas (package (name "openblas") - (version "0.2.13") + (version "0.2.14") (source (origin (method url-fetch) @@ -1029,10 +1080,14 @@ constant parts of it.") (file-name (string-append name "-" version ".tar.gz")) (sha256 (base32 - "1asg5mix13ipxgj5h2yj2p0r8km1di5jbcjkn5gmhb37nx7qfv6k")))) + "0av3pd96j8rx5i65f652xv9wqfkaqn0w4ma1gvbyz73i6j2hi9db")))) (build-system gnu-build-system) (arguments - '(#:tests? #f ;no "check" target + `(#:tests? #f ;no "check" target + ;; DYNAMIC_ARCH is not supported on MIPS. When it is disabled, + ;; OpenBLAS will tune itself to the build host, so we need to disable + ;; substitutions. + #:substitutable? ,(not (string-prefix? "mips" (%current-system))) #:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")) "SHELL=bash" @@ -1040,7 +1095,10 @@ constant parts of it.") ;; Build the library for all supported CPUs. This allows ;; switching CPU targets at runtime with the environment variable ;; OPENBLAS_CORETYPE=<type>, where "type" is a supported CPU type. - "DYNAMIC_ARCH=1") + ;; Unfortunately, this is not supported on MIPS. + ,@(if (string-prefix? "mips" (%current-system)) + '() + '("DYNAMIC_ARCH=1"))) ;; no configure script #:phases (alist-delete 'configure %standard-phases))) (inputs @@ -1333,3 +1391,72 @@ library with poor performance.") library for graphics software based on the OpenGL Shading Language (GLSL) specifications.") (license license:expat))) + +(define-public lpsolve + (package + (name "lpsolve") + (version "5.5.2.0") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/lpsolve/lpsolve/" version + "/lp_solve_" version "_source.tar.gz")) + (sha256 + (base32 + "176c7f023mb6b8bfmv4rfqnrlw88lsg422ca74zjh19i2h5s69sq")) + (modules '((guix build utils))) + (snippet + '(substitute* (list "lp_solve/ccc" "lpsolve55/ccc") + (("^c=cc") "c=gcc") + ;; Pretend to be on a 64 bit platform to obtain a common directory + ;; name for the build results on all architectures; nothing else + ;; seems to depend on it. + (("^PLATFORM=.*$") "PLATFORM=ux64\n"))))) + (build-system gnu-build-system) + (arguments + `(#:tests? #f ; no check target + #:phases + (modify-phases %standard-phases + (delete 'configure) + (replace 'build + (lambda _ + (with-directory-excursion "lpsolve55" + (system* "bash" "ccc")) + (with-directory-excursion "lp_solve" + (system* "bash" "ccc")) + #t)) + (replace 'install + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin")) + (lib (string-append out "/lib")) + ;; This is where LibreOffice expects to find the header + ;; files, and where they are installed by Debian. + (include (string-append out "/include/lpsolve"))) + (mkdir-p lib) + (copy-file "lpsolve55/bin/ux64/liblpsolve55.a" + (string-append lib "/liblpsolve55.a")) + (copy-file "lpsolve55/bin/ux64/liblpsolve55.so" + (string-append lib "/liblpsolve55.so")) + (mkdir-p bin) + (copy-file "lp_solve/bin/ux64/lp_solve" + (string-append bin "/lp_solve")) + (mkdir-p include) + ;; Install a subset of the header files as on Debian + ;; (plus lp_bit.h, which matches the regular expression). + (for-each + (lambda (name) + (copy-file name (string-append include "/" name))) + (find-files "." "lp_[HMSa-z].*\\.h$")) + (with-directory-excursion "shared" + (for-each + (lambda (name) + (copy-file name (string-append include "/" name))) + (find-files "." "\\.h$"))) + #t)))))) + (home-page "http://lpsolve.sourceforge.net/") + (synopsis "Mixed integer linear programming (MILP) solver") + (description + "lp_solve is a mixed integer linear programming solver based on the +revised simplex and the branch-and-bound methods.") + (license license:lgpl2.1+))) diff --git a/gnu/packages/messaging.scm b/gnu/packages/messaging.scm index fd857b1ec3..50d59cfcc5 100644 --- a/gnu/packages/messaging.scm +++ b/gnu/packages/messaging.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com> +;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -86,20 +87,20 @@ providing: (define-public bitlbee (package (name "bitlbee") - (version "3.2.2") + (version "3.4") (source (origin (method url-fetch) (uri (string-append "http://get.bitlbee.org/src/bitlbee-" version ".tar.gz")) (sha256 - (base32 "13jmcxxgli82wb2n4hs091159xk8rgh7nb02f478lgpjh6996f5s")))) + (base32 "0plx4dryf8i6hz7vghg84z5f6w6rkw1l8ckl4c4wh5zxpd3ddfnf")) + (patches (list (search-patch "bitlbee-configure-doc-fix.patch"))))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config) ("check" ,check))) (inputs `(("glib" ,glib) ("libotr" ,libotr) ("gnutls" ,gnutls) - ("zlib" ,zlib) ; Needed to satisfy "pkg-config --exists gnutls" ("python" ,python-2) ("perl" ,perl))) (arguments diff --git a/gnu/packages/moe.scm b/gnu/packages/moe.scm index 6708d72913..675ecb6ce2 100644 --- a/gnu/packages/moe.scm +++ b/gnu/packages/moe.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> +;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,7 +27,7 @@ (define-public moe (package (name "moe") - (version "1.6") + (version "1.7") (source (origin (method url-fetch) @@ -35,7 +35,7 @@ version ".tar.lz")) (sha256 (base32 - "1cfwi67sdl2qchqbdib4p6wxjpwz2kmn6vxn9hmh1zs0gg4xkbwc")))) + "1fzimk1qpmsm7wzfnjzzrp4dvdn7ipdb5j7969910g1m93wndfik")))) (build-system gnu-build-system) (native-inputs `(("lzip" ,lzip))) (inputs `(("ncurses" ,ncurses))) diff --git a/gnu/packages/socat.scm b/gnu/packages/networking.scm index 7c0bc3d964..dd13e1720b 100644 --- a/gnu/packages/socat.scm +++ b/gnu/packages/networking.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -16,14 +17,42 @@ ;;; 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 socat) +(define-module (gnu packages networking) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module (gnu packages openssl)) -;; XXX: Group with other networking tools like tcpdump in a module? +(define-public miredo + (package + (name "miredo") + (version "1.2.6") + (source (origin + (method url-fetch) + (uri (string-append "http://www.remlab.net/files/miredo/miredo-" + version ".tar.xz")) + (sha256 + (base32 + "0j9ilig570snbmj48230hf7ms8kvcwi2wblycqrmhh85lksd49ps")))) + (build-system gnu-build-system) + (arguments + '(#:phases + (modify-phases %standard-phases + ;; The checkconf test in src/ requires network access. + (add-before + 'check 'disable-checkconf-test + (lambda _ + (substitute* "src/Makefile" + (("^TESTS = .*") "TESTS = \n"))))))) + (home-page "http://www.remlab.net/miredo/") + (synopsis "Teredo IPv6 tunneling software") + (description + "Miredo is an implementation (client, relay, server) of the Teredo +specification, which provides IPv6 Internet connectivity to IPv6 enabled hosts +residing in IPv4-only networks, even when they are behind a NAT device.") + (license license:gpl2+))) + (define-public socat (package (name "socat") @@ -53,3 +82,26 @@ line, to logically connect serial lines on different computers, or to establish a relatively secure environment (su and chroot) for running client or server shell scripts with network connections. ") (license license:gpl2))) + +(define-public zeromq + (package + (name "zeromq") + (version "4.0.5") + (source (origin + (method url-fetch) + (uri (string-append "http://download.zeromq.org/zeromq-" + version ".tar.gz")) + (sha256 + (base32 + "0arl8fy8d03xd5h0mgda1s5bajwg8iyh1kk4hd1420rpcxgkrj9v")))) + (build-system gnu-build-system) + (home-page "http://zeromq.org") + (synopsis "Library for message-based applications") + (description + "The 0MQ lightweight messaging kernel is a library which extends the +standard socket interfaces with features traditionally provided by specialized +messaging middle-ware products. 0MQ sockets provide an abstraction of +asynchronous message queues, multiple messaging patterns, message +filtering (subscriptions), seamless access to multiple transport protocols and +more.") + (license license:lgpl3+))) diff --git a/gnu/packages/ocaml.scm b/gnu/packages/ocaml.scm index 2b4821ed42..5baf24cac0 100644 --- a/gnu/packages/ocaml.scm +++ b/gnu/packages/ocaml.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> -;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> +;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,11 +18,20 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu packages ocaml) - #:use-module (guix licenses) + #:use-module ((guix licenses) #:hide (zlib)) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix utils) #:use-module (guix build-system gnu) #:use-module (gnu packages) + #:use-module (gnu packages base) + #:use-module (gnu packages emacs) + #:use-module (gnu packages texinfo) + #:use-module (gnu packages pkg-config) + #:use-module (gnu packages compression) + #:use-module (gnu packages commencement) + #:use-module (gnu packages xorg) + #:use-module (gnu packages texlive) #:use-module (gnu packages perl) #:use-module (gnu packages python) #:use-module (gnu packages ncurses) @@ -32,56 +41,94 @@ (define-public ocaml (package (name "ocaml") - (version "4.00.1") + (version "4.02.1") (source (origin - (method url-fetch) - (uri (string-append - "http://caml.inria.fr/pub/distrib/ocaml-4.00/ocaml-" - version ".tar.gz")) - (sha256 - (base32 - "0yp86napnvbi2jgxr6bk1235bmjdclgzrzgq4mhwv87l7dymr3dl")))) + (method url-fetch) + (uri (string-append + "http://caml.inria.fr/pub/distrib/ocaml-" + (version-major+minor version) + "/ocaml-" version ".tar.xz")) + (sha256 + (base32 + "1p7lqvh64xpykh99014mz21q8fs3qyjym2qazhhbq8scwldv1i38")))) (build-system gnu-build-system) + (native-inputs + `(("perl" ,perl) + ("pkg-config" ,pkg-config))) + (inputs + `(("libx11" ,libx11) + ("gcc:lib" ,gcc-final "lib") ; for libiberty, needed for objdump support + ("zlib" ,zlib))) ; also needed for objdump support (arguments - `(#:modules ((guix build gnu-build-system) - (guix build utils) - (srfi srfi-1)) - #:phases (alist-replace - 'configure - (lambda* (#:key outputs #:allow-other-keys) - ;; OCaml uses "-prefix <prefix>" rather than the usual - ;; "--prefix=<prefix>". - (let ((out (assoc-ref outputs "out"))) - (zero? (system* "./configure" "-prefix" out - "-mandir" - (string-append out "/share/man"))))) - (alist-replace - 'build - (lambda* (#:key outputs #:allow-other-keys) - ;; "make" does not do anything, we must use - ;; "make world.opt". - (zero? (system* "make" "world.opt"))) - (alist-replace - 'check-after-install - (lambda* (#:key outputs #:allow-other-keys) - ;; There does not seem to be a "check" or "test" target. - (zero? (system "cd testsuite && make all"))) - (let ((check (assq-ref %standard-phases 'check))) - ;; OCaml assumes that "make install" is run before - ;; launching the tests. - (alist-cons-after - 'install 'check-after-install - check - (alist-delete 'check %standard-phases)))))))) - (inputs `(("perl" ,perl))) - (home-page "http://caml.inria.fr/") + `(#:modules ((guix build gnu-build-system) + (guix build utils) + (web server)) + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'patch-/bin/sh-references + (lambda* (#:key inputs #:allow-other-keys) + (let* ((sh (string-append (assoc-ref inputs "bash") + "/bin/sh")) + (quoted-sh (string-append "\"" sh "\""))) + (with-fluids ((%default-port-encoding #f)) + (for-each (lambda (file) + (substitute* file + (("\"/bin/sh\"") + (begin + (format (current-error-port) "\ +patch-/bin/sh-references: ~a: changing `\"/bin/sh\"' to `~a'~%" + file quoted-sh) + quoted-sh)))) + (find-files "." "\\.ml$")) + #t)))) + (replace 'configure + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (mandir (string-append out "/share/man"))) + ;; Custom configure script doesn't recognize + ;; --prefix=<PREFIX> syntax (with equals sign). + (zero? (system* "./configure" + "--prefix" out + "--mandir" mandir))))) + (replace 'build + (lambda _ + (zero? (system* "make" "-j" (number->string + (parallel-job-count)) + "world.opt")))) + (delete 'check) + (add-after 'install 'check + (lambda _ + (with-directory-excursion "testsuite" + (zero? (system* "make" "all"))))) + (add-before 'check 'prepare-socket-test + (lambda _ + (format (current-error-port) + "Spawning local test web server on port 8080~%") + (when (zero? (primitive-fork)) + (run-server (lambda (request request-body) + (values '((content-type . (text/plain))) + "Hello!")) + 'http '(#:port 8080))) + (let ((file "testsuite/tests/lib-threads/testsocket.ml")) + (format (current-error-port) + "Patching ~a to use localhost port 8080~%" + file) + (substitute* file + (("caml.inria.fr") "localhost") + (("80") "8080") + (("HTTP1.0") "HTTP/1.0")) + #t)))))) + (home-page "https://ocaml.org/") (synopsis "The OCaml programming language") (description "OCaml is a general purpose industrial-strength programming language with an emphasis on expressiveness and safety. Developed for more than 20 years at Inria it benefits from one of the most advanced type systems and supports functional, imperative and object-oriented styles of programming.") - (license (list qpl gpl2)))) + ;; The compiler is distributed under qpl1.0 with a change to choice of + ;; law: the license is governed by the laws of France. The library is + ;; distributed under lgpl2.0. + (license (list qpl lgpl2.0)))) (define-public opam (package @@ -143,3 +190,198 @@ Git-friendly development workflow.") ;; The 'LICENSE' file waives some requirements compared to LGPLv3. (license lgpl3))) + +(define-public camlp5 + (package + (name "camlp5") + (version "6.12") + (source (origin + (method url-fetch) + (uri (string-append "http://camlp5.gforge.inria.fr/distrib/src/" + name "-" version ".tgz")) + (sha256 + (base32 + "00jwgp6w4g64lfqjx77xziy532091fy00c42fsy0b4i892rch5mp")))) + (build-system gnu-build-system) + (inputs + `(("ocaml" ,ocaml))) + (arguments + `(#:tests? #f ; XXX TODO figure out how to run the tests + #:phases + (modify-phases %standard-phases + (replace 'configure + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (mandir (string-append out "/share/man"))) + ;; Custom configure script doesn't recognize + ;; --prefix=<PREFIX> syntax (with equals sign). + (zero? (system* "./configure" + "--prefix" out + "--mandir" mandir))))) + (replace 'build + (lambda _ + (zero? (system* "make" "-j" (number->string + (parallel-job-count)) + "world.opt"))))))) + (home-page "http://camlp5.gforge.inria.fr/") + (synopsis "Pre-processor Pretty Printer for OCaml") + (description + "Camlp5 is a Pre-Processor-Pretty-Printer for Objective Caml. It offers +tools for syntax (Stream Parsers and Grammars) and the ability to modify the +concrete syntax of the language (Quotations, Syntax Extensions).") + ;; Most files are distributed under bsd-3, but ocaml_stuff/* is under qpl. + (license (list bsd-3 qpl)))) + +(define-public hevea + (package + (name "hevea") + (version "2.23") + (source (origin + (method url-fetch) + (uri (string-append "http://hevea.inria.fr/distri/" + name "-" version ".tar.gz")) + (sha256 + (base32 + "1f9pj48518ixhjxbviv2zx27v4anp92zgg3x704g1s5cki2w33nv")))) + (build-system gnu-build-system) + (inputs + `(("ocaml" ,ocaml))) + (arguments + `(#:tests? #f ; no test suite + #:make-flags (list (string-append "PREFIX=" %output)) + #:phases (modify-phases %standard-phases + (delete 'configure)))) + (home-page "http://hevea.inria.fr/") + (synopsis "LaTeX to HTML translator") + (description + "HeVeA is a LaTeX to HTML translator that generates modern HTML 5. It is +written in Objective Caml.") + (license qpl))) + +(define-public coq + (package + (name "coq") + (version "8.4pl6") + (source (origin + (method url-fetch) + (uri (string-append "https://coq.inria.fr/distrib/V" version + "/files/" name "-" version ".tar.gz")) + (sha256 + (base32 + "1mpbj4yf36kpjg2v2sln12i8dzqn8rag6fd07hslj2lpm4qs4h55")))) + (build-system gnu-build-system) + (native-inputs + `(("texlive" ,texlive) + ("hevea" ,hevea))) + (inputs + `(("ocaml" ,ocaml) + ("camlp5" ,camlp5))) + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'configure + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (mandir (string-append out "/share/man")) + (browser "icecat -remote \"OpenURL(%s,new-tab)\"")) + (zero? (system* "./configure" + "--prefix" out + "--mandir" mandir + "--browser" browser))))) + (replace 'build + (lambda _ + (zero? (system* "make" "-j" (number->string + (parallel-job-count)) + "world")))) + (delete 'check) + (add-after 'install 'check + (lambda _ + (with-directory-excursion "test-suite" + (zero? (system* "make")))))))) + (home-page "https://coq.inria.fr") + (synopsis "Proof assistant for higher-order logic") + (description + "Coq is a proof assistant for higher-order logic, which allows the +development of computer programs consistent with their formal specification. +It is developed using Objective Caml and Camlp5.") + ;; The code is distributed under lgpl2.1. + ;; Some of the documentation is distributed under opl1.0+. + (license (list lgpl2.1 opl1.0+)))) + +(define-public proof-general + (package + (name "proof-general") + (version "4.2") + (source (origin + (method url-fetch) + (uri (string-append + "http://proofgeneral.inf.ed.ac.uk/releases/" + "ProofGeneral-" version ".tgz")) + (sha256 + (base32 + "09qb0myq66fw17v4ziz401ilsb5xlxz1nl2wsp69d0vrfy0bcrrm")))) + (build-system gnu-build-system) + (native-inputs + `(("which" ,which) + ("emacs" ,emacs-no-x) + ("texinfo" ,texinfo))) + (inputs + `(("host-emacs" ,emacs) + ("perl" ,perl) + ("coq" ,coq))) + (arguments + `(#:tests? #f ; no check target + #:make-flags (list (string-append "PREFIX=" %output) + (string-append "DEST_PREFIX=" %output)) + #:modules ((guix build gnu-build-system) + (guix build utils) + (guix build emacs-utils)) + #:imported-modules (,@%gnu-build-system-modules + (guix build emacs-utils)) + #:phases + (modify-phases %standard-phases + (delete 'configure) + (add-after 'unpack 'disable-byte-compile-error-on-warn + (lambda _ + (substitute* "Makefile" + (("\\(setq byte-compile-error-on-warn t\\)") + "(setq byte-compile-error-on-warn nil)")) + #t)) + (add-after 'unpack 'patch-hardcoded-paths + (lambda* (#:key inputs outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out")) + (coq (assoc-ref inputs "coq")) + (emacs (assoc-ref inputs "host-emacs"))) + (define (coq-prog name) + (string-append coq "/bin/" name)) + (emacs-substitute-variables "coq/coq.el" + ("coq-prog-name" (coq-prog "coqtop")) + ("coq-compiler" (coq-prog "coqc")) + ("coq-dependency-analyzer" (coq-prog "coqdep"))) + (substitute* "Makefile" + (("/sbin/install-info") "install-info")) + (substitute* "bin/proofgeneral" + (("^PGHOMEDEFAULT=.*" all) + (string-append all + "PGHOME=$PGHOMEDEFAULT\n" + "EMACS=" emacs "/bin/emacs"))) + #t))) + (add-after 'unpack 'clean + (lambda _ + ;; Delete the pre-compiled elc files for Emacs 23. + (zero? (system* "make" "clean")))) + (add-after 'install 'install-doc + (lambda* (#:key make-flags #:allow-other-keys) + ;; XXX FIXME avoid building/installing pdf files, + ;; due to unresolved errors building them. + (substitute* "Makefile" + ((" [^ ]*\\.pdf") "")) + (zero? (apply system* "make" "install-doc" + make-flags))))))) + (home-page "http://proofgeneral.inf.ed.ac.uk/") + (description "Generic front-end for proof assistants based on Emacs") + (synopsis + "Proof General is a major mode to turn Emacs into an interactive proof +assistant to write formal mathematical proofs using a variety of theorem +provers.") + (license gpl2+))) diff --git a/gnu/packages/openldap.scm b/gnu/packages/openldap.scm index fe7961affb..52bd0eea47 100644 --- a/gnu/packages/openldap.scm +++ b/gnu/packages/openldap.scm @@ -37,11 +37,21 @@ (version "2.4.40") (source (origin (method url-fetch) - (uri (string-append - "ftp://sunsite.cnlab-switch.ch/mirror/OpenLDAP/openldap-release/openldap-" - version ".tgz")) - (sha256 (base32 - "1nyslrgwxwilgv5sixc37svls5rbvhsv9drb7hlrjr2vqaji29ni")))) + + ;; See <http://www.openldap.org/software/download/> for a list of + ;; mirrors. + (uri (list (string-append + "ftp://mirror.switch.ch/mirror/OpenLDAP/" + "openldap-release/openldap-" version ".tgz") + (string-append + "ftp://ftp.OpenLDAP.org/pub/OpenLDAP/" + "openldap-release/openldap-" version ".tgz") + (string-append + "ftp://ftp.dti.ad.jp/pub/net/OpenLDAP/" + "openldap-release/openldap-" version ".tgz"))) + (sha256 + (base32 + "1nyslrgwxwilgv5sixc37svls5rbvhsv9drb7hlrjr2vqaji29ni")))) (build-system gnu-build-system) (inputs `(("bdb" ,bdb) ("openssl" ,openssl) diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 75efd0c448..db05969139 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -29,6 +29,7 @@ #:use-module (gnu packages compression) #:use-module (gnu packages gnupg) #:use-module (gnu packages databases) + #:use-module (gnu packages gnutls) #:use-module (gnu packages graphviz) #:use-module (gnu packages pkg-config) #:use-module (gnu packages autotools) @@ -51,17 +52,17 @@ arch "-linux" "/20131110/guile-2.0.9.tar.xz"))) -(define-public guix-0.8.1 +(define-public guix-0.8.2 (package (name "guix") - (version "0.8.1") + (version "0.8.2") (source (origin (method url-fetch) (uri (string-append "ftp://alpha.gnu.org/gnu/guix/guix-" version ".tar.gz")) (sha256 (base32 - "12h5ldj1yf0za6ladlr8h7nx2gqrv2dxcsiwyqayvrza93lijkf5")))) + "1a5gnkh17w7fgi5zy63ph64iqdvarkdqypkwgw2iifpqa6jq04zz")))) (build-system gnu-build-system) (arguments `(#:configure-flags (list @@ -130,7 +131,8 @@ (base32 "1mi3brl7l58aww34rawhvja84xc7l1b4hmwdmc36fp9q9mfx0lg5")))))) (propagated-inputs - `(("guile-json" ,guile-json) + `(("gnutls" ,gnutls) ;for 'guix download' & co. + ("guile-json" ,guile-json) ("geiser" ,geiser))) ;for guix.el (home-page "http://www.gnu.org/software/guix") @@ -148,9 +150,9 @@ the Nix package manager.") ;; ;; Note: use a short commit id; when using the long one, the limit on socket ;; file names is exceeded while running the tests. - (let ((commit "fc34dee")) - (package (inherit guix-0.8.1) - (version (string-append "0.8.1." commit)) + (let ((commit "c2ee19e")) + (package (inherit guix-0.8.2) + (version (string-append "0.8.2." commit)) (source (origin (method git-fetch) (uri (git-reference @@ -158,9 +160,9 @@ the Nix package manager.") (commit commit))) (sha256 (base32 - "0nx60wwiar0s4bgwrm3nrskc54jig3vw7yzwxkwilc43cnlgpkja")))) + "1gwc1gypgscxg2m3n2vd0mw4dmxr7vsisqgh3y0lr05q9z5742sj")))) (arguments - (substitute-keyword-arguments (package-arguments guix-0.8.1) + (substitute-keyword-arguments (package-arguments guix-0.8.2) ((#:phases phases) `(alist-cons-after 'unpack 'bootstrap @@ -178,7 +180,7 @@ the Nix package manager.") ("gettext" ,gnu-gettext) ("texinfo" ,texinfo) ("graphviz" ,graphviz) - ,@(package-native-inputs guix-0.8.1)))))) + ,@(package-native-inputs guix-0.8.2)))))) (define-public guix guix-devel) diff --git a/gnu/packages/parallel.scm b/gnu/packages/parallel.scm index 70595b1bac..05d641fc36 100644 --- a/gnu/packages/parallel.scm +++ b/gnu/packages/parallel.scm @@ -28,7 +28,7 @@ (define-public parallel (package (name "parallel") - (version "20150322") + (version "20150422") (source (origin (method url-fetch) @@ -36,7 +36,7 @@ version ".tar.bz2")) (sha256 (base32 - "1zsj1bd4zbwb4n9i0jgzs7vd5wkyg3xvj6s1q6s5fyn0pff7j01c")))) + "1x6lvbw6msjkibadihzr2s0mbbcx2h2wxd723q5bgz6mcnsml346")))) (build-system gnu-build-system) (inputs `(("perl" ,perl))) (home-page "http://www.gnu.org/software/parallel/") diff --git a/gnu/packages/patches/bitlbee-configure-doc-fix.patch b/gnu/packages/patches/bitlbee-configure-doc-fix.patch new file mode 100644 index 0000000000..ade0b7f25c --- /dev/null +++ b/gnu/packages/patches/bitlbee-configure-doc-fix.patch @@ -0,0 +1,15 @@ +Fix the check for the prebuilt helpfile when xsltproc is not available. + +--- bitlbee-3.4/configure.orig 2015-03-25 18:09:10.000000000 -0400 ++++ bitlbee-3.4/configure 2015-05-20 14:51:33.627975970 -0400 +@@ -650,8 +650,8 @@ + + if [ "$doc" = "1" ]; then + if [ ! -e doc/user-guide/help.txt ] && \ +- ! type xmlto > /dev/null 2> /dev/null || \ +- ! type xsltproc > /dev/null 2> /dev/null ++ (! type xmlto > /dev/null 2> /dev/null || \ ++ ! type xsltproc > /dev/null 2> /dev/null) + then + echo + echo 'WARNING: Building from an unreleased source tree without prebuilt helpfile.' diff --git a/gnu/packages/patches/curl-support-capath-on-gnutls-conf.patch b/gnu/packages/patches/curl-support-capath-on-gnutls-conf.patch deleted file mode 100644 index d2391d461d..0000000000 --- a/gnu/packages/patches/curl-support-capath-on-gnutls-conf.patch +++ /dev/null @@ -1,16 +0,0 @@ -This patch updates 'configure' as autoreconf would have done after -applying curl-support-capath-on-gnutls.patch. - ---- a/configure 2015-03-22 01:11:23.178743705 +0100 -+++ b/configure 2015-02-25 00:05:37.000000000 +0100 -@@ -23952,8 +24432,8 @@ - ca="$want_ca" - capath="no" - elif test "x$want_capath" != "xno" -a "x$want_capath" != "xunset"; then -- if test "x$OPENSSL_ENABLED" != "x1" -a "x$POLARSSL_ENABLED" != "x1"; then -- as_fn_error $? "--with-ca-path only works with openSSL or PolarSSL" "$LINENO" 5 -+ if test "x$OPENSSL_ENABLED" != "x1" -a "x$GNUTLS_ENABLED" != "x1" -a "x$POLARSSL_ENABLED" != "x1"; then -+ as_fn_error $? "--with-ca-path only works with OpenSSL, GnuTLS or PolarSSL" "$LINENO" 5 - fi - capath="$want_capath" - ca="no" diff --git a/gnu/packages/patches/curl-support-capath-on-gnutls.patch b/gnu/packages/patches/curl-support-capath-on-gnutls.patch deleted file mode 100644 index d05dd021e8..0000000000 --- a/gnu/packages/patches/curl-support-capath-on-gnutls.patch +++ /dev/null @@ -1,102 +0,0 @@ -This patch adds support for CURLOPT_CAPATH to the GnuTLS backend. - -From 5a1614cecdd57cab8b4ae3e9bc19dfff5ba77e80 Mon Sep 17 00:00:00 2001 -From: Alessandro Ghedini <alessandro@ghedini.me> -Date: Sun, 8 Mar 2015 20:11:06 +0100 -Subject: [PATCH] gtls: add support for CURLOPT_CAPATH - ---- - acinclude.m4 | 4 ++-- - docs/libcurl/opts/CURLOPT_CAPATH.3 | 5 ++--- - lib/vtls/gtls.c | 22 ++++++++++++++++++++++ - lib/vtls/gtls.h | 3 +++ - 4 files changed, 29 insertions(+), 5 deletions(-) - -diff --git a/acinclude.m4 b/acinclude.m4 -index 6ed7ffb..ca01869 100644 ---- a/acinclude.m4 -+++ b/acinclude.m4 -@@ -2615,8 +2615,8 @@ AC_HELP_STRING([--without-ca-path], [Don't use a default CA path]), - capath="no" - elif test "x$want_capath" != "xno" -a "x$want_capath" != "xunset"; then - dnl --with-ca-path given -- if test "x$OPENSSL_ENABLED" != "x1" -a "x$POLARSSL_ENABLED" != "x1"; then -- AC_MSG_ERROR([--with-ca-path only works with openSSL or PolarSSL]) -+ if test "x$OPENSSL_ENABLED" != "x1" -a "x$GNUTLS_ENABLED" != "x1" -a "x$POLARSSL_ENABLED" != "x1"; then -+ AC_MSG_ERROR([--with-ca-path only works with OpenSSL, GnuTLS or PolarSSL]) - fi - capath="$want_capath" - ca="no" -diff --git a/docs/libcurl/opts/CURLOPT_CAPATH.3 b/docs/libcurl/opts/CURLOPT_CAPATH.3 -index 642953d..6695f9f 100644 ---- a/docs/libcurl/opts/CURLOPT_CAPATH.3 -+++ b/docs/libcurl/opts/CURLOPT_CAPATH.3 -@@ -43,9 +43,8 @@ All TLS based protocols: HTTPS, FTPS, IMAPS, POP3, SMTPS etc. - .SH EXAMPLE - TODO - .SH AVAILABILITY --This option is OpenSSL-specific and does nothing if libcurl is built to use --GnuTLS. NSS-powered libcurl provides the option only for backward --compatibility. -+This option is supported by the OpenSSL, GnuTLS and PolarSSL backends. The NSS -+backend provides the option only for backward compatibility. - .SH RETURN VALUE - Returns CURLE_OK if TLS enabled, and CURLE_UNKNOWN_OPTION if not, or - CURLE_OUT_OF_MEMORY if there was insufficient heap space. -diff --git a/lib/vtls/gtls.c b/lib/vtls/gtls.c -index 05aef19..c792540 100644 ---- a/lib/vtls/gtls.c -+++ b/lib/vtls/gtls.c -@@ -97,6 +97,10 @@ static bool gtls_inited = FALSE; - # if (GNUTLS_VERSION_NUMBER >= 0x03020d) - # define HAS_OCSP - # endif -+ -+# if (GNUTLS_VERSION_NUMBER >= 0x030306) -+# define HAS_CAPATH -+# endif - #endif - - #ifdef HAS_OCSP -@@ -462,6 +466,24 @@ gtls_connect_step1(struct connectdata *conn, - rc, data->set.ssl.CAfile); - } - -+#ifdef HAS_CAPATH -+ if(data->set.ssl.CApath) { -+ /* set the trusted CA cert directory */ -+ rc = gnutls_certificate_set_x509_trust_dir(conn->ssl[sockindex].cred, -+ data->set.ssl.CApath, -+ GNUTLS_X509_FMT_PEM); -+ if(rc < 0) { -+ infof(data, "error reading ca cert file %s (%s)\n", -+ data->set.ssl.CAfile, gnutls_strerror(rc)); -+ if(data->set.ssl.verifypeer) -+ return CURLE_SSL_CACERT_BADFILE; -+ } -+ else -+ infof(data, "found %d certificates in %s\n", -+ rc, data->set.ssl.CApath); -+ } -+#endif -+ - if(data->set.ssl.CRLfile) { - /* set the CRL list file */ - rc = gnutls_certificate_set_x509_crl_file(conn->ssl[sockindex].cred, -diff --git a/lib/vtls/gtls.h b/lib/vtls/gtls.h -index c3867e5..af1cb5b 100644 ---- a/lib/vtls/gtls.h -+++ b/lib/vtls/gtls.h -@@ -54,6 +54,9 @@ bool Curl_gtls_cert_status_request(void); - /* Set the API backend definition to GnuTLS */ - #define CURL_SSL_BACKEND CURLSSLBACKEND_GNUTLS - -+/* this backend supports the CAPATH option */ -+#define have_curlssl_ca_path 1 -+ - /* API setup for GnuTLS */ - #define curlssl_init Curl_gtls_init - #define curlssl_cleanup Curl_gtls_cleanup --- -2.2.1 - diff --git a/gnu/packages/patches/fltk-shared-lib-defines.patch b/gnu/packages/patches/fltk-shared-lib-defines.patch new file mode 100644 index 0000000000..d36a50ff5e --- /dev/null +++ b/gnu/packages/patches/fltk-shared-lib-defines.patch @@ -0,0 +1,51 @@ +This patch from upstream revision 10588. + +--- fltk-1.3.3/src/Xutf8.h ++++ fltk-1.3.3/src/Xutf8.h +@@ -25,6 +25,7 @@ + #include <X11/Xlib.h> + #include <X11/Xlocale.h> + #include <X11/Xutil.h> ++#include <FL/Fl_Export.H> + + typedef struct { + int nb_font; +@@ -98,8 +99,8 @@ + XUtf8FontStruct *font_set, + unsigned int ucs); + +-int +-XGetUtf8FontAndGlyph( ++FL_EXPORT int ++fl_XGetUtf8FontAndGlyph( + XUtf8FontStruct *font_set, + unsigned int ucs, + XFontStruct **fnt, +--- fltk-1.3.3/src/gl_draw.cxx ++++ fltk-1.3.3/src/gl_draw.cxx +@@ -114,7 +114,7 @@ + for (int i = 0; i < 0x400; i++) { + XFontStruct *font = NULL; + unsigned short id; +- XGetUtf8FontAndGlyph(gl_fontsize->font, ii, &font, &id); ++ fl_XGetUtf8FontAndGlyph(gl_fontsize->font, ii, &font, &id); + if (font) glXUseXFont(font->fid, id, 1, gl_fontsize->listbase+ii); + ii++; + } +--- fltk-1.3.3/src/xutf8/utf8Wrap.c ++++ fltk-1.3.3/src/xutf8/utf8Wrap.c +@@ -816,10 +816,10 @@ + /** get the X font and glyph ID of a UCS char **/ + /*****************************************************************************/ + int +-XGetUtf8FontAndGlyph(XUtf8FontStruct *font_set, +- unsigned int ucs, +- XFontStruct **fnt, +- unsigned short *id) { ++fl_XGetUtf8FontAndGlyph(XUtf8FontStruct *font_set, ++ unsigned int ucs, ++ XFontStruct **fnt, ++ unsigned short *id) { + + /* int x; */ + int *encodings; /* encodings array */ diff --git a/gnu/packages/patches/fuse-CVE-2015-3202.patch b/gnu/packages/patches/fuse-CVE-2015-3202.patch new file mode 100644 index 0000000000..7c64de7683 --- /dev/null +++ b/gnu/packages/patches/fuse-CVE-2015-3202.patch @@ -0,0 +1,65 @@ +The following patch was copied from Debian. + +Description: Fix CVE-2015-3202 + Missing scrubbing of the environment before executing a mount or umount + of a filesystem. +Origin: upstream +Author: Miklos Szeredi <miklos@szeredi.hu> +Last-Update: 2015-05-19 + +--- + lib/mount_util.c | 23 +++++++++++++++++------ + 1 file changed, 17 insertions(+), 6 deletions(-) + +--- a/lib/mount_util.c ++++ b/lib/mount_util.c +@@ -95,10 +95,12 @@ static int add_mount(const char *prognam + goto out_restore; + } + if (res == 0) { ++ char *env = NULL; ++ + sigprocmask(SIG_SETMASK, &oldmask, NULL); + setuid(geteuid()); +- execl("/bin/mount", "/bin/mount", "--no-canonicalize", "-i", +- "-f", "-t", type, "-o", opts, fsname, mnt, NULL); ++ execle("/bin/mount", "/bin/mount", "--no-canonicalize", "-i", ++ "-f", "-t", type, "-o", opts, fsname, mnt, NULL, &env); + fprintf(stderr, "%s: failed to execute /bin/mount: %s\n", + progname, strerror(errno)); + exit(1); +@@ -146,10 +148,17 @@ static int exec_umount(const char *progn + goto out_restore; + } + if (res == 0) { ++ char *env = NULL; ++ + sigprocmask(SIG_SETMASK, &oldmask, NULL); + setuid(geteuid()); +- execl("/bin/umount", "/bin/umount", "-i", rel_mnt, +- lazy ? "-l" : NULL, NULL); ++ if (lazy) { ++ execle("/bin/umount", "/bin/umount", "-i", rel_mnt, ++ "-l", NULL, &env); ++ } else { ++ execle("/bin/umount", "/bin/umount", "-i", rel_mnt, ++ NULL, &env); ++ } + fprintf(stderr, "%s: failed to execute /bin/umount: %s\n", + progname, strerror(errno)); + exit(1); +@@ -205,10 +214,12 @@ static int remove_mount(const char *prog + goto out_restore; + } + if (res == 0) { ++ char *env = NULL; ++ + sigprocmask(SIG_SETMASK, &oldmask, NULL); + setuid(geteuid()); +- execl("/bin/umount", "/bin/umount", "--no-canonicalize", "-i", +- "--fake", mnt, NULL); ++ execle("/bin/umount", "/bin/umount", "--no-canonicalize", "-i", ++ "--fake", mnt, NULL, &env); + fprintf(stderr, "%s: failed to execute /bin/umount: %s\n", + progname, strerror(errno)); + exit(1); diff --git a/gnu/packages/patches/gcc-5.0-libvtv-runpath.patch b/gnu/packages/patches/gcc-5.0-libvtv-runpath.patch new file mode 100644 index 0000000000..9a9bc5ca53 --- /dev/null +++ b/gnu/packages/patches/gcc-5.0-libvtv-runpath.patch @@ -0,0 +1,15 @@ +GCC 4.9 and later have libvtv and, just like libstdc++ (see +https://gcc.gnu.org/bugzilla/show_bug.cgi?id=32354), it doesn't +have $libdir in its RUNPATH, but it NEEDs libgcc_s. This patch +fixes that. + +--- gcc-5.1.0/libvtv/Makefile.in 2014-10-30 09:28:58.000000000 +0100 ++++ gcc-5.1.0/libvtv/Makefile.in 2015-04-30 09:51:04.161129705 +0200 +@@ -15,6 +15,7 @@ + + @SET_MAKE@ + ++libvtv_la_LDFLAGS = -Wl,-rpath=$(libdir) + + VPATH = @srcdir@ + pkgdatadir = $(datadir)/@PACKAGE@ diff --git a/gnu/packages/patches/gnutls-fix-duplicate-manpages.patch b/gnu/packages/patches/gnutls-fix-duplicate-manpages.patch deleted file mode 100644 index 95a25560e5..0000000000 --- a/gnu/packages/patches/gnutls-fix-duplicate-manpages.patch +++ /dev/null @@ -1,30 +0,0 @@ -Remove duplicate manpage entries from Makefile. - ---- gnutls-3.4.0/doc/manpages/Makefile.am.orig 2015-04-06 04:48:30.000000000 -0400 -+++ gnutls-3.4.0/doc/manpages/Makefile.am 2015-04-12 16:52:58.029694525 -0400 -@@ -134,11 +134,8 @@ - APIMANS += gnutls_certificate_get_peers_subkey_id.3 - APIMANS += gnutls_certificate_get_trust_list.3 - APIMANS += gnutls_certificate_get_verify_flags.3 --APIMANS += gnutls_certificate_get_verify_flags.3 --APIMANS += gnutls_certificate_get_x509_crt.3 - APIMANS += gnutls_certificate_get_x509_crt.3 - APIMANS += gnutls_certificate_get_x509_key.3 --APIMANS += gnutls_certificate_get_x509_key.3 - APIMANS += gnutls_certificate_send_x509_rdn_sequence.3 - APIMANS += gnutls_certificate_server_set_request.3 - APIMANS += gnutls_certificate_set_dh_params.3 ---- gnutls-3.4.0/doc/manpages/Makefile.in.orig 2015-04-08 02:08:30.000000000 -0400 -+++ gnutls-3.4.0/doc/manpages/Makefile.in 2015-04-12 16:53:13.319694530 -0400 -@@ -1275,11 +1275,8 @@ - gnutls_certificate_get_peers_subkey_id.3 \ - gnutls_certificate_get_trust_list.3 \ - gnutls_certificate_get_verify_flags.3 \ -- gnutls_certificate_get_verify_flags.3 \ -- gnutls_certificate_get_x509_crt.3 \ - gnutls_certificate_get_x509_crt.3 \ - gnutls_certificate_get_x509_key.3 \ -- gnutls_certificate_get_x509_key.3 \ - gnutls_certificate_send_x509_rdn_sequence.3 \ - gnutls_certificate_server_set_request.3 \ - gnutls_certificate_set_dh_params.3 \ diff --git a/gnu/packages/patches/guix-test-networking.patch b/gnu/packages/patches/guix-test-networking.patch deleted file mode 100644 index a8d1f4fd2f..0000000000 --- a/gnu/packages/patches/guix-test-networking.patch +++ /dev/null @@ -1,15 +0,0 @@ -Skip that test when the network is unreachable. - -diff --git a/tests/packages.scm b/tests/packages.scm -index 04e3b0b..6ac215b 100644 ---- a/tests/packages.scm -+++ b/tests/packages.scm -@@ -139,6 +139,8 @@ - (and (direct-store-path? source) - (string-suffix? "utils.scm" source)))) - -+(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)) -+ (test-skip 1)) - (test-equal "package-source-derivation, snippet" - "OK" - (let* ((file (search-bootstrap-binary "guile-2.0.9.tar.xz" diff --git a/gnu/packages/patches/hop-linker-flags.patch b/gnu/packages/patches/hop-linker-flags.patch new file mode 100644 index 0000000000..f1f5dbfbd9 --- /dev/null +++ b/gnu/packages/patches/hop-linker-flags.patch @@ -0,0 +1,60 @@ +Make hop's link rules honor flags set by the --blflags configure argument. + +--- hop-2.4.0/src/Makefile 2015-05-05 19:41:04.800151036 -0500 ++++ hop-2.4.0/src/Makefile 2015-05-05 19:40:40.916150417 -0500 +@@ -69,10 +69,10 @@ + $(MAKE) link.$(LINK) DEST=$@ + + link.dynamic: +- @ $(call link,$(BIGLOO),$(BCFLAGS),$(BCFLAGSDEV),$(OBJECTS),-o,$(DEST)) ++ @ $(call link,$(BIGLOO),$(BCFLAGS) $(BLFLAGS),$(BCFLAGSDEV),$(OBJECTS),-o,$(DEST)) + + link.static: +- @ $(call link,$(BIGLOO),$(BCFLAGS),$(BCFLAGSDEV),-static-all-bigloo $(OBJECTS),-o,$(DEST)) ++ @ $(call link,$(BIGLOO),$(BCFLAGS) $(BLFLAGS),$(BCFLAGSDEV),-static-all-bigloo $(OBJECTS),-o,$(DEST)) + + link.library: + echo "***ERROR: link.library not currently supported!" +--- hop-2.4.0/hopc/Makefile 2013-01-30 07:17:59.000000000 -0600 ++++ hop-2.4.0/hopc/Makefile 2015-05-05 19:45:21.876157699 -0500 +@@ -62,7 +62,7 @@ + mkdir -p $@ + + $(BUILDBINDIR)/$(EXEC): .afile .etags $(OBJECTS) +- @ $(call link,$(BIGLOO),$(BCFLAGS),,$(OBJECTS),-o,$@) ++ @ $(call link,$(BIGLOO),$(BCFLAGS) $(BLFLAGS),$(BCFLAGSDEV),$(OBJECTS),-o,$@) + + $(BUILDBINDIR)/$(EXEC).jar: .afile .etags .jfile $(BGL_CLASSES) META-INF/MANIFEST.MF jvm-stdlibs jvm-share jvm-lib + $(JAR) $@ META-INF/MANIFEST.MF -C o/class_s . +--- hop-2.4.0/hophz/Makefile 2013-01-30 07:17:59.000000000 -0600 ++++ hop-2.4.0/hophz/Makefile 2015-05-05 19:59:42.996180030 -0500 +@@ -16,9 +16,6 @@ + -include ../etc/Makefile.hopconfig + -include ../etc/Makefile.version + +-BLFLAGS = +-BLINKFLAGS = -suffix hop +- + #*---------------------------------------------------------------------*/ + #* Target and Project */ + #*---------------------------------------------------------------------*/ +@@ -72,7 +69,7 @@ + mkdir -p $@ + + $(BUILDBINDIR)/$(EXEC): .afile .etags $(OBJECTS) +- @ $(call link,$(BIGLOO),$(BCFLAGS),$(BLINKFLAGS),$(OBJECTS),-o,$@) ++ @ $(call link,$(BIGLOO),$(BCFLAGS) $(BLFLAGS),$(BCFLAGSDEV),$(OBJECTS),-o,$@) + + $(BUILDBINDIR)/$(EXEC).jar: .afile .etags .jfile $(BGL_CLASSES) META-INF/MANIFEST.MF jvm-stdlibs jvm-share jvm-lib + @ $(JAR) $@ META-INF/MANIFEST.MF -C o/class_s . +--- hop-2.4.0/hopsh/Makefile 2013-01-30 07:17:59.000000000 -0600 ++++ hop-2.4.0/hopsh/Makefile 2015-05-05 19:46:36.060159626 -0500 +@@ -60,7 +60,7 @@ + mkdir -p $@ + + $(BUILDBINDIR)/$(EXEC): .afile .etags $(OBJECTS) +- @ $(call link,$(BIGLOO),$(BCFLAGS),$(BCFLAGSDEV),$(OBJECTS),-o,$@) ++ @ $(call link,$(BIGLOO),$(BCFLAGS) $(BLFLAGS),$(BCFLAGSDEV),$(OBJECTS),-o,$@) + + $(BUILDBINDIR)/$(EXEC).jar: .afile .etags .jfile $(BGL_CLASSES) META-INF/MANIFEST.MF jvm-stdlibs jvm-share jvm-lib + @ $(JAR) $@ META-INF/MANIFEST.MF -C o/class_s . diff --git a/gnu/packages/patches/inetutils-syslogd.patch b/gnu/packages/patches/inetutils-syslogd.patch deleted file mode 100644 index 0bf9eb7fc6..0000000000 --- a/gnu/packages/patches/inetutils-syslogd.patch +++ /dev/null @@ -1,20 +0,0 @@ -From <http://lists.gnu.org/archive/html/bug-inetutils/2015-04/msg00001.html>. - -2015-04-01 Ludovic Courtès <ludo@gnu.org> - - * src/syslogd.c (load_conffile): Use 'bcopy' instead of 'strcpy' - since the two regions may overlap. - Reported by Alex Kost <alezost@gmail.com> - at <http://lists.gnu.org/archive/html/guix-devel/2015-03/msg00780.html>. - ---- a/src/syslogd.c -+++ b/src/syslogd.c -@@ -1989,7 +1989,7 @@ load_conffile (const char *filename, struct filed **nextp) - if (*p == '\0' || *p == '#') - continue; - -- strcpy (cline, p); -+ bcopy (p, cline, strlen (p) + 1); - - /* Cut the trailing spaces. */ - for (p = strchr (cline, '\0'); isspace (*--p);) diff --git a/gnu/packages/patches/libtool-skip-tests.patch b/gnu/packages/patches/libtool-skip-tests.patch deleted file mode 100644 index 9191d40487..0000000000 --- a/gnu/packages/patches/libtool-skip-tests.patch +++ /dev/null @@ -1,55 +0,0 @@ -Because our GCC 'lib' spec automatically adds '-rpath' for each '-L' -and a couple more '-rpath, there are two test failures: -one in demo.test, and one in destdir.at. Disable these. - -Also skip the nopic test on ARM and MIPS systems. - ---- libtool-2.4.6/tests/demo.at.orig 2015-01-16 13:52:04.000000000 -0500 -+++ libtool-2.4.6/tests/demo.at 2015-02-16 10:48:51.435851966 -0500 -@@ -510,7 +510,7 @@ - AT_SETUP([force non-PIC objects]) - - AT_CHECK([case $host in --hppa*|x86_64*|s390*) -+hppa*|x86_64*|s390*|arm*|mips*) - # These hosts cannot use non-PIC shared libs - exit 77 ;; - *-solaris*|*-sunos*) ---- libtool-2.4.6/tests/testsuite.orig 2015-02-15 11:15:25.000000000 -0500 -+++ libtool-2.4.6/tests/testsuite 2015-02-16 10:50:58.736483216 -0500 -@@ -8741,7 +8741,7 @@ - - { set +x - $as_echo "$at_srcdir/demo.at:535: case \$host in --hppa*|x86_64*|s390*) -+hppa*|x86_64*|s390*|arm*|mips*) - # These hosts cannot use non-PIC shared libs - exit 77 ;; - *-solaris*|*-sunos*) -@@ -8766,7 +8766,7 @@ - " - at_fn_check_prepare_notrace 'a `...` command substitution' "demo.at:535" - ( $at_check_trace; case $host in --hppa*|x86_64*|s390*) -+hppa*|x86_64*|s390*|arm*|mips*) - # These hosts cannot use non-PIC shared libs - exit 77 ;; - *-solaris*|*-sunos*) -@@ -9298,7 +9298,7 @@ - #AT_START_34 - at_fn_group_banner 34 'demo.at:548' \ - "hardcoding library path" " " 4 --at_xfail=no -+at_xfail=yes - test no = "$ACLOCAL" && at_xfail=yes - test no = "$AUTOHEADER" && at_xfail=yes - test no = "$AUTOMAKE" && at_xfail=yes -@@ -27243,7 +27243,7 @@ - #AT_START_98 - at_fn_group_banner 98 'destdir.at:75' \ - "DESTDIR with in-package deplibs" " " 8 --at_xfail=no -+at_xfail=yes - eval `$LIBTOOL --config | $GREP '^fast_install='` - case $fast_install in no) :;; *) false;; esac && at_xfail=yes - ( diff --git a/gnu/packages/patches/linux-libre-libreboot-fix.patch b/gnu/packages/patches/linux-libre-libreboot-fix.patch deleted file mode 100644 index d340a99fcb..0000000000 --- a/gnu/packages/patches/linux-libre-libreboot-fix.patch +++ /dev/null @@ -1,37 +0,0 @@ -This patch fixes linux-libre-3.19.x on Libreboot X60 machines. -Copied from https://bugzilla.kernel.org/show_bug.cgi?id=93171#c25 - ---- a/drivers/gpu/drm/i915/i915_irq.c -+++ a/drivers/gpu/drm/i915/i915_irq.c -@@ -3598,14 +3598,12 @@ static int i8xx_irq_postinstall(struct drm_device *dev) - ~(I915_DISPLAY_PIPE_A_EVENT_INTERRUPT | - I915_DISPLAY_PIPE_B_EVENT_INTERRUPT | - I915_DISPLAY_PLANE_A_FLIP_PENDING_INTERRUPT | -- I915_DISPLAY_PLANE_B_FLIP_PENDING_INTERRUPT | -- I915_RENDER_COMMAND_PARSER_ERROR_INTERRUPT); -+ I915_DISPLAY_PLANE_B_FLIP_PENDING_INTERRUPT); - I915_WRITE16(IMR, dev_priv->irq_mask); - - I915_WRITE16(IER, - I915_DISPLAY_PIPE_A_EVENT_INTERRUPT | - I915_DISPLAY_PIPE_B_EVENT_INTERRUPT | -- I915_RENDER_COMMAND_PARSER_ERROR_INTERRUPT | - I915_USER_INTERRUPT); - POSTING_READ16(IER); - -@@ -3767,14 +3765,12 @@ static int i915_irq_postinstall(struct drm_device *dev) - I915_DISPLAY_PIPE_A_EVENT_INTERRUPT | - I915_DISPLAY_PIPE_B_EVENT_INTERRUPT | - I915_DISPLAY_PLANE_A_FLIP_PENDING_INTERRUPT | -- I915_DISPLAY_PLANE_B_FLIP_PENDING_INTERRUPT | -- I915_RENDER_COMMAND_PARSER_ERROR_INTERRUPT); -+ I915_DISPLAY_PLANE_B_FLIP_PENDING_INTERRUPT); - - enable_mask = - I915_ASLE_INTERRUPT | - I915_DISPLAY_PIPE_A_EVENT_INTERRUPT | - I915_DISPLAY_PIPE_B_EVENT_INTERRUPT | -- I915_RENDER_COMMAND_PARSER_ERROR_INTERRUPT | - I915_USER_INTERRUPT; - - if (I915_HAS_HOTPLUG(dev)) { diff --git a/gnu/packages/patches/maxima-defsystem-mkdir.patch b/gnu/packages/patches/maxima-defsystem-mkdir.patch new file mode 100644 index 0000000000..bc42e51a32 --- /dev/null +++ b/gnu/packages/patches/maxima-defsystem-mkdir.patch @@ -0,0 +1,13 @@ +Change 'ensure-directories-exist' to look for 'mkdir' in $PATH, not in /bin. + +--- maxima-5.36.1/lisp-utils/defsystem.lisp.orig 2014-11-22 16:21:30.000000000 -0500 ++++ maxima-5.36.1/lisp-utils/defsystem.lisp 2015-05-25 21:53:31.223648483 -0400 +@@ -4627,7 +4627,7 @@ + (cmd (if (member :win32 *features*) + (format nil "mkdir \"~a\"" + (coerce (subst #\\ #\/ (coerce (namestring dir) 'list)) 'string)) +- (format nil "/bin/mkdir -p ~S" (namestring dir))))) ++ (format nil "mkdir -p ~S" (namestring dir))))) + (unless (directory dir) + (lisp:system cmd)) + ;; The second return value is supposed to be T if directories were diff --git a/gnu/packages/patches/python-sqlite-3.8.4-test-fix.patch b/gnu/packages/patches/python-sqlite-3.8.4-test-fix.patch deleted file mode 100644 index 2f8b159870..0000000000 --- a/gnu/packages/patches/python-sqlite-3.8.4-test-fix.patch +++ /dev/null @@ -1,15 +0,0 @@ -From resolution of upstream python issue #20901: http://bugs.python.org/issue20901 - -diff --git a/Lib/sqlite3/test/hooks.py b/Lib/sqlite3/test/hooks.py ---- Lib/sqlite3/test/hooks.py -+++ Lib/sqlite3/test/hooks.py -@@ -162,7 +162,7 @@ class ProgressTests(unittest.TestCase): - create table bar (a, b) - """) - second_count = len(progress_calls) -- self.assertGreater(first_count, second_count) -+ self.assertGreaterEqual(first_count, second_count) - - def CheckCancelOperation(self): - """ - diff --git a/gnu/packages/patches/qemu-CVE-2015-3209.patch b/gnu/packages/patches/qemu-CVE-2015-3209.patch new file mode 100644 index 0000000000..0bb726698c --- /dev/null +++ b/gnu/packages/patches/qemu-CVE-2015-3209.patch @@ -0,0 +1,49 @@ +From 9f7c594c006289ad41169b854d70f5da6e400a2a Mon Sep 17 00:00:00 2001 +From: Petr Matousek <pmatouse@redhat.com> +Date: Sun, 24 May 2015 10:53:44 +0200 +Subject: [PATCH] pcnet: force the buffer access to be in bounds during tx + +4096 is the maximum length per TMD and it is also currently the size of +the relay buffer pcnet driver uses for sending the packet data to QEMU +for further processing. With packet spanning multiple TMDs it can +happen that the overall packet size will be bigger than sizeof(buffer), +which results in memory corruption. + +Fix this by only allowing to queue maximum sizeof(buffer) bytes. + +This is CVE-2015-3209. + +[Fixed 3-space indentation to QEMU's 4-space coding standard. +--Stefan] + +Signed-off-by: Petr Matousek <pmatouse@redhat.com> +Reported-by: Matt Tait <matttait@google.com> +Reviewed-by: Peter Maydell <peter.maydell@linaro.org> +Reviewed-by: Stefan Hajnoczi <stefanha@redhat.com> +Signed-off-by: Stefan Hajnoczi <stefanha@redhat.com> +--- + hw/net/pcnet.c | 8 ++++++++ + 1 file changed, 8 insertions(+) + +diff --git a/hw/net/pcnet.c b/hw/net/pcnet.c +index bdfd38f..68b9981 100644 +--- a/hw/net/pcnet.c ++++ b/hw/net/pcnet.c +@@ -1241,6 +1241,14 @@ static void pcnet_transmit(PCNetState *s) + } + + bcnt = 4096 - GET_FIELD(tmd.length, TMDL, BCNT); ++ ++ /* if multi-tmd packet outsizes s->buffer then skip it silently. ++ Note: this is not what real hw does */ ++ if (s->xmit_pos + bcnt > sizeof(s->buffer)) { ++ s->xmit_pos = -1; ++ goto txdone; ++ } ++ + s->phys_mem_read(s->dma_opaque, PHYSADDR(s, tmd.tbadr), + s->buffer + s->xmit_pos, bcnt, CSR_BSWP(s)); + s->xmit_pos += bcnt; +-- +2.2.1 + diff --git a/gnu/packages/patches/qemu-CVE-2015-3456.patch b/gnu/packages/patches/qemu-CVE-2015-3456.patch new file mode 100644 index 0000000000..9514f7c3e5 --- /dev/null +++ b/gnu/packages/patches/qemu-CVE-2015-3456.patch @@ -0,0 +1,85 @@ +From e907746266721f305d67bc0718795fedee2e824c Mon Sep 17 00:00:00 2001 +From: Petr Matousek <pmatouse@redhat.com> +Date: Wed, 6 May 2015 09:48:59 +0200 +Subject: [PATCH] fdc: force the fifo access to be in bounds of the allocated + buffer + +During processing of certain commands such as FD_CMD_READ_ID and +FD_CMD_DRIVE_SPECIFICATION_COMMAND the fifo memory access could +get out of bounds leading to memory corruption with values coming +from the guest. + +Fix this by making sure that the index is always bounded by the +allocated memory. + +This is CVE-2015-3456. + +Signed-off-by: Petr Matousek <pmatouse@redhat.com> +Reviewed-by: John Snow <jsnow@redhat.com> +Signed-off-by: John Snow <jsnow@redhat.com> +--- + hw/block/fdc.c | 17 +++++++++++------ + 1 file changed, 11 insertions(+), 6 deletions(-) + +diff --git a/hw/block/fdc.c b/hw/block/fdc.c +index f72a392..d8a8edd 100644 +--- a/hw/block/fdc.c ++++ b/hw/block/fdc.c +@@ -1497,7 +1497,7 @@ static uint32_t fdctrl_read_data(FDCtrl *fdctrl) + { + FDrive *cur_drv; + uint32_t retval = 0; +- int pos; ++ uint32_t pos; + + cur_drv = get_cur_drv(fdctrl); + fdctrl->dsr &= ~FD_DSR_PWRDOWN; +@@ -1506,8 +1506,8 @@ static uint32_t fdctrl_read_data(FDCtrl *fdctrl) + return 0; + } + pos = fdctrl->data_pos; ++ pos %= FD_SECTOR_LEN; + if (fdctrl->msr & FD_MSR_NONDMA) { +- pos %= FD_SECTOR_LEN; + if (pos == 0) { + if (fdctrl->data_pos != 0) + if (!fdctrl_seek_to_next_sect(fdctrl, cur_drv)) { +@@ -1852,10 +1852,13 @@ static void fdctrl_handle_option(FDCtrl *fdctrl, int direction) + static void fdctrl_handle_drive_specification_command(FDCtrl *fdctrl, int direction) + { + FDrive *cur_drv = get_cur_drv(fdctrl); ++ uint32_t pos; + +- if (fdctrl->fifo[fdctrl->data_pos - 1] & 0x80) { ++ pos = fdctrl->data_pos - 1; ++ pos %= FD_SECTOR_LEN; ++ if (fdctrl->fifo[pos] & 0x80) { + /* Command parameters done */ +- if (fdctrl->fifo[fdctrl->data_pos - 1] & 0x40) { ++ if (fdctrl->fifo[pos] & 0x40) { + fdctrl->fifo[0] = fdctrl->fifo[1]; + fdctrl->fifo[2] = 0; + fdctrl->fifo[3] = 0; +@@ -1955,7 +1958,7 @@ static uint8_t command_to_handler[256]; + static void fdctrl_write_data(FDCtrl *fdctrl, uint32_t value) + { + FDrive *cur_drv; +- int pos; ++ uint32_t pos; + + /* Reset mode */ + if (!(fdctrl->dor & FD_DOR_nRESET)) { +@@ -2004,7 +2007,9 @@ static void fdctrl_write_data(FDCtrl *fdctrl, uint32_t value) + } + + FLOPPY_DPRINTF("%s: %02x\n", __func__, value); +- fdctrl->fifo[fdctrl->data_pos++] = value; ++ pos = fdctrl->data_pos++; ++ pos %= FD_SECTOR_LEN; ++ fdctrl->fifo[pos] = value; + if (fdctrl->data_pos == fdctrl->data_len) { + /* We now have all parameters + * and will be able to treat the command +-- +2.2.1 + diff --git a/gnu/packages/patches/r-fix-15899.patch b/gnu/packages/patches/r-fix-15899.patch new file mode 100644 index 0000000000..40593d34e6 --- /dev/null +++ b/gnu/packages/patches/r-fix-15899.patch @@ -0,0 +1,17 @@ +Without the "extern" keyword external applications linking against R (such as +Shogun, for example) might not be linkable. + +See https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=15899 for details +about this bug. + +--- a/src/include/Rinterface.h (revision 66251) ++++ b/src/include/Rinterface.h (working copy) +@@ -84,7 +84,7 @@ + void fpu_setup(Rboolean); + + /* in unix/system.c */ +-int R_running_as_main_program; ++extern int R_running_as_main_program; + + #ifdef CSTACK_DEFNS + /* duplicating Defn.h */ diff --git a/gnu/packages/patches/rsem-makefile.patch b/gnu/packages/patches/rsem-makefile.patch new file mode 100644 index 0000000000..5481dc685f --- /dev/null +++ b/gnu/packages/patches/rsem-makefile.patch @@ -0,0 +1,682 @@ +This patch simplifies the Makefile, making it much easier to build rsem +without the bundled version of samtools. It has already been submitted +upstream: https://github.com/bli25wisc/RSEM/pull/11 + +From 161894e91a16c7e15af57e4fcfe8cb613711c7fa Mon Sep 17 00:00:00 2001 +From: Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de> +Date: Wed, 22 Apr 2015 14:51:07 +0200 +Subject: [PATCH 1/7] remove all headers from Makefile + +--- + Makefile | 95 +++++++++++----------------------------------------------------- + 1 file changed, 16 insertions(+), 79 deletions(-) + +diff --git a/Makefile b/Makefile +index 54e2603..3a55ed8 100644 +--- a/Makefile ++++ b/Makefile +@@ -10,133 +10,70 @@ all : $(PROGRAMS) + sam/libbam.a : + cd sam ; ${MAKE} all + +-Transcript.h : utils.h +- +-Transcripts.h : utils.h my_assert.h Transcript.h +- +-rsem-extract-reference-transcripts : utils.h my_assert.h GTFItem.h Transcript.h Transcripts.h extractRef.cpp ++rsem-extract-reference-transcripts : extractRef.cpp + $(CC) -Wall -O3 extractRef.cpp -o rsem-extract-reference-transcripts + +-rsem-synthesis-reference-transcripts : utils.h my_assert.h Transcript.h Transcripts.h synthesisRef.cpp ++rsem-synthesis-reference-transcripts : synthesisRef.cpp + $(CC) -Wall -O3 synthesisRef.cpp -o rsem-synthesis-reference-transcripts + +-BowtieRefSeqPolicy.h : RefSeqPolicy.h +- +-RefSeq.h : utils.h +- +-Refs.h : utils.h RefSeq.h RefSeqPolicy.h PolyARules.h +- +- + rsem-preref : preRef.o + $(CC) preRef.o -o rsem-preref + +-preRef.o : utils.h RefSeq.h Refs.h PolyARules.h RefSeqPolicy.h AlignerRefSeqPolicy.h preRef.cpp ++preRef.o : preRef.cpp + $(CC) $(COFLAGS) preRef.cpp + +- +-SingleRead.h : Read.h +- +-SingleReadQ.h : Read.h +- +-PairedEndRead.h : Read.h SingleRead.h +- +-PairedEndReadQ.h : Read.h SingleReadQ.h +- +- +-PairedEndHit.h : SingleHit.h +- +-HitContainer.h : GroupInfo.h +- +- +-SamParser.h : sam/sam.h sam/bam.h utils.h my_assert.h SingleRead.h SingleReadQ.h PairedEndRead.h PairedEndReadQ.h SingleHit.h PairedEndHit.h Transcripts.h +- +- + rsem-parse-alignments : parseIt.o sam/libbam.a + $(CC) -o rsem-parse-alignments parseIt.o sam/libbam.a -lz -lpthread + +-parseIt.o : utils.h GroupInfo.h Read.h SingleRead.h SingleReadQ.h PairedEndRead.h PairedEndReadQ.h SingleHit.h PairedEndHit.h HitContainer.h SamParser.h Transcripts.h sam/sam.h sam/bam.h parseIt.cpp ++parseIt.o : parseIt.cpp + $(CC) -Wall -O2 -c -I. parseIt.cpp + +- +-rsem-build-read-index : utils.h buildReadIndex.cpp ++rsem-build-read-index : buildReadIndex.cpp + $(CC) -O3 buildReadIndex.cpp -o rsem-build-read-index + +- +-simul.h : boost/random.hpp +- +-ReadReader.h : SingleRead.h SingleReadQ.h PairedEndRead.h PairedEndReadQ.h ReadIndex.h +- +-SingleModel.h : utils.h my_assert.h Orientation.h LenDist.h RSPD.h Profile.h NoiseProfile.h ModelParams.h RefSeq.h Refs.h SingleRead.h SingleHit.h ReadReader.h simul.h +- +-SingleQModel.h : utils.h my_assert.h Orientation.h LenDist.h RSPD.h QualDist.h QProfile.h NoiseQProfile.h ModelParams.h RefSeq.h Refs.h SingleReadQ.h SingleHit.h ReadReader.h simul.h +- +-PairedEndModel.h : utils.h my_assert.h Orientation.h LenDist.h RSPD.h Profile.h NoiseProfile.h ModelParams.h RefSeq.h Refs.h SingleRead.h PairedEndRead.h PairedEndHit.h ReadReader.h simul.h +- +-PairedEndQModel.h : utils.h my_assert.h Orientation.h LenDist.h RSPD.h QualDist.h QProfile.h NoiseQProfile.h ModelParams.h RefSeq.h Refs.h SingleReadQ.h PairedEndReadQ.h PairedEndHit.h ReadReader.h simul.h +- +-HitWrapper.h : HitContainer.h +- +-sam_rsem_aux.h : sam/bam.h +- +-sam_rsem_cvt.h : sam/bam.h Transcript.h Transcripts.h +- +-BamWriter.h : sam/sam.h sam/bam.h sam_rsem_aux.h sam_rsem_cvt.h SingleHit.h PairedEndHit.h HitWrapper.h Transcript.h Transcripts.h +- +-sampling.h : boost/random.hpp +- +-WriteResults.h : utils.h my_assert.h GroupInfo.h Transcript.h Transcripts.h RefSeq.h Refs.h Model.h SingleModel.h SingleQModel.h PairedEndModel.h PairedEndQModel.h +- + rsem-run-em : EM.o sam/libbam.a + $(CC) -o rsem-run-em EM.o sam/libbam.a -lz -lpthread + +-EM.o : utils.h my_assert.h Read.h SingleRead.h SingleReadQ.h PairedEndRead.h PairedEndReadQ.h SingleHit.h PairedEndHit.h Model.h SingleModel.h SingleQModel.h PairedEndModel.h PairedEndQModel.h Refs.h GroupInfo.h HitContainer.h ReadIndex.h ReadReader.h Orientation.h LenDist.h RSPD.h QualDist.h QProfile.h NoiseQProfile.h ModelParams.h RefSeq.h RefSeqPolicy.h PolyARules.h Profile.h NoiseProfile.h Transcript.h Transcripts.h HitWrapper.h BamWriter.h sam/bam.h sam/sam.h simul.h sam_rsem_aux.h sampling.h boost/random.hpp WriteResults.h EM.cpp ++EM.o : EM.cpp + $(CC) $(COFLAGS) EM.cpp + +-bc_aux.h : sam/bam.h +- +-BamConverter.h : utils.h my_assert.h sam/sam.h sam/bam.h sam_rsem_aux.h sam_rsem_cvt.h bc_aux.h Transcript.h Transcripts.h +- +-rsem-tbam2gbam : utils.h Transcripts.h Transcript.h bc_aux.h BamConverter.h sam/sam.h sam/bam.h sam/libbam.a sam_rsem_aux.h sam_rsem_cvt.h tbam2gbam.cpp sam/libbam.a ++rsem-tbam2gbam : tbam2gbam.cpp sam/libbam.a + $(CC) -O3 -Wall tbam2gbam.cpp sam/libbam.a -lz -lpthread -o $@ + +-rsem-bam2wig : utils.h my_assert.h wiggle.h wiggle.o sam/libbam.a bam2wig.cpp ++rsem-bam2wig : wiggle.o sam/libbam.a bam2wig.cpp + $(CC) -O3 -Wall bam2wig.cpp wiggle.o sam/libbam.a -lz -lpthread -o $@ + +-rsem-bam2readdepth : utils.h my_assert.h wiggle.h wiggle.o sam/libbam.a bam2readdepth.cpp ++rsem-bam2readdepth : wiggle.o sam/libbam.a bam2readdepth.cpp + $(CC) -O3 -Wall bam2readdepth.cpp wiggle.o sam/libbam.a -lz -lpthread -o $@ + +-wiggle.o: sam/bam.h sam/sam.h wiggle.cpp wiggle.h ++wiggle.o: wiggle.cpp + $(CC) $(COFLAGS) wiggle.cpp + + rsem-simulate-reads : simulation.o + $(CC) -o rsem-simulate-reads simulation.o + +-simulation.o : utils.h Read.h SingleRead.h SingleReadQ.h PairedEndRead.h PairedEndReadQ.h Model.h SingleModel.h SingleQModel.h PairedEndModel.h PairedEndQModel.h Refs.h RefSeq.h GroupInfo.h Transcript.h Transcripts.h Orientation.h LenDist.h RSPD.h QualDist.h QProfile.h NoiseQProfile.h Profile.h NoiseProfile.h simul.h boost/random.hpp WriteResults.h simulation.cpp ++simulation.o : simulation.cpp + $(CC) $(COFLAGS) simulation.cpp + + rsem-run-gibbs : Gibbs.o + $(CC) -o rsem-run-gibbs Gibbs.o -lpthread + +-#some header files are omitted +-Gibbs.o : utils.h my_assert.h boost/random.hpp sampling.h Model.h SingleModel.h SingleQModel.h PairedEndModel.h PairedEndQModel.h RefSeq.h RefSeqPolicy.h PolyARules.h Refs.h GroupInfo.h WriteResults.h Gibbs.cpp ++Gibbs.o : Gibbs.cpp + $(CC) $(COFLAGS) Gibbs.cpp + +-Buffer.h : my_assert.h +- + rsem-calculate-credibility-intervals : calcCI.o + $(CC) -o rsem-calculate-credibility-intervals calcCI.o -lpthread + +-#some header files are omitted +-calcCI.o : utils.h my_assert.h boost/random.hpp sampling.h Model.h SingleModel.h SingleQModel.h PairedEndModel.h PairedEndQModel.h RefSeq.h RefSeqPolicy.h PolyARules.h Refs.h GroupInfo.h WriteResults.h Buffer.h calcCI.cpp ++calcCI.o : calcCI.cpp + $(CC) $(COFLAGS) calcCI.cpp + +-rsem-get-unique : sam/bam.h sam/sam.h getUnique.cpp sam/libbam.a ++rsem-get-unique : getUnique.cpp sam/libbam.a + $(CC) -O3 -Wall getUnique.cpp sam/libbam.a -lz -lpthread -o $@ + +-rsem-sam-validator : sam/bam.h sam/sam.h my_assert.h samValidator.cpp sam/libbam.a ++rsem-sam-validator : samValidator.cpp sam/libbam.a + $(CC) -O3 -Wall samValidator.cpp sam/libbam.a -lz -lpthread -o $@ + +-rsem-scan-for-paired-end-reads : sam/bam.h sam/sam.h my_assert.h scanForPairedEndReads.cpp sam/libbam.a ++rsem-scan-for-paired-end-reads : scanForPairedEndReads.cpp sam/libbam.a + $(CC) -O3 -Wall scanForPairedEndReads.cpp sam/libbam.a -lz -lpthread -o $@ + + ebseq : + +From ec136638a727632e20abfaeb65c22c46d15ca8c4 Mon Sep 17 00:00:00 2001 +From: Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de> +Date: Wed, 22 Apr 2015 15:06:41 +0200 +Subject: [PATCH 2/7] include current dir, ./sam and ./boost by default + +--- + Makefile | 48 ++++++++++++++++++++++++------------------------ + 1 file changed, 24 insertions(+), 24 deletions(-) + +diff --git a/Makefile b/Makefile +index 3a55ed8..1dd97ca 100644 +--- a/Makefile ++++ b/Makefile +@@ -1,6 +1,6 @@ + CC = g++ +-CFLAGS = -Wall -c -I. +-COFLAGS = -Wall -O3 -ffast-math -c -I. ++CFLAGS = -Wall -I. -I./sam -I./boost ++COFLAGS = -O3 -ffast-math -c + PROGRAMS = rsem-extract-reference-transcripts rsem-synthesis-reference-transcripts rsem-preref rsem-parse-alignments rsem-build-read-index rsem-run-em rsem-tbam2gbam rsem-run-gibbs rsem-calculate-credibility-intervals rsem-simulate-reads rsem-bam2wig rsem-get-unique rsem-bam2readdepth rsem-sam-validator rsem-scan-for-paired-end-reads + + .PHONY : all ebseq clean +@@ -11,70 +11,70 @@ sam/libbam.a : + cd sam ; ${MAKE} all + + rsem-extract-reference-transcripts : extractRef.cpp +- $(CC) -Wall -O3 extractRef.cpp -o rsem-extract-reference-transcripts ++ $(CC) $(CFLAGS) -O3 extractRef.cpp -o rsem-extract-reference-transcripts + + rsem-synthesis-reference-transcripts : synthesisRef.cpp +- $(CC) -Wall -O3 synthesisRef.cpp -o rsem-synthesis-reference-transcripts ++ $(CC) $(CFLAGS) -O3 synthesisRef.cpp -o rsem-synthesis-reference-transcripts + + rsem-preref : preRef.o +- $(CC) preRef.o -o rsem-preref ++ $(CC) $(CFLAGS) preRef.o -o rsem-preref + + preRef.o : preRef.cpp +- $(CC) $(COFLAGS) preRef.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) preRef.cpp + + rsem-parse-alignments : parseIt.o sam/libbam.a +- $(CC) -o rsem-parse-alignments parseIt.o sam/libbam.a -lz -lpthread ++ $(CC) $(CFLAGS) -o rsem-parse-alignments parseIt.o sam/libbam.a -lz -lpthread + + parseIt.o : parseIt.cpp +- $(CC) -Wall -O2 -c -I. parseIt.cpp ++ $(CC) $(CFLAGS) -O2 -c parseIt.cpp + + rsem-build-read-index : buildReadIndex.cpp +- $(CC) -O3 buildReadIndex.cpp -o rsem-build-read-index ++ $(CC) $(CFLAGS) -O3 buildReadIndex.cpp -o rsem-build-read-index + + rsem-run-em : EM.o sam/libbam.a +- $(CC) -o rsem-run-em EM.o sam/libbam.a -lz -lpthread ++ $(CC) $(CFLAGS) -o rsem-run-em EM.o sam/libbam.a -lz -lpthread + + EM.o : EM.cpp +- $(CC) $(COFLAGS) EM.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) EM.cpp + + rsem-tbam2gbam : tbam2gbam.cpp sam/libbam.a +- $(CC) -O3 -Wall tbam2gbam.cpp sam/libbam.a -lz -lpthread -o $@ ++ $(CC) $(CFLAGS) -O3 tbam2gbam.cpp sam/libbam.a -lz -lpthread -o $@ + + rsem-bam2wig : wiggle.o sam/libbam.a bam2wig.cpp +- $(CC) -O3 -Wall bam2wig.cpp wiggle.o sam/libbam.a -lz -lpthread -o $@ ++ $(CC) $(CFLAGS) -O3 bam2wig.cpp wiggle.o sam/libbam.a -lz -lpthread -o $@ + + rsem-bam2readdepth : wiggle.o sam/libbam.a bam2readdepth.cpp +- $(CC) -O3 -Wall bam2readdepth.cpp wiggle.o sam/libbam.a -lz -lpthread -o $@ ++ $(CC) $(CFLAGS) -O3 bam2readdepth.cpp wiggle.o sam/libbam.a -lz -lpthread -o $@ + + wiggle.o: wiggle.cpp +- $(CC) $(COFLAGS) wiggle.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) wiggle.cpp + + rsem-simulate-reads : simulation.o +- $(CC) -o rsem-simulate-reads simulation.o ++ $(CC) $(CFLAGS) -o rsem-simulate-reads simulation.o + + simulation.o : simulation.cpp +- $(CC) $(COFLAGS) simulation.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) simulation.cpp + + rsem-run-gibbs : Gibbs.o +- $(CC) -o rsem-run-gibbs Gibbs.o -lpthread ++ $(CC) $(CFLAGS) -o rsem-run-gibbs Gibbs.o -lpthread + + Gibbs.o : Gibbs.cpp +- $(CC) $(COFLAGS) Gibbs.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) Gibbs.cpp + + rsem-calculate-credibility-intervals : calcCI.o +- $(CC) -o rsem-calculate-credibility-intervals calcCI.o -lpthread ++ $(CC) $(CFLAGS) -o rsem-calculate-credibility-intervals calcCI.o -lpthread + + calcCI.o : calcCI.cpp +- $(CC) $(COFLAGS) calcCI.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) calcCI.cpp + + rsem-get-unique : getUnique.cpp sam/libbam.a +- $(CC) -O3 -Wall getUnique.cpp sam/libbam.a -lz -lpthread -o $@ ++ $(CC) $(CFLAGS) -O3 getUnique.cpp sam/libbam.a -lz -lpthread -o $@ + + rsem-sam-validator : samValidator.cpp sam/libbam.a +- $(CC) -O3 -Wall samValidator.cpp sam/libbam.a -lz -lpthread -o $@ ++ $(CC) $(CFLAGS) -O3 samValidator.cpp sam/libbam.a -lz -lpthread -o $@ + + rsem-scan-for-paired-end-reads : scanForPairedEndReads.cpp sam/libbam.a +- $(CC) -O3 -Wall scanForPairedEndReads.cpp sam/libbam.a -lz -lpthread -o $@ ++ $(CC) $(CFLAGS) -O3 scanForPairedEndReads.cpp sam/libbam.a -lz -lpthread -o $@ + + ebseq : + cd EBSeq ; ${MAKE} all + +From d366614ea50f79fdd93e3c76383ccb6fcdeaa8e0 Mon Sep 17 00:00:00 2001 +From: Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de> +Date: Wed, 22 Apr 2015 15:10:49 +0200 +Subject: [PATCH 3/7] separate object rules from rules for executables + +--- + Makefile | 50 ++++++++++++++++++++++++++------------------------ + 1 file changed, 26 insertions(+), 24 deletions(-) + +diff --git a/Makefile b/Makefile +index 1dd97ca..ae4de3b 100644 +--- a/Makefile ++++ b/Makefile +@@ -10,6 +10,32 @@ all : $(PROGRAMS) + sam/libbam.a : + cd sam ; ${MAKE} all + ++ebseq : ++ cd EBSeq ; ${MAKE} all ++ ++ ++calcCI.o : calcCI.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) calcCI.cpp ++ ++EM.o : EM.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) EM.cpp ++ ++Gibbs.o : Gibbs.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) Gibbs.cpp ++ ++preRef.o : preRef.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) preRef.cpp ++ ++parseIt.o : parseIt.cpp ++ $(CC) $(CFLAGS) -O2 -c parseIt.cpp ++ ++simulation.o : simulation.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) simulation.cpp ++ ++wiggle.o: wiggle.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) wiggle.cpp ++ ++ + rsem-extract-reference-transcripts : extractRef.cpp + $(CC) $(CFLAGS) -O3 extractRef.cpp -o rsem-extract-reference-transcripts + +@@ -19,24 +45,15 @@ rsem-synthesis-reference-transcripts : synthesisRef.cpp + rsem-preref : preRef.o + $(CC) $(CFLAGS) preRef.o -o rsem-preref + +-preRef.o : preRef.cpp +- $(CC) $(CFLAGS) $(COFLAGS) preRef.cpp +- + rsem-parse-alignments : parseIt.o sam/libbam.a + $(CC) $(CFLAGS) -o rsem-parse-alignments parseIt.o sam/libbam.a -lz -lpthread + +-parseIt.o : parseIt.cpp +- $(CC) $(CFLAGS) -O2 -c parseIt.cpp +- + rsem-build-read-index : buildReadIndex.cpp + $(CC) $(CFLAGS) -O3 buildReadIndex.cpp -o rsem-build-read-index + + rsem-run-em : EM.o sam/libbam.a + $(CC) $(CFLAGS) -o rsem-run-em EM.o sam/libbam.a -lz -lpthread + +-EM.o : EM.cpp +- $(CC) $(CFLAGS) $(COFLAGS) EM.cpp +- + rsem-tbam2gbam : tbam2gbam.cpp sam/libbam.a + $(CC) $(CFLAGS) -O3 tbam2gbam.cpp sam/libbam.a -lz -lpthread -o $@ + +@@ -46,27 +63,15 @@ rsem-bam2wig : wiggle.o sam/libbam.a bam2wig.cpp + rsem-bam2readdepth : wiggle.o sam/libbam.a bam2readdepth.cpp + $(CC) $(CFLAGS) -O3 bam2readdepth.cpp wiggle.o sam/libbam.a -lz -lpthread -o $@ + +-wiggle.o: wiggle.cpp +- $(CC) $(CFLAGS) $(COFLAGS) wiggle.cpp +- + rsem-simulate-reads : simulation.o + $(CC) $(CFLAGS) -o rsem-simulate-reads simulation.o + +-simulation.o : simulation.cpp +- $(CC) $(CFLAGS) $(COFLAGS) simulation.cpp +- + rsem-run-gibbs : Gibbs.o + $(CC) $(CFLAGS) -o rsem-run-gibbs Gibbs.o -lpthread + +-Gibbs.o : Gibbs.cpp +- $(CC) $(CFLAGS) $(COFLAGS) Gibbs.cpp +- + rsem-calculate-credibility-intervals : calcCI.o + $(CC) $(CFLAGS) -o rsem-calculate-credibility-intervals calcCI.o -lpthread + +-calcCI.o : calcCI.cpp +- $(CC) $(CFLAGS) $(COFLAGS) calcCI.cpp +- + rsem-get-unique : getUnique.cpp sam/libbam.a + $(CC) $(CFLAGS) -O3 getUnique.cpp sam/libbam.a -lz -lpthread -o $@ + +@@ -76,9 +81,6 @@ rsem-sam-validator : samValidator.cpp sam/libbam.a + rsem-scan-for-paired-end-reads : scanForPairedEndReads.cpp sam/libbam.a + $(CC) $(CFLAGS) -O3 scanForPairedEndReads.cpp sam/libbam.a -lz -lpthread -o $@ + +-ebseq : +- cd EBSeq ; ${MAKE} all +- + clean : + rm -f *.o *~ $(PROGRAMS) + cd sam ; ${MAKE} clean + +From 6ba1c33cccdf7c8e7df7a3189e7db204be3b1e8d Mon Sep 17 00:00:00 2001 +From: Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de> +Date: Wed, 22 Apr 2015 15:28:30 +0200 +Subject: [PATCH 4/7] add ./sam to library directories, link with -lbam + +--- + Makefile | 36 ++++++++++++++++++------------------ + 1 file changed, 18 insertions(+), 18 deletions(-) + +diff --git a/Makefile b/Makefile +index ae4de3b..a87cc4d 100644 +--- a/Makefile ++++ b/Makefile +@@ -1,11 +1,11 @@ + CC = g++ +-CFLAGS = -Wall -I. -I./sam -I./boost ++CFLAGS = -Wall -I. -I./sam -I./boost -L./sam + COFLAGS = -O3 -ffast-math -c + PROGRAMS = rsem-extract-reference-transcripts rsem-synthesis-reference-transcripts rsem-preref rsem-parse-alignments rsem-build-read-index rsem-run-em rsem-tbam2gbam rsem-run-gibbs rsem-calculate-credibility-intervals rsem-simulate-reads rsem-bam2wig rsem-get-unique rsem-bam2readdepth rsem-sam-validator rsem-scan-for-paired-end-reads + + .PHONY : all ebseq clean + +-all : $(PROGRAMS) ++all : sam/libbam.a $(PROGRAMS) + + sam/libbam.a : + cd sam ; ${MAKE} all +@@ -45,23 +45,23 @@ rsem-synthesis-reference-transcripts : synthesisRef.cpp + rsem-preref : preRef.o + $(CC) $(CFLAGS) preRef.o -o rsem-preref + +-rsem-parse-alignments : parseIt.o sam/libbam.a +- $(CC) $(CFLAGS) -o rsem-parse-alignments parseIt.o sam/libbam.a -lz -lpthread ++rsem-parse-alignments : parseIt.o ++ $(CC) $(CFLAGS) -o rsem-parse-alignments parseIt.o -lbam -lz -lpthread + + rsem-build-read-index : buildReadIndex.cpp + $(CC) $(CFLAGS) -O3 buildReadIndex.cpp -o rsem-build-read-index + +-rsem-run-em : EM.o sam/libbam.a +- $(CC) $(CFLAGS) -o rsem-run-em EM.o sam/libbam.a -lz -lpthread ++rsem-run-em : EM.o ++ $(CC) $(CFLAGS) -o rsem-run-em EM.o -lbam -lz -lpthread + +-rsem-tbam2gbam : tbam2gbam.cpp sam/libbam.a +- $(CC) $(CFLAGS) -O3 tbam2gbam.cpp sam/libbam.a -lz -lpthread -o $@ ++rsem-tbam2gbam : tbam2gbam.cpp ++ $(CC) $(CFLAGS) -O3 tbam2gbam.cpp -lbam -lz -lpthread -o $@ + +-rsem-bam2wig : wiggle.o sam/libbam.a bam2wig.cpp +- $(CC) $(CFLAGS) -O3 bam2wig.cpp wiggle.o sam/libbam.a -lz -lpthread -o $@ ++rsem-bam2wig : wiggle.o bam2wig.cpp ++ $(CC) $(CFLAGS) -O3 bam2wig.cpp wiggle.o -lbam -lz -lpthread -o $@ + +-rsem-bam2readdepth : wiggle.o sam/libbam.a bam2readdepth.cpp +- $(CC) $(CFLAGS) -O3 bam2readdepth.cpp wiggle.o sam/libbam.a -lz -lpthread -o $@ ++rsem-bam2readdepth : wiggle.o bam2readdepth.cpp ++ $(CC) $(CFLAGS) -O3 bam2readdepth.cpp wiggle.o -lbam -lz -lpthread -o $@ + + rsem-simulate-reads : simulation.o + $(CC) $(CFLAGS) -o rsem-simulate-reads simulation.o +@@ -72,14 +72,14 @@ rsem-run-gibbs : Gibbs.o + rsem-calculate-credibility-intervals : calcCI.o + $(CC) $(CFLAGS) -o rsem-calculate-credibility-intervals calcCI.o -lpthread + +-rsem-get-unique : getUnique.cpp sam/libbam.a +- $(CC) $(CFLAGS) -O3 getUnique.cpp sam/libbam.a -lz -lpthread -o $@ ++rsem-get-unique : getUnique.cpp ++ $(CC) $(CFLAGS) -O3 getUnique.cpp -lbam -lz -lpthread -o $@ + +-rsem-sam-validator : samValidator.cpp sam/libbam.a +- $(CC) $(CFLAGS) -O3 samValidator.cpp sam/libbam.a -lz -lpthread -o $@ ++rsem-sam-validator : samValidator.cpp ++ $(CC) $(CFLAGS) -O3 samValidator.cpp -lbam -lz -lpthread -o $@ + +-rsem-scan-for-paired-end-reads : scanForPairedEndReads.cpp sam/libbam.a +- $(CC) $(CFLAGS) -O3 scanForPairedEndReads.cpp sam/libbam.a -lz -lpthread -o $@ ++rsem-scan-for-paired-end-reads : scanForPairedEndReads.cpp ++ $(CC) $(CFLAGS) -O3 scanForPairedEndReads.cpp -lbam -lz -lpthread -o $@ + + clean : + rm -f *.o *~ $(PROGRAMS) + +From 5402b88c269df79ee245c1c59e15f3c8282a0220 Mon Sep 17 00:00:00 2001 +From: Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de> +Date: Wed, 22 Apr 2015 15:33:02 +0200 +Subject: [PATCH 5/7] do not repeat target name, use $@ instead + +--- + Makefile | 18 +++++++++--------- + 1 file changed, 9 insertions(+), 9 deletions(-) + +diff --git a/Makefile b/Makefile +index a87cc4d..7ec90a3 100644 +--- a/Makefile ++++ b/Makefile +@@ -37,22 +37,22 @@ wiggle.o: wiggle.cpp + + + rsem-extract-reference-transcripts : extractRef.cpp +- $(CC) $(CFLAGS) -O3 extractRef.cpp -o rsem-extract-reference-transcripts ++ $(CC) $(CFLAGS) -O3 extractRef.cpp -o $@ + + rsem-synthesis-reference-transcripts : synthesisRef.cpp +- $(CC) $(CFLAGS) -O3 synthesisRef.cpp -o rsem-synthesis-reference-transcripts ++ $(CC) $(CFLAGS) -O3 synthesisRef.cpp -o $@ + + rsem-preref : preRef.o +- $(CC) $(CFLAGS) preRef.o -o rsem-preref ++ $(CC) $(CFLAGS) preRef.o -o $@ + + rsem-parse-alignments : parseIt.o +- $(CC) $(CFLAGS) -o rsem-parse-alignments parseIt.o -lbam -lz -lpthread ++ $(CC) $(CFLAGS) -o $@ parseIt.o -lbam -lz -lpthread + + rsem-build-read-index : buildReadIndex.cpp +- $(CC) $(CFLAGS) -O3 buildReadIndex.cpp -o rsem-build-read-index ++ $(CC) $(CFLAGS) -O3 buildReadIndex.cpp -o $@ + + rsem-run-em : EM.o +- $(CC) $(CFLAGS) -o rsem-run-em EM.o -lbam -lz -lpthread ++ $(CC) $(CFLAGS) -o $@ EM.o -lbam -lz -lpthread + + rsem-tbam2gbam : tbam2gbam.cpp + $(CC) $(CFLAGS) -O3 tbam2gbam.cpp -lbam -lz -lpthread -o $@ +@@ -64,13 +64,13 @@ rsem-bam2readdepth : wiggle.o bam2readdepth.cpp + $(CC) $(CFLAGS) -O3 bam2readdepth.cpp wiggle.o -lbam -lz -lpthread -o $@ + + rsem-simulate-reads : simulation.o +- $(CC) $(CFLAGS) -o rsem-simulate-reads simulation.o ++ $(CC) $(CFLAGS) -o $@ simulation.o + + rsem-run-gibbs : Gibbs.o +- $(CC) $(CFLAGS) -o rsem-run-gibbs Gibbs.o -lpthread ++ $(CC) $(CFLAGS) -o $@ Gibbs.o -lpthread + + rsem-calculate-credibility-intervals : calcCI.o +- $(CC) $(CFLAGS) -o rsem-calculate-credibility-intervals calcCI.o -lpthread ++ $(CC) $(CFLAGS) -o $@ calcCI.o -lpthread + + rsem-get-unique : getUnique.cpp + $(CC) $(CFLAGS) -O3 getUnique.cpp -lbam -lz -lpthread -o $@ + +From f60784bc7aa303cc825bd87dd3f5d7d26c51bded Mon Sep 17 00:00:00 2001 +From: Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de> +Date: Wed, 22 Apr 2015 15:44:53 +0200 +Subject: [PATCH 6/7] use automatic variables to refer to prerequisites + +--- + Makefile | 44 ++++++++++++++++++++++---------------------- + 1 file changed, 22 insertions(+), 22 deletions(-) + +diff --git a/Makefile b/Makefile +index 7ec90a3..6540d81 100644 +--- a/Makefile ++++ b/Makefile +@@ -15,71 +15,71 @@ ebseq : + + + calcCI.o : calcCI.cpp +- $(CC) $(CFLAGS) $(COFLAGS) calcCI.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) $< + + EM.o : EM.cpp +- $(CC) $(CFLAGS) $(COFLAGS) EM.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) $< + + Gibbs.o : Gibbs.cpp +- $(CC) $(CFLAGS) $(COFLAGS) Gibbs.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) $< + + preRef.o : preRef.cpp +- $(CC) $(CFLAGS) $(COFLAGS) preRef.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) $< + + parseIt.o : parseIt.cpp +- $(CC) $(CFLAGS) -O2 -c parseIt.cpp ++ $(CC) $(CFLAGS) -O2 -c $< + + simulation.o : simulation.cpp +- $(CC) $(CFLAGS) $(COFLAGS) simulation.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) $< + + wiggle.o: wiggle.cpp +- $(CC) $(CFLAGS) $(COFLAGS) wiggle.cpp ++ $(CC) $(CFLAGS) $(COFLAGS) $< + + + rsem-extract-reference-transcripts : extractRef.cpp +- $(CC) $(CFLAGS) -O3 extractRef.cpp -o $@ ++ $(CC) $(CFLAGS) -O3 $< -o $@ + + rsem-synthesis-reference-transcripts : synthesisRef.cpp +- $(CC) $(CFLAGS) -O3 synthesisRef.cpp -o $@ ++ $(CC) $(CFLAGS) -O3 $< -o $@ + + rsem-preref : preRef.o +- $(CC) $(CFLAGS) preRef.o -o $@ ++ $(CC) $(CFLAGS) $< -o $@ + + rsem-parse-alignments : parseIt.o +- $(CC) $(CFLAGS) -o $@ parseIt.o -lbam -lz -lpthread ++ $(CC) $(CFLAGS) -o $@ $< -lbam -lz -lpthread + + rsem-build-read-index : buildReadIndex.cpp +- $(CC) $(CFLAGS) -O3 buildReadIndex.cpp -o $@ ++ $(CC) $(CFLAGS) -O3 $< -o $@ + + rsem-run-em : EM.o +- $(CC) $(CFLAGS) -o $@ EM.o -lbam -lz -lpthread ++ $(CC) $(CFLAGS) -o $@ $< -lbam -lz -lpthread + + rsem-tbam2gbam : tbam2gbam.cpp +- $(CC) $(CFLAGS) -O3 tbam2gbam.cpp -lbam -lz -lpthread -o $@ ++ $(CC) $(CFLAGS) -O3 $< -lbam -lz -lpthread -o $@ + + rsem-bam2wig : wiggle.o bam2wig.cpp +- $(CC) $(CFLAGS) -O3 bam2wig.cpp wiggle.o -lbam -lz -lpthread -o $@ ++ $(CC) $(CFLAGS) -O3 $^ -lbam -lz -lpthread -o $@ + + rsem-bam2readdepth : wiggle.o bam2readdepth.cpp +- $(CC) $(CFLAGS) -O3 bam2readdepth.cpp wiggle.o -lbam -lz -lpthread -o $@ ++ $(CC) $(CFLAGS) -O3 $^ -lbam -lz -lpthread -o $@ + + rsem-simulate-reads : simulation.o +- $(CC) $(CFLAGS) -o $@ simulation.o ++ $(CC) $(CFLAGS) -o $@ $< + + rsem-run-gibbs : Gibbs.o +- $(CC) $(CFLAGS) -o $@ Gibbs.o -lpthread ++ $(CC) $(CFLAGS) -o $@ $< -lpthread + + rsem-calculate-credibility-intervals : calcCI.o +- $(CC) $(CFLAGS) -o $@ calcCI.o -lpthread ++ $(CC) $(CFLAGS) -o $@ $< -lpthread + + rsem-get-unique : getUnique.cpp +- $(CC) $(CFLAGS) -O3 getUnique.cpp -lbam -lz -lpthread -o $@ ++ $(CC) $(CFLAGS) -O3 $< -lbam -lz -lpthread -o $@ + + rsem-sam-validator : samValidator.cpp +- $(CC) $(CFLAGS) -O3 samValidator.cpp -lbam -lz -lpthread -o $@ ++ $(CC) $(CFLAGS) -O3 $< -lbam -lz -lpthread -o $@ + + rsem-scan-for-paired-end-reads : scanForPairedEndReads.cpp +- $(CC) $(CFLAGS) -O3 scanForPairedEndReads.cpp -lbam -lz -lpthread -o $@ ++ $(CC) $(CFLAGS) -O3 $< -lbam -lz -lpthread -o $@ + + clean : + rm -f *.o *~ $(PROGRAMS) + +From 0cf9721077f67fb4ca15fdc59cbfbf24a944debd Mon Sep 17 00:00:00 2001 +From: Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de> +Date: Wed, 22 Apr 2015 15:49:19 +0200 +Subject: [PATCH 7/7] split long line + +--- + Makefile | 17 ++++++++++++++++- + 1 file changed, 16 insertions(+), 1 deletion(-) + +diff --git a/Makefile b/Makefile +index 6540d81..0ab04a5 100644 +--- a/Makefile ++++ b/Makefile +@@ -1,7 +1,22 @@ + CC = g++ + CFLAGS = -Wall -I. -I./sam -I./boost -L./sam + COFLAGS = -O3 -ffast-math -c +-PROGRAMS = rsem-extract-reference-transcripts rsem-synthesis-reference-transcripts rsem-preref rsem-parse-alignments rsem-build-read-index rsem-run-em rsem-tbam2gbam rsem-run-gibbs rsem-calculate-credibility-intervals rsem-simulate-reads rsem-bam2wig rsem-get-unique rsem-bam2readdepth rsem-sam-validator rsem-scan-for-paired-end-reads ++PROGRAMS = \ ++ rsem-extract-reference-transcripts \ ++ rsem-synthesis-reference-transcripts \ ++ rsem-preref \ ++ rsem-parse-alignments \ ++ rsem-build-read-index \ ++ rsem-run-em \ ++ rsem-tbam2gbam \ ++ rsem-run-gibbs \ ++ rsem-calculate-credibility-intervals \ ++ rsem-simulate-reads \ ++ rsem-bam2wig \ ++ rsem-get-unique \ ++ rsem-bam2readdepth \ ++ rsem-sam-validator \ ++ rsem-scan-for-paired-end-reads + + .PHONY : all ebseq clean + diff --git a/gnu/packages/patches/serf-comment-style-fix.patch b/gnu/packages/patches/serf-comment-style-fix.patch new file mode 100644 index 0000000000..5d336fb3c8 --- /dev/null +++ b/gnu/packages/patches/serf-comment-style-fix.patch @@ -0,0 +1,23 @@ +r2443 | andreas.stieger@gmx.de | 2014-10-21 17:42:56 -0400 (Tue, 21 Oct 2014) | 7 lines + +Follow-up to r2419: Correct comment style + +* test/test_buckets.c + (deflate_compress): Correct comment style not supported by strict + compilers, fails on /branches/1.3.x + +Index: test/test_buckets.c +=================================================================== +--- test/test_buckets.c (revision 2442) ++++ test/test_buckets.c (revision 2443) +@@ -1323,9 +1323,9 @@ + + /* The largest buffer we should need is 0.1% larger than the + uncompressed data, + 12 bytes. This info comes from zlib.h. ++ buf_size = orig_len + (orig_len / 1000) + 12; + Note: This isn't sufficient when using Z_NO_FLUSH and extremely compressed + data. Use a buffer bigger than what we need. */ +-// buf_size = orig_len + (orig_len / 1000) + 12; + buf_size = 100000; + + write_buf = apr_palloc(pool, buf_size); diff --git a/gnu/packages/patches/serf-deflate-buckets-test-fix.patch b/gnu/packages/patches/serf-deflate-buckets-test-fix.patch new file mode 100644 index 0000000000..be8be1b1e8 --- /dev/null +++ b/gnu/packages/patches/serf-deflate-buckets-test-fix.patch @@ -0,0 +1,69 @@ +r2445 | chemodax | 2014-10-23 12:15:22 -0400 (Thu, 23 Oct 2014) | 6 lines + +Reduce memory usage by deflate buckets test. + +* test/test_buckets.c + (deflate_buckets): Add POOL argument and use it instead of tb->pool. + (test_deflate_buckets): Use iterpool for deflate_buckets() call. + +Index: test/test_buckets.c +=================================================================== +--- test/test_buckets.c (revision 2444) ++++ test/test_buckets.c (revision 2445) +@@ -1400,12 +1400,12 @@ + expected_len); + } + +-static void deflate_buckets(CuTest *tc, int nr_of_loops) ++static void deflate_buckets(CuTest *tc, int nr_of_loops, apr_pool_t *pool) + { + const char *msg = "12345678901234567890123456789012345678901234567890"; + + test_baton_t *tb = tc->testBaton; +- serf_bucket_alloc_t *alloc = serf_bucket_allocator_create(tb->pool, NULL, ++ serf_bucket_alloc_t *alloc = serf_bucket_allocator_create(pool, NULL, + NULL); + z_stream zdestr; + int i; +@@ -1424,8 +1424,8 @@ + { + serf_config_t *config; + +- serf_context_t *ctx = serf_context_create(tb->pool); +- /* status = */ serf__config_store_get_config(ctx, NULL, &config, tb->pool); ++ serf_context_t *ctx = serf_context_create(pool); ++ /* status = */ serf__config_store_get_config(ctx, NULL, &config, pool); + + serf_bucket_set_config(defbkt, config); + } +@@ -1447,11 +1447,11 @@ + if (i == nr_of_loops - 1) { + CuAssertIntEquals(tc, APR_SUCCESS, + deflate_compress(&data, &len, &zdestr, msg, +- strlen(msg), 1, tb->pool)); ++ strlen(msg), 1, pool)); + } else { + CuAssertIntEquals(tc, APR_SUCCESS, + deflate_compress(&data, &len, &zdestr, msg, +- strlen(msg), 0, tb->pool)); ++ strlen(msg), 0, pool)); + } + + if (len == 0) +@@ -1469,10 +1469,15 @@ + static void test_deflate_buckets(CuTest *tc) + { + int i; ++ apr_pool_t *iterpool; ++ test_baton_t *tb = tc->testBaton; + ++ apr_pool_create(&iterpool, tb->pool); + for (i = 1; i < 1000; i++) { +- deflate_buckets(tc, i); ++ apr_pool_clear(iterpool); ++ deflate_buckets(tc, i, iterpool); + } ++ apr_pool_destroy(iterpool); + } + + static apr_status_t discard_data(serf_bucket_t *bkt, diff --git a/gnu/packages/patches/subversion-sqlite-3.8.9-fix.patch b/gnu/packages/patches/subversion-sqlite-3.8.9-fix.patch new file mode 100644 index 0000000000..92d8a85c8f --- /dev/null +++ b/gnu/packages/patches/subversion-sqlite-3.8.9-fix.patch @@ -0,0 +1,59 @@ +This upstream patch (r1672295) is needed to fix a test failure when built +against sqlite 3.8.9. See: + + https://mail-archives.apache.org/mod_mbox/subversion-dev/201504.mbox/%3C5526D197.6020808@gmx.de%3E + + +r1672295 | rhuijben | 2015-04-09 07:31:12 -0400 (Thu, 09 Apr 2015) | 15 lines + +Optimize STMT_SELECT_EXTERNALS_DEFINED when using Sqlite 3.8.9, by +adding two more rows to the sqlite_stat1 table. + +This fixes a test failure in wc-queries-test.c, but actual users most +likely don't notice a difference as a tablescan on an EXTERNALS tables +index is not that expensive, given that most working copies don't have +many externals. + +* subversion/libsvn_wc/wc-metadata.sql + (STMT_INSTALL_SCHEMA_STATISTICS): Add two rows. + +* subversion/tests/libsvn_wc/wc-queries-test.c + (test_schema_statistics): Add a dummy externals row to allow + verifying schema. + +Index: subversion/tests/libsvn_wc/wc-queries-test.c +=================================================================== +--- subversion/tests/libsvn_wc/wc-queries-test.c (revision 1672294) ++++ subversion/tests/libsvn_wc/wc-queries-test.c (revision 1672295) +@@ -927,6 +927,15 @@ + "VALUES (1, '', '')", + NULL, NULL, NULL)); + ++ SQLITE_ERR( ++ sqlite3_exec(sdb, ++ "INSERT INTO EXTERNALS (wc_id, local_relpath," ++ " parent_relpath, repos_id," ++ " presence, kind, def_local_relpath," ++ " def_repos_relpath) " ++ "VALUES (1, 'subdir', '', 1, 'normal', 'dir', '', '')", ++ NULL, NULL, NULL)); ++ + /* These are currently not necessary for query optimization, but it's better + to tell Sqlite how we intend to use this table anyway */ + SQLITE_ERR( +Index: subversion/libsvn_wc/wc-metadata.sql +=================================================================== +--- subversion/libsvn_wc/wc-metadata.sql (revision 1672294) ++++ subversion/libsvn_wc/wc-metadata.sql (revision 1672295) +@@ -619,6 +619,11 @@ + INSERT OR REPLACE INTO sqlite_stat1(tbl, idx, stat) VALUES + ('WC_LOCK', 'sqlite_autoindex_WC_LOCK_1', '100 100 1'); + ++INSERT OR REPLACE INTO sqlite_stat1(tbl, idx, stat) VALUES ++ ('EXTERNALS','sqlite_autoindex_EXTERNALS_1', '100 100 1'); ++INSERT OR REPLACE INTO sqlite_stat1(tbl, idx, stat) VALUES ++ ('EXTERNALS','I_EXTERNALS_DEFINED', '100 100 3 1'); ++ + /* sqlite_autoindex_WORK_QUEUE_1 doesn't exist because WORK_QUEUE is + a INTEGER PRIMARY KEY AUTOINCREMENT table */ + diff --git a/gnu/packages/patches/tvtime-gcc41.patch b/gnu/packages/patches/tvtime-gcc41.patch new file mode 100644 index 0000000000..d6e42721b8 --- /dev/null +++ b/gnu/packages/patches/tvtime-gcc41.patch @@ -0,0 +1,58 @@ +Source: https://projects.archlinux.org/svntogit/community.git/tree/trunk/tvtime-1.0.2-gcc41.patch?h=packages/tvtime + +--- tvtime-1.0.1/plugins/greedyh.asm 2005-08-14 18:16:43.000000000 +0200 ++++ tvtime-1.0.1-gcc41/plugins/greedyh.asm 2005-11-28 17:53:09.210774544 +0100 +@@ -18,7 +18,7 @@ + + #include "x86-64_macros.inc" + +-void DScalerFilterGreedyH::FUNCT_NAME(TDeinterlaceInfo* pInfo) ++void FUNCT_NAME(TDeinterlaceInfo* pInfo) + { + int64_t i; + bool InfoIsOdd = (pInfo->PictureHistory[0]->Flags & PICTURE_INTERLACED_ODD) ? 1 : 0; +diff -Naur tvtime-1.0.1/plugins/tomsmocomp/TomsMoCompAll2.inc tvtime-1.0.1-gcc41/plugins/tomsmocomp/TomsMoCompAll2.inc +--- tvtime-1.0.1/plugins/tomsmocomp/TomsMoCompAll2.inc 2004-10-20 17:31:05.000000000 +0200 ++++ tvtime-1.0.1-gcc41/plugins/tomsmocomp/TomsMoCompAll2.inc 2005-11-28 17:53:33.251119856 +0100 +@@ -5,9 +5,9 @@ + #endif + + #ifdef USE_STRANGE_BOB +-#define SEARCH_EFFORT_FUNC(n) DScalerFilterTomsMoComp::SEFUNC(n##_SB) ++#define SEARCH_EFFORT_FUNC(n) SEFUNC(n##_SB) + #else +-#define SEARCH_EFFORT_FUNC(n) DScalerFilterTomsMoComp::SEFUNC(n) ++#define SEARCH_EFFORT_FUNC(n) SEFUNC(n) + #endif + + int SEARCH_EFFORT_FUNC(0) // we don't try at all ;-) +diff -Naur tvtime-1.0.1/plugins/tomsmocomp.cpp tvtime-1.0.1-gcc41/plugins/tomsmocomp.cpp +--- tvtime-1.0.1/plugins/tomsmocomp.cpp 2004-10-20 19:38:04.000000000 +0200 ++++ tvtime-1.0.1-gcc41/plugins/tomsmocomp.cpp 2005-11-28 17:52:53.862107896 +0100 +@@ -31,7 +31,7 @@ + + #define IS_MMX + #define SSE_TYPE MMX +-#define FUNCT_NAME DScalerFilterTomsMoComp::filterDScaler_MMX ++#define FUNCT_NAME filterDScaler_MMX + #include "tomsmocomp/TomsMoCompAll.inc" + #undef IS_MMX + #undef SSE_TYPE +@@ -39,7 +39,7 @@ + + #define IS_3DNOW + #define SSE_TYPE 3DNOW +-#define FUNCT_NAME DScalerFilterTomsMoComp::filterDScaler_3DNOW ++#define FUNCT_NAME filterDScaler_3DNOW + #include "tomsmocomp/TomsMoCompAll.inc" + #undef IS_3DNOW + #undef SSE_TYPE +@@ -47,7 +47,7 @@ + + #define IS_SSE + #define SSE_TYPE SSE +-#define FUNCT_NAME DScalerFilterTomsMoComp::filterDScaler_SSE ++#define FUNCT_NAME filterDScaler_SSE + #include "tomsmocomp/TomsMoCompAll.inc" + #undef IS_SSE + #undef SSE_TYPE diff --git a/gnu/packages/patches/tvtime-pngoutput.patch b/gnu/packages/patches/tvtime-pngoutput.patch new file mode 100644 index 0000000000..0d14f77ca1 --- /dev/null +++ b/gnu/packages/patches/tvtime-pngoutput.patch @@ -0,0 +1,15 @@ +Source: https://sources.debian.net/src/tvtime/1.0.2-14/debian/patches/libpng.diff + +From: Nobuhiro Iwamatsu <iwamatsu@nigauri.org> +Date: Mon, 14 May 2012 19:01:31 +0900 +Prepares the package for libpng 1.5. Closes: #650582. + +--- tvtime-1.0.2.orig/src/pngoutput.c ++++ tvtime-1.0.2/src/pngoutput.c +@@ -18,5 +18,6 @@ + + #include <stdio.h> + #include <stdlib.h> ++#include <zlib.h> + #include <png.h> + #include "pngoutput.h" diff --git a/gnu/packages/patches/tvtime-videodev2.patch b/gnu/packages/patches/tvtime-videodev2.patch new file mode 100644 index 0000000000..74131f25d0 --- /dev/null +++ b/gnu/packages/patches/tvtime-videodev2.patch @@ -0,0 +1,15 @@ +Fix compilation error: non-existing header file. + +This is an excerpt from the debian patch: +http://http.debian.net/debian/pool/main/t/tvtime/tvtime_1.0.2-14.diff.gz + +--- tvtime-1.0.2.orig/src/videodev2.h ++++ tvtime-1.0.2/src/videodev2.h +@@ -16,7 +16,6 @@ + #ifdef __KERNEL__ + #include <linux/time.h> /* need struct timeval */ + #endif +-#include <linux/compiler.h> /* need __user */ + + /* for kernel versions 2.4.26 and below: */ + #ifndef __user diff --git a/gnu/packages/patches/tvtime-xmltv.patch b/gnu/packages/patches/tvtime-xmltv.patch new file mode 100644 index 0000000000..2f4afc6e5a --- /dev/null +++ b/gnu/packages/patches/tvtime-xmltv.patch @@ -0,0 +1,28 @@ +Fix compilation error: conflicting types for 'locale_t'. + +This is an excerpt from the debian patch ... +http://http.debian.net/debian/pool/main/t/tvtime/tvtime_1.0.2-14.diff.gz + +--- tvtime-1.0.2.orig/src/xmltv.c ++++ tvtime-1.0.2/src/xmltv.c +@@ -118,9 +118,9 @@ + typedef struct { + const char *code; + const char *name; +-} locale_t; ++} tvtime_locale_t; + +-static locale_t locale_table[] = { ++static tvtime_locale_t locale_table[] = { + {"AA", "Afar"}, {"AB", "Abkhazian"}, {"AF", "Afrikaans"}, + {"AM", "Amharic"}, {"AR", "Arabic"}, {"AS", "Assamese"}, + {"AY", "Aymara"}, {"AZ", "Azerbaijani"}, {"BA", "Bashkir"}, +@@ -168,7 +168,7 @@ + {"XH", "Xhosa"}, {"YO", "Yoruba"}, {"ZH", "Chinese"}, + {"ZU", "Zulu"} }; + +-const int num_locales = sizeof( locale_table ) / sizeof( locale_t ); ++const int num_locales = sizeof( locale_table ) / sizeof( tvtime_locale_t ); + + /** + * Timezone parsing code based loosely on the algorithm in diff --git a/gnu/packages/patches/udev-gir-libtool.patch b/gnu/packages/patches/udev-gir-libtool.patch deleted file mode 100644 index 7504f87eb8..0000000000 --- a/gnu/packages/patches/udev-gir-libtool.patch +++ /dev/null @@ -1,17 +0,0 @@ -Without this patch, 'ld' as invoked by 'g-ir-scanner' fails to find -lgudev-1.0 -This is because libtool puts it in $(top_builddir)/.libs. - -This patch forces 'g-ir-scanner' to use libtool, which enables it to find -libgudev-1.0.la. - ---- udev-182/Makefile.in 2014-06-22 14:55:07.000000000 +0200 -+++ udev-182/Makefile.in 2014-06-22 14:55:15.000000000 +0200 -@@ -3622,7 +3622,7 @@ test-sys-distclean: - @ENABLE_GUDEV_TRUE@@ENABLE_INTROSPECTION_TRUE@ --namespace GUdev \ - @ENABLE_GUDEV_TRUE@@ENABLE_INTROSPECTION_TRUE@ --nsversion=1.0 \ - @ENABLE_GUDEV_TRUE@@ENABLE_INTROSPECTION_TRUE@ --include=GObject-2.0 \ --@ENABLE_GUDEV_TRUE@@ENABLE_INTROSPECTION_TRUE@ --library=gudev-1.0 \ -+@ENABLE_GUDEV_TRUE@@ENABLE_INTROSPECTION_TRUE@ --library=gudev-1.0 --libtool=$(top_builddir)/libtool \ - @ENABLE_GUDEV_TRUE@@ENABLE_INTROSPECTION_TRUE@ --library-path=$(top_builddir)/src \ - @ENABLE_GUDEV_TRUE@@ENABLE_INTROSPECTION_TRUE@ --library-path=$(top_builddir)/src/gudev \ - @ENABLE_GUDEV_TRUE@@ENABLE_INTROSPECTION_TRUE@ --output $@ \ diff --git a/gnu/packages/patches/wicd-template-instantiation.patch b/gnu/packages/patches/wicd-template-instantiation.patch new file mode 100644 index 0000000000..16d8fa6e1d --- /dev/null +++ b/gnu/packages/patches/wicd-template-instantiation.patch @@ -0,0 +1,29 @@ +Wicd 1.7.3 fails to instantiate template lines that have several +variable references. For instance, the line: + + wep_key$_KEY_INDEX=$_KEY + +which is found in in the 'wep-hex' template, expands to these two +lines: + + wep_key0=$_KEY + wep_key0=123456789ab + +This patch fixes that by only emitting the fully substituted line. + +Patch by Ludovic Courtès <ludo@gnu.org>. + +--- a/wicd/misc.py 2012-11-17 00:07:08 +0000 ++++ b/wicd/misc.py 2015-05-09 11:22:37 +0000 +@@ -321,11 +321,11 @@ def ParseEncryption(network): + rep_val = '0' + if rep_val: + line = line.replace("$_%s" % cur_val, str(rep_val)) +- config_file = ''.join([config_file, line]) + else: + print "Ignoring template line: '%s'" % line + else: + print "Weird parsing error occurred" ++ config_file = ''.join([config_file, line]) + else: # Just a regular entry. + config_file = ''.join([config_file, line]) diff --git a/gnu/packages/patches/wpa-supplicant-2015-2-fix.patch b/gnu/packages/patches/wpa-supplicant-2015-2-fix.patch new file mode 100644 index 0000000000..cd097006d2 --- /dev/null +++ b/gnu/packages/patches/wpa-supplicant-2015-2-fix.patch @@ -0,0 +1,51 @@ +Patch copied from http://w1.fi/security/2015-2/ + +From 5acd23f4581da58683f3cf5e36cb71bbe4070bd7 Mon Sep 17 00:00:00 2001 +From: Jouni Malinen <j@w1.fi> +Date: Tue, 28 Apr 2015 17:08:33 +0300 +Subject: [PATCH] WPS: Fix HTTP chunked transfer encoding parser + +strtoul() return value may end up overflowing the int h->chunk_size and +resulting in a negative value to be stored as the chunk_size. This could +result in the following memcpy operation using a very large length +argument which would result in a buffer overflow and segmentation fault. + +This could have been used to cause a denial service by any device that +has been authorized for network access (either wireless or wired). This +would affect both the WPS UPnP functionality in a WPS AP (hostapd with +upnp_iface parameter set in the configuration) and WPS ER +(wpa_supplicant with WPS_ER_START control interface command used). + +Validate the parsed chunk length value to avoid this. In addition to +rejecting negative values, we can also reject chunk size that would be +larger than the maximum configured body length. + +Thanks to Kostya Kortchinsky of Google security team for discovering and +reporting this issue. + +Signed-off-by: Jouni Malinen <j@w1.fi> +--- + src/wps/httpread.c | 7 +++++++ + 1 file changed, 7 insertions(+) + +diff --git a/src/wps/httpread.c b/src/wps/httpread.c +index 2f08f37..d2855e3 100644 +--- a/src/wps/httpread.c ++++ b/src/wps/httpread.c +@@ -533,6 +533,13 @@ static void httpread_read_handler(int sd, void *eloop_ctx, void *sock_ctx) + if (!isxdigit(*cbp)) + goto bad; + h->chunk_size = strtoul(cbp, NULL, 16); ++ if (h->chunk_size < 0 || ++ h->chunk_size > h->max_bytes) { ++ wpa_printf(MSG_DEBUG, ++ "httpread: Invalid chunk size %d", ++ h->chunk_size); ++ goto bad; ++ } + /* throw away chunk header + * so we have only real data + */ +-- +1.9.1 + diff --git a/gnu/packages/patches/wpa-supplicant-2015-3-fix.patch b/gnu/packages/patches/wpa-supplicant-2015-3-fix.patch new file mode 100644 index 0000000000..de042f0c49 --- /dev/null +++ b/gnu/packages/patches/wpa-supplicant-2015-3-fix.patch @@ -0,0 +1,43 @@ +Patch copied from http://w1.fi/security/2015-3/ + +From ef566a4d4f74022e1fdb0a2addfe81e6de9f4aae Mon Sep 17 00:00:00 2001 +From: Jouni Malinen <j@w1.fi> +Date: Wed, 29 Apr 2015 02:21:53 +0300 +Subject: [PATCH] AP WMM: Fix integer underflow in WMM Action frame parser + +The length of the WMM Action frame was not properly validated and the +length of the information elements (int left) could end up being +negative. This would result in reading significantly past the stack +buffer while parsing the IEs in ieee802_11_parse_elems() and while doing +so, resulting in segmentation fault. + +This can result in an invalid frame being used for a denial of service +attack (hostapd process killed) against an AP with a driver that uses +hostapd for management frame processing (e.g., all mac80211-based +drivers). + +Thanks to Kostya Kortchinsky of Google security team for discovering and +reporting this issue. + +Signed-off-by: Jouni Malinen <j@w1.fi> +--- + src/ap/wmm.c | 3 +++ + 1 file changed, 3 insertions(+) + +diff --git a/src/ap/wmm.c b/src/ap/wmm.c +index 6d4177c..314e244 100644 +--- a/src/ap/wmm.c ++++ b/src/ap/wmm.c +@@ -274,6 +274,9 @@ void hostapd_wmm_action(struct hostapd_data *hapd, + return; + } + ++ if (left < 0) ++ return; /* not a valid WMM Action frame */ ++ + /* extract the tspec info element */ + if (ieee802_11_parse_elems(pos, left, &elems, 1) == ParseFailed) { + hostapd_logger(hapd, mgmt->sa, HOSTAPD_MODULE_IEEE80211, +-- +1.9.1 + diff --git a/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt1.patch b/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt1.patch new file mode 100644 index 0000000000..7ebf5f4cc1 --- /dev/null +++ b/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt1.patch @@ -0,0 +1,75 @@ +Patch copied from http://w1.fi/security/2015-4/ + +From dd2f043c9c43d156494e33d7ce22db96e6ef42c7 Mon Sep 17 00:00:00 2001 +From: Jouni Malinen <j@w1.fi> +Date: Fri, 1 May 2015 16:37:45 +0300 +Subject: [PATCH 1/5] EAP-pwd peer: Fix payload length validation for Commit + and Confirm + +The length of the received Commit and Confirm message payloads was not +checked before reading them. This could result in a buffer read +overflow when processing an invalid message. + +Fix this by verifying that the payload is of expected length before +processing it. In addition, enforce correct state transition sequence to +make sure there is no unexpected behavior if receiving a Commit/Confirm +message before the previous exchanges have been completed. + +Thanks to Kostya Kortchinsky of Google security team for discovering and +reporting this issue. + +Signed-off-by: Jouni Malinen <j@w1.fi> +--- + src/eap_peer/eap_pwd.c | 29 +++++++++++++++++++++++++++++ + 1 file changed, 29 insertions(+) + +diff --git a/src/eap_peer/eap_pwd.c b/src/eap_peer/eap_pwd.c +index f2b0926..a629437 100644 +--- a/src/eap_peer/eap_pwd.c ++++ b/src/eap_peer/eap_pwd.c +@@ -355,6 +355,23 @@ eap_pwd_perform_commit_exchange(struct eap_sm *sm, struct eap_pwd_data *data, + BIGNUM *mask = NULL, *x = NULL, *y = NULL, *cofactor = NULL; + u16 offset; + u8 *ptr, *scalar = NULL, *element = NULL; ++ size_t prime_len, order_len; ++ ++ if (data->state != PWD_Commit_Req) { ++ ret->ignore = TRUE; ++ goto fin; ++ } ++ ++ prime_len = BN_num_bytes(data->grp->prime); ++ order_len = BN_num_bytes(data->grp->order); ++ ++ if (payload_len != 2 * prime_len + order_len) { ++ wpa_printf(MSG_INFO, ++ "EAP-pwd: Unexpected Commit payload length %u (expected %u)", ++ (unsigned int) payload_len, ++ (unsigned int) (2 * prime_len + order_len)); ++ goto fin; ++ } + + if (((data->private_value = BN_new()) == NULL) || + ((data->my_element = EC_POINT_new(data->grp->group)) == NULL) || +@@ -554,6 +571,18 @@ eap_pwd_perform_confirm_exchange(struct eap_sm *sm, struct eap_pwd_data *data, + u8 conf[SHA256_MAC_LEN], *cruft = NULL, *ptr; + int offset; + ++ if (data->state != PWD_Confirm_Req) { ++ ret->ignore = TRUE; ++ goto fin; ++ } ++ ++ if (payload_len != SHA256_MAC_LEN) { ++ wpa_printf(MSG_INFO, ++ "EAP-pwd: Unexpected Confirm payload length %u (expected %u)", ++ (unsigned int) payload_len, SHA256_MAC_LEN); ++ goto fin; ++ } ++ + /* + * first build up the ciphersuite which is group | random_function | + * prf +-- +1.9.1 + diff --git a/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt2.patch b/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt2.patch new file mode 100644 index 0000000000..c11e4175d9 --- /dev/null +++ b/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt2.patch @@ -0,0 +1,68 @@ +Patch copied from http://w1.fi/security/2015-4/ + +From e28a58be26184c2a23f80b410e0997ef1bd5d578 Mon Sep 17 00:00:00 2001 +From: Jouni Malinen <j@w1.fi> +Date: Fri, 1 May 2015 16:40:44 +0300 +Subject: [PATCH 2/5] EAP-pwd server: Fix payload length validation for Commit + and Confirm + +The length of the received Commit and Confirm message payloads was not +checked before reading them. This could result in a buffer read +overflow when processing an invalid message. + +Fix this by verifying that the payload is of expected length before +processing it. In addition, enforce correct state transition sequence to +make sure there is no unexpected behavior if receiving a Commit/Confirm +message before the previous exchanges have been completed. + +Thanks to Kostya Kortchinsky of Google security team for discovering and +reporting this issue. + +Signed-off-by: Jouni Malinen <j@w1.fi> +--- + src/eap_server/eap_server_pwd.c | 19 +++++++++++++++++++ + 1 file changed, 19 insertions(+) + +diff --git a/src/eap_server/eap_server_pwd.c b/src/eap_server/eap_server_pwd.c +index 66bd5d2..3189105 100644 +--- a/src/eap_server/eap_server_pwd.c ++++ b/src/eap_server/eap_server_pwd.c +@@ -656,9 +656,21 @@ eap_pwd_process_commit_resp(struct eap_sm *sm, struct eap_pwd_data *data, + BIGNUM *x = NULL, *y = NULL, *cofactor = NULL; + EC_POINT *K = NULL, *point = NULL; + int res = 0; ++ size_t prime_len, order_len; + + wpa_printf(MSG_DEBUG, "EAP-pwd: Received commit response"); + ++ prime_len = BN_num_bytes(data->grp->prime); ++ order_len = BN_num_bytes(data->grp->order); ++ ++ if (payload_len != 2 * prime_len + order_len) { ++ wpa_printf(MSG_INFO, ++ "EAP-pwd: Unexpected Commit payload length %u (expected %u)", ++ (unsigned int) payload_len, ++ (unsigned int) (2 * prime_len + order_len)); ++ goto fin; ++ } ++ + if (((data->peer_scalar = BN_new()) == NULL) || + ((data->k = BN_new()) == NULL) || + ((cofactor = BN_new()) == NULL) || +@@ -774,6 +786,13 @@ eap_pwd_process_confirm_resp(struct eap_sm *sm, struct eap_pwd_data *data, + u8 conf[SHA256_MAC_LEN], *cruft = NULL, *ptr; + int offset; + ++ if (payload_len != SHA256_MAC_LEN) { ++ wpa_printf(MSG_INFO, ++ "EAP-pwd: Unexpected Confirm payload length %u (expected %u)", ++ (unsigned int) payload_len, SHA256_MAC_LEN); ++ goto fin; ++ } ++ + /* build up the ciphersuite: group | random_function | prf */ + grp = htons(data->group_num); + ptr = (u8 *) &cs; +-- +1.9.1 + diff --git a/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt3.patch b/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt3.patch new file mode 100644 index 0000000000..963dac9270 --- /dev/null +++ b/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt3.patch @@ -0,0 +1,54 @@ +Patch copied from http://w1.fi/security/2015-4/ + +From 477c74395acd0123340457ba6f15ab345d42016e Mon Sep 17 00:00:00 2001 +From: Jouni Malinen <j@w1.fi> +Date: Sat, 2 May 2015 19:23:04 +0300 +Subject: [PATCH 3/5] EAP-pwd peer: Fix Total-Length parsing for fragment + reassembly + +The remaining number of bytes in the message could be smaller than the +Total-Length field size, so the length needs to be explicitly checked +prior to reading the field and decrementing the len variable. This could +have resulted in the remaining length becoming negative and interpreted +as a huge positive integer. + +In addition, check that there is no already started fragment in progress +before allocating a new buffer for reassembling fragments. This avoid a +potential memory leak when processing invalid message. + +Signed-off-by: Jouni Malinen <j@w1.fi> +--- + src/eap_peer/eap_pwd.c | 12 ++++++++++++ + 1 file changed, 12 insertions(+) + +diff --git a/src/eap_peer/eap_pwd.c b/src/eap_peer/eap_pwd.c +index a629437..1d2079b 100644 +--- a/src/eap_peer/eap_pwd.c ++++ b/src/eap_peer/eap_pwd.c +@@ -866,11 +866,23 @@ eap_pwd_process(struct eap_sm *sm, void *priv, struct eap_method_ret *ret, + * if it's the first fragment there'll be a length field + */ + if (EAP_PWD_GET_LENGTH_BIT(lm_exch)) { ++ if (len < 2) { ++ wpa_printf(MSG_DEBUG, ++ "EAP-pwd: Frame too short to contain Total-Length field"); ++ ret->ignore = TRUE; ++ return NULL; ++ } + tot_len = WPA_GET_BE16(pos); + wpa_printf(MSG_DEBUG, "EAP-pwd: Incoming fragments whose " + "total length = %d", tot_len); + if (tot_len > 15000) + return NULL; ++ if (data->inbuf) { ++ wpa_printf(MSG_DEBUG, ++ "EAP-pwd: Unexpected new fragment start when previous fragment is still in use"); ++ ret->ignore = TRUE; ++ return NULL; ++ } + data->inbuf = wpabuf_alloc(tot_len); + if (data->inbuf == NULL) { + wpa_printf(MSG_INFO, "Out of memory to buffer " +-- +1.9.1 + diff --git a/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt4.patch b/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt4.patch new file mode 100644 index 0000000000..3d945382bc --- /dev/null +++ b/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt4.patch @@ -0,0 +1,52 @@ +Patch copied from http://w1.fi/security/2015-4/ + +From 3035cc2894e08319b905bd6561e8bddc8c2db9fa Mon Sep 17 00:00:00 2001 +From: Jouni Malinen <j@w1.fi> +Date: Sat, 2 May 2015 19:26:06 +0300 +Subject: [PATCH 4/5] EAP-pwd server: Fix Total-Length parsing for fragment + reassembly + +The remaining number of bytes in the message could be smaller than the +Total-Length field size, so the length needs to be explicitly checked +prior to reading the field and decrementing the len variable. This could +have resulted in the remaining length becoming negative and interpreted +as a huge positive integer. + +In addition, check that there is no already started fragment in progress +before allocating a new buffer for reassembling fragments. This avoid a +potential memory leak when processing invalid message. + +Signed-off-by: Jouni Malinen <j@w1.fi> +--- + src/eap_server/eap_server_pwd.c | 10 ++++++++++ + 1 file changed, 10 insertions(+) + +diff --git a/src/eap_server/eap_server_pwd.c b/src/eap_server/eap_server_pwd.c +index 3189105..2bfc3c2 100644 +--- a/src/eap_server/eap_server_pwd.c ++++ b/src/eap_server/eap_server_pwd.c +@@ -942,11 +942,21 @@ static void eap_pwd_process(struct eap_sm *sm, void *priv, + * the first fragment has a total length + */ + if (EAP_PWD_GET_LENGTH_BIT(lm_exch)) { ++ if (len < 2) { ++ wpa_printf(MSG_DEBUG, ++ "EAP-pwd: Frame too short to contain Total-Length field"); ++ return; ++ } + tot_len = WPA_GET_BE16(pos); + wpa_printf(MSG_DEBUG, "EAP-pwd: Incoming fragments, total " + "length = %d", tot_len); + if (tot_len > 15000) + return; ++ if (data->inbuf) { ++ wpa_printf(MSG_DEBUG, ++ "EAP-pwd: Unexpected new fragment start when previous fragment is still in use"); ++ return; ++ } + data->inbuf = wpabuf_alloc(tot_len); + if (data->inbuf == NULL) { + wpa_printf(MSG_INFO, "EAP-pwd: Out of memory to " +-- +1.9.1 + diff --git a/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt5.patch b/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt5.patch new file mode 100644 index 0000000000..30f71974ad --- /dev/null +++ b/gnu/packages/patches/wpa-supplicant-2015-4-fix-pt5.patch @@ -0,0 +1,34 @@ +Patch copied from http://w1.fi/security/2015-4/ + +From 28a069a545b06b99eb55ad53f63f2c99e65a98f6 Mon Sep 17 00:00:00 2001 +From: Jouni Malinen <j@w1.fi> +Date: Sat, 2 May 2015 19:26:28 +0300 +Subject: [PATCH 5/5] EAP-pwd peer: Fix asymmetric fragmentation behavior + +The L (Length) and M (More) flags needs to be cleared before deciding +whether the locally generated response requires fragmentation. This +fixes an issue where these flags from the server could have been invalid +for the following message. In some cases, this could have resulted in +triggering the wpabuf security check that would terminate the process +due to invalid buffer allocation. + +Signed-off-by: Jouni Malinen <j@w1.fi> +--- + src/eap_peer/eap_pwd.c | 1 + + 1 file changed, 1 insertion(+) + +diff --git a/src/eap_peer/eap_pwd.c b/src/eap_peer/eap_pwd.c +index 1d2079b..e58b13a 100644 +--- a/src/eap_peer/eap_pwd.c ++++ b/src/eap_peer/eap_pwd.c +@@ -968,6 +968,7 @@ eap_pwd_process(struct eap_sm *sm, void *priv, struct eap_method_ret *ret, + /* + * we have output! Do we need to fragment it? + */ ++ lm_exch = EAP_PWD_GET_EXCHANGE(lm_exch); + len = wpabuf_len(data->outbuf); + if ((len + EAP_PWD_HDR_SIZE) > data->mtu) { + resp = eap_msg_alloc(EAP_VENDOR_IETF, EAP_TYPE_PWD, data->mtu, +-- +1.9.1 + diff --git a/gnu/packages/pcre.scm b/gnu/packages/pcre.scm index 3181ba7592..86d3ca3874 100644 --- a/gnu/packages/pcre.scm +++ b/gnu/packages/pcre.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> -;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> +;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,14 +28,14 @@ (define-public pcre (package (name "pcre") - (version "8.36") + (version "8.37") (source (origin (method url-fetch) (uri (string-append "mirror://sourceforge/pcre/pcre/" version "/pcre-" version ".tar.bz2")) (sha256 (base32 - "1fs5p1z67m9f4xnyil3s4lhgyld78f7m4d1yawpyhh0cvrbk90zg")))) + "17bqykp604p7376wj3q2nmjdhrb6v1ny8q08zdwi7qvc02l9wrsi")))) (build-system gnu-build-system) (inputs `(("bzip2" ,bzip2) ("readline" ,readline) diff --git a/gnu/packages/pdf.scm b/gnu/packages/pdf.scm index bca577eb35..7023b9aa65 100644 --- a/gnu/packages/pdf.scm +++ b/gnu/packages/pdf.scm @@ -282,7 +282,7 @@ by using the poppler rendering engine.") (define-public zathura (package (name "zathura") - (version "0.3.2") + (version "0.3.3") (source (origin (method url-fetch) (uri @@ -290,7 +290,7 @@ by using the poppler rendering engine.") version ".tar.gz")) (sha256 (base32 - "1qk5s7cyqp4l673yhma5igk9g24p5jyqyy81fdk7q7xjqlym19px")) + "1rywx09qn6ap5hb1z31wxby4lzdrqdbldm51pjk1ifflr37xwirk")) (patches (list (search-patch "zathura-plugindir-environment-variable.patch"))))) diff --git a/gnu/packages/perl.scm b/gnu/packages/perl.scm index 09e57578d8..45ca94b279 100644 --- a/gnu/packages/perl.scm +++ b/gnu/packages/perl.scm @@ -1129,6 +1129,30 @@ on one page. This results in wanting to page through various pages of data. The maths behind this is unfortunately fiddly, hence this module.") (license (package-license perl)))) +(define-public perl-data-stag + (package + (name "perl-data-stag") + (version "0.14") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/C/CM/CMUNGALL/" + "Data-Stag-" version ".tar.gz")) + (sha256 + (base32 + "0ncf4l39ka23nb01jlm6rzxdb5pqbip01x0m38bnvf1gim825caa")))) + (build-system perl-build-system) + (propagated-inputs + `(("perl-io-string" ,perl-io-string))) + (home-page "http://search.cpan.org/dist/Data-Stag") + (synopsis "Structured tags datastructures") + (description + "This module is for manipulating data as hierarchical tag/value +pairs (Structured TAGs or Simple Tree AGgreggates). These datastructures can +be represented as nested arrays, which have the advantage of being native to +Perl.") + (license (package-license perl)))) + (define-public perl-data-stream-bulk (package (name "perl-data-stream-bulk") @@ -2442,6 +2466,25 @@ easier to develop interactive applications: is_interactive(), interactive(), and busy()") (license (package-license perl)))) +(define-public perl-io-string + (package + (name "perl-io-string") + (version "1.08") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://cpan/authors/id/G/GA/GAAS/" + "IO-String-" version ".tar.gz")) + (sha256 + (base32 + "18755m410yl70s17rgq3m0hyxl8r5mr47vsq1rw7141d8kc4lgra")))) + (build-system perl-build-system) + (home-page "http://search.cpan.org/~gaas/IO-String-1.08/") + (synopsis "Emulate file interface for in-core strings") + (description "IO::String is an IO::File (and IO::Handle) compatible class +that reads or writes data from in-core strings.") + (license (package-license perl)))) + (define-public perl-io-stringy (package (name "perl-io-stringy") @@ -2583,7 +2626,7 @@ versa using either JSON::XS or JSON::PP.") (source (origin (method url-fetch) - (uri (string-append "mirros://cpan/authors/id/E/ET/ETHER/" + (uri (string-append "mirror://cpan/authors/id/E/ET/ETHER/" "JSON-Any-" version ".tar.gz")) (sha256 (base32 diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 29b47f357c..914c2dc23c 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -26,7 +26,7 @@ (define-module (gnu packages python) #:use-module ((guix licenses) - #:select (asl2.0 bsd-3 bsd-2 non-copyleft cc0 x11 x11-style + #:select (asl2.0 bsd-4 bsd-3 bsd-2 non-copyleft cc0 x11 x11-style gpl2 gpl2+ gpl3+ lgpl2.0+ lgpl2.1 lgpl2.1+ lgpl3+ psfl public-domain x11-style)) #:use-module ((guix licenses) #:select (expat zlib) #:prefix license:) @@ -45,6 +45,7 @@ #:use-module (gnu packages libffi) #:use-module (gnu packages maths) #:use-module (gnu packages multiprecision) + #:use-module (gnu packages networking) #:use-module (gnu packages ncurses) #:use-module (gnu packages openssl) #:use-module (gnu packages perl) @@ -628,6 +629,44 @@ datetime module, available in Python 2.3+.") "Parse human-readable date/time text") (license asl2.0))) +(define-public python-pandas + (package + (name "python-pandas") + (version "0.16.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://pypi.python.org/packages/source/p/" + "pandas/pandas-" version ".tar.gz")) + (sha256 + (base32 "1wfrp8dx1zcsry6f09ndza6qm1yr7f163211f4l9vjlnhxpxw4s0")))) + (build-system python-build-system) + (arguments + `(;; Three tests fail: + ;; - test_read_google + ;; - test_read_yahoo + ;; - test_month_range_union_tz_dateutil + #:tests? #f)) + (propagated-inputs + `(("python-numpy" ,python-numpy) + ("python-pytz" ,python-pytz) + ("python-dateutil" ,python-dateutil-2))) + (native-inputs + `(("python-nose" ,python-nose) + ("python-setuptools" ,python-setuptools))) + (home-page "http://pandas.pydata.org") + (synopsis "Data structures for data analysis, time series, and statistics") + (description + "Pandas is a Python package providing fast, flexible, and expressive data +structures designed to make working with structured (tabular, +multidimensional, potentially heterogeneous) and time series data both easy +and intuitive. It aims to be the fundamental high-level building block for +doing practical, real world data analysis in Python.") + (license bsd-3))) + +(define-public python2-pandas + (package-with-python2 python-pandas)) + (define-public python-tzlocal (package (name "python-tzlocal") @@ -1023,14 +1062,14 @@ syntax.") (define-public scons (package (name "scons") - (version "2.1.0") + (version "2.3.4") (source (origin (method url-fetch) (uri (string-append "mirror://sourceforge/scons/scons-" version ".tar.gz")) (sha256 (base32 - "07cjn4afb2cljjrd3cr7xf062qq58z8q96f58z6yplhdyqafsfa1")))) + "0hdlci43wjz8maryj83mz04ir6rwcdrrzpd7cpzvdlzycqhdfmsb")))) (build-system python-build-system) (arguments ;; With Python 3.x, fails to build with a syntax error. @@ -1598,6 +1637,33 @@ is used by the Requests library to verify HTTPS requests.") (define-public python2-certifi (package-with-python2 python-certifi)) +(define-public python-click + (package + (name "python-click") + (version "4.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://pypi.python.org/packages/source/c/click/click-" + version ".tar.gz")) + (sha256 + (base32 "0294x9g28w6zgswl0rsygkwi0wf6n480gf7fiiw5f9az3xhh77pl")))) + (build-system python-build-system) + (native-inputs + `(("python-setuptools" ,python-setuptools))) + (home-page "http://click.pocoo.org") + (synopsis "Command line library for Python") + (description + "Click is a Python package for creating command line interfaces in a +composable way with as little code as necessary. Its name stands for +\"Command Line Interface Creation Kit\". It's highly configurable but comes +with sensible defaults out of the box.") + (license bsd-3))) + +(define-public python2-click + (package-with-python2 python-click)) + (define-public python-requests (package (name "python-requests") @@ -2065,6 +2131,101 @@ mining and data analysis.") (alist-delete "python-scipy" (package-propagated-inputs scikit)))))))) +(define-public python-scikit-image + (package + (name "python-scikit-image") + (version "0.11.3") + (source + (origin + (method url-fetch) + (uri (string-append + "https://pypi.python.org/packages/source/s/scikit-image/scikit-image-" + version ".tar.gz")) + (sha256 + (base32 "0jz416fqvpahqyffw8plmszzfj669w8wvf3y9clnr5lr6a7md3kn")))) + (build-system python-build-system) + (propagated-inputs + `(("python-matplotlib" ,python-matplotlib) + ("python-networkx" ,python-networkx) + ("python-numpy" ,python-numpy) + ("python-scipy" ,python-scipy) + ("python-six" ,python-six) + ("python-pillow" ,python-pillow))) + (native-inputs + `(("python-cython" ,python-cython) + ("python-setuptools" ,python-setuptools))) + (home-page "http://scikit-image.org/") + (synopsis "Image processing in Python") + (description + "scikit-image is a collection of algorithms for image processing.") + (license bsd-3))) + +(define-public python2-scikit-image + (let ((scikit-image (package-with-python2 python-scikit-image))) + (package (inherit scikit-image) + (native-inputs + `(("python2-mock" ,python2-mock) + ,@(package-native-inputs scikit-image))) + (propagated-inputs + `(("python2-pytz" ,python2-pytz) + ,@(package-propagated-inputs scikit-image)))))) + +(define-public python-redis + (package + (name "python-redis") + (version "2.10.3") + (source + (origin + (method url-fetch) + (uri (string-append + "https://pypi.python.org/packages/source/r/redis/redis-" + version ".tar.gz")) + (sha256 + (base32 "1701qjwn4n05q90fdg4bsg96s27xf5s4hsb4gxhv3xk052q3gyx4")))) + (build-system python-build-system) + ;; Tests require a running Redis server + (arguments '(#:tests? #f)) + (native-inputs + `(("python-setuptools" ,python-setuptools) + ("python-pytest" ,python-pytest))) + (home-page "https://github.com/andymccurdy/redis-py") + (synopsis "Redis Python client") + (description + "This package provides a Python interface to the Redis key-value store.") + (license license:expat))) + +(define-public python2-redis + (package-with-python2 python-redis)) + +(define-public python-rq + (package + (name "python-rq") + (version "0.5.2") + (source + (origin + (method url-fetch) + (uri (string-append + "https://pypi.python.org/packages/source/r/rq/rq-" + version ".tar.gz")) + (sha256 + (base32 "0b0z5hn8wkfg300hx7816csgv3bcfamlr29fi3yzgqmpqxwj3fix")))) + (build-system python-build-system) + (propagated-inputs + `(("python-click" ,python-click) + ("python-redis" ,python-redis))) + (native-inputs + `(("python-setuptools" ,python-setuptools))) + (home-page "http://python-rq.org/") + (synopsis "Simple job queues for Python") + (description + "RQ (Redis Queue) is a simple Python library for queueing jobs and +processing them in the background with workers. It is backed by Redis and it +is designed to have a low barrier to entry.") + (license bsd-2))) + +(define-public python2-rq + (package-with-python2 python-rq)) + (define-public python-cython (package (name "python-cython") @@ -2122,7 +2283,7 @@ writing C extensions for Python as easy as Python itself.") (build-system python-build-system) (inputs `(("python-nose" ,python-nose) - ("atlas" ,atlas))) + ("openblas" ,openblas))) (native-inputs `(("gfortran" ,gfortran-4.8))) (arguments @@ -2130,16 +2291,18 @@ writing C extensions for Python as easy as Python itself.") (alist-cons-before 'build 'set-environment-variables (lambda* (#:key inputs #:allow-other-keys) - (let* ((atlas-threaded - (string-append (assoc-ref inputs "atlas") - "/lib/libtatlas.so")) - ;; On single core CPUs only the serial library is created. - (atlas-lib - (if (file-exists? atlas-threaded) - atlas-threaded - (string-append (assoc-ref inputs "atlas") - "/lib/libsatlas.so")))) - (setenv "ATLAS" atlas-lib))) + (call-with-output-file "site.cfg" + (lambda (port) + (format port "[openblas] +libraries = openblas +library_dirs = ~a/lib +include_dirs = ~a/include +" (assoc-ref inputs "openblas") (assoc-ref inputs "openblas")))) + ;; Use "gcc" executable, not "cc". + (substitute* "numpy/distutils/system_info.py" + (("c = distutils\\.ccompiler\\.new_compiler\\(\\)") + "c = distutils.ccompiler.new_compiler(); c.set_executables(compiler='gcc',compiler_so='gcc',linker_exe='gcc',linker_so='gcc -shared')")) + #t) ;; Tests can only be run after the library has been installed and not ;; within the source directory. (alist-cons-after @@ -2627,7 +2790,7 @@ services for your Python modules and applications.") (define-public python-pillow (package (name "python-pillow") - (version "2.6.1") + (version "2.8.1") (source (origin (method url-fetch) @@ -2635,17 +2798,19 @@ services for your Python modules and applications.") "Pillow/Pillow-" version ".tar.gz")) (sha256 (base32 - "0iw36c73wkhz88wa78v6l43llsb080ihw8yq7adhfqxdib7l4hzr")))) + "15n92axxph2s3kvg68bki9gv3nzwgq7130kp7wbblpi1l0cc2q47")))) (build-system python-build-system) (native-inputs `(("python-setuptools" ,python-setuptools) ("python-nose" ,python-nose))) (inputs - `(("lcms" ,lcms) + `(("freetype" ,freetype) + ("lcms" ,lcms) ("zlib" ,zlib) ("libjpeg" ,libjpeg) ("openjpeg" ,openjpeg) - ("libtiff" ,libtiff))) + ("libtiff" ,libtiff) + ("libwebp" ,libwebp))) (propagated-inputs `(;; Used at runtime for pkg_resources ("python-setuptools" ,python-setuptools))) @@ -3113,9 +3278,7 @@ features useful for text console applications.") `(("pkg-config" ,pkg-config))) (inputs `(("python" ,python) - ("dbus" ,dbus) - ("dbus-glib" ,dbus-glib) - ("glib" ,glib))) + ("dbus-glib" ,dbus-glib))) (synopsis "Python bindings for D-bus") (description "python-dbus provides bindings for libdbus, the reference implementation of D-Bus.") @@ -3201,43 +3364,6 @@ libxml2 and libxslt.") (define-public python2-lxml (package-with-python2 python-lxml)) -(define-public python-pillow - (package - (name "python-pillow") - (version "2.7.0") - (source - (origin - (method url-fetch) - (uri (string-append - "https://pypi.python.org/packages/source/P/Pillow/Pillow-" - version - ".tar.gz")) - (sha256 - (base32 - "1y0rysgd7vqpl5lh0lsra7j2k30azwxqlh5jnqk1i0pmfc735s96")))) - (build-system python-build-system) - (inputs - `(("freetype" ,freetype) - ("lcms" ,lcms) - ("libjpeg" ,libjpeg) - ("libtiff" ,libtiff) - ("openjpeg" ,openjpeg) - ("python-setuptools" ,python-setuptools) - ("zlib" ,zlib))) - (arguments - `(#:tests? #f)) ; no check target - (home-page "http://python-pillow.github.io/") - (synopsis "Pillow fork of Python Imaging Library") - (description "Pillow is a fork of the Python Imaging Library (PIL).") - ;; PIL license, see - ;; http://www.pythonware.com/products/pil/license.htm - (license (x11-style - "file://PKG-INFO" - "See http://www.pythonware.com/products/pil/license.htm")))) - -(define-public python2-pillow - (package-with-python2 python-pillow)) - (define-public python2-pil (package (name "python2-pil") @@ -3446,6 +3572,67 @@ providing a clean and modern domain specific specification language (DSL) in Python style, together with a fast and comfortable execution environment.") (license license:expat))) +(define-public python-seaborn + (package + (name "python-seaborn") + (version "0.5.1") + (source + (origin + (method url-fetch) + (uri (string-append + "https://pypi.python.org/packages/source/s/seaborn/seaborn-" + version ".tar.gz")) + (sha256 + (base32 "1236abw18ijjglmv60q85ckqrvgf5qyy4zlq7nz5aqfg6q87z3wc")))) + (build-system python-build-system) + (propagated-inputs + `(("python-pandas" ,python-pandas) + ("python-matplotlib" ,python-matplotlib) + ("python-scipy" ,python-scipy))) + (native-inputs + `(("python-setuptools" ,python-setuptools))) + (home-page "http://stanford.edu/~mwaskom/software/seaborn/") + (synopsis "Statistical data visualization") + (description + "Seaborn is a library for making attractive and informative statistical +graphics in Python. It is built on top of matplotlib and tightly integrated +with the PyData stack, including support for numpy and pandas data structures +and statistical routines from scipy and statsmodels.") + (license bsd-3))) + +(define-public python2-seaborn + (let ((seaborn (package-with-python2 python-seaborn))) + (package (inherit seaborn) + (propagated-inputs + `(("python2-pytz" ,python2-pytz) + ,@(package-propagated-inputs seaborn)))))) + +(define-public python-sympy + (package + (name "python-sympy") + (version "0.7.6") + (source + (origin + (method url-fetch) + (uri (string-append + "https://github.com/sympy/sympy/releases/download/sympy-" + version "/sympy-" version ".tar.gz")) + (sha256 + (base32 "19yp0gy4i7p4g6l3b8vaqkj9qj7yqb5kqy0qgbdagpzgkdz958yz")))) + (build-system python-build-system) + (native-inputs + `(("python-setuptools" ,python-setuptools))) + (home-page "http://www.sympy.org/") + (synopsis "Python library for symbolic mathematics") + (description + "SymPy is a Python library for symbolic mathematics. It aims to become a +full-featured computer algebra system (CAS) while keeping the code as simple +as possible in order to be comprehensible and easily extensible.") + (license bsd-3))) + +(define-public python2-sympy + (package-with-python2 python-sympy)) + (define-public python-testlib (package (name "python-testlib") @@ -3606,3 +3793,37 @@ applications.") (define-public python2-waf (package-with-python2 python-waf)) + +(define-public python-pyzmq + (package + (name "python-pyzmq") + (version "14.6.0") + (source + (origin + (method url-fetch) + (uri (string-append + "https://pypi.python.org/packages/source/p/pyzmq/pyzmq-" + version ".tar.gz")) + (sha256 + (base32 "1frmbjykvhmdg64g7sn20c9fpamrsfxwci1nhhg8q7jgz5pq0ikp")))) + (build-system python-build-system) + (arguments + `(#:configure-flags + (list (string-append "--zmq=" (assoc-ref %build-inputs "zeromq"))) + ;; FIXME: You must build pyzmq with 'python setup.py build_ext + ;; --inplace' for 'python setup.py test' to work. + #:tests? #f)) + (inputs + `(("zeromq" ,zeromq))) + (native-inputs + `(("pkg-config" ,pkg-config) + ("python-nose" ,python-nose) + ("python-setuptools" ,python-setuptools))) + (home-page "http://github.com/zeromq/pyzmq") + (synopsis "Python bindings for 0MQ") + (description + "PyZMQ is the official Python binding for the ZeroMQ messaging library.") + (license bsd-4))) + +(define-public python2-pyzmq + (package-with-python2 python-pyzmq)) diff --git a/gnu/packages/qemu.scm b/gnu/packages/qemu.scm index 77aeecf40c..27a2d2e8ba 100644 --- a/gnu/packages/qemu.scm +++ b/gnu/packages/qemu.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,6 +34,7 @@ #:use-module (gnu packages image) #:use-module (gnu packages attr) #:use-module (gnu packages linux) + #:use-module (gnu packages libusb) #:use-module (gnu packages xdisorg) #:use-module (gnu packages gl) #:use-module (gnu packages sdl) @@ -42,14 +44,16 @@ ;; This is QEMU without GUI support. (package (name "qemu-headless") - (version "2.2.0") + (version "2.3.0") (source (origin (method url-fetch) (uri (string-append "http://wiki.qemu-project.org/download/qemu-" version ".tar.bz2")) (sha256 (base32 - "1703c3scl5n07gmpilg7g2xzyxnr7jczxgx6nn4m8kv9gin9p35n")))) + "120m53c3p28qxmfzllicjzr8syjv6v4d9rsyrgkp7gnmcgvvgfmn")) + (patches (map search-patch '("qemu-CVE-2015-3209.patch" + "qemu-CVE-2015-3456.patch"))))) (build-system gnu-build-system) (arguments '(#:phases (alist-replace @@ -137,4 +141,5 @@ server and embedded PowerPC, and S390 guests.") (synopsis "Machine emulator and virtualizer") (inputs `(("sdl" ,sdl) ("mesa" ,mesa) + ("libusb" ,libusb) ;USB pass-through support ,@(package-inputs qemu-headless))))) diff --git a/gnu/packages/rdf.scm b/gnu/packages/rdf.scm index f26b021e50..cee7f42398 100644 --- a/gnu/packages/rdf.scm +++ b/gnu/packages/rdf.scm @@ -221,9 +221,10 @@ Turtle/N3 and read them in SPARQL XML, RDF/XML and Turtle/N3.") (native-inputs `(("perl" ,perl) ; needed for installation ("pkg-config" ,pkg-config))) + (propagated-inputs + `(("rasqal" ,rasqal))) ; in Requires.private field of .pc (inputs - `(("bdb" ,bdb) - ("rasqal" ,rasqal))) + `(("bdb" ,bdb))) (home-page "http://librdf.org/") (synopsis "RDF library") (description "The Redland RDF Library (librdf) provides the RDF API @@ -317,7 +318,6 @@ ideal (e.g. in LV2 implementations or embedded applications).") (inputs `(("clucene" ,clucene) ("qt" ,qt-4) - ("rasqal" ,rasqal) ("redland" ,redland))) (home-page "http://soprano.sourceforge.net/") (synopsis "RDF data library for Qt") diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm index 42fcc93017..9943de7e0b 100644 --- a/gnu/packages/ruby.scm +++ b/gnu/packages/ruby.scm @@ -167,3 +167,200 @@ translation data, custom key/scope separator, custom exception handlers, and an extensible architecture with a swappable backend.") (home-page "http://github.com/svenfuchs/i18n") (license license:expat))) + +;; RSpec is the dominant testing library for Ruby projects. Even RSpec's +;; dependencies use RSpec for their test suites! To avoid these circular +;; dependencies, we disable tests for all of the RSpec-related packages. +(define ruby-rspec-support + (package + (name "ruby-rspec-support") + (version "3.2.2") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/rspec/rspec-support/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1pvzfrqgy0z0gwmdgjp9f2vz1d9c0cajyzfqj9z8i2ssxnzmj4bv")))) + (build-system ruby-build-system) + (arguments + '(#:tests? #f)) ; avoid dependency cycles + (synopsis "RSpec support library") + (description "Support utilities for RSpec gems.") + (home-page "https://github.com/rspec/rspec-support") + (license license:expat))) + +(define-public ruby-rspec-core + (package + (name "ruby-rspec-core") + (version "3.2.3") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/rspec/rspec-core/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1clsa4lkh5c9c7xc3xa336ym00ycr67pchpg1bv4y3fz5hvzw8ki")))) + (build-system ruby-build-system) + (arguments + '(#:tests? #f)) ; avoid dependency cycles + (propagated-inputs + `(("ruby-rspec-support" ,ruby-rspec-support))) + (synopsis "RSpec core library") + (description "Rspec-core provides the RSpec test runner and example +groups.") + (home-page "https://github.com/rspec/rspec-core") + (license license:expat))) + +(define ruby-diff-lcs-for-rspec + (package + (name "ruby-diff-lcs") + (version "1.2.5") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/halostatue/diff-lcs/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0kmfz2qdwbfjf97rx27hh9fm39mv3z9avjmvsajqnb5wxj2l5l4s")))) + (build-system ruby-build-system) + (arguments + '(#:tests? #f)) ; avoid dependency cycles + (synopsis "Compute the difference between two Enumerable sequences") + (description "Diff::LCS computes the difference between two Enumerable +sequences using the McIlroy-Hunt longest common subsequence (LCS) algorithm. +It includes utilities to create a simple HTML diff output format and a +standard diff-like tool.") + (home-page "https://github.com/halostatue/diff-lcs") + (license license:expat))) + +(define-public ruby-rspec-expectations + (package + (name "ruby-rspec-expectations") + (version "3.2.1") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/rspec/rspec-expectations/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "0h0rpprbh6h59gmksiyi1b8w6cvcai4wdbkikajwx3w1asxi6f7x")))) + (build-system ruby-build-system) + (arguments + '(#:tests? #f)) ; avoid dependency cycles + (propagated-inputs + `(("ruby-rspec-support" ,ruby-rspec-support) + ("ruby-diff-lcs" ,ruby-diff-lcs-for-rspec))) + (synopsis "RSpec expecations library") + (description "Rspec-expectations provides a simple API to express expected +outcomes of a code example.") + (home-page "https://github.com/rspec/rspec-expectations") + (license license:expat))) + +(define-public ruby-rspec-mocks + (package + (name "ruby-rspec-mocks") + (version "3.2.1") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/rspec/rspec-mocks/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1xzxsg0idxkg7czmjgqq10lcd821ibw1hjzn404sk9j6rw0fbx2g")))) + (build-system ruby-build-system) + (arguments + '(#:tests? #f)) ; avoid dependency cycles + (propagated-inputs + `(("ruby-rspec-support" ,ruby-rspec-support) + ("ruby-diff-lcs" ,ruby-diff-lcs-for-rspec))) + (synopsis "RSpec stubbing and mocking library") + (description "Rspec-mocks provides RSpec's \"test double\" framework, with +support for stubbing and mocking.") + (home-page "https://github.com/rspec/rspec-mocks") + (license license:expat))) + +(define-public ruby-rspec + (package + (name "ruby-rspec") + (version "3.2.0") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/rspec/rspec/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1jg38dbaknsdhiav5vnrwfccg524fwcg6sq1715441vx1xl6p54q")))) + (build-system ruby-build-system) + (arguments + '(#:tests? #f)) ; avoid dependency cycles + (propagated-inputs + `(("ruby-rspec-core" ,ruby-rspec-core) + ("ruby-rspec-mocks" ,ruby-rspec-mocks) + ("ruby-rspec-expectations" ,ruby-rspec-expectations))) + (synopsis "Behavior-driven development framework for Ruby") + (description "RSpec is a behavior-driven development (BDD) framework for +Ruby. This meta-package includes the RSpec test runner, along with the +expectations and mocks frameworks.") + (home-page "http://rspec.info/") + (license license:expat))) + +;; Bundler is yet another source of circular dependencies, so we must disable +;; its test suite as well. +(define-public bundler + (package + (name "bundler") + (version "1.9.9") + (source (origin + (method url-fetch) + (uri (string-append "https://github.com/bundler/bundler/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "08flx3n9hb3yz8mm5k16cdz0sb7g774f6vxn6gc3wfh5la83vfyx")))) + (build-system ruby-build-system) + (arguments + '(#:tests? #f)) ; avoid dependency cycles + (synopsis "Ruby gem bundler") + (description "Bundler automatically downloads and installs a list of gems +specified in a \"Gemfile\", as well as their dependencies.") + (home-page "http://bundler.io/") + (license license:expat))) + +(define-public ruby-useragent + (package + (name "ruby-useragent") + (version "0.13.3") + (source (origin + (method url-fetch) + (uri (string-append + "https://github.com/gshutler/useragent/archive/v" + version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1hj00fw06i0y3rwxxhxmnrqxhpnffv4zfqx2sqqpc5qc4fdvd2x9")))) + (build-system ruby-build-system) + (arguments + '(#:test-target "spec")) + (native-inputs + `(("ruby-rspec" ,ruby-rspec) + ("bundler" ,bundler))) + (synopsis "HTTP user agent parser for Ruby") + (description "UserAgent is a Ruby library that parses and compares HTTP +User Agents.") + (home-page "https://github.com/gshutler/useragent") + (license license:expat))) diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index 77d0d846c8..803b8d5a20 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -29,7 +29,6 @@ #:use-module (gnu packages databases) #:use-module (gnu packages emacs) #:use-module (gnu packages texinfo) - #:use-module (gnu packages elf) #:use-module (gnu packages base) #:use-module (gnu packages pkg-config) #:use-module (gnu packages avahi) @@ -39,6 +38,7 @@ #:use-module (gnu packages libffi) #:use-module (gnu packages fontutils) #:use-module (gnu packages image) + #:use-module (gnu packages xorg) #:use-module (ice-9 match)) (define (mit-scheme-source-directory system version) @@ -91,6 +91,7 @@ ;; ("texlive-core" ,texlive-core) ("texinfo" ,texinfo) ("m4" ,m4) + ("libx11" ,libx11) ("source" @@ -235,55 +236,27 @@ Scheme and C programs and between Scheme and Java programs.") (sha256 (base32 "1v2r4ga58kk1sx0frn8qa8ccmjpic9csqzpk499wc95y9c4b1wy3")) - (patches (list (search-patch "hop-bigloo-4.0b.patch"))))) + (patches (list (search-patch "hop-bigloo-4.0b.patch") + (search-patch "hop-linker-flags.patch"))))) (build-system gnu-build-system) (arguments - '(#:phases + `(#:phases (alist-replace 'configure - (lambda* (#:key inputs outputs #:allow-other-keys) + (lambda* (#:key outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out"))) (zero? (system* "./configure" - (string-append "--prefix=" out))))) - (alist-cons-after - 'strip 'patch-rpath - (lambda* (#:key outputs #:allow-other-keys) - ;; Patch the RPATH of every installed library to point to $out/lib - ;; instead of $TMPDIR. Note that "patchelf --set-rpath" produces - ;; invalid binaries when used before stripping. - (let ((out (assoc-ref outputs "out")) - (tmpdir (getcwd))) - (every (lambda (lib) - (let* ((in (open-pipe* OPEN_READ "patchelf" - "--print-rpath" lib)) - (rpath (read-line in))) - (and (zero? (close-pipe in)) - (let ((rpath* (regexp-substitute/global - #f (regexp-quote tmpdir) rpath - 'pre out 'post))) - (or (equal? rpath rpath*) - (begin - (format #t "~a: changing RPATH from `~a' to `~a'~%" - lib rpath rpath*) - (zero? - (system* "patchelf" "--set-rpath" - rpath* lib)))))))) - (append (find-files (string-append out "/bin") - ".*") - (find-files (string-append out "/lib") - "\\.so$"))))) - %standard-phases)) - #:tests? #f ; no test suite - #:modules ((guix build gnu-build-system) - (guix build utils) - (ice-9 popen) - (ice-9 regex) - (ice-9 rdelim) - (srfi srfi-1)))) + (string-append "--prefix=" out) + (string-append "--blflags=" + ;; user flags completely override useful + ;; default flags, so repeat them here. + "-copt \\$(CPICFLAGS) -L\\$(BUILDLIBDIR) " + "-ldopt -Wl,-rpath," out "/lib"))))) + %standard-phases) + #:tests? #f)) ; no test suite (inputs `(("bigloo" ,bigloo) - ("which" ,which) - ("patchelf" ,patchelf))) + ("which" ,which))) (home-page "http://hop.inria.fr/") (synopsis "Multi-tier programming language for the Web 2.0") (description @@ -481,14 +454,15 @@ mixed.") (define-public chibi-scheme (package (name "chibi-scheme") - (version "0.7.2") + (version "0.7.3") (source (origin (method url-fetch) - (uri (string-append - "http://abrek.synthcode.com/chibi-scheme-" version ".tgz")) + (uri (string-append "https://github.com/ashinn/chibi-scheme/archive/" + version ".tar.gz")) (sha256 - (base32 "0h6k2gdb4xk2pzhdipffcg2w3kfr4zh1va556k1hvng2did6prds")))) + (base32 "16wppf4qzr0748iyp0m89gidsfgq9s6x3gw4xggym91waw4fh742")) + (file-name (string-append "chibi-scheme-" version ".tar.gz")))) (build-system gnu-build-system) (arguments `(#:phases diff --git a/gnu/packages/search.scm b/gnu/packages/search.scm index 5886c6a9ea..e7f8aae881 100644 --- a/gnu/packages/search.scm +++ b/gnu/packages/search.scm @@ -124,4 +124,29 @@ files and directories.") command line tool for interacting with libtocc.") (license gpl3+))) +(define-public bool + (package + (name "bool") + (version "0.2.2") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/bool/bool-" + version ".tar.xz")) + (sha256 + (base32 + "1frdmgrmb509fxbdpsxxw3lvvwv7xm1pavqrqgm4jg698iix6xfw")))) + (build-system gnu-build-system) + (home-page "https://www.gnu.org/software/bool") + (synopsis "Finding text and HTML files that match boolean expressions") + (description + "GNU Bool is a utility to perform text searches on files using Boolean +expressions. For example, a search for \"hello AND world\" would return a +file containing the phrase \"Hello, world!\". It supports both AND and OR +statements, as well as the NEAR statement to search for the occurrence of +words in close proximity to each other. It handles context gracefully, +accounting for new lines and paragraph changes. It also has robust support +for parsing HTML files.") + (license gpl3+))) + ;;; search.scm ends here diff --git a/gnu/packages/statistics.scm b/gnu/packages/statistics.scm index 722e0dfa49..9408705d5e 100644 --- a/gnu/packages/statistics.scm +++ b/gnu/packages/statistics.scm @@ -50,7 +50,8 @@ version ".tar.gz")) (sha256 (base32 - "0dagyqgvi8i3nw158qi2zpwm04s4ffzvnmk5niaksvxs30zrbbpm")))) + "0dagyqgvi8i3nw158qi2zpwm04s4ffzvnmk5niaksvxs30zrbbpm")) + (patches (list (search-patch "r-fix-15899.patch"))))) (build-system gnu-build-system) (arguments `(#:make-flags diff --git a/gnu/packages/task-management.scm b/gnu/packages/task-management.scm new file mode 100644 index 0000000000..e77aecb957 --- /dev/null +++ b/gnu/packages/task-management.scm @@ -0,0 +1,61 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Tomáš Čech <sleep_walker@suse.cz> +;;; +;;; 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 task-management) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix packages) + #:use-module (gnu packages gnutls) + #:use-module (gnu packages linux) + #:use-module (gnu packages lua) + #:use-module (guix download) + #:use-module (guix build-system cmake)) + +(define-public taskwarrior + (package + (name "taskwarrior") + (version "2.4.3") + (source + (origin + (method url-fetch) + (uri (string-append + "http://taskwarrior.org/download/task-" version ".tar.gz")) + (sha256 (base32 + "1lkbw2fhshynbl7hppar1viapyrs712s14xhd8p3l8gyhvxbh0mv")))) + (build-system cmake-build-system) + (inputs + `(("gnutls" ,gnutls) + ("lua" ,lua) + ("util-linux" ,util-linux))) + (arguments + `(#:tests? #f ; No tests implemented. + #:phases + (modify-phases %standard-phases + (add-before + 'patch-source-shebangs 'remove-broken-symlinks + (lambda _ + ;; These files are broken symlinks - delete them. + (delete-file "src/cal") + (delete-file "src/calendar") + (delete-file "src/tw")))))) + (home-page "http://taskwarrior.org") + (synopsis "Command line task manager") + (description + "Taskwarrior is a command-line task manager following the Getting Things +Done time management method. It supports network synchronization, filtering +and querying data, exposing task data in multiple formats to other tools.") + (license license:expat))) diff --git a/gnu/packages/tcsh.scm b/gnu/packages/tcsh.scm index 814f2a6321..0bd1b92b8f 100644 --- a/gnu/packages/tcsh.scm +++ b/gnu/packages/tcsh.scm @@ -31,13 +31,17 @@ (name "tcsh") (version "6.18.01") (source (origin - (method url-fetch) - (uri (string-append "ftp://ftp.astron.com/pub/tcsh/tcsh-" - version ".tar.gz")) - (sha256 - (base32 "1a4z9kwgx1iqqzvv64si34m60gj34p7lp6rrcrb59s7ka5wa476q")) - (patches (list (search-patch "tcsh-fix-autotest.patch"))) - (patch-flags '("-p0")))) + (method url-fetch) + ;; Old tarballs are moved to old/. + (uri (list (string-append "ftp://ftp.astron.com/pub/tcsh/" + "tcsh-" version ".tar.gz") + (string-append "ftp://ftp.astron.com/pub/tcsh/" + "old/tcsh-" version ".tar.gz"))) + (sha256 + (base32 + "1a4z9kwgx1iqqzvv64si34m60gj34p7lp6rrcrb59s7ka5wa476q")) + (patches (list (search-patch "tcsh-fix-autotest.patch"))) + (patch-flags '("-p0")))) (build-system gnu-build-system) (inputs `(("autoconf" ,autoconf) diff --git a/gnu/packages/textutils.scm b/gnu/packages/textutils.scm index 08b1b64c57..325386d234 100644 --- a/gnu/packages/textutils.scm +++ b/gnu/packages/textutils.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com> +;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org> ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. @@ -23,8 +24,11 @@ #:use-module (guix download) #:use-module (guix git-download) #:use-module (guix build-system gnu) + #:use-module (guix build-system trivial) #:use-module (gnu packages autotools) - #:use-module (gnu packages python)) + #:use-module (gnu packages perl) + #:use-module (gnu packages python) + #:use-module (gnu packages zip)) (define-public recode (package @@ -155,3 +159,47 @@ encoding, supporting Unicode version 7.0.") "libgtextutils is a text utilities library used by the fastx toolkit from the Hannon Lab.") (license license:agpl3+))) + +(define-public markdown + (package + (name "markdown") + (version "1.0.1") + (source + (origin + (method url-fetch) + (uri (string-append + "http://daringfireball.net/projects/downloads/" + (string-capitalize name) "_" version ".zip")) + (sha256 + (base32 "0dq1pj91pvlwkv0jwcgdfpv6gvnxzrk3s8mnh7imamcclnvfj835")))) + (build-system trivial-build-system) + (arguments + '(#:modules ((guix build utils)) + #:builder + (begin + (use-modules (guix build utils)) + (let ((source (assoc-ref %build-inputs "source")) + (out (assoc-ref %outputs "out")) + (perlbd (string-append (assoc-ref %build-inputs "perl") "/bin")) + (unzip (string-append (assoc-ref %build-inputs "unzip") + "/bin/unzip"))) + (mkdir-p out) + (with-directory-excursion out + (system* unzip source) + (mkdir "bin") + (mkdir-p "share/doc") + (rename-file "Markdown_1.0.1/Markdown.pl" "bin/markdown") + (rename-file "Markdown_1.0.1/Markdown Readme.text" + "share/doc/README") + (patch-shebang "bin/markdown" (list perlbd)) + (delete-file-recursively "Markdown_1.0.1")))))) + (native-inputs `(("unzip" ,unzip))) + (inputs `(("perl" ,perl))) + (home-page "http://daringfireball.net/projects/markdown") + (synopsis "Text-to-HTML conversion tool") + (description + "Markdown is a text-to-HTML conversion tool for web writers. It allows +you to write using an easy-to-read, easy-to-write plain text format, then +convert it to structurally valid XHTML (or HTML).") + (license (license:non-copyleft "file://License.text" + "See License.text in the distribution.")))) diff --git a/gnu/packages/tor.scm b/gnu/packages/tor.scm index 0f19d9f2a4..d5e30e97f5 100644 --- a/gnu/packages/tor.scm +++ b/gnu/packages/tor.scm @@ -26,21 +26,24 @@ #:use-module (gnu packages compression) #:use-module (gnu packages openssl) #:use-module (gnu packages pcre) + #:use-module (gnu packages python) #:use-module (gnu packages autotools) #:use-module (gnu packages w3m)) (define-public tor (package (name "tor") - (version "0.2.5.12") + (version "0.2.6.8") (source (origin (method url-fetch) (uri (string-append "https://www.torproject.org/dist/tor-" version ".tar.gz")) (sha256 (base32 - "0j9byw3i2b7ji88vsqwmsxxg2nlxwkk45k5qbc1y7hdlzvzxl3sm")))) + "0xlsc2pa7i8hm8dyilln6p4rb0pig62b9c31yp1m0hj5jqw3d2xq")))) (build-system gnu-build-system) + (native-inputs + `(("python" ,python-2))) ; for tests (inputs `(("zlib" ,zlib) ("openssl" ,openssl) diff --git a/gnu/packages/tv.scm b/gnu/packages/tv.scm new file mode 100644 index 0000000000..0a229e149a --- /dev/null +++ b/gnu/packages/tv.scm @@ -0,0 +1,64 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Alex Kost <alezost@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 tv) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (gnu packages) + #:use-module (gnu packages xorg) + #:use-module (gnu packages image) + #:use-module (gnu packages compression) + #:use-module (gnu packages xml) + #:use-module (gnu packages fontutils)) + +(define-public tvtime + (package + (name "tvtime") + (version "1.0.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/tvtime/tvtime-" + version ".tar.gz")) + (sha256 + (base32 + "08q5gzbyz0lxb730rz6d6amkzimlc7nanv6n50j2bpw4n2xa9wmf")) + (patches (list (search-patch "tvtime-videodev2.patch") + (search-patch "tvtime-pngoutput.patch") + (search-patch "tvtime-xmltv.patch") + (search-patch "tvtime-gcc41.patch"))))) + (build-system gnu-build-system) + (inputs + `(("libx11" ,libx11) + ("libxext" ,libxext) + ("libxt" ,libxt) + ("libxtst" ,libxtst) + ("libxinerama" ,libxinerama) + ("libxv" ,libxv) + ("libxxf86vm" ,libxxf86vm) + ("libpng" ,libpng) + ("libxml2" ,libxml2) + ("freetype" ,freetype) + ("zlib" ,zlib))) + (home-page "http://tvtime.sourceforge.net") + (synopsis "Television viewer") + (description + "Tvtime processes the input from your video capture card and +displays it on a monitor. It focuses on a high visual quality.") + (license license:gpl2+))) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 3cbd12f635..0d153fa92d 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -3,7 +3,7 @@ ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr> -;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> +;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; ;;; This file is part of GNU Guix. @@ -49,6 +49,7 @@ #:use-module (gnu packages ncurses) #:use-module (gnu packages openssl) #:use-module (gnu packages ssh) + #:use-module (gnu packages web) #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) @@ -536,29 +537,20 @@ WebDAV metadata support, wrappers for PROPFIND and PROPPATCH to simplify property manipulation.") (license gpl2+))) ; for documentation and tests; source under lgpl2.0+ -(define-public neon-0.29.6 - (package (inherit neon) - (name "neon") - (version "0.29.6") - (source (origin - (method url-fetch) - (uri (string-append "http://www.webdav.org/neon/neon-" - version ".tar.gz")) - (sha256 - (base32 - "0hzbjqdx1z8zw0vmbknf159wjsxbcq8ii0wgwkqhxj3dimr0nr4w")))))) - (define-public subversion (package (name "subversion") - (version "1.7.18") + (version "1.8.13") (source (origin (method url-fetch) (uri (string-append "http://archive.apache.org/dist/subversion/" "subversion-" version ".tar.bz2")) (sha256 (base32 - "06nrqnn3qq1hhskkcdbm0ilk2xv6ay2gyf2c7qvxp6xncb782wzn")))) + "0ybmc0yq83jhblp42wdqvn2cryra3sypx8mkxn5b8lq7hilcr68h")) + (patches + (list (search-patch "subversion-sqlite-3.8.9-fix.patch"))) + (patch-flags '("-p0")))) (build-system gnu-build-system) (arguments '(#:phases (alist-cons-after @@ -574,7 +566,7 @@ property manipulation.") (substitute* "libtool" (("\\\\`ls") (string-append "\\`" coreutils "/bin/ls"))))) (alist-cons-after - 'install 'instal-perl-bindings + 'install 'install-perl-bindings (lambda* (#:key outputs #:allow-other-keys) ;; Follow the instructions from ;; 'subversion/bindings/swig/INSTALL'. @@ -603,7 +595,7 @@ property manipulation.") (inputs `(("apr" ,apr) ("apr-util" ,apr-util) - ("neon" ,neon-0.29.6) + ("serf" ,serf) ("perl" ,perl) ("python" ,python-2) ; incompatible with Python 3 (print syntax) ("sqlite" ,sqlite) diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm index c890d45d19..3955c383d7 100644 --- a/gnu/packages/video.scm +++ b/gnu/packages/video.scm @@ -857,7 +857,7 @@ projects while introducing many more.") (define-public youtube-dl (package (name "youtube-dl") - (version "2015.01.23.4") + (version "2015.06.04.1") (source (origin (method url-fetch) (uri (string-append "http://youtube-dl.org/downloads/" @@ -865,7 +865,7 @@ projects while introducing many more.") version ".tar.gz")) (sha256 (base32 - "0pvvab9dk1righ3fa79000iz8fzdlcxakscx5sd31730c37j3kj2")))) + "0rk5c2m19x119bly38yjbizkr99ayn265lm15rm2x5ipjvdixyyg")))) (build-system python-build-system) (inputs `(("setuptools" ,python-setuptools))) (home-page "http://youtube-dl.org") @@ -1102,6 +1102,8 @@ for use with HTML5 video.") "-DCMAKE_INSTALL_RPATH_USE_LINK_PATH=TRUE" (string-append "-DCMAKE_INSTALL_PREFIX=" out) (string-append "-DCMAKE_INSTALL_RPATH=" lib) + (string-append "-DCMAKE_SHARED_LINKER_FLAGS=" + "\"-Wl,-rpath=" lib "\"") (string-append "-DAVIDEMUX_SOURCE_DIR=" top) (string-append "-DSDL_INCLUDE_DIR=" sdl "/include/SDL") diff --git a/gnu/packages/vpn.scm b/gnu/packages/vpn.scm index 5883f99505..62036d9ef7 100644 --- a/gnu/packages/vpn.scm +++ b/gnu/packages/vpn.scm @@ -28,6 +28,7 @@ #:use-module (gnu packages gettext) #:use-module (gnu packages gnupg) #:use-module (gnu packages gnutls) + #:use-module (gnu packages linux) #:use-module (gnu packages openssl) #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) @@ -125,3 +126,33 @@ supported by the ASA5500 Series, by IOS 12.4(9)T or later on Cisco SR500, and probably others.") (license license:lgpl2.1) (home-page "http://www.infradead.org/openconnect/"))) + +(define-public openvpn + (package + (name "openvpn") + (version "2.3.6") + (source (origin + (method url-fetch) + (uri (string-append + "https://swupdate.openvpn.org/community/releases/openvpn-" + version ".tar.xz")) + (sha256 + (base32 + "1v8h2nshxnvn2zyr08vzkfby1kc7ma6bi0s6hix389cj9krjxbmd")))) + (build-system gnu-build-system) + (arguments + '(#:configure-flags '("--enable-iproute2=yes"))) + (native-inputs + `(("iproute2" ,iproute))) + (inputs + `(("lzo" ,lzo) + ("openssl" ,openssl) + ("linux-pam" ,linux-pam))) + (home-page "https://openvpn.net/") + (synopsis "Virtual private network daemon") + (description "OpenVPN implements virtual private network (VPN) techniques +for creating secure point-to-point or site-to-site connections in routed or +bridged configurations and remote access facilities. It uses a custom +security protocol that utilizes SSL/TLS for key exchange. It is capable of +traversing network address translators (NATs) and firewalls. ") + (license license:gpl2))) diff --git a/gnu/packages/web.scm b/gnu/packages/web.scm index fb3ff2d149..e77bad76d6 100644 --- a/gnu/packages/web.scm +++ b/gnu/packages/web.scm @@ -46,6 +46,7 @@ #:use-module (gnu packages icu4c) #:use-module (gnu packages lua) #:use-module (gnu packages base) + #:use-module (gnu packages python) #:use-module (gnu packages pcre) #:use-module (gnu packages pkg-config) #:use-module (gnu packages xml) @@ -548,6 +549,75 @@ URLs and extracting their actual media files.") from streaming URLs. It is a command-line wrapper for the libquvi library.") (license l:lgpl2.1+))) +(define-public serf + (package + (name "serf") + (version "1.3.8") + (source + (origin + (method url-fetch) + (uri (string-append "http://serf.googlecode.com/svn/src_releases/serf-" + version ".tar.bz2")) + (sha256 + (base32 "14155g48gamcv5s0828bzij6vr14nqmbndwq8j8f9g6vcph0nl70")) + (patches (map search-patch '("serf-comment-style-fix.patch" + "serf-deflate-buckets-test-fix.patch"))) + (patch-flags '("-p0")))) + (build-system gnu-build-system) + (native-inputs + `(("scons" ,scons) + ("python" ,python-2))) + (propagated-inputs + `(("apr" ,apr) + ("apr-util" ,apr-util) + ("openssl" ,openssl))) + (inputs + `(;; TODO: Fix build with gss. + ;;("gss" ,gss) + ("zlib" ,zlib))) + (arguments + `(#:phases + ;; TODO: Add scons-build-system and use it here. + (modify-phases %standard-phases + (delete 'configure) + (add-after 'unpack 'scons-propagate-environment + (lambda _ + ;; By design, SCons does not, by default, propagate + ;; environment variables to subprocesses. See: + ;; <http://comments.gmane.org/gmane.linux.distributions.nixos/4969> + ;; Here, we modify the SConstruct file to arrange for + ;; environment variables to be propagated. + (substitute* "SConstruct" + (("^env = Environment\\(") + "env = Environment(ENV=os.environ, ")))) + (replace 'build + (lambda* (#:key inputs outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out")) + (apr (assoc-ref inputs "apr")) + (apr-util (assoc-ref inputs "apr-util")) + (openssl (assoc-ref inputs "openssl")) + ;;(gss (assoc-ref inputs "gss")) + (zlib (assoc-ref inputs "zlib"))) + (zero? (system* "scons" + (string-append "APR=" apr) + (string-append "APU=" apr-util) + (string-append "OPENSSL=" openssl) + ;;(string-append "GSSAPI=" gss) + (string-append "ZLIB=" zlib) + (string-append "PREFIX=" out)))))) + (replace 'check (lambda _ (zero? (system* "scons" "check")))) + (replace 'install (lambda _ (zero? (system* "scons" "install"))))))) + (home-page "https://code.google.com/p/serf/") + (synopsis "High-performance asynchronous HTTP client library") + (description + "serf is a C-based HTTP client library built upon the Apache Portable +Runtime (APR) library. It multiplexes connections, running the read/write +communication asynchronously. Memory copies and transformations are kept to a +minimum to provide high performance operation.") + ;; Most of the code is covered by the Apache License, Version 2.0, but the + ;; bundled CuTest framework uses a different non-copyleft license. + (license (list l:asl2.0 (l:non-copyleft "file://test/CuTest-README.txt"))))) + (define-public perl-apache-logformat-compiler (package diff --git a/gnu/packages/webkit.scm b/gnu/packages/webkit.scm index e6de8ab0df..0f3a44b063 100644 --- a/gnu/packages/webkit.scm +++ b/gnu/packages/webkit.scm @@ -1,5 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> +;;; Copyright © 2015 David Hashe <david.hashe@dhashe.com> +;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,9 +23,13 @@ #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system cmake) + #:use-module (guix build-system gnu) + #:use-module (gnu packages) + #:use-module (gnu packages base) #:use-module (gnu packages bison) #:use-module (gnu packages databases) #:use-module (gnu packages enchant) + #:use-module (gnu packages flex) #:use-module (gnu packages gettext) #:use-module (gnu packages gl) #:use-module (gnu packages glib) @@ -45,19 +51,23 @@ (define-public webkitgtk (package (name "webkitgtk") - (version "2.8.1") + (version "2.8.3") (source (origin (method url-fetch) (uri (string-append "http://www.webkitgtk.org/releases/" name "-" version ".tar.xz")) (sha256 (base32 - "1zv030ryfwwp57yzlpr9bgpxcmc64izsxk2vsyd4kjhns9cl88bx")))) + "05igg61lflgwy83cmxgyzmvf2bkhplmp8710ssrlpmbfcz461pmk")))) (build-system cmake-build-system) (arguments '(#:tests? #f ; no tests #:build-type "Release" ; turn off debugging symbols to save space - #:configure-flags '("-DPORT=GTK"))) + #:configure-flags (list + "-DPORT=GTK" + (string-append ; uses lib64 by default + "-DLIB_INSTALL_DIR=" + (assoc-ref %outputs "out") "/lib")))) (native-inputs `(("bison" ,bison) ("gettext" ,gnu-gettext) @@ -103,3 +113,40 @@ HTML/CSS applications to full-fledged web browsers.") license:lgpl2.1+ license:bsd-2 license:bsd-3)))) + +;; Latest release of the stable 2.4 series, with WebKit1 support. +(define-public webkitgtk-2.4 + (package (inherit webkitgtk) + (name "webkitgtk") + (version "2.4.9") + (source (origin + (method url-fetch) + (uri (string-append "http://www.webkitgtk.org/releases/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "0r651ar3p0f8zwl7764kyimxk5hy88cwy116pv8cl5l8hbkjkpxg")))) + (build-system gnu-build-system) + (arguments + '(#:tests? #f ; no tests + #:phases (modify-phases %standard-phases + (add-after + 'unpack 'set-gcc + (lambda _ (setenv "CC" "gcc") #t))))) + (native-inputs + `(("flex" ,flex) + ("which" ,which) + ,@(package-native-inputs webkitgtk))))) + +;; Last GTK+2 port, required by GnuCash. +(define-public webkitgtk/gtk+-2 + (package (inherit webkitgtk-2.4) + (name "webkitgtk") + (arguments + `(#:configure-flags + '("--enable-webkit2=no" + "--with-gtk=2.0") + ,@(package-arguments webkitgtk-2.4))) + (propagated-inputs + `(("gtk+-2" ,gtk+-2) + ("libsoup" ,libsoup))))) diff --git a/gnu/packages/wicd.scm b/gnu/packages/wicd.scm index 1953a56b6c..908b15e30b 100644 --- a/gnu/packages/wicd.scm +++ b/gnu/packages/wicd.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Pierre-Antoine Rault <par@rigelk.eu> +;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -44,11 +45,12 @@ "/+download/wicd-" version ".tar.gz")) (sha256 (base32 "00c4rq753bhg64rv1v9yl834ssq7igyy7cz3swp287b5n5bqiqwi")) - (patches (list (search-patch "wicd-urwid-1.3.patch"))))) + (patches (map search-patch + '("wicd-urwid-1.3.patch" + "wicd-template-instantiation.patch"))))) (build-system python-build-system) (native-inputs `(("gettext" ,gnu-gettext))) - (inputs `(("dbus" ,dbus) - ("dbus-glib" ,dbus-glib) + (inputs `(("dbus-glib" ,dbus-glib) ("python2-dbus" ,python2-dbus) ("python2-pygtk" ,python2-pygtk) ("python2-urwid" ,python2-urwid) diff --git a/gnu/packages/wxwidgets.scm b/gnu/packages/wxwidgets.scm index ee270ff105..b49fb2fe84 100644 --- a/gnu/packages/wxwidgets.scm +++ b/gnu/packages/wxwidgets.scm @@ -96,5 +96,8 @@ and many other languages.") (arguments `(#:configure-flags '("--enable-unicode" "--with-regex=sys" "--with-sdl") + #:make-flags + (list (string-append "LDFLAGS=-Wl,-rpath=" + (assoc-ref %outputs "out") "/lib")) ;; No 'check' target. #:tests? #f)))) diff --git a/gnu/packages/xfce.scm b/gnu/packages/xfce.scm index 37f09579fe..818941892f 100644 --- a/gnu/packages/xfce.scm +++ b/gnu/packages/xfce.scm @@ -318,6 +318,37 @@ applications menu, workspace switcher and more.") ;; to read the battery state via ACPI or APM are covered by lgpl2.0+. (license (list gpl2+ lgpl2.0+)))) +(define-public xfce4-clipman-plugin + (package + (name "xfce4-clipman-plugin") + (version "1.2.6") + (source (origin + (method url-fetch) + (uri (string-append "http://archive.xfce.org/src/panel-plugins/" + name "/" (version-major+minor version) "/" + name "-" version ".tar.bz2")) + (sha256 + (base32 + "19a8gwcqc0r5qqi8w28dc8arqip34m8yxdb87lgps9g5qfcky113")))) + (build-system gnu-build-system) + (native-inputs + `(("intltool" ,intltool) + ("pkg-config" ,pkg-config))) + (inputs + `(("exo" ,exo) + ("libxfce4ui" ,libxfce4ui) + ("libxtst" ,libxtst) + ("xfce4-panel" ,xfce4-panel))) + (home-page + "http://goodies.xfce.org/projects/panel-plugins/xfce4-clipman-plugin") + (synopsis "Clipboard manager for Xfce") + (description + "Clipman is a clipboard manager for Xfce. It keeps the clipboard contents +around while it is usually lost when you close an application. It is able to +handle text and images, and has a feature to execute actions on specific text by +matching them against regular expressions.") + (license (list gpl2+)))) + (define-public xfce4-appfinder (package (name "xfce4-appfinder") @@ -601,6 +632,7 @@ on your desktop.") ("tumlber" ,tumbler) ("xfce4-appfinder" ,xfce4-appfinder) ("xfce4-battery-plugin" ,xfce4-battery-plugin) + ("xfce4-clipman-plugin" ,xfce4-clipman-plugin) ("xfce4-panel" ,xfce4-panel) ("xfce4-session" ,xfce4-session) ("xfce4-settings" ,xfce4-settings) diff --git a/gnu/packages/xml.scm b/gnu/packages/xml.scm index 97781adef2..59b73d2aa5 100644 --- a/gnu/packages/xml.scm +++ b/gnu/packages/xml.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> +;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; @@ -21,8 +21,10 @@ (define-module (gnu packages xml) #:use-module (gnu packages) + #:use-module (gnu packages autotools) #:use-module (gnu packages compression) #:use-module (gnu packages gnupg) + #:use-module (gnu packages gnutls) #:use-module (gnu packages perl) #:use-module (gnu packages python) #:use-module (gnu packages web) @@ -397,3 +399,32 @@ that conforms to the API of the Document Object Model.") stylesheet for the conversion you want and applies it using an external XSL-T processor. It also performs any necessary post-processing.") (license license:gpl2+))) + +(define-public xmlsec + (package + (name "xmlsec") + (version "1.2.20") + (source (origin + (method url-fetch) + (uri (string-append "https://www.aleksey.com/xmlsec/download/" + name "1-" version ".tar.gz")) + (sha256 + (base32 + "01bkbv2y3x8d1sf4dcln1x3y2jyj391s3208d9a2ndhglly5j89j")))) + (build-system gnu-build-system) + (propagated-inputs ; according to xmlsec1.pc + `(("libxml2" ,libxml2) + ("libxslt" ,libxslt))) + (inputs + `(("gnutls" ,gnutls) + ("libgcrypt" ,libgcrypt) + ("libltdl" ,libltdl))) + (home-page "http://www.libexpat.org/") + (synopsis "XML Security Library") + (description + "The XML Security Library is a C library based on Libxml2. It +supports XML security standards such as XML Signature, XML Encryption, +Canonical XML (part of Libxml2) and Exclusive Canonical XML (part of +Libxml2).") + (license (license:x11-style "file://COPYING" + "See 'COPYING' in the distribution.")))) diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm index 0a56f3d7f6..a3ca5ab6fb 100644 --- a/gnu/services/avahi.scm +++ b/gnu/services/avahi.scm @@ -63,7 +63,7 @@ (domains-to-browse '())) "Return a service that runs @command{avahi-daemon}, a system-wide mDNS/DNS-SD responder that allows for service discovery and -\"zero-configuration\" host name lookups. +\"zero-configuration\" host name lookups (see @uref{http://avahi.org/}). If @var{host-name} is different from @code{#f}, use that as the host name to publish for this machine; otherwise, use the machine's actual host name. diff --git a/gnu/services/base.scm b/gnu/services/base.scm index d0a2e8c848..d5744204d9 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015 Alex Kost <alezost@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -46,6 +47,7 @@ swap-service user-processes-service host-name-service + console-keymap-service console-font-service udev-service mingetty-service @@ -313,6 +315,19 @@ stopped before 'kill' is called." (else (zero? (cdr (waitpid pid)))))))) +(define (console-keymap-service file) + "Return a service to load console keymap from @var{file}." + (with-monad %store-monad + (return + (service + (documentation + (string-append "Load console keymap (loadkeys).")) + (provision '(console-keymap)) + (start #~(lambda _ + (zero? (system* (string-append #$kbd "/bin/loadkeys") + #$file)))) + (respawn? #f))))) + (define* (console-font-service tty #:optional (font "LatGrkCyr-8x16")) "Return a service that sets up Unicode support in @var{tty} and loads @var{font} for that tty (fonts are per virtual console in Linux.)" @@ -836,10 +851,10 @@ gexp, to open it, and evaluate @var{close} to close it." (requirement `(udev ,@requirement)) (documentation "Enable the given swap device.") (start #~(lambda () - (swapon #$device) + (restart-on-EINTR (swapon #$device)) #t)) (stop #~(lambda _ - (swapoff #$device) + (restart-on-EINTR (swapoff #$device)) #f)) (respawn? #f))))) diff --git a/gnu/services/colord.scm b/gnu/services/colord.scm deleted file mode 100644 index 588436002c..0000000000 --- a/gnu/services/colord.scm +++ /dev/null @@ -1,72 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2015 Andy Wingo <wingo@igalia.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 services colord) - #:use-module (gnu services) - #:use-module (gnu system shadow) - #:use-module (gnu packages gnome) - #:use-module (ice-9 match) - #:use-module (guix monads) - #:use-module (guix store) - #:use-module (guix gexp) - #:export (colord-service)) - -;;; Commentary: -;;; -;;; This module provides service definitions for the colord color management -;;; service. -;;; -;;; Code: - -(define* (colord-service #:key (colord colord)) - "Return a service that runs @command{colord}, a system service with a D-Bus -interface to manage the color profiles of input and output devices such as -screens and scanners. It is notably used by the GNOME Color Manager graphical -tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web -site} for more information." - (with-monad %store-monad - (return - (service - (documentation "Run the colord color management service.") - (provision '(colord-daemon)) - (requirement '(dbus-system udev)) - - (start #~(make-forkexec-constructor - (list (string-append #$colord "/libexec/colord")))) - (stop #~(make-kill-destructor)) - (activate #~(begin - (use-modules (guix build utils)) - (mkdir-p "/var/lib/colord") - (let ((user (getpwnam "colord"))) - (chown "/var/lib/colord" - (passwd:uid user) (passwd:gid user))))) - - (user-groups (list (user-group - (name "colord") - (system? #t)))) - (user-accounts (list (user-account - (name "colord") - (group "colord") - (system? #t) - (comment "colord daemon user") - (home-directory "/var/empty") - (shell - "/run/current-system/profile/sbin/nologin")))))))) - -;;; colord.scm ends here diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm new file mode 100644 index 0000000000..18f41e74da --- /dev/null +++ b/gnu/services/databases.scm @@ -0,0 +1,121 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 David Thompson <davet@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 databases) + #:use-module (gnu services) + #:use-module (gnu system shadow) + #:use-module (gnu packages admin) + #:use-module (gnu packages databases) + #:use-module (guix records) + #:use-module (guix monads) + #:use-module (guix store) + #:use-module (guix gexp) + #:export (postgresql-service)) + +;;; Commentary: +;;; +;;; Database services. +;;; +;;; Code: + +(define %default-postgres-hba + (text-file "pg_hba.conf" + " +local all all trust +host all all 127.0.0.1/32 trust +host all all ::1/128 trust")) + +(define %default-postgres-ident + (text-file "pg_ident.conf" + "# MAPNAME SYSTEM-USERNAME PG-USERNAME")) + +(define %default-postgres-config + (mlet %store-monad ((hba %default-postgres-hba) + (ident %default-postgres-ident)) + (text-file* "postgresql.conf" + ;; The daemon will not start without these. + "hba_file = '" hba "'\n" + "ident_file = '" ident "'\n"))) + +(define* (postgresql-service #:key (postgresql postgresql) + (config-file %default-postgres-config) + (data-directory "/var/lib/postgresql/data")) + "Return a service that runs @var{postgresql}, the PostgreSQL database server. + +The PostgreSQL daemon loads its runtime configuration from @var{config-file} +and stores the database cluster in @var{data-directory}." + ;; Wrapper script that switches to the 'postgres' user before launching + ;; daemon. + (define start-script + (mlet %store-monad ((config-file config-file)) + (gexp->script "start-postgres" + #~(let ((user (getpwnam "postgres")) + (postgres (string-append #$postgresql + "/bin/postgres"))) + (setgid (passwd:gid user)) + (setuid (passwd:uid user)) + (system* postgres + (string-append "--config-file=" #$config-file) + "-D" #$data-directory))))) + + (define activate + #~(begin + (use-modules (guix build utils) + (ice-9 match)) + + (let ((user (getpwnam "postgres")) + (initdb (string-append #$postgresql "/bin/initdb"))) + ;; Create db state directory. + (mkdir-p #$data-directory) + (chown #$data-directory (passwd:uid user) (passwd:gid user)) + + ;; Drop privileges and init state directory in a new + ;; process. Wait for it to finish before proceeding. + (match (primitive-fork) + (0 + ;; Exit with a non-zero status code if an exception is thrown. + (dynamic-wind + (const #t) + (lambda () + (setgid (passwd:gid user)) + (setuid (passwd:uid user)) + (primitive-exit (system* initdb "-D" #$data-directory))) + (lambda () + (primitive-exit 1)))) + (pid (waitpid pid)))))) + + (mlet %store-monad ((start-script start-script)) + (return + (service + (provision '(postgres)) + (documentation "Run the PostgreSQL daemon.") + (requirement '(user-processes loopback)) + (start #~(make-forkexec-constructor #$start-script)) + (stop #~(make-kill-destructor)) + (activate activate) + (user-groups (list (user-group + (name "postgres") + (system? #t)))) + (user-accounts (list (user-account + (name "postgres") + (group "postgres") + (system? #t) + (comment "PostgreSQL server user") + (home-directory "/var/empty") + (shell + #~(string-append #$shadow "/sbin/nologin"))))))))) diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm deleted file mode 100644 index 8f3b350951..0000000000 --- a/gnu/services/dbus.scm +++ /dev/null @@ -1,127 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015 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 dbus) - #:use-module (gnu services) - #:use-module (gnu system shadow) - #:use-module (gnu packages glib) - #:use-module (gnu packages admin) - #:use-module (guix monads) - #:use-module (guix store) - #:use-module (guix gexp) - #:export (dbus-service)) - -;;; Commentary: -;;; -;;; This module supports the configuration of the D-Bus message bus -;;; (http://dbus.freedesktop.org/). D-Bus is an inter-process communication -;;; facility. Its "system bus" is used to allow system services to -;;; communicate and be notified of system-wide events. -;;; -;;; Code: - -(define (dbus-configuration-directory dbus services) - "Return a configuration directory for @var{dbus} that includes the -@code{etc/dbus-1/system.d} directories of each package listed in -@var{services}." - (define build - #~(begin - (use-modules (sxml simple) - (srfi srfi-1)) - - (define (services->sxml services) - ;; Return the SXML 'includedir' clauses for DIRS. - `(busconfig - ,@(append-map (lambda (dir) - `((includedir - ,(string-append dir "/etc/dbus-1/system.d")) - (servicedir ;for '.service' files - ,(string-append dir "/share/dbus-1/services")))) - services))) - - (mkdir #$output) - (copy-file (string-append #$dbus "/etc/dbus-1/system.conf") - (string-append #$output "/system.conf")) - - ;; The default 'system.conf' has an <includedir> clause for - ;; 'system.d', so create it. - (mkdir (string-append #$output "/system.d")) - - ;; 'system-local.conf' is automatically included by the default - ;; 'system.conf', so this is where we stuff our own things. - (call-with-output-file (string-append #$output "/system-local.conf") - (lambda (port) - (sxml->xml (services->sxml (list #$@services)) - port))))) - - (gexp->derivation "dbus-configuration" build)) - -(define* (dbus-service services #:key (dbus dbus)) - "Return a service that runs the system bus, using @var{dbus}, with support -for @var{services}. - -@var{services} must be a list of packages that provide an -@file{etc/dbus-1/system.d} directory containing additional D-Bus configuration -and policy files. For example, to allow avahi-daemon to use the system bus, -@var{services} must be equal to @code{(list avahi)}." - (mlet %store-monad ((conf (dbus-configuration-directory dbus services))) - (return - (service - (documentation "Run the D-Bus system daemon.") - (provision '(dbus-system)) - (requirement '(user-processes)) - (start #~(make-forkexec-constructor - (list (string-append #$dbus "/bin/dbus-daemon") - "--nofork" - (string-append "--config-file=" #$conf "/system.conf")))) - (stop #~(make-kill-destructor)) - (user-groups (list (user-group - (name "messagebus") - (system? #t)))) - (user-accounts (list (user-account - (name "messagebus") - (group "messagebus") - (system? #t) - (comment "D-Bus system bus user") - (home-directory "/var/run/dbus") - (shell - #~(string-append #$shadow "/sbin/nologin"))))) - (activate #~(begin - (use-modules (guix build utils)) - - (mkdir-p "/var/run/dbus") - - (let ((user (getpwnam "messagebus"))) - (chown "/var/run/dbus" - (passwd:uid user) (passwd:gid user))) - - (unless (file-exists? "/etc/machine-id") - (format #t "creating /etc/machine-id...~%") - (let ((prog (string-append #$dbus "/bin/dbus-uuidgen"))) - ;; XXX: We can't use 'system' because the initrd's - ;; guile system(3) only works when 'sh' is in $PATH. - (let ((pid (primitive-fork))) - (if (zero? pid) - (call-with-output-file "/etc/machine-id" - (lambda (port) - (close-fdes 1) - (dup2 (port->fdes port) 1) - (execl prog))) - (waitpid pid))))))))))) - -;;; dbus.scm ends here diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm new file mode 100644 index 0000000000..910dc1f9e0 --- /dev/null +++ b/gnu/services/desktop.scm @@ -0,0 +1,300 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015 Andy Wingo <wingo@igalia.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 services desktop) + #:use-module (gnu services) + #:use-module (gnu services base) + #:use-module (gnu services avahi) + #:use-module (gnu services xorg) + #:use-module (gnu services networking) + #:use-module (gnu services ssh) + #:use-module (gnu system shadow) + #:use-module (gnu packages glib) + #:use-module (gnu packages admin) + #:use-module (gnu packages gnome) + #:use-module (gnu packages avahi) + #:use-module (gnu packages wicd) + #:use-module (guix monads) + #:use-module (guix store) + #:use-module (guix gexp) + #:use-module (ice-9 match) + #:export (dbus-service + upower-service + colord-service + %desktop-services)) + +;;; Commentary: +;;; +;;; This module contains service definitions for a "desktop" environment. +;;; +;;; Code: + + +;;; +;;; D-Bus. +;;; + +(define (dbus-configuration-directory dbus services) + "Return a configuration directory for @var{dbus} that includes the +@code{etc/dbus-1/system.d} directories of each package listed in +@var{services}." + (define build + #~(begin + (use-modules (sxml simple) + (srfi srfi-1)) + + (define (services->sxml services) + ;; Return the SXML 'includedir' clauses for DIRS. + `(busconfig + ,@(append-map (lambda (dir) + `((includedir + ,(string-append dir "/etc/dbus-1/system.d")) + (servicedir ;for '.service' files + ,(string-append dir "/share/dbus-1/services")))) + services))) + + (mkdir #$output) + (copy-file (string-append #$dbus "/etc/dbus-1/system.conf") + (string-append #$output "/system.conf")) + + ;; The default 'system.conf' has an <includedir> clause for + ;; 'system.d', so create it. + (mkdir (string-append #$output "/system.d")) + + ;; 'system-local.conf' is automatically included by the default + ;; 'system.conf', so this is where we stuff our own things. + (call-with-output-file (string-append #$output "/system-local.conf") + (lambda (port) + (sxml->xml (services->sxml (list #$@services)) + port))))) + + (gexp->derivation "dbus-configuration" build)) + +(define* (dbus-service services #:key (dbus dbus)) + "Return a service that runs the \"system bus\", using @var{dbus}, with +support for @var{services}. + +@uref{http://dbus.freedesktop.org/, D-Bus} is an inter-process communication +facility. Its system bus is used to allow system services to communicate and +be notified of system-wide events. + +@var{services} must be a list of packages that provide an +@file{etc/dbus-1/system.d} directory containing additional D-Bus configuration +and policy files. For example, to allow avahi-daemon to use the system bus, +@var{services} must be equal to @code{(list avahi)}." + (mlet %store-monad ((conf (dbus-configuration-directory dbus services))) + (return + (service + (documentation "Run the D-Bus system daemon.") + (provision '(dbus-system)) + (requirement '(user-processes)) + (start #~(make-forkexec-constructor + (list (string-append #$dbus "/bin/dbus-daemon") + "--nofork" + (string-append "--config-file=" #$conf "/system.conf")))) + (stop #~(make-kill-destructor)) + (user-groups (list (user-group + (name "messagebus") + (system? #t)))) + (user-accounts (list (user-account + (name "messagebus") + (group "messagebus") + (system? #t) + (comment "D-Bus system bus user") + (home-directory "/var/run/dbus") + (shell + #~(string-append #$shadow "/sbin/nologin"))))) + (activate #~(begin + (use-modules (guix build utils)) + + (mkdir-p "/var/run/dbus") + + (let ((user (getpwnam "messagebus"))) + (chown "/var/run/dbus" + (passwd:uid user) (passwd:gid user))) + + (unless (file-exists? "/etc/machine-id") + (format #t "creating /etc/machine-id...~%") + (let ((prog (string-append #$dbus "/bin/dbus-uuidgen"))) + ;; XXX: We can't use 'system' because the initrd's + ;; guile system(3) only works when 'sh' is in $PATH. + (let ((pid (primitive-fork))) + (if (zero? pid) + (call-with-output-file "/etc/machine-id" + (lambda (port) + (close-fdes 1) + (dup2 (port->fdes port) 1) + (execl prog))) + (waitpid pid))))))))))) + + +;;; +;;; Upower D-Bus service. +;;; + +(define* (upower-configuration-file #:key watts-up-pro? poll-batteries? + ignore-lid? use-percentage-for-policy? + percentage-low percentage-critical + percentage-action time-low + time-critical time-action + critical-power-action) + "Return an upower-daemon configuration file." + (define (bool value) + (if value "true\n" "false\n")) + + (text-file "UPower.conf" + (string-append + "[UPower]\n" + "EnableWattsUpPro=" (bool watts-up-pro?) + "NoPollBatteries=" (bool (not poll-batteries?)) + "IgnoreLid=" (bool ignore-lid?) + "UsePercentageForPolicy=" (bool use-percentage-for-policy?) + "PercentageLow=" (number->string percentage-low) "\n" + "PercentageCritical=" (number->string percentage-critical) "\n" + "PercentageAction=" (number->string percentage-action) "\n" + "TimeLow=" (number->string time-low) "\n" + "TimeCritical=" (number->string time-critical) "\n" + "TimeAction=" (number->string time-action) "\n" + "CriticalPowerAction=" (match critical-power-action + ('hybrid-sleep "HybridSleep") + ('hibernate "Hibernate") + ('power-off "PowerOff")) + "\n"))) + +(define* (upower-service #:key (upower upower) + (watts-up-pro? #f) + (poll-batteries? #t) + (ignore-lid? #f) + (use-percentage-for-policy? #f) + (percentage-low 10) + (percentage-critical 3) + (percentage-action 2) + (time-low 1200) + (time-critical 300) + (time-action 120) + (critical-power-action 'hybrid-sleep)) + "Return a service that runs @uref{http://upower.freedesktop.org/, +@command{upowerd}}, a system-wide monitor for power consumption and battery +levels, with the given configuration settings. It implements the +@code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME." + (mlet %store-monad ((config (upower-configuration-file + #:watts-up-pro? watts-up-pro? + #:poll-batteries? poll-batteries? + #:ignore-lid? ignore-lid? + #:use-percentage-for-policy? use-percentage-for-policy? + #:percentage-low percentage-low + #:percentage-critical percentage-critical + #:percentage-action percentage-action + #:time-low time-low + #:time-critical time-critical + #:time-action time-action + #:critical-power-action critical-power-action))) + (return + (service + (documentation "Run the UPower power and battery monitor.") + (provision '(upower-daemon)) + (requirement '(dbus-system udev)) + + (start #~(make-forkexec-constructor + (list (string-append #$upower "/libexec/upowerd")) + #:environment-variables + (list (string-append "UPOWER_CONF_FILE_NAME=" #$config)))) + (stop #~(make-kill-destructor)) + (activate #~(begin + (use-modules (guix build utils)) + (mkdir-p "/var/lib/upower") + (let ((user (getpwnam "upower"))) + (chown "/var/lib/upower" + (passwd:uid user) (passwd:gid user))))) + + (user-groups (list (user-group + (name "upower") + (system? #t)))) + (user-accounts (list (user-account + (name "upower") + (group "upower") + (system? #t) + (comment "UPower daemon user") + (home-directory "/var/empty") + (shell + #~(string-append #$shadow "/sbin/nologin"))))))))) + + +;;; +;;; Colord D-Bus service. +;;; + +(define* (colord-service #:key (colord colord)) + "Return a service that runs @command{colord}, a system service with a D-Bus +interface to manage the color profiles of input and output devices such as +screens and scanners. It is notably used by the GNOME Color Manager graphical +tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web +site} for more information." + (with-monad %store-monad + (return + (service + (documentation "Run the colord color management service.") + (provision '(colord-daemon)) + (requirement '(dbus-system udev)) + + (start #~(make-forkexec-constructor + (list (string-append #$colord "/libexec/colord")))) + (stop #~(make-kill-destructor)) + (activate #~(begin + (use-modules (guix build utils)) + (mkdir-p "/var/lib/colord") + (let ((user (getpwnam "colord"))) + (chown "/var/lib/colord" + (passwd:uid user) (passwd:gid user))))) + + (user-groups (list (user-group + (name "colord") + (system? #t)))) + (user-accounts (list (user-account + (name "colord") + (group "colord") + (system? #t) + (comment "colord daemon user") + (home-directory "/var/empty") + (shell + #~(string-append #$shadow "/sbin/nologin"))))))))) + +(define %desktop-services + ;; List of services typically useful for a "desktop" use case. + (cons* (slim-service) + + (avahi-service) + (wicd-service) + (upower-service) + (colord-service) + (dbus-service (list avahi wicd upower colord)) + + (ntp-service) + (lsh-service) + + (map (lambda (mservice) + ;; Provide an nscd ready to use nss-mdns. + (mlet %store-monad ((service mservice)) + (if (memq 'nscd (service-provision service)) + (nscd-service (nscd-configuration) + #:name-services (list nss-mdns)) + mservice))) + %base-services))) + +;;; desktop.scm ends here diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index f9d262d977..102202c853 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -170,15 +170,33 @@ Protocol (DHCP) client, on all the non-loopback network interfaces." ;; up*. However, the relevant interfaces are ;; typically down at this point. Thus we perform our ;; own interface discovery here. - (let* ((valid? (negate loopback-network-interface?)) - (ifaces (filter valid? - (all-network-interfaces))) - (pid (fork+exec-command - (cons* #$dhclient "-nw" - "-pf" #$pid-file - ifaces)))) + (define valid? + (negate loopback-network-interface?)) + (define ifaces + (filter valid? (all-network-interfaces))) + + ;; XXX: Make sure the interfaces are up so that + ;; 'dhclient' can actually send/receive over them. + (for-each set-network-interface-up ifaces) + + (false-if-exception (delete-file #$pid-file)) + (let ((pid (fork+exec-command + (cons* #$dhclient "-nw" + "-pf" #$pid-file ifaces)))) (and (zero? (cdr (waitpid pid))) - (call-with-input-file #$pid-file read))))) + (let loop () + (catch 'system-error + (lambda () + (call-with-input-file #$pid-file read)) + (lambda args + ;; 'dhclient' returned before PID-FILE + ;; was created, so try again. + (let ((errno (system-error-errno args))) + (if (= ENOENT errno) + (begin + (sleep 1) + (loop)) + (apply throw args)))))))))) (stop #~(make-kill-destructor)))))) (define %ntp-servers diff --git a/gnu/services/upower.scm b/gnu/services/upower.scm deleted file mode 100644 index 3654c812f1..0000000000 --- a/gnu/services/upower.scm +++ /dev/null @@ -1,122 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Andy Wingo <wingo@igalia.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 services upower) - #:use-module (gnu services) - #:use-module (gnu system shadow) - #:use-module (gnu packages gnome) - #:use-module (ice-9 match) - #:use-module (guix monads) - #:use-module (guix store) - #:use-module (guix gexp) - #:export (upower-service)) - -;;; Commentary: -;;; -;;; This module provides service definitions for the UPower power and battery -;;; monitoring service. -;;; -;;; Code: - -(define* (configuration-file #:key watts-up-pro? poll-batteries? ignore-lid? - use-percentage-for-policy? percentage-low - percentage-critical percentage-action - time-low time-critical time-action - critical-power-action) - "Return an upower-daemon configuration file." - (define (bool value) - (if value "true\n" "false\n")) - - (text-file "UPower.conf" - (string-append - "[UPower]\n" - "EnableWattsUpPro=" (bool watts-up-pro?) - "NoPollBatteries=" (bool (not poll-batteries?)) - "IgnoreLid=" (bool ignore-lid?) - "UsePercentageForPolicy=" (bool use-percentage-for-policy?) - "PercentageLow=" (number->string percentage-low) "\n" - "PercentageCritical=" (number->string percentage-critical) "\n" - "PercentageAction=" (number->string percentage-action) "\n" - "TimeLow=" (number->string time-low) "\n" - "TimeCritical=" (number->string time-critical) "\n" - "TimeAction=" (number->string time-action) "\n" - "CriticalPowerAction=" (match critical-power-action - ('hybrid-sleep "HybridSleep") - ('hibernate "Hibernate") - ('power-off "PowerOff")) - "\n"))) - -(define* (upower-service #:key (upower upower) - (watts-up-pro? #f) - (poll-batteries? #t) - (ignore-lid? #f) - (use-percentage-for-policy? #f) - (percentage-low 10) - (percentage-critical 3) - (percentage-action 2) - (time-low 1200) - (time-critical 300) - (time-action 120) - (critical-power-action 'hybrid-sleep)) - "Return a service that runs @uref{http://upower.freedesktop.org/, -@command{upowerd}}, a system-wide monitor for power consumption and battery -levels, with the given configuration settings. It implements the -@code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME." - (mlet %store-monad ((config (configuration-file - #:watts-up-pro? watts-up-pro? - #:poll-batteries? poll-batteries? - #:ignore-lid? ignore-lid? - #:use-percentage-for-policy? use-percentage-for-policy? - #:percentage-low percentage-low - #:percentage-critical percentage-critical - #:percentage-action percentage-action - #:time-low time-low - #:time-critical time-critical - #:time-action time-action - #:critical-power-action critical-power-action))) - (return - (service - (documentation "Run the UPower power and battery monitor.") - (provision '(upower-daemon)) - (requirement '(dbus-system udev)) - - (start #~(make-forkexec-constructor - (list (string-append #$upower "/libexec/upowerd")) - #:environment-variables - (list (string-append "UPOWER_CONF_FILE_NAME=" #$config)))) - (stop #~(make-kill-destructor)) - (activate #~(begin - (use-modules (guix build utils)) - (mkdir-p "/var/lib/upower") - (let ((user (getpwnam "upower"))) - (chown "/var/lib/upower" - (passwd:uid user) (passwd:gid user))))) - - (user-groups (list (user-group - (name "upower") - (system? #t)))) - (user-accounts (list (user-account - (name "upower") - (group "upower") - (system? #t) - (comment "UPower daemon user") - (home-directory "/var/empty") - (shell - "/run/current-system/profile/sbin/nologin")))))))) - -;;; upower.scm ends here diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index c687b46bc2..9ee88170e4 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -37,7 +37,8 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) - #:export (xorg-start-command + #:export (xorg-configuration-file + xorg-start-command %default-slim-theme %default-slim-theme-name slim-service)) @@ -48,12 +49,10 @@ ;;; ;;; Code: -(define* (xorg-start-command #:key - (guile (canonical-package guile-2.0)) - (xorg-server xorg-server) - (drivers '()) (resolutions '())) - "Return a derivation that builds a @var{guile} script to start the X server -from @var{xorg-server}. Usually the X server is started by a login manager. +(define* (xorg-configuration-file #:key (drivers '()) (resolutions '()) + (extra-config '())) + "Return a configuration file for the Xorg server containing search paths for +all the common drivers. @var{drivers} must be either the empty list, in which case Xorg chooses a graphics driver automatically, or a list of driver names that will be tried in @@ -61,8 +60,11 @@ this order---e.g., @code{(\"modesetting\" \"vesa\")}. Likewise, when @var{resolutions} is the empty list, Xorg chooses an appropriate screen resolution; otherwise, it must be a list of -resolutions---e.g., @code{((1024 768) (640 480))}." +resolutions---e.g., @code{((1024 768) (640 480))}. +Last, @var{extra-config} is a list of strings or objects appended to the +@code{text-file*} argument list. It is used to pass extra text to be added +verbatim to the configuration file." (define (device-section driver) (string-append " Section \"Device\" @@ -78,15 +80,14 @@ Section \"Screen\" SubSection \"Display\" Modes " (string-join (map (match-lambda - ((x y) - (string-append "\"" (number->string x) - "x" (number->string y) "\""))) + ((x y) + (string-append "\"" (number->string x) + "x" (number->string y) "\""))) resolutions)) " EndSubSection EndSection")) - (define (xserver.conf) - (text-file* "xserver.conf" " + (apply text-file* "xserver.conf" " Section \"Files\" FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\" ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" @@ -98,6 +99,12 @@ Section \"Files\" ModulePath \"" xf86-video-nouveau "/lib/xorg/modules/drivers\" ModulePath \"" xf86-video-nv "/lib/xorg/modules/drivers\" ModulePath \"" xf86-video-sis "/lib/xorg/modules/drivers\" + + # Libinput is the new thing and is recommended over evdev/synaptics + # by those who know: + # <http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>. + ModulePath \"" xf86-input-libinput "/lib/xorg/modules/input\" + ModulePath \"" xf86-input-evdev "/lib/xorg/modules/input\" ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\" ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\" @@ -111,12 +118,27 @@ Section \"ServerFlags\" Option \"AllowMouseOpenFail\" \"on\" EndSection " - (string-join (map device-section drivers) "\n") + (string-join (map device-section drivers) "\n") "\n" (string-join (map (cut screen-section <> resolutions) drivers) - "\n"))) + "\n") + + "\n" + extra-config)) - (mlet %store-monad ((config (xserver.conf))) +(define* (xorg-start-command #:key + (guile (canonical-package guile-2.0)) + configuration-file + (xorg-server xorg-server)) + "Return a derivation that builds a @var{guile} script to start the X server +from @var{xorg-server}. @var{configuration-file} is the server configuration +file or a derivation that builds it; when omitted, the result of +@code{xorg-configuration-file} is used. + +Usually the X server is started by a login manager." + (mlet %store-monad ((config (if configuration-file + (return configuration-file) + (xorg-configuration-file)))) (define script ;; Write a small wrapper around the X server. #~(begin @@ -192,7 +214,7 @@ which should be passed to this script as the first argument. If not, the (define %default-slim-theme-name ;; This must be the name of the sub-directory in %DEFAULT-SLIM-THEME that ;; contains the actual theme files. - "0.8") + "0.x") (define* (slim-service #:key (slim slim) (allow-empty-passwords? #t) auto-login? @@ -207,6 +229,19 @@ which should be passed to this script as the first argument. If not, the turn starts the X display server with @var{startx}, a command as returned by @code{xorg-start-command}. +@cindex X session + +SLiM automatically looks for session types described by the @file{.desktop} +files in @file{/run/current-system/profile/share/xsessions} and allows users +to choose a session from the log-in screen using @kbd{F1}. Packages such as +@var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files; +adding them to the system-wide set of packages automatically makes them +available at the log-in screen. + +In addition, @file{~/.xsession} files are honored. When available, +@file{~/.xsession} must be an executable that starts a window manager +and/or other X clients. + When @var{allow-empty-passwords?} is true, allow logins with an empty password. When @var{auto-login?} is true, log in automatically as @var{default-user} with @var{auto-login-session}. @@ -217,7 +252,9 @@ theme to use. In that case, @var{theme-name} specifies the name of the theme." (define (slim.cfg) - (mlet %store-monad ((startx (or startx (xorg-start-command))) + (mlet %store-monad ((startx (if startx + (return startx) + (xorg-start-command))) (xinitrc (xinitrc #:fallback-session auto-login-session))) (text-file* "slim.cfg" " diff --git a/gnu/system.scm b/gnu/system.scm index 609604a9b5..92ed454b2c 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -25,6 +25,7 @@ #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix profiles) + #:use-module (guix ui) #:use-module (gnu packages base) #:use-module (gnu packages bash) #:use-module (gnu packages guile) @@ -109,7 +110,7 @@ (default %base-firmware)) (host-name operating-system-host-name) ; string - (hosts-file operating-system-hosts-file ; M item | #f + (hosts-file operating-system-hosts-file ; file-like | #f (default #f)) (mapped-devices operating-system-mapped-devices ; list of <mapped-device> @@ -119,7 +120,7 @@ (default '())) (users operating-system-users ; list of user accounts - (default '())) + (default %base-user-accounts)) (groups operating-system-groups ; list of user groups (default %base-groups)) @@ -147,7 +148,7 @@ (setuid-programs operating-system-setuid-programs (default %setuid-programs)) ; list of string-valued gexps - (sudoers operating-system-sudoers ; /etc/sudoers contents + (sudoers operating-system-sudoers ; file-like (default %sudoers-specification))) @@ -373,7 +374,7 @@ This is the GNU system. Welcome.\n") (define (default-/etc/hosts host-name) "Return the default /etc/hosts file." - (text-file "hosts" (local-host-aliases host-name))) + (plain-file "hosts" (local-host-aliases host-name))) (define (emacs-site-file) "Return the Emacs 'site-start.el' file. That file contains the necessary @@ -439,11 +440,10 @@ on SHELLS. /etc/shells is used by xterm, polkit, and other programs." (pam-services '()) (profile "/run/current-system/profile") hosts-file nss (shells '()) - (sudoers "")) + (sudoers (plain-file "sudoers" ""))) "Return a derivation that builds the static part of the /etc directory." (mlet* %store-monad ((pam.d (pam-services->directory pam-services)) - (sudoers (text-file "sudoers" sudoers)) (login.defs (text-file "login.defs" "# Empty for now.\n")) (shells (shells-file shells)) (emacs (emacs-site-directory)) @@ -461,14 +461,40 @@ export TZDIR=\"" tzdata "/share/zoneinfo\" # Tell 'modprobe' & co. where to look for modules. export LINUX_MODULE_DIRECTORY=/run/booted-system/kernel/lib/modules -export PATH=$HOME/.guix-profile/bin:/run/current-system/profile/bin -export PATH=/run/setuid-programs:/run/current-system/profile/sbin:$PATH +# These variables are honored by OpenSSL (libssl) and Git. +export SSL_CERT_DIR=/etc/ssl/certs +export SSL_CERT_FILE=\"$SSL_CERT_DIR/ca-certificates.crt\" +export GIT_SSL_CAINFO=\"$SSL_CERT_FILE\" + +# Crucial variables that could be missing the the profiles' 'etc/profile' +# because they would require combining both profiles. +# FIXME: See <http://bugs.gnu.org/20255>. export MANPATH=$HOME/.guix-profile/share/man:/run/current-system/profile/share/man export INFOPATH=$HOME/.guix-profile/share/info:/run/current-system/profile/share/info - export XDG_DATA_DIRS=$HOME/.guix-profile/share:/run/current-system/profile/share export XDG_CONFIG_DIRS=$HOME/.guix-profile/etc/xdg:/run/current-system/profile/etc/xdg +# Ignore the default value of 'PATH'. +unset PATH + +# Load the system profile's settings. +GUIX_PROFILE=/run/current-system/profile \\ +. /run/current-system/profile/etc/profile + +# Prepend setuid programs. +export PATH=/run/setuid-programs:$PATH + +if [ -f \"$HOME/.guix-profile/etc/profile\" ] +then + # Load the user profile's settings. + GUIX_PROFILE=\"$HOME/.guix-profile\" \\ + . \"$HOME/.guix-profile/etc/profile\" +else + # At least define this one so that basic things just work + # when the user installs their first package. + export PATH=\"$HOME/.guix-profile/bin:$PATH\" +fi + # Append the directory of 'site-start.el' to the search path. export EMACSLOADPATH=:/etc/emacs @@ -476,18 +502,13 @@ export EMACSLOADPATH=:/etc/emacs # when /etc/machine-id is missing. Make sure these warnings are non-fatal. export DBUS_FATAL_WARNINGS=0 -# These variables are honored by OpenSSL (libssl) and Git. -export SSL_CERT_DIR=/etc/ssl/certs -export SSL_CERT_FILE=\"$SSL_CERT_DIR/ca-certificates.crt\" -export GIT_SSL_CAINFO=\"$SSL_CERT_FILE\" - # Allow Aspell to find dictionaries installed in the user profile. export ASPELL_CONF=\"dict-dir $HOME/.guix-profile/lib/aspell\" if [ -n \"$BASH_VERSION\" -a -f /etc/bashrc ] then # Load Bash-specific initialization code. - source /etc/bashrc + . /etc/bashrc fi ")) @@ -519,7 +540,7 @@ fi\n")) ("hosts" ,#~#$hosts-file) ("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/" #$timezone)) - ("sudoers" ,#~#$sudoers))))) + ("sudoers" ,sudoers))))) (define (operating-system-profile os) "Return a derivation that builds the system profile of OS." @@ -549,6 +570,37 @@ fi\n")) (return (append users (append-map service-user-accounts services))))) +(define (maybe-string->file file-name thing) + "If THING is a string, return a <plain-file> with THING as its content. +Otherwise just return THING. + +This is for backward-compatibility of fields that used to be strings and are +now file-like objects.." + (match thing + ((? string?) + (warning (_ "using a string for file '~a' is deprecated; \ +use 'plain-file' instead~%") + file-name) + (plain-file file-name thing)) + (x + x))) + +(define (maybe-file->monadic file-name thing) + "If THING is a value in %STORE-MONAD, return it as is; otherwise return +THING in the %STORE-MONAD. + +This is for backward-compatibility of fields that used to be monadic values +and are now file-like objects." + (with-monad %store-monad + (match thing + ((? procedure?) + (warning (_ "using a monadic value for '~a' is deprecated; \ +use 'plain-file' instead~%") + file-name) + thing) + (x + (return x))))) + (define (operating-system-etc-directory os) "Return that static part of the /etc directory of OS." (mlet* %store-monad @@ -559,8 +611,10 @@ fi\n")) (append-map service-pam-services services))) (profile-drv (operating-system-profile os)) (skeletons (operating-system-skeletons os)) - (/etc/hosts (or (operating-system-hosts-file os) - (default-/etc/hosts (operating-system-host-name os)))) + (/etc/hosts (maybe-file->monadic + "hosts" + (or (operating-system-hosts-file os) + (default-/etc/hosts (operating-system-host-name os))))) (shells (user-shells os))) (etc-directory #:pam-services pam-services #:skeletons skeletons @@ -570,7 +624,9 @@ fi\n")) #:timezone (operating-system-timezone os) #:hosts-file /etc/hosts #:shells shells - #:sudoers (operating-system-sudoers os) + #:sudoers (maybe-string->file + "sudoers" + (operating-system-sudoers os)) #:profile profile-drv))) (define %setuid-programs @@ -587,8 +643,9 @@ fi\n")) ;; group can do anything. See ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>. ;; TODO: Add a declarative API. - "root ALL=(ALL) ALL -%wheel ALL=(ALL) ALL\n") + (plain-file "sudoers" "\ +root ALL=(ALL) ALL +%wheel ALL=(ALL) ALL\n")) (define (user-group->gexp group) "Turn GROUP, a <user-group> object, into a list-valued gexp suitable for @@ -665,6 +722,8 @@ etc." (define group-specs (map user-group->gexp groups)) + (assert-valid-users/groups accounts groups) + (gexp->file "activate" #~(begin (eval-when (expand load eval) diff --git a/gnu/system/os-config.tmpl b/gnu/system/examples/bare-bones.tmpl index e14c95733a..dc5cfc81a4 100644 --- a/gnu/system/os-config.tmpl +++ b/gnu/system/examples/bare-bones.tmpl @@ -1,12 +1,13 @@ -;; This is an operating system configuration template. +;; This is an operating system configuration template +;; for a "bare bones" setup, with no X11 display server. (use-modules (gnu)) -(use-service-modules xorg networking dbus avahi) -(use-package-modules xorg avahi) +(use-service-modules networking ssh) +(use-package-modules admin) (operating-system - (host-name "antelope") - (timezone "Europe/Paris") + (host-name "komputilo") + (timezone "Europe/Berlin") (locale "en_US.UTF-8") ;; Assuming /dev/sdX is the target hard disk, and "root" is @@ -22,7 +23,7 @@ ;; This is where user accounts are specified. The "root" ;; account is implicit, and is initially created with the ;; empty password. - (users (list (user-account + (users (cons (user-account (name "alice") (comment "Bob's sister") (group "users") @@ -33,15 +34,14 @@ ;; and access the webcam. (supplementary-groups '("wheel" "audio" "video")) - (home-directory "/home/alice")))) + (home-directory "/home/alice")) + %base-user-accounts)) ;; Globally-installed packages. - (packages (cons xterm %base-packages)) + (packages (cons tcpdump %base-packages)) - ;; Add services to the baseline: the SLiM log-in manager - ;; for Xorg sessions, a DHCP client, Avahi, and D-Bus. - (services (cons* (slim-service) - (dhcp-client-service) - (avahi-service) - (dbus-service (list avahi)) + ;; Add services to the baseline: a DHCP client and + ;; an SSH server. + (services (cons* (dhcp-client-service) + (lsh-service #:port-number 2222) %base-services))) diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl new file mode 100644 index 0000000000..988b8f937f --- /dev/null +++ b/gnu/system/examples/desktop.tmpl @@ -0,0 +1,44 @@ +;; This is an operating system configuration template +;; for a "desktop" setup with X11. + +(use-modules (gnu) (gnu system nss)) +(use-service-modules desktop) +(use-package-modules xfce ratpoison wicd avahi xorg certs) + +(operating-system + (host-name "antelope") + (timezone "Europe/Paris") + (locale "en_US.UTF-8") + + ;; Assuming /dev/sdX is the target hard disk, and "root" is + ;; the label of the target root file system. + (bootloader (grub-configuration (device "/dev/sdX"))) + (file-systems (cons (file-system + (device "root") + (title 'label) + (mount-point "/") + (type "ext4")) + %base-file-systems)) + + (users (cons (user-account + (name "bob") + (comment "Alice's brother") + (group "users") + (supplementary-groups '("wheel" "netdev" + "audio" "video")) + (home-directory "/home/bob")) + %base-user-accounts)) + + ;; Add Xfce and Ratpoison; that allows us to choose + ;; sessions using either of these at the log-in screen. + (packages (cons* xfce ratpoison ;desktop environments + xterm wicd avahi ;useful tools + nss-certs ;for HTTPS access + %base-packages)) + + ;; Use the "desktop" services, which include the X11 + ;; log-in service, networking with Wicd, and more. + (services %desktop-services) + + ;; Allow resolution of '.local' host names with mDNS. + (name-service-switch %mdns-host-lookup-nss)) diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 17b08aa9b7..e49b6dbe54 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -80,7 +80,8 @@ (define %background-image (grub-image (aspect-ratio 4/3) - (file #~(string-append #$%artwork-repository "/grub/GuixSD-4-3.svg")))) + (file #~(string-append #$%artwork-repository + "/grub/GuixSD-fully-black-4-3.svg")))) (define %default-theme ;; Default theme contributed by Felipe López. diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 2fd35e8c48..27d8ecdefc 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,7 @@ #:use-module ((guix store) #:select (%store-prefix)) #:use-module (guix profiles) #:use-module (gnu packages admin) + #:use-module (gnu packages bash) #:use-module (gnu packages linux) #:use-module (gnu packages cryptsetup) #:use-module (gnu packages package-management) @@ -31,6 +33,8 @@ #:use-module (gnu packages grub) #:use-module (gnu packages texinfo) #:use-module (gnu packages compression) + #:use-module (ice-9 match) + #:use-module (srfi srfi-26) #:export (self-contained-tarball installation-os)) @@ -67,7 +71,16 @@ under /root/.guix-profile where GUIX is installed." ;; length limitation. (with-directory-excursion %root (zero? (system* "tar" "--xz" "--format=gnu" - "-cvf" #$output "."))))) + "--owner=root:0" "--group=root:0" + "-cvf" #$output + ;; Avoid adding / and /var to the tarball, + ;; so that the ownership and permissions of those + ;; directories will not be overwritten when + ;; extracting the archive. Do not include /root + ;; because the root account might have a different + ;; home directory. + "./var/guix" + (string-append "." (%store-directory))))))) (gexp->derivation "guix-tarball.tar.xz" build #:references-graphs `(("profile" ,profile)) @@ -171,12 +184,17 @@ the given target.") "Return a dummy service whose purpose is to install an operating system configuration template file in the installation system." - (define local-template - "/etc/configuration-template.scm") - (define template - (search-path %load-path "gnu/system/os-config.tmpl")) + (define search + (cut search-path %load-path <>)) + (define templates + (map (match-lambda + ((file '-> target) + (list (local-file (search file)) + (string-append "/etc/configuration/" target)))) + '(("gnu/system/examples/bare-bones.tmpl" -> "bare-bones.scm") + ("gnu/system/examples/desktop.tmpl" -> "desktop.scm")))) - (mlet %store-monad ((template (interned-file template))) + (with-monad %store-monad (return (service (requirement '(root-file-system)) (provision '(os-config-template)) @@ -185,8 +203,16 @@ configuration template file in the installation system." (start #~(const #t)) (stop #~(const #f)) (activate - #~(unless (file-exists? #$local-template) - (copy-file #$template #$local-template))))))) + #~(begin + (use-modules (ice-9 match) + (guix build utils)) + + (mkdir-p "/etc/configuration") + (for-each (match-lambda + ((file target) + (unless (file-exists? target) + (copy-file file target)))) + '#$templates))))))) (define %nscd-minimal-caches ;; Minimal in-memory caching policy for nscd. @@ -316,6 +342,7 @@ Use Alt-F2 for documentation. ;; 2.0.0a, that pulls Guile 1.8, which takes unreasonable ;; space; furthermore util-linux's fdisk is already ;; available here, so we keep that. + bash-completion %base-packages)))) ;; Return it here so 'guix system' can consume it directly. diff --git a/gnu/system/nss.scm b/gnu/system/nss.scm index ec2d2517e7..f4d2855289 100644 --- a/gnu/system/nss.scm +++ b/gnu/system/nss.scm @@ -29,6 +29,8 @@ lookup-specification %default-nss + %mdns-host-lookup-nss + %files %compat %dns @@ -148,6 +150,27 @@ ;; Default NSS configuration. (name-service-switch)) +(define %mdns-host-lookup-nss + (name-service-switch + (hosts (list %files ;first, check /etc/hosts + + ;; If the above did not succeed, try with 'mdns_minimal'. + (name-service + (name "mdns_minimal") + + ;; 'mdns_minimal' is authoritative for '.local'. When it + ;; returns "not found", no need to try the next methods. + (reaction (lookup-specification + (not-found => return)))) + + ;; Then fall back to DNS. + (name-service + (name "dns")) + + ;; Finally, try with the "full" 'mdns'. + (name-service + (name "mdns")))))) + ;;; ;;; Serialization. diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 16b9e4b555..aa97652678 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -21,12 +21,17 @@ #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix monads) + #:use-module (guix sets) + #:use-module (guix ui) #:use-module ((gnu system file-systems) #:select (%tty-gid)) #:use-module ((gnu packages admin) #:select (shadow)) #:use-module (gnu packages bash) #:use-module (gnu packages guile-wm) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:export (user-account user-account? user-account-name @@ -48,7 +53,9 @@ default-skeletons skeleton-directory - %base-groups)) + %base-groups + %base-user-accounts + assert-valid-users/groups)) ;;; Commentary: ;;; @@ -107,6 +114,16 @@ (system-group (name "tape")) (system-group (name "kvm"))))) ; for /dev/kvm +(define %base-user-accounts + ;; List of standard user accounts. Note that "root" is a special case, so + ;; it's not listed here. + (list (user-account + (name "nobody") + (uid 65534) + (group "nogroup") + (home-directory "/var/empty") + (system? #t)))) + (define (default-skeletons) "Return the default skeleton files for /etc/skel. These files are copied by 'useradd' in the home directory of newly created user accounts." @@ -176,4 +193,31 @@ set debug-file-directory ~/.guix-profile/lib/debug\n"))) '#$skeletons) #t))) +(define (assert-valid-users/groups users groups) + "Raise an error if USERS refer to groups not listed in GROUPS." + (let ((groups (list->set (map user-group-name groups)))) + (define (validate-supplementary-group user group) + (unless (set-contains? groups group) + (raise (condition + (&message + (message + (format #f (_ "supplementary group '~a' \ +of user '~a' is undeclared") + group + (user-account-name user)))))))) + + (for-each (lambda (user) + (unless (set-contains? groups (user-account-group user)) + (raise (condition + (&message + (message + (format #f (_ "primary group '~a' \ +of user '~a' is undeclared") + (user-account-group user) + (user-account-name user))))))) + + (for-each (cut validate-supplementary-group user <>) + (user-account-supplementary-groups user))) + users))) + ;;; shadow.scm ends here diff --git a/guix/base32.scm b/guix/base32.scm index e0599dc01e..7b2e2a6712 100644 --- a/guix/base32.scm +++ b/guix/base32.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,6 +18,8 @@ (define-module (guix base32) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-60) #:use-module (rnrs bytevectors) #:use-module (ice-9 vlist) @@ -25,7 +27,11 @@ bytevector->base32-string bytevector->nix-base32-string base32-string->bytevector - nix-base32-string->bytevector)) + nix-base32-string->bytevector + &invalid-base32-character + invalid-base32-character? + invalid-base32-character-value + invalid-base32-character-string)) ;;; Commentary: ;;; @@ -264,6 +270,12 @@ starting from the right of S." s) bv)) +;; Invalid base32 character error condition when decoding base32. +(define-condition-type &invalid-base32-character &error + invalid-base32-character? + (character invalid-base32-character-value) + (string invalid-base32-character-string)) + (define (make-base32-string->bytevector base32-string-unfold base32-chars) (let ((char->value (let loop ((i 0) (v vlist-null)) @@ -276,7 +288,10 @@ starting from the right of S." "Return the binary representation of base32 string S as a bytevector." (base32-string-unfold (lambda (chr) (or (and=> (vhash-assv chr char->value) cdr) - (error "invalid base32 character" chr))) + (raise (condition + (&invalid-base32-character + (character chr) + (string s)))))) s)))) (define base32-string->bytevector diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm index 1bc1879be5..25ac262d5d 100644 --- a/guix/build-system/cmake.scm +++ b/guix/build-system/cmake.scm @@ -21,6 +21,7 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix derivations) + #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (guix packages) diff --git a/guix/build-system/glib-or-gtk.scm b/guix/build-system/glib-or-gtk.scm index 954c716893..a1f0a9b8a4 100644 --- a/guix/build-system/glib-or-gtk.scm +++ b/guix/build-system/glib-or-gtk.scm @@ -22,6 +22,7 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix derivations) + #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (guix packages) diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 3ccdef1328..da664e5422 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -20,6 +20,7 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix derivations) + #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix packages) #:use-module (srfi srfi-1) @@ -204,9 +205,10 @@ runs `make distcheck' and whose result is one or more source tarballs." ;; Add autotools & co. as inputs. (let ((ref (lambda (module var) (module-ref (resolve-interface module) var)))) - `(("autoconf" ,(ref '(gnu packages autotools) 'autoconf)) + `(,@(package-native-inputs p) + ("autoconf" ,(ref '(gnu packages autotools) 'autoconf)) ("automake" ,(ref '(gnu packages autotools) 'automake)) - ("libtool" ,(ref '(gnu packages autotools) 'libtool) "bin") + ("libtool" ,(ref '(gnu packages autotools) 'libtool)) ("gettext" ,(ref '(gnu packages gettext) 'gnu-gettext)) ("texinfo" ,(ref '(gnu packages texinfo) 'texinfo)))))))) diff --git a/guix/build-system/haskell.scm b/guix/build-system/haskell.scm index 0fbf0b8e75..1cb734631c 100644 --- a/guix/build-system/haskell.scm +++ b/guix/build-system/haskell.scm @@ -21,6 +21,7 @@ #:use-module (guix utils) #:use-module (guix packages) #:use-module (guix derivations) + #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (ice-9 match) diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm index 7833153676..06af1dd20e 100644 --- a/guix/build-system/perl.scm +++ b/guix/build-system/perl.scm @@ -20,6 +20,7 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix derivations) + #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (guix packages) diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index d498cf618b..e9fffcc62f 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -23,6 +23,7 @@ #:use-module (guix utils) #:use-module (guix packages) #:use-module (guix derivations) + #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (ice-9 match) diff --git a/guix/build-system/ruby.scm b/guix/build-system/ruby.scm index 83bc93d901..e4fda30cf3 100644 --- a/guix/build-system/ruby.scm +++ b/guix/build-system/ruby.scm @@ -22,6 +22,7 @@ #:use-module (guix utils) #:use-module (guix packages) #:use-module (guix derivations) + #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (ice-9 match) diff --git a/guix/build-system/waf.scm b/guix/build-system/waf.scm index c67f649fa7..044d2a0829 100644 --- a/guix/build-system/waf.scm +++ b/guix/build-system/waf.scm @@ -21,6 +21,7 @@ #:use-module (guix utils) #:use-module (guix packages) #:use-module (guix derivations) + #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module ((guix build-system python) diff --git a/guix/build/download.scm b/guix/build/download.scm index 2e0b019d38..65d18eb839 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -19,7 +19,7 @@ (define-module (guix build download) #:use-module (web uri) - #:use-module (web client) + #:use-module ((web client) #:hide (open-socket-for-uri)) #:use-module (web response) #:use-module (guix ftp-client) #:use-module (guix build utils) @@ -30,7 +30,8 @@ #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:use-module (ice-9 format) - #:export (open-connection-for-uri + #:export (open-socket-for-uri + open-connection-for-uri resolve-uri-reference maybe-expand-mirrors url-fetch @@ -195,6 +196,25 @@ host name without trailing dot." (add-weak-reference record port) record))) +(define (open-socket-for-uri uri) + "Return an open port for URI. This variant works around +<http://bugs.gnu.org/15368> which affects Guile's 'open-socket-for-uri' up to +2.0.11 included." + (define rmem-max + ;; The maximum size for a receive buffer on Linux, see socket(7). + "/proc/sys/net/core/rmem_max") + + (define buffer-size + (if (file-exists? rmem-max) + (call-with-input-file rmem-max read) + 126976)) ;the default for Linux, per 'rmem_default' + + (let ((s ((@ (web client) open-socket-for-uri) uri))) + ;; Work around <http://bugs.gnu.org/15368> by restoring a decent + ;; buffer size. + (setsockopt s SOL_SOCKET SO_RCVBUF buffer-size) + s)) + (define (open-connection-for-uri uri) "Like 'open-socket-for-uri', but also handle HTTPS connections." (define https? @@ -218,6 +238,9 @@ host name without trailing dot." (thunk))))))) (with-https-proxy (let ((s (open-socket-for-uri uri))) + ;; Buffer input and output on this port. + (setvbuf s _IOFBF %http-receive-buffer-size) + (if https? (tls-wrap s (uri-host uri)) s))))) diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm new file mode 100644 index 0000000000..6e316d5d2c --- /dev/null +++ b/guix/build/profiles.scm @@ -0,0 +1,149 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 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 profiles) + #:use-module (guix build union) + #:use-module (guix build utils) + #:use-module (guix search-paths) + #:use-module (srfi srfi-26) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (ice-9 pretty-print) + #:export (ensure-writable-directory + build-profile)) + +;;; Commentary: +;;; +;;; Build a user profile (essentially the union of all the installed packages) +;;; with its associated meta-data. +;;; +;;; Code: + +(define (abstract-profile profile) + "Return a procedure that replaces PROFILE in VALUE with a reference to the +'GUIX_PROFILE' environment variable. This allows users to specify what the +user-friendly name of the profile is, for instance ~/.guix-profile rather than +/gnu/store/...-profile." + (let ((replacement (string-append "${GUIX_PROFILE:-" profile "}"))) + (match-lambda + ((search-path . value) + (let* ((separator (search-path-specification-separator search-path)) + (items (string-tokenize* value separator)) + (crop (cute string-drop <> (string-length profile)))) + (cons search-path + (string-join (map (lambda (str) + (string-append replacement (crop str))) + items) + separator))))))) + +(define (write-environment-variable-definition port) + "Write the given environment variable definition to PORT." + (match-lambda + ((search-path . value) + (display (search-path-definition search-path value #:kind 'prefix) + port) + (newline port)))) + +(define (build-etc/profile output search-paths) + "Build the 'OUTPUT/etc/profile' shell file containing environment variable +definitions for all the SEARCH-PATHS." + (mkdir-p (string-append output "/etc")) + (call-with-output-file (string-append output "/etc/profile") + (lambda (port) + ;; The use of $GUIX_PROFILE described below is not great. Another + ;; option would have been to use "$1" and have users run: + ;; + ;; source ~/.guix-profile/etc/profile ~/.guix-profile + ;; + ;; However, when 'source' is used with no arguments, $1 refers to the + ;; first positional parameter of the calling scripts, so we can rely on + ;; it. + (display "\ +# Source this file to define all the relevant environment variables in Bash +# for this profile. You may want to define the 'GUIX_PROFILE' environment +# variable to point to the \"visible\" name of the profile, like this: +# +# GUIX_PROFILE=/path/to/profile +# source /path/to/profile/etc/profile +# +# When GUIX_PROFILE is undefined, the various environment variables refer +# to this specific profile generation. +\n" port) + (let ((variables (evaluate-search-paths (cons $PATH search-paths) + (list output)))) + (for-each (write-environment-variable-definition port) + (map (abstract-profile output) variables)))))) + +(define (ensure-writable-directory directory) + "Ensure DIRECTORY exists and is writable. If DIRECTORY is currently a +symlink (to a read-only directory in the store), then delete the symlink and +instead make DIRECTORY a \"real\" directory containing symlinks." + (define (unsymlink link) + (let* ((target (readlink link)) + ;; TARGET might itself be a symlink, so append "/" to make sure + ;; 'scandir' enters it. + (files (scandir (string-append target "/") + (negate (cut member <> '("." "..")))))) + (delete-file link) + (mkdir link) + (for-each (lambda (file) + (symlink (string-append target "/" file) + (string-append link "/" file))) + files))) + + (catch 'system-error + (lambda () + (mkdir directory)) + (lambda args + (let ((errno (system-error-errno args))) + (if (= errno EEXIST) + (let ((stat (lstat directory))) + (case (stat:type stat) + ((symlink) + ;; "Unsymlink" DIRECTORY so that it is writable. + (unsymlink directory)) + ((directory) + #t) + (else + (error "cannot mkdir because a same-named file exists" + directory)))) + (apply throw args)))))) + +(define* (build-profile output inputs + #:key manifest search-paths) + "Build a user profile from INPUTS in directory OUTPUT. Write MANIFEST, an +sexp, to OUTPUT/manifest. Create OUTPUT/etc/profile with Bash definitions for +-all the variables listed in SEARCH-PATHS." + ;; Make the symlinks. + (union-build output inputs + #:log-port (%make-void-port "w")) + + ;; Store meta-data. + (call-with-output-file (string-append output "/manifest") + (lambda (p) + (pretty-print manifest p))) + + ;; Make sure we can write to 'OUTPUT/etc'. 'union-build' above could have + ;; made 'etc' a symlink to a read-only sub-directory in the store so we need + ;; to work around that. + (ensure-writable-directory (string-append output "/etc")) + + ;; Write 'OUTPUT/etc/profile'. + (build-etc/profile output search-paths)) + +;;; profile.scm ends here diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index b62a8cce64..3585bf27a8 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,6 +29,7 @@ MS_REMOUNT MS_BIND MS_MOVE + restart-on-EINTR mount umount mount-points @@ -46,6 +47,7 @@ network-interface-address set-network-interface-flags set-network-interface-address + set-network-interface-up configure-network-interface)) ;;; Commentary: @@ -88,6 +90,19 @@ (ref bv)))) (lambda () 0))) +(define (call-with-restart-on-EINTR thunk) + (let loop () + (catch 'system-error + thunk + (lambda args + (if (= (system-error-errno args) EINTR) + (loop) + (apply throw args)))))) + +(define-syntax-rule (restart-on-EINTR expr) + "Evaluate EXPR and restart upon EINTR. Return the value of EXPR." + (call-with-restart-on-EINTR (lambda () expr))) + (define (augment-mtab source target type options) "Augment /etc/mtab with information about the given mount point." (let ((port (open-file "/etc/mtab" "a"))) @@ -203,7 +218,7 @@ constants from <sys/mount.h>." (let ((ret (proc (string->pointer device))) (err (errno))) (unless (zero? ret) - (throw 'system-error "swapff" "~S: ~A" + (throw 'system-error "swapoff" "~S: ~A" (list device (strerror err)) (list err))))))) @@ -552,4 +567,17 @@ the same type as that returned by 'make-socket-address'." (lambda () (close-port sock))))) +(define* (set-network-interface-up name + #:key (family AF_INET)) + "Turn up the interface NAME." + (let ((sock (socket family SOCK_STREAM 0))) + (dynamic-wind + (const #t) + (lambda () + (let ((flags (network-interface-flags sock name))) + (set-network-interface-flags sock name + (logior flags IFF_UP)))) + (lambda () + (close-port sock))))) + ;;; syscalls.scm ends here diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm index ab72405df0..37feb895a5 100644 --- a/guix/ftp-client.scm +++ b/guix/ftp-client.scm @@ -109,11 +109,8 @@ or a TCP port number), and return it." (%ftp-login "anonymous" "guix@example.com" s) (%make-ftp-connection s ai)) (begin - (format (current-error-port) - "FTP to `~a' failed: ~A: ~A~%" - host code message) (close s) - #f)))) + (throw 'ftp-error s "log-in" code message))))) (lambda args ;; Connection failed, so try one of the other addresses. diff --git a/guix/gexp.scm b/guix/gexp.scm index b08a361232..10056e5a1f 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -31,8 +31,17 @@ gexp-input gexp-input? + local-file local-file? + local-file-file + local-file-name + local-file-recursive? + + plain-file + plain-file? + plain-file-name + plain-file-content gexp->derivation gexp->file @@ -137,7 +146,7 @@ cross-compiling.)" ;;; -;;; Local files. +;;; File declarations. ;;; (define-record-type <local-file> @@ -166,6 +175,28 @@ This is the declarative counterpart of the 'interned-file' monadic procedure." (($ <local-file> file name recursive?) (interned-file file name #:recursive? recursive?)))) +(define-record-type <plain-file> + (%plain-file name content references) + plain-file? + (name plain-file-name) ;string + (content plain-file-content) ;string + (references plain-file-references)) ;list (currently unused) + +(define (plain-file name content) + "Return an object representing a text file called NAME with the given +CONTENT (a string) to be added to the store. + +This is the declarative counterpart of 'text-file'." + ;; XXX: For now just ignore 'references' because it's not clear how to use + ;; them in a declarative context. + (%plain-file name content '())) + +(define-gexp-compiler (plain-file-compiler (file plain-file?) system target) + ;; "Compile" FILE by adding it to the store. + (match file + (($ <plain-file> name content references) + (text-file name content references)))) + ;;; ;;; Inputs & outputs. diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 0528e9f253..8d47cee487 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010, 2011, 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; ;;; This file is part of GNU Guix. @@ -179,9 +179,18 @@ network to check in GNU's database." (define (mirror-type url) (let ((uri (string->uri url))) (and (eq? (uri-scheme uri) 'mirror) - (if (member (uri-host uri) '("gnu" "gnupg" "gcc")) - 'gnu - 'non-gnu)))) + (cond + ((member (uri-host uri) + '("gnu" "gnupg" "gcc" "gnome")) + ;; Definitely GNU. + 'gnu) + ((equal? (uri-host uri) "cran") + ;; Possibly GNU: mirror://cran could be either GNU R itself + ;; or a non-GNU package. + #f) + (else + ;; Definitely non-GNU. + 'non-gnu))))) (let ((url (and=> (package-source package) origin-uri)) (name (package-name package))) @@ -348,7 +357,8 @@ open (resp. close) FTP connections; this can be useful to reuse connections." (let-values (((server directory) (ftp-server/directory project))) (define conn (ftp-open server)) - (let loop ((directory directory)) + (let loop ((directory directory) + (result #f)) (let* ((entries (ftp-list conn directory)) ;; Filter out sub-directories that do not contain digits---e.g., @@ -360,32 +370,38 @@ open (resp. close) FTP connections; this can be useful to reuse connections." (((? contains-digit? dir) 'directory . _) dir) (_ #f)) - entries))) - (match subdirs - (() - ;; No sub-directories, so assume that tarballs are here. - (let ((releases (filter-map (match-lambda - ((file 'file . _) - (and (release-file? project file) - (gnu-release - (package project) - (version - (tarball->version file)) - (directory directory) - (files (list file))))) - (_ #f)) - entries))) - (ftp-close conn) - (reduce latest-release #f (coalesce-releases releases)))) - ((subdirs ...) - ;; Assume that SUBDIRS correspond to versions, and jump into the - ;; one with the highest version number. - (let ((target (reduce latest #f subdirs))) - (if target - (loop (string-append directory "/" target)) - (begin - (ftp-close conn) - #f))))))))) + entries)) + + ;; Whether or not SUBDIRS is empty, compute the latest releases + ;; for the current directory. This is necessary for packages + ;; such as 'sharutils' that have a sub-directory that contains + ;; only an older release. + (releases (filter-map (match-lambda + ((file 'file . _) + (and (release-file? project file) + (gnu-release + (package project) + (version + (tarball->version file)) + (directory directory) + (files (list file))))) + (_ #f)) + entries))) + + ;; Assume that SUBDIRS correspond to versions, and jump into the + ;; one with the highest version number. + (let* ((release (reduce latest-release #f + (coalesce-releases releases))) + (result (if (and result release) + (latest-release release result) + (or release result))) + (target (reduce latest #f subdirs))) + (if target + (loop (string-append directory "/" target) + result) + (begin + (ftp-close conn) + result))))))) (define (gnu-release-archive-types release) "Return the available types of archives for RELEASE---a list of strings such diff --git a/guix/http-client.scm b/guix/http-client.scm index 3bffbb1c24..dc8d3298fc 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2012, 2015 Free Software Foundation, Inc. ;;; @@ -21,7 +21,7 @@ (define-module (guix http-client) #:use-module (guix utils) #:use-module (web uri) - #:use-module (web client) + #:use-module ((web client) #:hide (open-socket-for-uri)) #:use-module (web response) #:use-module (srfi srfi-11) #:use-module (srfi srfi-34) @@ -30,14 +30,15 @@ #:use-module (rnrs bytevectors) #:use-module (guix ui) #:use-module (guix utils) - #:use-module ((guix build download) #:select (resolve-uri-reference)) + #:use-module ((guix build download) + #:select (open-socket-for-uri resolve-uri-reference)) + #:re-export (open-socket-for-uri) #:export (&http-get-error http-get-error? http-get-error-uri http-get-error-code http-get-error-reason - open-socket-for-uri http-fetch)) ;;; Commentary: @@ -174,59 +175,13 @@ closes PORT, unless KEEP-ALIVE? is true." ;; Guile <= 2.0.9 had a bug whereby 'response-body-port' would read more ;; than what 'content-length' says. See Guile commit 802a25b. (module-set! (resolve-module '(web response)) - 'make-delimited-input-port make-delimited-input-port)) - - (define (read-response-body* r) - "Reads the response body from @var{r}, as a bytevector. Returns - @code{#f} if there was no response body." - (define bad-response - (@@ (web response) bad-response)) - - (if (member '(chunked) (response-transfer-encoding r)) - (let ((chunk-port (make-chunked-input-port (response-port r) - #:keep-alive? #t))) - (get-bytevector-all chunk-port)) - (let ((nbytes (response-content-length r))) - ;; Backport of Guile commit 84dfde82ae8f6ec247c1c147c1e2ae50b207bad9 - ;; ("fix response-body-port for responses without content-length"). - (if nbytes - (let ((bv (get-bytevector-n (response-port r) nbytes))) - (if (= (bytevector-length bv) nbytes) - bv - (bad-response "EOF while reading response body: ~a bytes of ~a" - (bytevector-length bv) nbytes))) - (get-bytevector-all (response-port r)))))) - - ;; Install this patch only on Guile 2.0.5. - (unless (guile-version>? "2.0.5") - (module-set! (resolve-module '(web response)) - 'read-response-body read-response-body*))) + 'make-delimited-input-port make-delimited-input-port))) ;; XXX: Work around <http://bugs.gnu.org/13095>, present in Guile ;; up to 2.0.7. (module-define! (resolve-module '(web client)) 'shutdown (const #f)) -(define* (open-socket-for-uri uri #:key (buffered? #t)) - "Return an open port for URI. When BUFFERED? is false, the returned port is -unbuffered." - (define rmem-max - ;; The maximum size for a receive buffer on Linux, see socket(7). - "/proc/sys/net/core/rmem_max") - - (define buffer-size - (if (file-exists? rmem-max) - (call-with-input-file rmem-max read) - 126976)) ; the default for Linux, per 'rmem_default' - - (let ((s ((@ (web client) open-socket-for-uri) uri))) - ;; Work around <http://bugs.gnu.org/15368> by restoring a decent - ;; buffer size. - (setsockopt s SOL_SOCKET SO_RCVBUF buffer-size) - (unless buffered? - (setvbuf s _IONBF)) - s)) - (define* (http-fetch uri #:key port (text? #f) (buffered? #t)) "Return an input port containing the data at URI, and the expected number of bytes available or #f. If TEXT? is true, the data at URI is considered to be @@ -235,44 +190,20 @@ unbuffered port, suitable for use in `filtered-port'. Raise an '&http-get-error' condition if downloading fails." (let loop ((uri uri)) - (let ((port (or port - (open-socket-for-uri uri - #:buffered? buffered?)))) + (let ((port (or port (open-socket-for-uri uri)))) + (unless buffered? + (setvbuf port _IONBF)) (let*-values (((resp data) ;; Try hard to use the API du jour to get an input port. - ;; On Guile 2.0.5 and before, we can only get a string or - ;; bytevector, and not an input port. Work around that. (if (guile-version>? "2.0.7") (http-get uri #:streaming? #t #:port port) ; 2.0.9+ - (if (defined? 'http-get*) - (http-get* uri #:decode-body? text? - #:port port) ; 2.0.7 - (http-get uri #:decode-body? text? - #:port port)))) ; 2.0.5- + (http-get* uri #:decode-body? text? ; 2.0.7 + #:port port))) ((code) (response-code resp))) (case code ((200) - (let ((len (response-content-length resp))) - (cond ((not data) - (begin - ;; Guile 2.0.5 and earlier did not support chunked - ;; transfer encoding, which is required for instance when - ;; fetching %PACKAGE-LIST-URL (see - ;; <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>). - ;; Normally the `when-guile<=2.0.5' block above fixes - ;; that, but who knows what could happen. - (warning (_ "using Guile ~a, which does not support ~s encoding~%") - (version) - (response-transfer-encoding resp)) - (leave (_ "download failed; use a newer Guile~%") - uri resp))) - ((string? data) ; `http-get' from 2.0.5- - (values (open-input-string data) len)) - ((bytevector? data) ; likewise - (values (open-bytevector-input-port data) len)) - (else ; input port - (values data len))))) + (values data (response-content-length resp))) ((301 ; moved permanently 302) ; found (redirection) (let ((uri (resolve-uri-reference (response-location resp) uri))) diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm new file mode 100644 index 0000000000..dfeba88312 --- /dev/null +++ b/guix/import/cabal.scm @@ -0,0 +1,815 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 import cabal) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 receive) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) + #:use-module (system base lalr) + #:use-module (rnrs enums) + #:export (read-cabal + eval-cabal + + cabal-package? + cabal-package-name + cabal-package-version + cabal-package-license + cabal-package-home-page + cabal-package-source-repository + cabal-package-synopsis + cabal-package-description + cabal-package-executables + cabal-package-library + cabal-package-test-suites + cabal-package-flags + cabal-package-eval-environment + + cabal-source-repository? + cabal-source-repository-use-case + cabal-source-repository-type + cabal-source-repository-location + + cabal-flag? + cabal-flag-name + cabal-flag-description + cabal-flag-default + cabal-flag-manual + + cabal-dependency? + cabal-dependency-name + cabal-dependency-version + + cabal-executable? + cabal-executable-name + cabal-executable-dependencies + + cabal-library? + cabal-library-dependencies + + cabal-test-suite? + cabal-test-suite-name + cabal-test-suite-dependencies)) + +;; Part 1: +;; +;; Functions used to read a Cabal file. + +;; Comment: +;; +;; The use of virtual closing braces VCCURLY and some lexer functions were +;; inspired from http://hackage.haskell.org/package/haskell-src + +;; Object containing information about the structure of a block: (i) delimited +;; by braces or by indentation, (ii) minimum indentation. +(define-record-type <parse-context> + (make-parse-context mode indentation) + parse-context? + (mode parse-context-mode) ; 'layout or 'no-layout + (indentation parse-context-indentation)) ; #f for 'no-layout + +;; <parse-context> mode set universe +(define-enumeration context (layout no-layout) make-context) + +(define (make-stack) + "Creates a simple stack closure. Actions on the generated stack are +requested by calling it with one of the following symbols as the first +argument: 'empty?, 'push!, 'top, 'pop! and 'clear!. The action 'push! is the +only one requiring a second argument corresponding to the object to be added +to the stack." + (let ((stack '())) + (lambda (msg . args) + (cond ((eqv? msg 'empty?) (null? stack)) + ((eqv? msg 'push!) (set! stack (cons (first args) stack))) + ((eqv? msg 'top) (if (null? stack) '() (first stack))) + ((eqv? msg 'pop!) (match stack + ((e r ...) (set! stack (cdr stack)) e) + (_ #f))) + ((eqv? msg 'clear!) (set! stack '())) + (else #f))))) + +;; Stack to track the structure of nested blocks and simple interface +(define context-stack (make-parameter (make-stack))) + +(define (context-stack-empty?) ((context-stack) 'empty?)) + +(define (context-stack-push! e) ((context-stack) 'push! e)) + +(define (context-stack-top) ((context-stack) 'top)) + +(define (context-stack-pop!) ((context-stack) 'pop!)) + +(define (context-stack-clear!) ((context-stack) 'clear!)) + +;; Indentation of the line being parsed. +(define current-indentation (make-parameter 0)) + +;; Signal to reprocess the beginning of line, in case we need to close more +;; than one indentation level. +(define check-bol? (make-parameter #f)) + +;; Name of the file being parsed. Used in error messages. +(define cabal-file-name (make-parameter "unknowk")) + +;; Specify the grammar of a Cabal file and generate a suitable syntax analyser. +(define (make-cabal-parser) + "Generate a parser for Cabal files." + (lalr-parser + ;; --- token definitions + (CCURLY VCCURLY OPAREN CPAREN TEST ID VERSION RELATION + (right: IF FLAG EXEC TEST-SUITE SOURCE-REPO BENCHMARK LIB OCURLY) + (left: OR) + (left: PROPERTY AND) + (right: ELSE NOT)) + ;; --- rules + (body (properties sections) : (append $1 $2)) + (sections (sections flags) : (append $1 $2) + (sections source-repo) : (append $1 (list $2)) + (sections executables) : (append $1 $2) + (sections test-suites) : (append $1 $2) + (sections benchmarks) : (append $1 $2) + (sections lib-sec) : (append $1 (list $2)) + () : '()) + (flags (flags flag-sec) : (append $1 (list $2)) + (flag-sec) : (list $1)) + (flag-sec (FLAG OCURLY properties CCURLY) : `(section flag ,$1 ,$3) + (FLAG open properties close) : `(section flag ,$1 ,$3) + (FLAG) : `(section flag ,$1 '())) + (source-repo (SOURCE-REPO OCURLY properties CCURLY) + : `(section source-repository ,$1 ,$3) + (SOURCE-REPO open properties close) + : `(section source-repository ,$1 ,$3)) + (properties (properties PROPERTY) : (append $1 (list $2)) + (PROPERTY) : (list $1)) + (executables (executables exec-sec) : (append $1 (list $2)) + (exec-sec) : (list $1)) + (exec-sec (EXEC OCURLY exprs CCURLY) : `(section executable ,$1 ,$3) + (EXEC open exprs close) : `(section executable ,$1 ,$3)) + (test-suites (test-suites ts-sec) : (append $1 (list $2)) + (ts-sec) : (list $1)) + (ts-sec (TEST-SUITE OCURLY exprs CCURLY) : `(section test-suite ,$1 ,$3) + (TEST-SUITE open exprs close) : `(section test-suite ,$1 ,$3)) + (benchmarks (benchmarks bm-sec) : (append $1 (list $2)) + (bm-sec) : (list $1)) + (bm-sec (BENCHMARK OCURLY exprs CCURLY) : `(section benchmark ,$1 ,$3) + (BENCHMARK open exprs close) : `(section benchmark ,$1 ,$3)) + (lib-sec (LIB OCURLY exprs CCURLY) : `(section library ,$3) + (LIB open exprs close) : `(section library ,$3)) + (exprs (exprs PROPERTY) : (append $1 (list $2)) + (PROPERTY) : (list $1) + (exprs if-then-else) : (append $1 (list $2)) + (if-then-else) : (list $1) + (exprs if-then) : (append $1 (list $2)) + (if-then) : (list $1)) + (if-then-else (IF tests OCURLY exprs CCURLY ELSE OCURLY exprs CCURLY) + : `(if ,$2 ,$4 ,$8) + (IF tests open exprs close ELSE OCURLY exprs CCURLY) + : `(if ,$2 ,$4 ,$8) + ;; The 'open' token after 'tests' is shifted after an 'exprs' + ;; is found. This is because, instead of 'exprs' a 'OCURLY' + ;; token is a valid alternative. For this reason, 'open' + ;; pushes a <parse-context> with a line indentation equal to + ;; the indentation of 'exprs'. + ;; + ;; Differently from this, without the rule above this + ;; comment, when an 'ELSE' token is found, the 'open' token + ;; following the 'ELSE' would be shifted immediately, before + ;; the 'exprs' is found (because there are no other valid + ;; tokens). The 'open' would therefore create a + ;; <parse-context> with the indentation of 'ELSE' and not + ;; 'exprs', creating an inconsistency. We therefore allow + ;; mixed style conditionals. + (IF tests open exprs close ELSE open exprs close) + : `(if ,$2 ,$4 ,$8)) + (if-then (IF tests OCURLY exprs CCURLY) : `(if ,$2 ,$4 ()) + (IF tests open exprs close) : `(if ,$2 ,$4 ())) + (tests (TEST OPAREN ID CPAREN) : `(,$1 ,$3) + (TEST OPAREN ID RELATION VERSION CPAREN) + : `(,$1 ,(string-append $3 " " $4 " " $5)) + (TEST OPAREN ID RELATION VERSION AND RELATION VERSION CPAREN) + : `(and (,$1 ,(string-append $3 " " $4 " " $5)) + (,$1 ,(string-append $3 " " $7 " " $8))) + (NOT tests) : `(not ,$2) + (tests AND tests) : `(and ,$1 ,$3) + (tests OR tests) : `(or ,$1 ,$3) + (OPAREN tests CPAREN) : $2) + (open () : (context-stack-push! + (make-parse-context (context layout) + (current-indentation)))) + (close (VCCURLY)))) + +(define (peek-next-line-indent port) + "This function can be called when the next character on PORT is #\newline +and returns the indentation of the line starting after the #\newline +character. Discard (and consume) empty and comment lines." + (let ((initial-newline (string (read-char port)))) + (let loop ((char (peek-char port)) + (word "")) + (cond ((eqv? char #\newline) (read-char port) + (loop (peek-char port) "")) + ((or (eqv? char #\space) (eqv? char #\tab)) + (let ((c (read-char port))) + (loop (peek-char port) (string-append word (string c))))) + ((comment-line port char) (loop (peek-char port) "")) + (else + (let ((len (string-length word))) + (unread-string (string-append initial-newline word) port) + len)))))) + +(define* (read-value port value min-indent #:optional (separator " ")) + "The next character on PORT must be #\newline. Append to VALUE the +following lines with indentation larger than MIN-INDENT." + (let loop ((val (string-trim-both value)) + (x (peek-next-line-indent port))) + (if (> x min-indent) + (begin + (read-char port) ; consume #\newline + (loop (string-append + val (if (string-null? val) "" separator) + (string-trim-both (read-delimited "\n" port 'peek))) + (peek-next-line-indent port))) + val))) + +(define (lex-white-space port bol) + "Consume white spaces and comment lines on PORT. If a new line is started return #t, +otherwise return BOL (beginning-of-line)." + (let loop ((c (peek-char port)) + (bol bol)) + (cond + ((and (not (eof-object? c)) + (or (char=? c #\space) (char=? c #\tab))) + (read-char port) + (loop (peek-char port) bol)) + ((and (not (eof-object? c)) (char=? c #\newline)) + (read-char port) + (loop (peek-char port) #t)) + ((comment-line port c) + (lex-white-space port bol)) + (else + bol)))) + +(define (lex-bol port) + "Process the beginning of a line on PORT: update current-indentation and +check the end of an indentation based context." + (let ((loc (make-source-location (cabal-file-name) (port-line port) + (port-column port) -1 -1))) + (current-indentation (source-location-column loc)) + (case (get-offside port) + ((less-than) + (check-bol? #t) ; need to check if closing more than 1 indent level. + (unless (context-stack-empty?) (context-stack-pop!)) + (make-lexical-token 'VCCURLY loc #f)) + (else + (lex-token port))))) + +(define (bol? port) (or (check-bol?) (= (port-column port) 0))) + +(define (comment-line port c) + "If PORT starts with a comment line, consume it up to, but not including +#\newline. C is the next character on PORT." + (cond ((and (not (eof-object? c)) (char=? c #\-)) + (read-char port) + (let ((c2 (peek-char port))) + (if (char=? c2 #\-) + (read-delimited "\n" port 'peek) + (begin (unread-char c port) #f)))) + (else #f))) + +(define-enumeration ordering (less-than equal greater-than) make-ordering) + +(define (get-offside port) + "In an indentation based context return the symbol 'greater-than, 'equal or +'less-than to signal if the current column number on PORT is greater-, equal-, +or less-than the indentation of the current context." + (let ((x (port-column port))) + (match (context-stack-top) + (($ <parse-context> 'layout indentation) + (cond + ((> x indentation) (ordering greater-than)) + ((= x indentation) (ordering equal)) + (else (ordering less-than)))) + (_ (ordering greater-than))))) + +;; (Semi-)Predicates for individual tokens. + +(define (is-relation? c) + (and (char? c) (any (cut char=? c <>) '(#\< #\> #\=)))) + +(define (make-rx-matcher pat) + "Compile PAT into a regular expression and creates a function matching a +string against the created regexp." + (let ((rx (make-regexp pat))) (cut regexp-exec rx <>))) + +(define is-property (make-rx-matcher "([a-zA-Z0-9-]+):[ \t]*(\\w?.*)$")) + +(define is-flag (make-rx-matcher "^[Ff]lag +([a-zA-Z0-9_-]+)")) + +(define is-src-repo + (make-rx-matcher "^[Ss]ource-[Rr]epository +([a-zA-Z0-9_-]+)")) + +(define is-exec (make-rx-matcher "^[Ee]xecutable +([a-zA-Z0-9_-]+)")) + +(define is-test-suite (make-rx-matcher "^[Tt]est-[Ss]uite +([a-zA-Z0-9_-]+)")) + +(define is-benchmark (make-rx-matcher "^[Bb]enchmark +([a-zA-Z0-9_-]+)")) + +(define is-lib (make-rx-matcher "^[Ll]ibrary *")) + +(define is-else (make-rx-matcher "^else")) + +(define (is-if s) (string=? s "if")) + +(define (is-and s) (string=? s "&&")) + +(define (is-or s) (string=? s "||")) + +(define (is-id s) + (let ((cabal-reserved-words + '("if" "else" "library" "flag" "executable" "test-suite" + "source-repository" "benchmark"))) + (and (every (cut string-ci<> s <>) cabal-reserved-words) + (not (char=? (last (string->list s)) #\:))))) + +(define (is-test s port) + (let ((tests-rx (make-regexp "os|arch|flag|impl")) + (c (peek-char port))) + (and (regexp-exec tests-rx s) (char=? #\( c)))) + +;; Lexers for individual tokens. + +(define (lex-relation loc port) + (make-lexical-token 'RELATION loc (read-while is-relation? port))) + +(define (lex-version loc port) + (make-lexical-token 'VERSION loc + (read-while char-numeric? port + (cut char=? #\. <>) char-numeric?))) + +(define* (read-while is? port #:optional + (is-if-followed-by? (lambda (c) #f)) + (is-allowed-follower? (lambda (c) #f))) + "Read from PORT as long as: (i) either the read character satisfies the +predicate IS?, or (ii) it satisfies the predicate IS-IF-FOLLOWED-BY? and the +character immediately following it satisfies IS-ALLOWED-FOLLOWER?. Returns a +string with the read characters." + (let loop ((c (peek-char port)) + (res '())) + (cond ((and (not (eof-object? c)) (is? c)) + (let ((c (read-char port))) + (loop (peek-char port) (append res (list c))))) + ((and (not (eof-object? c)) (is-if-followed-by? c)) + (let ((c (read-char port)) + (c2 (peek-char port))) + (if (and (not (eof-object? c2)) (is-allowed-follower? c2)) + (loop c2 (append res (list c))) + (begin (unread-char c) (list->string res))))) + (else (list->string res))))) + +(define (lex-property k-v-rx-res loc port) + (let ((key (string-downcase (match:substring k-v-rx-res 1))) + (value (match:substring k-v-rx-res 2))) + (make-lexical-token + 'PROPERTY loc + (list key `(,(read-value port value (current-indentation))))))) + +(define (lex-rx-res rx-res token loc) + (let ((name (string-downcase (match:substring rx-res 1)))) + (make-lexical-token token loc name))) + +(define (lex-flag flag-rx-res loc) (lex-rx-res flag-rx-res 'FLAG loc)) + +(define (lex-src-repo src-repo-rx-res loc) + (lex-rx-res src-repo-rx-res 'SOURCE-REPO loc)) + +(define (lex-exec exec-rx-res loc) (lex-rx-res exec-rx-res 'EXEC loc)) + +(define (lex-test-suite ts-rx-res loc) (lex-rx-res ts-rx-res 'TEST-SUITE loc)) + +(define (lex-benchmark bm-rx-res loc) (lex-rx-res bm-rx-res 'BENCHMARK loc)) + +(define (lex-lib loc) (make-lexical-token 'LIB loc #f)) + +(define (lex-else loc) (make-lexical-token 'ELSE loc #f)) + +(define (lex-if loc) (make-lexical-token 'IF loc #f)) + +(define (lex-and loc) (make-lexical-token 'AND loc #f)) + +(define (lex-or loc) (make-lexical-token 'OR loc #f)) + +(define (lex-id w loc) (make-lexical-token 'ID loc w)) + +(define (lex-test w loc) (make-lexical-token 'TEST loc (string->symbol w))) + +;; Lexer for tokens recognizable by single char. + +(define* (is-ref-char->token ref-char next-char token loc port + #:optional (hook-fn #f)) + "If the next character NEXT-CHAR on PORT is REF-CHAR, then read it, +execute HOOK-FN if it isn't #f and return a lexical token of type TOKEN with +location information LOC." + (cond ((char=? next-char ref-char) + (read-char port) + (when hook-fn (hook-fn)) + (make-lexical-token token loc (string next-char))) + (else #f))) + +(define (is-ocurly->token c loc port) + (is-ref-char->token #\{ c 'OCURLY loc port + (lambda () + (context-stack-push! (make-parse-context + (context no-layout) #f))))) + +(define (is-ccurly->token c loc port) + (is-ref-char->token #\} c 'CCURLY loc port (lambda () (context-stack-pop!)))) + +(define (is-oparen->token c loc port) + (is-ref-char->token #\( c 'OPAREN loc port)) + +(define (is-cparen->token c loc port) + (is-ref-char->token #\) c 'CPAREN loc port)) + +(define (is-not->token c loc port) + (is-ref-char->token #\! c 'NOT loc port)) + +(define (is-version? c) (char-numeric? c)) + +;; Main lexer functions + +(define (lex-single-char port loc) + "Process tokens which can be recognised by peeking the next character on +PORT. If no token can be recognized return #f. LOC is the current port +location." + (let* ((c (peek-char port))) + (cond ((eof-object? c) (read-char port) '*eoi*) + ((is-ocurly->token c loc port)) + ((is-ccurly->token c loc port)) + ((is-oparen->token c loc port)) + ((is-cparen->token c loc port)) + ((is-not->token c loc port)) + ((is-version? c) (lex-version loc port)) + ((is-relation? c) (lex-relation loc port)) + (else + #f)))) + +(define (lex-word port loc) + "Process tokens which can be recognized by reading the next word form PORT. +LOC is the current port location." + (let* ((w (read-delimited " ()\t\n" port 'peek))) + (cond ((is-if w) (lex-if loc)) + ((is-test w port) (lex-test w loc)) + ((is-and w) (lex-and loc)) + ((is-or w) (lex-or loc)) + ((is-id w) (lex-id w loc)) + (else (unread-string w port) #f)))) + +(define (lex-line port loc) + "Process tokens which can be recognised by reading a line from PORT. LOC is +the current port location." + (let* ((s (read-delimited "\n{}" port 'peek))) + (cond + ((is-property s) => (cut lex-property <> loc port)) + ((is-flag s) => (cut lex-flag <> loc)) + ((is-src-repo s) => (cut lex-src-repo <> loc)) + ((is-exec s) => (cut lex-exec <> loc)) + ((is-test-suite s) => (cut lex-test-suite <> loc)) + ((is-benchmark s) => (cut lex-benchmark <> loc)) + ((is-lib s) (lex-lib loc)) + ((is-else s) (lex-else loc)) + (else + #f)))) + +(define (lex-token port) + (let* ((loc (make-source-location (cabal-file-name) (port-line port) + (port-column port) -1 -1))) + (or (lex-single-char port loc) (lex-word port loc) (lex-line port loc)))) + +;; Lexer- and error-function generators + +(define (errorp) + "Generates the lexer error function." + (let ((p (current-error-port))) + (lambda (message . args) + (format p "~a" message) + (if (and (pair? args) (lexical-token? (car args))) + (let* ((token (car args)) + (source (lexical-token-source token)) + (line (source-location-line source)) + (column (source-location-column source))) + (format p "~a " (or (lexical-token-value token) + (lexical-token-category token))) + (when (and (number? line) (number? column)) + (format p "(at line ~a, column ~a)" (1+ line) column))) + (for-each display args)) + (format p "~%")))) + +(define (make-lexer port) + "Generate the Cabal lexical analyser reading from PORT." + (let ((p port)) + (lambda () + (let ((bol (lex-white-space p (bol? p)))) + (check-bol? #f) + (if bol (lex-bol p) (lex-token p)))))) + +(define* (read-cabal #:optional (port (current-input-port)) + (file-name #f)) + "Read a Cabal file from PORT. FILE-NAME is a string used in error messages. +If #f use the function 'port-filename' to obtain it." + (let ((cabal-parser (make-cabal-parser))) + (parameterize ((cabal-file-name + (or file-name (port-filename port) "standard input")) + (current-indentation 0) + (check-bol? #f) + (context-stack (make-stack))) + (cabal-parser (make-lexer port) (errorp))))) + +;; Part 2: +;; +;; Evaluate the S-expression returned by 'read-cabal'. + +;; This defines the object and interface that we provide to access the Cabal +;; file information. Note that this does not include all the pieces of +;; information of the Cabal file, but only the ones we currently are +;; interested in. +(define-record-type <cabal-package> + (make-cabal-package name version license home-page source-repository + synopsis description + executables lib test-suites + flags eval-environment) + cabal-package? + (name cabal-package-name) + (version cabal-package-version) + (license cabal-package-license) + (home-page cabal-package-home-page) + (source-repository cabal-package-source-repository) + (synopsis cabal-package-synopsis) + (description cabal-package-description) + (executables cabal-package-executables) + (lib cabal-package-library) ; 'library' is a Scheme keyword + (test-suites cabal-package-test-suites) + (flags cabal-package-flags) + (eval-environment cabal-package-eval-environment)) ; alist + +(set-record-type-printer! <cabal-package> + (lambda (package port) + (format port "#<cabal-package ~a-~a>" + (cabal-package-name package) + (cabal-package-version package)))) + +(define-record-type <cabal-source-repository> + (make-cabal-source-repository use-case type location) + cabal-source-repository? + (use-case cabal-source-repository-use-case) + (type cabal-source-repository-type) + (location cabal-source-repository-location)) + +;; We need to be able to distinguish the value of a flag from the Scheme #t +;; and #f values. +(define-record-type <cabal-flag> + (make-cabal-flag name description default manual) + cabal-flag? + (name cabal-flag-name) + (description cabal-flag-description) + (default cabal-flag-default) ; 'true or 'false + (manual cabal-flag-manual)) ; 'true or 'false + +(set-record-type-printer! <cabal-flag> + (lambda (package port) + (format port "#<cabal-flag ~a default:~a>" + (cabal-flag-name package) + (cabal-flag-default package)))) + +(define-record-type <cabal-dependency> + (make-cabal-dependency name version) + cabal-dependency? + (name cabal-dependency-name) + (version cabal-dependency-version)) + +(define-record-type <cabal-executable> + (make-cabal-executable name dependencies) + cabal-executable? + (name cabal-executable-name) + (dependencies cabal-executable-dependencies)) ; list of <cabal-dependency> + +(define-record-type <cabal-library> + (make-cabal-library dependencies) + cabal-library? + (dependencies cabal-library-dependencies)) ; list of <cabal-dependency> + +(define-record-type <cabal-test-suite> + (make-cabal-test-suite name dependencies) + cabal-test-suite? + (name cabal-test-suite-name) + (dependencies cabal-test-suite-dependencies)) ; list of <cabal-dependency> + +(define (cabal-flags->alist flag-list) + "Retrun an alist associating the flag name to its default value from a +list of <cabal-flag> objects." + (map (lambda (flag) (cons (cabal-flag-name flag) (cabal-flag-default flag))) + flag-list)) + +(define (eval-cabal cabal-sexp env) + "Given the CABAL-SEXP produced by 'read-cabal', evaluate all conditionals +and return a 'cabal-package' object. The values of all tests can be +overwritten by specifying the desired value in ENV. ENV must be an alist. +The accepted keys are: \"os\", \"arch\", \"impl\" and a name of a flag. The +value associated with a flag has to be either \"true\" or \"false\". The +value associated with other keys has to conform to the Cabal file format +definition." + (define (os name) + (let ((env-os (or (assoc-ref env "os") "linux"))) + (string-match env-os name))) + + (define (arch name) + (let ((env-arch (or (assoc-ref env "arch") "x86_64"))) + (string-match env-arch name))) + + (define (comp-name+version haskell) + "Extract the compiler name and version from the string HASKELL." + (let* ((matcher-fn (make-rx-matcher "([a-zA-Z0-9_]+)-([0-9.]+)")) + (name (or (and=> (matcher-fn haskell) (cut match:substring <> 1)) + haskell)) + (version (and=> (matcher-fn haskell) (cut match:substring <> 2)))) + (values name version))) + + (define (comp-spec-name+op+version spec) + "Extract the compiler specification from SPEC. Return the compiler name, +the ordering operation and the version." + (let* ((with-ver-matcher-fn (make-rx-matcher + "([a-zA-Z0-9_-]+) *([<>=]+) *([0-9.]+) *")) + (without-ver-matcher-fn (make-rx-matcher "([a-zA-Z0-9_-]+)")) + (name (or (and=> (with-ver-matcher-fn spec) + (cut match:substring <> 1)) + (match:substring (without-ver-matcher-fn spec) 1))) + (operator (and=> (with-ver-matcher-fn spec) + (cut match:substring <> 2))) + (version (and=> (with-ver-matcher-fn spec) + (cut match:substring <> 3)))) + (values name operator version))) + + (define (impl haskell) + (let*-values (((comp-name comp-ver) + (comp-name+version (or (assoc-ref env "impl") "ghc"))) + ((spec-name spec-op spec-ver) + (comp-spec-name+op+version haskell))) + (if (and spec-ver comp-ver) + (eval-string + (string-append "(string" spec-op " \"" comp-name "\"" + " \"" spec-name "-" spec-ver "\")")) + (string-match spec-name comp-name)))) + + (define (cabal-flags) + (make-cabal-section cabal-sexp 'flag)) + + (define (flag name) + (let ((value (or (assoc-ref env name) + (assoc-ref (cabal-flags->alist (cabal-flags)) name)))) + (if (eq? value 'false) #f #t))) + + (define (eval sexp) + (match sexp + (() '()) + ;; nested 'if' + ((('if predicate true-group false-group) rest ...) + (append (if (eval predicate) + (eval true-group) + (eval false-group)) + (eval rest))) + (('if predicate true-group false-group) + (if (eval predicate) + (eval true-group) + (eval false-group))) + (('flag name) (flag name)) + (('os name) (os name)) + (('arch name) (arch name)) + (('impl name) (impl name)) + (('not name) (not (eval name))) + ;; 'and' and 'or' aren't functions, thus we can't use apply + (('and args ...) (fold (lambda (e s) (and e s)) #t (eval args))) + (('or args ...) (fold (lambda (e s) (or e s)) #f (eval args))) + ;; no need to evaluate flag parameters + (('section 'flag name parameters) + (list 'section 'flag name parameters)) + ;; library does not have a name parameter + (('section 'library parameters) + (list 'section 'library (eval parameters))) + (('section type name parameters) + (list 'section type name (eval parameters))) + (((? string? name) values) + (list name values)) + ((element rest ...) + (cons (eval element) (eval rest))) + (_ (raise (condition + (&message (message "Failed to evaluate Cabal file. \ +See the manual for limitations."))))))) + + (define (cabal-evaluated-sexp->package evaluated-sexp) + (let* ((name (lookup-join evaluated-sexp "name")) + (version (lookup-join evaluated-sexp "version")) + (license (lookup-join evaluated-sexp "license")) + (home-page (lookup-join evaluated-sexp "homepage")) + (home-page-or-hackage + (if (string-null? home-page) + (string-append "http://hackage.haskell.org/package/" name) + home-page)) + (source-repository (make-cabal-section evaluated-sexp + 'source-repository)) + (synopsis (lookup-join evaluated-sexp "synopsis")) + (description (lookup-join evaluated-sexp "description")) + (executables (make-cabal-section evaluated-sexp 'executable)) + (lib (make-cabal-section evaluated-sexp 'library)) + (test-suites (make-cabal-section evaluated-sexp 'test-suite)) + (flags (make-cabal-section evaluated-sexp 'flag)) + (eval-environment '())) + (make-cabal-package name version license home-page-or-hackage + source-repository synopsis description executables lib + test-suites flags eval-environment))) + + ((compose cabal-evaluated-sexp->package eval) cabal-sexp)) + +(define (make-cabal-section sexp section-type) + "Given an SEXP as produced by 'read-cabal', produce a list of objects +pertaining to SECTION-TYPE sections. SECTION-TYPE must be one of: +'executable, 'flag, 'test-suite, 'source-repository or 'library." + (filter-map (cut match <> + (('section (? (cut equal? <> section-type)) name parameters) + (case section-type + ((test-suite) (make-cabal-test-suite + name (dependencies parameters))) + ((executable) (make-cabal-executable + name (dependencies parameters))) + ((source-repository) (make-cabal-source-repository + name + (lookup-join parameters "type") + (lookup-join parameters "location"))) + ((flag) + (let* ((default (lookup-join parameters "default")) + (default-true-or-false + (if (and default (string-ci=? "false" default)) + 'false + 'true)) + (description (lookup-join parameters "description")) + (manual (lookup-join parameters "manual")) + (manual-true-or-false + (if (and manual (string-ci=? "true" manual)) + 'true + 'false))) + (make-cabal-flag name description + default-true-or-false + manual-true-or-false))) + (else #f))) + (('section (? (cut equal? <> section-type) lib) parameters) + (make-cabal-library (dependencies parameters))) + (_ #f)) + sexp)) + +(define* (lookup-join key-values-list key #:optional (delimiter " ")) + "Lookup and joint all values pertaining to keys of value KEY in +KEY-VALUES-LIST. The optional DELIMITER is used to specify a delimiter string +to be added between the values found in different key/value pairs." + (string-join + (filter-map (cut match <> + (((? (lambda(x) (equal? x key))) value) + (string-join value delimiter)) + (_ #f)) + key-values-list) + delimiter)) + +(define dependency-name-version-rx + (make-regexp "([a-zA-Z0-9_-]+) *(.*)")) + +(define (dependencies key-values-list) + "Return a list of 'cabal-dependency' objects for the dependencies found in +KEY-VALUES-LIST." + (let ((deps (string-tokenize (lookup-join key-values-list "build-depends" ",") + (char-set-complement (char-set #\,))))) + (map (lambda (d) + (let ((rx-result (regexp-exec dependency-name-version-rx d))) + (make-cabal-dependency + (match:substring rx-result 1) + (match:substring rx-result 2)))) + deps))) + +;;; cabal.scm ends here diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index 1b27803dba..b5574a8d9f 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -18,28 +18,19 @@ (define-module (guix import hackage) #:use-module (ice-9 match) - #:use-module (ice-9 regex) - #:use-module (ice-9 rdelim) - #:use-module (ice-9 receive) - #:use-module (ice-9 pretty-print) #:use-module (srfi srfi-26) - #:use-module (srfi srfi-34) - #:use-module (srfi srfi-35) #:use-module (srfi srfi-11) #:use-module (srfi srfi-1) #:use-module ((guix download) #:select (download-to-store)) #:use-module ((guix utils) #:select (package-name->name+version)) #:use-module (guix import utils) + #:use-module (guix import cabal) #:use-module (guix store) #:use-module (guix hash) #:use-module (guix base32) #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:export (hackage->guix-package)) -;; Part 1: -;; -;; Functions used to read a Cabal file. - (define ghc-standard-libraries ;; List of libraries distributed with ghc (7.8.4). We include GHC itself as ;; some packages list it. @@ -75,588 +66,12 @@ (define package-name-prefix "ghc-") -(define key-value-rx - ;; Regular expression matching "key: value" - (make-regexp "([a-zA-Z0-9-]+):[ \t]*(\\w?.*)$")) - -(define sections-rx - ;; Regular expression matching a section "head sub-head ..." - (make-regexp "([a-zA-Z0-9\\(\\)-]+)")) - -(define comment-rx - ;; Regexp matching Cabal comment lines. - (make-regexp "^ *--")) - -(define (has-key? line) - "Check if LINE includes a key." - (regexp-exec key-value-rx line)) - -(define (comment-line? line) - "Check if LINE is a comment line." - (regexp-exec comment-rx line)) - -(define (line-indentation+rest line) - "Returns two results: The number of indentation spaces and the rest of the -line (without indentation)." - (let loop ((line-lst (string->list line)) - (count 0)) - ;; Sometimes values are spread over multiple lines and new lines start - ;; with a comma ',' with the wrong indentation. See e.g. haddock-api. - (if (or (null? line-lst) - (not (or - (eqv? (first line-lst) #\space) - (eqv? (first line-lst) #\,) ; see, e.g., haddock-api.cabal - (eqv? (first line-lst) #\tab)))) - (values count (list->string line-lst)) - (loop (cdr line-lst) (+ count 1))))) - -(define (multi-line-value lines seed) - "Function to read a value split across multiple lines. LINES are the -remaining input lines to be read. SEED is the value read on the same line as -the key. Return two values: A list with values and the remaining lines to be -processed." - (define (multi-line-value-with-min-indent lines seed min-indent) - (if (null? lines) - (values '() '()) - (let-values (((current-indent value) (line-indentation+rest (first lines))) - ((next-line-indent next-line-value) - (if (null? (cdr lines)) - (values #f "") - (line-indentation+rest (second lines))))) - (if (or (not next-line-indent) (< next-line-indent min-indent) - (regexp-exec condition-rx next-line-value)) - (values (reverse (cons value seed)) (cdr lines)) - (multi-line-value-with-min-indent (cdr lines) (cons value seed) - min-indent))))) - - (let-values (((current-indent value) (line-indentation+rest (first lines)))) - (multi-line-value-with-min-indent lines seed current-indent))) - -(define (read-cabal port) - "Parses a Cabal file from PORT. Return a list of list pairs: - -(((head1 sub-head1 ... key1) (value)) - ((head2 sub-head2 ... key2) (value2)) - ...). - -We try do deduce the Cabal format from the following document: -https://www.haskell.org/cabal/users-guide/developing-packages.html - -Keys are case-insensitive. We therefore lowercase them. Values are -case-sensitive. Currently only indentation-structured files are parsed. -Braces structured files are not handled." ;" <- make emacs happy. - (define (read-and-trim-line port) - (let ((line (read-line port))) - (if (string? line) - (string-trim-both line #\return) - line))) - - (define (strip-insignificant-lines port) - (let loop ((line (read-and-trim-line port)) - (result '())) - (cond - ((eof-object? line) - (reverse result)) - ((or (string-null? line) (comment-line? line)) - (loop (read-and-trim-line port) result)) - (else - (loop (read-and-trim-line port) (cons line result)))))) - - (let loop - ((lines (strip-insignificant-lines port)) - (indents '()) ; only includes indents at start of section heads. - (sections '()) - (result '())) - (let-values - (((current-indent line) - (if (null? lines) - (values 0 "") - (line-indentation+rest (first lines)))) - ((next-line-indent next-line) - (if (or (null? lines) (null? (cdr lines))) - (values 0 "") - (line-indentation+rest (second lines))))) - (if (null? lines) - (reverse result) - (let ((rx-result (has-key? line))) - (cond - (rx-result - (let ((key (string-downcase (match:substring rx-result 1))) - (value (match:substring rx-result 2))) - (cond - ;; Simple single line "key: value". - ((= next-line-indent current-indent) - (loop (cdr lines) indents sections - (cons - (list (reverse (cons key sections)) (list value)) - result))) - ;; Multi line "key: value\n value cont...". - ((> next-line-indent current-indent) - (let*-values (((value-lst lines) - (multi-line-value (cdr lines) - (if (string-null? value) - '() - `(,value))))) - ;; multi-line-value returns to the first line after the - ;; multi-value. - (loop lines indents sections - (cons - (list (reverse (cons key sections)) value-lst) - result)))) - ;; Section ended. - (else - ;; Indentation is reduced. Check by how many levels. - (let* ((idx (and=> (list-index - (lambda (x) (= next-line-indent x)) - indents) - (cut + <> - (if (has-key? next-line) 1 0)))) - (sec - (if idx - (drop sections idx) - (raise - (condition - (&message - (message "unable to parse Cabal file")))))) - (ind (drop indents idx))) - (loop (cdr lines) ind sec - (cons - (list (reverse (cons key sections)) (list value)) - result))))))) - ;; Start of a new section. - ((or (null? indents) - (> current-indent (first indents))) - (loop (cdr lines) (cons current-indent indents) - (cons (string-downcase line) sections) result)) - (else - (loop (cdr lines) indents - (cons (string-downcase line) (cdr sections)) - result)))))))) - -(define condition-rx - ;; Regexp for conditionals. - (make-regexp "^if +(.*)$")) - -(define (split-section section) - "Split SECTION in individual words with exception for the predicate of an -'if' conditional." - (let ((rx-result (regexp-exec condition-rx section))) - (if rx-result - `("if" ,(match:substring rx-result 1)) - (map match:substring (list-matches sections-rx section))))) - -(define (join-sections sec1 sec2) - (fold-right cons sec2 sec1)) - -(define (pre-process-keys key) - (match key - (() '()) - ((sec1 rest ...) - (join-sections (split-section sec1) (pre-process-keys rest))))) - -(define (pre-process-entry-keys entry) - (match entry - ((key value) - (list (pre-process-keys key) value)) - (() '()))) - -(define (pre-process-entries-keys entries) - "ENTRIES is a list of list pairs, a keys list and a valules list, as -produced by 'read-cabal'. Split each element of the keys list into individual -words. This pre-processing is used to read flags." - (match entries - ((entry rest ...) - (cons (pre-process-entry-keys entry) - (pre-process-entries-keys rest))) - (() - '()))) - -(define (get-flags pre-processed-entries) - "PRE-PROCESSED-ENTRIES is a list of list pairs, a keys list and a values -list, as produced by 'read-cabal' and pre-processed by -'pre-process-entries-keys'. Return a list of pairs with the name of flags and -their default value (one of \"False\" or \"True\") as specified in the Cabal file: - -((\"flag1-name\" . \"False-or-True\") ...)." ;" <- make emacs happy - (match pre-processed-entries - (() '()) - (((("flag" flag-name "default") (flag-val)) rest ...) - (cons (cons flag-name flag-val) - (get-flags rest))) - ((entry rest ... ) - (get-flags rest)) - (_ #f))) - -;; Part 2: -;; -;; Functions to read information from the Cabal object created by 'read-cabal' -;; and convert Cabal format dependencies conditionals into equivalent -;; S-expressions. - -(define tests-rx - ;; Cabal test keywords - (make-regexp "(os|arch|flag|impl) *\\(([ a-zA-Z0-9_.<>=-]+)\\)")) - -(define parens-rx - ;; Parentheses within conditions - (make-regexp "\\((.+)\\)")) - -(define or-rx - ;; OR operator in conditions - (make-regexp " +\\|\\| +")) - -(define and-rx - ;; AND operator in conditions - (make-regexp " +&& +")) - -(define not-rx - ;; NOT operator in conditions - (make-regexp "^!.+")) - -(define (bi-op-args str match-lst) - "Return a list with the arguments of (logic) bianry operators. MATCH-LST -is the result of 'list-match' against a binary operator regexp on STR." - (let ((operators (length match-lst))) - (map (lambda (from to) - (substring str from to)) - (cons 0 (map match:end match-lst)) - (append (map match:start match-lst) (list (string-length str)))))) - -(define (bi-op->sexp-like bi-op args) - "BI-OP is a string with the name of a Scheme operator which in a Cabal file -is represented by a binary operator. ARGS are the arguments of said operator. -Return a string representing an S-expression of the operator applied to its -arguments." - (if (= (length args) 1) - (first args) - (string-append "(" bi-op - (fold (lambda (arg seed) (string-append seed " " arg)) - "" args) ")"))) - -(define (not->sexp-like arg) - "If the string ARG is prefixed by a Cabal negation operator, convert it to -an equivalent Scheme S-expression string." - (if (regexp-exec not-rx arg) - (string-append "(not " - (substring arg 1 (string-length arg)) - ")") - arg)) - -(define (parens-less-cond->sexp-like conditional) - "Convert a Cabal CONDITIONAL string into a string with equivalent Scheme -syntax. This procedure accepts only simple conditionals without parentheses." - ;; The outher operation is the one with the lowest priority: OR - (bi-op->sexp-like - "or" - ;; each OR argument may be an AND operation - (map (lambda (or-arg) - (let ((m-lst (list-matches and-rx or-arg))) - ;; is there an AND operation? - (if (> (length m-lst) 0) - (bi-op->sexp-like - "and" - ;; expand NOT operators when there are ANDs - (map not->sexp-like (bi-op-args or-arg m-lst))) - ;; ... and when there aren't. - (not->sexp-like or-arg)))) - ;; list of OR arguments - (bi-op-args conditional (list-matches or-rx conditional))))) - -(define test-keyword-ornament "__") - -(define (conditional->sexp-like conditional) - "Convert a Cabal CONDITIONAL string into a string with equivalent Scheme -syntax." - ;; First we substitute TEST-KEYWORD-ORNAMENT for parentheses around tests - ;; keywords so that parentheses are only used to set precedences. This - ;; substantially simplify parsing. - (let ((conditional - (regexp-substitute/global #f tests-rx conditional - 'pre 1 test-keyword-ornament 2 - test-keyword-ornament 'post))) - (let loop ((sub-cond conditional)) - (let ((rx-result (regexp-exec parens-rx sub-cond))) - (cond - (rx-result - (parens-less-cond->sexp-like - (string-append - (match:prefix rx-result) - (loop (match:substring rx-result 1)) - (match:suffix rx-result)))) - (else - (parens-less-cond->sexp-like sub-cond))))))) - -(define (eval-flags sexp-like-cond flags) - "SEXP-LIKE-COND is a string representing an S-expression conditional. FLAGS -is a list of flag name and value pairs as produced by 'get-flags'. Substitute -\"#t\" or \"#f\" according to the value of flags. (Default to \"True\")." - (fold-right - (lambda (flag sexp) - (match flag - ((name . value) - (let ((rx (make-regexp - (string-append "flag" test-keyword-ornament name - test-keyword-ornament)))) - (regexp-substitute/global - #f rx sexp - 'pre (if (string-ci= value "False") "#f" "#t") 'post))) - (_ sexp))) - sexp-like-cond - (cons '("[a-zA-Z0-9_-]+" . "True") flags))) - -(define (eval-tests->sexp sexp-like-cond) - "In the string SEXP-LIKE-COND substitute test keywords \"os(...)\" and -\"arch(...)\" with equivalent Scheme checks. Retrun an S-expression." - (with-input-from-string - (fold-right - (lambda (test sexp) - (match test - ((type pre-match post-match) - (let ((rx (make-regexp - (string-append type test-keyword-ornament "(\\w+)" - test-keyword-ornament)))) - (regexp-substitute/global - #f rx sexp - 'pre pre-match 2 post-match 'post))) - (_ sexp))) - sexp-like-cond - ;; (%current-system) returns, e.g., "x86_64-linux" or "i686-linux". - '(("(os|arch)" "(string-match \"" "\" (%current-system))"))) - read)) - -(define (eval-impl sexp-like-cond) - "Check for the Cabal test \"impl(...)\" in the string SEXP-LIKE-COND. -Assume the module declaring the generated package includes a local variable -called \"haskell-implementation\" with a string value of the form NAME-VERSION -against which we compare." - (with-output-to-string - (lambda () - (write - (with-input-from-string - (fold-right - (lambda (test sexp) - (match test - ((pre-match post-match) - (let ((rx-with-version - (make-regexp - (string-append - "impl" test-keyword-ornament - "([a-zA-Z0-9_-]+) *([<>=]+) *([0-9.]+) *" - test-keyword-ornament))) - (rx-without-version - (make-regexp - (string-append "impl" test-keyword-ornament "(\\w+)" - test-keyword-ornament)))) - (if (regexp-exec rx-with-version sexp) - (regexp-substitute/global - #f rx-with-version sexp - 'pre pre-match 2 " " post-match " \"" 1 "-" 3 "\")" 'post) - (regexp-substitute/global - #f rx-without-version sexp - 'pre pre-match "-match \"" 1 "\" " post-match ")" 'post)))) - (_ sexp))) - sexp-like-cond - '(("(string" "haskell-implementation"))) - read))))) - -(define (eval-cabal-keywords sexp-like-cond flags) - ((compose eval-tests->sexp eval-impl (cut eval-flags <> flags)) - sexp-like-cond)) - -(define (key->values meta key) - "META is the representation of a Cabal file as produced by 'read-cabal'. -Return the list of values associated with a specific KEY (a string)." - (match meta - (() '()) - (((((? (lambda(x) (equal? x key)))) v) r ...) - v) - (((k v) r ...) - (key->values (cdr meta) key)) - (_ "key Not fount"))) - -(define (key-start-end->entries meta key-start-rx key-end-rx) - "META is the representation of a Cabal file as produced by 'read-cabal'. -Return all entries whose keys list starts with KEY-START and ends with -KEY-END." - (let ((pred - (lambda (x) - (and (regexp-exec key-start-rx (first x)) - (regexp-exec key-end-rx (last x)))))) - ;; (equal? (list key-start key-end) (list (first x) (last x)))))) - (match meta - (() '()) - ((((? pred k) v) r ...) - (cons `(,k ,v) - (key-start-end->entries (cdr meta) key-start-rx key-end-rx))) - (((k v) r ...) - (key-start-end->entries (cdr meta) key-start-rx key-end-rx)) - (_ "key Not fount")))) - -(define else-rx - (make-regexp "^else$")) - -(define (count-if-else rx-result-ls) - (apply + (map (lambda (m) (if m 1 0)) rx-result-ls))) - -(define (analyze-entry-cond entry) - (let* ((keys (first entry)) - (vals (second entry)) - (rx-cond-result - (map (cut regexp-exec condition-rx <>) keys)) - (rx-else-result - (map (cut regexp-exec else-rx <>) keys)) - (cond-no (count-if-else rx-cond-result)) - (else-no (count-if-else rx-else-result)) - (cond-idx (list-index (lambda (rx) (if rx #t #f)) rx-cond-result)) - (else-idx (list-index (lambda (rx) (if rx #t #f)) rx-else-result)) - (key-cond - (cond - ((or (and cond-idx else-idx (< cond-idx else-idx)) - (and cond-idx (not else-idx))) - (match:substring - (receive (head tail) - (split-at rx-cond-result cond-idx) (first tail)))) - ((or (and cond-idx else-idx (> cond-idx else-idx)) - (and (not cond-idx) else-idx)) - (match:substring - (receive (head tail) - (split-at rx-else-result else-idx) (first tail)))) - (else - "")))) - (values keys vals rx-cond-result - rx-else-result cond-no else-no key-cond))) - -(define (remove-cond entry cond) - (match entry - ((k v) - (list (cdr (member cond k)) v)))) - -(define (group-and-reduce-level entries group group-cond) - (let loop - ((true-group group) - (false-group '()) - (entries entries)) - (if (null? entries) - (values (reverse true-group) (reverse false-group) entries) - (let*-values (((entry) (first entries)) - ((keys vals rx-cond-result rx-else-result - cond-no else-no key-cond) - (analyze-entry-cond entry))) - (cond - ((and (>= (+ cond-no else-no) 1) (string= group-cond key-cond)) - (loop (cons (remove-cond entry group-cond) true-group) false-group - (cdr entries))) - ((and (>= (+ cond-no else-no) 1) (string= key-cond "else")) - (loop true-group (cons (remove-cond entry "else") false-group) - (cdr entries))) - (else - (values (reverse true-group) (reverse false-group) entries))))))) - -(define dependencies-rx - (make-regexp "([a-zA-Z0-9_-]+) *[^,]*,?")) - (define (hackage-name->package-name name) + "Given the NAME of a Cabal package, return the corresponding Guix name." (if (string-prefix? package-name-prefix name) (string-downcase name) (string-append package-name-prefix (string-downcase name)))) -(define (split-and-filter-dependencies ls names-to-filter) - "Split the comma separated list of dependencies LS coming from the Cabal -file, filter packages included in NAMES-TO-FILTER and return a list with -inputs suitable for the Guix package. Currently the version information is -discarded." - (define (split-at-comma-and-filter d) - (fold - (lambda (m seed) - (let* ((name (string-downcase (match:substring m 1))) - (pkg-name (hackage-name->package-name name))) - (if (member name names-to-filter) - seed - (cons (list pkg-name (list 'unquote (string->symbol pkg-name))) - seed)))) - '() - (list-matches dependencies-rx d))) - - (fold (lambda (d p) (append (split-at-comma-and-filter d) p)) '() ls)) - -(define* (dependencies-cond->sexp meta #:key (include-test-dependencies? #t)) - "META is the representation of a Cabal file as produced by 'read-cabal'. -Return an S-expression containing the list of dependencies as expected by the -'inputs' field of a package. The generated S-expressions may include -conditionals as defined in the cabal file. During this process we discard the -version information of the packages." - (define (take-dependencies meta) - (let ((key-start-exe (make-regexp "executable")) - (key-start-lib (make-regexp "library")) - (key-start-tests (make-regexp "test-suite")) - (key-end (make-regexp "build-depends"))) - (append - (key-start-end->entries meta key-start-exe key-end) - (key-start-end->entries meta key-start-lib key-end) - (if include-test-dependencies? - (key-start-end->entries meta key-start-tests key-end) - '())))) - - (let ((flags (get-flags (pre-process-entries-keys meta))) - (augmented-ghc-std-libs (append (key->values meta "name") - ghc-standard-libraries))) - (delete-duplicates - (let loop ((entries (take-dependencies meta)) - (result '())) - (if (null? entries) - (reverse result) - (let*-values (((entry) (first entries)) - ((keys vals rx-cond-result rx-else-result - cond-no else-no key-cond) - (analyze-entry-cond entry))) - (cond - ((= (+ cond-no else-no) 0) - (loop (cdr entries) - (append - (split-and-filter-dependencies vals - augmented-ghc-std-libs) - result))) - (else - (let-values (((true-group false-group entries) - (group-and-reduce-level entries '() - key-cond)) - ((cond-final) (eval-cabal-keywords - (conditional->sexp-like - (last (split-section key-cond))) - flags))) - (loop entries - (cond - ((or (eq? cond-final #t) (equal? cond-final '(not #f))) - (append (loop true-group '()) result)) - ((or (eq? cond-final #f) (equal? cond-final '(not #t))) - (append (loop false-group '()) result)) - (else - (let ((true-group-result (loop true-group '())) - (false-group-result (loop false-group '()))) - (cond - ((and (null? true-group-result) - (null? false-group-result)) - result) - ((null? false-group-result) - (cons `(unquote-splicing - (when ,cond-final ,true-group-result)) - result)) - ((null? true-group-result) - (cons `(unquote-splicing - (unless ,cond-final ,false-group-result)) - result)) - (else - (cons `(unquote-splicing - (if ,cond-final - ,true-group-result - ,false-group-result)) - result)))))))))))))))) - -;; Part 3: -;; -;; Retrive the desired package and its Cabal file from -;; http://hackage.haskell.org and construct the Guix package S-expression. - (define (hackage-fetch name-version) "Return the Cabal file for the package NAME-VERSION, or #f on failure. If the version part is omitted from the package name, then return the latest @@ -696,33 +111,63 @@ version." ((lst ...) `(list ,@(map string->license lst))) (_ #f))) -(define* (hackage-module->sexp meta #:key (include-test-dependencies? #t)) - "Return the `package' S-expression for a Cabal package. META is the + +(define (cabal-dependencies->names cabal include-test-dependencies?) + "Return the list of dependencies names from the CABAL package object. If +INCLUDE-TEST-DEPENDENCIES? is #f, do not include dependencies required by test +suites." + (let* ((lib (cabal-package-library cabal)) + (lib-deps (if (pair? lib) + (map cabal-dependency-name + (append-map cabal-library-dependencies lib)) + '())) + (exe (cabal-package-executables cabal)) + (exe-deps (if (pair? exe) + (map cabal-dependency-name + (append-map cabal-executable-dependencies exe)) + '())) + (ts (cabal-package-test-suites cabal)) + (ts-deps (if (pair? ts) + (map cabal-dependency-name + (append-map cabal-test-suite-dependencies ts)) + '()))) + (if include-test-dependencies? + (delete-duplicates (append lib-deps exe-deps ts-deps)) + (delete-duplicates (append lib-deps exe-deps))))) + +(define (filter-dependencies dependencies own-name) + "Filter the dependencies included with the GHC compiler from DEPENDENCIES, a +list with the names of dependencies. OWN-NAME is the name of the Cabal +package being processed and is used to filter references to itself." + (filter (lambda (d) (not (member (string-downcase d) + (cons own-name ghc-standard-libraries)))) + dependencies)) + +(define* (hackage-module->sexp cabal #:key (include-test-dependencies? #t)) + "Return the `package' S-expression for a Cabal package. CABAL is the representation of a Cabal file as produced by 'read-cabal'." (define name - (first (key->values meta "name"))) + (cabal-package-name cabal)) (define version - (first (key->values meta "version"))) - - (define description - (let*-values (((description) (key->values meta "description")) - ((lines last) - (split-at description (- (length description) 1)))) - (fold-right (lambda (line seed) (string-append line "\n" seed)) - (first last) lines))) + (cabal-package-version cabal)) (define source-url (string-append "http://hackage.haskell.org/package/" name "/" name "-" version ".tar.gz")) - ;; Several packages do not have an official home-page other than on Hackage. - (define home-page - (let ((home-page-entry (key->values meta "homepage"))) - (if (null? home-page-entry) - (string-append "http://hackage.haskell.org/package/" name) - (first home-page-entry)))) + (define dependencies + (let ((names + (map hackage-name->package-name + ((compose (cut filter-dependencies <> + (cabal-package-name cabal)) + (cut cabal-dependencies->names <> + include-test-dependencies?)) + cabal)))) + (map (lambda (name) + (list name (list 'unquote (string->symbol name)))) + names))) (define (maybe-inputs input-type inputs) (match inputs @@ -732,6 +177,11 @@ representation of a Cabal file as produced by 'read-cabal'." (list (list input-type (list 'quasiquote inputs)))))) + (define (maybe-arguments) + (if (not include-test-dependencies?) + '((arguments `(#:tests? #f))) + '())) + (let ((tarball (with-store store (download-to-store store source-url)))) `(package @@ -746,22 +196,33 @@ representation of a Cabal file as produced by 'read-cabal'." (bytevector->nix-base32-string (file-sha256 tarball)) "failed to download tar archive"))))) (build-system haskell-build-system) - ,@(maybe-inputs 'inputs - (dependencies-cond->sexp meta - #:include-test-dependencies? - include-test-dependencies?)) - (home-page ,home-page) - (synopsis ,@(key->values meta "synopsis")) - (description ,description) - (license ,(string->license (key->values meta "license")))))) - -(define* (hackage->guix-package module-name - #:key (include-test-dependencies? #t)) - "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, and return -the `package' S-expression corresponding to that package, or #f on failure." - (let ((module-meta (hackage-fetch module-name))) - (and=> module-meta (cut hackage-module->sexp <> - #:include-test-dependencies? - include-test-dependencies?)))) + ,@(maybe-inputs 'inputs dependencies) + ,@(maybe-arguments) + (home-page ,(cabal-package-home-page cabal)) + (synopsis ,(cabal-package-synopsis cabal)) + (description ,(cabal-package-description cabal)) + (license ,(string->license (cabal-package-license cabal)))))) + +(define* (hackage->guix-package package-name #:key + (include-test-dependencies? #t) + (port #f) + (cabal-environment '())) + "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the +called with keyword parameter PORT, from PORT. Return the `package' +S-expression corresponding to that package, or #f on failure. +CABAL-ENVIRONMENT is an alist defining the environment in which the Cabal +conditionals are evaluated. The accepted keys are: \"os\", \"arch\", \"impl\" +and the name of a flag. The value associated with a flag has to be either the +symbol 'true' or 'false'. The value associated with other keys has to conform +to the Cabal file format definition. The default value associated with the +keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\" +respectively." + (let ((cabal-meta (if port + (read-cabal port) + (hackage-fetch package-name)))) + (and=> cabal-meta (compose (cut hackage-module->sexp <> + #:include-test-dependencies? + include-test-dependencies?) + (cut eval-cabal <> cabal-environment))))) ;;; cabal.scm ends here diff --git a/guix/licenses.scm b/guix/licenses.scm index 1be35001ff..480442158d 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -37,6 +37,7 @@ freetype gpl1 gpl1+ gpl2 gpl2+ gpl3 gpl3+ fdl1.3+ + opl1.0+ isc ijg ibmpl1.0 @@ -206,6 +207,11 @@ at URI, which may be a file:// URI pointing the package's tree." "https://www.gnu.org/licenses/fdl.html" "https://www.gnu.org/licenses/license-list#FDL")) +(define opl1.0+ + (license "Open Publication License 1.0 or later" + "http://opencontent.org/openpub/" + "https://www.gnu.org/licenses/license-list#OpenPublicationL")) + (define isc (license "ISC" "http://directory.fsf.org/wiki/License:ISC" diff --git a/guix/monads.scm b/guix/monads.scm index f693e99a59..2196a9c991 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -112,6 +112,29 @@ (lambda (s) (syntax-violation 'return "return used outside of 'with-monad'" s))) +(define-syntax-rule (bind-syntax bind) + "Return a macro transformer that handles the expansion of '>>=' expressions +using BIND as the binary bind operator. + +This macro exists to allow the expansion of n-ary '>>=' expressions, even +though BIND is simply binary, as in: + + (with-monad %state-monad + (>>= (return 1) + (lift 1+ %state-monad) + (lift 1+ %state-monad))) +" + (lambda (stx) + (define (expand body) + (syntax-case body () + ((_ mval mproc) + #'(bind mval mproc)) + ((x mval mproc0 mprocs (... ...)) + (expand #'(>>= (>>= mval mproc0) + mprocs (... ...)))))) + + (expand stx))) + (define-syntax with-monad (lambda (s) "Evaluate BODY in the context of MONAD, and return its result." @@ -120,13 +143,13 @@ (eq? 'macro (syntax-local-binding #'monad)) ;; MONAD is a syntax transformer, so we can obtain the bind and return ;; methods by directly querying it. - #'(syntax-parameterize ((>>= (identifier-syntax (monad %bind))) + #'(syntax-parameterize ((>>= (bind-syntax (monad %bind))) (return (identifier-syntax (monad %return)))) body ...)) ((_ monad body ...) ;; MONAD refers to the <monad> record that represents the monad at run ;; time, so use the slow method. - #'(syntax-parameterize ((>>= (identifier-syntax + #'(syntax-parameterize ((>>= (bind-syntax (monad-bind monad))) (return (identifier-syntax (monad-return monad)))) @@ -225,8 +248,11 @@ MONAD---i.e., return a monadic function in MONAD." (return (apply proc args))))) (define (foldm monad mproc init lst) - "Fold MPROC over LST, a list of monadic values in MONAD, and return a -monadic value seeded by INIT." + "Fold MPROC over LST and return a monadic value seeded by INIT. + + (foldm %state-monad (lift2 cons %state-monad) '() '(a b c)) + => '(c b a) ;monadic +" (with-monad monad (let loop ((lst lst) (result init)) @@ -234,18 +260,21 @@ monadic value seeded by INIT." (() (return result)) ((head tail ...) - (mlet* monad ((item head) - (result (mproc item result))) - (loop tail result))))))) + (>>= (mproc head result) + (lambda (result) + (loop tail result)))))))) (define (mapm monad mproc lst) - "Map MPROC over LST, a list of monadic values in MONAD, and return a monadic -list. LST items are bound from left to right, so effects in MONAD are known -to happen in that order." + "Map MPROC over LST and return a monadic list. + + (mapm %state-monad (lift1 1+ %state-monad) '(0 1 2)) + => (1 2 3) ;monadic +" (mlet monad ((result (foldm monad (lambda (item result) - (mlet monad ((item (mproc item))) - (return (cons item result)))) + (>>= (mproc item) + (lambda (item) + (return (cons item result))))) '() lst))) (return (reverse result)))) @@ -268,20 +297,24 @@ evaluating each item of LST in sequence." (lambda (item) (seq tail (cons item result))))))))) -(define (anym monad proc lst) - "Apply PROC to the list of monadic values LST; return the first value, -lifted in MONAD, for which PROC returns true." +(define (anym monad mproc lst) + "Apply MPROC to the list of values LST; return as a monadic value the first +value for which MPROC returns a true monadic value or #f. For example: + + (anym %state-monad (lift1 odd? %state-monad) '(0 1 2)) + => #t ;monadic +" (with-monad monad (let loop ((lst lst)) (match lst (() (return #f)) ((head tail ...) - (mlet* monad ((value head) - (result -> (proc value))) - (if result - (return result) - (loop tail)))))))) + (>>= (mproc head) + (lambda (result) + (if result + (return result) + (loop tail))))))))) (define-syntax listm (lambda (s) diff --git a/guix/packages.scm b/guix/packages.scm index d5bf6dbf65..cbe6127f28 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -26,6 +26,7 @@ #:use-module (guix base32) #:use-module (guix derivations) #:use-module (guix build-system) + #:use-module (guix search-paths) #:use-module (guix gexp) #:use-module (ice-9 match) #:use-module (ice-9 vlist) @@ -36,7 +37,8 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:re-export (%current-system - %current-target-system) + %current-target-system + search-path-specification) ;for convenience #:export (origin origin? origin-uri @@ -52,11 +54,6 @@ origin-imported-modules base32 - <search-path-specification> - search-path-specification - search-path-specification? - search-path-specification->sexp - package package? package-name @@ -82,6 +79,8 @@ package-location package-field-location + package-direct-sources + package-transitive-sources package-direct-inputs package-transitive-inputs package-transitive-target-inputs @@ -186,26 +185,6 @@ representation." ((_ str) #'(nix-base32-string->bytevector str))))) -;; The specification of a search path. -(define-record-type* <search-path-specification> - search-path-specification make-search-path-specification - search-path-specification? - (variable search-path-specification-variable) ;string - (files search-path-specification-files) ;list of strings - (separator search-path-specification-separator ;string - (default ":")) - (file-type search-path-specification-file-type ;symbol - (default 'directory)) - (file-pattern search-path-specification-file-pattern ;#f | string - (default #f))) - -(define (search-path-specification->sexp spec) - "Return an sexp representing SPEC, a <search-path-specification>. The sexp -corresponds to the arguments expected by `set-path-environment-variable'." - (match spec - (($ <search-path-specification> variable files separator type pattern) - `(,variable ,files ,separator ,type ,pattern)))) - (define %supported-systems ;; This is the list of system types that are supported. By default, we ;; expect all packages to build successfully here. @@ -527,6 +506,28 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." ((input rest ...) (loop rest (cons input result)))))) +(define (package-direct-sources package) + "Return all source origins associated with PACKAGE; including origins in +PACKAGE's inputs." + `(,@(or (and=> (package-source package) list) '()) + ,@(filter-map (match-lambda + ((_ (? origin? orig) _ ...) + orig) + (_ #f)) + (package-direct-inputs package)))) + +(define (package-transitive-sources package) + "Return PACKAGE's direct sources, and their direct sources, recursively." + (delete-duplicates + (concatenate (filter-map (match-lambda + ((_ (? origin? orig) _ ...) + (list orig)) + ((_ (? package? p) _ ...) + (package-direct-sources p)) + (_ #f)) + (bag-transitive-inputs + (package->bag package)))))) + (define (package-direct-inputs package) "Return all the direct inputs of PACKAGE---i.e, its direct inputs along with their propagated inputs." diff --git a/guix/profiles.scm b/guix/profiles.scm index 4bb309305b..28150affb6 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2014 Alex Kost <alezost@gmail.com> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> +;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,8 +23,9 @@ (define-module (guix profiles) #:use-module (guix utils) #:use-module (guix records) - #:use-module (guix derivations) #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (guix search-paths) #:use-module (guix gexp) #:use-module (guix monads) #:use-module (guix store) @@ -59,6 +61,7 @@ manifest-entry-output manifest-entry-item manifest-entry-dependencies + manifest-entry-search-paths manifest-pattern manifest-pattern? @@ -78,6 +81,7 @@ profile-manifest package->manifest-entry + packages->manifest %default-profile-hooks profile-derivation generation-number @@ -133,6 +137,8 @@ (default "out")) (item manifest-entry-item) ; package | store path (dependencies manifest-entry-dependencies ; (store path | package)* + (default '())) + (search-paths manifest-entry-search-paths ; search-path-specification* (default '()))) (define-record-type* <manifest-pattern> manifest-pattern @@ -165,25 +171,72 @@ omitted or #f, use the first output of PACKAGE." (version (package-version package)) (output (or output (car (package-outputs package)))) (item package) - (dependencies (delete-duplicates deps))))) + (dependencies (delete-duplicates deps)) + (search-paths (package-native-search-paths package))))) + +(define (packages->manifest packages) + "Return a list of manifest entries, one for each item listed in PACKAGES. +Elements of PACKAGES can be either package objects or package/string tuples +denoting a specific output of a package." + (manifest + (map (match-lambda + ((package output) + (package->manifest-entry package output)) + (package + (package->manifest-entry package))) + packages))) (define (manifest->gexp manifest) "Return a representation of MANIFEST as a gexp." (define (entry->gexp entry) (match entry - (($ <manifest-entry> name version output (? string? path) (deps ...)) - #~(#$name #$version #$output #$path #$deps)) - (($ <manifest-entry> name version output (? package? package) (deps ...)) + (($ <manifest-entry> name version output (? string? path) + (deps ...) (search-paths ...)) + #~(#$name #$version #$output #$path + (propagated-inputs #$deps) + (search-paths #$(map search-path-specification->sexp + search-paths)))) + (($ <manifest-entry> name version output (? package? package) + (deps ...) (search-paths ...)) #~(#$name #$version #$output - (ungexp package (or output "out")) #$deps)))) + (ungexp package (or output "out")) + (propagated-inputs #$deps) + (search-paths #$(map search-path-specification->sexp + search-paths)))))) (match manifest (($ <manifest> (entries ...)) - #~(manifest (version 1) + #~(manifest (version 2) (packages #$(map entry->gexp entries)))))) +(define (find-package name version) + "Return a package from the distro matching NAME and possibly VERSION. This +procedure is here for backward-compatibility and will eventually vanish." + (define find-best-packages-by-name ;break abstractions + (module-ref (resolve-interface '(gnu packages)) + 'find-best-packages-by-name)) + + ;; Use 'find-best-packages-by-name' and not 'find-packages-by-name'; the + ;; former traverses the module tree only once and then allows for efficient + ;; access via a vhash. + (match (find-best-packages-by-name name version) + ((p _ ...) p) + (_ + (match (find-best-packages-by-name name #f) + ((p _ ...) p) + (_ #f))))) + (define (sexp->manifest sexp) "Parse SEXP as a manifest." + (define (infer-search-paths name version) + ;; Infer the search path specifications for NAME-VERSION by looking up a + ;; same-named package in the distro. Useful for the old manifest formats + ;; that did not store search path info. + (let ((package (find-package name version))) + (if package + (package-native-search-paths package) + '()))) + (match sexp (('manifest ('version 0) ('packages ((name version output path) ...))) @@ -193,7 +246,8 @@ omitted or #f, use the first output of PACKAGE." (name name) (version version) (output output) - (item path))) + (item path) + (search-paths (infer-search-paths name version)))) name version output path))) ;; Version 1 adds a list of propagated inputs to the @@ -215,11 +269,31 @@ omitted or #f, use the first output of PACKAGE." (version version) (output output) (item path) - (dependencies deps)))) + (dependencies deps) + (search-paths (infer-search-paths name version))))) name version output path deps))) + ;; Version 2 adds search paths and is slightly more verbose. + (('manifest ('version 2 minor-version ...) + ('packages ((name version output path + ('propagated-inputs deps) + ('search-paths search-paths) + extra-stuff ...) + ...))) + (manifest + (map (lambda (name version output path deps search-paths) + (manifest-entry + (name name) + (version version) + (output output) + (item path) + (dependencies deps) + (search-paths (map sexp->search-path-specification + search-paths)))) + name version output path deps search-paths))) (_ - (error "unsupported manifest format" manifest)))) + (raise (condition + (&message (message "unsupported manifest format"))))))) (define (read-manifest port) "Return the packages listed in MANIFEST." @@ -409,7 +483,7 @@ entries of MANIFEST, or #f if MANIFEST does not have any GHC packages." (module-ref (resolve-interface '(gnu packages haskell)) 'ghc)) (define build - #~(begin + #~(begin (use-modules (guix build utils) (srfi srfi-1) (srfi srfi-26) (ice-9 ftw)) @@ -418,20 +492,20 @@ entries of MANIFEST, or #f if MANIFEST does not have any GHC packages." (let* ((base (basename #+ghc))) (string-drop base (+ 1 (string-index base #\-))))) - + (define db-subdir (string-append "lib/" ghc-name-version "/package.conf.d")) (define db-dir (string-append #$output "/" db-subdir)) - + (define (conf-files top) (find-files (string-append top "/" db-subdir) "\\.conf$")) (define (copy-conf-file conf) (let ((base (basename conf))) (copy-file conf (string-append db-dir "/" base)))) - + (system* (string-append #+ghc "/bin/ghc-pkg") "init" db-dir) (for-each copy-conf-file (append-map conf-files @@ -443,12 +517,14 @@ entries of MANIFEST, or #f if MANIFEST does not have any GHC packages." (for-each delete-file (find-files db-dir "\\.conf$")) success))) - ;; Don't depend on GHC when there's nothing to do. - (and (any (cut string-prefix? "ghc" <>) - (map manifest-entry-name (manifest-entries manifest))) - (gexp->derivation "ghc-package-cache" build - #:modules '((guix build utils)) - #:local-build? #t))) + (with-monad %store-monad + ;; Don't depend on GHC when there's nothing to do. + (if (any (cut string-prefix? "ghc" <>) + (map manifest-entry-name (manifest-entries manifest))) + (gexp->derivation "ghc-package-cache" build + #:modules '((guix build utils)) + #:local-build? #t) + (return #f)))) (define (ca-certificate-bundle manifest) "Return a derivation that builds a single-file bundle containing the CA @@ -513,12 +589,92 @@ MANIFEST. Single-file bundles are required by programs such as Git and Lynx." #:modules '((guix build utils)) #:local-build? #t)) +(define (gtk-icon-themes manifest) + "Return a derivation that unions all icon themes from manifest entries and +creates the GTK+ 'icon-theme.cache' file for each theme." + ;; Return as a monadic value the GTK+ package or store path referenced by the + ;; manifest ENTRY, or #f if not referenced. + (define (entry-lookup-gtk+ entry) + (define (find-among-inputs inputs) + (find (lambda (input) + (and (package? input) + (string=? "gtk+" (package-name input)))) + inputs)) + + (define (find-among-store-items items) + (find (lambda (item) + (equal? "gtk+" + (package-name->name+version + (store-path-package-name item)))) + items)) + + ;; TODO: Factorize. + (define references* + (store-lift references)) + + (with-monad %store-monad + (match (manifest-entry-item entry) + ((? package? package) + (match (package-transitive-inputs package) + (((labels inputs . _) ...) + (return (find-among-inputs inputs))))) + ((? string? item) + (mlet %store-monad ((refs (references* item))) + (return (find-among-store-items refs))))))) + + (define (manifest-lookup-gtk+ manifest) + (anym %store-monad + entry-lookup-gtk+ (manifest-entries manifest))) + + (mlet %store-monad ((gtk+ (manifest-lookup-gtk+ manifest))) + (define build + #~(begin + (use-modules (guix build utils) + (guix build union) + (guix build profiles) + (srfi srfi-26) + (ice-9 ftw)) + + (let* ((destdir (string-append #$output "/share/icons")) + (icondirs (filter file-exists? + (map (cut string-append <> "/share/icons") + '#$(manifest-inputs manifest)))) + (update-icon-cache (string-append + #+gtk+ "/bin/gtk-update-icon-cache"))) + + ;; Union all the icons. + (mkdir-p (string-append #$output "/share")) + (union-build destdir icondirs) + + ;; Update the 'icon-theme.cache' file for each icon theme. + (for-each + (lambda (theme) + (let ((dir (string-append destdir "/" theme))) + ;; Occasionally DESTDIR contains plain files, such as + ;; "abiword_48.png". Ignore these. + (when (file-is-directory? dir) + (ensure-writable-directory dir) + (system* update-icon-cache "-t" dir)))) + (scandir destdir (negate (cut member <> '("." "..")))))))) + + ;; Don't run the hook when there's nothing to do. + (if gtk+ + (gexp->derivation "gtk-icon-themes" build + #:modules '((guix build utils) + (guix build union) + (guix build profiles) + (guix search-paths) + (guix records)) + #:local-build? #t) + (return #f)))) + (define %default-profile-hooks ;; This is the list of derivation-returning procedures that are called by ;; default when making a non-empty profile. (list info-dir-file ghc-package-cache-file - ca-certificate-bundle)) + ca-certificate-bundle + gtk-icon-themes)) (define* (profile-derivation manifest #:key @@ -529,29 +685,42 @@ the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc." (mlet %store-monad ((extras (if (null? (manifest-entries manifest)) (return '()) (sequence %store-monad - (filter-map (lambda (hook) - (hook manifest)) - hooks))))) + (map (lambda (hook) + (hook manifest)) + hooks))))) (define inputs - (append (map gexp-input extras) + (append (filter-map (lambda (drv) + (and (derivation? drv) + (gexp-input drv))) + extras) (manifest-inputs manifest))) (define builder #~(begin - (use-modules (ice-9 pretty-print) - (guix build union)) + (use-modules (guix build profiles) + (guix search-paths)) (setvbuf (current-output-port) _IOLBF) (setvbuf (current-error-port) _IOLBF) - (union-build #$output '#$inputs - #:log-port (%make-void-port "w")) - (call-with-output-file (string-append #$output "/manifest") - (lambda (p) - (pretty-print '#$(manifest->gexp manifest) p))))) + (define search-paths + ;; Search paths of MANIFEST's packages, converted back to their + ;; record form. + (map sexp->search-path-specification + '#$(map search-path-specification->sexp + (append-map manifest-entry-search-paths + (manifest-entries manifest))))) + + (build-profile #$output '#$inputs + #:manifest '#$(manifest->gexp manifest) + #:search-paths search-paths))) (gexp->derivation "profile" builder - #:modules '((guix build union)) + #:modules '((guix build profiles) + (guix build union) + (guix build utils) + (guix search-paths) + (guix records)) #:local-build? #t))) (define (profile-regexp profile) diff --git a/guix/records.scm b/guix/records.scm index fd17e135e1..db59a99052 100644 --- a/guix/records.scm +++ b/guix/records.scm @@ -42,102 +42,106 @@ (format #f fmt args ...) form)))) -(define* (make-syntactic-constructor type name ctor fields - #:key (thunked '()) (defaults '()) - (delayed '())) - "Make the syntactic constructor NAME for TYPE, that calls CTOR, and expects +(eval-when (expand load eval) + ;; This procedure is a syntactic helper used by 'define-record-type*', hence + ;; 'eval-when'. + + (define* (make-syntactic-constructor type name ctor fields + #:key (thunked '()) (defaults '()) + (delayed '())) + "Make the syntactic constructor NAME for TYPE, that calls CTOR, and expects all of FIELDS to be initialized. DEFAULTS is the list of FIELD/DEFAULT-VALUE tuples, THUNKED is the list of identifiers of thunked fields, and DELAYED is the list of identifiers of delayed fields." - (with-syntax ((type type) - (name name) - (ctor ctor) - (expected fields) - (defaults defaults)) - #`(define-syntax name - (lambda (s) - (define (record-inheritance orig-record field+value) - ;; Produce code that returns a record identical to ORIG-RECORD, - ;; except that values for the FIELD+VALUE alist prevail. - (define (field-inherited-value f) - (and=> (find (lambda (x) - (eq? f (car (syntax->datum x)))) - field+value) - car)) - - ;; Make sure there are no unknown field names. - (let* ((fields (map (compose car syntax->datum) field+value)) - (unexpected (lset-difference eq? fields 'expected))) - (when (pair? unexpected) - (record-error 'name s "extraneous field initializers ~a" - unexpected))) - - #`(make-struct type 0 - #,@(map (lambda (field index) - (or (field-inherited-value field) - #`(struct-ref #,orig-record - #,index))) - 'expected - (iota (length 'expected))))) - - (define (thunked-field? f) - (memq (syntax->datum f) '#,thunked)) - - (define (delayed-field? f) - (memq (syntax->datum f) '#,delayed)) - - (define (wrap-field-value f value) - (cond ((thunked-field? f) - #`(lambda () #,value)) - ((delayed-field? f) - #`(delay #,value)) - (else value))) - - (define (field-bindings field+value) - ;; Return field to value bindings, for use in 'let*' below. - (map (lambda (field+value) - (syntax-case field+value () - ((field value) - #`(field - #,(wrap-field-value #'field #'value))))) - field+value)) - - (syntax-case s (inherit #,@fields) - ((_ (inherit orig-record) (field value) (... ...)) - #`(let* #,(field-bindings #'((field value) (... ...))) - #,(record-inheritance #'orig-record - #'((field value) (... ...))))) - ((_ (field value) (... ...)) - (let ((fields (map syntax->datum #'(field (... ...)))) - (dflt (map (match-lambda - ((f v) - (list (syntax->datum f) v))) - #'defaults))) - - (define (field-value f) - (or (and=> (find (lambda (x) - (eq? f (car (syntax->datum x)))) - #'((field value) (... ...))) - car) - (let ((value - (car (assoc-ref dflt (syntax->datum f))))) - (wrap-field-value f value)))) - - (let ((fields (append fields (map car dflt)))) - (cond ((lset= eq? fields 'expected) - #`(let* #,(field-bindings - #'((field value) (... ...))) - (ctor #,@(map field-value 'expected)))) - ((pair? (lset-difference eq? fields 'expected)) - (record-error 'name s - "extraneous field initializers ~a" - (lset-difference eq? fields - 'expected))) - (else - (record-error 'name s - "missing field initializers ~a" - (lset-difference eq? 'expected - fields)))))))))))) + (with-syntax ((type type) + (name name) + (ctor ctor) + (expected fields) + (defaults defaults)) + #`(define-syntax name + (lambda (s) + (define (record-inheritance orig-record field+value) + ;; Produce code that returns a record identical to ORIG-RECORD, + ;; except that values for the FIELD+VALUE alist prevail. + (define (field-inherited-value f) + (and=> (find (lambda (x) + (eq? f (car (syntax->datum x)))) + field+value) + car)) + + ;; Make sure there are no unknown field names. + (let* ((fields (map (compose car syntax->datum) field+value)) + (unexpected (lset-difference eq? fields 'expected))) + (when (pair? unexpected) + (record-error 'name s "extraneous field initializers ~a" + unexpected))) + + #`(make-struct type 0 + #,@(map (lambda (field index) + (or (field-inherited-value field) + #`(struct-ref #,orig-record + #,index))) + 'expected + (iota (length 'expected))))) + + (define (thunked-field? f) + (memq (syntax->datum f) '#,thunked)) + + (define (delayed-field? f) + (memq (syntax->datum f) '#,delayed)) + + (define (wrap-field-value f value) + (cond ((thunked-field? f) + #`(lambda () #,value)) + ((delayed-field? f) + #`(delay #,value)) + (else value))) + + (define (field-bindings field+value) + ;; Return field to value bindings, for use in 'let*' below. + (map (lambda (field+value) + (syntax-case field+value () + ((field value) + #`(field + #,(wrap-field-value #'field #'value))))) + field+value)) + + (syntax-case s (inherit #,@fields) + ((_ (inherit orig-record) (field value) (... ...)) + #`(let* #,(field-bindings #'((field value) (... ...))) + #,(record-inheritance #'orig-record + #'((field value) (... ...))))) + ((_ (field value) (... ...)) + (let ((fields (map syntax->datum #'(field (... ...)))) + (dflt (map (match-lambda + ((f v) + (list (syntax->datum f) v))) + #'defaults))) + + (define (field-value f) + (or (and=> (find (lambda (x) + (eq? f (car (syntax->datum x)))) + #'((field value) (... ...))) + car) + (let ((value + (car (assoc-ref dflt (syntax->datum f))))) + (wrap-field-value f value)))) + + (let ((fields (append fields (map car dflt)))) + (cond ((lset= eq? fields 'expected) + #`(let* #,(field-bindings + #'((field value) (... ...))) + (ctor #,@(map field-value 'expected)))) + ((pair? (lset-difference eq? fields 'expected)) + (record-error 'name s + "extraneous field initializers ~a" + (lset-difference eq? fields + 'expected))) + (else + (record-error 'name s + "missing field initializers ~a" + (lset-difference eq? 'expected + fields))))))))))))) (define-syntax define-record-type* (lambda (s) diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm index e9900689fa..eedebb4bac 100644 --- a/guix/scripts/authenticate.scm +++ b/guix/scripts/authenticate.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -82,12 +82,6 @@ to stdout upon success." (leave (_ "error: corrupt signature data: ~a~%") (canonical-sexp->string signature))))) -(define %default-port-conversion-strategy - ;; This fluid is in Guile > 2.0.5. - (if (defined? '%default-port-conversion-strategy) - (@ (guile) %default-port-conversion-strategy) - (make-fluid #f))) - ;;; ;;; Entry point with 'openssl'-compatible interface. We support this diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 370c2a37ff..2307f76b42 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -37,6 +37,7 @@ #:autoload (guix download) (download-to-store) #:export (%standard-build-options set-build-options-from-command-line + set-build-options-from-command-line* show-build-options-help guix-build)) @@ -139,6 +140,9 @@ options handled by 'set-build-options-from-command-line', and listed in #:print-build-trace (assoc-ref opts 'print-build-trace?) #:verbosity (assoc-ref opts 'verbosity))) +(define set-build-options-from-command-line* + (store-lift set-build-options-from-command-line)) + (define %standard-build-options ;; List of standard command-line options for tools that build something. (list (option '(#\L "load-path") #t #f @@ -228,6 +232,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (display (_ " -S, --source build the packages' source derivations")) (display (_ " + --sources[=TYPE] build source derivations; TYPE may optionally be one + of \"package\", \"all\" (default), or \"transitive\"")) + (display (_ " -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) (display (_ " --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) @@ -262,10 +269,22 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (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))) + (alist-cons 'source #t result))) + (option '("sources") #f #t + (lambda (opt name arg result) + (match arg + ("package" + (alist-cons 'source #t result)) + ((or "all" #f) + (alist-cons 'source package-direct-sources result)) + ("transitive" + (alist-cons 'source package-transitive-sources result)) + (else + (leave (_ "invalid argument: '~a' option argument: ~a, ~ +must be one of 'package', 'all', or 'transitive'~%") + name arg))))) (option '(#\s "system") #t #f (lambda (opt name arg result) (alist-cons 'system arg @@ -308,28 +327,34 @@ build." (triplet (cut package-cross-derivation <> <> triplet <>)))) - (define src? (assoc-ref opts 'source?)) + (define src (assoc-ref opts 'source)) (define sys (assoc-ref opts 'system)) (define graft? (assoc-ref opts 'graft?)) (parameterize ((%graft? graft?)) (let ((opts (options/with-source store (options/resolve-packages store opts)))) - (filter-map (match-lambda - (('argument . (? package? p)) - (if src? + (concatenate + (filter-map (match-lambda + (('argument . (? package? p)) + (match src + (#f + (list (package->derivation store p sys))) + (#t (let ((s (package-source p))) - (package-source-derivation store s)) - (package->derivation store p sys))) - (('argument . (? derivation? drv)) - drv) - (('argument . (? derivation-path? drv)) - (call-with-input-file drv read-derivation)) - (('argument . (? store-path?)) - ;; Nothing to do; maybe for --log-file. - #f) - (_ #f)) - opts)))) + (list (package-source-derivation store s)))) + (proc + (map (cut package-source-derivation store <>) + (proc p))))) + (('argument . (? derivation? drv)) + (list drv)) + (('argument . (? derivation-path? drv)) + (list (call-with-input-file drv read-derivation))) + (('argument . (? store-path?)) + ;; Nothing to do; maybe for --log-file. + #f) + (_ #f)) + opts))))) (define (options/resolve-packages store opts) "Return OPTS with package specification strings replaced by actual diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 80ae924410..42178091e6 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 David Thompson <davet@gnu.org> +;;; Copyright © 2014, 2015 David Thompson <davet@gnu.org> +;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,9 +23,9 @@ #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix profiles) + #:use-module (guix search-paths) #:use-module (guix utils) #:use-module (guix monads) - #:use-module (guix build utils) #:use-module (guix scripts build) #:use-module (gnu packages) #:use-module (ice-9 format) @@ -35,32 +36,20 @@ #:use-module (srfi srfi-98) #:export (guix-environment)) -(define (for-each-search-path proc inputs derivations pure?) - "Apply PROC for each native search path in INPUTS in addition to 'PATH'. -Use the output paths of DERIVATIONS to build each search path. When PURE? is -#t, the existing search path value is ignored. Otherwise, the existing search -path value is appended." - (let ((paths (append-map (lambda (drv) - (map (match-lambda - ((_ . output) - (derivation-output-path output))) - (derivation-outputs drv))) - derivations))) - (for-each (match-lambda - (($ <search-path-specification> - variable directories separator) - (let* ((current (getenv variable)) - (path (search-path-as-list directories paths)) - (value (list->search-path-as-string path separator))) - (proc variable - (if (and current (not pure?)) - (string-append value separator current) - value))))) - (cons* (search-path-specification - (variable "PATH") - (files '("bin" "sbin"))) - (delete-duplicates - (append-map package-native-search-paths inputs)))))) +(define (evaluate-input-search-paths inputs derivations) + "Evaluate the native search paths of INPUTS, a list of packages, of the +outputs of DERIVATIONS, and return a list of search-path/value pairs." + (let ((directories (append-map (lambda (drv) + (map (match-lambda + ((_ . output) + (derivation-output-path output))) + (derivation-outputs drv))) + derivations)) + (paths (cons $PATH + (delete-duplicates + (append-map package-native-search-paths + inputs))))) + (evaluate-search-paths paths directories))) ;; Protect some env vars from purification. Borrowed from nix-shell. (define %precious-variables @@ -80,15 +69,26 @@ as 'HOME' and 'USER' are left untouched." PURE? is #t, unset the variables in the current environment. Otherwise, augment existing enviroment variables with additional search paths." (when pure? (purify-environment)) - (for-each-search-path setenv inputs derivations pure?)) + (for-each (match-lambda + ((($ <search-path-specification> variable _ separator) . value) + (let ((current (getenv variable))) + (setenv variable + (if (and current (not pure?)) + (string-append value separator current) + value))))) + (evaluate-input-search-paths inputs derivations))) (define (show-search-paths inputs derivations pure?) "Display the needed search paths to build an environment that contains the packages within INPUTS. When PURE? is #t, do not augment existing environment variables with additional search paths." - (for-each-search-path (lambda (variable value) - (format #t "export ~a=\"~a\"~%" variable value)) - inputs derivations pure?)) + (for-each (match-lambda + ((search-path . value) + (display + (search-path-definition search-path value + #:kind (if pure? 'exact 'prefix))) + (newline))) + (evaluate-input-search-paths inputs derivations))) (define (show-help) (display (_ "Usage: guix environment [OPTION]... PACKAGE... @@ -103,6 +103,9 @@ shell command in that environment.\n")) (display (_ " -E, --exec=COMMAND execute COMMAND in new environment")) (display (_ " + --ad-hoc include all specified packages in the environment instead + of only their inputs")) + (display (_ " --pure unset existing environment variables")) (display (_ " --search-paths display needed environment variable definitions")) @@ -147,6 +150,9 @@ shell command in that environment.\n")) (option '(#\e "expression") #t #f (lambda (opt name arg result) (alist-cons 'expression arg result))) + (option '("ad-hoc") #f #f + (lambda (opt name arg result) + (alist-cons 'ad-hoc? #t result))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t result))) @@ -191,12 +197,17 @@ packages." (delete-duplicates (append-map transitive-inputs packages))) -;; TODO: Deduplicate these. -(define show-what-to-build* - (store-lift show-what-to-build)) - -(define set-build-options-from-command-line* - (store-lift set-build-options-from-command-line)) +(define (packages+propagated-inputs packages) + "Return a list containing PACKAGES plus all of their propagated inputs." + (delete-duplicates + (append packages + (map (match-lambda + ((or (_ (? package? package)) + (_ (? package? package) _)) + package) + (_ #f)) + (append-map package-transitive-propagated-inputs + packages))))) (define (build-inputs inputs opts) "Build the packages in INPUTS using the build options in OPTS." @@ -225,9 +236,12 @@ packages." (let* ((opts (parse-command-line args %options (list %default-options) #:argument-handler handle-argument)) (pure? (assoc-ref opts 'pure)) + (ad-hoc? (assoc-ref opts 'ad-hoc?)) (command (assoc-ref opts 'exec)) - (inputs (packages->transitive-inputs - (pick-all (options/resolve-packages opts) 'package))) + (packages (pick-all (options/resolve-packages opts) 'package)) + (inputs (if ad-hoc? + (packages+propagated-inputs packages) + (packages->transitive-inputs packages))) (drvs (run-with-store store (mbegin %store-monad (set-guile-for-build (default-guile)) diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index ed16cab8f9..6403893687 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -44,6 +44,8 @@ Invoke the garbage collector.\n")) (display (_ " -d, --delete attempt to delete PATHS")) (display (_ " + --optimize optimize the store by deduplicating identical files")) + (display (_ " --list-dead list dead paths")) (display (_ " --list-live list live paths")) @@ -56,6 +58,11 @@ Invoke the garbage collector.\n")) --referrers list the referrers of PATHS")) (newline) (display (_ " + --verify[=OPTS] verify the integrity of the store; OPTS is a + comma-separated combination of 'repair' and + 'contents'")) + (newline) + (display (_ " -h, --help display this help and exit")) (display (_ " -V, --version display version information and exit")) @@ -88,6 +95,21 @@ Invoke the garbage collector.\n")) (lambda (opt name arg result) (alist-cons 'action 'delete (alist-delete 'action result)))) + (option '("optimize") #f #f + (lambda (opt name arg result) + (alist-cons 'action 'optimize + (alist-delete 'action result)))) + (option '("verify") #f #t + (let ((not-comma (char-set-complement (char-set #\,)))) + (lambda (opt name arg result) + (let ((options (if arg + (map string->symbol + (string-tokenize arg not-comma)) + '()))) + (alist-cons 'action 'verify + (alist-cons 'verify-options options + (alist-delete 'action + result))))))) (option '("list-dead") #f #f (lambda (opt name arg result) (alist-cons 'action 'list-dead @@ -162,13 +184,21 @@ Invoke the garbage collector.\n")) (collect-garbage store min-freed) (collect-garbage store)))) ((delete) - (delete-paths store paths)) + (delete-paths store (map direct-store-path paths))) ((list-references) (list-relatives references)) ((list-requisites) (list-relatives requisites)) ((list-referrers) (list-relatives referrers)) + ((optimize) + (optimize-store store)) + ((verify) + (let ((options (assoc-ref opts 'verify-options))) + (exit + (verify-store store + #:check-contents? (memq 'contents options) + #:repair? (memq 'repair options))))) ((list-dead) (for-each (cut simple-format #t "~a~%" <>) (dead-paths store))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 06b4c17573..45ce092f13 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -86,6 +86,7 @@ rather than \\n." Run IMPORTER with ARGS.\n")) (newline) (display (_ "IMPORTER must be one of the importers listed below:\n")) + (newline) (format #t "~{ ~a~%~}" importers) (display (_ " -h, --help display this help and exit")) diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm index f7c18cd3bf..e5e9b0ed64 100644 --- a/guix/scripts/import/hackage.scm +++ b/guix/scripts/import/hackage.scm @@ -34,7 +34,9 @@ ;;; (define %default-options - '((include-test-dependencies? . #t))) + '((include-test-dependencies? . #t) + (read-from-stdin? . #f) + ('cabal-environment . '()))) (define (show-help) (display (_ "Usage: guix import hackage PACKAGE-NAME @@ -45,8 +47,13 @@ package will be generated. If no version suffix is pecified, then the generated package definition will correspond to the latest available version.\n")) (display (_ " + -e ALIST, --cabal-environment=ALIST + specify environment for Cabal evaluation")) + (display (_ " -h, --help display this help and exit")) (display (_ " + -s, --stdin read from standard input")) + (display (_ " -t, --no-test-dependencies don't include test only dependencies")) (display (_ " -V, --version display version information and exit")) @@ -67,6 +74,16 @@ version.\n")) (alist-cons 'include-test-dependencies? #f (alist-delete 'include-test-dependencies? result)))) + (option '(#\s "stdin") #f #f + (lambda (opt name arg result) + (alist-cons 'read-from-stdin? #t + (alist-delete 'read-from-stdin? + result)))) + (option '(#\e "cabal-environment") #t #f + (lambda (opt name arg result) + (alist-cons 'cabal-environment (read/eval arg) + (alist-delete 'cabal-environment + result)))) %standard-import-options)) @@ -84,23 +101,42 @@ version.\n")) (alist-cons 'argument arg result)) %default-options)) + (define (run-importer package-name opts error-fn) + (let ((sexp (hackage->guix-package + package-name + #:include-test-dependencies? + (assoc-ref opts 'include-test-dependencies?) + #:port (if (assoc-ref opts 'read-from-stdin?) + (current-input-port) + #f) + #:cabal-environment + (assoc-ref opts 'cabal-environment)))) + (unless sexp (error-fn)) + sexp)) + (let* ((opts (parse-options)) (args (filter-map (match-lambda (('argument . value) value) (_ #f)) (reverse opts)))) - (match args - ((package-name) - (let ((sexp (hackage->guix-package - package-name - #:include-test-dependencies? - (assoc-ref opts 'include-test-dependencies?)))) - (unless sexp - (leave (_ "failed to download cabal file for package '~a'~%") - package-name)) - sexp)) - (() - (leave (_ "too few arguments~%"))) - ((many ...) - (leave (_ "too many arguments~%")))))) + (if (assoc-ref opts 'read-from-stdin?) + (match args + (() + (run-importer "stdin" opts + (lambda () + (leave (_ "failed to import cabal file from '~a'~%")) + package-name))) + ((many ...) + (leave (_ "too many arguments~%")))) + (match args + ((package-name) + (run-importer package-name opts + (lambda () + (leave + (_ "failed to download cabal file for package '~a'~%")) + package-name))) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%"))))))) diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index cced1bda66..3740b71d5e 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -28,6 +28,7 @@ #:use-module (guix ui) #:use-module (guix utils) #:use-module (guix gnu-maintenance) + #:use-module (guix monads) #:use-module (gnu packages) #:use-module (ice-9 match) #:use-module (ice-9 regex) @@ -41,6 +42,7 @@ #:use-module (web request) #:use-module (web response) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-6) ;Unicode string ports #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -71,6 +73,25 @@ (package-full-name package) message))) +(define (call-with-accumulated-warnings thunk) + "Call THUNK, accumulating any warnings in the current state, using the state +monad." + (let ((port (open-output-string))) + (mlet %state-monad ((state (current-state)) + (result -> (parameterize ((guix-warning-port port)) + (thunk))) + (warning -> (get-output-string port))) + (mbegin %state-monad + (munless (string=? "" warning) + (set-current-state (cons warning state))) + (return result))))) + +(define-syntax-rule (with-accumulated-warnings exp ...) + "Evaluate EXP and accumulate warnings in the state monad." + (call-with-accumulated-warnings + (lambda () + exp ...))) + ;;; ;;; Checkers @@ -287,20 +308,22 @@ response from URI, and additional details, such as the actual HTTP response." (values 'unknown-protocol #f))))) (define (validate-uri uri package field) - "Return #t if the given URI can be reached, otherwise emit a + "Return #t if the given URI can be reached, otherwise return #f and emit a warning for PACKAGE mentionning the FIELD." (let-values (((status argument) (probe-uri uri))) (case status ((http-response) (or (= 200 (response-code argument)) - (emit-warning package - (format #f - (_ "URI ~a not reachable: ~a (~s)") - (uri->string uri) - (response-code argument) - (response-reason-phrase argument)) - field))) + (begin + (emit-warning package + (format #f + (_ "URI ~a not reachable: ~a (~s)") + (uri->string uri) + (response-code argument) + (response-reason-phrase argument)) + field) + #f))) ((ftp-response) (match argument (('ok) #t) @@ -309,7 +332,8 @@ warning for PACKAGE mentionning the FIELD." (format #f (_ "URI ~a not reachable: ~a (~s)") (uri->string uri) - code (string-trim-both message)))))) + code (string-trim-both message))) + #f))) ((getaddrinfo-error) (emit-warning package (format #f @@ -432,6 +456,16 @@ descriptions maintained upstream." (define (check-source package) "Emit a warning if PACKAGE has an invalid 'source' field, or if that 'source' is not reachable." + (define (try-uris uris) + (run-with-state + (anym %state-monad + (lambda (uri) + (with-accumulated-warnings + (validate-uri uri package 'source))) + (append-map (cut maybe-expand-mirrors <> %mirrors) + uris)) + '())) + (let ((origin (package-source package))) (when (and origin (eqv? (origin-method origin) url-fetch)) @@ -439,10 +473,24 @@ descriptions maintained upstream." (uris (if (list? strings) (map string->uri strings) (list (string->uri strings))))) + ;; Just make sure that at least one of the URIs is valid. - (any (cut validate-uri <> package 'source) - (append-map (cut maybe-expand-mirrors <> %mirrors) - uris)))))) + (call-with-values + (lambda () (try-uris uris)) + (lambda (success? warnings) + ;; When everything fails, report all of WARNINGS, otherwise don't + ;; report anything. + ;; + ;; XXX: Ideally we'd still allow warnings to be raised if *some* + ;; URIs are unreachable, but distinguish that from the error case + ;; where *all* the URIs are unreachable. + (unless success? + (emit-warning package + (_ "all the source URIs are unreachable:") + 'source) + (for-each (lambda (warning) + (display warning (guix-warning-port))) + (reverse warnings))))))))) (define (check-derivation package) "Emit a warning if we fail to compile PACKAGE to a derivation." @@ -527,7 +575,8 @@ descriptions maintained upstream." (define (show-help) (display (_ "Usage: guix lint [OPTION]... [PACKAGE]... -Run a set of checkers on the specified package; if none is specified, run the checkers on all packages.\n")) +Run a set of checkers on the specified package; if none is specified, +run the checkers on all packages.\n")) (display (_ " -c, --checkers=CHECKER1,CHECKER2... only run the specificed checkers")) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 1e724b4e19..d9f38fb8bc 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -25,6 +25,7 @@ #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix profiles) + #:use-module (guix search-paths) #:use-module (guix monads) #:use-module (guix utils) #:use-module (guix config) @@ -52,6 +53,7 @@ roll-back delete-generation delete-generations + display-search-paths guix-package)) (define %store @@ -89,6 +91,15 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if %current-profile profile)) +(define (user-friendly-profile profile) + "Return either ~/.guix-profile if that's what PROFILE refers to, directly or +indirectly, or PROFILE." + (if (and %user-profile-directory + (false-if-exception + (string=? (readlink %user-profile-directory) profile))) + %user-profile-directory + profile)) + (define (link-to-empty-profile store generation) "Link GENERATION, a string, to the empty profile." (let* ((drv (run-with-store store @@ -365,77 +376,35 @@ an output path different than CURRENT-PATH." ;;; Search paths. ;;; -(define-syntax-rule (with-null-error-port exp) - "Evaluate EXP with the error port pointing to the bit bucket." - (with-error-to-port (%make-void-port "w") - (lambda () exp))) - (define* (search-path-environment-variables entries profile - #:optional (getenv getenv)) + #:optional (getenv getenv) + #:key (kind 'exact)) "Return environment variable definitions that may be needed for the use of ENTRIES, a list of manifest entries, in PROFILE. Use GETENV to determine the -current settings and report only settings not already effective." - - ;; Prefer ~/.guix-profile to the real profile directory name. - (let ((profile (if (and %user-profile-directory - (false-if-exception - (string=? (readlink %user-profile-directory) - profile))) - %user-profile-directory - profile))) - - ;; The search path info is not stored in the manifest. Thus, we infer the - ;; search paths from same-named packages found in the distro. - - (define manifest-entry->package - (match-lambda - (($ <manifest-entry> name version) - ;; Use 'find-best-packages-by-name' and not 'find-packages-by-name'; - ;; the former traverses the module tree only once and then allows for - ;; efficient access via a vhash. - (match (find-best-packages-by-name name version) - ((p _ ...) p) - (_ - (match (find-best-packages-by-name name #f) - ((p _ ...) p) - (_ #f))))))) - - (define search-path-definition - (match-lambda - (($ <search-path-specification> variable files separator - type pattern) - (let* ((values (or (and=> (getenv variable) - (cut string-tokenize* <> separator)) - '())) - ;; Add a trailing slash to force symlinks to be treated as - ;; directories when 'find-files' traverses them. - (files (if pattern - (map (cut string-append <> "/") files) - files)) - - ;; XXX: Silence 'find-files' when it stumbles upon non-existent - ;; directories (see - ;; <http://lists.gnu.org/archive/html/guix-devel/2015-01/msg00269.html>.) - (path (with-null-error-port - (search-path-as-list files (list profile) - #:type type - #:pattern pattern)))) - (if (every (cut member <> values) path) - #f - (format #f "export ~a=\"~a\"" - variable - (string-join path separator))))))) - - (let* ((packages (filter-map manifest-entry->package entries)) - (search-paths (delete-duplicates - (append-map package-native-search-paths - packages)))) - (filter-map search-path-definition search-paths)))) - -(define (display-search-paths entries profile) +current settings and report only settings not already effective. KIND +must be one of 'exact, 'prefix, or 'suffix, depending on the kind of search +path definition to be returned." + (let ((search-paths (delete-duplicates + (cons $PATH + (append-map manifest-entry-search-paths + entries))))) + (filter-map (match-lambda + ((spec . value) + (let ((variable (search-path-specification-variable spec)) + (sep (search-path-specification-separator spec))) + (environment-variable-definition variable value + #:separator sep + #:kind kind)))) + (evaluate-search-paths search-paths (list profile) + getenv)))) + +(define* (display-search-paths entries profile + #:key (kind 'exact)) "Display the search path environment variables that may need to be set for ENTRIES, a list of manifest entries, in the context of PROFILE." - (let ((settings (search-path-environment-variables entries profile))) + (let* ((profile (user-friendly-profile profile)) + (settings (search-path-environment-variables entries profile + #:kind kind))) (unless (null? settings) (format #t (_ "The following environment variable definitions may be needed:~%")) (format #t "~{ ~a~%~}" settings)))) @@ -453,23 +422,29 @@ ENTRIES, a list of manifest entries, in the context of PROFILE." (substitutes? . #t))) (define (show-help) - (display (_ "Usage: guix package [OPTION]... PACKAGES... -Install, remove, or upgrade PACKAGES in a single transaction.\n")) + (display (_ "Usage: guix package [OPTION]... +Install, remove, or upgrade packages in a single transaction.\n")) (display (_ " - -i, --install=PACKAGE install PACKAGE")) + -i, --install PACKAGE ... + install PACKAGEs")) (display (_ " -e, --install-from-expression=EXP install the package EXP evaluates to")) (display (_ " - -r, --remove=PACKAGE remove PACKAGE")) + -r, --remove PACKAGE ... + remove PACKAGEs")) (display (_ " -u, --upgrade[=REGEXP] upgrade all the installed packages matching REGEXP")) (display (_ " + -m, --manifest=FILE create a new profile generation with the manifest + from FILE")) + (display (_ " --do-not-upgrade[=REGEXP] do not upgrade any packages matching REGEXP")) (display (_ " --roll-back roll back to the previous generation")) (display (_ " - --search-paths display needed environment variable definitions")) + --search-paths[=KIND] + display needed environment variable definitions")) (display (_ " -l, --list-generations[=PATTERN] list generations matching PATTERN")) @@ -496,7 +471,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) -A, --list-available[=REGEXP] list available packages matching REGEXP")) (display (_ " - --show=PACKAGE show details about PACKAGE")) + --show=PACKAGE show details about PACKAGE")) (newline) (show-build-options-help) (newline) @@ -556,6 +531,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (lambda (opt name arg result arg-handler) (values (alist-cons 'roll-back? #t result) #f))) + (option '(#\m "manifest") #t #f + (lambda (opt name arg result arg-handler) + (values (alist-cons 'manifest arg result) + arg-handler))) (option '(#\l "list-generations") #f #t (lambda (opt name arg result arg-handler) (values (cons `(query list-generations ,(or arg "")) @@ -570,10 +549,20 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (lambda (opt name arg result arg-handler) (values (alist-cons 'switch-generation arg result) #f))) - (option '("search-paths") #f #f + (option '("search-paths") #f #t (lambda (opt name arg result arg-handler) - (values (cons `(query search-paths) result) - #f))) + (let ((kind (match arg + ((or "exact" "prefix" "suffix") + (string->symbol arg)) + (#f + 'exact) + (x + (leave (_ "~a: unsupported \ +kind of search path~%") + x))))) + (values (cons `(query search-paths ,kind) + result) + #f)))) (option '(#\p "profile") #t #f (lambda (opt name arg result arg-handler) (values (alist-cons 'profile (canonicalize-profile arg) @@ -822,6 +811,50 @@ more information.~%")) (define dry-run? (assoc-ref opts 'dry-run?)) (define profile (assoc-ref opts 'profile)) + (define (build-and-use-profile manifest) + (let* ((bootstrap? (assoc-ref opts 'bootstrap?))) + + (when (equal? profile %current-profile) + (ensure-default-profile)) + + (let* ((prof-drv (run-with-store (%store) + (profile-derivation + manifest + #:hooks (if bootstrap? + '() + %default-profile-hooks)))) + (prof (derivation->output-path prof-drv))) + (show-what-to-build (%store) (list prof-drv) + #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? dry-run?) + + (cond + (dry-run? #t) + ((and (file-exists? profile) + (and=> (readlink* profile) (cut string=? prof <>))) + (format (current-error-port) (_ "nothing to be done~%"))) + (else + (let* ((number (generation-number profile)) + + ;; Always use NUMBER + 1 for the new profile, + ;; possibly overwriting a "previous future + ;; generation". + (name (generation-file-name profile + (+ 1 number)))) + (and (build-derivations (%store) (list prof-drv)) + (let* ((entries (manifest-entries manifest)) + (count (length entries))) + (switch-symlinks name prof) + (switch-symlinks profile name) + (unless (string=? profile %current-profile) + (register-gc-root (%store) name)) + (format #t (N_ "~a package in profile~%" + "~a packages in profile~%" + count) + count) + (display-search-paths entries profile))))))))) + ;; First roll back if asked to. (cond ((and (assoc-ref opts 'roll-back?) (not dry-run?)) @@ -856,60 +889,30 @@ more information.~%")) (alist-delete 'delete-generations opts))) (_ #f)) opts)) + ((assoc-ref opts 'manifest) + (let* ((file-name (assoc-ref opts 'manifest)) + (user-module (make-user-module '((guix profiles) + (gnu)))) + (manifest (load* file-name user-module))) + (if (assoc-ref opts 'dry-run?) + (format #t (_ "would install new manifest from '~a' with ~d entries~%") + file-name (length (manifest-entries manifest))) + (format #t (_ "installing new manifest from '~a' with ~d entries~%") + file-name (length (manifest-entries manifest)))) + (build-and-use-profile manifest))) (else (let* ((manifest (profile-manifest profile)) (install (options->installable opts manifest)) (remove (options->removable opts manifest)) - (bootstrap? (assoc-ref opts 'bootstrap?)) (transaction (manifest-transaction (install install) (remove remove))) (new (manifest-perform-transaction manifest transaction))) - (when (equal? profile %current-profile) - (ensure-default-profile)) - (unless (and (null? install) (null? remove)) - (let* ((prof-drv (run-with-store (%store) - (profile-derivation - new - #:hooks (if bootstrap? - '() - %default-profile-hooks)))) - (prof (derivation->output-path prof-drv))) - (show-manifest-transaction (%store) manifest transaction - #:dry-run? dry-run?) - (show-what-to-build (%store) (list prof-drv) - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:dry-run? dry-run?) - - (cond - (dry-run? #t) - ((and (file-exists? profile) - (and=> (readlink* profile) (cut string=? prof <>))) - (format (current-error-port) (_ "nothing to be done~%"))) - (else - (let* ((number (generation-number profile)) - - ;; Always use NUMBER + 1 for the new profile, - ;; possibly overwriting a "previous future - ;; generation". - (name (generation-file-name profile - (+ 1 number)))) - (and (build-derivations (%store) (list prof-drv)) - (let* ((entries (manifest-entries new)) - (count (length entries))) - (switch-symlinks name prof) - (switch-symlinks profile name) - (unless (string=? profile %current-profile) - (register-gc-root (%store) name)) - (format #t (N_ "~a package in profile~%" - "~a packages in profile~%" - count) - count) - (display-search-paths entries - profile)))))))))))) + (show-manifest-transaction (%store) manifest transaction + #:dry-run? dry-run?) + (build-and-use-profile new)))))) (define (process-query opts) ;; Process any query specified by OPTS. Return #t when a query was @@ -1014,11 +1017,13 @@ more information.~%")) (find-packages-by-name name version))) #t)) - (('search-paths) + (('search-paths kind) (let* ((manifest (profile-manifest profile)) (entries (manifest-entries manifest)) + (profile (user-friendly-profile profile)) (settings (search-path-environment-variables entries profile - (const #f)))) + (const #f) + #:kind kind))) (format #t "~{~a~%~}" settings) #t)) diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index c7c66fefbe..7bad2619b9 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -51,6 +51,10 @@ Publish ~a over HTTP.\n") %store-directory) (display (_ " -p, --port=PORT listen on PORT")) (display (_ " + --listen=HOST listen on the network interface for HOST")) + (display (_ " + -u, --user=USER change privileges to USER as soon as possible")) + (display (_ " -r, --repl[=PORT] spawn REPL server on PORT")) (newline) (display (_ " @@ -60,6 +64,15 @@ Publish ~a over HTTP.\n") %store-directory) (newline) (show-bug-report-information)) +(define (getaddrinfo* host) + "Like 'getaddrinfo', but properly report errors." + (catch 'getaddrinfo-error + (lambda () + (getaddrinfo host)) + (lambda (key error) + (leave (_ "lookup of host '~a' failed: ~a~%") + host (gai-strerror error))))) + (define %options (list (option '(#\h "help") #f #f (lambda _ @@ -68,9 +81,21 @@ Publish ~a over HTTP.\n") %store-directory) (option '(#\V "version") #f #f (lambda _ (show-version-and-exit "guix publish"))) + (option '(#\u "user") #t #f + (lambda (opt name arg result) + (alist-cons 'user arg result))) (option '(#\p "port") #t #f (lambda (opt name arg result) (alist-cons 'port (string->number* arg) result))) + (option '("listen") #t #f + (lambda (opt name arg result) + (match (getaddrinfo* arg) + ((info _ ...) + (alist-cons 'address (addrinfo:addr info) + result)) + (() + (leave (_ "lookup of host '~a' returned nothing") + name))))) (option '(#\r "repl") #f #t (lambda (opt name arg result) ;; If port unspecified, use default Guile REPL port. @@ -78,7 +103,8 @@ Publish ~a over HTTP.\n") %store-directory) (alist-cons 'repl (or port 37146) result)))))) (define %default-options - '((port . 8080) + `((port . 8080) + (address . ,(make-socket-address AF_INET INADDR_ANY 0)) (repl . #f))) (define (lazy-read-file-sexp file) @@ -220,24 +246,69 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")." (_ (not-found request))) (not-found request)))) -(define (run-publish-server port store) +(define (run-publish-server socket store) (run-server (make-request-handler store) 'http - `(#:addr ,INADDR_ANY - #:port ,port))) + `(#:socket ,socket))) + +(define (open-server-socket address) + "Return a TCP socket bound to ADDRESS, a socket address." + (let ((sock (socket (sockaddr:fam address) SOCK_STREAM 0))) + (setsockopt sock SOL_SOCKET SO_REUSEADDR 1) + (bind sock address) + sock)) + +(define (gather-user-privileges user) + "Switch to the identity of USER, a user name." + (catch 'misc-error + (lambda () + (let ((user (getpw user))) + (setgroups #()) + (setgid (passwd:gid user)) + (setuid (passwd:uid user)))) + (lambda (key proc message args . rest) + (leave (_ "user '~a' not found: ~a~%") + user (apply format #f message args))))) + + +;;; +;;; Entry point. +;;; (define (guix-publish . args) (with-error-handling - (let* ((opts (args-fold* args %options - (lambda (opt name arg result) - (leave (_ "~A: unrecognized option~%") name)) - (lambda (arg result) - (leave (_ "~A: extraneuous argument~%") arg)) - %default-options)) - (port (assoc-ref opts 'port)) + (let* ((opts (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (leave (_ "~A: extraneuous argument~%") arg)) + %default-options)) + (user (assoc-ref opts 'user)) + (port (assoc-ref opts 'port)) + (address (let ((addr (assoc-ref opts 'address))) + (make-socket-address (sockaddr:fam addr) + (sockaddr:addr addr) + port))) + (socket (open-server-socket address)) (repl-port (assoc-ref opts 'repl))) - (format #t (_ "publishing ~a on port ~d~%") %store-directory port) + ;; Read the key right away so that (1) we fail early on if we can't + ;; access them, and (2) we can then drop privileges. + (force %private-key) + (force %public-key) + + (when user + ;; Now that we've read the key material and opened the socket, we can + ;; drop privileges. + (gather-user-privileges user)) + + (when (zero? (getuid)) + (warning (_ "server running as root; \ +consider using the '--user' option!~%"))) + (format #t (_ "publishing ~a on ~a, port ~d~%") + %store-directory + (inet-ntop (sockaddr:fam address) (sockaddr:addr address)) + (sockaddr:port address)) (when repl-port (repl:spawn-server (repl:make-tcp-server-socket #:port repl-port))) (with-store store - (run-publish-server (assoc-ref opts 'port) store))))) + (run-publish-server socket store))))) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index b9983c5b9c..8b4fa36d2a 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -84,8 +84,10 @@ disabled!~%")) (define %narinfo-ttl ;; Number of seconds during which cached narinfo lookups are considered - ;; valid. - (* 24 3600)) + ;; valid. This is a reasonable default value (corresponds to the TTL for + ;; nginx's .nar cache on hydra.gnu.org) but we'd rather want publishers to + ;; state what their TTL is in /nix-cache-info. (XXX) + (* 36 3600)) (define %narinfo-negative-ttl ;; Likewise, but for negative lookups---i.e., cached lookup failures. @@ -155,15 +157,12 @@ to the caller without emitting an error message." (leave (_ "download from '~a' failed: ~a, ~s~%") (uri->string (http-get-error-uri c)) code (http-get-error-reason c)))))) - ;; On Guile 2.0.5, `http-fetch' fetches the whole thing at once. So - ;; honor TIMEOUT? to disable the timeout when fetching a nar. - ;; ;; Test this with: ;; sudo tc qdisc add dev eth0 root netem delay 1500ms ;; and then cancel with: ;; sudo tc qdisc del dev eth0 root (let ((port #f)) - (with-timeout (if (or timeout? (guile-version>? "2.0.5")) + (with-timeout (if timeout? %fetch-timeout 0) (begin @@ -180,7 +179,9 @@ to the caller without emitting an error message." (close-port port)))) (begin (when (or (not port) (port-closed? port)) - (set! port (open-socket-for-uri uri #:buffered? buffered?))) + (set! port (open-socket-for-uri uri)) + (unless buffered? + (setvbuf port _IONBF))) (http-fetch uri #:text? #f #:port port)))))))) (define-record-type <cache> @@ -645,17 +646,9 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by ;; XXX: We're not in control, so we always return anyway. n)) - ;; Since `http-fetch' in Guile 2.0.5 returns all the data once it's done, - ;; don't pretend to report any progress in that case. - (if (guile-version>? "2.0.5") - (make-custom-binary-input-port "progress-port-proc" - read! #f #f - (cut close-port port)) - (begin - (format (current-error-port) (_ "Downloading, please wait...~%")) - (format (current-error-port) - (_ "(Please consider upgrading Guile to get proper progress report.)~%")) - port))) + (make-custom-binary-input-port "progress-port-proc" + read! #f #f + (cut close-port port))) (define-syntax with-networking (syntax-rules () diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 1838e89452..aa9b3f838a 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -48,28 +48,14 @@ (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)) + (make-user-module '((gnu system) + (gnu services) + (gnu system shadow)))) (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) + (load* file %user-module)) - (save-module-excursion - (lambda () - (set-current-module %user-module) - (primitive-load file)))) - (lambda args - (report-load-error file args)))) ;;; @@ -81,8 +67,6 @@ (store-lift references)) (define topologically-sorted* (store-lift topologically-sorted)) -(define show-what-to-build* - (store-lift show-what-to-build)) (define* (copy-item item target @@ -92,6 +76,13 @@ (let ((dest (string-append target item)) (state (string-append target "/var/guix"))) (format log-port "copying '~a'...~%" item) + + ;; Remove DEST if it exists to make sure that (1) we do not fail badly + ;; while trying to overwrite it (see <http://bugs.gnu.org/20722>), and + ;; (2) we end up with the right contents. + (when (file-exists? dest) + (delete-file-recursively dest)) + (copy-recursively item dest #:log (%make-void-port "w")) @@ -144,8 +135,9 @@ TARGET, and register them." (define* (install os-drv target #:key (log-port (current-output-port)) grub? grub.cfg device) - "Copy the output of OS-DRV and its dependencies to directory TARGET. TARGET -must be an absolute directory name since that's what 'guix-register' expects. + "Copy the closure of GRUB.CFG, which includes the output of OS-DRV, to +directory TARGET. TARGET must be an absolute directory name since that's what +'guix-register' expects. When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG." (define (maybe-copy to-copy) @@ -161,12 +153,24 @@ When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG." ;; Copy items to the new store. (copy-closure to-copy target #:log-port log-port))))) + ;; Make sure TARGET is root-owned when running as root, but still allow + ;; non-root uses (useful for testing.) See + ;; <http://lists.gnu.org/archive/html/guix-devel/2015-05/msg00452.html>. + (if (zero? (geteuid)) + (chown target 0 0) + (warning (_ "not running as 'root', so \ +the ownership of '~a' may be incorrect!~%") + target)) + + (chmod target #o755) (let ((os-dir (derivation->output-path os-drv)) (format (lift format %store-monad)) (populate (lift2 populate-root-file-system %store-monad))) (mbegin %store-monad - (maybe-copy os-dir) + ;; Copy the closure of GRUB.CFG, which includes OS-DIR, GRUB's + ;; background image and so on. + (maybe-copy grub.cfg) ;; Create a bunch of additional files. (format log-port "populating '~a'...~%" target) @@ -290,10 +294,6 @@ it atomically, and then run OS's activation script." ((disk-image) (system-disk-image os #:disk-image-size image-size)))) -(define (grub.cfg os) - "Return the GRUB configuration file for OS." - (operating-system-grub.cfg os (previous-grub-entries))) - (define* (maybe-build drvs #:key dry-run? use-substitutes?) "Show what will/would be built, and actually build DRVS, unless DRY-RUN? is @@ -323,7 +323,10 @@ boot directly to the kernel or to the bootloader." #:full-boot? full-boot? #:mappings mappings)) (grub (package->derivation grub)) - (grub.cfg (grub.cfg os)) + (grub.cfg (operating-system-grub.cfg os + (if (eq? 'init action) + '() + (previous-grub-entries)))) (drvs -> (if (and grub? (memq action '(init reconfigure))) (list sys grub grub.cfg) (list sys))) @@ -372,21 +375,25 @@ boot directly to the kernel or to the bootloader." Build the operating system declared in FILE according to ACTION.\n")) (newline) (display (_ "The valid values for ACTION are:\n")) + (newline) (display (_ "\ - - 'reconfigure', switch to a new operating system configuration\n")) + reconfigure switch to a new operating system configuration\n")) (display (_ "\ - - 'build', build the operating system without installing anything\n")) + build build the operating system without installing anything\n")) (display (_ "\ - - 'vm', build a virtual machine image that shares the host's store\n")) + vm build a virtual machine image that shares the host's store\n")) (display (_ "\ - - 'vm-image', build a freestanding virtual machine image\n")) + vm-image build a freestanding virtual machine image\n")) (display (_ "\ - - 'disk-image', build a disk image, suitable for a USB stick\n")) + disk-image build a disk image, suitable for a USB stick\n")) (display (_ "\ - - 'init', initialize a root file system to run GNU.\n")) + init initialize a root file system to run GNU.\n")) (show-build-options-help) (display (_ " + --on-error=STRATEGY + apply STRATEGY when an error occurs while reading FILE")) + (display (_ " --image-size=SIZE for 'vm-image', produce an image of SIZE")) (display (_ " --no-grub for 'init', do not install GRUB")) @@ -426,6 +433,10 @@ Build the operating system declared in FILE according to ACTION.\n")) (option '(#\V "version") #f #f (lambda args (show-version-and-exit "guix system"))) + (option '("on-error") #t #f + (lambda (opt name arg result) + (alist-cons 'on-error (string->symbol arg) + result))) (option '("image-size") #t #f (lambda (opt name arg result) (alist-cons 'image-size (size->number arg) @@ -518,7 +529,8 @@ Build the operating system declared in FILE according to ACTION.\n")) (action (assoc-ref opts 'action)) (system (assoc-ref opts 'system)) (os (if file - (read-operating-system file) + (load* file %user-module + #:on-error (assoc-ref opts 'on-error)) (leave (_ "no configuration file specified~%")))) (dry? (assoc-ref opts 'dry-run?)) diff --git a/guix/search-paths.scm b/guix/search-paths.scm new file mode 100644 index 0000000000..7fd15d440c --- /dev/null +++ b/guix/search-paths.scm @@ -0,0 +1,193 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014, 2015 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 search-paths) + #:use-module (guix records) + #:use-module (guix build utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) + #:export (<search-path-specification> + search-path-specification + search-path-specification? + search-path-specification-variable + search-path-specification-files + search-path-specification-separator + search-path-specification-file-type + search-path-specification-file-pattern + + $PATH + + search-path-specification->sexp + sexp->search-path-specification + string-tokenize* + evaluate-search-paths + environment-variable-definition + search-path-definition)) + +;;; Commentary: +;;; +;;; This module defines "search path specifications", which allow packages to +;;; declare environment variables that they use to define search paths. For +;;; instance, GCC has the 'CPATH' variable, Guile has the 'GUILE_LOAD_PATH' +;;; variable, etc. +;;; +;;; Code: + +;; The specification of a search path. +(define-record-type* <search-path-specification> + search-path-specification make-search-path-specification + search-path-specification? + (variable search-path-specification-variable) ;string + (files search-path-specification-files) ;list of strings + (separator search-path-specification-separator ;string + (default ":")) + (file-type search-path-specification-file-type ;symbol + (default 'directory)) + (file-pattern search-path-specification-file-pattern ;#f | string + (default #f))) + +(define $PATH + ;; The 'PATH' variable. This variable is a bit special: it is not attached + ;; to any package in particular. + (search-path-specification + (variable "PATH") + (files '("bin" "sbin")))) + +(define (search-path-specification->sexp spec) + "Return an sexp representing SPEC, a <search-path-specification>. The sexp +corresponds to the arguments expected by `set-path-environment-variable'." + ;; Note that this sexp format is used both by build systems and in + ;; (guix profiles), so think twice before you change it. + (match spec + (($ <search-path-specification> variable files separator type pattern) + `(,variable ,files ,separator ,type ,pattern)))) + +(define (sexp->search-path-specification sexp) + "Convert SEXP, which is as returned by 'search-path-specification->sexp', to +a <search-path-specification> object." + (match sexp + ((variable files separator type pattern) + (search-path-specification + (variable variable) + (files files) + (separator separator) + (file-type type) + (file-pattern pattern))))) + +(define-syntax-rule (with-null-error-port exp) + "Evaluate EXP with the error port pointing to the bit bucket." + (with-error-to-port (%make-void-port "w") + (lambda () exp))) + +;; XXX: This procedure used to be in (guix utils) but since we want to be able +;; to use (guix search-paths) on the build side, we want to avoid the +;; dependency on (guix utils), and so this procedure is back here for now. +(define (string-tokenize* string separator) + "Return the list of substrings of STRING separated by SEPARATOR. This is +like `string-tokenize', but SEPARATOR is a string." + (define (index string what) + (let loop ((string string) + (offset 0)) + (cond ((string-null? string) + #f) + ((string-prefix? what string) + offset) + (else + (loop (string-drop string 1) (+ 1 offset)))))) + + (define len + (string-length separator)) + + (let loop ((string string) + (result '())) + (cond ((index string separator) + => + (lambda (offset) + (loop (string-drop string (+ offset len)) + (cons (substring string 0 offset) + result)))) + (else + (reverse (cons string result)))))) + +(define* (evaluate-search-paths search-paths directories + #:optional (getenv (const #f))) + "Evaluate SEARCH-PATHS, a list of search-path specifications, for +DIRECTORIES, a list of directory names, and return a list of +specification/value pairs. Use GETENV to determine the current settings and +report only settings not already effective." + (define search-path-definition + (match-lambda + ((and spec + ($ <search-path-specification> variable files separator + type pattern)) + (let* ((values (or (and=> (getenv variable) + (cut string-tokenize* <> separator)) + '())) + ;; Add a trailing slash to force symlinks to be treated as + ;; directories when 'find-files' traverses them. + (files (if pattern + (map (cut string-append <> "/") files) + files)) + + ;; XXX: Silence 'find-files' when it stumbles upon non-existent + ;; directories (see + ;; <http://lists.gnu.org/archive/html/guix-devel/2015-01/msg00269.html>.) + (path (with-null-error-port + (search-path-as-list files directories + #:type type + #:pattern pattern)))) + (if (every (cut member <> values) path) + #f ;VARIABLE is already set appropriately + (cons spec (string-join path separator))))))) + + (filter-map search-path-definition search-paths)) + +(define* (environment-variable-definition variable value + #:key + (kind 'exact) + (separator ":")) + "Return a the definition of VARIABLE to VALUE in Bash syntax. + +KIND can be either 'exact (return the definition of VARIABLE=VALUE), +'prefix (return the definition where VALUE is added as a prefix to VARIABLE's +current value), or 'suffix (return the definition where VALUE is added as a +suffix to VARIABLE's current value.) In the case of 'prefix and 'suffix, +SEPARATOR is used as the separator between VARIABLE's current value and its +prefix/suffix." + (match kind + ('exact + (format #f "export ~a=\"~a\"" variable value)) + ('prefix + (format #f "export ~a=\"~a${~a:+~a}$~a\"" + variable value variable separator variable)) + ('suffix + (format #f "export ~a=\"$~a${~a:+~a}~a\"" + variable variable variable separator value)))) + +(define* (search-path-definition search-path value + #:key (kind 'exact)) + "Similar to 'environment-variable-definition', but applied to a +<search-path-specification>." + (match search-path + (($ <search-path-specification> variable _ separator) + (environment-variable-definition variable value + #:kind kind + #:separator separator)))) + +;;; search-paths.scm ends here diff --git a/guix/serialization.scm b/guix/serialization.scm index 51d7ef76c6..7a3defc03d 100644 --- a/guix/serialization.scm +++ b/guix/serialization.scm @@ -279,17 +279,11 @@ sub-directories of FILE as needed." (write-string "type" p) (write-string "directory" p) (let ((entries - ;; NOTE: Guile 2.0.5's 'scandir' returns all subdirectories - ;; unconditionally, including "." and "..", regardless of the - ;; 'select?' predicate passed to it, so we have to filter - ;; those out externally. - (filter (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. - (scandir f (const #t) string<?)))) + ;; '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. + (scandir f (negate (cut member <> '("." ".."))) string<?))) (for-each (lambda (e) (let ((f (string-append f "/" e))) (write-string "entry" p) diff --git a/guix/store.scm b/guix/store.scm index 10b9062db2..933708defc 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -90,6 +90,8 @@ references requisites referrers + optimize-store + verify-store topologically-sorted valid-derivers query-derivation-outputs @@ -120,6 +122,7 @@ derivation-path? store-path-package-name store-path-hash-part + direct-store-path log-file)) (define %protocol-version #x10c) @@ -171,7 +174,9 @@ (query-substitutable-path-infos 30) (query-valid-paths 31) (query-substitutable-paths 32) - (query-valid-derivers 33)) + (query-valid-derivers 33) + (optimize-store 34) + (verify-store 35)) (define-enumerate-type hash-algo ;; hash.hh @@ -494,8 +499,8 @@ encoding conversion errors." ;; Client-provided substitute URLs. For ;; unprivileged clients, these are considered - ;; "untrusted"; for root, they override the - ;; daemon's settings. + ;; "untrusted"; for "trusted" users, they override + ;; the daemon's settings. (substitute-urls %default-substitute-urls)) ;; Must be called after `open-connection'. @@ -760,6 +765,25 @@ substitutable. For each substitutable path, a `substitutable?' object is returned." substitutable-path-list)) +(define-operation (optimize-store) + "Optimize the store by hard-linking identical files (\"deduplication\".) +Return #t on success." + ;; Note: the daemon in Guix <= 0.8.2 does not implement this RPC. + boolean) + +(define verify-store + (let ((verify (operation (verify-store (boolean check-contents?) + (boolean repair?)) + "Verify the store." + boolean))) + (lambda* (store #:key check-contents? repair?) + "Verify the integrity of the store and return false if errors remain, +and true otherwise. When REPAIR? is true, repair any missing or altered store +items by substituting them (this typically requires root privileges because it +is not an atomic operation.) When CHECK-CONTENTS? is true, check the contents +of store items; this can take a lot of time." + (not (verify store check-contents? repair?))))) + (define (run-gc server action to-delete min-freed) "Perform the garbage-collector operation ACTION, one of the `gc-action' values. When ACTION is `delete-specific', the TO-DELETE is @@ -1004,6 +1028,15 @@ valid inputs." (let ((len (+ 1 (string-length (%store-prefix))))) (not (string-index (substring path len) #\/))))) +(define (direct-store-path path) + "Return the direct store path part of PATH, stripping components after +'/gnu/store/xxxx-foo'." + (let ((prefix-length (+ (string-length (%store-prefix)) 35))) + (if (> (string-length path) prefix-length) + (let ((slash (string-index path #\/ prefix-length))) + (if slash (string-take path slash) path)) + path))) + (define (derivation-path? path) "Return #t if PATH is a derivation path." (and (store-path? path) (string-suffix? ".drv" path))) diff --git a/guix/tests.scm b/guix/tests.scm index 080ee9cc74..87e6cc2830 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -37,7 +37,8 @@ %substitute-directory with-derivation-narinfo with-derivation-substitute - dummy-package)) + dummy-package + dummy-origin)) ;;; Commentary: ;;; @@ -219,6 +220,13 @@ initialized with default values, and with EXTRA-FIELDS set as specified." (synopsis #f) (description #f) (home-page #f) (license #f))) +(define-syntax-rule (dummy-origin extra-fields ...) + "Return a \"dummy\" origin, with all its compulsory fields initialized with +default values, and with EXTRA-FIELDS set as specified." + (origin extra-fields ... + (method #f) (uri "http://www.example.com") + (sha256 (base32 (make-string 52 #\x))))) + ;; Local Variables: ;; eval: (put 'call-with-derivation-narinfo 'scheme-indent-function 1) ;; eval: (put 'call-with-derivation-substitute 'scheme-indent-function 2) diff --git a/guix/ui.scm b/guix/ui.scm index e717ab713e..11af646a6e 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -35,6 +35,7 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-31) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) @@ -42,19 +43,22 @@ #:use-module (ice-9 match) #:use-module (ice-9 format) #:use-module (ice-9 regex) - #:replace (symlink) + #:autoload (system repl repl) (start-repl) + #:autoload (system repl debug) (make-debug stack->vector) #:export (_ N_ P_ report-error leave - report-load-error + make-user-module + load* warn-about-load-error show-version-and-exit show-bug-report-information string->number* size->number show-what-to-build + show-what-to-build* show-manifest-transaction call-with-error-handling with-error-handling @@ -133,22 +137,102 @@ messages." (report-error args ...) (exit 1))) -(define (report-load-error file args) - "Report the failure to load FILE, a user-provided Scheme file, and exit. +(define (make-user-module modules) + "Return a new user module with the additional MODULES loaded." + ;; 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))) + modules) + module)) + +(define* (load* file user-module + #:key (on-error 'nothing-special)) + "Load the user provided Scheme source code FILE." + (define (frame-with-source frame) + ;; Walk from FRAME upwards until source location information is found. + (let loop ((frame frame) + (previous frame)) + (if (not frame) + previous + (if (frame-source frame) + frame + (loop (frame-previous frame) frame))))) + + (define (error-string frame args) + (call-with-output-string + (lambda (port) + (apply display-error frame port (cdr args))))) + + (define tag + (make-prompt-tag "user-code")) + + (catch #t + (lambda () + ;; XXX: Force a recompilation to avoid ABI issues. + (set! %fresh-auto-compile #t) + (set! %load-should-auto-compile #t) + + (save-module-excursion + (lambda () + (set-current-module user-module) + + ;; Hide the "auto-compiling" messages. + (parameterize ((current-warning-port (%make-void-port "w"))) + (call-with-prompt tag + (lambda () + ;; Give 'load' an absolute file name so that it doesn't try to + ;; search for FILE in %LOAD-PATH. Note: use 'load', not + ;; 'primitive-load', so that FILE is compiled, which then allows us + ;; to provide better error reporting with source line numbers. + (load (canonicalize-path file))) + (const #f)))))) + (lambda _ + ;; XXX: Errors are reported from the pre-unwind handler below, but + ;; calling 'exit' from there has no effect, so we call it here. + (exit 1)) + (rec (handle-error . args) + ;; Capture the stack up to this procedure call, excluded, and pass + ;; the faulty stack frame to 'report-load-error'. + (let* ((stack (make-stack #t handle-error tag)) + (depth (stack-length stack)) + (last (and (> depth 0) (stack-ref stack 0))) + (frame (frame-with-source + (if (> depth 1) + (stack-ref stack 1) ;skip the 'throw' frame + last)))) + + (report-load-error file args frame) + + (case on-error + ((debug) + (newline) + (display (_ "entering debugger; type ',bt' for a backtrace\n")) + (start-repl #:debug (make-debug (stack->vector stack) 0 + (error-string frame args) + #f))) + ((backtrace) + (newline (current-error-port)) + (display-backtrace stack (current-error-port))) + (else + #t)))))) + +(define* (report-load-error file args #:optional frame) + "Report the failure to load FILE, a user-provided Scheme file. ARGS is the list of arguments received by the 'throw' handler." (match args (('system-error . _) (let ((err (system-error-errno args))) - (leave (_ "failed to load '~a': ~a~%") file (strerror err)))) + (report-error (_ "failed to load '~a': ~a~%") file (strerror err)))) (('syntax-error proc message properties form . rest) (let ((loc (source-properties->location properties))) (format (current-error-port) (_ "~a: error: ~a~%") - (location->string loc) message) - (exit 1))) + (location->string loc) message))) + (('srfi-34 obj) + (report-error (_ "exception thrown: ~s~%") obj)) ((error args ...) (report-error (_ "failed to load '~a':~%") file) - (apply display-error #f (current-error-port) args) - (exit 1)))) + (apply display-error frame (current-error-port) args)))) (define (warn-about-load-error file args) ;FIXME: factorize with ↑ "Report the failure to load FILE, a user-provided Scheme file, without @@ -161,6 +245,9 @@ exiting. ARGS is the list of arguments received by the 'throw' handler." (let ((loc (source-properties->location properties))) (format (current-error-port) (_ "~a: warning: ~a~%") (location->string loc) message))) + (('srfi-34 obj) + (warning (_ "failed to load '~a': exception thrown: ~s~%") + file obj)) ((error args ...) (warning (_ "failed to load '~a':~%") file) (apply display-error #f (current-error-port) args)))) @@ -206,7 +293,9 @@ Report bugs to: ~a.") %guix-bug-report-address) General help using GNU software: <http://www.gnu.org/gethelp/>")) (newline)) -(define symlink +(set! symlink + ;; We 'set!' the global binding because (gnu build ...) modules and similar + ;; typically don't use (guix ui). (let ((real-symlink (@ (guile) symlink))) (lambda (target link) "This is a 'symlink' replacement that provides proper error reporting." @@ -218,8 +307,25 @@ General help using GNU software: <http://www.gnu.org/gethelp/>")) ;; information is missing as of Guile 2.0.11, making the exception ;; uninformative.) (apply throw key proc "~A: ~S" - (append args (list link)) - errno)))))) + (list (strerror (car errno)) link) + (list errno))))))) + +(set! copy-file + ;; Note: here we use 'set!', not #:replace, because UIs typically use + ;; 'copy-recursively', which doesn't use (guix ui). + (let ((real-copy-file (@ (guile) copy-file))) + (lambda (source target) + "This is a 'copy-file' replacement that provides proper error reporting." + (catch 'system-error + (lambda () + (real-copy-file source target)) + (lambda (key proc fmt args errno) + ;; Augment the FMT and ARGS with information about TARGET (this + ;; information is missing as of Guile 2.0.11, making the exception + ;; uninformative.) + (apply throw key proc "~A: ~S" + (list (strerror (car errno)) target) + (list errno))))))) (define (string->number* str) "Like `string->number', but error out with an error message on failure." @@ -346,8 +452,16 @@ interpreted." (lambda () (eval exp (force %guix-user-module))) (lambda args - (leave (_ "failed to evaluate expression `~a': ~s~%") - exp args))))) + (report-error (_ "failed to evaluate expression '~a':~%") exp) + (match args + (('syntax-error proc message properties form . rest) + (report-error (_ "syntax error: ~a~%") message)) + (('srfi-34 obj) + (report-error (_ "exception thrown: ~s~%") obj)) + ((error args ...) + (apply display-error #f (current-error-port) args)) + (what? #f)) + (exit 1))))) (define (read/eval-package-expression str) "Read and evaluate STR and return the package it refers to, or exit an @@ -429,6 +543,9 @@ available for download." (null? download) download))) (pair? build))) +(define show-what-to-build* + (store-lift show-what-to-build)) + (define (right-arrow port) "Return either a string containing the 'RIGHT ARROW' character, or an ASCII replacement if PORT is not Unicode-capable." @@ -852,11 +969,8 @@ parameter of 'args-fold'." (define dot-scm? (cut string-suffix? ".scm" <>)) - ;; In Guile 2.0.5 `scandir' would return "." and ".." regardless even though - ;; they don't match `dot-scm?'. Work around it by doing additional - ;; filtering. (if directory - (filter dot-scm? (scandir directory dot-scm?)) + (scandir directory dot-scm?) '())) (define (commands) diff --git a/guix/utils.scm b/guix/utils.scm index 3d38ba1223..a2ade2bf97 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -72,7 +72,6 @@ version-major+minor guile-version>? package-name->name+version - string-tokenize* string-replace-substring arguments-from-environment-variable file-extension @@ -606,33 +605,6 @@ introduce the version part." (substring file 0 dot) file))) -(define (string-tokenize* string separator) - "Return the list of substrings of STRING separated by SEPARATOR. This is -like `string-tokenize', but SEPARATOR is a string." - (define (index string what) - (let loop ((string string) - (offset 0)) - (cond ((string-null? string) - #f) - ((string-prefix? what string) - offset) - (else - (loop (string-drop string 1) (+ 1 offset)))))) - - (define len - (string-length separator)) - - (let loop ((string string) - (result '())) - (cond ((index string separator) - => - (lambda (offset) - (loop (string-drop string (+ offset len)) - (cons (substring string 0 offset) - result)))) - (else - (reverse (cons string result)))))) - (define* (string-replace-substring str substr replacement #:optional (start 0) diff --git a/m4/guix.m4 b/m4/guix.m4 index 445ce857dd..fa5a4023ba 100644 --- a/m4/guix.m4 +++ b/m4/guix.m4 @@ -218,3 +218,42 @@ AC_DEFUN([GUIX_CHECK_FILE_NAME_LIMITS], [ AC_MSG_ERROR([store directory '$storedir' would lead to overly long hash-bang lines]) fi ]) + +dnl GUIX_CHECK_CXX11 +dnl +dnl Check whether the C++ compiler can compile a typical C++11 program. +AC_DEFUN([GUIX_CHECK_CXX11], [ + AC_REQUIRE([AC_PROG_CXX]) + AC_CACHE_CHECK([whether $CXX supports C++11], + [ac_cv_guix_cxx11_support], + [save_CXXFLAGS="$CXXFLAGS" + CXXFLAGS="-std=c++11 $CXXFLAGS" + AC_COMPILE_IFELSE([ + AC_LANG_SOURCE([ + #include <functional> + + std::function<int(int)> + return_plus_lambda (int x) + { + auto result = [[&]](int y) { + return x + y; + }; + + return result; + } + ])], + [ac_cv_guix_cxx11_support=yes], + [ac_cv_guix_cxx11_support=no]) + CXXFLAGS="$save_CXXFLAGS" + ]) +]) + +dnl GUIX_ASSERT_CXX11 +dnl +dnl Error out if the C++ compiler cannot compile C++11 code. +AC_DEFUN([GUIX_ASSERT_CXX11], [ + GUIX_CHECK_CXX11 + if test "x$ac_cv_guix_cxx11_support" != "xyes"; then + AC_MSG_ERROR([C++ compiler '$CXX' does not support the C++11 standard]) + fi +]) diff --git a/nix/guix-register/guix-register.cc b/nix/guix-register/guix-register.cc index f5c610fde0..16dae62b3d 100644 --- a/nix/guix-register/guix-register.cc +++ b/nix/guix-register/guix-register.cc @@ -1,5 +1,5 @@ /* GNU Guix --- Functional package management for GNU - Copyright (C) 2013, 2014 Ludovic Courtès <ludo@gnu.org> + Copyright (C) 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013 Eelco Dolstra <eelco.dolstra@logicblox.com> @@ -192,13 +192,21 @@ register_validity (LocalStore *store, std::istream &input, store's '.links' directory, which means 'optimisePath' would try to link to that instead of linking to the target store. Thus, disable deduplication in this case. */ - if (optimize && prefix.empty ()) + if (optimize) { /* Make sure deduplication is enabled. */ settings.autoOptimiseStore = true; - foreach (ValidPathInfos::const_iterator, i, infos) - store->optimisePath (i->path); + std::string store_dir = settings.nixStore; + + /* 'optimisePath' creates temporary links under 'settings.nixStore' and + this must be the real target store, under PREFIX, to avoid + cross-device links. Thus, temporarily switch the value of + 'settings.nixStore'. */ + settings.nixStore = prefix + store_dir; + for (auto&& i: infos) + store->optimisePath (prefix + i.path); + settings.nixStore = store_dir; } } diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc index f38cd29940..85a818ba94 100644 --- a/nix/libstore/build.cc +++ b/nix/libstore/build.cc @@ -38,6 +38,9 @@ #if HAVE_SYS_MOUNT_H #include <sys/mount.h> #endif +#if HAVE_SYS_SYSCALL_H +#include <sys/syscall.h> +#endif #if HAVE_SCHED_H #include <sched.h> #endif @@ -48,7 +51,7 @@ #include <linux/fs.h> #endif -#define CHROOT_ENABLED HAVE_CHROOT && HAVE_UNSHARE && HAVE_SYS_MOUNT_H && defined(MS_BIND) && defined(MS_PRIVATE) && defined(CLONE_NEWNS) +#define CHROOT_ENABLED HAVE_CHROOT && HAVE_UNSHARE && HAVE_SYS_MOUNT_H && defined(MS_BIND) && defined(MS_PRIVATE) && defined(CLONE_NEWNS) && defined(SYS_pivot_root) #if CHROOT_ENABLED #include <sys/socket.h> @@ -57,9 +60,8 @@ #include <netinet/ip.h> #endif -#if HAVE_SYS_PERSONALITY_H +#if __linux__ #include <sys/personality.h> -#define CAN_DO_LINUX32_BUILDS #endif #if HAVE_STATVFS @@ -85,8 +87,12 @@ class Goal; typedef std::shared_ptr<Goal> GoalPtr; typedef std::weak_ptr<Goal> WeakGoalPtr; +struct CompareGoalPtrs { + bool operator() (const GoalPtr & a, const GoalPtr & b); +}; + /* Set of goals. */ -typedef set<GoalPtr> Goals; +typedef set<GoalPtr, CompareGoalPtrs> Goals; typedef list<WeakGoalPtr> WeakGoals; /* A map of paths to goals (and the other way around). */ @@ -173,11 +179,20 @@ public: (important!), etc. */ virtual void cancel(bool timeout) = 0; + virtual string key() = 0; + protected: void amDone(ExitCode result); }; +bool CompareGoalPtrs::operator() (const GoalPtr & a, const GoalPtr & b) { + string s1 = a->key(); + string s2 = b->key(); + return s1 < s2; +} + + /* A mapping used to remember for each child process to what goal it belongs, and file descriptors for receiving log data and output path creation commands. */ @@ -238,6 +253,9 @@ public: failure). */ bool permanentFailure; + /* Set if at least one derivation had a timeout. */ + bool timedOut; + LocalStore & store; std::shared_ptr<HookInstance> hook; @@ -301,6 +319,7 @@ public: void addToWeakGoals(WeakGoals & goals, GoalPtr p) { // FIXME: necessary? + // FIXME: O(n) foreach (WeakGoals::iterator, i, goals) if (i->lock() == p) return; goals.push_back(p); @@ -374,8 +393,6 @@ void Goal::trace(const format & f) /* Common initialisation performed in child processes. */ static void commonChildInit(Pipe & logPipe) { - restoreAffinity(); - /* Put the child in a separate session (and thus a separate process group) so that it has no controlling terminal (meaning that e.g. ssh cannot open /dev/tty) and it doesn't receive @@ -400,19 +417,6 @@ static void commonChildInit(Pipe & logPipe) close(fdDevNull); } - -/* Convert a string list to an array of char pointers. Careful: the - string list should outlive the array. */ -const char * * strings2CharPtrs(const Strings & ss) -{ - const char * * arr = new const char * [ss.size() + 1]; - const char * * p = arr; - foreach (Strings::const_iterator, i, ss) *p++ = i->c_str(); - *p = 0; - return arr; -} - - /* Restore default handling of SIGPIPE, otherwise some programs will randomly say "Broken pipe". */ static void restoreSIGPIPE() @@ -590,7 +594,9 @@ HookInstance::HookInstance() { debug("starting build hook"); - Path buildHook = absPath(getEnv("NIX_BUILD_HOOK")); + Path buildHook = getEnv("NIX_BUILD_HOOK"); + if (string(buildHook, 0, 1) != "/") buildHook = settings.nixLibexecDir + "/nix/" + buildHook; + buildHook = canonPath(buildHook); /* Create a pipe to get the output of the child. */ fromHook.create(); @@ -602,44 +608,30 @@ HookInstance::HookInstance() builderOut.create(); /* Fork the hook. */ - pid = maybeVfork(); - switch (pid) { - - case -1: - throw SysError("unable to fork"); + pid = startProcess([&]() { - case 0: - try { /* child */ + commonChildInit(fromHook); - commonChildInit(fromHook); + if (chdir("/") == -1) throw SysError("changing into `/"); - if (chdir("/") == -1) throw SysError("changing into `/"); + /* Dup the communication pipes. */ + if (dup2(toHook.readSide, STDIN_FILENO) == -1) + throw SysError("dupping to-hook read side"); - /* Dup the communication pipes. */ - if (dup2(toHook.readSide, STDIN_FILENO) == -1) - throw SysError("dupping to-hook read side"); + /* Use fd 4 for the builder's stdout/stderr. */ + if (dup2(builderOut.writeSide, 4) == -1) + throw SysError("dupping builder's stdout/stderr"); - /* Use fd 4 for the builder's stdout/stderr. */ - if (dup2(builderOut.writeSide, 4) == -1) - throw SysError("dupping builder's stdout/stderr"); + execl(buildHook.c_str(), buildHook.c_str(), settings.thisSystem.c_str(), + (format("%1%") % settings.maxSilentTime).str().c_str(), + (format("%1%") % settings.printBuildTrace).str().c_str(), + (format("%1%") % settings.buildTimeout).str().c_str(), + NULL); - execl(buildHook.c_str(), buildHook.c_str(), settings.thisSystem.c_str(), - (format("%1%") % settings.maxSilentTime).str().c_str(), - (format("%1%") % settings.printBuildTrace).str().c_str(), - (format("%1%") % settings.buildTimeout).str().c_str(), - NULL); + throw SysError(format("executing `%1%'") % buildHook); + }); - throw SysError(format("executing `%1%'") % buildHook); - - } catch (std::exception & e) { - writeToStderr("build hook error: " + string(e.what()) + "\n"); - } - _exit(1); - } - - /* parent */ pid.setSeparatePG(true); - pid.setKillSignal(SIGTERM); fromHook.writeSide.close(); toHook.readSide.close(); } @@ -648,7 +640,8 @@ HookInstance::HookInstance() HookInstance::~HookInstance() { try { - pid.kill(); + toHook.writeSide.close(); + pid.kill(true); } catch (...) { ignoreException(); } @@ -761,7 +754,7 @@ private: typedef void (DerivationGoal::*GoalState)(); GoalState state; - /* Stuff we need to pass to initChild(). */ + /* Stuff we need to pass to runChild(). */ typedef map<Path, Path> DirsInChroot; // maps target path to source path DirsInChroot dirsInChroot; typedef map<string, string> Environment; @@ -784,17 +777,21 @@ private: outputs to allow hard links between outputs. */ InodesSeen inodesSeen; - /* Magic exit code denoting that setting up the child environment - failed. (It's possible that the child actually returns the - exit code, but ah well.) */ - const static int childSetupFailed = 189; - public: DerivationGoal(const Path & drvPath, const StringSet & wantedOutputs, Worker & worker, BuildMode buildMode = bmNormal); ~DerivationGoal(); void cancel(bool timeout); + string key() + { + /* Ensure that derivations get built in order of their name, + i.e. a derivation named "aardvark" always comes before + "baboon". And substitution goals always happen before + derivation goals (due to "b$"). */ + return "b$" + storePathToName(drvPath) + "$" + drvPath; + } + void work(); Path getDrvPath() @@ -821,8 +818,8 @@ private: /* Start building a derivation. */ void startBuilder(); - /* Initialise the builder's process. */ - void initChild(); + /* Run the builder's process. */ + void runChild(); friend int childEntry(void *); @@ -879,13 +876,9 @@ DerivationGoal::~DerivationGoal() { /* Careful: we should never ever throw an exception from a destructor. */ - try { - killChild(); - deleteTmpDir(false); - closeLogFile(); - } catch (...) { - ignoreException(); - } + try { killChild(); } catch (...) { ignoreException(); } + try { deleteTmpDir(false); } catch (...) { ignoreException(); } + try { closeLogFile(); } catch (...) { ignoreException(); } } @@ -956,6 +949,11 @@ void DerivationGoal::init() /* The first thing to do is to make sure that the derivation exists. If it doesn't, it may be created through a substitute. */ + if (buildMode == bmNormal && worker.store.isValidPath(drvPath)) { + haveDerivation(); + return; + } + addWaitee(worker.makeSubstitutionGoal(drvPath)); state = &DerivationGoal::haveDerivation; @@ -1209,7 +1207,7 @@ static string get(const StringPairs & map, const string & key) static bool canBuildLocally(const string & platform) { return platform == settings.thisSystem -#ifdef CAN_DO_LINUX32_BUILDS +#if __linux__ || (platform == "i686-linux" && settings.thisSystem == "x86_64-linux") #endif ; @@ -1433,9 +1431,6 @@ void DerivationGoal::buildDone() if (pathExists(chrootRootDir + *i)) rename((chrootRootDir + *i).c_str(), i->c_str()); - if (WIFEXITED(status) && WEXITSTATUS(status) == childSetupFailed) - throw Error(format("failed to set up the build environment for `%1%'") % drvPath); - if (diskFull) printMsg(lvlError, "note: build failure may have been caused by lack of free disk space"); @@ -1469,37 +1464,41 @@ void DerivationGoal::buildDone() outputLocks.unlock(); } catch (BuildError & e) { - printMsg(lvlError, e.msg()); + if (!hook) + printMsg(lvlError, e.msg()); outputLocks.unlock(); buildUser.release(); - /* When using a build hook, the hook will return a remote - build failure using exit code 100. Anything else is a hook - problem. */ - bool hookError = hook && - (!WIFEXITED(status) || WEXITSTATUS(status) != 100); + if (hook && WIFEXITED(status) && WEXITSTATUS(status) == 101) { + if (settings.printBuildTrace) + printMsg(lvlError, format("@ build-failed %1% - timeout") % drvPath); + worker.timedOut = true; + } - if (settings.printBuildTrace) { - if (hook && hookError) + else if (hook && (!WIFEXITED(status) || WEXITSTATUS(status) != 100)) { + if (settings.printBuildTrace) printMsg(lvlError, format("@ hook-failed %1% - %2% %3%") % drvPath % status % e.msg()); - else + } + + else { + if (settings.printBuildTrace) printMsg(lvlError, format("@ build-failed %1% - %2% %3%") % drvPath % 1 % e.msg()); + worker.permanentFailure = !fixedOutput && !diskFull; + + /* Register the outputs of this build as "failed" so we + won't try to build them again (negative caching). + However, don't do this for fixed-output derivations, + since they're likely to fail for transient reasons + (e.g., fetchurl not being able to access the network). + Hook errors (like communication problems with the + remote machine) shouldn't be cached either. */ + if (settings.cacheFailure && !fixedOutput && !diskFull) + foreach (DerivationOutputs::iterator, i, drv.outputs) + worker.store.registerFailedPath(i->second.path); } - /* Register the outputs of this build as "failed" so we won't - try to build them again (negative caching). However, don't - do this for fixed-output derivations, since they're likely - to fail for transient reasons (e.g., fetchurl not being - able to access the network). Hook errors (like - communication problems with the remote machine) shouldn't - be cached either. */ - if (settings.cacheFailure && !hookError && !fixedOutput) - foreach (DerivationOutputs::iterator, i, drv.outputs) - worker.store.registerFailedPath(i->second.path); - - worker.permanentFailure = !hookError && !fixedOutput && !diskFull; amDone(ecFailed); return; } @@ -1603,7 +1602,7 @@ void chmod_(const Path & path, mode_t mode) int childEntry(void * arg) { - ((DerivationGoal *) arg)->initChild(); + ((DerivationGoal *) arg)->runChild(); return 1; } @@ -1750,37 +1749,11 @@ void DerivationGoal::startBuilder() /* Change ownership of the temporary build directory. */ if (chown(tmpDir.c_str(), buildUser.getUID(), buildUser.getGID()) == -1) - throw SysError(format("cannot change ownership of `%1%'") % tmpDir); + throw SysError(format("cannot change ownership of '%1%'") % tmpDir); + } - /* Check that the Nix store has the appropriate permissions, - i.e., owned by root and mode 1775 (sticky bit on so that - the builder can create its output but not mess with the - outputs of other processes). */ - struct stat st; - if (stat(settings.nixStore.c_str(), &st) == -1) - throw SysError(format("cannot stat `%1%'") % settings.nixStore); - if (!(st.st_mode & S_ISVTX) || - ((st.st_mode & S_IRWXG) != S_IRWXG) || - (st.st_gid != buildUser.getGID())) - throw Error(format( - "builder does not have write permission to `%2%'; " - "try `chgrp %1% %2%; chmod 1775 %2%'") - % buildUser.getGID() % settings.nixStore); - } - - - /* Are we doing a chroot build? Note that fixed-output - derivations are never done in a chroot, mainly so that - functions like fetchurl (which needs a proper /etc/resolv.conf) - work properly. Purity checking for fixed-output derivations - is somewhat pointless anyway. */ useChroot = settings.useChroot; - if (fixedOutput) useChroot = false; - - /* Hack to allow derivations to disable chroot builds. */ - if (get(drv.env, "__noChroot") == "1") useChroot = false; - if (useChroot) { #if CHROOT_ENABLED /* Create a temporary directory in which we set up the chroot @@ -1795,6 +1768,12 @@ void DerivationGoal::startBuilder() printMsg(lvlChatty, format("setting up chroot environment in `%1%'") % chrootRootDir); + if (mkdir(chrootRootDir.c_str(), 0750) == -1) + throw SysError(format("cannot create ‘%1%’") % chrootRootDir); + + if (chown(chrootRootDir.c_str(), 0, buildUser.getGID()) == -1) + throw SysError(format("cannot change ownership of ‘%1%’") % chrootRootDir); + /* Create a writable /tmp in the chroot. Many builders need this. (Of course they should really respect $TMPDIR instead.) */ @@ -1821,16 +1800,20 @@ void DerivationGoal::startBuilder() % (buildUser.enabled() ? buildUser.getGID() : getgid())).str()); /* Create /etc/hosts with localhost entry. */ - writeFile(chrootRootDir + "/etc/hosts", "127.0.0.1 localhost\n"); + if (!fixedOutput) + writeFile(chrootRootDir + "/etc/hosts", "127.0.0.1 localhost\n"); /* Bind-mount a user-configurable set of directories from the host file system. */ - foreach (StringSet::iterator, i, settings.dirsInChroot) { - size_t p = i->find('='); + PathSet dirs = tokenizeString<StringSet>(settings.get("build-chroot-dirs", string(DEFAULT_CHROOT_DIRS))); + PathSet dirs2 = tokenizeString<StringSet>(settings.get("build-extra-chroot-dirs", string(""))); + dirs.insert(dirs2.begin(), dirs2.end()); + for (auto & i : dirs) { + size_t p = i.find('='); if (p == string::npos) - dirsInChroot[*i] = *i; + dirsInChroot[i] = i; else - dirsInChroot[string(*i, 0, p)] = string(*i, p + 1); + dirsInChroot[string(i, 0, p)] = string(i, p + 1); } dirsInChroot[tmpDir] = tmpDir; @@ -1841,8 +1824,12 @@ void DerivationGoal::startBuilder() can be bind-mounted). !!! As an extra security precaution, make the fake Nix store only writable by the build user. */ - createDirs(chrootRootDir + settings.nixStore); - chmod_(chrootRootDir + settings.nixStore, 01777); + Path chrootStoreDir = chrootRootDir + settings.nixStore; + createDirs(chrootStoreDir); + chmod_(chrootStoreDir, 01775); + + if (chown(chrootStoreDir.c_str(), 0, buildUser.getGID()) == -1) + throw SysError(format("cannot change ownership of ‘%1%’") % chrootStoreDir); foreach (PathSet::iterator, i, inputPaths) { struct stat st; @@ -1951,14 +1938,17 @@ void DerivationGoal::startBuilder() */ #if CHROOT_ENABLED if (useChroot) { - char stack[32 * 1024]; - pid = clone(childEntry, stack + sizeof(stack) - 8, - CLONE_NEWPID | CLONE_NEWNS | CLONE_NEWNET | CLONE_NEWIPC | CLONE_NEWUTS | SIGCHLD, this); + char stack[32 * 1024]; + int flags = CLONE_NEWPID | CLONE_NEWNS | CLONE_NEWIPC | CLONE_NEWUTS | SIGCHLD; + if (!fixedOutput) flags |= CLONE_NEWNET; + pid = clone(childEntry, stack + sizeof(stack) - 8, flags, this); + if (pid == -1) + throw SysError("cloning builder process"); } else #endif { pid = fork(); - if (pid == 0) initChild(); + if (pid == 0) runChild(); } if (pid == -1) throw SysError("unable to fork"); @@ -1969,22 +1959,31 @@ void DerivationGoal::startBuilder() worker.childStarted(shared_from_this(), pid, singleton<set<int> >(builderOut.readSide), true, true); + /* Check if setting up the build environment failed. */ + string msg = readLine(builderOut.readSide); + if (!msg.empty()) throw Error(msg); + if (settings.printBuildTrace) { printMsg(lvlError, format("@ build-started %1% - %2% %3%") % drvPath % drv.platform % logFile); } + } -void DerivationGoal::initChild() +void DerivationGoal::runChild() { /* Warning: in the child we should absolutely not make any SQLite calls! */ - bool inSetup = true; - try { /* child */ + _writeToStderr = 0; + + restoreAffinity(); + + commonChildInit(builderOut); + #if CHROOT_ENABLED if (useChroot) { /* Initialise the loopback interface. */ @@ -2001,9 +2000,11 @@ void DerivationGoal::initChild() /* Set the hostname etc. to fixed values. */ char hostname[] = "localhost"; - sethostname(hostname, sizeof(hostname)); + if (sethostname(hostname, sizeof(hostname)) == -1) + throw SysError("cannot set host name"); char domainname[] = "(none)"; // kernel default - setdomainname(domainname, sizeof(domainname)); + if (setdomainname(domainname, sizeof(domainname)) == -1) + throw SysError("cannot set domain name"); /* Make all filesystems private. This is necessary because subtrees may have been mounted as "shared" @@ -2021,12 +2022,17 @@ void DerivationGoal::initChild() throw SysError(format("unable to make filesystem `%1%' private") % fs); } + /* Bind-mount chroot directory to itself, to treat it as a + different filesystem from /, as needed for pivot_root. */ + if (mount(chrootRootDir.c_str(), chrootRootDir.c_str(), 0, MS_BIND, 0) == -1) + throw SysError(format("unable to bind mount ‘%1%’") % chrootRootDir); + /* Set up a nearly empty /dev, unless the user asked to bind-mount the host /dev. */ + Strings ss; if (dirsInChroot.find("/dev") == dirsInChroot.end()) { createDirs(chrootRootDir + "/dev/shm"); createDirs(chrootRootDir + "/dev/pts"); - Strings ss; ss.push_back("/dev/full"); #ifdef __linux__ if (pathExists("/dev/kvm")) @@ -2037,13 +2043,24 @@ void DerivationGoal::initChild() ss.push_back("/dev/tty"); ss.push_back("/dev/urandom"); ss.push_back("/dev/zero"); - foreach (Strings::iterator, i, ss) dirsInChroot[*i] = *i; createSymlink("/proc/self/fd", chrootRootDir + "/dev/fd"); createSymlink("/proc/self/fd/0", chrootRootDir + "/dev/stdin"); createSymlink("/proc/self/fd/1", chrootRootDir + "/dev/stdout"); createSymlink("/proc/self/fd/2", chrootRootDir + "/dev/stderr"); } + /* Fixed-output derivations typically need to access the + network, so give them access to /etc/resolv.conf and so + on. */ + if (fixedOutput) { + ss.push_back("/etc/resolv.conf"); + ss.push_back("/etc/nsswitch.conf"); + ss.push_back("/etc/services"); + ss.push_back("/etc/hosts"); + } + + for (auto & i : ss) dirsInChroot[i] = i; + /* Bind-mount all the directories from the "host" filesystem that we want in the chroot environment. */ @@ -2088,30 +2105,41 @@ void DerivationGoal::initChild() throw SysError("mounting /dev/pts"); createSymlink("/dev/pts/ptmx", chrootRootDir + "/dev/ptmx"); - /* Make sure /dev/pts/ptmx is world-writable. With some - Linux versions, it is created with permissions 0. */ - chmod_(chrootRootDir + "/dev/pts/ptmx", 0666); + /* Make sure /dev/pts/ptmx is world-writable. With some + Linux versions, it is created with permissions 0. */ + chmod_(chrootRootDir + "/dev/pts/ptmx", 0666); } - /* Do the chroot(). Below we do a chdir() to the - temporary build directory to make sure the current - directory is in the chroot. (Actually the order - doesn't matter, since due to the bind mount tmpDir and - tmpRootDit/tmpDir are the same directories.) */ - if (chroot(chrootRootDir.c_str()) == -1) - throw SysError(format("cannot change root directory to `%1%'") % chrootRootDir); + /* Do the chroot(). */ + if (chdir(chrootRootDir.c_str()) == -1) + throw SysError(format("cannot change directory to '%1%'") % chrootRootDir); + + if (mkdir("real-root", 0) == -1) + throw SysError("cannot create real-root directory"); + +#define pivot_root(new_root, put_old) (syscall(SYS_pivot_root, new_root, put_old)) + if (pivot_root(".", "real-root") == -1) + throw SysError(format("cannot pivot old root directory onto '%1%'") % (chrootRootDir + "/real-root")); +#undef pivot_root + + if (chroot(".") == -1) + throw SysError(format("cannot change root directory to '%1%'") % chrootRootDir); + + if (umount2("real-root", MNT_DETACH) == -1) + throw SysError("cannot unmount real root filesystem"); + + if (rmdir("real-root") == -1) + throw SysError("cannot remove real-root directory"); } #endif - commonChildInit(builderOut); - if (chdir(tmpDir.c_str()) == -1) throw SysError(format("changing into `%1%'") % tmpDir); /* Close all other file descriptors. */ closeMostFDs(set<int>()); -#ifdef CAN_DO_LINUX32_BUILDS +#if __linux__ /* Change the personality to 32-bit if we're doing an i686-linux build on an x86_64-linux machine. */ struct utsname utsbuf; @@ -2119,7 +2147,7 @@ void DerivationGoal::initChild() if (drv.platform == "i686-linux" && (settings.thisSystem == "x86_64-linux" || (!strcmp(utsbuf.sysname, "Linux") && !strcmp(utsbuf.machine, "x86_64")))) { - if (personality(0x0008 | 0x8000000 /* == PER_LINUX32_3GB */) == -1) + if (personality(PER_LINUX32) == -1) throw SysError("cannot set i686-linux personality"); } @@ -2129,17 +2157,18 @@ void DerivationGoal::initChild() int cur = personality(0xffffffff); if (cur != -1) personality(cur | 0x0020000 /* == UNAME26 */); } + + /* Disable address space randomization for improved + determinism. */ + int cur = personality(0xffffffff); + if (cur != -1) personality(cur | ADDR_NO_RANDOMIZE); #endif /* Fill in the environment. */ Strings envStrs; foreach (Environment::const_iterator, i, env) envStrs.push_back(rewriteHashes(i->first + "=" + i->second, rewritesToTmp)); - const char * * envArr = strings2CharPtrs(envStrs); - - Path program = drv.builder.c_str(); - std::vector<const char *> args; /* careful with c_str()! */ - string user; /* must be here for its c_str()! */ + auto envArr = stringsToCharPtrs(envStrs); /* If we are running in `build-users' mode, then switch to the user we allocated above. Make sure that we drop all root @@ -2165,23 +2194,26 @@ void DerivationGoal::initChild() } /* Fill in the arguments. */ + Strings args; string builderBasename = baseNameOf(drv.builder); - args.push_back(builderBasename.c_str()); + args.push_back(builderBasename); foreach (Strings::iterator, i, drv.args) - args.push_back(rewriteHashes(*i, rewritesToTmp).c_str()); - args.push_back(0); + args.push_back(rewriteHashes(*i, rewritesToTmp)); + auto argArr = stringsToCharPtrs(args); restoreSIGPIPE(); + /* Indicate that we managed to set up the build environment. */ + writeFull(STDERR_FILENO, "\n"); + /* Execute the program. This should not return. */ - inSetup = false; - execve(program.c_str(), (char * *) &args[0], (char * *) envArr); + execve(drv.builder.c_str(), (char * *) &argArr[0], (char * *) &envArr[0]); throw SysError(format("executing `%1%'") % drv.builder); } catch (std::exception & e) { - writeToStderr("build error: " + string(e.what()) + "\n"); - _exit(inSetup ? childSetupFailed : 1); + writeFull(STDERR_FILENO, "while setting up the build environment: " + string(e.what()) + "\n"); + _exit(1); } abort(); /* never reached */ @@ -2333,7 +2365,7 @@ void DerivationGoal::registerOutputs() if (buildMode == bmCheck) { ValidPathInfo info = worker.store.queryPathInfo(path); if (hash.first != info.hash) - throw Error(format("derivation `%2%' may not be deterministic: hash mismatch in output `%1%'") % drvPath % path); + throw Error(format("derivation `%1%' may not be deterministic: hash mismatch in output `%2%'") % drvPath % path); continue; } @@ -2347,16 +2379,36 @@ void DerivationGoal::registerOutputs() debug(format("referenced input: `%1%'") % *i); } - /* If the derivation specifies an `allowedReferences' - attribute (containing a list of paths that the output may - refer to), check that all references are in that list. !!! - allowedReferences should really be per-output. */ - if (drv.env.find("allowedReferences") != drv.env.end()) { - PathSet allowed = parseReferenceSpecifiers(drv, get(drv.env, "allowedReferences")); - foreach (PathSet::iterator, i, references) - if (allowed.find(*i) == allowed.end()) - throw BuildError(format("output is not allowed to refer to path `%1%'") % *i); - } + /* Enforce `allowedReferences' and friends. */ + auto checkRefs = [&](const string & attrName, bool allowed, bool recursive) { + if (drv.env.find(attrName) == drv.env.end()) return; + + PathSet spec = parseReferenceSpecifiers(drv, get(drv.env, attrName)); + + PathSet used; + if (recursive) { + /* Our requisites are the union of the closures of our references. */ + for (auto & i : references) + /* Don't call computeFSClosure on ourselves. */ + if (actualPath != i) + computeFSClosure(worker.store, i, used); + } else + used = references; + + for (auto & i : used) + if (allowed) { + if (spec.find(i) == spec.end()) + throw BuildError(format("output (`%1%') is not allowed to refer to path `%2%'") % actualPath % i); + } else { + if (spec.find(i) != spec.end()) + throw BuildError(format("output (`%1%') is not allowed to refer to path `%2%'") % actualPath % i); + } + }; + + checkRefs("allowedReferences", true, false); + checkRefs("allowedRequisites", true, true); + checkRefs("disallowedReferences", false, false); + checkRefs("disallowedRequisites", false, true); worker.store.optimisePath(path); // FIXME: combine with scanForReferences() @@ -2475,7 +2527,7 @@ void DerivationGoal::handleChildOutput(int fd, const string & data) BZ2_bzWrite(&err, bzLogFile, (unsigned char *) data.data(), data.size()); if (err != BZ_OK) throw Error(format("cannot write to compressed log file (BZip2 error = %1%)") % err); } else if (fdLogFile != -1) - writeFull(fdLogFile, (unsigned char *) data.data(), data.size()); + writeFull(fdLogFile, data); } if (hook && fd == hook->fromHook.readSide) @@ -2586,6 +2638,13 @@ public: void cancel(bool timeout); + string key() + { + /* "a$" ensures substitution goals happen before derivation + goals. */ + return "a$" + storePathToName(storePath) + "$" + storePath; + } + void work(); /* The states. */ @@ -2778,35 +2837,21 @@ void SubstitutionGoal::tryToRun() args.push_back("--substitute"); args.push_back(storePath); args.push_back(destPath); - const char * * argArr = strings2CharPtrs(args); + auto argArr = stringsToCharPtrs(args); /* Fork the substitute program. */ - pid = maybeVfork(); - - switch (pid) { + pid = startProcess([&]() { - case -1: - throw SysError("unable to fork"); + commonChildInit(logPipe); - case 0: - try { /* child */ + if (dup2(outPipe.writeSide, STDOUT_FILENO) == -1) + throw SysError("cannot dup output pipe into stdout"); - commonChildInit(logPipe); + execv(sub.c_str(), (char * *) &argArr[0]); - if (dup2(outPipe.writeSide, STDOUT_FILENO) == -1) - throw SysError("cannot dup output pipe into stdout"); + throw SysError(format("executing `%1%'") % sub); + }); - execv(sub.c_str(), (char * *) argArr); - - throw SysError(format("executing `%1%'") % sub); - - } catch (std::exception & e) { - writeToStderr("substitute error: " + string(e.what()) + "\n"); - } - _exit(1); - } - - /* parent */ pid.setSeparatePG(true); pid.setKillSignal(SIGTERM); outPipe.writeSide.close(); @@ -2944,6 +2989,7 @@ Worker::Worker(LocalStore & store) nrLocalBuilds = 0; lastWokenUp = 0; permanentFailure = false; + timedOut = false; } @@ -3109,15 +3155,19 @@ void Worker::run(const Goals & _topGoals) checkInterrupt(); - /* Call every wake goal. */ + /* Call every wake goal (in the ordering established by + CompareGoalPtrs). */ while (!awake.empty() && !topGoals.empty()) { - WeakGoals awake2(awake); + Goals awake2; + for (auto & i : awake) { + GoalPtr goal = i.lock(); + if (goal) awake2.insert(goal); + } awake.clear(); - foreach (WeakGoals::iterator, i, awake2) { + for (auto & goal : awake2) { checkInterrupt(); - GoalPtr goal = i->lock(); - if (goal) goal->work(); - if (topGoals.empty()) break; + goal->work(); + if (topGoals.empty()) break; // stuff may have been cancelled } } @@ -3255,6 +3305,7 @@ void Worker::waitForInput() format("%1% timed out after %2% seconds of silence") % goal->getName() % settings.maxSilentTime); goal->cancel(true); + timedOut = true; } else if (goal->getExitCode() == Goal::ecBusy && @@ -3266,6 +3317,7 @@ void Worker::waitForInput() format("%1% timed out after %2% seconds") % goal->getName() % settings.buildTimeout); goal->cancel(true); + timedOut = true; } } @@ -3282,7 +3334,7 @@ void Worker::waitForInput() unsigned int Worker::exitStatus() { - return permanentFailure ? 100 : 1; + return timedOut ? 101 : (permanentFailure ? 100 : 1); } diff --git a/nix/libstore/gc.cc b/nix/libstore/gc.cc index f90edac1cd..34768324c2 100644 --- a/nix/libstore/gc.cc +++ b/nix/libstore/gc.cc @@ -96,7 +96,7 @@ Path addPermRoot(StoreAPI & store, const Path & _storePath, "(are you running nix-build inside the store?)") % gcRoot); if (indirect) { - /* Don't clobber the the link if it already exists and doesn't + /* Don't clobber the link if it already exists and doesn't point to the Nix store. */ if (pathExists(gcRoot) && (!isLink(gcRoot) || !isInStore(readLink(gcRoot)))) throw Error(format("cannot create symlink `%1%'; already exists") % gcRoot); @@ -115,7 +115,10 @@ Path addPermRoot(StoreAPI & store, const Path & _storePath, % gcRoot % rootsDir); } - makeSymlink(gcRoot, storePath); + if (baseNameOf(gcRoot) == baseNameOf(storePath)) + writeFile(gcRoot, ""); + else + makeSymlink(gcRoot, storePath); } /* Check that the root can be found by the garbage collector. @@ -142,11 +145,6 @@ Path addPermRoot(StoreAPI & store, const Path & _storePath, } -/* The file to which we write our temporary roots. */ -static Path fnTempRoots; -static AutoCloseFD fdTempRoots; - - void LocalStore::addTempRoot(const Path & path) { /* Create the temporary roots file for this process. */ @@ -193,7 +191,7 @@ void LocalStore::addTempRoot(const Path & path) lockFile(fdTempRoots, ltWrite, true); string s = path + '\0'; - writeFull(fdTempRoots, (const unsigned char *) s.data(), s.size()); + writeFull(fdTempRoots, s); /* Downgrade to a read lock. */ debug(format("downgrading to read lock on `%1%'") % fnTempRoots); @@ -201,27 +199,6 @@ void LocalStore::addTempRoot(const Path & path) } -void removeTempRoots() -{ - if (fdTempRoots != -1) { - fdTempRoots.close(); - unlink(fnTempRoots.c_str()); - } -} - - -/* Automatically clean up the temporary roots file when we exit. */ -struct RemoveTempRoots -{ - ~RemoveTempRoots() - { - removeTempRoots(); - } -}; - -static RemoveTempRoots autoRemoveTempRoots __attribute__((unused)); - - typedef std::shared_ptr<AutoCloseFD> FDPtr; typedef list<FDPtr> FDs; @@ -230,11 +207,11 @@ static void readTempRoots(PathSet & tempRoots, FDs & fds) { /* Read the `temproots' directory for per-process temporary root files. */ - Strings tempRootFiles = readDirectory( + DirEntries tempRootFiles = readDirectory( (format("%1%/%2%") % settings.nixStateDir % tempRootsDir).str()); - foreach (Strings::iterator, i, tempRootFiles) { - Path path = (format("%1%/%2%/%3%") % settings.nixStateDir % tempRootsDir % *i).str(); + for (auto & i : tempRootFiles) { + Path path = (format("%1%/%2%/%3%") % settings.nixStateDir % tempRootsDir % i.name).str(); debug(format("reading temporary root file `%1%'") % path); FDPtr fd(new AutoCloseFD(open(path.c_str(), O_RDWR, 0666))); @@ -254,7 +231,7 @@ static void readTempRoots(PathSet & tempRoots, FDs & fds) if (lockFile(*fd, ltWrite, false)) { printMsg(lvlError, format("removing stale temporary roots file `%1%'") % path); unlink(path.c_str()); - writeFull(*fd, (const unsigned char *) "d", 1); + writeFull(*fd, "d"); continue; } @@ -294,19 +271,19 @@ static void foundRoot(StoreAPI & store, } -static void findRoots(StoreAPI & store, const Path & path, Roots & roots) +static void findRoots(StoreAPI & store, const Path & path, unsigned char type, Roots & roots) { try { - struct stat st = lstat(path); + if (type == DT_UNKNOWN) + type = getFileType(path); - if (S_ISDIR(st.st_mode)) { - Strings names = readDirectory(path); - foreach (Strings::iterator, i, names) - findRoots(store, path + "/" + *i, roots); + if (type == DT_DIR) { + for (auto & i : readDirectory(path)) + findRoots(store, path + "/" + i.name, i.type, roots); } - else if (S_ISLNK(st.st_mode)) { + else if (type == DT_LNK) { Path target = readLink(path); if (isInStore(target)) foundRoot(store, path, target, roots); @@ -328,6 +305,12 @@ static void findRoots(StoreAPI & store, const Path & path, Roots & roots) } } + else if (type == DT_REG) { + Path storePath = settings.nixStore + "/" + baseNameOf(path); + if (store.isValidPath(storePath)) + roots[path] = storePath; + } + } catch (SysError & e) { @@ -345,9 +328,10 @@ Roots LocalStore::findRoots() Roots roots; /* Process direct roots in {gcroots,manifests,profiles}. */ - nix::findRoots(*this, settings.nixStateDir + "/" + gcRootsDir, roots); - nix::findRoots(*this, settings.nixStateDir + "/manifests", roots); - nix::findRoots(*this, settings.nixStateDir + "/profiles", roots); + nix::findRoots(*this, settings.nixStateDir + "/" + gcRootsDir, DT_UNKNOWN, roots); + if (pathExists(settings.nixStateDir + "/manifests")) + nix::findRoots(*this, settings.nixStateDir + "/manifests", DT_UNKNOWN, roots); + nix::findRoots(*this, settings.nixStateDir + "/profiles", DT_UNKNOWN, roots); return roots; } @@ -449,7 +433,6 @@ void LocalStore::deletePathRecursive(GCState & state, const Path & path) // if the path was not valid, need to determine the actual // size. state.bytesInvalidated += size; - // Mac OS X cannot rename directories if they are read-only. if (chmod(path.c_str(), st.st_mode | S_IWUSR) == -1) throw SysError(format("making `%1%' writable") % path); Path tmp = state.trashDir + "/" + baseNameOf(path); @@ -649,7 +632,7 @@ void LocalStore::collectGarbage(const GCOptions & options, GCResults & results) /* After this point the set of roots or temporary roots cannot increase, since we hold locks on everything. So everything - that is not reachable from `roots'. */ + that is not reachable from `roots' is garbage. */ if (state.shouldDelete) { if (pathExists(state.trashDir)) deleteGarbage(state, state.trashDir); @@ -741,7 +724,7 @@ void LocalStore::collectGarbage(const GCOptions & options, GCResults & results) } /* While we're at it, vacuum the database. */ - if (options.action == GCOptions::gcDeleteDead) vacuumDB(); + //if (options.action == GCOptions::gcDeleteDead) vacuumDB(); } diff --git a/nix/libstore/globals.cc b/nix/libstore/globals.cc index 86fa56739c..bb08a7d0b0 100644 --- a/nix/libstore/globals.cc +++ b/nix/libstore/globals.cc @@ -2,6 +2,7 @@ #include "globals.hh" #include "util.hh" +#include "archive.hh" #include <map> #include <algorithm> @@ -55,6 +56,7 @@ Settings::Settings() envKeepDerivations = false; lockCPU = getEnv("NIX_AFFINITY_HACK", "1") == "1"; showTrace = false; + enableImportNative = false; } @@ -112,35 +114,61 @@ void Settings::set(const string & name, const string & value) } +string Settings::get(const string & name, const string & def) +{ + auto i = settings.find(name); + if (i == settings.end()) return def; + return i->second; +} + + +Strings Settings::get(const string & name, const Strings & def) +{ + auto i = settings.find(name); + if (i == settings.end()) return def; + return tokenizeString<Strings>(i->second); +} + + +bool Settings::get(const string & name, bool def) +{ + bool res = def; + _get(res, name); + return res; +} + + void Settings::update() { - get(tryFallback, "build-fallback"); - get(maxBuildJobs, "build-max-jobs"); - get(buildCores, "build-cores"); - get(thisSystem, "system"); - get(maxSilentTime, "build-max-silent-time"); - get(buildTimeout, "build-timeout"); - get(reservedSize, "gc-reserved-space"); - get(fsyncMetadata, "fsync-metadata"); - get(useSQLiteWAL, "use-sqlite-wal"); - get(syncBeforeRegistering, "sync-before-registering"); - get(useSubstitutes, "build-use-substitutes"); - get(buildUsersGroup, "build-users-group"); - get(useChroot, "build-use-chroot"); - get(dirsInChroot, "build-chroot-dirs"); - get(impersonateLinux26, "build-impersonate-linux-26"); - get(keepLog, "build-keep-log"); - get(compressLog, "build-compress-log"); - get(maxLogSize, "build-max-log-size"); - get(cacheFailure, "build-cache-failure"); - get(pollInterval, "build-poll-interval"); - get(checkRootReachability, "gc-check-reachability"); - get(gcKeepOutputs, "gc-keep-outputs"); - get(gcKeepDerivations, "gc-keep-derivations"); - get(autoOptimiseStore, "auto-optimise-store"); - get(envKeepDerivations, "env-keep-derivations"); - get(sshSubstituterHosts, "ssh-substituter-hosts"); - get(useSshSubstituter, "use-ssh-substituter"); + _get(tryFallback, "build-fallback"); + _get(maxBuildJobs, "build-max-jobs"); + _get(buildCores, "build-cores"); + _get(thisSystem, "system"); + _get(maxSilentTime, "build-max-silent-time"); + _get(buildTimeout, "build-timeout"); + _get(reservedSize, "gc-reserved-space"); + _get(fsyncMetadata, "fsync-metadata"); + _get(useSQLiteWAL, "use-sqlite-wal"); + _get(syncBeforeRegistering, "sync-before-registering"); + _get(useSubstitutes, "build-use-substitutes"); + _get(buildUsersGroup, "build-users-group"); + _get(useChroot, "build-use-chroot"); + _get(impersonateLinux26, "build-impersonate-linux-26"); + _get(keepLog, "build-keep-log"); + _get(compressLog, "build-compress-log"); + _get(maxLogSize, "build-max-log-size"); + _get(cacheFailure, "build-cache-failure"); + _get(pollInterval, "build-poll-interval"); + _get(checkRootReachability, "gc-check-reachability"); + _get(gcKeepOutputs, "gc-keep-outputs"); + _get(gcKeepDerivations, "gc-keep-derivations"); + _get(autoOptimiseStore, "auto-optimise-store"); + _get(envKeepDerivations, "env-keep-derivations"); + _get(sshSubstituterHosts, "ssh-substituter-hosts"); + _get(useSshSubstituter, "use-ssh-substituter"); + _get(logServers, "log-servers"); + _get(enableImportNative, "allow-unsafe-native-code-during-evaluation"); + _get(useCaseHack, "use-case-hack"); string subs = getEnv("NIX_SUBSTITUTERS", "default"); if (subs == "default") { @@ -158,7 +186,7 @@ void Settings::update() } -void Settings::get(string & res, const string & name) +void Settings::_get(string & res, const string & name) { SettingsMap::iterator i = settings.find(name); if (i == settings.end()) return; @@ -166,7 +194,7 @@ void Settings::get(string & res, const string & name) } -void Settings::get(bool & res, const string & name) +void Settings::_get(bool & res, const string & name) { SettingsMap::iterator i = settings.find(name); if (i == settings.end()) return; @@ -177,7 +205,7 @@ void Settings::get(bool & res, const string & name) } -void Settings::get(StringSet & res, const string & name) +void Settings::_get(StringSet & res, const string & name) { SettingsMap::iterator i = settings.find(name); if (i == settings.end()) return; @@ -186,7 +214,7 @@ void Settings::get(StringSet & res, const string & name) res.insert(ss.begin(), ss.end()); } -void Settings::get(Strings & res, const string & name) +void Settings::_get(Strings & res, const string & name) { SettingsMap::iterator i = settings.find(name); if (i == settings.end()) return; @@ -194,7 +222,7 @@ void Settings::get(Strings & res, const string & name) } -template<class N> void Settings::get(N & res, const string & name) +template<class N> void Settings::_get(N & res, const string & name) { SettingsMap::iterator i = settings.find(name); if (i == settings.end()) return; diff --git a/nix/libstore/globals.hh b/nix/libstore/globals.hh index 711c365294..c17e10d7c3 100644 --- a/nix/libstore/globals.hh +++ b/nix/libstore/globals.hh @@ -21,6 +21,12 @@ struct Settings { void set(const string & name, const string & value); + string get(const string & name, const string & def); + + Strings get(const string & name, const Strings & def); + + bool get(const string & name, bool def); + void update(); string pack(); @@ -142,10 +148,6 @@ struct Settings { /* Whether to build in chroot. */ bool useChroot; - /* The directories from the host filesystem to be included in the - chroot. */ - StringSet dirsInChroot; - /* Set of ssh connection strings for the ssh substituter */ Strings sshSubstituterHosts; @@ -197,14 +199,20 @@ struct Settings { /* Whether to show a stack trace if Nix evaluation fails. */ bool showTrace; + /* A list of URL prefixes that can return Nix build logs. */ + Strings logServers; + + /* Whether the importNative primop should be enabled */ + bool enableImportNative; + private: SettingsMap settings, overrides; - void get(string & res, const string & name); - void get(bool & res, const string & name); - void get(StringSet & res, const string & name); - void get(Strings & res, const string & name); - template<class N> void get(N & res, const string & name); + void _get(string & res, const string & name); + void _get(bool & res, const string & name); + void _get(StringSet & res, const string & name); + void _get(Strings & res, const string & name); + template<class N> void _get(N & res, const string & name); }; diff --git a/nix/libstore/local-store.cc b/nix/libstore/local-store.cc index 2c3d65215c..630cb80c41 100644 --- a/nix/libstore/local-store.cc +++ b/nix/libstore/local-store.cc @@ -254,22 +254,25 @@ LocalStore::LocalStore(bool reserveSpace) Path perUserDir = profilesDir + "/per-user"; createDirs(perUserDir); if (chmod(perUserDir.c_str(), 01777) == -1) - throw SysError(format("could not set permissions on `%1%' to 1777") % perUserDir); + throw SysError(format("could not set permissions on '%1%' to 1777") % perUserDir); + + mode_t perm = 01775; struct group * gr = getgrnam(settings.buildUsersGroup.c_str()); if (!gr) throw Error(format("the group `%1%' specified in `build-users-group' does not exist") % settings.buildUsersGroup); - - struct stat st; - if (stat(settings.nixStore.c_str(), &st)) - throw SysError(format("getting attributes of path `%1%'") % settings.nixStore); - - if (st.st_uid != 0 || st.st_gid != gr->gr_gid || (st.st_mode & ~S_IFMT) != 01775) { - if (chown(settings.nixStore.c_str(), 0, gr->gr_gid) == -1) - throw SysError(format("changing ownership of path `%1%'") % settings.nixStore); - if (chmod(settings.nixStore.c_str(), 01775) == -1) - throw SysError(format("changing permissions on path `%1%'") % settings.nixStore); + else { + struct stat st; + if (stat(settings.nixStore.c_str(), &st)) + throw SysError(format("getting attributes of path '%1%'") % settings.nixStore); + + if (st.st_uid != 0 || st.st_gid != gr->gr_gid || (st.st_mode & ~S_IFMT) != perm) { + if (chown(settings.nixStore.c_str(), 0, gr->gr_gid) == -1) + throw SysError(format("changing ownership of path '%1%'") % settings.nixStore); + if (chmod(settings.nixStore.c_str(), perm) == -1) + throw SysError(format("changing permissions on path '%1%'") % settings.nixStore); + } } } @@ -358,7 +361,17 @@ LocalStore::~LocalStore() i->second.to.close(); i->second.from.close(); i->second.error.close(); - i->second.pid.wait(true); + if (i->second.pid != -1) + i->second.pid.wait(true); + } + } catch (...) { + ignoreException(); + } + + try { + if (fdTempRoots != -1) { + fdTempRoots.close(); + unlink(fnTempRoots.c_str()); } } catch (...) { ignoreException(); @@ -489,7 +502,7 @@ void LocalStore::makeStoreWritable() if (unshare(CLONE_NEWNS) == -1) throw SysError("setting up a private mount namespace"); - if (mount(0, settings.nixStore.c_str(), 0, MS_REMOUNT | MS_BIND, 0) == -1) + if (mount(0, settings.nixStore.c_str(), "none", MS_REMOUNT | MS_BIND, 0) == -1) throw SysError(format("remounting %1% writable") % settings.nixStore); } #endif @@ -551,9 +564,9 @@ static void canonicalisePathMetaData_(const Path & path, uid_t fromUid, InodesSe if (lstat(path.c_str(), &st)) throw SysError(format("getting attributes of path `%1%'") % path); - /* Really make sure that the path is of a supported type. This - has already been checked in dumpPath(). */ - assert(S_ISREG(st.st_mode) || S_ISDIR(st.st_mode) || S_ISLNK(st.st_mode)); + /* Really make sure that the path is of a supported type. */ + if (!(S_ISREG(st.st_mode) || S_ISDIR(st.st_mode) || S_ISLNK(st.st_mode))) + throw Error(format("file ‘%1%’ has an unsupported type") % path); /* Fail if the file is not owned by the build user. This prevents us from messing up the ownership/permissions of files @@ -593,9 +606,9 @@ static void canonicalisePathMetaData_(const Path & path, uid_t fromUid, InodesSe } if (S_ISDIR(st.st_mode)) { - Strings names = readDirectory(path); - foreach (Strings::iterator, i, names) - canonicalisePathMetaData_(path + "/" + *i, fromUid, inodesSeen); + DirEntries entries = readDirectory(path); + for (auto & i : entries) + canonicalisePathMetaData_(path + "/" + i.name, fromUid, inodesSeen); } } @@ -1083,31 +1096,16 @@ void LocalStore::startSubstituter(const Path & substituter, RunningSubstituter & setSubstituterEnv(); - run.pid = maybeVfork(); - - switch (run.pid) { - - case -1: - throw SysError("unable to fork"); - - case 0: /* child */ - try { - restoreAffinity(); - if (dup2(toPipe.readSide, STDIN_FILENO) == -1) - throw SysError("dupping stdin"); - if (dup2(fromPipe.writeSide, STDOUT_FILENO) == -1) - throw SysError("dupping stdout"); - if (dup2(errorPipe.writeSide, STDERR_FILENO) == -1) - throw SysError("dupping stderr"); - execl(substituter.c_str(), substituter.c_str(), "--query", NULL); - throw SysError(format("executing `%1%'") % substituter); - } catch (std::exception & e) { - std::cerr << "error: " << e.what() << std::endl; - } - _exit(1); - } - - /* Parent. */ + run.pid = startProcess([&]() { + if (dup2(toPipe.readSide, STDIN_FILENO) == -1) + throw SysError("dupping stdin"); + if (dup2(fromPipe.writeSide, STDOUT_FILENO) == -1) + throw SysError("dupping stdout"); + if (dup2(errorPipe.writeSide, STDERR_FILENO) == -1) + throw SysError("dupping stderr"); + execl(substituter.c_str(), substituter.c_str(), "--query", NULL); + throw SysError(format("executing `%1%'") % substituter); + }); run.program = baseNameOf(substituter); run.to = toPipe.writeSide.borrow(); @@ -1171,7 +1169,7 @@ string LocalStore::getLineFromSubstituter(RunningSubstituter & run) while (((p = err.find('\n')) != string::npos) || ((p = err.find('\r')) != string::npos)) { string thing(err, 0, p + 1); - writeToStderr(run.program + ": " + thing); + writeToStderr(run.program + ": " + thing); err = string(err, p + 1); } } @@ -1409,7 +1407,7 @@ Path LocalStore::addToStoreFromDump(const string & dump, const string & name, } -Path LocalStore::addToStore(const Path & _srcPath, +Path LocalStore::addToStore(const string & name, const Path & _srcPath, bool recursive, HashType hashAlgo, PathFilter & filter, bool repair) { Path srcPath(absPath(_srcPath)); @@ -1424,7 +1422,7 @@ Path LocalStore::addToStore(const Path & _srcPath, else sink.s = readFile(srcPath); - return addToStoreFromDump(sink.s, baseNameOf(srcPath), recursive, hashAlgo, repair); + return addToStoreFromDump(sink.s, name, recursive, hashAlgo, repair); } @@ -1503,7 +1501,8 @@ void LocalStore::exportPath(const Path & path, bool sign, { assertStorePath(path); - addTempRoot(path); + printMsg(lvlInfo, format("exporting path `%1%'") % path); + if (!isValidPath(path)) throw Error(format("path `%1%' is not valid") % path); @@ -1613,8 +1612,6 @@ Path LocalStore::importPath(bool requireSignature, Source & source) Path dstPath = readStorePath(hashAndReadSource); - printMsg(lvlInfo, format("importing path `%1%'") % dstPath); - PathSet references = readStorePaths<PathSet>(hashAndReadSource); Path deriver = readString(hashAndReadSource); @@ -1747,8 +1744,8 @@ bool LocalStore::verifyStore(bool checkContents, bool repair) /* Acquire the global GC lock to prevent a garbage collection. */ AutoCloseFD fdGCLock = openGCLock(ltWrite); - Paths entries = readDirectory(settings.nixStore); - PathSet store(entries.begin(), entries.end()); + PathSet store; + for (auto & i : readDirectory(settings.nixStore)) store.insert(i.name); /* Check whether all valid paths actually exist. */ printMsg(lvlInfo, "checking path existence..."); @@ -1898,9 +1895,8 @@ void LocalStore::markContentsGood(const Path & path) PathSet LocalStore::queryValidPathsOld() { PathSet paths; - Strings entries = readDirectory(settings.nixDBPath + "/info"); - foreach (Strings::iterator, i, entries) - if (i->at(0) != '.') paths.insert(settings.nixStore + "/" + *i); + for (auto & i : readDirectory(settings.nixDBPath + "/info")) + if (i.name.at(0) != '.') paths.insert(settings.nixStore + "/" + i.name); return paths; } @@ -1987,9 +1983,8 @@ static void makeMutable(const Path & path) if (!S_ISDIR(st.st_mode) && !S_ISREG(st.st_mode)) return; if (S_ISDIR(st.st_mode)) { - Strings names = readDirectory(path); - foreach (Strings::iterator, i, names) - makeMutable(path + "/" + *i); + for (auto & i : readDirectory(path)) + makeMutable(path + "/" + i.name); } /* The O_NOFOLLOW is important to prevent us from changing the diff --git a/nix/libstore/local-store.hh b/nix/libstore/local-store.hh index 54331e448a..819f59327a 100644 --- a/nix/libstore/local-store.hh +++ b/nix/libstore/local-store.hh @@ -1,16 +1,12 @@ #pragma once #include <string> +#include <unordered_set> #include "store-api.hh" #include "util.hh" #include "pathlocks.hh" -#if HAVE_TR1_UNORDERED_SET -#include <tr1/unordered_set> -#endif - - class sqlite3; class sqlite3_stmt; @@ -134,7 +130,7 @@ public: void querySubstitutablePathInfos(const PathSet & paths, SubstitutablePathInfos & infos); - Path addToStore(const Path & srcPath, + Path addToStore(const string & name, const Path & srcPath, bool recursive = true, HashType hashAlgo = htSHA256, PathFilter & filter = defaultPathFilter, bool repair = false); @@ -171,6 +167,9 @@ public: files with the same contents. */ void optimiseStore(OptimiseStats & stats); + /* Generic variant of the above method. */ + void optimiseStore(); + /* Optimise a single store path. */ void optimisePath(const Path & path); @@ -245,6 +244,10 @@ private: bool didSetSubstituterEnv; + /* The file to which we write our temporary roots. */ + Path fnTempRoots; + AutoCloseFD fdTempRoots; + int getSchema(); void openDB(bool create); @@ -306,11 +309,7 @@ private: void checkDerivationOutputs(const Path & drvPath, const Derivation & drv); -#if HAVE_TR1_UNORDERED_SET - typedef std::tr1::unordered_set<ino_t> InodeHash; -#else - typedef std::set<ino_t> InodeHash; -#endif + typedef std::unordered_set<ino_t> InodeHash; InodeHash loadInodeHash(); Strings readDirectoryIgnoringInodes(const Path & path, const InodeHash & inodeHash); diff --git a/nix/libstore/optimise-store.cc b/nix/libstore/optimise-store.cc index 67ee94a4bd..c62b8e451b 100644 --- a/nix/libstore/optimise-store.cc +++ b/nix/libstore/optimise-store.cc @@ -4,6 +4,7 @@ #include "local-store.hh" #include "globals.hh" +#include <cstdlib> #include <sys/types.h> #include <sys/stat.h> #include <unistd.h> @@ -225,6 +226,22 @@ void LocalStore::optimiseStore(OptimiseStats & stats) } } +static string showBytes(unsigned long long bytes) +{ + return (format("%.2f MiB") % (bytes / (1024.0 * 1024.0))).str(); +} + +void LocalStore::optimiseStore() +{ + OptimiseStats stats; + + optimiseStore(stats); + + printMsg(lvlError, + format("%1% freed by hard-linking %2% files") + % showBytes(stats.bytesFreed) + % stats.filesLinked); +} void LocalStore::optimisePath(const Path & path) { diff --git a/nix/libstore/pathlocks.cc b/nix/libstore/pathlocks.cc index b858ed238d..830858ff8d 100644 --- a/nix/libstore/pathlocks.cc +++ b/nix/libstore/pathlocks.cc @@ -33,7 +33,7 @@ void deleteLockFile(const Path & path, int fd) other processes waiting on this lock that the lock is stale (deleted). */ unlink(path.c_str()); - writeFull(fd, (const unsigned char *) "d", 1); + writeFull(fd, "d"); /* Note that the result of unlink() is ignored; removing the lock file is an optimisation, not a necessity. */ } diff --git a/nix/libstore/remote-store.cc b/nix/libstore/remote-store.cc index 4619206932..0539bbe127 100644 --- a/nix/libstore/remote-store.cc +++ b/nix/libstore/remote-store.cc @@ -10,6 +10,7 @@ #include <sys/stat.h> #include <sys/socket.h> #include <sys/un.h> +#include <errno.h> #include <fcntl.h> #include <iostream> @@ -87,8 +88,7 @@ void RemoteStore::openConnection(bool reserveSpace) processStderr(); } catch (Error & e) { - throw Error(format("cannot start worker (%1%)") - % e.msg()); + throw Error(format("cannot start daemon worker: %1%") % e.msg()); } setOptions(); @@ -110,7 +110,7 @@ void RemoteStore::connectToDaemon() applications... */ AutoCloseFD fdPrevDir = open(".", O_RDONLY); if (fdPrevDir == -1) throw SysError("couldn't open current directory"); - chdir(dirOf(socketPath).c_str()); + if (chdir(dirOf(socketPath).c_str()) == -1) throw SysError(format("couldn't change to directory of ‘%1%’") % socketPath); Path socketPathRel = "./" + baseNameOf(socketPath); struct sockaddr_un addr; @@ -133,8 +133,6 @@ RemoteStore::~RemoteStore() try { to.flush(); fdSocket.close(); - if (child != -1) - child.wait(true); } catch (...) { ignoreException(); } @@ -387,7 +385,7 @@ Path RemoteStore::queryPathFromHashPart(const string & hashPart) } -Path RemoteStore::addToStore(const Path & _srcPath, +Path RemoteStore::addToStore(const string & name, const Path & _srcPath, bool recursive, HashType hashAlgo, PathFilter & filter, bool repair) { if (repair) throw Error("repairing is not supported when building through the Nix daemon"); @@ -397,13 +395,28 @@ Path RemoteStore::addToStore(const Path & _srcPath, Path srcPath(absPath(_srcPath)); writeInt(wopAddToStore, to); - writeString(baseNameOf(srcPath), to); + writeString(name, to); /* backwards compatibility hack */ writeInt((hashAlgo == htSHA256 && recursive) ? 0 : 1, to); writeInt(recursive ? 1 : 0, to); writeString(printHashType(hashAlgo), to); - dumpPath(srcPath, to, filter); - processStderr(); + + try { + to.written = 0; + to.warn = true; + dumpPath(srcPath, to, filter); + to.warn = false; + processStderr(); + } catch (SysError & e) { + /* Daemon closed while we were sending the path. Probably OOM + or I/O error. */ + if (e.errNo == EPIPE) + try { + processStderr(); + } catch (EndOfFile & e) { } + throw; + } + return readStorePath(from); } @@ -564,6 +577,23 @@ void RemoteStore::clearFailedPaths(const PathSet & paths) readInt(from); } +void RemoteStore::optimiseStore() +{ + openConnection(); + writeInt(wopOptimiseStore, to); + processStderr(); + readInt(from); +} + +bool RemoteStore::verifyStore(bool checkContents, bool repair) +{ + openConnection(); + writeInt(wopVerifyStore, to); + writeInt(checkContents, to); + writeInt(repair, to); + processStderr(); + return readInt(from) != 0; +} void RemoteStore::processStderr(Sink * sink, Source * source) { diff --git a/nix/libstore/remote-store.hh b/nix/libstore/remote-store.hh index 04b60fce4b..030120db40 100644 --- a/nix/libstore/remote-store.hh +++ b/nix/libstore/remote-store.hh @@ -21,15 +21,15 @@ public: RemoteStore(); ~RemoteStore(); - + /* Implementations of abstract store API methods. */ - + bool isValidPath(const Path & path); PathSet queryValidPaths(const PathSet & paths); - + PathSet queryAllValidPaths(); - + ValidPathInfo queryPathInfo(const Path & path); Hash queryPathHash(const Path & path); @@ -39,21 +39,21 @@ public: void queryReferrers(const Path & path, PathSet & referrers); Path queryDeriver(const Path & path); - + PathSet queryValidDerivers(const Path & path); PathSet queryDerivationOutputs(const Path & path); - + StringSet queryDerivationOutputNames(const Path & path); Path queryPathFromHashPart(const string & hashPart); - + PathSet querySubstitutablePaths(const PathSet & paths); - + void querySubstitutablePathInfos(const PathSet & paths, SubstitutablePathInfos & infos); - - Path addToStore(const Path & srcPath, + + Path addToStore(const string & name, const Path & srcPath, bool recursive = true, HashType hashAlgo = htSHA256, PathFilter & filter = defaultPathFilter, bool repair = false); @@ -64,7 +64,7 @@ public: Sink & sink); Paths importPaths(bool requireSignature, Source & source); - + void buildPaths(const PathSet & paths, BuildMode buildMode); void ensurePath(const Path & path); @@ -72,22 +72,24 @@ public: void addTempRoot(const Path & path); void addIndirectRoot(const Path & path); - + void syncWithGC(); - + Roots findRoots(); void collectGarbage(const GCOptions & options, GCResults & results); - + PathSet queryFailedPaths(); void clearFailedPaths(const PathSet & paths); - + + void optimiseStore(); + + bool verifyStore(bool checkContents, bool repair); private: AutoCloseFD fdSocket; FdSink to; FdSource from; - Pid child; unsigned int daemonVersion; bool initialised; diff --git a/nix/libstore/store-api.hh b/nix/libstore/store-api.hh index b635fee2cf..3764f3e542 100644 --- a/nix/libstore/store-api.hh +++ b/nix/libstore/store-api.hh @@ -54,7 +54,7 @@ struct GCOptions }; -struct GCResults +struct GCResults { /* Depending on the action, the GC roots, or the paths that would be or have been deleted. */ @@ -82,7 +82,7 @@ struct SubstitutablePathInfo typedef std::map<Path, SubstitutablePathInfo> SubstitutablePathInfos; -struct ValidPathInfo +struct ValidPathInfo { Path path; Path deriver; @@ -100,13 +100,13 @@ typedef list<ValidPathInfo> ValidPathInfos; enum BuildMode { bmNormal, bmRepair, bmCheck }; -class StoreAPI +class StoreAPI { public: virtual ~StoreAPI() { } - /* Check whether a path is valid. */ + /* Check whether a path is valid. */ virtual bool isValidPath(const Path & path) = 0; /* Query which of the given paths is valid. */ @@ -118,7 +118,7 @@ public: /* Query information about a valid path. */ virtual ValidPathInfo queryPathInfo(const Path & path) = 0; - /* Query the hash of a valid path. */ + /* Query the hash of a valid path. */ virtual Hash queryPathHash(const Path & path) = 0; /* Query the set of outgoing FS references for a store path. The @@ -150,7 +150,7 @@ public: /* Query the full store path given the hash part of a valid store path, or "" if the path doesn't exist. */ virtual Path queryPathFromHashPart(const string & hashPart) = 0; - + /* Query which of the given paths have substitutes. */ virtual PathSet querySubstitutablePaths(const PathSet & paths) = 0; @@ -159,12 +159,12 @@ public: info, it's omitted from the resulting ‘infos’ map. */ virtual void querySubstitutablePathInfos(const PathSet & paths, SubstitutablePathInfos & infos) = 0; - + /* Copy the contents of a path to the store and register the validity the resulting path. The resulting path is returned. The function object `filter' can be used to exclude files (see libutil/archive.hh). */ - virtual Path addToStore(const Path & srcPath, + virtual Path addToStore(const string & name, const Path & srcPath, bool recursive = true, HashType hashAlgo = htSHA256, PathFilter & filter = defaultPathFilter, bool repair = false) = 0; @@ -250,6 +250,14 @@ public: `nix-store --register-validity'. */ string makeValidityRegistration(const PathSet & paths, bool showDerivers, bool showHash); + + /* Optimise the disk space usage of the Nix store by hard-linking files + with the same contents. */ + virtual void optimiseStore() = 0; + + /* Check the integrity of the Nix store. Returns true if errors + remain. */ + virtual bool verifyStore(bool checkContents, bool repair) = 0; }; @@ -263,7 +271,7 @@ bool isStorePath(const Path & path); /* Extract the name part of the given store path. */ string storePathToName(const Path & path); - + void checkStoreName(const string & name); @@ -284,7 +292,7 @@ Path followLinksToStorePath(const Path & path); /* Constructs a unique store path name. */ Path makeStorePath(const string & type, const Hash & hash, const string & name); - + Path makeOutputPath(const string & id, const Hash & hash, const string & name); diff --git a/nix/libstore/worker-protocol.hh b/nix/libstore/worker-protocol.hh index 9317f89c37..d037d7402e 100644 --- a/nix/libstore/worker-protocol.hh +++ b/nix/libstore/worker-protocol.hh @@ -12,7 +12,6 @@ namespace nix { typedef enum { - wopQuit = 0, wopIsValidPath = 1, wopHasSubstitutes = 3, wopQueryPathHash = 4, @@ -43,6 +42,8 @@ typedef enum { wopQueryValidPaths = 31, wopQuerySubstitutablePaths = 32, wopQueryValidDerivers = 33, + wopOptimiseStore = 34, + wopVerifyStore = 35 } WorkerOp; diff --git a/nix/libutil/archive.cc b/nix/libutil/archive.cc index 70a1c580dd..6856ea0f28 100644 --- a/nix/libutil/archive.cc +++ b/nix/libutil/archive.cc @@ -1,10 +1,14 @@ +#define _XOPEN_SOURCE 600 + #include "config.h" #include <cerrno> #include <algorithm> #include <vector> +#include <map> + +#include <strings.h> // for strcasecmp -#define _XOPEN_SOURCE 600 #include <sys/types.h> #include <sys/stat.h> #include <unistd.h> @@ -18,39 +22,21 @@ namespace nix { +bool useCaseHack = +#if __APPLE__ + true; +#else + false; +#endif + static string archiveVersion1 = "nix-archive-1"; +static string caseHackSuffix = "~nix~case~hack~"; PathFilter defaultPathFilter; -static void dump(const string & path, Sink & sink, PathFilter & filter); - - -static void dumpEntries(const Path & path, Sink & sink, PathFilter & filter) -{ - Strings names = readDirectory(path); - vector<string> names2(names.begin(), names.end()); - sort(names2.begin(), names2.end()); - - for (vector<string>::iterator i = names2.begin(); - i != names2.end(); ++i) - { - Path entry = path + "/" + *i; - if (filter(entry)) { - writeString("entry", sink); - writeString("(", sink); - writeString("name", sink); - writeString(*i, sink); - writeString("node", sink); - dump(entry, sink, filter); - writeString(")", sink); - } - } -} - - -static void dumpContents(const Path & path, size_t size, +static void dumpContents(const Path & path, size_t size, Sink & sink) { writeString("contents", sink); @@ -58,7 +44,7 @@ static void dumpContents(const Path & path, size_t size, AutoCloseFD fd = open(path.c_str(), O_RDONLY); if (fd == -1) throw SysError(format("opening file `%1%'") % path); - + unsigned char buf[65536]; size_t left = size; @@ -89,12 +75,40 @@ static void dump(const Path & path, Sink & sink, PathFilter & filter) writeString("", sink); } dumpContents(path, (size_t) st.st_size, sink); - } + } else if (S_ISDIR(st.st_mode)) { writeString("type", sink); writeString("directory", sink); - dumpEntries(path, sink, filter); + + /* If we're on a case-insensitive system like Mac OS X, undo + the case hack applied by restorePath(). */ + std::map<string, string> unhacked; + for (auto & i : readDirectory(path)) + if (useCaseHack) { + string name(i.name); + size_t pos = i.name.find(caseHackSuffix); + if (pos != string::npos) { + printMsg(lvlDebug, format("removing case hack suffix from `%1%'") % (path + "/" + i.name)); + name.erase(pos); + } + if (unhacked.find(name) != unhacked.end()) + throw Error(format("file name collision in between `%1%' and `%2%'") + % (path + "/" + unhacked[name]) % (path + "/" + i.name)); + unhacked[name] = i.name; + } else + unhacked[i.name] = i.name; + + for (auto & i : unhacked) + if (filter(path + "/" + i.first)) { + writeString("entry", sink); + writeString("(", sink); + writeString("name", sink); + writeString(i.first, sink); + writeString("node", sink); + dump(path + "/" + i.second, sink, filter); + writeString(")", sink); + } } else if (S_ISLNK(st.st_mode)) { @@ -123,6 +137,7 @@ static SerialisationError badArchive(string s) } +#if 0 static void skipGeneric(Source & source) { if (readString(source) == "(") { @@ -130,43 +145,13 @@ static void skipGeneric(Source & source) skipGeneric(source); } } - - -static void parse(ParseSink & sink, Source & source, const Path & path); - - - -static void parseEntry(ParseSink & sink, Source & source, const Path & path) -{ - string s, name; - - s = readString(source); - if (s != "(") throw badArchive("expected open tag"); - - while (1) { - checkInterrupt(); - - s = readString(source); - - if (s == ")") { - break; - } else if (s == "name") { - name = readString(source); - } else if (s == "node") { - if (s == "") throw badArchive("entry name missing"); - parse(sink, source, path + "/" + name); - } else { - throw badArchive("unknown field " + s); - skipGeneric(source); - } - } -} +#endif static void parseContents(ParseSink & sink, Source & source, const Path & path) { unsigned long long size = readLongLong(source); - + sink.preallocateContents(size); unsigned long long left = size; @@ -185,6 +170,15 @@ static void parseContents(ParseSink & sink, Source & source, const Path & path) } +struct CaseInsensitiveCompare +{ + bool operator() (const string & a, const string & b) const + { + return strcasecmp(a.c_str(), b.c_str()) < 0; + } +}; + + static void parse(ParseSink & sink, Source & source, const Path & path) { string s; @@ -194,6 +188,8 @@ static void parse(ParseSink & sink, Source & source, const Path & path) enum { tpUnknown, tpRegular, tpDirectory, tpSymlink } type = tpUnknown; + std::map<Path, int, CaseInsensitiveCompare> names; + while (1) { checkInterrupt(); @@ -221,9 +217,9 @@ static void parse(ParseSink & sink, Source & source, const Path & path) else if (t == "symlink") { type = tpSymlink; } - + else throw badArchive("unknown file type " + t); - + } else if (s == "contents" && type == tpRegular) { @@ -236,7 +232,40 @@ static void parse(ParseSink & sink, Source & source, const Path & path) } else if (s == "entry" && type == tpDirectory) { - parseEntry(sink, source, path); + string name, prevName; + + s = readString(source); + if (s != "(") throw badArchive("expected open tag"); + + while (1) { + checkInterrupt(); + + s = readString(source); + + if (s == ")") { + break; + } else if (s == "name") { + name = readString(source); + if (name.empty() || name == "." || name == ".." || name.find('/') != string::npos || name.find((char) 0) != string::npos) + throw Error(format("NAR contains invalid file name `%1%'") % name); + if (name <= prevName) + throw Error("NAR directory is not sorted"); + prevName = name; + if (useCaseHack) { + auto i = names.find(name); + if (i != names.end()) { + printMsg(lvlDebug, format("case collision between `%1%' and `%2%'") % i->first % name); + name += caseHackSuffix; + name += int2String(++i->second); + } else + names[name] = 0; + } + } else if (s == "node") { + if (s.empty()) throw badArchive("entry name missing"); + parse(sink, source, path + "/" + name); + } else + throw badArchive("unknown field " + s); + } } else if (s == "target" && type == tpSymlink) { @@ -244,17 +273,15 @@ static void parse(ParseSink & sink, Source & source, const Path & path) sink.createSymlink(path, target); } - else { + else throw badArchive("unknown field " + s); - skipGeneric(source); - } } } void parseDump(ParseSink & sink, Source & source) { - string version; + string version; try { version = readString(source); } catch (SerialisationError & e) { @@ -323,7 +350,7 @@ struct RestoreSink : ParseSink } }; - + void restorePath(const Path & path, Source & source) { RestoreSink sink; @@ -331,5 +358,5 @@ void restorePath(const Path & path, Source & source) parseDump(sink, source); } - + } diff --git a/nix/libutil/archive.hh b/nix/libutil/archive.hh index ccac92074d..c216e9768f 100644 --- a/nix/libutil/archive.hh +++ b/nix/libutil/archive.hh @@ -28,7 +28,7 @@ namespace nix { where: - attrs(as) = concat(map(attr, as)) + encN(0) + attrs(as) = concat(map(attr, as)) + encN(0) attrs((a, b)) = encS(a) + encS(b) encS(s) = encN(len(s)) + s + (padding until next 64-bit boundary) @@ -58,7 +58,7 @@ void dumpPath(const Path & path, Sink & sink, struct ParseSink { virtual void createDirectory(const Path & path) { }; - + virtual void createRegularFile(const Path & path) { }; virtual void isExecutable() { }; virtual void preallocateContents(unsigned long long size) { }; @@ -66,10 +66,14 @@ struct ParseSink virtual void createSymlink(const Path & path, const string & target) { }; }; - + void parseDump(ParseSink & sink, Source & source); void restorePath(const Path & path, Source & source); - + +// FIXME: global variables are bad m'kay. +extern bool useCaseHack; + + } diff --git a/nix/libutil/hash.cc b/nix/libutil/hash.cc index 050446610f..2da00a53de 100644 --- a/nix/libutil/hash.cc +++ b/nix/libutil/hash.cc @@ -84,7 +84,7 @@ string printHash(const Hash & hash) return string(buf, hash.hashSize * 2); } - + Hash parseHash(HashType ht, const string & s) { Hash hash(ht); @@ -92,7 +92,7 @@ Hash parseHash(HashType ht, const string & s) throw Error(format("invalid hash `%1%'") % s); for (unsigned int i = 0; i < hash.hashSize; i++) { string s2(s, i * 2, 2); - if (!isxdigit(s2[0]) || !isxdigit(s2[1])) + if (!isxdigit(s2[0]) || !isxdigit(s2[1])) throw Error(format("invalid hash `%1%'") % s); std::istringstream str(s2); int n; @@ -103,24 +103,6 @@ Hash parseHash(HashType ht, const string & s) } -static unsigned char divMod(unsigned char * bytes, unsigned char y) -{ - unsigned int borrow = 0; - - int pos = Hash::maxHashSize - 1; - while (pos >= 0 && !bytes[pos]) --pos; - - for ( ; pos >= 0; --pos) { - unsigned int s = bytes[pos] + (borrow << 8); - unsigned int d = s / y; - borrow = s % y; - bytes[pos] = d; - } - - return borrow; -} - - unsigned int hashLength32(const Hash & hash) { return (hash.hashSize * 8 - 1) / 5 + 1; @@ -136,19 +118,19 @@ string printHash32(const Hash & hash) Hash hash2(hash); unsigned int len = hashLength32(hash); - const char * chars = base32Chars.data(); - - string s(len, '0'); - - int pos = len - 1; - while (pos >= 0) { - unsigned char digit = divMod(hash2.hash, 32); - s[pos--] = chars[digit]; + string s; + s.reserve(len); + + for (int n = len - 1; n >= 0; n--) { + unsigned int b = n * 5; + unsigned int i = b / 8; + unsigned int j = b % 8; + unsigned char c = + (hash.hash[i] >> j) + | (i >= hash.hashSize - 1 ? 0 : hash.hash[i + 1] << (8 - j)); + s.push_back(base32Chars[c & 0x1f]); } - for (unsigned int i = 0; i < hash2.maxHashSize; ++i) - assert(hash2.hash[i] == 0); - return s; } @@ -159,51 +141,24 @@ string printHash16or32(const Hash & hash) } -static bool mul(unsigned char * bytes, unsigned char y, int maxSize) -{ - unsigned char carry = 0; - - for (int pos = 0; pos < maxSize; ++pos) { - unsigned int m = bytes[pos] * y + carry; - bytes[pos] = m & 0xff; - carry = m >> 8; - } - - return carry; -} - - -static bool add(unsigned char * bytes, unsigned char y, int maxSize) -{ - unsigned char carry = y; - - for (int pos = 0; pos < maxSize; ++pos) { - unsigned int m = bytes[pos] + carry; - bytes[pos] = m & 0xff; - carry = m >> 8; - if (carry == 0) break; - } - - return carry; -} - - Hash parseHash32(HashType ht, const string & s) { Hash hash(ht); + unsigned int len = hashLength32(ht); + assert(s.size() == len); - const char * chars = base32Chars.data(); - - for (unsigned int i = 0; i < s.length(); ++i) { - char c = s[i]; + for (unsigned int n = 0; n < len; ++n) { + char c = s[len - n - 1]; unsigned char digit; for (digit = 0; digit < base32Chars.size(); ++digit) /* !!! slow */ - if (chars[digit] == c) break; + if (base32Chars[digit] == c) break; if (digit >= 32) - throw Error(format("invalid base-32 hash `%1%'") % s); - if (mul(hash.hash, 32, hash.hashSize) || - add(hash.hash, digit, hash.hashSize)) - throw Error(format("base-32 hash `%1%' is too large") % s); + throw Error(format("invalid base-32 hash '%1%'") % s); + unsigned int b = n * 5; + unsigned int i = b / 8; + unsigned int j = b % 8; + hash.hash[i] |= digit << j; + if (i < hash.hashSize - 1) hash.hash[i + 1] |= digit >> (8 - j); } return hash; @@ -299,7 +254,7 @@ Hash hashFile(HashType ht, const Path & path) if (n == -1) throw SysError(format("reading file `%1%'") % path); update(ht, ctx, buf, n); } - + finish(ht, ctx, hash.hash); return hash; } @@ -311,7 +266,7 @@ HashSink::HashSink(HashType ht) : ht(ht) bytes = 0; start(ht, *ctx); } - + HashSink::~HashSink() { bufPos = 0; @@ -369,7 +324,7 @@ HashType parseHashType(const string & s) else return htUnknown; } - + string printHashType(HashType ht) { if (ht == htMD5) return "md5"; @@ -378,5 +333,5 @@ string printHashType(HashType ht) else throw Error("cannot print unknown hash type"); } - + } diff --git a/nix/libutil/serialise.cc b/nix/libutil/serialise.cc index 6b71f52c15..9241750750 100644 --- a/nix/libutil/serialise.cc +++ b/nix/libutil/serialise.cc @@ -54,8 +54,24 @@ FdSink::~FdSink() } +size_t threshold = 256 * 1024 * 1024; + +static void warnLargeDump() +{ + printMsg(lvlError, "warning: dumping very large path (> 256 MiB); this may run out of memory"); +} + + void FdSink::write(const unsigned char * data, size_t len) { + static bool warned = false; + if (warn && !warned) { + written += len; + if (written > threshold) { + warnLargeDump(); + warned = true; + } + } writeFull(fd, data, len); } @@ -256,4 +272,15 @@ template Paths readStrings(Source & source); template PathSet readStrings(Source & source); +void StringSink::operator () (const unsigned char * data, size_t len) +{ + static bool warned = false; + if (!warned && s.size() > threshold) { + warnLargeDump(); + warned = true; + } + s.append((const char *) data, len); +} + + } diff --git a/nix/libutil/serialise.hh b/nix/libutil/serialise.hh index e5a9df1d05..6a6f028aa6 100644 --- a/nix/libutil/serialise.hh +++ b/nix/libutil/serialise.hh @@ -72,9 +72,11 @@ struct BufferedSource : Source struct FdSink : BufferedSink { int fd; + bool warn; + size_t written; - FdSink() : fd(-1) { } - FdSink(int fd) : fd(fd) { } + FdSink() : fd(-1), warn(false), written(0) { } + FdSink(int fd) : fd(fd), warn(false), written(0) { } ~FdSink(); void write(const unsigned char * data, size_t len); @@ -95,10 +97,7 @@ struct FdSource : BufferedSource struct StringSink : Sink { string s; - void operator () (const unsigned char * data, size_t len) - { - s.append((const char *) data, len); - } + void operator () (const unsigned char * data, size_t len); }; diff --git a/nix/libutil/types.hh b/nix/libutil/types.hh index 4b5ce9a78c..160884ee1a 100644 --- a/nix/libutil/types.hh +++ b/nix/libutil/types.hh @@ -8,6 +8,15 @@ #include <boost/format.hpp> +/* Before 4.7, gcc's std::exception uses empty throw() specifiers for + * its (virtual) destructor and what() in c++11 mode, in violation of spec + */ +#ifdef __GNUC__ +#if __GNUC__ < 4 || (__GNUC__ == 4 && __GNUC_MINOR__ < 7) +#define EXCEPTION_NEEDS_THROW_SPEC +#endif +#endif + namespace nix { @@ -39,10 +48,14 @@ protected: public: unsigned int status; // exit status BaseError(const FormatOrString & fs, unsigned int status = 1); +#ifdef EXCEPTION_NEEDS_THROW_SPEC ~BaseError() throw () { }; const char * what() const throw () { return err.c_str(); } - const string & msg() const throw () { return err; } - const string & prefix() const throw () { return prefix_; } +#else + const char * what() const noexcept { return err.c_str(); } +#endif + const string & msg() const { return err; } + const string & prefix() const { return prefix_; } BaseError & addPrefix(const FormatOrString & fs); }; diff --git a/nix/libutil/util.cc b/nix/libutil/util.cc index 846674a29d..dab4235b04 100644 --- a/nix/libutil/util.cc +++ b/nix/libutil/util.cc @@ -1,5 +1,8 @@ #include "config.h" +#include "util.hh" +#include "affinity.hh" + #include <iostream> #include <cerrno> #include <cstdio> @@ -16,7 +19,9 @@ #include <sys/syscall.h> #endif -#include "util.hh" +#ifdef __linux__ +#include <sys/prctl.h> +#endif extern char * * environ; @@ -125,7 +130,6 @@ Path canonPath(const Path & path, bool resolveSymlinks) i = temp.begin(); /* restart */ end = temp.end(); s = ""; - /* !!! potential for infinite loop */ } } } @@ -189,8 +193,12 @@ Path readLink(const Path & path) if (!S_ISLNK(st.st_mode)) throw Error(format("`%1%' is not a symlink") % path); char buf[st.st_size]; - if (readlink(path.c_str(), buf, st.st_size) != st.st_size) - throw SysError(format("reading symbolic link `%1%'") % path); + ssize_t rlsize = readlink(path.c_str(), buf, st.st_size); + if (rlsize == -1) + throw SysError(format("reading symbolic link '%1%'") % path); + else if (rlsize > st.st_size) + throw Error(format("symbolic link ‘%1%’ size overflow %2% > %3%") + % path % rlsize % st.st_size); return string(buf, st.st_size); } @@ -202,9 +210,10 @@ bool isLink(const Path & path) } -Strings readDirectory(const Path & path) +DirEntries readDirectory(const Path & path) { - Strings names; + DirEntries entries; + entries.reserve(64); AutoCloseDir dir = opendir(path.c_str()); if (!dir) throw SysError(format("opening directory `%1%'") % path); @@ -214,11 +223,21 @@ Strings readDirectory(const Path & path) checkInterrupt(); string name = dirent->d_name; if (name == "." || name == "..") continue; - names.push_back(name); + entries.emplace_back(name, dirent->d_ino, dirent->d_type); } if (errno) throw SysError(format("reading directory `%1%'") % path); - return names; + return entries; +} + + +unsigned char getFileType(const Path & path) +{ + struct stat st = lstat(path); + if (S_ISDIR(st.st_mode)) return DT_DIR; + if (S_ISLNK(st.st_mode)) return DT_LNK; + if (S_ISREG(st.st_mode)) return DT_REG; + return DT_UNKNOWN; } @@ -249,8 +268,8 @@ void writeFile(const Path & path, const string & s) { AutoCloseFD fd = open(path.c_str(), O_WRONLY | O_TRUNC | O_CREAT, 0666); if (fd == -1) - throw SysError(format("opening file `%1%'") % path); - writeFull(fd, (unsigned char *) s.data(), s.size()); + throw SysError(format("opening file '%1%'") % path); + writeFull(fd, s); } @@ -277,7 +296,7 @@ string readLine(int fd) void writeLine(int fd, string s) { s += '\n'; - writeFull(fd, (const unsigned char *) s.data(), s.size()); + writeFull(fd, s); } @@ -293,16 +312,14 @@ static void _deletePath(const Path & path, unsigned long long & bytesFreed) bytesFreed += st.st_blocks * 512; if (S_ISDIR(st.st_mode)) { - Strings names = readDirectory(path); - /* Make the directory writable. */ if (!(st.st_mode & S_IWUSR)) { if (chmod(path.c_str(), st.st_mode | S_IWUSR) == -1) throw SysError(format("making `%1%' writable") % path); } - for (Strings::iterator i = names.begin(); i != names.end(); ++i) - _deletePath(path + "/" + *i, bytesFreed); + for (auto & i : readDirectory(path)) + _deletePath(path + "/" + i.name, bytesFreed); } if (remove(path.c_str()) == -1) @@ -380,6 +397,9 @@ Paths createDirs(const Path & path) created.push_back(path); } + if (S_ISLNK(st.st_mode) && stat(path.c_str(), &st) == -1) + throw SysError(format("statting symlink `%1%'") % path); + if (!S_ISDIR(st.st_mode)) throw Error(format("`%1%' is not a directory") % path); return created; @@ -469,7 +489,10 @@ void warnOnce(bool & haveWarned, const FormatOrString & fs) void writeToStderr(const string & s) { try { - _writeToStderr((const unsigned char *) s.data(), s.size()); + if (_writeToStderr) + _writeToStderr((const unsigned char *) s.data(), s.size()); + else + writeFull(STDERR_FILENO, s); } catch (SysError & e) { /* Ignore failing writes to stderr if we're in an exception handler, otherwise throw an exception. We need to ignore @@ -481,13 +504,7 @@ void writeToStderr(const string & s) } -static void defaultWriteToStderr(const unsigned char * buf, size_t count) -{ - writeFull(STDERR_FILENO, buf, count); -} - - -void (*_writeToStderr) (const unsigned char * buf, size_t count) = defaultWriteToStderr; +void (*_writeToStderr) (const unsigned char * buf, size_t count) = 0; void readFull(int fd, unsigned char * buf, size_t count) @@ -521,6 +538,12 @@ void writeFull(int fd, const unsigned char * buf, size_t count) } +void writeFull(int fd, const string & s) +{ + writeFull(fd, (const unsigned char *) s.data(), s.size()); +} + + string drainFD(int fd) { string result; @@ -707,10 +730,14 @@ void AutoCloseDir::close() Pid::Pid() + : pid(-1), separatePG(false), killSignal(SIGKILL) +{ +} + + +Pid::Pid(pid_t pid) + : pid(pid), separatePG(false), killSignal(SIGKILL) { - pid = -1; - separatePG = false; - killSignal = SIGKILL; } @@ -734,11 +761,12 @@ Pid::operator pid_t() } -void Pid::kill() +void Pid::kill(bool quiet) { if (pid == -1 || pid == 0) return; - printMsg(lvlError, format("killing process %1%") % pid); + if (!quiet) + printMsg(lvlError, format("killing process %1%") % pid); /* Send the requested signal to the child. If it has its own process group, send the signal to every process in the child @@ -801,43 +829,30 @@ void killUser(uid_t uid) users to which the current process can send signals. So we fork a process, switch to uid, and send a mass kill. */ - Pid pid; - pid = fork(); - switch (pid) { - - case -1: - throw SysError("unable to fork"); - - case 0: - try { /* child */ + Pid pid = startProcess([&]() { - if (setuid(uid) == -1) - throw SysError("setting uid"); + if (setuid(uid) == -1) + throw SysError("setting uid"); - while (true) { + while (true) { #ifdef __APPLE__ - /* OSX's kill syscall takes a third parameter that, among other - things, determines if kill(-1, signo) affects the calling - process. In the OSX libc, it's set to true, which means - "follow POSIX", which we don't want here + /* OSX's kill syscall takes a third parameter that, among + other things, determines if kill(-1, signo) affects the + calling process. In the OSX libc, it's set to true, + which means "follow POSIX", which we don't want here */ - if (syscall(SYS_kill, -1, SIGKILL, false) == 0) break; + if (syscall(SYS_kill, -1, SIGKILL, false) == 0) break; #else - if (kill(-1, SIGKILL) == 0) break; + if (kill(-1, SIGKILL) == 0) break; #endif - if (errno == ESRCH) break; /* no more processes */ - if (errno != EINTR) - throw SysError(format("cannot kill processes for uid `%1%'") % uid); - } - - } catch (std::exception & e) { - writeToStderr((format("killing processes belonging to uid `%1%': %2%\n") % uid % e.what()).str()); - _exit(1); + if (errno == ESRCH) break; /* no more processes */ + if (errno != EINTR) + throw SysError(format("cannot kill processes for uid `%1%'") % uid); } + _exit(0); - } + }); - /* parent */ int status = pid.wait(true); if (status != 0) throw Error(format("cannot kill processes for uid `%1%': %2%") % uid % statusToString(status)); @@ -852,47 +867,69 @@ void killUser(uid_t uid) ////////////////////////////////////////////////////////////////////// +pid_t startProcess(std::function<void()> fun, + bool dieWithParent, const string & errorPrefix, bool runExitHandlers) +{ + pid_t pid = fork(); + if (pid == -1) throw SysError("unable to fork"); + + if (pid == 0) { + _writeToStderr = 0; + try { +#if __linux__ + if (dieWithParent && prctl(PR_SET_PDEATHSIG, SIGKILL) == -1) + throw SysError("setting death signal"); +#endif + restoreAffinity(); + fun(); + } catch (std::exception & e) { + try { + std::cerr << errorPrefix << e.what() << "\n"; + } catch (...) { } + } catch (...) { } + if (runExitHandlers) + exit(1); + else + _exit(1); + } + + return pid; +} + + +std::vector<const char *> stringsToCharPtrs(const Strings & ss) +{ + std::vector<const char *> res; + for (auto & s : ss) res.push_back(s.c_str()); + res.push_back(0); + return res; +} + + string runProgram(Path program, bool searchPath, const Strings & args) { checkInterrupt(); - std::vector<const char *> cargs; /* careful with c_str()! */ - cargs.push_back(program.c_str()); - for (Strings::const_iterator i = args.begin(); i != args.end(); ++i) - cargs.push_back(i->c_str()); - cargs.push_back(0); - /* Create a pipe. */ Pipe pipe; pipe.create(); /* Fork. */ - Pid pid; - pid = maybeVfork(); - - switch (pid) { - - case -1: - throw SysError("unable to fork"); - - case 0: /* child */ - try { - if (dup2(pipe.writeSide, STDOUT_FILENO) == -1) - throw SysError("dupping stdout"); + Pid pid = startProcess([&]() { + if (dup2(pipe.writeSide, STDOUT_FILENO) == -1) + throw SysError("dupping stdout"); - if (searchPath) - execvp(program.c_str(), (char * *) &cargs[0]); - else - execv(program.c_str(), (char * *) &cargs[0]); - throw SysError(format("executing `%1%'") % program); + Strings args_(args); + args_.push_front(program); + auto cargs = stringsToCharPtrs(args_); - } catch (std::exception & e) { - writeToStderr("error: " + string(e.what()) + "\n"); - } - _exit(1); - } + if (searchPath) + execvp(program.c_str(), (char * *) &cargs[0]); + else + execv(program.c_str(), (char * *) &cargs[0]); - /* Parent. */ + throw SysError(format("executing `%1%'") % program); + }); pipe.writeSide.close(); @@ -901,7 +938,7 @@ string runProgram(Path program, bool searchPath, const Strings & args) /* Wait for the child to finish. */ int status = pid.wait(true); if (!statusOk(status)) - throw Error(format("program `%1%' %2%") + throw ExecError(format("program `%1%' %2%") % program % statusToString(status)); return result; @@ -928,13 +965,6 @@ void closeOnExec(int fd) } -#if HAVE_VFORK -pid_t (*maybeVfork)() = vfork; -#else -pid_t (*maybeVfork)() = fork; -#endif - - ////////////////////////////////////////////////////////////////////// diff --git a/nix/libutil/util.hh b/nix/libutil/util.hh index ce2d77c19a..6a84ed8851 100644 --- a/nix/libutil/util.hh +++ b/nix/libutil/util.hh @@ -7,6 +7,7 @@ #include <dirent.h> #include <unistd.h> #include <signal.h> +#include <functional> #include <cstdio> @@ -63,7 +64,20 @@ bool isLink(const Path & path); /* Read the contents of a directory. The entries `.' and `..' are removed. */ -Strings readDirectory(const Path & path); +struct DirEntry +{ + string name; + ino_t ino; + unsigned char type; // one of DT_* + DirEntry(const string & name, ino_t ino, unsigned char type) + : name(name), ino(ino), type(type) { } +}; + +typedef vector<DirEntry> DirEntries; + +DirEntries readDirectory(const Path & path); + +unsigned char getFileType(const Path & path); /* Read the contents of a file into a string. */ string readFile(int fd); @@ -157,6 +171,7 @@ extern void (*_writeToStderr) (const unsigned char * buf, size_t count); requested number of bytes. */ void readFull(int fd, unsigned char * buf, size_t count); void writeFull(int fd, const unsigned char * buf, size_t count); +void writeFull(int fd, const string & s); MakeError(EndOfFile, Error) @@ -237,10 +252,11 @@ class Pid int killSignal; public: Pid(); + Pid(pid_t pid); ~Pid(); void operator =(pid_t pid); operator pid_t(); - void kill(); + void kill(bool quiet = false); int wait(bool block); void setSeparatePG(bool separatePG); void setKillSignal(int signal); @@ -252,11 +268,24 @@ public: void killUser(uid_t uid); +/* Fork a process that runs the given function, and return the child + pid to the caller. */ +pid_t startProcess(std::function<void()> fun, bool dieWithParent = true, + const string & errorPrefix = "error: ", bool runExitHandlers = false); + + /* Run a program and return its stdout in a string (i.e., like the shell backtick operator). */ string runProgram(Path program, bool searchPath = false, const Strings & args = Strings()); +MakeError(ExecError, Error) + +/* Convert a list of strings to a null-terminated vector of char + *'s. The result must not be accessed beyond the lifetime of the + list of strings. */ +std::vector<const char *> stringsToCharPtrs(const Strings & ss); + /* Close all file descriptors except stdin, stdout, stderr, and those listed in the given set. Good practice in child processes. */ void closeMostFDs(const set<int> & exceptions); @@ -264,9 +293,6 @@ void closeMostFDs(const set<int> & exceptions); /* Set the close-on-exec flag for the given file descriptor. */ void closeOnExec(int fd); -/* Call vfork() if available, otherwise fork(). */ -extern pid_t (*maybeVfork)(); - /* User interruption. */ diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc index f096ed5a97..1934487d24 100644 --- a/nix/nix-daemon/guix-daemon.cc +++ b/nix/nix-daemon/guix-daemon.cc @@ -33,6 +33,9 @@ #include <strings.h> #include <exception> +#include <libintl.h> +#include <locale.h> + /* Variables used by `nix-daemon.cc'. */ volatile ::sig_atomic_t blockInt; char **argvSaved; @@ -45,16 +48,21 @@ extern void run (Strings args); /* Command-line options. */ +#define n_(str) str +#define _(str) gettext (str) +static const char guix_textdomain[] = "guix"; + + const char *argp_program_version = "guix-daemon (" PACKAGE_NAME ") " PACKAGE_VERSION; const char *argp_program_bug_address = PACKAGE_BUGREPORT; static char doc[] = -"guix-daemon -- perform derivation builds and store accesses\ -\v\ -This program is a daemon meant to run in the background. It serves \ + n_("guix-daemon -- perform derivation builds and store accesses") + "\v\n" + n_("This program is a daemon meant to run in the background. It serves \ requests sent over a Unix-domain socket. It accesses the store, and \ -builds derivations on behalf of its clients."; +builds derivations on behalf of its clients."); #define GUIX_OPT_SYSTEM 1 #define GUIX_OPT_DISABLE_CHROOT 2 @@ -75,56 +83,59 @@ builds derivations on behalf of its clients."; static const struct argp_option options[] = { - { "system", GUIX_OPT_SYSTEM, "SYSTEM", 0, - "Assume SYSTEM as the current system type" }, - { "cores", 'c', "N", 0, - "Use N CPU cores to build each derivation; 0 means as many as available" }, - { "max-jobs", 'M', "N", 0, - "Allow at most N build jobs" }, + { "system", GUIX_OPT_SYSTEM, n_("SYSTEM"), 0, + n_("assume SYSTEM as the current system type") }, + { "cores", 'c', n_("N"), 0, + n_("use N CPU cores to build each derivation; 0 means as many as available") + }, + { "max-jobs", 'M', n_("N"), 0, + n_("allow at most N build jobs") }, { "disable-chroot", GUIX_OPT_DISABLE_CHROOT, 0, 0, - "Disable chroot builds" }, - { "chroot-directory", GUIX_OPT_CHROOT_DIR, "DIR", 0, - "Add DIR to the build chroot" }, - { "build-users-group", GUIX_OPT_BUILD_USERS_GROUP, "GROUP", 0, - "Perform builds as a user of GROUP" }, + n_("disable chroot builds") }, + { "chroot-directory", GUIX_OPT_CHROOT_DIR, n_("DIR"), 0, + n_("add DIR to the build chroot") }, + { "build-users-group", GUIX_OPT_BUILD_USERS_GROUP, n_("GROUP"), 0, + n_("perform builds as a user of GROUP") }, { "no-substitutes", GUIX_OPT_NO_SUBSTITUTES, 0, 0, - "Do not use substitutes" }, - { "substitute-urls", GUIX_OPT_SUBSTITUTE_URLS, "URLS", 0, - "Use URLS as the default list of substitute providers" }, + n_("do not use substitutes") }, + { "substitute-urls", GUIX_OPT_SUBSTITUTE_URLS, n_("URLS"), 0, + n_("use URLS as the default list of substitute providers") }, { "no-build-hook", GUIX_OPT_NO_BUILD_HOOK, 0, 0, - "Do not use the 'build hook'" }, + n_("do not use the 'build hook'") }, { "cache-failures", GUIX_OPT_CACHE_FAILURES, 0, 0, - "Cache build failures" }, + n_("cache build failures") }, { "lose-logs", GUIX_OPT_LOSE_LOGS, 0, 0, - "Do not keep build logs" }, + n_("do not keep build logs") }, { "disable-log-compression", GUIX_OPT_DISABLE_LOG_COMPRESSION, 0, 0, - "Disable compression of the build logs" }, + n_("disable compression of the build logs") }, /* '--disable-deduplication' was known as '--disable-store-optimization' up to Guix 0.7 included, so keep the alias around. */ { "disable-deduplication", GUIX_OPT_DISABLE_DEDUPLICATION, 0, 0, - "Disable automatic file \"deduplication\" in the store" }, + n_("disable automatic file \"deduplication\" in the store") }, { "disable-store-optimization", GUIX_OPT_DISABLE_DEDUPLICATION, 0, OPTION_ALIAS | OPTION_HIDDEN, NULL }, - { "impersonate-linux-2.6", GUIX_OPT_IMPERSONATE_LINUX_26, 0, 0, - "Impersonate Linux 2.6" -#ifndef HAVE_SYS_PERSONALITY_H - " (this option has no effect in this configuration)" + { "impersonate-linux-2.6", GUIX_OPT_IMPERSONATE_LINUX_26, 0, +#ifdef HAVE_SYS_PERSONALITY_H + 0, +#else + OPTION_HIDDEN, #endif + n_("impersonate Linux 2.6") }, { "gc-keep-outputs", GUIX_OPT_GC_KEEP_OUTPUTS, "yes/no", OPTION_ARG_OPTIONAL, - "Tell whether the GC must keep outputs of live derivations" }, + n_("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" }, + n_("tell whether the GC must keep derivations corresponding \ +to live outputs") }, - { "listen", GUIX_OPT_LISTEN, "SOCKET", 0, - "Listen for connections on SOCKET" }, + { "listen", GUIX_OPT_LISTEN, n_("SOCKET"), 0, + n_("listen for connections on SOCKET") }, { "debug", GUIX_OPT_DEBUG, 0, 0, - "Produce debugging output" }, + n_("produce debugging output") }, { 0, 0, 0, 0, 0 } }; @@ -154,8 +165,18 @@ parse_opt (int key, char *arg, struct argp_state *state) settings.useChroot = false; break; case GUIX_OPT_CHROOT_DIR: - settings.dirsInChroot.insert (arg); - break; + { + std::string chroot_dirs; + + chroot_dirs = settings.get ("build-extra-chroot-dirs", + (std::string) ""); + if (chroot_dirs == "") + chroot_dirs = arg; + else + chroot_dirs = chroot_dirs + " " + arg; + settings.set("build-extra-chroot-dirs", chroot_dirs); + break; + } case GUIX_OPT_DISABLE_LOG_COMPRESSION: settings.compressLog = false; break; @@ -181,7 +202,7 @@ parse_opt (int key, char *arg, struct argp_state *state) } catch (std::exception &e) { - fprintf (stderr, "error: %s\n", e.what ()); + fprintf (stderr, _("error: %s\n"), e.what ()); exit (EXIT_FAILURE); } break; @@ -220,19 +241,29 @@ parse_opt (int key, char *arg, struct argp_state *state) } /* Argument parsing. */ -static struct argp argp = { options, parse_opt, 0, doc }; +static const struct argp argp = + { + options, parse_opt, + NULL, doc, + NULL, NULL, // children and help_filter + guix_textdomain + }; int main (int argc, char *argv[]) { - Strings nothing; + static const Strings nothing; + + setlocale (LC_ALL, ""); + bindtextdomain (guix_textdomain, LOCALEDIR); + textdomain (guix_textdomain); /* Initialize libgcrypt. */ if (!gcry_check_version (GCRYPT_VERSION)) { - fprintf (stderr, "error: libgcrypt version mismatch\n"); + fprintf (stderr, _("error: libgcrypt version mismatch\n")); exit (EXIT_FAILURE); } @@ -323,16 +354,17 @@ main (int argc, char *argv[]) settings.update (); if (geteuid () == 0 && settings.buildUsersGroup.empty ()) - fprintf (stderr, "warning: daemon is running as root, so " - "using `--build-users-group' is highly recommended\n"); + fprintf (stderr, _("warning: daemon is running as root, so \ +using `--build-users-group' is highly recommended\n")); if (settings.useChroot) { - foreach (PathSet::iterator, i, settings.dirsInChroot) - { - printMsg (lvlDebug, - format ("directory `%1%' added to the chroot") % *i); - } + std::string chroot_dirs; + + chroot_dirs = settings.get ("build-extra-chroot-dirs", + (std::string) ""); + printMsg (lvlDebug, + format ("extra chroot directories: '%1%'") % chroot_dirs); } printMsg (lvlDebug, @@ -346,7 +378,7 @@ main (int argc, char *argv[]) } catch (std::exception &e) { - fprintf (stderr, "error: %s\n", e.what ()); + fprintf (stderr, _("error: %s\n"), e.what ()); return EXIT_FAILURE; } diff --git a/nix/nix-daemon/nix-daemon.cc b/nix/nix-daemon/nix-daemon.cc index 8814fe3155..10159db62e 100644 --- a/nix/nix-daemon/nix-daemon.cc +++ b/nix/nix-daemon/nix-daemon.cc @@ -7,6 +7,8 @@ #include "affinity.hh" #include "globals.hh" +#include <algorithm> + #include <cstring> #include <unistd.h> #include <signal.h> @@ -17,6 +19,8 @@ #include <sys/un.h> #include <fcntl.h> #include <errno.h> +#include <pwd.h> +#include <grp.h> using namespace nix; @@ -44,7 +48,6 @@ static FdSource from(STDIN_FILENO); static FdSink to(STDOUT_FILENO); bool canSendStderr; -pid_t myPid; @@ -54,11 +57,7 @@ pid_t myPid; socket. */ static void tunnelStderr(const unsigned char * buf, size_t count) { - /* Don't send the message to the client if we're a child of the - process handling the connection. Otherwise we could screw up - the protocol. It's up to the parent to redirect stderr and - send it to the client somehow (e.g., as in build.cc). */ - if (canSendStderr && myPid == getpid()) { + if (canSendStderr) { try { writeInt(STDERR_NEXT, to); writeString(buf, count, to); @@ -284,15 +283,6 @@ static void performOp(bool trusted, unsigned int clientVersion, { switch (op) { -#if 0 - case wopQuit: { - /* Close the database. */ - store.reset((StoreAPI *) 0); - writeInt(1, to); - break; - } -#endif - case wopIsValidPath: { /* 'readStorePath' could raise an error leading to the connection being closed. To be able to recover from an invalid path error, @@ -450,6 +440,9 @@ static void performOp(bool trusted, unsigned int clientVersion, case wopImportPaths: { startWork(); TunnelSource source(from); + + /* Unlike Nix, always require a signature, even for "trusted" + users. */ Paths paths = store->importPaths(true, source); stopWork(); writeStrings(paths, to); @@ -650,6 +643,25 @@ static void performOp(bool trusted, unsigned int clientVersion, break; } + case wopOptimiseStore: + startWork(); + store->optimiseStore(); + stopWork(); + writeInt(1, to); + break; + + case wopVerifyStore: { + bool checkContents = readInt(from) != 0; + bool repair = readInt(from) != 0; + startWork(); + if (repair && !trusted) + throw Error("you are not privileged to repair paths"); + bool errors = store->verifyStore(checkContents, repair); + stopWork(); + writeInt(errors, to); + break; + } + default: throw Error(format("invalid operation %1%") % op); } @@ -659,7 +671,6 @@ static void performOp(bool trusted, unsigned int clientVersion, static void processConnection(bool trusted) { canSendStderr = false; - myPid = getpid(); _writeToStderr = tunnelStderr; #ifdef HAVE_HUP_NOTIFICATION @@ -708,7 +719,7 @@ static void processConnection(bool trusted) to.flush(); } catch (Error & e) { - stopWork(false, e.msg()); + stopWork(false, e.msg(), GET_PROTOCOL_MINOR(clientVersion) >= 8 ? 1 : 0); to.flush(); return; } @@ -735,12 +746,10 @@ static void processConnection(bool trusted) during addTextToStore() / importPath(). If that happens, just send the error message and exit. */ bool errorAllowed = canSendStderr; - if (!errorAllowed) printMsg(lvlError, format("error processing client input: %1%") % e.msg()); stopWork(false, e.msg(), GET_PROTOCOL_MINOR(clientVersion) >= 8 ? e.status : 0); - if (!errorAllowed) break; + if (!errorAllowed) throw; } catch (std::bad_alloc & e) { - if (canSendStderr) - stopWork(false, "Nix daemon out of memory", GET_PROTOCOL_MINOR(clientVersion) >= 8 ? 1 : 0); + stopWork(false, "Nix daemon out of memory", GET_PROTOCOL_MINOR(clientVersion) >= 8 ? 1 : 0); throw; } @@ -749,7 +758,9 @@ static void processConnection(bool trusted) assert(!canSendStderr); }; - printMsg(lvlError, format("%1% operations") % opCount); + canSendStderr = false; + _isInterrupted = false; + printMsg(lvlDebug, format("%1% operations") % opCount); } @@ -771,11 +782,35 @@ static void setSigChldAction(bool autoReap) } +bool matchUser(const string & user, const string & group, const Strings & users) +{ + if (find(users.begin(), users.end(), "*") != users.end()) + return true; + + if (find(users.begin(), users.end(), user) != users.end()) + return true; + + for (auto & i : users) + if (string(i, 0, 1) == "@") { + if (group == string(i, 1)) return true; + struct group * gr = getgrnam(i.c_str() + 1); + if (!gr) continue; + for (char * * mem = gr->gr_mem; *mem; mem++) + if (user == string(*mem)) return true; + } + + return false; +} + + #define SD_LISTEN_FDS_START 3 static void daemonLoop() { + if (chdir("/") == -1) + throw SysError("cannot change current directory"); + /* Get rid of children automatically; don't let them become zombies. */ setSigChldAction(true); @@ -804,7 +839,8 @@ static void daemonLoop() /* Urgh, sockaddr_un allows path names of only 108 characters. So chdir to the socket directory so that we can pass a relative path name. */ - chdir(dirOf(socketPath).c_str()); + if (chdir(dirOf(socketPath).c_str()) == -1) + throw SysError("cannot change current directory"); Path socketPathRel = "./" + baseNameOf(socketPath); struct sockaddr_un addr; @@ -824,7 +860,8 @@ static void daemonLoop() if (res == -1) throw SysError(format("cannot bind to socket `%1%'") % socketPath); - chdir("/"); /* back to the root */ + if (chdir("/") == -1) /* back to the root */ + throw SysError("cannot change current directory"); if (listen(fdSocket, 5) == -1) throw SysError(format("cannot listen on socket `%1%'") % socketPath); @@ -856,58 +893,61 @@ static void daemonLoop() closeOnExec(remote); - /* Get the identity of the caller, if possible. */ - uid_t clientUid = -1; - pid_t clientPid = -1; bool trusted = false; + pid_t clientPid = -1; #if defined(SO_PEERCRED) + /* Get the identity of the caller, if possible. */ ucred cred; socklen_t credLen = sizeof(cred); - if (getsockopt(remote, SOL_SOCKET, SO_PEERCRED, &cred, &credLen) != -1) { - clientPid = cred.pid; - clientUid = cred.uid; - if (clientUid == 0) trusted = true; - } -#endif + if (getsockopt(remote, SOL_SOCKET, SO_PEERCRED, &cred, &credLen) == -1) + throw SysError("getting peer credentials"); - printMsg(lvlInfo, format("accepted connection from pid %1%, uid %2%") % clientPid % clientUid); + clientPid = cred.pid; - /* Fork a child to handle the connection. */ - pid_t child; - child = fork(); + struct passwd * pw = getpwuid(cred.uid); + string user = pw ? pw->pw_name : int2String(cred.uid); - switch (child) { + struct group * gr = getgrgid(cred.gid); + string group = gr ? gr->gr_name : int2String(cred.gid); - case -1: - throw SysError("unable to fork"); + Strings trustedUsers = settings.get("trusted-users", Strings({"root"})); + Strings allowedUsers = settings.get("allowed-users", Strings({"*"})); - case 0: - try { /* child */ + if (matchUser(user, group, trustedUsers)) + trusted = true; - /* Background the daemon. */ - if (setsid() == -1) - throw SysError(format("creating a new session")); + if (!trusted && !matchUser(user, group, allowedUsers)) + throw Error(format("user `%1%' is not allowed to connect to the Nix daemon") % user); - /* Restore normal handling of SIGCHLD. */ - setSigChldAction(false); + printMsg(lvlInfo, format((string) "accepted connection from pid %1%, user %2%" + + (trusted ? " (trusted)" : "")) % clientPid % user); +#endif - /* For debugging, stuff the pid into argv[1]. */ - if (clientPid != -1 && argvSaved[1]) { - string processName = int2String(clientPid); - strncpy(argvSaved[1], processName.c_str(), strlen(argvSaved[1])); - } + /* Fork a child to handle the connection. */ + startProcess([&]() { + fdSocket.close(); - /* Handle the connection. */ - from.fd = remote; - to.fd = remote; - processConnection(trusted); + /* Background the daemon. */ + if (setsid() == -1) + throw SysError(format("creating a new session")); - } catch (std::exception & e) { - writeToStderr("unexpected Nix daemon error: " + string(e.what()) + "\n"); + /* Restore normal handling of SIGCHLD. */ + setSigChldAction(false); + + /* For debugging, stuff the pid into argv[1]. */ + if (clientPid != -1 && argvSaved[1]) { + string processName = int2String(clientPid); + strncpy(argvSaved[1], processName.c_str(), strlen(argvSaved[1])); } + + /* Handle the connection. */ + from.fd = remote; + to.fd = remote; + processConnection(trusted); + exit(0); - } + }, false, "unexpected Nix daemon error: ", true); } catch (Interrupted & e) { throw; @@ -925,7 +965,6 @@ void run(Strings args) if (arg == "--daemon") /* ignored for backwards compatibility */; } - chdir("/"); daemonLoop(); } diff --git a/po/guix/Makevars b/po/guix/Makevars index 9c5965a136..8ec7d8aed6 100644 --- a/po/guix/Makevars +++ b/po/guix/Makevars @@ -6,12 +6,14 @@ subdir = po/guix top_builddir = ../.. # These options get passed to xgettext. We want to catch standard -# gettext uses, and SRFI-35 error condition messages. +# gettext uses, and SRFI-35 error condition messages. In C++ code +# we use 'n_' instead of the more usual 'N_' for no-ops. XGETTEXT_OPTIONS = \ - --language=Scheme --from-code=UTF-8 \ + --from-code=UTF-8 \ --keyword=_ --keyword=N_:1,2 \ --keyword=message \ - --keyword=description + --keyword=description \ + --keyword=n_ COPYRIGHT_HOLDER = Ludovic Courtès diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 30ce28b712..4f27f54d6c 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -3,6 +3,7 @@ gnu/packages.scm gnu/system.scm gnu/services/dmd.scm +gnu/system/shadow.scm guix/scripts/build.scm guix/scripts/download.scm guix/scripts/package.scm @@ -19,3 +20,4 @@ guix/gnu-maintenance.scm guix/ui.scm guix/http-client.scm guix/nar.scm +nix/nix-daemon/guix-daemon.cc diff --git a/po/guix/da.po b/po/guix/da.po index 3e0c84caf1..2274ebff57 100644 --- a/po/guix/da.po +++ b/po/guix/da.po @@ -7,10 +7,10 @@ # msgid "" msgstr "" -"Project-Id-Version: guix 0.8.1\n" +"Project-Id-Version: guix 0.8.2\n" "Report-Msgid-Bugs-To: ludo@gnu.org\n" -"POT-Creation-Date: 2015-01-26 23:51+0100\n" -"PO-Revision-Date: 2015-04-06 19:30+01:00\n" +"POT-Creation-Date: 2015-05-10 14:02+0200\n" +"PO-Revision-Date: 2015-05-14 19:30+01:00\n" "Last-Translator: Joe Hansen <joedalton2@yahoo.dk>\n" "Language-Team: Danish <dansk@dansk-gruppen.dk>\n" "Language: da\n" @@ -34,40 +34,45 @@ msgstr "kunne ikke finde bootstraps binære »~a« for system »~a«" msgid "cannot access `~a': ~a~%" msgstr "kan ikke tilgå »~a«: ~a~%" -#: gnu/packages.scm:372 +#: gnu/packages.scm:382 #, scheme-format msgid "looking for the latest release of GNU ~a..." msgstr "kigger efter den seneste udgivelse af GNU ~a..." -#: gnu/packages.scm:379 +#: gnu/packages.scm:389 #, scheme-format msgid "~a: note: using ~a but ~a is available upstream~%" msgstr "~a: bemærk: bruger ~a men ~a er tilgængelig opstrøm~%" -#: gnu/packages.scm:401 guix/scripts/package.scm:306 +#: gnu/packages.scm:411 guix/scripts/package.scm:350 #, scheme-format msgid "ambiguous package specification `~a'~%" msgstr "tvetydig pakkespecifikation »~a«~%" -#: gnu/packages.scm:402 guix/scripts/package.scm:308 +#: gnu/packages.scm:412 guix/scripts/package.scm:352 #, scheme-format msgid "choosing ~a from ~a~%" msgstr "vælger ~a fra ~a~%" -#: gnu/packages.scm:408 +#: gnu/packages.scm:418 #, scheme-format msgid "~A: package not found for version ~a~%" msgstr "~A: pakke ikke fundet for version ~a~%" -#: gnu/packages.scm:410 +#: gnu/packages.scm:420 #, scheme-format msgid "~A: unknown package~%" msgstr "~A: ukendt pakke~%" -#: gnu/system.scm:716 +#: gnu/system.scm:811 msgid "system locale lacks a definition" msgstr "systemsprog mangler en definition" +#: gnu/services/dmd.scm:51 +#, scheme-format +msgid "service '~a' provided more than once" +msgstr "tjeneste »~a« tilbudt mere end en gang" + #: guix/scripts/build.scm:65 #, scheme-format msgid "failed to create GC root `~a': ~a~%" @@ -196,12 +201,22 @@ msgstr "" #: guix/scripts/build.scm:230 msgid "" "\n" +" --sources[=TYPE] build source derivations; TYPE may optionally be one\n" +" of \"package\", \"all\" (default), or \"transitive\"" +msgstr "" +"\n" +" --sources[=TYPE] bygningskildeafledninger; TYPE kan valgfrit være\n" +" »package«, »all« (standard) eller »transitive«" + +#: guix/scripts/build.scm:233 +msgid "" +"\n" " -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"" msgstr "" "\n" " -s, --system=SYSTEM forsøger at bygge for SYSTEM--f.eks., »i686-linux«" -#: guix/scripts/build.scm:232 +#: guix/scripts/build.scm:235 msgid "" "\n" " --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"" @@ -209,7 +224,7 @@ msgstr "" "\n" " --target=TRIPLET krydsbyg for TRIPLET--f.eks., »armel-linux-gnu«" -#: guix/scripts/build.scm:234 +#: guix/scripts/build.scm:237 msgid "" "\n" " --with-source=SOURCE\n" @@ -219,7 +234,7 @@ msgstr "" " --with-source=KILDE\n" " brug KILDE når den tilsvarende pakke bygges" -#: guix/scripts/build.scm:237 +#: guix/scripts/build.scm:240 msgid "" "\n" " --no-grafts do not graft packages" @@ -227,7 +242,7 @@ msgstr "" "\n" " --no-grafts pod ikke pakker" -#: guix/scripts/build.scm:239 +#: guix/scripts/build.scm:242 msgid "" "\n" " -d, --derivations return the derivation paths of the given packages" @@ -235,7 +250,7 @@ msgstr "" "\n" " -d, --derivations returner de afledte stier for de givne pakker" -#: guix/scripts/build.scm:241 +#: guix/scripts/build.scm:244 msgid "" "\n" " -r, --root=FILE make FILE a symlink to the result, and register it\n" @@ -245,7 +260,7 @@ msgstr "" " -r, --root=FIL gør FIL til en symbolsk henvisning for resultatet, og\n" " registrer den som en affaldsindsamlerroot" -#: guix/scripts/build.scm:244 +#: guix/scripts/build.scm:247 msgid "" "\n" " --log-file return the log file names for the given derivations" @@ -253,11 +268,12 @@ msgstr "" "\n" " --log-file returner logfilnavnen for de givne afledninger" -#: guix/scripts/build.scm:249 guix/scripts/download.scm:53 -#: guix/scripts/package.scm:467 guix/scripts/gc.scm:58 -#: guix/scripts/hash.scm:55 guix/scripts/pull.scm:81 -#: guix/scripts/substitute-binary.scm:566 guix/scripts/system.scm:414 -#: guix/scripts/lint.scm:469 +#: guix/scripts/build.scm:252 guix/scripts/download.scm:53 +#: guix/scripts/package.scm:464 guix/scripts/gc.scm:58 +#: guix/scripts/hash.scm:55 guix/scripts/import.scm:90 +#: guix/scripts/pull.scm:81 guix/scripts/substitute.scm:682 +#: guix/scripts/system.scm:400 guix/scripts/lint.scm:534 +#: guix/scripts/publish.scm:56 msgid "" "\n" " -h, --help display this help and exit" @@ -265,11 +281,12 @@ msgstr "" "\n" " -h, --help vis denne hjælpetekst og afslut" -#: guix/scripts/build.scm:251 guix/scripts/download.scm:55 -#: guix/scripts/package.scm:469 guix/scripts/gc.scm:60 -#: guix/scripts/hash.scm:57 guix/scripts/pull.scm:83 -#: guix/scripts/substitute-binary.scm:568 guix/scripts/system.scm:416 -#: guix/scripts/lint.scm:473 +#: guix/scripts/build.scm:254 guix/scripts/download.scm:55 +#: guix/scripts/package.scm:466 guix/scripts/gc.scm:60 +#: guix/scripts/hash.scm:57 guix/scripts/import.scm:92 +#: guix/scripts/pull.scm:83 guix/scripts/substitute.scm:684 +#: guix/scripts/system.scm:402 guix/scripts/lint.scm:538 +#: guix/scripts/publish.scm:58 msgid "" "\n" " -V, --version display version information and exit" @@ -277,20 +294,21 @@ msgstr "" "\n" " -V, --version vis versioninformation og afslut" -#: guix/scripts/build.scm:383 +#: guix/scripts/build.scm:281 #, scheme-format -msgid "sources do not match any package:~{ ~a~}~%" -msgstr "kilder matcher ikke nogen pakke:~{ ~a~}~%" +msgid "" +"invalid argument: '~a' option argument: ~a, ~\n" +"must be one of 'package', 'all', or 'transitive'~%" +msgstr "" +"ugyldigt argument: »~a« tilvalgsargumentet: ~a, ~\n" +"skal være »package«, »all« eller »transitive«~%" -#: guix/scripts/build.scm:417 guix/scripts/download.scm:96 -#: guix/scripts/package.scm:694 guix/scripts/gc.scm:122 -#: guix/scripts/pull.scm:213 guix/scripts/system.scm:499 -#: guix/scripts/lint.scm:521 +#: guix/scripts/build.scm:404 #, scheme-format -msgid "~A: unrecognized option~%" -msgstr "~A: ikke genkendt tilvalg~%" +msgid "sources do not match any package:~{ ~a~}~%" +msgstr "kilder matcher ikke nogen pakke:~{ ~a~}~%" -#: guix/scripts/build.scm:445 +#: guix/scripts/build.scm:453 #, scheme-format msgid "no build log for '~a'~%" msgstr "ingen byggelog for »~a«~%" @@ -324,6 +342,13 @@ msgstr "" msgid "unsupported hash format: ~a~%" msgstr "ikke understøttet hash-format: ~a~%" +#: guix/scripts/download.scm:96 guix/scripts/gc.scm:122 +#: guix/scripts/pull.scm:217 guix/scripts/lint.scm:585 +#: guix/scripts/publish.scm:233 guix/ui.scm:829 +#, scheme-format +msgid "~A: unrecognized option~%" +msgstr "~A: ikke genkendt tilvalg~%" + #: guix/scripts/download.scm:106 #, scheme-format msgid "~a: failed to parse URI~%" @@ -334,42 +359,57 @@ msgstr "~a: kunne ikke fortolke URI~%" msgid "~a: download failed~%" msgstr "~a: overførsel mislykkede~%" -#: guix/scripts/package.scm:98 +#: guix/scripts/package.scm:108 #, scheme-format msgid "failed to build the empty profile~%" msgstr "kunne ikke bygge den tomme profil~%" -#: guix/scripts/package.scm:114 +#: guix/scripts/package.scm:124 #, scheme-format msgid "switching from generation ~a to ~a~%" msgstr "skifter fra generation ~a til ~a~%" -#: guix/scripts/package.scm:133 +#: guix/scripts/package.scm:143 #, scheme-format msgid "nothing to do: already at the empty profile~%" msgstr "intet at udføre: allerede en tom profil~%" -#: guix/scripts/package.scm:145 +#: guix/scripts/package.scm:155 #, scheme-format msgid "deleting ~a~%" msgstr "sletter ~a~%" -#: guix/scripts/package.scm:296 +#: guix/scripts/package.scm:268 +#, scheme-format +msgid "not removing generation ~a, which is current~%" +msgstr "fjerner ikke generation ~a, som er nuværende~%" + +#: guix/scripts/package.scm:275 +#, scheme-format +msgid "no matching generation~%" +msgstr "ingen matchende generation~%" + +#: guix/scripts/package.scm:278 guix/scripts/package.scm:917 +#, scheme-format +msgid "invalid syntax: ~a~%" +msgstr "ugyldig syntaks: ~a~%" + +#: guix/scripts/package.scm:340 #, scheme-format msgid "package `~a' lacks output `~a'~%" msgstr "pakke »~a« mangler uddata »~a«~%" -#: guix/scripts/package.scm:313 +#: guix/scripts/package.scm:357 #, scheme-format msgid "~a: package not found~%" msgstr "~a: pakken blev ikke fundet~%" -#: guix/scripts/package.scm:406 +#: guix/scripts/package.scm:401 #, scheme-format msgid "The following environment variable definitions may be needed:~%" msgstr "De følgende miljøvariabeldefinitioner kan være krævet:~%" -#: guix/scripts/package.scm:422 +#: guix/scripts/package.scm:417 msgid "" "Usage: guix package [OPTION]... PACKAGES...\n" "Install, remove, or upgrade PACKAGES in a single transaction.\n" @@ -377,7 +417,7 @@ msgstr "" "Brug: guix-pakke [TILVALG]... PAKKER...\n" "Installer, fjern eller opgrader PAKKER i en enkel transaktion.\n" -#: guix/scripts/package.scm:424 +#: guix/scripts/package.scm:419 msgid "" "\n" " -i, --install=PACKAGE install PACKAGE" @@ -385,7 +425,7 @@ msgstr "" "\n" " -i, --install=PAKKE installer PAKKE" -#: guix/scripts/package.scm:426 +#: guix/scripts/package.scm:421 msgid "" "\n" " -e, --install-from-expression=EXP\n" @@ -395,7 +435,7 @@ msgstr "" " -e, --install-from-expression=UDTRYK\n" " installer pakken UDTRYK evaluerer til" -#: guix/scripts/package.scm:429 +#: guix/scripts/package.scm:424 msgid "" "\n" " -r, --remove=PACKAGE remove PACKAGE" @@ -403,7 +443,7 @@ msgstr "" "\n" " -r, --remove=PAKKE fjern PAKKE" -#: guix/scripts/package.scm:431 +#: guix/scripts/package.scm:426 msgid "" "\n" " -u, --upgrade[=REGEXP] upgrade all the installed packages matching REGEXP" @@ -413,7 +453,15 @@ msgstr "" " opgrader alle de installerede pakker der matcher\n" " REGUDTRYK" -#: guix/scripts/package.scm:433 +#: guix/scripts/package.scm:428 +msgid "" +"\n" +" --do-not-upgrade[=REGEXP] do not upgrade any packages matching REGEXP" +msgstr "" +"\n" +" --do-not--upgrade[=REGUDTRYK] opgrader ikke pakker der matcher REGUDTRYK" + +#: guix/scripts/package.scm:430 msgid "" "\n" " --roll-back roll back to the previous generation" @@ -421,7 +469,7 @@ msgstr "" "\n" " --roll-back rul tilbage til den forrige generation" -#: guix/scripts/package.scm:435 +#: guix/scripts/package.scm:432 msgid "" "\n" " --search-paths display needed environment variable definitions" @@ -429,7 +477,7 @@ msgstr "" "\n" " --search-paths vis krævede miljøvariabeldefinitioner" -#: guix/scripts/package.scm:437 +#: guix/scripts/package.scm:434 msgid "" "\n" " -l, --list-generations[=PATTERN]\n" @@ -439,7 +487,7 @@ msgstr "" " -l, --list-generations[=MØNSTER]\n" " vis generationer der matcher MØNSTER" -#: guix/scripts/package.scm:440 +#: guix/scripts/package.scm:437 msgid "" "\n" " -d, --delete-generations[=PATTERN]\n" @@ -449,7 +497,7 @@ msgstr "" " -d, --delete-generations[=MØNSTER]\n" " slet generationer der matcher MØNSTER" -#: guix/scripts/package.scm:443 +#: guix/scripts/package.scm:440 msgid "" "\n" " -S, --switch-generation=PATTERN\n" @@ -459,7 +507,7 @@ msgstr "" " -S, --switch-generation=MØNSTER\n" " skift til et generationsmatchende MØNSTER" -#: guix/scripts/package.scm:446 +#: guix/scripts/package.scm:443 msgid "" "\n" " -p, --profile=PROFILE use PROFILE instead of the user's default profile" @@ -467,7 +515,7 @@ msgstr "" "\n" " -p, --profile=PROFIL brug PROFIL i stedet for brugerens standardprofil" -#: guix/scripts/package.scm:449 +#: guix/scripts/package.scm:446 msgid "" "\n" " --bootstrap use the bootstrap Guile to build the profile" @@ -475,7 +523,7 @@ msgstr "" "\n" " --bootstrap brug bootstrap Guile til at bygge profilen" -#: guix/scripts/package.scm:451 guix/scripts/pull.scm:74 +#: guix/scripts/package.scm:448 guix/scripts/pull.scm:74 msgid "" "\n" " --verbose produce verbose output" @@ -483,7 +531,7 @@ msgstr "" "\n" " --verbose lav uddybende uddata" -#: guix/scripts/package.scm:454 +#: guix/scripts/package.scm:451 msgid "" "\n" " -s, --search=REGEXP search in synopsis and description using REGEXP" @@ -491,7 +539,7 @@ msgstr "" "\n" " -s, --search=REGUDTRYK søg i synopsis og beskrivelse via REGUDTRYK" -#: guix/scripts/package.scm:456 +#: guix/scripts/package.scm:453 msgid "" "\n" " -I, --list-installed[=REGEXP]\n" @@ -501,7 +549,7 @@ msgstr "" " -I, --list-installed[=REGUDTRYK]\n" " vis installerede pakker der matcher REGUDTRYK" -#: guix/scripts/package.scm:459 +#: guix/scripts/package.scm:456 msgid "" "\n" " -A, --list-available[=REGEXP]\n" @@ -511,7 +559,7 @@ msgstr "" " -A, --list-available[=REGUDTRYK]\n" " vis tilgængelige pakker der matcher REGUDTRYK" -#: guix/scripts/package.scm:462 +#: guix/scripts/package.scm:459 msgid "" "\n" " --show=PACKAGE show details about PACKAGE" @@ -519,64 +567,59 @@ msgstr "" "\n" " --show=PACKAGE vis detaljer om PAKKE" -#: guix/scripts/package.scm:698 +#: guix/scripts/package.scm:730 #, scheme-format msgid "~A: extraneous argument~%" msgstr "~A: uvedkommende argument~%" -#: guix/scripts/package.scm:708 +#: guix/scripts/package.scm:738 #, scheme-format msgid "Try \"info '(guix) Invoking guix package'\" for more information.~%" msgstr "Prøv »info '(guix) Invoking guix package« for yderligere information.~%" -#: guix/scripts/package.scm:730 +#: guix/scripts/package.scm:760 #, scheme-format msgid "error: while creating directory `~a': ~a~%" msgstr "fejl: under oprettelse af mappe »~a«: ~a~%" -#: guix/scripts/package.scm:734 +#: guix/scripts/package.scm:764 #, scheme-format msgid "Please create the `~a' directory, with you as the owner.~%" msgstr "Opret venligst mappen »~a«, med dig som ejer.~%" -#: guix/scripts/package.scm:741 +#: guix/scripts/package.scm:771 #, scheme-format msgid "error: directory `~a' is not owned by you~%" msgstr "fejl: mappen »~a« er ikke ejet af dig~%" -#: guix/scripts/package.scm:744 +#: guix/scripts/package.scm:774 #, scheme-format msgid "Please change the owner of `~a' to user ~s.~%" msgstr "Ændr venligst ejeren af »~a« til brugeren ~s.~%" -#: guix/scripts/package.scm:777 +#: guix/scripts/package.scm:804 #, scheme-format msgid "cannot switch to generation '~a'~%" msgstr "kan ikke skifte til generation »~a«~%" -#: guix/scripts/package.scm:809 guix/scripts/package.scm:910 -#, scheme-format -msgid "invalid syntax: ~a~%" -msgstr "ugyldig syntaks: ~a~%" - -#: guix/scripts/package.scm:846 +#: guix/scripts/package.scm:852 #, scheme-format msgid "nothing to be done~%" msgstr "intet at udføre~%" -#: guix/scripts/package.scm:861 +#: guix/scripts/package.scm:868 #, scheme-format msgid "~a package in profile~%" msgid_plural "~a packages in profile~%" msgstr[0] "~a pakke i profil~%" msgstr[1] "~a pakker i profil~%" -#: guix/scripts/package.scm:876 +#: guix/scripts/package.scm:883 #, scheme-format msgid "Generation ~a\t~a" msgstr "Generation ~a\t~a" -#: guix/scripts/package.scm:883 +#: guix/scripts/package.scm:890 #, scheme-format msgid "~a\t(current)~%" msgstr "~a\t(nuværende)~%" @@ -679,7 +722,7 @@ msgstr "" msgid "unrecognized option: ~a~%" msgstr "tilvalg blev ikke genkendt: ~a~%" -#: guix/scripts/hash.scm:134 guix/ui.scm:258 +#: guix/scripts/hash.scm:134 guix/ui.scm:318 #, scheme-format msgid "~a~%" msgstr "~a~%" @@ -689,6 +732,28 @@ msgstr "~a~%" msgid "wrong number of arguments~%" msgstr "forkert antal argumenter~%" +#: guix/scripts/import.scm:85 +msgid "" +"Usage: guix import IMPORTER ARGS ...\n" +"Run IMPORTER with ARGS.\n" +msgstr "" +"Brug: guix import IMPORTER ARG ...\n" +"Kør IMPORTER med ARG.\n" + +#: guix/scripts/import.scm:88 +msgid "IMPORTER must be one of the importers listed below:\n" +msgstr "IMPORTER skal være en af importørerne vist nedenfor:\n" + +#: guix/scripts/import.scm:101 +#, scheme-format +msgid "guix import: missing importer name~%" +msgstr "guix import: mangler importørnavn~%" + +#: guix/scripts/import.scm:112 +#, scheme-format +msgid "guix import: invalid importer~%" +msgstr "guix import: ugyldig importør~%" + #: guix/scripts/pull.scm:72 msgid "" "Usage: guix pull [OPTION]...\n" @@ -726,123 +791,123 @@ msgstr "udpakker »~a«...~%" msgid "failed to unpack source code" msgstr "kunne ikke udpakke kildekode" -#: guix/scripts/pull.scm:200 +#: guix/scripts/pull.scm:202 +msgid "Guix already up to date\n" +msgstr "Guix er allerede opdateret\n" + +#: guix/scripts/pull.scm:207 #, scheme-format msgid "updated ~a successfully deployed under `~a'~%" msgstr "opdaterede ~a der med succes blev udrullet undet »~a«~%" -#: guix/scripts/pull.scm:203 +#: guix/scripts/pull.scm:210 #, scheme-format msgid "failed to update Guix, check the build log~%" msgstr "kunne ikke opdatere Guix, kontroller byggeloggen~%" -#: guix/scripts/pull.scm:205 -msgid "Guix already up to date\n" -msgstr "Guix er allerede opdateret\n" - -#: guix/scripts/pull.scm:215 +#: guix/scripts/pull.scm:219 #, scheme-format msgid "~A: unexpected argument~%" msgstr "~A: uventet argument~%" -#: guix/scripts/pull.scm:224 +#: guix/scripts/pull.scm:228 msgid "failed to download up-to-date source, exiting\n" msgstr "kunne ikke hente opdateret kilde, afslutter\n" -#: guix/scripts/substitute-binary.scm:80 +#: guix/scripts/substitute.scm:81 #, scheme-format msgid "authentication and authorization of substitutes disabled!~%" msgstr "godkendelse og autorisation af substitutter er deaktiveret!~%" -#: guix/scripts/substitute-binary.scm:163 +#: guix/scripts/substitute.scm:157 #, scheme-format msgid "download from '~a' failed: ~a, ~s~%" msgstr "hent fra »~a« mislykkedes: ~a, ~s~%" -#: guix/scripts/substitute-binary.scm:178 +#: guix/scripts/substitute.scm:169 #, scheme-format msgid "while fetching ~a: server is somewhat slow~%" msgstr "under overførsel af ~a: server er noget langsom~%" -#: guix/scripts/substitute-binary.scm:180 +#: guix/scripts/substitute.scm:171 #, scheme-format msgid "try `--no-substitutes' if the problem persists~%" msgstr "prøv »--no-substitutes« hvis problemet fortsætter~%" -#: guix/scripts/substitute-binary.scm:221 +#: guix/scripts/substitute.scm:214 #, scheme-format -msgid "updating list of substitutes from '~a'...~%" -msgstr "opdaterer liste af substitutter fra »~a«...~%" +msgid "updating list of substitutes from '~a'...\r" +msgstr "opdaterer liste af substitutter fra »~a«...\r" -#: guix/scripts/substitute-binary.scm:253 +#: guix/scripts/substitute.scm:246 #, scheme-format msgid "signature version must be a number: ~s~%" msgstr "signaturversion skal være et nummer: ~s~%" -#: guix/scripts/substitute-binary.scm:257 +#: guix/scripts/substitute.scm:250 #, scheme-format msgid "unsupported signature version: ~a~%" msgstr "signaturversion er ikke understøttet: ~a~%" -#: guix/scripts/substitute-binary.scm:265 +#: guix/scripts/substitute.scm:258 #, scheme-format msgid "signature is not a valid s-expression: ~s~%" msgstr "signatur er ikke et gyldigt s-udtryk: ~s~%" -#: guix/scripts/substitute-binary.scm:269 +#: guix/scripts/substitute.scm:262 #, scheme-format msgid "invalid format of the signature field: ~a~%" msgstr "ugyldigt format for signaturfeltet: ~a~%" -#: guix/scripts/substitute-binary.scm:304 +#: guix/scripts/substitute.scm:297 #, scheme-format msgid "invalid signature for '~a'~%" msgstr "ugyldig signatur for »~a«~%" -#: guix/scripts/substitute-binary.scm:306 +#: guix/scripts/substitute.scm:299 #, scheme-format msgid "hash mismatch for '~a'~%" msgstr "hash mismatch for »~a«~%" -#: guix/scripts/substitute-binary.scm:308 +#: guix/scripts/substitute.scm:301 #, scheme-format msgid "'~a' is signed with an unauthorized key~%" msgstr "»~a« er underskrevet med en uautoriseret nøgle~%" -#: guix/scripts/substitute-binary.scm:310 +#: guix/scripts/substitute.scm:303 #, scheme-format msgid "signature on '~a' is corrupt~%" msgstr "signatur på »~a« er ødelagt~%" -#: guix/scripts/substitute-binary.scm:344 +#: guix/scripts/substitute.scm:341 #, scheme-format msgid "substitute at '~a' lacks a signature~%" msgstr "substitut på »~a« mangler en signatur~%" -#: guix/scripts/substitute-binary.scm:532 +#: guix/scripts/substitute.scm:504 #, scheme-format -msgid "Downloading, please wait...~%" -msgstr "Henter, vent venligst ...~%" +msgid "updating list of substitutes from '~a'... ~5,1f%" +msgstr "opdaterer liste af substitutter fra »~a«... ~5,1f%" -#: guix/scripts/substitute-binary.scm:534 +#: guix/scripts/substitute.scm:552 #, scheme-format -msgid "(Please consider upgrading Guile to get proper progress report.)~%" -msgstr "(Overvej venligst at opgradere Guile for at få korrekt statusrapport.)~%" +msgid "~s: unsupported server URI scheme~%" +msgstr "~s: ikke understøttet server-URI-skema~%" -#: guix/scripts/substitute-binary.scm:547 +#: guix/scripts/substitute.scm:663 #, scheme-format msgid "host name lookup error: ~a~%" msgstr "opslagsfejl for værtsnavn: ~a~%" -#: guix/scripts/substitute-binary.scm:556 +#: guix/scripts/substitute.scm:672 msgid "" -"Usage: guix substitute-binary [OPTION]...\n" +"Usage: guix substitute [OPTION]...\n" "Internal tool to substitute a pre-built binary to a local build.\n" msgstr "" -"Brug: guix substitute-binary [TILVALG]...\n" +"Brug: guix substitute [TILVALG] ...\n" "Internt værktøj til at erstatte en præbygget binær fil med en lokal bygning.\n" -#: guix/scripts/substitute-binary.scm:558 +#: guix/scripts/substitute.scm:674 msgid "" "\n" " --query report on the availability of substitutes for the\n" @@ -852,7 +917,7 @@ msgstr "" " --query rapport om tilgængeligheden for substitutter for\n" " lagerfilnavnene sendt til standardind" -#: guix/scripts/substitute-binary.scm:561 +#: guix/scripts/substitute.scm:677 msgid "" "\n" " --substitute STORE-FILE DESTINATION\n" @@ -864,21 +929,21 @@ msgstr "" " hent LAGER-FIL og lagr den som en Nar i filen\n" " DESTINATION" -#: guix/scripts/substitute-binary.scm:606 +#: guix/scripts/substitute.scm:712 msgid "ACL for archive imports seems to be uninitialized, substitutes may be unavailable\n" msgstr "ACL for arkivimporter ser ikke ud til at være initialiseret, substitutter kan være utilgængelige\n" -#: guix/scripts/substitute-binary.scm:640 +#: guix/scripts/substitute.scm:750 #, scheme-format msgid "these substitute URLs will not be used:~{ ~a~}~%" msgstr "disse substitutadresser vil ikke blive brugt:~{ ~a~}~%" -#: guix/scripts/substitute-binary.scm:666 +#: guix/scripts/substitute.scm:776 #, scheme-format msgid "failed to look up host '~a' (~a), substituter disabled~%" msgstr "kunne ikke slå vært op »~a« (~a), substitutter deaktiveret~%" -#: guix/scripts/substitute-binary.scm:777 +#: guix/scripts/substitute.scm:883 #, scheme-format msgid "~a: unrecognized options~%" msgstr "~a: ikke genkendte tilvalg~%" @@ -903,7 +968,7 @@ msgstr "fejl: ikke autoriseret offentlig nøgle: ~a~%" msgid "error: corrupt signature data: ~a~%" msgstr "fejl: ødelagt signaturdata: ~a~%" -#: guix/scripts/authenticate.scm:126 +#: guix/scripts/authenticate.scm:120 msgid "" "Usage: guix authenticate OPTION...\n" "Sign or verify the signature on the given file. This tool is meant to\n" @@ -913,56 +978,41 @@ msgstr "" "Underskriv eller verificer signaturen på den givne fil. Dette værktøj skal\n" "bruges internt af »guix-daemon«.\n" -#: guix/scripts/authenticate.scm:132 +#: guix/scripts/authenticate.scm:126 msgid "wrong arguments" msgstr "forkerte argumenter" -#: guix/scripts/system.scm:75 -#, scheme-format -msgid "failed to open operating system file '~a': ~a~%" -msgstr "kunne ikke åbne operativsystemfil »~a«: ~a~%" - -#: guix/scripts/system.scm:79 -#, scheme-format -msgid "~a: error: ~a~%" -msgstr "~a: fejl: ~a~%" - -#: guix/scripts/system.scm:83 -#, scheme-format -msgid "failed to load operating system file '~a':~%" -msgstr "kunne ikke indlæse operativsystemfil »~a«:~%" - -#: guix/scripts/system.scm:120 +#: guix/scripts/system.scm:106 #, scheme-format msgid "failed to register '~a' under '~a'~%" msgstr "kunne ikke registrere »~a« under »~a«~%" -#: guix/scripts/system.scm:152 +#: guix/scripts/system.scm:138 #, scheme-format msgid "failed to install GRUB on device '~a'~%" msgstr "kunne ikke installere GRUB på enhed »~a«~%" -#: guix/scripts/system.scm:169 +#: guix/scripts/system.scm:155 #, scheme-format msgid "initializing the current root file system~%" msgstr "initialiserer det nuværende root-filsystem~%" -#: guix/scripts/system.scm:223 +#: guix/scripts/system.scm:209 #, scheme-format msgid "activating system...~%" msgstr "aktiverer system ...~%" -#: guix/scripts/system.scm:273 +#: guix/scripts/system.scm:259 #, scheme-format msgid "unrecognized boot parameters for '~a'~%" msgstr "ikke genkendte opstartsparametre for »~a«~%" -#: guix/scripts/system.scm:369 +#: guix/scripts/system.scm:355 #, scheme-format msgid "initializing operating system under '~a'...~%" msgstr "initialiserer operativsystem under »~a«...~%" -#: guix/scripts/system.scm:385 +#: guix/scripts/system.scm:371 msgid "" "Usage: guix system [OPTION] ACTION FILE\n" "Build the operating system declared in FILE according to ACTION.\n" @@ -970,35 +1020,35 @@ msgstr "" "Brug: guix system [TILVALG] HANDLING FIL\n" "Byg operativsystemet deklæret i FIL jævnfør HANDLING.\n" -#: guix/scripts/system.scm:388 +#: guix/scripts/system.scm:374 msgid "The valid values for ACTION are:\n" msgstr "De gyldige værdier for HANDLING er:\n" -#: guix/scripts/system.scm:389 +#: guix/scripts/system.scm:375 msgid " - 'reconfigure', switch to a new operating system configuration\n" msgstr " - »reconfigure«, skift til en ny operativsystemkonfiguration\n" -#: guix/scripts/system.scm:391 +#: guix/scripts/system.scm:377 msgid " - 'build', build the operating system without installing anything\n" msgstr " - »build«, byg operativsystemet uden at installere noget\n" -#: guix/scripts/system.scm:393 +#: guix/scripts/system.scm:379 msgid " - 'vm', build a virtual machine image that shares the host's store\n" msgstr " - »vm«, byg et virtuelt maskinaftryk som deler værtens lager\n" -#: guix/scripts/system.scm:395 +#: guix/scripts/system.scm:381 msgid " - 'vm-image', build a freestanding virtual machine image\n" msgstr " - »vm-image«, byg et fritstående virtuelt maskinaftryk\n" -#: guix/scripts/system.scm:397 +#: guix/scripts/system.scm:383 msgid " - 'disk-image', build a disk image, suitable for a USB stick\n" msgstr " - »disk-image«, byg et diskaftryk, egnet for et USB-drev\n" -#: guix/scripts/system.scm:399 +#: guix/scripts/system.scm:385 msgid " - 'init', initialize a root file system to run GNU.\n" msgstr " - »init«, initialiser et rootfilsystem til at køre GNU.\n" -#: guix/scripts/system.scm:403 +#: guix/scripts/system.scm:389 msgid "" "\n" " --image-size=SIZE for 'vm-image', produce an image of SIZE" @@ -1006,7 +1056,7 @@ msgstr "" "\n" " --image-size=STR for »vm-image«, lav et aftryk af STR" -#: guix/scripts/system.scm:405 +#: guix/scripts/system.scm:391 msgid "" "\n" " --no-grub for 'init', do not install GRUB" @@ -1014,7 +1064,7 @@ msgstr "" "\n" " --no-grub for »init«, installer ikke GRUB" -#: guix/scripts/system.scm:407 +#: guix/scripts/system.scm:393 msgid "" "\n" " --share=SPEC for 'vm', share host file system according to SPEC" @@ -1022,7 +1072,7 @@ msgstr "" "\n" " --share=SPEC for »vm«, del værtsfilsystem jævnfør SPEC" -#: guix/scripts/system.scm:409 +#: guix/scripts/system.scm:395 msgid "" "\n" " --expose=SPEC for 'vm', expose host file system according to SPEC" @@ -1030,7 +1080,7 @@ msgstr "" "\n" " --expose=SPEC for »vm«, fremvis værtsfilsystem jævnfør SPEC" -#: guix/scripts/system.scm:411 +#: guix/scripts/system.scm:397 msgid "" "\n" " --full-boot for 'vm', make a full boot sequence" @@ -1038,36 +1088,36 @@ msgstr "" "\n" " --full-boot for »vm«, lav en fuld opstartssekvens" -#: guix/scripts/system.scm:507 +#: guix/scripts/system.scm:484 #, scheme-format msgid "~a: unknown action~%" msgstr "~a: ukendt handling~%" -#: guix/scripts/system.scm:524 +#: guix/scripts/system.scm:499 #, scheme-format msgid "wrong number of arguments for action '~a'~%" msgstr "forkert antal argumenter for handling »~a«~%" -#: guix/scripts/system.scm:544 +#: guix/scripts/system.scm:522 #, scheme-format msgid "no configuration file specified~%" msgstr "ingen konfigurationsfil angivet~%" -#: guix/scripts/lint.scm:82 +#: guix/scripts/lint.scm:90 #, scheme-format msgid "Available checkers:~%" msgstr "Tilgængelige kontrolprogrammer:~%" -#: guix/scripts/lint.scm:102 +#: guix/scripts/lint.scm:110 msgid "description should not be empty" msgstr "beskrivelse skal være udfyldt" -#: guix/scripts/lint.scm:109 +#: guix/scripts/lint.scm:117 msgid "description should start with an upper-case letter or digit" msgstr "beskrivelse skal starte med et stort bogstav eller et tal" # arg, hvad foregår der her -#: guix/scripts/lint.scm:125 +#: guix/scripts/lint.scm:133 #, scheme-format msgid "" "sentences in description should be followed ~\n" @@ -1076,101 +1126,115 @@ msgstr "" "sætninger i beskrivelsen skal efterfølges ~\n" "af to mellemrum; mulig infraction~p ved ~{~a~^, ~}" -#: guix/scripts/lint.scm:146 +#: guix/scripts/lint.scm:154 msgid "pkg-config should probably be a native input" msgstr "pkg-config skal sandsynligvis være standarddata" -#: guix/scripts/lint.scm:161 +#: guix/scripts/lint.scm:169 msgid "synopsis should not be empty" msgstr "synopsis skal være udfyldt" -#: guix/scripts/lint.scm:169 +#: guix/scripts/lint.scm:177 msgid "no period allowed at the end of the synopsis" msgstr "ingen periode er tilladt i slutningen af synopsen" -#: guix/scripts/lint.scm:181 +#: guix/scripts/lint.scm:189 msgid "no article allowed at the beginning of the synopsis" msgstr "ingen artikel er tilladt i begyndelsen af synopsen" -#: guix/scripts/lint.scm:188 +#: guix/scripts/lint.scm:196 msgid "synopsis should be less than 80 characters long" msgstr "synopsis skal være mindre end 80 tegn lang" -#: guix/scripts/lint.scm:194 +#: guix/scripts/lint.scm:202 msgid "synopsis should start with an upper-case letter or digit" msgstr "synopsis skal starte med et stort bogstav eller et tal" -#: guix/scripts/lint.scm:201 +#: guix/scripts/lint.scm:209 msgid "synopsis should not start with the package name" msgstr "synopsis skal ikke starte med pakkenavnet" -#: guix/scripts/lint.scm:270 +#: guix/scripts/lint.scm:299 guix/scripts/lint.scm:310 #, scheme-format msgid "URI ~a not reachable: ~a (~s)" msgstr "URI ~a kan ikke nås: ~a (~s)" -#: guix/scripts/lint.scm:278 +#: guix/scripts/lint.scm:316 #, scheme-format msgid "URI ~a domain not found: ~a" msgstr "URI ~a domæne blev ikke fundet: ~a" -#: guix/scripts/lint.scm:286 +#: guix/scripts/lint.scm:324 #, scheme-format msgid "URI ~a unreachable: ~a" msgstr "URI ~a kan ikke nås: ~a" -#: guix/scripts/lint.scm:312 +#: guix/scripts/lint.scm:350 msgid "invalid value for home page" msgstr "ugyldig værdi for hjemmeside" -#: guix/scripts/lint.scm:315 +#: guix/scripts/lint.scm:353 #, scheme-format msgid "invalid home page URL: ~s" msgstr "ugyldig hjemmesideadresse: ~s" -#: guix/scripts/lint.scm:336 +#: guix/scripts/lint.scm:378 msgid "file names of patches should start with the package name" msgstr "filnavn for rettelser skal starte med pakkenavnet" -#: guix/scripts/lint.scm:374 +#: guix/scripts/lint.scm:416 #, scheme-format msgid "~a: ~a: proposed synopsis: ~s~%" msgstr "~a: ~a: foreslået synopsis: ~s~%" -#: guix/scripts/lint.scm:386 +#: guix/scripts/lint.scm:428 #, scheme-format msgid "~a: ~a: proposed description:~% \"~a\"~%" msgstr "~a: ~a: foreslået beskrivelse:~% »~a«~%" -#: guix/scripts/lint.scm:415 +#: guix/scripts/lint.scm:453 guix/scripts/lint.scm:457 +#, scheme-format +msgid "failed to create derivation: ~a" +msgstr "kunne ikke oprette afledning: ~a" + +#: guix/scripts/lint.scm:463 +#, scheme-format +msgid "failed to create derivation: ~s~%" +msgstr "kunne ikke oprette afledning: ~s~%" + +#: guix/scripts/lint.scm:476 msgid "Validate package descriptions" msgstr "Valider pakkebeskrivelser" -#: guix/scripts/lint.scm:419 +#: guix/scripts/lint.scm:480 msgid "Validate synopsis & description of GNU packages" msgstr "Valider synopsis og beskrivelse for GNU-pakker" -#: guix/scripts/lint.scm:423 +#: guix/scripts/lint.scm:484 msgid "Identify inputs that should be native inputs" msgstr "Identificer inddata som skal være standarddata" -#: guix/scripts/lint.scm:427 -msgid "Validate file names of patches" -msgstr "Valider filnavne for rettelser" +#: guix/scripts/lint.scm:488 +msgid "Validate file names and availability of patches" +msgstr "Valider filnavne og tilgængelighed for rettelser" -#: guix/scripts/lint.scm:431 +#: guix/scripts/lint.scm:492 msgid "Validate home-page URLs" msgstr "Valider hjemmesiders adresser" -#: guix/scripts/lint.scm:435 +#: guix/scripts/lint.scm:496 msgid "Validate source URLs" msgstr "Valider kildeadresser" -#: guix/scripts/lint.scm:439 +#: guix/scripts/lint.scm:500 +msgid "Report failure to compile a package to a derivation" +msgstr "Rapporter mislykket kompilering af en pakke til en afledning" + +#: guix/scripts/lint.scm:504 msgid "Validate package synopses" msgstr "Valider pakkesynopser" -#: guix/scripts/lint.scm:464 +#: guix/scripts/lint.scm:529 msgid "" "Usage: guix lint [OPTION]... [PACKAGE]...\n" "Run a set of checkers on the specified package; if none is specified, run the checkers on all packages.\n" @@ -1178,7 +1242,7 @@ msgstr "" "Brug: guix lint [TILVALG]... [PAKKE]...\n" "Kør et sæt af kontroller på den specificerede pakke; hvis ingen er specificeret, så kør kontrollerne på alle pakker.\n" -#: guix/scripts/lint.scm:466 +#: guix/scripts/lint.scm:531 msgid "" "\n" " -c, --checkers=CHECKER1,CHECKER2...\n" @@ -1188,7 +1252,7 @@ msgstr "" " -c, --checkers=KONTROL1,KONTROL2...\n" " kør kun de specificerede kontroller" -#: guix/scripts/lint.scm:471 +#: guix/scripts/lint.scm:536 msgid "" "\n" " -l, --list-checkers display the list of available lint checkers" @@ -1196,49 +1260,104 @@ msgstr "" "\n" " -l, --list-checkers vis listen med tilgængelige lint-kontroller" -#: guix/scripts/lint.scm:491 +#: guix/scripts/lint.scm:556 #, scheme-format msgid "~a: invalid checker~%" msgstr "~a: ugyldig kontrol~%" -#: guix/gnu-maintenance.scm:438 +#: guix/scripts/publish.scm:49 +#, scheme-format +msgid "" +"Usage: guix publish [OPTION]...\n" +"Publish ~a over HTTP.\n" +msgstr "" +"Brug: guix publish [TILVALG] ...\n" +"Udgiv ~a over HTTP.\n" + +#: guix/scripts/publish.scm:51 +msgid "" +"\n" +" -p, --port=PORT listen on PORT" +msgstr "" +"\n" +" -p, --port=PORT lyt på PORT" + +#: guix/scripts/publish.scm:53 +msgid "" +"\n" +" -r, --repl[=PORT] spawn REPL server on PORT" +msgstr "" +"\n" +" -r, --repl[=PORT] udsend REPL-server on PORT" + +#: guix/scripts/publish.scm:235 +#, scheme-format +msgid "~A: extraneuous argument~%" +msgstr "~A: uvedkommende argument~%" + +#: guix/scripts/publish.scm:239 +#, scheme-format +msgid "publishing ~a on port ~d~%" +msgstr "udgiver ~a på port ~d~%" + +#: guix/gnu-maintenance.scm:447 #, scheme-format msgid "signature verification failed for `~a'~%" msgstr "signaturverifikation mislykkedes for »~a«~%" -#: guix/gnu-maintenance.scm:440 +#: guix/gnu-maintenance.scm:449 #, scheme-format msgid "(could be because the public key is not in your keyring)~%" msgstr "(kunne være fordi den offentlige nøgle ikke er i din nøglering)~%" -#: guix/gnu-maintenance.scm:515 +#: guix/gnu-maintenance.scm:524 #, scheme-format msgid "~a: could not locate source file" msgstr "~a: kunne ikke lokalisere kildefil" -#: guix/gnu-maintenance.scm:520 +#: guix/gnu-maintenance.scm:529 #, scheme-format msgid "~a: ~a: no `version' field in source; skipping~%" msgstr "~a: ~a: intet »versionsfelt« i kilde; udelader~%" -#: guix/ui.scm:137 +#: guix/ui.scm:142 guix/ui.scm:159 +#, scheme-format +msgid "failed to load '~a': ~a~%" +msgstr "kunne ikke indlæse »~a«: ~a~%" + +#: guix/ui.scm:145 +#, scheme-format +msgid "~a: error: ~a~%" +msgstr "~a: fejl: ~a~%" + +#: guix/ui.scm:149 guix/ui.scm:165 +#, scheme-format +msgid "failed to load '~a':~%" +msgstr "kunne ikke indlæse »~a«:~%" + +#: guix/ui.scm:162 +#, scheme-format +msgid "~a: warning: ~a~%" +msgstr "~a: advarsel: ~a~%" + +#: guix/ui.scm:174 #, scheme-format msgid "failed to install locale: ~a~%" msgstr "kunne ikke installere sprog: ~a~%" -#: guix/ui.scm:156 +#: guix/ui.scm:193 msgid "" -"Copyright (C) 2014 the Guix authors\n" +"Copyright (C) 2015 the Guix authors\n" "License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>\n" "This is free software: you are free to change and redistribute it.\n" "There is NO WARRANTY, to the extent permitted by law.\n" msgstr "" -"Ophavsret 2014 Guix-forfatterne\n" +"Ophavsret 2015 Guix-forfatterne\n" "Licens GPLv3+: GNU GPL version 3 eller senere <http://gnu.org/licenses/gpl.html>\n" "Dette er et frit program; du kan frit ændre og videredistribuere programmet.\n" "Der er INGEN GARANTI, inden for lovens rammer.\n" -#: guix/ui.scm:164 +#: guix/ui.scm:201 #, scheme-format msgid "" "\n" @@ -1247,7 +1366,7 @@ msgstr "" "\n" "Rapporter fejl til: ~a." -#: guix/ui.scm:166 +#: guix/ui.scm:203 #, scheme-format msgid "" "\n" @@ -1256,7 +1375,7 @@ msgstr "" "\n" "~a hjemmeside: <~a>" -#: guix/ui.scm:168 +#: guix/ui.scm:205 msgid "" "\n" "General help using GNU software: <http://www.gnu.org/gethelp/>" @@ -1264,170 +1383,194 @@ msgstr "" "\n" "Generel hjælp til brugen af GNU-programmer: <http://www.gnu.org/gethelp/>" -#: guix/ui.scm:175 +#: guix/ui.scm:227 #, scheme-format msgid "~a: invalid number~%" msgstr "~a: ugyldigt nummer~%" -#: guix/ui.scm:192 +#: guix/ui.scm:244 #, scheme-format msgid "invalid number: ~a~%" msgstr "ugyldigt nummer: ~a~%" -#: guix/ui.scm:215 +#: guix/ui.scm:267 #, scheme-format msgid "unknown unit: ~a~%" msgstr "ukendt enhed: ~a~%" -#: guix/ui.scm:226 +#: guix/ui.scm:278 #, scheme-format msgid "~a:~a:~a: package `~a' has an invalid input: ~s~%" msgstr "~a:~a:~a: pakken »~a« har ugyldige inddata: ~s~%" -#: guix/ui.scm:233 +#: guix/ui.scm:285 #, scheme-format msgid "~a: ~a: build system `~a' does not support cross builds~%" msgstr "~a: ~a: byggesystem »~a« understøtter ikke krydsbygninger~%" -#: guix/ui.scm:238 +#: guix/ui.scm:290 #, scheme-format msgid "profile '~a' does not exist~%" msgstr "profilen »~a« findes ikke~%" -#: guix/ui.scm:241 +#: guix/ui.scm:293 #, scheme-format msgid "generation ~a of profile '~a' does not exist~%" msgstr "oprettelse ~a af profilen »~a« findes ikke~%" -#: guix/ui.scm:245 +#: guix/ui.scm:300 +#, scheme-format +msgid "corrupt input while restoring '~a' from ~s~%" +msgstr "ødelagte inddata under gendannelse af »~a« fra ~s~%" + +#: guix/ui.scm:302 +#, scheme-format +msgid "corrupt input while restoring archive from ~s~%" +msgstr "ødelagte inddata under gendannelse af arkiv fra ~s~%" + +#: guix/ui.scm:305 #, scheme-format msgid "failed to connect to `~a': ~a~%" msgstr "kunne ikke forbinde til »~a«: ~a~%" -#: guix/ui.scm:250 +#: guix/ui.scm:310 #, scheme-format msgid "build failed: ~a~%" msgstr "bygning mislykkedes: ~a~%" -#: guix/ui.scm:253 +#: guix/ui.scm:313 #, scheme-format msgid "reference to invalid output '~a' of derivation '~a'~%" msgstr "reference til ugyldige uddata »~a« for afledning »~a«~%" -#: guix/ui.scm:264 +#: guix/ui.scm:324 #, scheme-format msgid "~a: ~a~%" msgstr "~a: ~a~%" -#: guix/ui.scm:283 +#: guix/ui.scm:343 #, scheme-format msgid "failed to read expression ~s: ~s~%" msgstr "kunne ikke læse udtryk ~s: ~s~%" -#: guix/ui.scm:289 +#: guix/ui.scm:349 #, scheme-format msgid "failed to evaluate expression `~a': ~s~%" msgstr "kunne ikke evaluere udtryk »~a«: ~s~%" -#: guix/ui.scm:298 +#: guix/ui.scm:358 #, scheme-format msgid "expression ~s does not evaluate to a package~%" msgstr "udtryk ~s evaluerer ikke til en pakke~%" -#: guix/ui.scm:350 +#: guix/ui.scm:410 #, scheme-format msgid "~:[The following derivation would be built:~%~{ ~a~%~}~;~]" msgid_plural "~:[The following derivations would be built:~%~{ ~a~%~}~;~]" msgstr[0] "~:[Den følgende afledning ville blive bygget:~%~{ ~a~%~}~;~]" msgstr[1] "~:[De følgende afledninger ville blive bygget:~%~{ ~a~%~}~;~]" -#: guix/ui.scm:355 +#: guix/ui.scm:415 #, scheme-format msgid "~:[The following file would be downloaded:~%~{ ~a~%~}~;~]" msgid_plural "~:[The following files would be downloaded:~%~{ ~a~%~}~;~]" msgstr[0] "~:[Den følgende fil ville blive hentet:~%~{ ~a~%~}~;~]" msgstr[1] "~:[De følgende filer ville blive hentet:~%~{ ~a~%~}~;~]" -#: guix/ui.scm:361 +#: guix/ui.scm:421 #, scheme-format msgid "~:[The following derivation will be built:~%~{ ~a~%~}~;~]" msgid_plural "~:[The following derivations will be built:~%~{ ~a~%~}~;~]" msgstr[0] "~:[Den følgende afledning vil blive bygget:~%~{ ~a~%~}~;~]" msgstr[1] "~:[De følgende afledninger vil blive bygget:~%~{ ~a~%~}~;~]" -#: guix/ui.scm:366 +#: guix/ui.scm:426 #, scheme-format msgid "~:[The following file will be downloaded:~%~{ ~a~%~}~;~]" msgid_plural "~:[The following files will be downloaded:~%~{ ~a~%~}~;~]" msgstr[0] "~:[Den følgende fil vil blive hentet:~%~{ ~a~%~}~;~]" msgstr[1] "~:[De følgende filer vil blive hentet:~%~{ ~a~%~}~;~]" -#: guix/ui.scm:418 +#: guix/ui.scm:478 #, scheme-format msgid "The following package would be removed:~%~{~a~%~}~%" msgid_plural "The following packages would be removed:~%~{~a~%~}~%" msgstr[0] "Den følgende pakke ville blive fjernet:~%~{~a~%~}~%" msgstr[1] "De følgende pakker ville blive fjernet:~%~{~a~%~}~%" -#: guix/ui.scm:423 +#: guix/ui.scm:483 #, scheme-format msgid "The following package will be removed:~%~{~a~%~}~%" msgid_plural "The following packages will be removed:~%~{~a~%~}~%" msgstr[0] "Den følgende pakke vil blive fjernet:~%~{~a~%~}~%" msgstr[1] "De følgende pakker vil blive fjernet:~%~{~a~%~}~%" -#: guix/ui.scm:436 +#: guix/ui.scm:496 +#, scheme-format +msgid "The following package would be downgraded:~%~{~a~%~}~%" +msgid_plural "The following packages would be downgraded:~%~{~a~%~}~%" +msgstr[0] "Den følgende pakke ville blive nedgraderet:~%~{~a~%~}~%" +msgstr[1] "De følgende pakker ville blive nedgraderet:~%~{~a~%~}~%" + +#: guix/ui.scm:501 +#, scheme-format +msgid "The following package will be downgraded:~%~{~a~%~}~%" +msgid_plural "The following packages will be downgraded:~%~{~a~%~}~%" +msgstr[0] "Den følgende pakke vil blive nedgraderet:~%~{~a~%~}~%" +msgstr[1] "De følgende pakker vil blive nedgraderet:~%~{~a~%~}~%" + +#: guix/ui.scm:514 #, scheme-format msgid "The following package would be upgraded:~%~{~a~%~}~%" msgid_plural "The following packages would be upgraded:~%~{~a~%~}~%" msgstr[0] "Den følgende pakke ville blive opgraderet:~%~{~a~%~}~%" msgstr[1] "De følgende pakker ville blive opgraderet:~%~{~a~%~}~%" -#: guix/ui.scm:441 +#: guix/ui.scm:519 #, scheme-format msgid "The following package will be upgraded:~%~{~a~%~}~%" msgid_plural "The following packages will be upgraded:~%~{~a~%~}~%" msgstr[0] "Den følgende pakke vil blive opgraderet:~%~{~a~%~}~%" msgstr[1] "De følgende pakker vil blive opgraderet:~%~{~a~%~}~%" -#: guix/ui.scm:452 +#: guix/ui.scm:530 #, scheme-format msgid "The following package would be installed:~%~{~a~%~}~%" msgid_plural "The following packages would be installed:~%~{~a~%~}~%" msgstr[0] "Den følgende pakke ville blive installeret:~%~{~a~%~}~%" msgstr[1] "De følgende pakker ville blive installeret:~%~{~a~%~}~%" -#: guix/ui.scm:457 +#: guix/ui.scm:535 #, scheme-format msgid "The following package will be installed:~%~{~a~%~}~%" msgid_plural "The following packages will be installed:~%~{~a~%~}~%" msgstr[0] "Den følgende pakke vil blive installeret:~%~{~a~%~}~%" msgstr[1] "De følgende pakker vil blive installeret:~%~{~a~%~}~%" -#: guix/ui.scm:474 +#: guix/ui.scm:552 msgid "<unknown location>" msgstr "<ukendt sted>" -#: guix/ui.scm:500 +#: guix/ui.scm:578 #, scheme-format msgid "failed to create configuration directory `~a': ~a~%" msgstr "kunne ikke oprette konfiguratinsmappe »~a«: ~a~%" -#: guix/ui.scm:600 guix/ui.scm:614 +#: guix/ui.scm:680 guix/ui.scm:694 msgid "unknown" msgstr "ukendt" -#: guix/ui.scm:723 +#: guix/ui.scm:803 #, scheme-format msgid "invalid argument: ~a~%" msgstr "ugyldigt argument: ~a~%" -#: guix/ui.scm:732 +#: guix/ui.scm:842 #, scheme-format msgid "Try `guix --help' for more information.~%" msgstr "Prøv »guix --help« for yderligere information.~%" -#: guix/ui.scm:762 +#: guix/ui.scm:869 msgid "" "Usage: guix COMMAND ARGS...\n" "Run COMMAND with ARGS.\n" @@ -1435,41 +1578,31 @@ msgstr "" "Brug: guix KOMMANDO ARG...\n" "Kør KOMMANDO med ARG.\n" -#: guix/ui.scm:765 +#: guix/ui.scm:872 msgid "COMMAND must be one of the sub-commands listed below:\n" msgstr "KOMMANDO skal være en af underkommandoerne vist nedenfor:\n" -#: guix/ui.scm:785 +#: guix/ui.scm:892 #, scheme-format msgid "guix: ~a: command not found~%" msgstr "guix: ~a: kommando blev ikke fundet~%" -#: guix/ui.scm:803 +#: guix/ui.scm:910 #, scheme-format msgid "guix: missing command name~%" msgstr "guix: mangler kommandonavn~%" -#: guix/ui.scm:811 +#: guix/ui.scm:918 #, scheme-format msgid "guix: unrecognized option '~a'~%" msgstr "guix: ikke genkendt tilvalg »~a«~%" -#: guix/http-client.scm:217 -#, scheme-format -msgid "using Guile ~a, which does not support ~s encoding~%" -msgstr "bruger Guile ~a, som ikke understøtter ~s-kodning~%" - -#: guix/http-client.scm:220 -#, scheme-format -msgid "download failed; use a newer Guile~%" -msgstr "overførsel mislykkedes; brug en nyere Guile~%" - -#: guix/http-client.scm:232 +#: guix/http-client.scm:211 #, scheme-format msgid "following redirection to `~a'...~%" msgstr "følger omdirigering til »~a«...~%" -#: guix/http-client.scm:241 +#: guix/http-client.scm:220 msgid "download failed" msgstr "overførsel mislykkedes" @@ -1514,3 +1647,21 @@ msgstr "importeret fil mangler en signatur" #: guix/nar.scm:268 msgid "invalid inter-file archive mark" msgstr "ugyldig arkivmærke for mellemfil" + +#~ msgid "Downloading, please wait...~%" +#~ msgstr "Henter, vent venligst ...~%" + +#~ msgid "(Please consider upgrading Guile to get proper progress report.)~%" +#~ msgstr "(Overvej venligst at opgradere Guile for at få korrekt statusrapport.)~%" + +#~ msgid "failed to open operating system file '~a': ~a~%" +#~ msgstr "kunne ikke åbne operativsystemfil »~a«: ~a~%" + +#~ msgid "failed to load operating system file '~a':~%" +#~ msgstr "kunne ikke indlæse operativsystemfil »~a«:~%" + +#~ msgid "using Guile ~a, which does not support ~s encoding~%" +#~ msgstr "bruger Guile ~a, som ikke understøtter ~s-kodning~%" + +#~ msgid "download failed; use a newer Guile~%" +#~ msgstr "overførsel mislykkedes; brug en nyere Guile~%" diff --git a/po/packages/POTFILES.in b/po/packages/POTFILES.in index 0e7bc4c0d3..b1da6d2023 100644 --- a/po/packages/POTFILES.in +++ b/po/packages/POTFILES.in @@ -6,24 +6,52 @@ gnu/packages/aspell.scm gnu/packages/backup.scm gnu/packages/base.scm gnu/packages/bittorrent.scm +gnu/packages/certs.scm +gnu/packages/compression.scm gnu/packages/databases.scm +gnu/packages/debug.scm +gnu/packages/dejagnu.scm +gnu/packages/feh.scm gnu/packages/games.scm gnu/packages/gcc.scm +gnu/packages/geeqie.scm gnu/packages/gettext.scm gnu/packages/gnuzilla.scm gnu/packages/gtk.scm gnu/packages/guile.scm -gnu/packages/image.scm gnu/packages/imagemagick.scm +gnu/packages/image.scm gnu/packages/inkscape.scm +gnu/packages/jemalloc.scm +gnu/packages/key-mon.scm +gnu/packages/less.scm +gnu/packages/lesstif.scm gnu/packages/linux.scm gnu/packages/lout.scm +gnu/packages/messaging.scm gnu/packages/mpd.scm +gnu/packages/netpbm.scm +gnu/packages/nettle.scm +gnu/packages/networking.scm gnu/packages/pdf.scm +gnu/packages/pem.scm +gnu/packages/perl.scm gnu/packages/photo.scm +gnu/packages/qemu.scm gnu/packages/ratpoison.scm +gnu/packages/readline.scm gnu/packages/scanner.scm gnu/packages/scheme.scm +gnu/packages/search.scm +gnu/packages/serveez.scm +gnu/packages/telephony.scm +gnu/packages/texinfo.scm +gnu/packages/texlive.scm +gnu/packages/textutils.scm +gnu/packages/version-control.scm +gnu/packages/webkit.scm +gnu/packages/web.scm +gnu/packages/weechat.scm gnu/packages/wordnet.scm gnu/packages/xiph.scm gnu/packages/zip.scm diff --git a/tests/base32.scm b/tests/base32.scm index 81d242355a..dcd926f4b8 100644 --- a/tests/base32.scm +++ b/tests/base32.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +21,7 @@ #:use-module (guix base32) #:use-module (guix utils) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-64) #:use-module (ice-9 rdelim) #:use-module (ice-9 popen) @@ -77,6 +78,13 @@ ;; Examples from RFC 4648. (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar")))) +(test-equal "&invalid-base32-character" + #\e + (guard (c ((invalid-base32-character? c) + (invalid-base32-character-value c))) + (nix-base32-string->bytevector + (string-append (make-string 51 #\a) "e")))) + ;; The following test requires `nix-hash' in $PATH. (unless %have-nix-hash? (test-skip 1)) diff --git a/tests/derivations.scm b/tests/derivations.scm index a8cccac34a..df5f07d117 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -499,12 +499,16 @@ (string=? path (derivation-file-name (%guile-for-build))))) (derivation-prerequisites drv)))) -(test-assert "derivation-prerequisites and derivation-input-is-valid?" +(test-assert "derivation-prerequisites and valid-derivation-input?" (let* ((a (build-expression->derivation %store "a" '(mkdir %output))) (b (build-expression->derivation %store "b" `(list ,(random-text)))) (c (build-expression->derivation %store "c" `(mkdir %output) #:inputs `(("a" ,a) ("b" ,b))))) - (build-derivations %store (list a)) + ;; Make sure both A and %BOOTSTRAP-GUILE are built (the latter could have + ;; be removed by tests/guix-gc.sh.) + (build-derivations %store + (list a (package-derivation %store %bootstrap-guile))) + (match (derivation-prerequisites c (cut valid-derivation-input? %store <>)) diff --git a/tests/gexp.scm b/tests/gexp.scm index f81ef39860..7e14073fd4 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -109,6 +109,16 @@ (eq? x local))) (equal? `(display ,intd) (gexp->sexp* exp))))) +(test-assert "one plain file" + (let* ((file (plain-file "hi" "Hello, world!")) + (exp (gexp (display (ungexp file)))) + (expected (add-text-to-store %store "hi" "Hello, world!"))) + (and (gexp? exp) + (match (gexp-inputs exp) + (((x "out")) + (eq? x file))) + (equal? `(display ,expected) (gexp->sexp* exp))))) + (test-assert "same input twice" (let ((exp (gexp (begin (display (ungexp coreutils)) diff --git a/tests/guix-archive.sh b/tests/guix-archive.sh index d4259b8677..8eacf89338 100644 --- a/tests/guix-archive.sh +++ b/tests/guix-archive.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> # # This file is part of GNU Guix. # @@ -41,7 +41,6 @@ cmp "$archive" "$archive_alt" # Check the exit value and stderr upon import. guix archive --import < "$archive" -guix archive --import < "$archive" 2>&1 | grep "import.*guile-bootstrap" if guix archive something-that-does-not-exist then false; else true; fi diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 836c45e776..a72ce0911d 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -36,6 +36,88 @@ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' | \ guix build hello -d | \ grep -e '-hello-[0-9\.]\+\.drv$' +# Check --sources option with its arguments +module_dir="t-guix-build-$$" +mkdir "$module_dir" +trap "rm -rf $module_dir" EXIT + +cat > "$module_dir/foo.scm"<<EOF +(define-module (foo) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system trivial)) + +(define-public foo + (package + (name "foo") + (version "42") + (source (origin + (method url-fetch) + (uri "http://www.example.com/foo.tar.gz") + (sha256 + (base32 + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")))) + (build-system trivial-build-system) + (inputs + (quasiquote (("bar" ,bar)))) + (home-page "www.example.com") + (synopsis "Dummy package") + (description "foo is a dummy package for testing.") + (license #f))) + +(define-public bar + (package + (name "bar") + (version "9001") + (source (origin + (method url-fetch) + (uri "http://www.example.com/bar.tar.gz") + (sha256 + (base32 + "yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy")))) + (build-system trivial-build-system) + (inputs + (quasiquote + (("data" ,(origin + (method url-fetch) + (uri "http://www.example.com/bar.dat") + (sha256 + (base32 + "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz"))))))) + (home-page "www.example.com") + (synopsis "Dummy package") + (description "bar is a dummy package for testing.") + (license #f))) +EOF + +GUIX_PACKAGE_PATH="$module_dir" +export GUIX_PACKAGE_PATH + +# foo.tar.gz +guix build -d -S foo +guix build -d -S foo | grep -e 'foo\.tar\.gz' + +guix build -d --sources=package foo +guix build -d --sources=package foo | grep -e 'foo\.tar\.gz' + +# bar.tar.gz and bar.dat +guix build -d --sources bar +test `guix build -d --sources bar \ + | grep -e 'bar\.tar\.gz' -e 'bar\.dat' \ + | wc -l` -eq 2 + +# bar.tar.gz and bar.dat +guix build -d --sources=all bar +test `guix build -d --sources bar \ + | grep -e 'bar\.tar\.gz' -e 'bar\.dat' \ + | wc -l` -eq 2 + +# Should include foo.tar.gz, bar.tar.gz, and bar.dat +guix build -d --sources=transitive foo +test `guix build -d --sources=transitive foo \ + | grep -e 'foo\.tar\.gz' -e 'bar\.tar\.gz' -e 'bar\.dat' \ + | wc -l` -eq 3 + # Should all return valid log files. drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh index eac9d82e89..c1eb66cef5 100644 --- a/tests/guix-gc.sh +++ b/tests/guix-gc.sh @@ -64,3 +64,23 @@ guix gc -C 1KiB # Check trivial error cases. if guix gc --delete /dev/null; then false; else true; fi + +# Bug #19757 +out="`guix build guile-bootstrap`" +test -d "$out" + +guix gc --delete "$out" + +! test -d "$out" + +out="`guix build guile-bootstrap`" +test -d "$out" + +guix gc --delete "$out/" + +! test -d "$out" + +out="`guix build guile-bootstrap`" +test -d "$out" + +guix gc --delete "$out/bin/guile" diff --git a/tests/guix-package-net.sh b/tests/guix-package-net.sh index cf3233bee2..14222cfd25 100644 --- a/tests/guix-package-net.sh +++ b/tests/guix-package-net.sh @@ -147,7 +147,7 @@ test "`readlink_base "$profile"`" = "$profile-2-link" # Make sure LIBRARY_PATH gets listed by `--search-paths'. guix package --bootstrap -p "$profile" -i guile-bootstrap -i gcc-bootstrap -guix package --search-paths -p "$profile" | grep LIBRARY_PATH +guix package -p "$profile" --search-paths | grep LIBRARY_PATH # Roll back so we can delete #3 below. guix package -p "$profile" --switch-generation=2 diff --git a/tests/guix-package.sh b/tests/guix-package.sh index a732110d5c..b361b1ba00 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -52,8 +52,13 @@ test -L "$profile" && test -L "$profile-1-link" test -f "$profile/bin/guile" # No search path env. var. here. -guix package --search-paths -p "$profile" -test "`guix package --search-paths -p "$profile" | wc -l`" = 0 +guix package -p "$profile" --search-paths +guix package -p "$profile" --search-paths | grep '^export PATH=' +test "`guix package -p "$profile" --search-paths | wc -l`" = 1 # $PATH +( set -e; set -x; \ + eval `guix package --search-paths=prefix -p "$PWD/$profile"`; \ + test "`type -P guile`" = "$PWD/$profile/bin/guile" ; \ + type -P rm ) # Exit with 1 when a generation does not exist. if guix package -p "$profile" --delete-generations=42; @@ -237,3 +242,31 @@ export GUIX_BUILD_OPTIONS available2="`guix package -A | sort`" test "$available2" = "$available" guix package -I + +unset GUIX_BUILD_OPTIONS + +# Applying a manifest file. +cat > "$module_dir/manifest.scm"<<EOF +(use-package-modules bootstrap) + +(packages->manifest (list %bootstrap-guile)) +EOF +guix package --bootstrap -m "$module_dir/manifest.scm" +guix package -I | grep guile +test `guix package -I | wc -l` -eq 1 + +# Error reporting. +cat > "$module_dir/manifest.scm"<<EOF +(use-package-modules bootstrap) +(packages->manifest + (list %bootstrap-guile + wonderful-package-that-does-not-exist)) +EOF +if guix package --bootstrap -n -m "$module_dir/manifest.scm" \ + 2> "$module_dir/stderr" +then false +else + cat "$module_dir/stderr" + grep "manifest.scm:[1-3]:.*[Uu]nbound variable.*wonderful-package" \ + "$module_dir/stderr" +fi diff --git a/tests/guix-register.sh b/tests/guix-register.sh index 7084ac6b8c..360cf55979 100644 --- a/tests/guix-register.sh +++ b/tests/guix-register.sh @@ -56,15 +56,14 @@ guile -c " (exit (= (stat:ino (stat \"$new_file\")) (stat:ino (stat \"$new_file2\"))))" -# Make sure both are valid, and delete them. +# Make sure both are valid. guile -c " (use-modules (guix store)) (define s (open-connection)) (exit (and (valid-path? s \"$new_file\") (valid-path? s \"$new_file2\") (null? (references s \"$new_file\")) - (null? (references s \"$new_file2\")) - (pair? (delete-paths s (list \"$new_file\" \"$new_file2\")))))" + (null? (references s \"$new_file2\"))))" # @@ -98,6 +97,33 @@ guix-register --prefix "$new_store" "$closure" guix-register -p "$new_store" \ --state-directory "$new_store/chbouib" "$closure" +# Register duplicate files. +cp "$new_file" "$new_file2" "$new_store_dir" +guix-register -p "$new_store" <<EOF +$new_file + +0 +EOF +guix-register -p "$new_store" <<EOF +$new_file2 + +0 +EOF + +copied_duplicate1="$new_store_dir/`basename $new_file`" +copied_duplicate2="$new_store_dir/`basename $new_file2`" + +# Make sure there is indeed deduplication under $new_store and that there are +# no cross-store hard links. +guile -c " + (exit (and (= (stat:ino (stat \"$copied_duplicate1\")) + (stat:ino (stat \"$copied_duplicate2\"))) + (not (= (stat:ino (stat \"$new_file\")) + (stat:ino (stat \"$copied_duplicate1\"))))))" + +# Delete them. +guix gc -d "$new_file" "$new_file2" + # Now make sure this is recognized as valid. ls -R "$new_store" @@ -107,12 +133,13 @@ do NIX_STATE_DIR="$new_store$state_dir" NIX_LOG_DIR="$new_store$state_dir/log/guix" NIX_DB_DIR="$new_store$state_dir/db" + GUIX_DAEMON_SOCKET="$NIX_STATE_DIR/daemon-socket/socket" export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR NIX_STATE_DIR \ - NIX_LOG_DIR NIX_DB_DIR + NIX_LOG_DIR NIX_DB_DIR GUIX_DAEMON_SOCKET # Check whether we overflow the limitation on local socket name lengths. - if [ `echo "$NIX_STATE_DIR/daemon-socket/socket" | wc -c` -ge 108 ] + if [ `echo "$GUIX_DAEMON_SOCKET" | wc -c` -ge 108 ] then # Mark the test as skipped even though we already did some work so # that the remainder is not silently skipped. @@ -130,9 +157,12 @@ do # that name in a 'valid-path?' query because 'assertStorePath' would kill # us because of the wrong prefix. So we just list dead paths instead. guile -c " - (use-modules (guix store)) - (define s (open-connection)) - (exit (equal? (list \"$copied\") (dead-paths s)))" + (use-modules (guix store) (srfi srfi-1)) + (define s (open-connection \"$GUIX_DAEMON_SOCKET\")) + (exit (lset= string=? + (pk 1 (list \"$copied\" \"$copied_duplicate1\" + \"$copied_duplicate2\")) + (pk 2 (dead-paths s))))" # Kill the daemon so we can access the database below (otherwise we may # get "database is locked" errors.) diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 1b77d1a0db..4289db2390 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -45,6 +45,32 @@ else fi +# Reporting of unbound variables. + +cat > "$tmpfile" <<EOF +(use-modules (gnu)) ; 1 +(use-service-modules networking) ; 2 + +(operating-system ; 4 + (host-name "antelope") ; 5 + (timezone "Europe/Paris") ; 6 + (locale "en_US.UTF-8") ; 7 + + (bootloader (GRUB-config (device "/dev/sdX"))) ; 9 + (file-systems (cons (file-system + (device "root") + (title 'label) + (mount-point "/") + (type "ext4")) + %base-file-systems))) +EOF + +if guix system build "$tmpfile" -n 2> "$errorfile" +then false +else + grep "$tmpfile:9:.*[Uu]nbound variable.*GRUB-config" "$errorfile" +fi + # Reporting of duplicate service identifiers. cat > "$tmpfile" <<EOF @@ -76,3 +102,42 @@ then else grep "service 'networking'.*more than once" "$errorfile" fi + +make_user_config () +{ + cat > "$tmpfile" <<EOF +(use-modules (gnu)) +(use-service-modules networking) + +(operating-system + (host-name "antelope") + (timezone "Europe/Paris") + (locale "en_US.UTF-8") + + (bootloader (grub-configuration (device "/dev/sdX"))) + (file-systems (cons (file-system + (device "root") + (title 'label) + (mount-point "/") + (type "ext4")) + %base-file-systems)) + (users (list (user-account + (name "dave") + (home-directory "/home/dave") + (group "$1") + (supplementary-groups '("$2")))))) +EOF +} + +make_user_config "users" "wheel" +guix system build "$tmpfile" -n # succeeds + +make_user_config "group-that-does-not-exist" "users" +if guix system build "$tmpfile" -n 2> "$errorfile" +then false +else grep "primary group.*group-that-does-not-exist.*undeclared" "$errorfile"; fi + +make_user_config "users" "group-that-does-not-exist" +if guix system build "$tmpfile" -n 2> "$errorfile" +then false +else grep "supplementary group.*group-that-does-not-exist.*undeclared" "$errorfile"; fi diff --git a/tests/hackage.scm b/tests/hackage.scm index 23b854caa4..229bee35ea 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (test-hackage) + #:use-module (guix import cabal) #:use-module (guix import hackage) #:use-module (guix tests) #:use-module (srfi srfi-64) @@ -35,44 +36,44 @@ executable cabal mtl >= 2.0 && < 3 ") -;; Use TABs to indent lines and to separate keys from value. (define test-cabal-2 - "name: foo -version: 1.0.0 -homepage: http://test.org -synopsis: synopsis -description: description -license: BSD3 -executable cabal - build-depends: HTTP >= 4000.2.5 && < 4000.3, - mtl >= 2.0 && < 3 -") - -;; Use indentation with comma as found, e.g., in 'haddock-api'. -(define test-cabal-3 "name: foo version: 1.0.0 homepage: http://test.org synopsis: synopsis description: description license: BSD3 -executable cabal - build-depends: - HTTP >= 4000.2.5 && < 4000.3 - , mtl >= 2.0 && < 3 +executable cabal { +build-depends: + HTTP >= 4000.2.5 && < 4000.3, + mtl >= 2.0 && < 3 +} ") -(define test-cond-1 - "(os(darwin) || !(flag(debug))) && flag(cips)") - -(define read-cabal - (@@ (guix import hackage) read-cabal)) - -(define eval-cabal-keywords - (@@ (guix import hackage) eval-cabal-keywords)) - -(define conditional->sexp-like - (@@ (guix import hackage) conditional->sexp-like)) +;; A fragment of a real Cabal file with minor modification to check precedence +;; of 'and' over 'or'. +(define test-read-cabal-1 + "name: test-me +library + -- Choose which library versions to use. + if flag(base4point8) + Build-depends: base >= 4.8 && < 5 + else + if flag(base4) + Build-depends: base >= 4 && < 4.8 + else + if flag(base3) + Build-depends: base >= 3 && < 4 + else + Build-depends: base < 3 + if flag(base4point8) || flag(base4) && flag(base3) + Build-depends: random + Build-depends: containers + + -- Modules that are always built. + Exposed-Modules: + Test.QuickCheck.Exception +") (test-begin "hackage") @@ -115,18 +116,25 @@ executable cabal (test-assert "hackage->guix-package test 2" (eval-test-with-cabal test-cabal-2)) -(test-assert "hackage->guix-package test 3" - (eval-test-with-cabal test-cabal-3)) - -(test-assert "conditional->sexp-like" - (match - (eval-cabal-keywords - (conditional->sexp-like test-cond-1) - '(("debug" . "False"))) - (('and ('or ('string-match "darwin" ('%current-system)) ('not '#f)) '#t) +(test-assert "read-cabal test 1" + (match (call-with-input-string test-read-cabal-1 read-cabal) + ((("name" ("test-me")) + ('section 'library + (('if ('flag "base4point8") + (("build-depends" ("base >= 4.8 && < 5"))) + (('if ('flag "base4") + (("build-depends" ("base >= 4 && < 4.8"))) + (('if ('flag "base3") + (("build-depends" ("base >= 3 && < 4"))) + (("build-depends" ("base < 3")))))))) + ('if ('or ('flag "base4point8") + ('and ('flag "base4") ('flag "base3"))) + (("build-depends" ("random"))) + ()) + ("build-depends" ("containers")) + ("exposed-modules" ("Test.QuickCheck.Exception"))))) #t) - (x - (pk 'fail x #f)))) + (x (pk 'fail x #f)))) (test-end "hackage") diff --git a/tests/monads.scm b/tests/monads.scm index 57a8e66797..d3ef065f24 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -103,6 +103,19 @@ %monads %monad-run)) +(test-assert ">>= with more than two arguments" + (every (lambda (monad run) + (let ((1+ (lift1 1+ monad)) + (2* (lift1 (cut * 2 <>) monad))) + (with-monad monad + (let ((number (random 777))) + (= (run (>>= (return number) + 1+ 1+ 1+ + 2* 2* 2*)) + (* 8 (+ number 3))))))) + %monads + %monad-run)) + (test-assert "mbegin" (every (lambda (monad run) (with-monad monad @@ -163,7 +176,7 @@ (test-assert "mapm" (every (lambda (monad run) (with-monad monad - (equal? (run (mapm monad (lift1 1+ monad) (map return (iota 10)))) + (equal? (run (mapm monad (lift1 1+ monad) (iota 10))) (map 1+ (iota 10))))) %monads %monad-run)) @@ -202,11 +215,12 @@ (test-assert "anym" (every (lambda (monad run) (eq? (run (with-monad monad - (let ((lst (list (return 1) (return 2) (return 3)))) - (anym monad - (lambda (x) - (and (odd? x) 'odd!)) - lst)))) + (anym monad + (lift1 (lambda (x) + (and (odd? x) 'odd!)) + monad) + (append (make-list 1000 0) + (list 1 2))))) 'odd!)) %monads %monad-run)) diff --git a/tests/packages.scm b/tests/packages.scm index 4e52813659..511ad78b6c 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -155,6 +155,36 @@ (package-transitive-supported-systems d) (package-transitive-supported-systems e)))) +(let* ((o (dummy-origin)) + (u (dummy-origin)) + (i (dummy-origin)) + (a (dummy-package "a")) + (b (dummy-package "b" + (inputs `(("a" ,a) ("i" ,i))))) + (c (package (inherit b) (source o))) + (d (dummy-package "d" + (build-system trivial-build-system) + (source u) (inputs `(("c" ,c)))))) + (test-assert "package-direct-sources, no source" + (null? (package-direct-sources a))) + (test-equal "package-direct-sources, #f source" + (list i) + (package-direct-sources b)) + (test-equal "package-direct-sources, not input source" + (list u) + (package-direct-sources d)) + (test-assert "package-direct-sources" + (let ((s (package-direct-sources c))) + (and (= (length (pk 's-sources s)) 2) + (member o s) + (member i s)))) + (test-assert "package-transitive-sources" + (let ((s (package-transitive-sources d))) + (and (= (length (pk 'd-sources s)) 3) + (member o s) + (member i s) + (member u s))))) + (test-equal "package-transitive-supported-systems, implicit inputs" %supported-systems diff --git a/tests/profiles.scm b/tests/profiles.scm index 54fbaea864..cc9a822cee 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -24,10 +24,14 @@ #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix derivations) + #:use-module (guix build-system trivial) #:use-module (gnu packages bootstrap) #:use-module ((gnu packages base) #:prefix packages:) + #:use-module ((gnu packages guile) #:prefix packages:) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (ice-9 popen) + #:use-module (rnrs io ports) #:use-module (srfi srfi-11) #:use-module (srfi srfi-64)) @@ -198,6 +202,109 @@ #:hooks '()))) (return (derivation-inputs drv)))) +(test-assertm "profile-manifest, search-paths" + (mlet* %store-monad + ((guile -> (package + (inherit %bootstrap-guile) + (native-search-paths + (package-native-search-paths packages:guile-2.0)))) + (entry -> (package->manifest-entry guile)) + (drv (profile-derivation (manifest (list entry)) + #:hooks '())) + (profile -> (derivation->output-path drv))) + (mbegin %store-monad + (built-derivations (list drv)) + + ;; Read the manifest back and make sure search paths are preserved. + (let ((manifest (profile-manifest profile))) + (match (manifest-entries manifest) + ((result) + (return (equal? (manifest-entry-search-paths result) + (manifest-entry-search-paths entry) + (package-native-search-paths + packages:guile-2.0))))))))) + +(test-assertm "etc/profile" + ;; Make sure we get an 'etc/profile' file that at least defines $PATH. + (mlet* %store-monad + ((guile -> (package + (inherit %bootstrap-guile) + (native-search-paths + (package-native-search-paths packages:guile-2.0)))) + (entry -> (package->manifest-entry guile)) + (drv (profile-derivation (manifest (list entry)) + #:hooks '())) + (profile -> (derivation->output-path drv))) + (mbegin %store-monad + (built-derivations (list drv)) + (let* ((pipe (open-input-pipe + (string-append "unset GUIX_PROFILE; " + ;; 'source' is a Bashism; use '.' (dot). + ". " profile "/etc/profile; " + ;; Don't try to parse set(1) output because + ;; it differs among shells; just use echo. + "echo $PATH"))) + (path (get-string-all pipe))) + (return + (and (zero? (close-pipe pipe)) + (string-contains path (string-append profile "/bin")))))))) + +(test-assertm "etc/profile when etc/ already exists" + ;; Here 'union-build' makes the profile's etc/ a symlink to the package's + ;; etc/ directory, which makes it read-only. Make sure the profile build + ;; handles that. + (mlet* %store-monad + ((thing -> (dummy-package "dummy" + (build-system trivial-build-system) + (arguments + `(#:guile ,%bootstrap-guile + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (mkdir (string-append out "/etc")) + (call-with-output-file (string-append out "/etc/foo") + (lambda (port) + (display "foo!" port)))))))) + (entry -> (package->manifest-entry thing)) + (drv (profile-derivation (manifest (list entry)) + #:hooks '())) + (profile -> (derivation->output-path drv))) + (mbegin %store-monad + (built-derivations (list drv)) + (return (and (file-exists? (string-append profile "/etc/profile")) + (string=? (call-with-input-file + (string-append profile "/etc/foo") + get-string-all) + "foo!")))))) + +(test-assertm "etc/profile when etc/ is a symlink" + ;; When etc/ is a symlink, the unsymlink code in 0.8.2 would fail + ;; gracelessly because 'scandir' would return #f. + (mlet* %store-monad + ((thing -> (dummy-package "dummy" + (build-system trivial-build-system) + (arguments + `(#:guile ,%bootstrap-guile + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (mkdir (string-append out "/foo")) + (symlink "foo" (string-append out "/etc")) + (call-with-output-file (string-append out "/etc/bar") + (lambda (port) + (display "foo!" port)))))))) + (entry -> (package->manifest-entry thing)) + (drv (profile-derivation (manifest (list entry)) + #:hooks '())) + (profile -> (derivation->output-path drv))) + (mbegin %store-monad + (built-derivations (list drv)) + (return (and (file-exists? (string-append profile "/etc/profile")) + (string=? (call-with-input-file + (string-append profile "/etc/bar") + get-string-all) + "foo!")))))) + (test-end "profiles") diff --git a/tests/store.scm b/tests/store.scm index eeceed45c1..faa924fce9 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -600,6 +600,60 @@ (null? (valid-derivers %store file)) (null? (referrers %store file)))))) +(test-assert "verify-store" + (let* ((text (random-text)) + (file1 (add-text-to-store %store "foo" text)) + (file2 (add-text-to-store %store "bar" (random-text) + (list file1)))) + (and (pk 'verify1 (verify-store %store)) ;hopefully OK ; + (begin + (delete-file file1) + (not (pk 'verify2 (verify-store %store)))) ;bad! ; + (begin + ;; Using 'add-text-to-store' here wouldn't work: It would succeed ; + ;; without actually creating the file. ; + (call-with-output-file file1 + (lambda (port) + (display text port))) + (pk 'verify3 (verify-store %store)))))) ;OK again + +(test-assert "verify-store + check-contents" + ;; XXX: This test is I/O intensive. + (with-store s + (let* ((text (random-text)) + (drv (build-expression->derivation + s "corrupt" + `(let ((out (assoc-ref %outputs "out"))) + (call-with-output-file out + (lambda (port) + (display ,text port))) + #t) + #:guile-for-build + (package-derivation s %bootstrap-guile (%current-system)))) + (file (derivation->output-path drv))) + (with-derivation-substitute drv text + (and (build-derivations s (list drv)) + (verify-store s #:check-contents? #t) ;should be OK + (begin + (chmod file #o644) + (call-with-output-file file + (lambda (port) + (display "corrupt!" port))) + #t) + + ;; Make sure the corruption is detected. We don't test repairing + ;; because only "trusted" users are allowed to do it, but we + ;; don't expose that notion of trusted users that nix-daemon + ;; supports because it seems dubious and redundant with what the + ;; OS provides (in Nix "trusted" users have additional + ;; privileges, such as overriding the set of substitute URLs, but + ;; we instead want to allow anyone to modify them, provided + ;; substitutes are signed by a root-approved key.) + (not (verify-store s #:check-contents? #t)) + + ;; Delete the corrupt item to leave the store in a clean state. + (delete-paths s (list file))))))) + (test-equal "store-lower" "Lowered." (let* ((add (store-lower text-file)) diff --git a/tests/utils.scm b/tests/utils.scm index a662c9a8d3..115868c857 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; ;;; This file is part of GNU Guix. @@ -21,6 +21,7 @@ #:use-module ((guix config) #:select (%gzip)) #:use-module (guix utils) #:use-module ((guix store) #:select (%store-prefix store-path-package-name)) + #:use-module ((guix search-paths) #:select (string-tokenize*)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-64) |