From b24d1cfc85cba1024d7396f3ad625c5fc3cf926b Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Mon, 2 Sep 2013 21:48:50 +0200 Subject: gnu: python: Revert 77c7f8f4 and make Python 3 the default. * gnu/packages/python.scm (python-3): Rename this to... * gnu/packages/python.scm (python): ...this, rename this to... * gnu/packages/python.scm (python-2): ...this. --- gnu/packages/python.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 493068adde..0a3977aabb 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -31,7 +31,7 @@ #:use-module (guix build-system gnu) #:use-module (guix build-system python)) -(define-public python +(define-public python-2 (package (name "python") (version "2.7.5") @@ -151,8 +151,8 @@ packages; exception-based error handling; and very high level dynamic data types.") (license psfl))) -(define-public python-3 - (package (inherit python) +(define-public python + (package (inherit python-2) (version "3.3.2") (source (origin -- cgit v1.2.3 From 898238b9f5199aaebffa508f62a2a00854370048 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Tue, 3 Sep 2013 21:27:40 +0200 Subject: gnu: python: Add package python-wrapper. * gnu/packages/python.scm (python-wrapper): New variable. --- gnu/packages/python.scm | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 0a3977aabb..33082a6d94 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -29,7 +29,8 @@ #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) - #:use-module (guix build-system python)) + #:use-module (guix build-system python) + #:use-module (guix build-system trivial)) (define-public python-2 (package @@ -167,6 +168,31 @@ data types.") (variable "PYTHONPATH") (directories '("lib/python3.3/site-packages"))))))) +(define-public python-wrapper + (package (inherit python) + (name "python-wrapper") + (source #f) + (build-system trivial-build-system) + (inputs `(("python" ,python))) + (arguments + `(#:modules ((guix build utils)) + #:builder + (begin + (use-modules (guix build utils)) + (let ((bin (string-append (assoc-ref %outputs "out") "/bin")) + (python (string-append (assoc-ref %build-inputs "python") "/bin/"))) + (mkdir-p bin) + (for-each + (lambda (old new) + (symlink (string-append python old) + (string-append bin "/" new))) + `("python3", "pydoc3", "idle3") + `("python", "pydoc", "idle")))))) + (description (string-append (package-description python) + "\n\nThis wrapper package provides symbolic links to the python binaries + without version suffix.")))) + + (define-public pytz (package (name "pytz") -- cgit v1.2.3 From ee3e314bb7ba376c7e8c95c3da1f64ba07d57847 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Tue, 3 Sep 2013 22:18:39 +0200 Subject: gnu: python: Replace input python by python-wrapper. * gnu/packages/{gdb.scm (gdb), cryptsetup.scm (cryptsetup), ghostscript.scm (ghostscript), glib.scm (glib), gnupg.scm (pius), gtk.scm (cairo, harfbuzz), libevent.scm (libevent), netpbm.scm (netpbm), oggvorbis.scm (libkate), qemu.scm (qemu), samba.scm (samba), texlive.scm (rubber, texlive), version-control.scm (subversion), xml.scm (libxml2, libxslt), xorg.scm (libxcb, mesa, xcb-proto, xorg-server), yasm.scm (yasm), zip.scm (zziplib)}: Replace input python by python-wrapper. --- gnu/packages/cryptsetup.scm | 2 +- gnu/packages/gdb.scm | 2 +- gnu/packages/ghostscript.scm | 2 +- gnu/packages/glib.scm | 2 +- gnu/packages/gnupg.scm | 2 +- gnu/packages/gtk.scm | 4 ++-- gnu/packages/libevent.scm | 2 +- gnu/packages/netpbm.scm | 2 +- gnu/packages/oggvorbis.scm | 2 +- gnu/packages/qemu.scm | 2 +- gnu/packages/samba.scm | 2 +- gnu/packages/texlive.scm | 4 ++-- gnu/packages/version-control.scm | 2 +- gnu/packages/xml.scm | 4 ++-- gnu/packages/xorg.scm | 8 ++++---- gnu/packages/yasm.scm | 2 +- gnu/packages/zip.scm | 2 +- 17 files changed, 23 insertions(+), 23 deletions(-) diff --git a/gnu/packages/cryptsetup.scm b/gnu/packages/cryptsetup.scm index c746e28721..8645e9e04a 100644 --- a/gnu/packages/cryptsetup.scm +++ b/gnu/packages/cryptsetup.scm @@ -45,7 +45,7 @@ `(("libgcrypt" ,libgcrypt) ("lvm2" ,lvm2) ("popt" ,popt) - ("python" ,python) + ("python" ,python-wrapper) ("util-linux" ,util-linux))) (synopsis "hard disk encryption tool") (description diff --git a/gnu/packages/gdb.scm b/gnu/packages/gdb.scm index 4cf6b90cc3..5190283895 100644 --- a/gnu/packages/gdb.scm +++ b/gnu/packages/gdb.scm @@ -53,7 +53,7 @@ ("gmp" ,gmp) ("readline" ,readline) ("ncurses" ,ncurses) - ("python" ,python) + ("python" ,python-wrapper) ("texinfo" ,texinfo) ("dejagnu" ,dejagnu))) (home-page "http://www.gnu.org/software/gdb/") diff --git a/gnu/packages/ghostscript.scm b/gnu/packages/ghostscript.scm index dd6c576cdf..7df1f6c17e 100644 --- a/gnu/packages/ghostscript.scm +++ b/gnu/packages/ghostscript.scm @@ -136,7 +136,7 @@ printing, and psresize, for adjusting page sizes.") ("libtiff" ,libtiff) ("perl" ,perl) ("pkg-config" ,pkg-config) ; needed to find libtiff - ("python" ,python) + ("python" ,python-wrapper) ("tcl" ,tcl) ("zlib" ,zlib))) (arguments diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm index 63751bb510..72479f21e7 100644 --- a/gnu/packages/glib.scm +++ b/gnu/packages/glib.scm @@ -92,7 +92,7 @@ shared NFS home directories.") ("gettext" ,guix:gettext) ("libffi" ,libffi) ("pkg-config" ,pkg-config) - ("python" ,python) + ("python" ,python-wrapper) ("zlib" ,zlib) ("perl" ,perl) ; needed by GIO tests ("dbus" ,dbus) ; for GDBus tests diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index 604ebc2941..7c0f50900a 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -191,7 +191,7 @@ S/MIME.") "1g1jly3wl4ks6h8ydkygyl2c4i7v3z91rg42005m6vm70y1d8b3d")))) (build-system gnu-build-system) (inputs `(("perl" ,perl) - ("python" ,python) + ("python" ,python-wrapper) ("gpg" ,gnupg))) (arguments `(#:tests? #f diff --git a/gnu/packages/gtk.scm b/gnu/packages/gtk.scm index 742cbf172e..e72f7c5acc 100644 --- a/gnu/packages/gtk.scm +++ b/gnu/packages/gtk.scm @@ -83,7 +83,7 @@ tools have full access to view and control running applications.") ("libspectre" ,libspectre) ("pkg-config" ,pkg-config) ("poppler" ,poppler) - ("python" ,python) + ("python" ,python-wrapper) ("xextproto" ,xextproto) ("zlib" ,zlib))) (arguments @@ -123,7 +123,7 @@ affine transformation (scale, rotation, shear, etc.)") `(("cairo" ,cairo) ("icu4c" ,icu4c) ("pkg-config" ,pkg-config) - ("python" ,python))) + ("python" ,python-wrapper))) (synopsis "opentype text shaping engine") (description "HarfBuzz is an OpenType text shaping engine.") diff --git a/gnu/packages/libevent.scm b/gnu/packages/libevent.scm index ccca427fc4..8f2d5dad46 100644 --- a/gnu/packages/libevent.scm +++ b/gnu/packages/libevent.scm @@ -44,7 +44,7 @@ ;; Dependencies used for the tests and for `event_rpcgen.py'. ("which" ,which) - ("python" ,python))) + ("python" ,python-wrapper))) (arguments '(#:patches (list (assoc-ref %build-inputs "patch/dns-tests")))) (home-page "http://libevent.org/") diff --git a/gnu/packages/netpbm.scm b/gnu/packages/netpbm.scm index d2213b8f0d..c8d3603701 100644 --- a/gnu/packages/netpbm.scm +++ b/gnu/packages/netpbm.scm @@ -57,7 +57,7 @@ ("libxml2" ,libxml2) ("perl" ,perl) ("pkg-config" ,pkg-config) - ("python" ,python) + ("python" ,python-wrapper) ("zlib" ,zlib))) (arguments `(#:phases diff --git a/gnu/packages/oggvorbis.scm b/gnu/packages/oggvorbis.scm index 2aa606ca22..589828be0a 100644 --- a/gnu/packages/oggvorbis.scm +++ b/gnu/packages/oggvorbis.scm @@ -191,7 +191,7 @@ meaning that audio is compressed in FLAC without any loss in quality.") ("libogg" ,libogg) ("libpng" ,libpng) ("pkg-config" ,pkg-config) - ("python" ,python) + ("python" ,python-wrapper) ("zlib" ,zlib))) (synopsis "kate, a karaoke and text codec for embedding in ogg") (description diff --git a/gnu/packages/qemu.scm b/gnu/packages/qemu.scm index 9c9355c4d6..2ca34ad9c7 100644 --- a/gnu/packages/qemu.scm +++ b/gnu/packages/qemu.scm @@ -94,7 +94,7 @@ `(;; ("mesa" ,mesa) ;; ("libaio" ,libaio) ("glib" ,glib) - ("python" ,python) + ("python" ,python-wrapper) ("ncurses" ,ncurses) ("libpng" ,libpng) ("libjpeg" ,libjpeg-8) diff --git a/gnu/packages/samba.scm b/gnu/packages/samba.scm index b016442908..e0199bce90 100644 --- a/gnu/packages/samba.scm +++ b/gnu/packages/samba.scm @@ -150,7 +150,7 @@ anywhere.") ("patchelf" ,patchelf))) ; for (guix build rpath) (native-inputs ; for the test suite `(("perl" ,perl) - ("python" ,python))) + ("python" ,python-wrapper))) (home-page "http://www.samba.org/") (synopsis "The standard Windows interoperability suite of programs for GNU and Unix") diff --git a/gnu/packages/texlive.scm b/gnu/packages/texlive.scm index a0d57444e3..0240def785 100644 --- a/gnu/packages/texlive.scm +++ b/gnu/packages/texlive.scm @@ -81,7 +81,7 @@ ("pkg-config" ,pkg-config) ;; FIXME: Add interpreters fontforge and ruby, ;; once they are available. - ("python" ,python) + ("python" ,python-wrapper) ("tcsh" ,tcsh) ("teckit" ,teckit) ("t1lib" ,t1lib) @@ -202,7 +202,7 @@ world.") (build-system gnu-build-system) (arguments '(#:tests? #f)) ; no `check' target (inputs `(("texinfo" ,texinfo) - ("python" ,python) + ("python" ,python-wrapper) ("which" ,which))) (home-page "https://launchpad.net/rubber") (synopsis "Rubber, a wrapper for LaTeX and friends") diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 14404f0bfe..ed64b460db 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -126,7 +126,7 @@ everything from small to very large projects with speed and efficiency.") `(("apr" ,apr) ("apr-util" ,apr-util) ("perl" ,perl) - ("python" ,python) + ("python" ,python-wrapper) ("sqlite" ,sqlite) ("zlib" ,zlib))) (home-page "http://subversion.apache.org/") diff --git a/gnu/packages/xml.scm b/gnu/packages/xml.scm index 2f9d64b81a..5b031ac512 100644 --- a/gnu/packages/xml.scm +++ b/gnu/packages/xml.scm @@ -66,7 +66,7 @@ things the parser might find in the XML document (like start tags).") (home-page "http://www.xmlsoft.org/") (synopsis "libxml2, a C parser for XML") (inputs `(("perl" ,perl) - ("python" ,python) + ("python" ,python-wrapper) ("zlib" ,zlib))) (arguments `(#:phases @@ -102,7 +102,7 @@ things the parser might find in the XML document (like start tags).") (synopsis "libxslt, a C library for applying XSLT stylesheets to XML documents") (inputs `(("libgcrypt" ,libgcrypt) ("libxml2" ,libxml2) - ("python" ,python) + ("python" ,python-wrapper) ("zlib" ,zlib))) (description "Libxslt is an XSLT C library developed for the GNOME project. It is diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm index 5f07401e98..bc9e05fdb5 100644 --- a/gnu/packages/xorg.scm +++ b/gnu/packages/xorg.scm @@ -1857,7 +1857,7 @@ tracking.") "0ds4qg6slidrzyz6q9ckq0a19hn6blzpnvciy4brh741gn49jpdd")))) (build-system gnu-build-system) (inputs - `(("pkg-config" ,pkg-config) ("python" ,python))) + `(("pkg-config" ,pkg-config) ("python" ,python-wrapper))) (home-page "http://www.x.org/wiki/") (synopsis "xorg implementation of the X Window System") (description "X.org provides an implementation of the X Window System") @@ -4169,7 +4169,7 @@ tracking.") ("libxml2" ,libxml2) ("makedepend" ,makedepend) ("pkg-config" ,pkg-config) - ("python" ,python))) + ("python" ,python-wrapper))) (arguments `(#:configure-flags `("--with-gallium-drivers=r600,svga,swrast") ; drop r300 from the default list as it requires llvm @@ -4215,7 +4215,7 @@ emulation to complete hardware acceleration for modern GPUs.") `(("xcb-proto" ,xcb-proto) ("libxslt" ,libxslt) ("pkg-config" ,pkg-config) - ("python" ,python))) + ("python" ,python-wrapper))) (home-page "http://www.x.org/wiki/") (synopsis "xorg implementation of the X Window System") (description "X.org provides an implementation of the X Window System") @@ -4270,7 +4270,7 @@ emulation to complete hardware acceleration for modern GPUs.") ("mesa" ,mesa) ("openssl" ,openssl) ("pkg-config" ,pkg-config) - ("python" ,python) + ("python" ,python-wrapper) ("recordproto" ,recordproto) ("resourceproto" ,resourceproto) ("scrnsaverproto" ,scrnsaverproto) diff --git a/gnu/packages/yasm.scm b/gnu/packages/yasm.scm index 51cd3ed0a5..a990d08174 100644 --- a/gnu/packages/yasm.scm +++ b/gnu/packages/yasm.scm @@ -40,7 +40,7 @@ "0cfg7ji3ia2in628w42wrfvw2ixmmm4rghwmv2k202mraysgm3vn")))) (build-system gnu-build-system) (inputs - `(("python" ,python) + `(("python" ,python-wrapper) ("xmlto" ,xmlto))) (home-page "http://yasm.tortall.net/") (synopsis "Rewrite of the NASM assembler") diff --git a/gnu/packages/zip.scm b/gnu/packages/zip.scm index 934acdc316..c419b08e9f 100644 --- a/gnu/packages/zip.scm +++ b/gnu/packages/zip.scm @@ -120,7 +120,7 @@ UnZip recreates the stored directory structure by default.") (build-system gnu-build-system) (inputs `(("perl" ,perl) ; for the documentation ("pkg-config" ,pkg-config) - ("python" ,python) ; for the documentation + ("python" ,python-wrapper) ; for the documentation ("zip" ,zip) ; to create test files ("zlib" ,zlib))) (arguments -- cgit v1.2.3 From 3df47231e6c632aadcd7b103bb5b399a8d29772d Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 4 Sep 2013 18:04:15 +0200 Subject: guix: python: Switch to python-wrapper as the default version for the python build system (switches to Python 3) and compute python-version instead of passing it as a parameter. * guix/build-system/python.scm (default-python): Switch to python-wrapper. * guix/build-system/python.scm (python-build): Drop parameter #:python-version. * guix/build/python-build-system.scm (wrap): Compute python version from input. --- guix/build-system/python.scm | 6 ++---- guix/build/python-build-system.scm | 4 +++- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index b60adb182f..7ac93b296b 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -39,13 +39,11 @@ "Return the default Python package." ;; Lazily resolve the binding to avoid a circular dependency. (let ((python (resolve-interface '(gnu packages python)))) - (module-ref python 'python))) + (module-ref python 'python-wrapper))) (define* (python-build store name source inputs #:key (python (default-python)) - (python-version - (string-take (package-version (default-python)) 3)) (tests? #t) (configure-flags ''()) (phases '(@ (guix build python-build-system) @@ -62,6 +60,7 @@ (guix build utils)))) "Build SOURCE using PYTHON, and with INPUTS. This assumes that SOURCE provides a 'setup.py' file as its build system." + (define python-search-paths (append (package-native-search-paths python) (standard-search-paths))) @@ -78,7 +77,6 @@ provides a 'setup.py' file as its build system." #:test-target "test" #:tests? ,tests? #:outputs %outputs - #:python-version ,python-version #:search-paths ',(map search-path-specification->sexp (append python-search-paths search-paths)) diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm index 84299798b0..04c223bb85 100644 --- a/guix/build/python-build-system.scm +++ b/guix/build/python-build-system.scm @@ -53,7 +53,7 @@ (zero? (apply system* "python" args))) (error "no setup.py found"))) -(define* (wrap #:key outputs python-version #:allow-other-keys) +(define* (wrap #:key inputs outputs #:allow-other-keys) (define (list-of-files dir) (map (cut string-append dir "/" <>) (or (scandir dir (lambda (f) @@ -69,6 +69,8 @@ outputs)) (let* ((out (assoc-ref outputs "out")) + (python (assoc-ref inputs "python")) + (python-version (string-take (string-take-right python 5) 3)) (var `("PYTHONPATH" prefix ,(cons (string-append out "/lib/python" python-version "/site-packages") -- cgit v1.2.3 From 1611eccd106fa14e0161b7c562f3a09931ed97e1 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 4 Sep 2013 18:35:49 +0200 Subject: gnu: bazaar: Switch back to Python 2. * gnu/packages/version-control.scm (bazaar): Switch back to Python 2. --- gnu/packages/version-control.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index ed64b460db..1b0e1bd6e0 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -58,7 +58,9 @@ ;; require Zsh. `(("gettext" ,guix:gettext))) (arguments - `(#:tests? #f)) ; no test target + `(#:tests? #f ; no test target + #:python ,python-2)) ; Python 3 apparently not yet supported, see + ; https://answers.launchpad.net/bzr/+question/229048 (home-page "https://gnu.org/software/bazaar") (synopsis "Decentralized revision control system") (description -- cgit v1.2.3 From 91da9ab009d11fac66814c14a202ec7c43de590e Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 4 Sep 2013 18:40:54 +0200 Subject: gnu: zziplib: Switch back to Python 2. * gnu/packages/zip.scm (zziplib): Switch back to Python 2. --- gnu/packages/zip.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnu/packages/zip.scm b/gnu/packages/zip.scm index c419b08e9f..f505d053c6 100644 --- a/gnu/packages/zip.scm +++ b/gnu/packages/zip.scm @@ -120,7 +120,8 @@ UnZip recreates the stored directory structure by default.") (build-system gnu-build-system) (inputs `(("perl" ,perl) ; for the documentation ("pkg-config" ,pkg-config) - ("python" ,python-wrapper) ; for the documentation + ("python" ,python-2) ; for the documentation; Python 3 not supported, + ; http://forums.gentoo.org/viewtopic-t-863161-start-0.html ("zip" ,zip) ; to create test files ("zlib" ,zlib))) (arguments -- cgit v1.2.3 From f82cfaac716f2ffc15f56338b98b99d42fb0ef86 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 4 Sep 2013 18:54:53 +0200 Subject: gnu: libxml2: Switch back to Python 2. * gnu/packages/xml.scm (libxml2): Switch back to Python 2. --- gnu/packages/xml.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/xml.scm b/gnu/packages/xml.scm index 5b031ac512..28c99b1f8c 100644 --- a/gnu/packages/xml.scm +++ b/gnu/packages/xml.scm @@ -66,7 +66,7 @@ things the parser might find in the XML document (like start tags).") (home-page "http://www.xmlsoft.org/") (synopsis "libxml2, a C parser for XML") (inputs `(("perl" ,perl) - ("python" ,python-wrapper) + ("python" ,python-2) ; incompatible with Python 3 (print syntax) ("zlib" ,zlib))) (arguments `(#:phases -- cgit v1.2.3 From 98e4829c4bda0b0a3bffad6ac6da8307f58ea5f9 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 4 Sep 2013 19:03:14 +0200 Subject: gnu: mesa: Switch back to Python 2. * gnu/packages/xorg.scm (mesa): Switch back to Python 2. --- gnu/packages/xorg.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm index bc9e05fdb5..b7ce8ad8aa 100644 --- a/gnu/packages/xorg.scm +++ b/gnu/packages/xorg.scm @@ -4169,7 +4169,7 @@ tracking.") ("libxml2" ,libxml2) ("makedepend" ,makedepend) ("pkg-config" ,pkg-config) - ("python" ,python-wrapper))) + ("python" ,python-2))) ; incompatible with Python 3 (print syntax) (arguments `(#:configure-flags `("--with-gallium-drivers=r600,svga,swrast") ; drop r300 from the default list as it requires llvm -- cgit v1.2.3 From 9bee5d6c18de87493ed4596de8410bbb66360343 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 4 Sep 2013 19:06:51 +0200 Subject: gnu: rubber: Switch back to Python 2. * gnu/packages/texlive.scm (rubber): Switch back to Python 2. --- gnu/packages/texlive.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/texlive.scm b/gnu/packages/texlive.scm index 0240def785..223d8e9e4d 100644 --- a/gnu/packages/texlive.scm +++ b/gnu/packages/texlive.scm @@ -202,7 +202,7 @@ world.") (build-system gnu-build-system) (arguments '(#:tests? #f)) ; no `check' target (inputs `(("texinfo" ,texinfo) - ("python" ,python-wrapper) + ("python" ,python-2) ; incompatible with Python 3 (print syntax) ("which" ,which))) (home-page "https://launchpad.net/rubber") (synopsis "Rubber, a wrapper for LaTeX and friends") -- cgit v1.2.3 From 78fed0648fe5e1db0ee302fc548755422c80359b Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 4 Sep 2013 19:09:39 +0200 Subject: gnu: texlive: Switch back to Python 2. * gnu/packages/texlive.scm (texlive): Switch back to Python 2. --- gnu/packages/texlive.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/texlive.scm b/gnu/packages/texlive.scm index 223d8e9e4d..7c6f82b9c9 100644 --- a/gnu/packages/texlive.scm +++ b/gnu/packages/texlive.scm @@ -81,7 +81,7 @@ ("pkg-config" ,pkg-config) ;; FIXME: Add interpreters fontforge and ruby, ;; once they are available. - ("python" ,python-wrapper) + ("python" ,python-2) ; incompatible with Python 3 (print syntax) ("tcsh" ,tcsh) ("teckit" ,teckit) ("t1lib" ,t1lib) -- cgit v1.2.3 From 66ed0c314646c66d5f9ec586a8e5a1d079a927b0 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 4 Sep 2013 19:13:41 +0200 Subject: gnu: qemu: Switch back to Python 2. * gnu/packages/qemu.scm (qemu): Switch back to Python 2. --- gnu/packages/qemu.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/qemu.scm b/gnu/packages/qemu.scm index 2ca34ad9c7..6330fabcf9 100644 --- a/gnu/packages/qemu.scm +++ b/gnu/packages/qemu.scm @@ -94,7 +94,7 @@ `(;; ("mesa" ,mesa) ;; ("libaio" ,libaio) ("glib" ,glib) - ("python" ,python-wrapper) + ("python" ,python-2) ; incompatible with Python 3 according to error message ("ncurses" ,ncurses) ("libpng" ,libpng) ("libjpeg" ,libjpeg-8) -- cgit v1.2.3 From aa9e22efa38a88c2370591a3656b23f52d3bab64 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 4 Sep 2013 19:17:19 +0200 Subject: gnu: subversion: Switch back to Python 2. * gnu/packages/version-control.scm (subversion): Switch back to Python 2. --- gnu/packages/version-control.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 1b0e1bd6e0..0ed6ce297a 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -128,7 +128,7 @@ everything from small to very large projects with speed and efficiency.") `(("apr" ,apr) ("apr-util" ,apr-util) ("perl" ,perl) - ("python" ,python-wrapper) + ("python" ,python-2) ; incompatible with Python 3 (print syntax) ("sqlite" ,sqlite) ("zlib" ,zlib))) (home-page "http://subversion.apache.org/") -- cgit v1.2.3 From 89114f39e4be7ac655fbdd7f00a5f985c8f4ce6b Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 4 Sep 2013 22:12:33 +0200 Subject: gnu: python: Implement the python naming scheme for pytz and babel. * gnu/packages/python.scm (pytz): Rename this ... * gnu/packages/python.scm (python-pytz): ... to this * gnu/packages/python.scm (python2-pytz): New variable, input python-2. * gnu/packages/python.scm (babel): Rename this ... * gnu/packages/python.scm (python-babel): ... to this * gnu/packages/python.scm (python2-babel): New variable, input python-2. --- gnu/packages/python.scm | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 33082a6d94..a4007d963b 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -193,9 +193,9 @@ data types.") without version suffix.")))) -(define-public pytz +(define-public python-pytz (package - (name "pytz") + (name "python-pytz") (version "2013b") (source (origin @@ -213,9 +213,14 @@ data types.") using Python 2.4 or higher and provides access to the Olson timezone database.") (license x11))) -(define-public babel +(define-public python2-pytz + (package (inherit python-pytz) + (name "python2-pytz") + (arguments `(#:python ,python-2)))) + +(define-public python-babel (package - (name "babel") + (name "python-babel") (version "0.9.6") (source (origin @@ -227,7 +232,7 @@ using Python 2.4 or higher and provides access to the Olson timezone database.") "03vmr54jq5vf3qw6kpdv7cdk7x7i2jhzyf1mawv2gk8zrxg0hfja")))) (build-system python-build-system) (inputs - `(("pytz" ,pytz))) + `(("python-pytz" ,python-pytz))) (home-page "http://babel.edgewall.org/") (synopsis "Tools for internationalizing Python applications") @@ -238,3 +243,10 @@ using Python 2.4 or higher and provides access to the Olson timezone database.") access to various locale display names, localized number and date formatting, etc. ") (license bsd-3))) + +(define-public python2-babel + (package (inherit python-babel) + (name "python2-babel") + (inputs + `(("python2-pytz" ,python2-pytz))) + (arguments `(#:python ,python-2)))) -- cgit v1.2.3 From d1f30e9943bf59fa0eefe40bb9aea64df2e7a594 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Thu, 5 Sep 2013 18:13:23 +0200 Subject: gnu: git: Switch back to Python 2. * gnu/packages/version-control.scm (git): Switch back to Python 2. --- gnu/packages/version-control.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 0ed6ce297a..42b5d5fe99 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -88,7 +88,7 @@ from a command line or use a GUI application.") ("gettext" ,guix:gettext) ("openssl" ,openssl) ("perl" ,perl) - ("python" ,python) ; CAVEAT: incompatible with python-3 according to INSTALL + ("python" ,python-2) ; CAVEAT: incompatible with python-3 according to INSTALL ("zlib" ,zlib))) (arguments `(#:make-flags `("V=1") ; more verbose compilation -- cgit v1.2.3 From 7b96bf82daf25699ce6b4f4cb2ced1e5318b576f Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Thu, 5 Sep 2013 18:43:18 +0200 Subject: gnu: python: Honour #:tests? and #:test-target in build system. * guix/build/python-build-system.scm (check): Use named parameters tests? and test-target (default now: "test" instead of "check"). --- guix/build/python-build-system.scm | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm index 04c223bb85..27818526fa 100644 --- a/guix/build/python-build-system.scm +++ b/guix/build/python-build-system.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. @@ -45,13 +46,15 @@ (zero? (apply system* "python" args))) (error "no setup.py found")))) -(define* (check #:key outputs #:allow-other-keys) +(define* (check #:key outputs tests? test-target #:allow-other-keys) "Run the test suite of a given Python package." - (if (file-exists? "setup.py") - (let ((args `("setup.py" "check"))) - (format #t "running 'python' with arguments ~s~%" args) - (zero? (apply system* "python" args))) - (error "no setup.py found"))) + (if tests? + (if (file-exists? "setup.py") + (let ((args `("setup.py" ,test-target))) + (format #t "running 'python' with arguments ~s~%" args) + (zero? (apply system* "python" args))) + (error "no setup.py found")) + #t)) (define* (wrap #:key inputs outputs #:allow-other-keys) (define (list-of-files dir) -- cgit v1.2.3 From 8498b8cfac1ef63f706b0094289a3e300c8846c0 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Thu, 5 Sep 2013 18:55:27 +0200 Subject: gnu: python: Disable tests in pytz and babel. * gnu/packages/python.scm (python-pytz, python-babel): Disable tests. --- gnu/packages/python.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index a4007d963b..4baef78e7b 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -206,6 +206,7 @@ data types.") (base32 "19giwgfcrg0nr1gdv49qnmf2jb2ilkcfc7qyqvfpz4dp0p64ksv5")))) (build-system python-build-system) + (arguments `(#:tests? #f)) ; no test target (home-page "https://launchpad.net/pytz") (synopsis "The Python timezone library.") (description @@ -233,6 +234,7 @@ using Python 2.4 or higher and provides access to the Olson timezone database.") (build-system python-build-system) (inputs `(("python-pytz" ,python-pytz))) + (arguments `(#:tests? #f)) ; no test target (home-page "http://babel.edgewall.org/") (synopsis "Tools for internationalizing Python applications") -- cgit v1.2.3 From 49b90a7539f69c2ac6a86697f3b9c631a3ceca15 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Thu, 5 Sep 2013 19:07:28 +0200 Subject: gnu: python: Disable tests in python2-pytz and python2-babel. * gnu/packages/python.scm (python2-pytz, python2-babel): Disable tests. --- gnu/packages/python.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 4baef78e7b..ce89281e26 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -217,7 +217,7 @@ using Python 2.4 or higher and provides access to the Olson timezone database.") (define-public python2-pytz (package (inherit python-pytz) (name "python2-pytz") - (arguments `(#:python ,python-2)))) + (arguments (append (package-arguments python-pytz) `(#:python ,python-2))))) (define-public python-babel (package @@ -251,4 +251,4 @@ etc. ") (name "python2-babel") (inputs `(("python2-pytz" ,python2-pytz))) - (arguments `(#:python ,python-2)))) + (arguments (append (package-arguments python-babel) `(#:python ,python-2))))) -- cgit v1.2.3 From b191f88ee34576a6908b9b5e94cb7664e88c7e79 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Thu, 5 Sep 2013 20:25:08 +0200 Subject: guix: python: Add build phase and factor out calls to setup.py. * guix/build/python-build-system.scm (call-setuppy): New procedure. * guix/build/python-build-system.scm (build): New procedure. * guix/build/python-build-system.scm (check, install): Use call-setuppy. * guix/build/python-build-system.scm (%standard-phases): Add call to build. --- guix/build/python-build-system.scm | 49 ++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 21 deletions(-) diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm index 27818526fa..f213a97f01 100644 --- a/guix/build/python-build-system.scm +++ b/guix/build/python-build-system.scm @@ -35,27 +35,33 @@ ;; ;; Code: -(define* (install #:key outputs (configure-flags '()) - #:allow-other-keys) - "Install a given Python package." - (let ((out (assoc-ref outputs "out"))) - (if (file-exists? "setup.py") - (let ((args `("setup.py" "install" ,(string-append "--prefix=" out) - ,@configure-flags))) - (format #t "running 'python' with arguments ~s~%" args) - (zero? (apply system* "python" args))) - (error "no setup.py found")))) -(define* (check #:key outputs tests? test-target #:allow-other-keys) +(define (call-setuppy command params) + (if (file-exists? "setup.py") + (begin + (format #t "running \"python setup.py\" with command ~s and parameters ~s~%" + command params) + (zero? (apply system* "python" "setup.py" command params))) + (error "no setup.py found"))) + +(define* (build #:rest empty) + "Build a given Python package." + (call-setuppy "build" '())) + +(define* (check #:key tests? test-target #:allow-other-keys) "Run the test suite of a given Python package." (if tests? - (if (file-exists? "setup.py") - (let ((args `("setup.py" ,test-target))) - (format #t "running 'python' with arguments ~s~%" args) - (zero? (apply system* "python" args))) - (error "no setup.py found")) + (call-setuppy test-target '()) #t)) +(define* (install #:key outputs (configure-flags '()) + #:allow-other-keys) + "Install a given Python package." + (let* ((out (assoc-ref outputs "out")) + (params (append (list (string-append "--prefix=" out)) + configure-flags))) + (call-setuppy "install" params))) + (define* (wrap #:key inputs outputs #:allow-other-keys) (define (list-of-files dir) (map (cut string-append dir "/" <>) @@ -92,11 +98,12 @@ 'install 'wrap wrap (alist-replace - 'check check - (alist-replace 'install install - (alist-delete 'configure - (alist-delete 'build - gnu:%standard-phases)))))) + 'build build + (alist-replace + 'check check + (alist-replace 'install install + (alist-delete 'configure + gnu:%standard-phases)))))) (define* (python-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) -- cgit v1.2.3 From 11bb85a10d4a84dab7fdfaaaf7012b743ce7a09f Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 8 Sep 2013 16:57:37 +0200 Subject: guix: python: Add package-with-python2, a procedure rewriting a package to compile with Python 2 instead of the default Python 3. * guix/build-system/python.scm (default-python2, package-with-explicit-python, package-with-python2): New procedures. * guix/build-system/python.scm (python2-pytz, python2-babel): Use package-with-python2. --- gnu/packages/python.scm | 11 +++------ guix/build-system/python.scm | 54 +++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 56 insertions(+), 9 deletions(-) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index ce89281e26..3ff4da2149 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -28,6 +28,7 @@ #:use-module (gnu packages patchelf) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix utils) #:use-module (guix build-system gnu) #:use-module (guix build-system python) #:use-module (guix build-system trivial)) @@ -215,9 +216,7 @@ using Python 2.4 or higher and provides access to the Olson timezone database.") (license x11))) (define-public python2-pytz - (package (inherit python-pytz) - (name "python2-pytz") - (arguments (append (package-arguments python-pytz) `(#:python ,python-2))))) + (package-with-python2 python-pytz)) (define-public python-babel (package @@ -247,8 +246,4 @@ etc. ") (license bsd-3))) (define-public python2-babel - (package (inherit python-babel) - (name "python2-babel") - (inputs - `(("python2-pytz" ,python2-pytz))) - (arguments (append (package-arguments python-babel) `(#:python ,python-2))))) + (package-with-python2 python-babel)) diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index 7ac93b296b..d120cc9cc3 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. @@ -25,7 +26,9 @@ #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (ice-9 match) - #:export (python-build + #:use-module (srfi srfi-26) + #:export (package-with-python2 + python-build python-build-system)) ;; Commentary: @@ -41,6 +44,55 @@ (let ((python (resolve-interface '(gnu packages python)))) (module-ref python 'python-wrapper))) +(define (default-python2) + "Return the default Python 2 package." + (let ((python (resolve-interface '(gnu packages python)))) + (module-ref python 'python-2))) + +(define (package-with-explicit-python p python old-prefix new-prefix) + "Create a package with the same fields as P, which is assumed to use +PYTHON-BUILD-SYSTEM, such that it is compiled with PYTHON instead. The +inputs are changed recursively accordingly. If the name of P starts with +OLD-PREFIX, this is replaced by NEW-PREFIX; otherwise, NEW-PREFIX is +prepended to the name." + (let* ((build-system (package-build-system p)) + (rewrite-if-package + (lambda (content) + ;; CONTENT may be a string (e.g., for patches), in which case it + ;; is returned, or a package, which is rewritten with the new + ;; PYTHON and NEW-PREFIX. + (if (package? content) + (package-with-explicit-python content python + old-prefix new-prefix) + content))) + (rewrite + (match-lambda + ((name content . rest) + (append (list name (rewrite-if-package content)) rest))))) + (package (inherit p) + (name + (let ((name (package-name p))) + (if (eq? build-system python-build-system) + (string-append new-prefix + (if (string-prefix? old-prefix name) + (substring name (string-length old-prefix)) + name)) + name))) + (arguments + (let ((arguments (package-arguments p))) + (if (eq? build-system python-build-system) + (if (member #:python arguments) + (substitute-keyword-arguments arguments ((#:python p) python)) + (append arguments `(#:python ,python))) + arguments))) + (inputs + (map rewrite (package-inputs p))) + (native-inputs + (map rewrite (package-native-inputs p)))))) + +(define package-with-python2 + (cut package-with-explicit-python <> (default-python2) "python-" "python2-")) + (define* (python-build store name source inputs #:key (python (default-python)) -- cgit v1.2.3 From 8ab73e91d6550c192b750ec1457c69acbca9e711 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 8 Sep 2013 22:45:30 +0200 Subject: gnu: vm: Clear timestamps on the imported files, like in the store. * gnu/system/vm.scm (qemu-image): Clear timestamps on the copied files. --- gnu/system/vm.scm | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 73543896ef..f0f40e54a3 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -75,6 +75,9 @@ DISK-IMAGE-SIZE bytes and return it. When REFERENCES-GRAPHS is true, it must be a list of file name/store path pairs, as for `derivation'. The files containing the reference graphs are made available under the /xchg CIFS share." + ;; FIXME: Allow use of macros from other modules, as done in + ;; `build-expression->derivation'. + (define input-alist (map (match-lambda ((input (? package? package)) @@ -294,6 +297,19 @@ It can be used to provide additional files, such as /etc files." (primitive-load populate) (chdir "/"))) + (display "clearing file timestamps...\n") + (for-each (lambda (file) + (let ((s (lstat file))) + ;; XXX: Guile uses libc's 'utime' function + ;; (not 'futime'), so the timestamp of + ;; symlinks cannot be changed, and there + ;; are symlinks here pointing to + ;; /nix/store, which is the host, + ;; read-only store. + (unless (eq? (stat:type s) 'symlink) + (utime file 0 0 0 0)))) + (find-files "/fs" ".*")) + (and (zero? (system* grub "--no-floppy" "--boot-directory" "/fs/boot" -- cgit v1.2.3 From 98aeb06b41ba99dbb789e3750d17b08f10ef6dbd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 8 Sep 2013 23:52:03 +0200 Subject: gnu: vm: Create valid /etc/shadow and /etc/passwd. * gnu/system/vm.scm (/etc/passwd): Rename to... (passwd-file): ... this. Add 'shadow?' keyword parameter. Change format of ACCOUNTS, and fix CONTENTS. (example2): Adjust accordingly. Create both /etc/shadow and /etc/passwd, the latter being used by getpwnam(3) & co. when nscd is not running. --- gnu/system/vm.scm | 29 ++++++++++++++++++----------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index f0f40e54a3..059cea1a45 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -363,22 +363,28 @@ It can be used to provide additional files, such as /etc files." (lambda () (close-connection store))))) -(define (/etc/shadow store accounts) - "Return a /etc/shadow file for ACCOUNTS." +(define* (passwd-file store accounts #:key shadow?) + "Return a password file for ACCOUNTS, a list of vectors as returned by +'getpwnam'. If SHADOW? is true, then it is a /etc/shadow file, otherwise it +is a /etc/passwd file." + ;; XXX: The resulting file is world-readable, so don't rely on it! (define contents (let loop ((accounts accounts) (result '())) (match accounts - (((name uid gid comment home-dir shell) rest ...) + ((#(name pass uid gid comment home-dir shell) rest ...) (loop rest - (cons (string-append name "::" (number->string uid) + (cons (string-append name + ":" (if shadow? pass "x") + ":" (number->string uid) ":" (number->string gid) - comment ":" home-dir ":" shell) + ":" comment ":" home-dir ":" shell) result))) (() (string-concatenate-reverse result))))) - (add-text-to-store store "shadow" contents '())) + (add-text-to-store store (if shadow? "shadow" "passwd") + contents '())) (define (example2) (let ((store #f)) @@ -390,16 +396,17 @@ It can be used to provide additional files, such as /etc files." (let* ((bash-drv (package-derivation store bash)) (bash-file (string-append (derivation-path->output-path bash-drv) "/bin/bash")) - (passwd (/etc/shadow store - `(("root" 0 0 "System administrator" "/" - ,bash-file)))) + (accounts (list (vector "root" "" 0 0 "System administrator" + "/" bash-file))) + (passwd (passwd-file store accounts)) + (shadow (passwd-file store accounts #:shadow? #t)) (populate (add-text-to-store store "populate-qemu-image" (object->string `(begin (mkdir-p "etc") - (symlink ,(substring passwd 1) - "etc/shadow"))) + (symlink ,shadow "etc/shadow") + (symlink ,passwd "etc/passwd"))) (list passwd))) (out (derivation-path->output-path (package-derivation store mingetty))) -- cgit v1.2.3 From d34c0ac6e9c669702bc4957faa5ee51f2b9465c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 9 Sep 2013 21:52:14 +0200 Subject: gnu: vm: Copy /etc/shadow to the guest. * gnu/system/vm.scm (example2): Add SHADOW to #:inputs-to-copy. --- gnu/system/vm.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 059cea1a45..5128bdfd29 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -442,7 +442,8 @@ is a /etc/passwd file." ("guile" ,guile-2.0) ("mingetty" ,mingetty) - ("shadow" ,passwd)))))) + ("etc-passwd" ,passwd) + ("etc-shadow" ,shadow)))))) (lambda () (close-connection store))))) -- cgit v1.2.3 From 1d1f939798d2649bbabc962e37f90efe5805e202 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Tue, 10 Sep 2013 11:42:07 +0200 Subject: guix: python: Add parameter #:phases to build system. * guix/build-system/python.scm (python-build): Use parameter #:phases. --- guix/build-system/python.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index d120cc9cc3..d018ee70f3 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -128,6 +128,7 @@ provides a 'setup.py' file as its build system." #:system ,system #:test-target "test" #:tests? ,tests? + #:phases ,phases #:outputs %outputs #:search-paths ',(map search-path-specification->sexp (append python-search-paths -- cgit v1.2.3 From 590a4904d28e8cd6cbee404b66ce7a475713ca28 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Tue, 10 Sep 2013 19:05:43 +0200 Subject: gnu: isl: Update urls. * gnu/packages/gcc.scm (isl): Update source and home page url. --- gnu/packages/gcc.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/gcc.scm b/gnu/packages/gcc.scm index 571526ebdf..c1a2ce61c5 100644 --- a/gnu/packages/gcc.scm +++ b/gnu/packages/gcc.scm @@ -221,7 +221,7 @@ used in the GNU system including the GNU/Linux variant.") (source (origin (method url-fetch) (uri (list (string-append - "ftp://ftp.linux.student.kuleuven.be/pub/people/skimo/isl/isl-" + "http://isl.gforge.inria.fr/isl-" version ".tar.bz2") (string-append %gcc-infrastructure @@ -231,7 +231,7 @@ used in the GNU system including the GNU/Linux variant.") "13d9cqa5rzhbjq0xf0b2dyxag7pqa72xj9dhsa03m8ccr1a4npq9")))) (build-system gnu-build-system) (inputs `(("gmp" ,gmp))) - (home-page "http://www.kotnet.org/~skimo/isl/") + (home-page "http://isl.gforge.inria.fr/") (synopsis "A library for manipulating sets and relations of integer points bounded by linear constraints") -- cgit v1.2.3 From e1a264f6fac2f517a2192e07eaae1db600eb8b1d Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Tue, 10 Sep 2013 20:32:50 +0200 Subject: guix: python: Do not import %standard-phases from gnu-build-system. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build-system/python.scm (python-build): Drop module gnu-build-system. Thanks to Ludovic Courtès . --- guix/build-system/python.scm | 1 - 1 file changed, 1 deletion(-) diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index d018ee70f3..03e587ba01 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -108,7 +108,6 @@ prepended to the name." (guix build gnu-build-system) (guix build utils))) (modules '((guix build python-build-system) - (guix build gnu-build-system) (guix build utils)))) "Build SOURCE using PYTHON, and with INPUTS. This assumes that SOURCE provides a 'setup.py' file as its build system." -- cgit v1.2.3 From 73adf220370e12b8788d47ea22ee1975cb9bc752 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Tue, 10 Sep 2013 21:08:12 +0200 Subject: gnu: Add python-setuptools, python2-setuptools. * gnu/packages/python.scm (python-setuptools, python2-setuptools): New variables. --- gnu/packages/python.scm | 50 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 3ff4da2149..8f65852630 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -247,3 +247,53 @@ etc. ") (define-public python2-babel (package-with-python2 python-babel)) + +(define-public python-setuptools + (package + (name "python-setuptools") + (version "1.1.4") + (source + (origin + (method url-fetch) + (uri (string-append "https://pypi.python.org/packages/source/s/setuptools/setuptools-" + version ".tar.gz")) + (sha256 + (base32 + "0hl9sa5xr9bi2ifq51wy1bawsjv5nzvpbac7m9z1ciz778874csf")))) + (build-system python-build-system) + (arguments + `(#:tests? #f + ;;FIXME: test_sdist_with_utf8_encoded_filename fails in + ;; /tmp/nix-build-python2-setuptools-1.1.4.drv-0/setuptools-1.1.4/setuptools/tests/test_sdist.py" + ;; line 354 + ;; The tests pass with Python 2.7.5. + #:phases + (alist-replace + 'install + (lambda* (#:key outputs #:allow-other-keys #:rest args) + (let* ((install (assoc-ref %standard-phases 'install)) + (out (assoc-ref outputs "out")) + (python (assoc-ref %build-inputs "python")) + (python-version (string-take (string-take-right python 5) 3)) + (path (string-append out "/lib/python" python-version + "/site-packages/"))) + (mkdir-p path) + (setenv "PYTHONPATH" path) + (apply install args))) + %standard-phases))) + (home-page "https://pypi.python.org/pypi/setuptools") + (synopsis + "Library designed to facilitate packaging Python projects") + (description + "Setuptools is a fully-featured, stable library designed to facilitate +packaging Python projects, where packaging includes: +Python package and module definitions, +distribution package metadata, +test hooks, +project installation, +platform-specific details, +Python 3 support.") + (license psfl))) + +(define-public python2-setuptools + (package-with-python2 python-setuptools)) -- cgit v1.2.3 From cfbf916045c180c8f77f90e9c910012f18447dc9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 10 Sep 2013 22:36:41 +0200 Subject: store: The 'references' parameter of 'add-text-to-store' is now optional. * guix/store.scm (add-text-to-store): Make 'references' optional. * tests/store.scm ("dead-paths", "references"): Use 'add-text-to-store' with no optional argument. * doc/guix.texi (The Store): Adjust accordingly. --- doc/guix.texi | 2 +- guix/store.scm | 2 +- tests/store.scm | 5 ++--- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 5b91bc2982..5d1b780144 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1061,7 +1061,7 @@ argument. Return @code{#t} when @var{path} is a valid store path. @end deffn -@deffn {Scheme Procedure} add-text-to-store @var{server} @var{name} @var{text} @var{references} +@deffn {Scheme Procedure} add-text-to-store @var{server} @var{name} @var{text} [@var{references}] Add @var{text} under file @var{name} in the store, and return its store path. @var{references} is the list of store paths referred to by the resulting store path. diff --git a/guix/store.scm b/guix/store.scm index 541c7c848f..0f1e2f9466 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -452,7 +452,7 @@ encoding conversion errors." (string-list references)) #f store-path))) - (lambda (server name text references) + (lambda* (server name text #:optional (references '())) "Add TEXT under file NAME in the store, and return its store path. REFERENCES is the list of store paths referred to by the resulting store path." diff --git a/tests/store.scm b/tests/store.scm index 9625a6b308..0280713191 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -68,8 +68,7 @@ (test-skip (if %store 0 10)) (test-assert "dead-paths" - (let ((p (add-text-to-store %store "random-text" - (random-text) '()))) + (let ((p (add-text-to-store %store "random-text" (random-text)))) (member p (dead-paths %store)))) ;; FIXME: Find a test for `live-paths'. @@ -99,7 +98,7 @@ (test-assert "references" (let* ((t1 (add-text-to-store %store "random1" - (random-text) '())) + (random-text))) (t2 (add-text-to-store %store "random2" (random-text) (list t1)))) (and (equal? (list t1) (references %store t2)) -- cgit v1.2.3 From c84d0eca053cd524294ad10c1f49a877902932c4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 11 Sep 2013 00:22:45 +0200 Subject: gnu: linux-pam: Add declarative PAM service interface. * gnu/packages/linux.scm (, ): New record types. (pam-service->configuration, pam-services->directory, unix-pam-service): New procedures. (%pam-other-services): New variable. --- gnu/packages/linux.scm | 128 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 127 insertions(+), 1 deletion(-) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index b5ed92e198..a479d791b6 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -32,7 +32,18 @@ #:use-module (gnu packages algebra) #:use-module (guix packages) #:use-module (guix download) - #:use-module (guix build-system gnu)) + #:use-module (guix build-system gnu) + #:use-module (guix store) + #:use-module (guix derivations) + #:use-module (guix records) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) + #:export (pam-service + pam-entry + pam-services->directory + %pam-other-services + unix-pam-service)) (define-public (system->linux-architecture arch) "Return the Linux architecture name for ARCH, a Guix system name such as @@ -214,6 +225,11 @@ (license gpl2) (home-page "http://www.gnu.org/software/linux-libre/")))) + +;;; +;;; Pluggable authentication modules (PAM). +;;; + (define-public linux-pam (package (name "linux-pam") @@ -255,6 +271,116 @@ 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))) +;; PAM services (see +;; .) +(define-record-type* pam-service + make-pam-service + pam-service? + (name pam-service-name) ; string + + ;; The four "management groups". + (account pam-service-account ; list of + (default '())) + (auth pam-service-auth + (default '())) + (password pam-service-password + (default '())) + (session pam-service-session + (default '()))) + +(define-record-type* pam-entry + make-pam-entry + pam-entry? + (control pam-entry-control) ; string + (module pam-entry-module) ; file name + (arguments pam-entry-arguments ; list of strings + (default '()))) + +(define (pam-service->configuration service) + "Return the configuration string for SERVICE, to be dumped in +/etc/pam.d/NAME, where NAME is the name of SERVICE." + (define (entry->string type entry) + (match entry + (($ control module (arguments ...)) + (string-append type " " + control " " module " " + (string-join arguments) + "\n")))) + + (match service + (($ name account auth password session) + (string-concatenate + (append (map (cut entry->string "account" <>) account) + (map (cut entry->string "auth" <>) auth) + (map (cut entry->string "password" <>) password) + (map (cut entry->string "session" <>) session)))))) + +(define (pam-services->directory store services) + "Return the derivation to build the configuration directory to be used as +/etc/pam.d for SERVICES." + (let ((names (map pam-service-name services)) + (files (map (match-lambda + ((and service ($ name)) + (let ((config (pam-service->configuration service))) + (add-text-to-store store + (string-append name ".pam") + config '())))) + services))) + (define builder + '(begin + (use-modules (ice-9 match)) + + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (for-each (match-lambda + ((name . file) + (symlink file (string-append out "/" name)))) + %build-inputs) + #t))) + + (build-expression->derivation store "pam.d" (%current-system) + builder + (zip names files)))) + +(define %pam-other-services + ;; The "other" PAM configuration, which denies everything (see + ;; .) + (let ((deny (pam-entry + (control "required") + (module "pam_deny.so")))) + (pam-service + (name "other") + (account (list deny)) + (auth (list deny)) + (password (list deny)) + (session (list deny))))) + +(define unix-pam-service + (let ((unix (pam-entry + (control "required") + (module "pam_unix.so")))) + (lambda* (name #:key allow-empty-passwords?) + "Return a standard Unix-style PAM service for NAME. When +ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords." + ;; See . + (let ((name* name)) + (pam-service + (name name*) + (account (list unix)) + (auth (list (if allow-empty-passwords? + (pam-entry + (control "required") + (module "pam_unix.so") + (arguments '("nullok"))) + unix))) + (password (list unix)) + (session (list unix))))))) + + +;;; +;;; Miscellaneous. +;;; + (define-public psmisc (package (name "psmisc") -- cgit v1.2.3 From e0ba5fe5abb44bbd17cb62dfd5909e7627160ef2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 11 Sep 2013 00:51:31 +0200 Subject: gnu: linux-initrd: Fix typo. * gnu/packages/linux-initrd.scm (gnu-system-initrd): Add missing argument to 'format' call. --- gnu/packages/linux-initrd.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm index 6dd2a10e53..b62843aadd 100644 --- a/gnu/packages/linux-initrd.scm +++ b/gnu/packages/linux-initrd.scm @@ -386,7 +386,8 @@ the Linux kernel.") (chroot "/root") (primitive-load to-load) (format (current-error-port) - "boot program '~a' terminated, rebooting~%") + "boot program '~a' terminated, rebooting~%" + to-load) (sleep 2) (reboot)) (begin -- cgit v1.2.3 From 37c825eb79e18ac61080e626db6cff6552fd5cf4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 11 Sep 2013 00:52:36 +0200 Subject: linux-initrd: Create /dev/klog and /dev/kmsg. * guix/build/linux-initrd.scm (make-essential-device-nodes): Make /dev/klog and /dev/kmsg. --- guix/build/linux-initrd.scm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index b5404da7f0..cbdb363b4e 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -89,6 +89,10 @@ (device-number 4 n)) (loop (+ 1 n))))) + ;; Rendez-vous point for syslogd. + (mknod (scope "dev/log") 'socket #o666 0) + (mknod (scope "dev/kmsg") 'char-special #o600 (device-number 1 11)) + ;; Other useful nodes. (mknod (scope "dev/null") 'char-special #o666 (device-number 1 3)) (mknod (scope "dev/zero") 'char-special #o666 (device-number 1 5))) -- cgit v1.2.3 From 3b07625ad667bf586ae5e3b2ca579933dc261dbe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 11 Sep 2013 00:54:20 +0200 Subject: gnu: vm: Create shadow files with the right format. * gnu/system/vm.scm (passwd-file): When SHADOW? is true, use the right shadow(5) format. Always add a trailing newline. --- gnu/system/vm.scm | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 5128bdfd29..7ad87254d8 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -367,21 +367,25 @@ It can be used to provide additional files, such as /etc files." "Return a password file for ACCOUNTS, a list of vectors as returned by 'getpwnam'. If SHADOW? is true, then it is a /etc/shadow file, otherwise it is a /etc/passwd file." - ;; XXX: The resulting file is world-readable, so don't rely on it! + ;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t! (define contents (let loop ((accounts accounts) (result '())) (match accounts ((#(name pass uid gid comment home-dir shell) rest ...) (loop rest - (cons (string-append name - ":" (if shadow? pass "x") - ":" (number->string uid) - ":" (number->string gid) - ":" comment ":" home-dir ":" shell) + (cons (if shadow? + (string-append name + ":" ; XXX: use (crypt PASS …)? + ":::::::") + (string-append name + ":" "x" + ":" (number->string uid) + ":" (number->string gid) + ":" comment ":" home-dir ":" shell)) result))) (() - (string-concatenate-reverse result))))) + (string-join (reverse result) "\n" 'suffix))))) (add-text-to-store store (if shadow? "shadow" "passwd") contents '())) -- cgit v1.2.3 From a843fe2222fec5f162a94da8836b803cd7e0c7ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 11 Sep 2013 01:07:07 +0200 Subject: gnu: vm: Setup PAM. * gnu/system/vm.scm (example2): Use 'pam-services->directory'. Change POPULATE to create /etc/pam.d, /etc/login.defs, and /var/run. Change BOOT to spawn syslogd; boot to Bash. Add inputs. --- gnu/system/vm.scm | 63 +++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 43 insertions(+), 20 deletions(-) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 7ad87254d8..28d22efdc3 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -33,8 +33,7 @@ #:use-module (gnu packages linux-initrd) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) - #:use-module ((gnu packages system) - #:select (mingetty)) + #:use-module (gnu packages system) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) @@ -396,6 +395,11 @@ is a /etc/passwd file." (lambda () (set! store (open-connection))) (lambda () + (define %pam-services + ;; Services known to PAM. + (list %pam-other-services + (unix-pam-service "login" #:allow-empty-passwords? #t))) + (parameterize ((%guile-for-build (package-derivation store guile-final))) (let* ((bash-drv (package-derivation store bash)) (bash-file (string-append (derivation-path->output-path bash-drv) @@ -404,17 +408,26 @@ is a /etc/passwd file." "/" bash-file))) (passwd (passwd-file store accounts)) (shadow (passwd-file store accounts #:shadow? #t)) + (pam.d-drv (pam-services->directory store %pam-services)) + (pam.d (derivation-path->output-path pam.d-drv)) (populate (add-text-to-store store "populate-qemu-image" (object->string `(begin (mkdir-p "etc") (symlink ,shadow "etc/shadow") - (symlink ,passwd "etc/passwd"))) + (symlink ,passwd "etc/passwd") + (symlink "/dev/null" + "etc/login.defs") + (symlink ,pam.d "etc/pam.d") + (mkdir-p "var/run"))) (list passwd))) (out (derivation-path->output-path (package-derivation store mingetty))) (getty (string-append out "/sbin/mingetty")) + (iu-drv (package-derivation store inetutils)) + (syslogd (string-append (derivation-path->output-path iu-drv) + "/libexec/syslogd")) (boot (add-text-to-store store "boot" (object->string `(begin @@ -423,9 +436,15 @@ is a /etc/passwd file." ;; 'TIOCSCTTY'. (setsid) - ;; Directly into mingetty. - (execl ,getty "mingetty" - "--noclear" "tty1"))) + (when (zero? (primitive-fork)) + (format #t "starting syslogd as ~a~%" + (getpid)) + (execl ,syslogd "syslogd")) + + ;; Directly into mingetty. XXX + ;; (execl ,getty "mingetty" + ;; "--noclear" "tty1") + (execl ,bash-file "bash"))) (list out))) (entries (list (menu-entry (label "Boot-to-Guile! (GNU System technology preview)") @@ -434,20 +453,24 @@ is a /etc/passwd file." ,(string-append "--load=" boot))) (initrd gnu-system-initrd)))) (grub.cfg (grub-configuration-file store entries))) - (qemu-image store - #:grub-configuration grub.cfg - #:populate populate - #:disk-image-size (* 400 (expt 2 20)) - #:inputs-to-copy `(("boot" ,boot) - ("linux" ,linux-libre) - ("initrd" ,gnu-system-initrd) - ("coreutils" ,coreutils) - ("bash" ,bash) - ("guile" ,guile-2.0) - ("mingetty" ,mingetty) - - ("etc-passwd" ,passwd) - ("etc-shadow" ,shadow)))))) + (build-derivations store (list pam.d-drv)) + (qemu-image store + #:grub-configuration grub.cfg + #:populate populate + #:disk-image-size (* 400 (expt 2 20)) + #:inputs-to-copy `(("boot" ,boot) + ("linux" ,linux-libre) + ("initrd" ,gnu-system-initrd) + ("coreutils" ,coreutils) + ("bash" ,bash) + ("guile" ,guile-2.0) + ("mingetty" ,mingetty) + ("inetutils" ,inetutils) + + ;; Configuration. + ("etc-pam.d" ,pam.d) + ("etc-passwd" ,passwd) + ("etc-shadow" ,shadow)))))) (lambda () (close-connection store))))) -- cgit v1.2.3 From 824af8cadc1b4f1ac7a859f3d18cbe69b195a844 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 11 Sep 2013 15:47:34 +0200 Subject: guix: python: Create module installation path and add it to PYTHONPATH during the installation phase. * guix/build/python-build-system.scm (get-python-version): New procedure. * guix/build/python-build-system.scm (install): Create and add path. * gnu/packages/python.scm (python-setuptools): Drop path creation code. --- gnu/packages/python.scm | 16 +--------------- guix/build/python-build-system.scm | 23 +++++++++++++++++++---- 2 files changed, 20 insertions(+), 19 deletions(-) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 8f65852630..55d23e45e8 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -262,25 +262,11 @@ etc. ") "0hl9sa5xr9bi2ifq51wy1bawsjv5nzvpbac7m9z1ciz778874csf")))) (build-system python-build-system) (arguments - `(#:tests? #f + `(#:tests? #f)) ;;FIXME: test_sdist_with_utf8_encoded_filename fails in ;; /tmp/nix-build-python2-setuptools-1.1.4.drv-0/setuptools-1.1.4/setuptools/tests/test_sdist.py" ;; line 354 ;; The tests pass with Python 2.7.5. - #:phases - (alist-replace - 'install - (lambda* (#:key outputs #:allow-other-keys #:rest args) - (let* ((install (assoc-ref %standard-phases 'install)) - (out (assoc-ref outputs "out")) - (python (assoc-ref %build-inputs "python")) - (python-version (string-take (string-take-right python 5) 3)) - (path (string-append out "/lib/python" python-version - "/site-packages/"))) - (mkdir-p path) - (setenv "PYTHONPATH" path) - (apply install args))) - %standard-phases))) (home-page "https://pypi.python.org/pypi/setuptools") (synopsis "Library designed to facilitate packaging Python projects") diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm index f213a97f01..0bb8c4d49d 100644 --- a/guix/build/python-build-system.scm +++ b/guix/build/python-build-system.scm @@ -54,12 +54,27 @@ (call-setuppy test-target '()) #t)) -(define* (install #:key outputs (configure-flags '()) +(define (get-python-version python) + (string-take (string-take-right python 5) 3)) + +(define* (install #:key outputs inputs (configure-flags '()) #:allow-other-keys) "Install a given Python package." (let* ((out (assoc-ref outputs "out")) (params (append (list (string-append "--prefix=" out)) - configure-flags))) + configure-flags)) + (python-version (get-python-version (assoc-ref inputs "python"))) + (old-path (getenv "PYTHONPATH")) + (add-path (string-append out "/lib/python" python-version + "/site-packages/"))) + ;; create the module installation directory and add it to PYTHONPATH + ;; to make setuptools happy + (mkdir-p add-path) + (setenv "PYTHONPATH" + (string-append (if old-path + (string-append old-path ":") + "") + add-path)) (call-setuppy "install" params))) (define* (wrap #:key inputs outputs #:allow-other-keys) @@ -79,10 +94,10 @@ (let* ((out (assoc-ref outputs "out")) (python (assoc-ref inputs "python")) - (python-version (string-take (string-take-right python 5) 3)) (var `("PYTHONPATH" prefix ,(cons (string-append out "/lib/python" - python-version "/site-packages") + (get-python-version python) + "/site-packages") (search-path-as-string->list (or (getenv "PYTHONPATH") "")))))) (for-each (lambda (dir) -- cgit v1.2.3 From fc50e9c69425c74b4367feb46b83cc28aeb178c2 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 11 Sep 2013 15:51:13 +0200 Subject: gnu: Add python-dateutil, python2-dateutil. * gnu/packages/python.scm (python-dateutil, python2-dateutil): New variables. --- gnu/packages/python.scm | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 55d23e45e8..b50a893e1d 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -218,6 +218,7 @@ using Python 2.4 or higher and provides access to the Olson timezone database.") (define-public python2-pytz (package-with-python2 python-pytz)) + (define-public python-babel (package (name "python-babel") @@ -248,6 +249,7 @@ etc. ") (define-public python2-babel (package-with-python2 python-babel)) + (define-public python-setuptools (package (name "python-setuptools") @@ -283,3 +285,30 @@ Python 3 support.") (define-public python2-setuptools (package-with-python2 python-setuptools)) + + +(define-public python-dateutil + (package + (name "python-dateutil") + (version "1.5") ; last version for python < 3 + (source + (origin + (method url-fetch) + (uri (string-append "http://labix.org/download/python-dateutil/python-dateutil-" + version ".tar.gz")) + (sha256 + (base32 + "0fqfglhy5khbvsipr3x7m6bcaqljh8xl5cw33vbfxy7qhmywm2n0")))) + (build-system python-build-system) + (inputs + `(("python-setuptools" ,python-setuptools))) + (home-page "http://labix.org/python-dateutil") + (synopsis + "Extensions to the standard datetime module, available in Python 2.3+") + (description + "The dateutil module provides powerful extensions to the standard +datetime module, available in Python 2.3+.") + (license psfl))) + +(define-public python2-dateutil + (package-with-python2 python-dateutil)) -- cgit v1.2.3 From aedb72fbe07b82da00f6c7a397794d465c217135 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 11 Sep 2013 20:08:53 +0200 Subject: gnu: vm: Remove potluck hacks. * gnu/system/vm.scm (example1): Remove. (example2): Rename to... (system-qemu-image): ... this. Add 'store' parameter, and remove call to 'open-connection'. --- gnu/system/vm.scm | 180 ++++++++++++++++++++++++------------------------------ 1 file changed, 79 insertions(+), 101 deletions(-) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 28d22efdc3..6886e67c21 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -38,7 +38,8 @@ #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:export (expression->derivation-in-linux-vm - qemu-image)) + qemu-image + system-qemu-image)) ;;; Commentary: @@ -342,26 +343,9 @@ It can be used to provide additional files, such as /etc files." ;;; -;;; Guile 2.0 potluck examples. +;;; Stand-alone VM image. ;;; -(define (example1) - (let ((store #f)) - (dynamic-wind - (lambda () - (set! store (open-connection))) - (lambda () - (parameterize ((%guile-for-build (package-derivation store guile-final))) - (expression->derivation-in-linux-vm - store "vm-test" - '(begin - (display "hello from boot!\n") - (call-with-output-file "/xchg/hello" - (lambda (p) - (display "world" p))))))) - (lambda () - (close-connection store))))) - (define* (passwd-file store accounts #:key shadow?) "Return a password file for ACCOUNTS, a list of vectors as returned by 'getpwnam'. If SHADOW? is true, then it is a /etc/shadow file, otherwise it @@ -389,89 +373,83 @@ is a /etc/passwd file." (add-text-to-store store (if shadow? "shadow" "passwd") contents '())) -(define (example2) - (let ((store #f)) - (dynamic-wind - (lambda () - (set! store (open-connection))) - (lambda () - (define %pam-services - ;; Services known to PAM. - (list %pam-other-services - (unix-pam-service "login" #:allow-empty-passwords? #t))) - - (parameterize ((%guile-for-build (package-derivation store guile-final))) - (let* ((bash-drv (package-derivation store bash)) - (bash-file (string-append (derivation-path->output-path bash-drv) - "/bin/bash")) - (accounts (list (vector "root" "" 0 0 "System administrator" - "/" bash-file))) - (passwd (passwd-file store accounts)) - (shadow (passwd-file store accounts #:shadow? #t)) - (pam.d-drv (pam-services->directory store %pam-services)) - (pam.d (derivation-path->output-path pam.d-drv)) - (populate - (add-text-to-store store "populate-qemu-image" +(define (system-qemu-image store) + "Return the derivation of a QEMU image of the GNU system." + (define %pam-services + ;; Services known to PAM. + (list %pam-other-services + (unix-pam-service "login" #:allow-empty-passwords? #t))) + + (parameterize ((%guile-for-build (package-derivation store guile-final))) + (let* ((bash-drv (package-derivation store bash)) + (bash-file (string-append (derivation-path->output-path bash-drv) + "/bin/bash")) + (accounts (list (vector "root" "" 0 0 "System administrator" + "/" bash-file))) + (passwd (passwd-file store accounts)) + (shadow (passwd-file store accounts #:shadow? #t)) + (pam.d-drv (pam-services->directory store %pam-services)) + (pam.d (derivation-path->output-path pam.d-drv)) + (populate + (add-text-to-store store "populate-qemu-image" + (object->string + `(begin + (mkdir-p "etc") + (symlink ,shadow "etc/shadow") + (symlink ,passwd "etc/passwd") + (symlink "/dev/null" + "etc/login.defs") + (symlink ,pam.d "etc/pam.d") + (mkdir-p "var/run"))) + (list passwd))) + (out (derivation-path->output-path + (package-derivation store mingetty))) + (getty (string-append out "/sbin/mingetty")) + (iu-drv (package-derivation store inetutils)) + (syslogd (string-append (derivation-path->output-path iu-drv) + "/libexec/syslogd")) + (boot (add-text-to-store store "boot" (object->string `(begin - (mkdir-p "etc") - (symlink ,shadow "etc/shadow") - (symlink ,passwd "etc/passwd") - (symlink "/dev/null" - "etc/login.defs") - (symlink ,pam.d "etc/pam.d") - (mkdir-p "var/run"))) - (list passwd))) - (out (derivation-path->output-path - (package-derivation store mingetty))) - (getty (string-append out "/sbin/mingetty")) - (iu-drv (package-derivation store inetutils)) - (syslogd (string-append (derivation-path->output-path iu-drv) - "/libexec/syslogd")) - (boot (add-text-to-store store "boot" - (object->string - `(begin - ;; Become the session leader, - ;; so that mingetty can do - ;; 'TIOCSCTTY'. - (setsid) - - (when (zero? (primitive-fork)) - (format #t "starting syslogd as ~a~%" - (getpid)) - (execl ,syslogd "syslogd")) - - ;; Directly into mingetty. XXX - ;; (execl ,getty "mingetty" - ;; "--noclear" "tty1") - (execl ,bash-file "bash"))) - (list out))) - (entries (list (menu-entry - (label "Boot-to-Guile! (GNU System technology preview)") - (linux linux-libre) - (linux-arguments `("--root=/dev/vda1" - ,(string-append "--load=" boot))) - (initrd gnu-system-initrd)))) - (grub.cfg (grub-configuration-file store entries))) - (build-derivations store (list pam.d-drv)) - (qemu-image store - #:grub-configuration grub.cfg - #:populate populate - #:disk-image-size (* 400 (expt 2 20)) - #:inputs-to-copy `(("boot" ,boot) - ("linux" ,linux-libre) - ("initrd" ,gnu-system-initrd) - ("coreutils" ,coreutils) - ("bash" ,bash) - ("guile" ,guile-2.0) - ("mingetty" ,mingetty) - ("inetutils" ,inetutils) - - ;; Configuration. - ("etc-pam.d" ,pam.d) - ("etc-passwd" ,passwd) - ("etc-shadow" ,shadow)))))) - (lambda () - (close-connection store))))) + ;; Become the session leader, + ;; so that mingetty can do + ;; 'TIOCSCTTY'. + (setsid) + + (when (zero? (primitive-fork)) + (format #t "starting syslogd as ~a~%" + (getpid)) + (execl ,syslogd "syslogd")) + + ;; Directly into mingetty. XXX + ;; (execl ,getty "mingetty" + ;; "--noclear" "tty1") + (execl ,bash-file "bash"))) + (list out))) + (entries (list (menu-entry + (label "Boot-to-Guile! (GNU System technology preview)") + (linux linux-libre) + (linux-arguments `("--root=/dev/vda1" + ,(string-append "--load=" boot))) + (initrd gnu-system-initrd)))) + (grub.cfg (grub-configuration-file store entries))) + (build-derivations store (list pam.d-drv)) + (qemu-image store + #:grub-configuration grub.cfg + #:populate populate + #:disk-image-size (* 400 (expt 2 20)) + #:inputs-to-copy `(("boot" ,boot) + ("linux" ,linux-libre) + ("initrd" ,gnu-system-initrd) + ("coreutils" ,coreutils) + ("bash" ,bash) + ("guile" ,guile-2.0) + ("mingetty" ,mingetty) + ("inetutils" ,inetutils) + + ;; Configuration. + ("etc-pam.d" ,pam.d) + ("etc-passwd" ,passwd) + ("etc-shadow" ,shadow)))))) ;;; vm.scm ends here -- cgit v1.2.3 From 0ded70f37d47579ca058f2f4ca27335129a96e25 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 11 Sep 2013 22:36:50 +0200 Subject: =?UTF-8?q?gnu:=20Move=20helper=20code=20to=20(gnu=20system=20?= =?UTF-8?q?=E2=80=A6)=20modules.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/grub.scm (, grub-configuration-file): Move to... * gnu/system/grub.scm: ... here. New file. * gnu/packages/linux.scm (, , pam-service->configuration, pam-service->directory, %pam-other-services, unix-pam-service): Move to... * gnu/system/linux.scm: ... here. New file. * gnu/system/vm.scm (passwd-file): Move to... * gnu/system/shadow.scm: ... here. New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add gnu/system/{grub,linux,shadow}.scm. --- gnu-system.am | 4 ++ gnu/packages/grub.scm | 62 +-------------------- gnu/packages/linux.scm | 118 +--------------------------------------- gnu/system/grub.scm | 84 ++++++++++++++++++++++++++++ gnu/system/linux.scm | 145 +++++++++++++++++++++++++++++++++++++++++++++++++ gnu/system/shadow.scm | 57 +++++++++++++++++++ gnu/system/vm.scm | 33 ++--------- 7 files changed, 298 insertions(+), 205 deletions(-) create mode 100644 gnu/system/grub.scm create mode 100644 gnu/system/linux.scm create mode 100644 gnu/system/shadow.scm diff --git a/gnu-system.am b/gnu-system.am index a5000bcdfe..d88f6bf4e8 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -179,6 +179,10 @@ GNU_SYSTEM_MODULES = \ gnu/packages/yasm.scm \ gnu/packages/zile.scm \ gnu/packages/zip.scm \ + \ + gnu/system/grub.scm \ + gnu/system/linux.scm \ + gnu/system/shadow.scm \ gnu/system/vm.scm patchdir = $(guilemoduledir)/gnu/packages/patches diff --git a/gnu/packages/grub.scm b/gnu/packages/grub.scm index 71c4fad781..8c981bf88d 100644 --- a/gnu/packages/grub.scm +++ b/gnu/packages/grub.scm @@ -19,9 +19,6 @@ (define-module (gnu packages grub) #:use-module (guix download) #:use-module (guix packages) - #:use-module (guix records) - #:use-module (guix store) - #:use-module (guix derivations) #:use-module ((guix licenses) #:select (gpl3+)) #:use-module (guix build-system gnu) #:use-module (gnu packages) @@ -33,11 +30,7 @@ #:use-module (gnu packages qemu) #:use-module (gnu packages ncurses) #:use-module (gnu packages cdrom) - #:use-module (srfi srfi-1) - #:use-module (ice-9 match) - #:export (menu-entry - menu-entry? - grub-configuration-file)) + #:use-module (srfi srfi-1)) (define qemu-for-tests ;; Newer QEMU versions, such as 1.5.1, no longer support the 'shutdown' @@ -117,56 +110,3 @@ computer starts. It is responsible for loading and transferring control to the operating system kernel software (such as the Hurd or the Linux). The kernel, in turn, initializes the rest of the operating system (e.g., GNU).") (license gpl3+))) - - -;;; -;;; Configuration. -;;; - -(define-record-type* - menu-entry make-menu-entry - menu-entry? - (label menu-entry-label) - (linux menu-entry-linux) - (linux-arguments menu-entry-linux-arguments - (default '())) - (initrd menu-entry-initrd)) - -(define* (grub-configuration-file store entries - #:key (default-entry 1) (timeout 5) - (system (%current-system))) - "Return the GRUB configuration file in STORE for ENTRIES, a list of - objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT." - (define prologue - (format #f " -set default=~a -set timeout=~a -search.file ~a~%" - default-entry timeout - (any (match-lambda - (($ _ linux) - (let* ((drv (package-derivation store linux system)) - (out (derivation-path->output-path drv))) - (string-append out "/bzImage")))) - entries))) - - (define entry->text - (match-lambda - (($ label linux arguments initrd) - (let ((linux-drv (package-derivation store linux system)) - (initrd-drv (package-derivation store initrd system))) - ;; XXX: Assume that INITRD is a directory containing an 'initrd' file. - (format #f "menuentry ~s { - linux ~a/bzImage ~a - initrd ~a/initrd -}~%" - label - (derivation-path->output-path linux-drv) - (string-join arguments) - (derivation-path->output-path initrd-drv)))))) - - (add-text-to-store store "grub.cfg" - (string-append prologue - (string-concatenate - (map entry->text entries))) - '())) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index a479d791b6..38bff72933 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -32,18 +32,7 @@ #:use-module (gnu packages algebra) #:use-module (guix packages) #:use-module (guix download) - #:use-module (guix build-system gnu) - #:use-module (guix store) - #:use-module (guix derivations) - #:use-module (guix records) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) - #:use-module (ice-9 match) - #:export (pam-service - pam-entry - pam-services->directory - %pam-other-services - unix-pam-service)) + #:use-module (guix build-system gnu)) (define-public (system->linux-architecture arch) "Return the Linux architecture name for ARCH, a Guix system name such as @@ -271,111 +260,6 @@ 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))) -;; PAM services (see -;; .) -(define-record-type* pam-service - make-pam-service - pam-service? - (name pam-service-name) ; string - - ;; The four "management groups". - (account pam-service-account ; list of - (default '())) - (auth pam-service-auth - (default '())) - (password pam-service-password - (default '())) - (session pam-service-session - (default '()))) - -(define-record-type* pam-entry - make-pam-entry - pam-entry? - (control pam-entry-control) ; string - (module pam-entry-module) ; file name - (arguments pam-entry-arguments ; list of strings - (default '()))) - -(define (pam-service->configuration service) - "Return the configuration string for SERVICE, to be dumped in -/etc/pam.d/NAME, where NAME is the name of SERVICE." - (define (entry->string type entry) - (match entry - (($ control module (arguments ...)) - (string-append type " " - control " " module " " - (string-join arguments) - "\n")))) - - (match service - (($ name account auth password session) - (string-concatenate - (append (map (cut entry->string "account" <>) account) - (map (cut entry->string "auth" <>) auth) - (map (cut entry->string "password" <>) password) - (map (cut entry->string "session" <>) session)))))) - -(define (pam-services->directory store services) - "Return the derivation to build the configuration directory to be used as -/etc/pam.d for SERVICES." - (let ((names (map pam-service-name services)) - (files (map (match-lambda - ((and service ($ name)) - (let ((config (pam-service->configuration service))) - (add-text-to-store store - (string-append name ".pam") - config '())))) - services))) - (define builder - '(begin - (use-modules (ice-9 match)) - - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (for-each (match-lambda - ((name . file) - (symlink file (string-append out "/" name)))) - %build-inputs) - #t))) - - (build-expression->derivation store "pam.d" (%current-system) - builder - (zip names files)))) - -(define %pam-other-services - ;; The "other" PAM configuration, which denies everything (see - ;; .) - (let ((deny (pam-entry - (control "required") - (module "pam_deny.so")))) - (pam-service - (name "other") - (account (list deny)) - (auth (list deny)) - (password (list deny)) - (session (list deny))))) - -(define unix-pam-service - (let ((unix (pam-entry - (control "required") - (module "pam_unix.so")))) - (lambda* (name #:key allow-empty-passwords?) - "Return a standard Unix-style PAM service for NAME. When -ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords." - ;; See . - (let ((name* name)) - (pam-service - (name name*) - (account (list unix)) - (auth (list (if allow-empty-passwords? - (pam-entry - (control "required") - (module "pam_unix.so") - (arguments '("nullok"))) - unix))) - (password (list unix)) - (session (list unix))))))) - ;;; ;;; Miscellaneous. diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm new file mode 100644 index 0000000000..695a044bfa --- /dev/null +++ b/gnu/system/grub.scm @@ -0,0 +1,84 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu system grub) + #:use-module (guix store) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (guix records) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (menu-entry + menu-entry? + grub-configuration-file)) + +;;; Commentary: +;;; +;;; Configuration of GNU GRUB. +;;; +;;; Code: + +(define-record-type* + menu-entry make-menu-entry + menu-entry? + (label menu-entry-label) + (linux menu-entry-linux) + (linux-arguments menu-entry-linux-arguments + (default '())) + (initrd menu-entry-initrd)) + +(define* (grub-configuration-file store entries + #:key (default-entry 1) (timeout 5) + (system (%current-system))) + "Return the GRUB configuration file in STORE for ENTRIES, a list of + objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT." + (define prologue + (format #f " +set default=~a +set timeout=~a +search.file ~a~%" + default-entry timeout + (any (match-lambda + (($ _ linux) + (let* ((drv (package-derivation store linux system)) + (out (derivation-path->output-path drv))) + (string-append out "/bzImage")))) + entries))) + + (define entry->text + (match-lambda + (($ label linux arguments initrd) + (let ((linux-drv (package-derivation store linux system)) + (initrd-drv (package-derivation store initrd system))) + ;; XXX: Assume that INITRD is a directory containing an 'initrd' file. + (format #f "menuentry ~s { + linux ~a/bzImage ~a + initrd ~a/initrd +}~%" + label + (derivation-path->output-path linux-drv) + (string-join arguments) + (derivation-path->output-path initrd-drv)))))) + + (add-text-to-store store "grub.cfg" + (string-append prologue + (string-concatenate + (map entry->text entries))) + '())) + +;;; grub.scm ends here diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm new file mode 100644 index 0000000000..b2daa13e06 --- /dev/null +++ b/gnu/system/linux.scm @@ -0,0 +1,145 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu system linux) + #:use-module (guix store) + #:use-module (guix records) + #:use-module (guix derivations) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module ((guix utils) #:select (%current-system)) + #:export (pam-service + pam-entry + pam-services->directory + %pam-other-services + unix-pam-service)) + +;;; Commentary: +;;; +;;; Configuration of Linux-related things, including pluggable authentication +;;; modules (PAM). +;;; +;;; Code: + +;; PAM services (see +;; .) +(define-record-type* pam-service + make-pam-service + pam-service? + (name pam-service-name) ; string + + ;; The four "management groups". + (account pam-service-account ; list of + (default '())) + (auth pam-service-auth + (default '())) + (password pam-service-password + (default '())) + (session pam-service-session + (default '()))) + +(define-record-type* pam-entry + make-pam-entry + pam-entry? + (control pam-entry-control) ; string + (module pam-entry-module) ; file name + (arguments pam-entry-arguments ; list of strings + (default '()))) + +(define (pam-service->configuration service) + "Return the configuration string for SERVICE, to be dumped in +/etc/pam.d/NAME, where NAME is the name of SERVICE." + (define (entry->string type entry) + (match entry + (($ control module (arguments ...)) + (string-append type " " + control " " module " " + (string-join arguments) + "\n")))) + + (match service + (($ name account auth password session) + (string-concatenate + (append (map (cut entry->string "account" <>) account) + (map (cut entry->string "auth" <>) auth) + (map (cut entry->string "password" <>) password) + (map (cut entry->string "session" <>) session)))))) + +(define (pam-services->directory store services) + "Return the derivation to build the configuration directory to be used as +/etc/pam.d for SERVICES." + (let ((names (map pam-service-name services)) + (files (map (match-lambda + ((and service ($ name)) + (let ((config (pam-service->configuration service))) + (add-text-to-store store + (string-append name ".pam") + config '())))) + services))) + (define builder + '(begin + (use-modules (ice-9 match)) + + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (for-each (match-lambda + ((name . file) + (symlink file (string-append out "/" name)))) + %build-inputs) + #t))) + + (build-expression->derivation store "pam.d" (%current-system) + builder + (zip names files)))) + +(define %pam-other-services + ;; The "other" PAM configuration, which denies everything (see + ;; .) + (let ((deny (pam-entry + (control "required") + (module "pam_deny.so")))) + (pam-service + (name "other") + (account (list deny)) + (auth (list deny)) + (password (list deny)) + (session (list deny))))) + +(define unix-pam-service + (let ((unix (pam-entry + (control "required") + (module "pam_unix.so")))) + (lambda* (name #:key allow-empty-passwords?) + "Return a standard Unix-style PAM service for NAME. When +ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords." + ;; See . + (let ((name* name)) + (pam-service + (name name*) + (account (list unix)) + (auth (list (if allow-empty-passwords? + (pam-entry + (control "required") + (module "pam_unix.so") + (arguments '("nullok"))) + unix))) + (password (list unix)) + (session (list unix))))))) + +;;; linux.scm ends here diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm new file mode 100644 index 0000000000..71f8e0d771 --- /dev/null +++ b/gnu/system/shadow.scm @@ -0,0 +1,57 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu system shadow) + #:use-module (guix store) + #:use-module (ice-9 match) + #:export (passwd-file)) + +;;; Commentary: +;;; +;;; Utilities for configuring the Shadow tool suite ('login', 'passwd', etc.) +;;; +;;; Code: + +(define* (passwd-file store accounts #:key shadow?) + "Return a password file for ACCOUNTS, a list of vectors as returned by +'getpwnam'. If SHADOW? is true, then it is a /etc/shadow file, otherwise it +is a /etc/passwd file." + ;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t! + (define contents + (let loop ((accounts accounts) + (result '())) + (match accounts + ((#(name pass uid gid comment home-dir shell) rest ...) + (loop rest + (cons (if shadow? + (string-append name + ":" ; XXX: use (crypt PASS …)? + ":::::::") + (string-append name + ":" "x" + ":" (number->string uid) + ":" (number->string gid) + ":" comment ":" home-dir ":" shell)) + result))) + (() + (string-join (reverse result) "\n" 'suffix))))) + + (add-text-to-store store (if shadow? "shadow" "passwd") + contents '())) + +;;; shadow.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 6886e67c21..192ed1d5a3 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -34,9 +34,15 @@ #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) #:use-module (gnu packages system) + + #:use-module (gnu system shadow) + #:use-module (gnu system linux) + #:use-module (gnu system grub) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) + #:export (expression->derivation-in-linux-vm qemu-image system-qemu-image)) @@ -346,33 +352,6 @@ It can be used to provide additional files, such as /etc files." ;;; Stand-alone VM image. ;;; -(define* (passwd-file store accounts #:key shadow?) - "Return a password file for ACCOUNTS, a list of vectors as returned by -'getpwnam'. If SHADOW? is true, then it is a /etc/shadow file, otherwise it -is a /etc/passwd file." - ;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t! - (define contents - (let loop ((accounts accounts) - (result '())) - (match accounts - ((#(name pass uid gid comment home-dir shell) rest ...) - (loop rest - (cons (if shadow? - (string-append name - ":" ; XXX: use (crypt PASS …)? - ":::::::") - (string-append name - ":" "x" - ":" (number->string uid) - ":" (number->string gid) - ":" comment ":" home-dir ":" shell)) - result))) - (() - (string-join (reverse result) "\n" 'suffix))))) - - (add-text-to-store store (if shadow? "shadow" "passwd") - contents '())) - (define (system-qemu-image store) "Return the derivation of a QEMU image of the GNU system." (define %pam-services -- cgit v1.2.3 From e1804763d00a2aa03e696a73dc3675a15acd47de Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 11 Sep 2013 22:56:52 +0200 Subject: gnu: Update python-babel, python2-babel to 1.3. * gnu/packages/python.scm (python-babel, python2-babel): Update to 1.3. --- gnu/packages/python.scm | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index b50a893e1d..9b9a445f38 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -222,20 +222,21 @@ using Python 2.4 or higher and provides access to the Olson timezone database.") (define-public python-babel (package (name "python-babel") - (version "0.9.6") + (version "1.3") (source (origin (method url-fetch) - (uri (string-append "http://ftp.edgewall.com/pub/babel/Babel-" + (uri (string-append "https://pypi.python.org/packages/source/B/Babel/Babel-" version ".tar.gz")) (sha256 (base32 - "03vmr54jq5vf3qw6kpdv7cdk7x7i2jhzyf1mawv2gk8zrxg0hfja")))) + "0bnin777lc53nxd1hp3apq410jj5wx92n08h7h4izpl4f4sx00lz")))) (build-system python-build-system) (inputs - `(("python-pytz" ,python-pytz))) + `(("python-pytz" ,python-pytz) + ("python-setuptools" ,python-setuptools))) (arguments `(#:tests? #f)) ; no test target - (home-page "http://babel.edgewall.org/") + (home-page "http://babel.pocoo.org/") (synopsis "Tools for internationalizing Python applications") (description -- cgit v1.2.3 From 8eaa8a3bf048997288633191a278028a65d78ae3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 11 Sep 2013 23:37:57 +0200 Subject: gnu: avahi, dbus: Use /var as $localstatedir. * gnu/packages/avahi.scm (avahi): Pass '--localstatedir'; add 'patch/localstatedir'. * gnu/packages/glib.scm (dbus): Pass '--localstatedir' and '--with-session-socket-dir'; add 'patch/localstatedir'. * gnu/packages/patches/avahi-localstatedir.patch, gnu/packages/patches/dbus-localstatedir.patch: New files. * gnu-system.am (dist_patch_DATA): Add them. --- gnu-system.am | 2 ++ gnu/packages/avahi.scm | 10 +++++++-- gnu/packages/glib.scm | 14 +++++++++++- gnu/packages/patches/avahi-localstatedir.patch | 12 +++++++++++ gnu/packages/patches/dbus-localstatedir.patch | 30 ++++++++++++++++++++++++++ 5 files changed, 65 insertions(+), 3 deletions(-) create mode 100644 gnu/packages/patches/avahi-localstatedir.patch create mode 100644 gnu/packages/patches/dbus-localstatedir.patch diff --git a/gnu-system.am b/gnu-system.am index d88f6bf4e8..871254624a 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -189,11 +189,13 @@ patchdir = $(guilemoduledir)/gnu/packages/patches dist_patch_DATA = \ gnu/packages/patches/apr-skip-getservbyname-test.patch \ gnu/packages/patches/automake-skip-amhello-tests.patch \ + gnu/packages/patches/avahi-localstatedir.patch \ gnu/packages/patches/bigloo-gc-shebangs.patch \ gnu/packages/patches/binutils-ld-new-dtags.patch \ gnu/packages/patches/cdparanoia-fpic.patch \ gnu/packages/patches/cmake-fix-tests.patch \ gnu/packages/patches/cpio-gets-undeclared.patch \ + gnu/packages/patches/dbus-localstatedir.patch \ gnu/packages/patches/diffutils-gets-undeclared.patch \ gnu/packages/patches/emacs-configure-sh.patch \ gnu/packages/patches/findutils-absolute-paths.patch \ diff --git a/gnu/packages/avahi.scm b/gnu/packages/avahi.scm index fbdc0e2834..14073b32a0 100644 --- a/gnu/packages/avahi.scm +++ b/gnu/packages/avahi.scm @@ -21,6 +21,7 @@ #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) + #:use-module (gnu packages) #:use-module (gnu packages gdbm) #:use-module (gnu packages libdaemon) #:use-module (gnu packages pkg-config) @@ -42,13 +43,15 @@ (build-system gnu-build-system) (arguments '(#:configure-flags '("--with-distro=none" + "--localstatedir=/var" ; for the DBus socket "--disable-python" "--disable-mono" "--disable-doxygen-doc" "--disable-xmltoman" "--enable-tests" "--disable-qt3" "--disable-qt4" - "--disable-gtk" "--disable-gtk3"))) + "--disable-gtk" "--disable-gtk3") + #:patches (list (assoc-ref %build-inputs "patch/localstatedir")))) (inputs `(("expat" ,expat) ("glib" ,glib) @@ -56,7 +59,10 @@ ("libdaemon" ,libdaemon) ("intltool" ,intltool) ("pkg-config" ,pkg-config) - ("gdbm" ,gdbm))) + ("gdbm" ,gdbm) + + ("patch/localstatedir" + ,(search-patch "avahi-localstatedir.patch")))) (synopsis "Avahi, an mDNS/DNS-SD implementation") (description "Avahi is a system which facilitates service discovery on a local diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm index fee834f9f9..dd4c036e4b 100644 --- a/gnu/packages/glib.scm +++ b/gnu/packages/glib.scm @@ -50,9 +50,21 @@ (base32 "1wacqyfkcpayg7f8rvx9awqg275n5pksxq5q7y21lxjx85x6pfjz")))) (build-system gnu-build-system) + (arguments + '(#:configure-flags (list ;; Install the system bus socket under /var. + "--localstatedir=/var" + + ;; XXX: Fix the following to allow system-wide + ;; config. + ;; "--sysconfdir=/etc" + + "--with-session-socket-dir=/tmp") + #:patches (list (assoc-ref %build-inputs "patch/localstatedir")))) (inputs `(("expat" ,expat) - ("pkg-config" ,pkg-config))) + ("pkg-config" ,pkg-config) + ("patch/localstatedir" + ,(search-patch "dbus-localstatedir.patch")))) (home-page "http://dbus.freedesktop.org/") (synopsis "Message bus for inter-process communication (IPC)") (description diff --git a/gnu/packages/patches/avahi-localstatedir.patch b/gnu/packages/patches/avahi-localstatedir.patch new file mode 100644 index 0000000000..76377d1057 --- /dev/null +++ b/gnu/packages/patches/avahi-localstatedir.patch @@ -0,0 +1,12 @@ +Don't "mkdir $(localstatedir)" since we can't do it (/var). + +--- avahi-0.6.27/avahi-daemon/Makefile.in 2010-07-13 05:06:35.000000000 +0200 ++++ avahi-0.6.27/avahi-daemon/Makefile.in 2010-07-13 18:03:45.000000000 +0200 +@@ -1554,7 +1554,6 @@ xmllint: + done + + install-data-local: +- test -z "$(localstatedir)/run" || $(mkdir_p) "$(DESTDIR)$(localstatedir)/run" + + update-systemd: + curl http://cgit.freedesktop.org/systemd/plain/src/sd-daemon.c > sd-daemon.c diff --git a/gnu/packages/patches/dbus-localstatedir.patch b/gnu/packages/patches/dbus-localstatedir.patch new file mode 100644 index 0000000000..61bed91b5c --- /dev/null +++ b/gnu/packages/patches/dbus-localstatedir.patch @@ -0,0 +1,30 @@ +Do not try to create $localstatedir and $sysconfdir since we cannot do this +when they are /var and /etc. + +--- dbus-1.6.4/bus/Makefile.in 2013-09-11 16:15:13.000000000 +0200 ++++ dbus-1.6.4/bus/Makefile.in 2013-09-11 16:15:15.000000000 +0200 +@@ -1510,9 +1510,6 @@ clean-local: + /bin/rm *.bb *.bbg *.da *.gcov || true + + install-data-hook: +- $(mkinstalldirs) $(DESTDIR)$(localstatedir)/run/dbus +- $(mkinstalldirs) $(DESTDIR)$(configdir)/system.d +- $(mkinstalldirs) $(DESTDIR)$(configdir)/session.d + $(mkinstalldirs) $(DESTDIR)$(datadir)/dbus-1/services + $(mkinstalldirs) $(DESTDIR)$(datadir)/dbus-1/system-services + # Install dbus.socket as default implementation of a D-Bus stack. + +--- dbus-1.6.4/tools/Makefile.in 2013-09-11 16:10:31.000000000 +0200 ++++ dbus-1.6.4/tools/Makefile.in 2013-09-11 16:10:32.000000000 +0200 +@@ -757,11 +757,6 @@ uninstall-am: uninstall-binPROGRAMS + + + # create the /var/lib/dbus directory for dbus-uuidgen +-install-data-local: +- $(MKDIR_P) $(DESTDIR)$(localstatedir)/lib/dbus +- +-installcheck-local: +- test -d $(DESTDIR)$(localstatedir)/lib/dbus + + # Tell versions [3.59,3.63) of GNU make to not export all variables. + # Otherwise a system limit (for SysV at least) may be exceeded. -- cgit v1.2.3 From ea1673808584f3c40cc76cc2ea570676309ba5bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 12 Sep 2013 14:09:29 +0200 Subject: daemon: Use 'int' instead of the internal 'gcry_md_algo_t' type. Fixes compilation with the forthcoming libgcrypt 1.6.x. Reported by Matthias Wachs and NIIBE Yutaka . * nix/libutil/gcrypt-hash.cc (guix_hash_init, guix_hash_final): Use 'int' as the type of the 'algo' parameter. * nix/libutil/gcrypt-hash.hh: Update declarations accordingly. --- nix/libutil/gcrypt-hash.cc | 6 +++--- nix/libutil/gcrypt-hash.hh | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/nix/libutil/gcrypt-hash.cc b/nix/libutil/gcrypt-hash.cc index b364a5747a..553f633b93 100644 --- a/nix/libutil/gcrypt-hash.cc +++ b/nix/libutil/gcrypt-hash.cc @@ -1,5 +1,5 @@ /* GNU Guix --- Functional package management for GNU - Copyright (C) 2012 Ludovic Courtès + Copyright (C) 2012, 2013 Ludovic Courtès This file is part of GNU Guix. @@ -24,7 +24,7 @@ extern "C" { void -guix_hash_init (struct guix_hash_context *ctx, gcry_md_algo_t algo) +guix_hash_init (struct guix_hash_context *ctx, int algo) { gcry_error_t err; @@ -40,7 +40,7 @@ guix_hash_update (struct guix_hash_context *ctx, const void *buffer, size_t len) void guix_hash_final (void *resbuf, struct guix_hash_context *ctx, - gcry_md_algo_t algo) + int algo) { memcpy (resbuf, gcry_md_read (ctx->md_handle, algo), gcry_md_get_algo_dlen (algo)); diff --git a/nix/libutil/gcrypt-hash.hh b/nix/libutil/gcrypt-hash.hh index d2d40d5fb2..d93a6eb881 100644 --- a/nix/libutil/gcrypt-hash.hh +++ b/nix/libutil/gcrypt-hash.hh @@ -1,5 +1,5 @@ /* GNU Guix --- Functional package management for GNU - Copyright (C) 2012 Ludovic Courtès + Copyright (C) 2012, 2013 Ludovic Courtès This file is part of GNU Guix. @@ -30,10 +30,10 @@ struct guix_hash_context gcry_md_hd_t md_handle; }; -extern void guix_hash_init (struct guix_hash_context *ctx, gcry_md_algo_t algo); +extern void guix_hash_init (struct guix_hash_context *ctx, int algo); extern void guix_hash_update (struct guix_hash_context *ctx, const void *buffer, size_t len); extern void guix_hash_final (void *resbuf, struct guix_hash_context *ctx, - gcry_md_algo_t algo); + int algo); } -- cgit v1.2.3 From 7763c538adc9739f0a95cff4cc1215e2b2bd2068 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 12 Sep 2013 14:11:15 +0200 Subject: Thank Matthias and Yutaka. --- THANKS | 2 ++ 1 file changed, 2 insertions(+) diff --git a/THANKS b/THANKS index 9dc330f998..c19fd2e8a7 100644 --- a/THANKS +++ b/THANKS @@ -15,6 +15,8 @@ infrastructure help: Rafael Ferreira Christian Grothoff Matthew Lien + Yutaka Niibe Alex Sassmannshausen Jason Self Alen Skondro + Matthias Wachs -- cgit v1.2.3 From 1d08c01fcf31ae7ac61f4595b151355b7a197e47 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Thu, 12 Sep 2013 15:31:45 +0200 Subject: gnu: Add python2-sqlite. * gnu/packages/python.scm (python2-sqlite): New variable. --- gnu/packages/python.scm | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 9b9a445f38..dcfe784e57 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -20,12 +20,15 @@ (define-module (gnu packages python) #:use-module ((guix licenses) #:select (bsd-3 psfl x11)) + #:use-module ((guix licenses) #:select (zlib) + #:renamer (symbol-prefix-proc 'license)) #:use-module (gnu packages) #:use-module (gnu packages compression) #:use-module (gnu packages gdbm) #:use-module (gnu packages readline) #:use-module (gnu packages openssl) #:use-module (gnu packages patchelf) + #:use-module (gnu packages sqlite) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix utils) @@ -313,3 +316,31 @@ datetime module, available in Python 2.3+.") (define-public python2-dateutil (package-with-python2 python-dateutil)) + + +(define-public python2-pysqlite + (package + (name "python2-pysqlite") + (version "2.6.3") + (source + (origin + (method url-fetch) + (uri (string-append "http://pysqlite.googlecode.com/files/pysqlite-" + version ".tar.gz")) + (sha256 + (base32 + "0nsqqfp072rgqbls100rdvbzkjkin7li3kprhfxlfqvzf608hlqd")))) + (build-system python-build-system) + (inputs + `(("sqlite" ,sqlite))) + (arguments + `(#:python ,python-2 ; incompatible with Python 3 + #:tests? #f)) ; no test target + (home-page "http://labix.org/python-dateutil") + (synopsis + "SQLite bindings for Python.") + (description + "Pysqlite provides SQLite bindings for Python that comply to the +Database API 2.0T.") + (license zlib))) + -- cgit v1.2.3 From 1b0a8212d1dc736610c1e87bfeb0ae8bf39ed23d Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Thu, 12 Sep 2013 17:31:53 +0000 Subject: guix package: Rename generation-related procedures. * guix/scripts/package.scm (profile-numbers): Rename to 'generation-numbers'. (previous-profile-number): Rename to 'previous-generation-number'. (profile-number): Rename to 'generation-number'. (roll-back): Rename 'previous-profile' to 'previous-generation'. --- guix/scripts/package.scm | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 5c3947dd63..1393ca3180 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -95,7 +95,7 @@ (make-regexp (string-append "^" (regexp-quote (basename profile)) "-([0-9]+)"))) -(define (profile-numbers profile) +(define (generation-numbers profile) "Return the list of generation numbers of PROFILE, or '(0) if no former profiles were found." (define* (scandir name #:optional (select? (const #t)) @@ -144,7 +144,7 @@ former profiles were found." (cute regexp-exec (profile-regexp profile) <>)) profiles)))) -(define (previous-profile-number profile number) +(define (previous-generation-number profile number) "Return the number of the generation before generation NUMBER of PROFILE, or 0 if none exists. It could be NUMBER - 1, but it's not the case when generations have been deleted (there are \"holes\")." @@ -153,7 +153,7 @@ case when generations have been deleted (there are \"holes\")." candidate highest)) 0 - (profile-numbers profile))) + (generation-numbers profile))) (define (profile-derivation store packages) "Return a derivation that builds a profile (a user environment) with @@ -205,7 +205,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." packages) #:modules '((guix build union)))) -(define (profile-number profile) +(define (generation-number profile) "Return PROFILE's number or 0. An absolute file name must be used." (or (and=> (false-if-exception (regexp-exec (profile-regexp profile) (basename (readlink profile)))) @@ -214,17 +214,17 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (define (roll-back profile) "Roll back to the previous generation of PROFILE." - (let* ((number (profile-number profile)) - (previous-number (previous-profile-number profile number)) - (previous-profile (format #f "~a-~a-link" - profile previous-number)) - (manifest (string-append previous-profile "/manifest"))) + (let* ((number (generation-number profile)) + (previous-number (previous-generation-number profile number)) + (previous-generation (format #f "~a-~a-link" + profile previous-number)) + (manifest (string-append previous-generation "/manifest"))) (define (switch-link) - ;; Atomically switch PROFILE to the previous profile. + ;; Atomically switch PROFILE to the previous generation. (format #t (_ "switching from generation ~a to ~a~%") number previous-number) - (switch-symlinks profile previous-profile)) + (switch-symlinks profile previous-generation)) (cond ((not (file-exists? profile)) ; invalid profile (leave (_ "profile `~a' does not exist~%") @@ -233,7 +233,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (format (current-error-port) (_ "nothing to do: already at the empty profile~%"))) ((or (zero? previous-number) ; going to emptiness - (not (file-exists? previous-profile))) + (not (file-exists? previous-generation))) (let*-values (((drv-path drv) (profile-derivation (%store) '())) ((prof) @@ -242,7 +242,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (when (not (build-derivations (%store) (list drv-path))) (leave (_ "failed to build the empty profile~%"))) - (switch-symlinks previous-profile prof) + (switch-symlinks previous-generation prof) (switch-link))) (else (switch-link))))) ; anything else @@ -846,7 +846,7 @@ more information.~%")) (%store) (manifest-packages (profile-manifest profile)))) (old-prof (derivation-path->output-path old-drv)) - (number (profile-number profile)) + (number (generation-number profile)) ;; Always use NUMBER + 1 for the new profile, ;; possibly overwriting a "previous future -- cgit v1.2.3 From 2875caf5b52340ea16965b1d8f76342cc07bf8b5 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Fri, 13 Sep 2013 14:25:53 +0200 Subject: gnu: Add python2-mechanize. * gnu/packages/python.scm (python2-mechanize): New variable. --- gnu/packages/python.scm | 37 ++++++++++++++++++++++++++++++++++++- 1 file changed, 36 insertions(+), 1 deletion(-) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index dcfe784e57..be33bf6570 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -19,7 +19,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu packages python) - #:use-module ((guix licenses) #:select (bsd-3 psfl x11)) + #:use-module ((guix licenses) #:select (bsd-3 bsd-style psfl x11)) #:use-module ((guix licenses) #:select (zlib) #:renamer (symbol-prefix-proc 'license)) #:use-module (gnu packages) @@ -344,3 +344,38 @@ datetime module, available in Python 2.3+.") Database API 2.0T.") (license zlib))) + +(define-public python2-mechanize + (package + (name "python2-mechanize") + (version "0.2.5") + (source + (origin + (method url-fetch) + (uri (string-append "https://pypi.python.org/packages/source/m/mechanize/mechanize-" + version ".tar.gz")) + (sha256 + (base32 + "0rj7r166i1dyrq0ihm5rijfmvhs8a04im28lv05c0c3v206v4rrf")))) + (build-system python-build-system) + (inputs + `(("python2-setuptools" ,python2-setuptools))) + (arguments + `(#:python ,python-2 ; apparently incompatible with Python 3 + #:tests? #f)) + ;; test fails with message + ;; AttributeError: 'module' object has no attribute 'test_pullparser' + ;; (python-3.3.2) or + ;; AttributeError: 'module' object has no attribute 'test_urllib2_localnet' + ;; (python-2.7.5). + ;; The source code is from March 2011 and probably not up-to-date + ;; with respect to python unit tests. + (home-page "http://wwwsearch.sourceforge.net/mechanize/") + (synopsis + "Stateful programmatic web browsing in Python") + (description + "Mechanize implements stateful programmatic web browsing in Python, +after Andy Lester’s Perl module WWW::Mechanize.") + (license (bsd-style "file://COPYING" + "See COPYING in the distribution.")))) + -- cgit v1.2.3 From 0cb9b45674b659b4dba7af2e19ab2491af1efecb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 13 Sep 2013 11:12:35 +0200 Subject: gnu: gnutls: Upgrade to 3.2.4. * gnu/packages/gnutls.scm (gnutls): Update to 3.2.4; remove 'arguments' field, remove "patch/fix-tests" from the inputs. * gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch: Remove. * gnu-system.am (dist_patch_DATA): Adjust accordingly. --- gnu-system.am | 1 - gnu/packages/gnutls.scm | 12 ++------ .../gnutls-fix-tests-on-32-bits-system.patch | 36 ---------------------- 3 files changed, 3 insertions(+), 46 deletions(-) delete mode 100644 gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch diff --git a/gnu-system.am b/gnu-system.am index 871254624a..4069301fe7 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -208,7 +208,6 @@ dist_patch_DATA = \ gnu/packages/patches/glib-tests-prlimit.patch \ gnu/packages/patches/glibc-bootstrap-system.patch \ gnu/packages/patches/glibc-no-ld-so-cache.patch \ - gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch \ gnu/packages/patches/grub-gets-undeclared.patch \ gnu/packages/patches/guile-1.8-cpp-4.5.patch \ gnu/packages/patches/guile-default-utf8.patch \ diff --git a/gnu/packages/gnutls.scm b/gnu/packages/gnutls.scm index d636a9c927..766731e289 100644 --- a/gnu/packages/gnutls.scm +++ b/gnu/packages/gnutls.scm @@ -54,7 +54,7 @@ portable, and only require an ANSI C89 platform.") (define-public gnutls (package (name "gnutls") - (version "3.2.1") + (version "3.2.4") (source (origin (method url-fetch) (uri @@ -64,20 +64,14 @@ portable, and only require an ANSI C89 platform.") version ".tar.xz")) (sha256 (base32 - "1zi2kq3vcbqdy9khl7r6pgk4hgwibniasm9k6siasdvqjijq3ymb")))) + "0zvhzy87v9dfxfvmg1pl951kw55rp647cqdza8942fxq7spp158i")))) (build-system gnu-build-system) - (arguments - `(#:patches (list (assoc-ref %build-inputs - "patch/fix-tests")) - #:patch-flags '("-p0"))) (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("guile" ,guile-2.0) ("zlib" ,guix:zlib) - ("perl" ,perl) - ("patch/fix-tests" - ,(search-patch "gnutls-fix-tests-on-32-bits-system.patch")))) + ("perl" ,perl))) (propagated-inputs `(("libtasn1" ,libtasn1) ("nettle" ,nettle) diff --git a/gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch b/gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch deleted file mode 100644 index 07d633149e..0000000000 --- a/gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch +++ /dev/null @@ -1,36 +0,0 @@ -From b12040aeab5fbaf02677571db1d8bf1995bd5ee0 Mon Sep 17 00:00:00 2001 -From: Nikos Mavrogiannopoulos -Date: Sun, 2 Jun 2013 12:10:06 +0200 -Subject: [PATCH] Avoid comparing the expiration date to prevent false positive -error in 32-bit systems. - ---- - tests/cert-tests/pem-decoding | 6 ++++-- - 1 files changed, 4 insertions(+), 2 deletions(-) - -diff --git a/tests/cert-tests/pem-decoding b/tests/cert-tests/pem-decoding -index fe769ec..f8c6372 100755 ---- tests/cert-tests/pem-decoding -+++ tests/cert-tests/pem-decoding -@@ -61,7 +61,9 @@ if test "$rc" != "0"; then - exit $rc - fi - --diff $srcdir/complex-cert.pem tmp-pem.pem -+cat $srcdir/complex-cert.pem |grep -v "Not After:" >tmp1 -+cat $srcdir/tmp-pem.pem |grep -v "Not After:" >tmp2 -+diff tmp1 tmp2 - rc=$? - - if test "$rc" != "0"; then -@@ -69,6 +71,6 @@ if test "$rc" != "0"; then - exit $rc - fi - --rm -f tmp-pem.pem -+rm -f tmp-pem.pem tmp1 tmp2 - - exit 0 --- -1.7.1 - -- cgit v1.2.3 From 29479de5659ba912b486c74078403bbb9a4df104 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 13 Sep 2013 23:42:36 +0200 Subject: substitute-binary: Add '--help'. Reported by Nikita Karetnikov . * guix/scripts/substitute-binary.scm (show-help): New procedure. (guix-substitute-binary): Add '--help'. --- guix/scripts/substitute-binary.scm | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 63f0c4f8d2..1afc93bbc9 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -444,6 +444,30 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by (leave (_ "host name lookup error: ~a~%") (gai-strerror error))))))) + +;;; +;;; Help. +;;; + +(define (show-help) + (display (_ "Usage: guix substitute-binary [OPTION]... +Internal tool to substitute a pre-built binary to a local build.\n")) + (display (_ " + --query report on the availability of substitutes for the + store file names passed on the standard input")) + (display (_ " + --substitute STORE-FILE DESTINATION + download STORE-FILE and store it as a Nar in file + DESTINATION")) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + + ;;; ;;; Entry point. @@ -536,7 +560,11 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by (restore-file input destination) (every (compose zero? cdr waitpid) pids)))) (("--version") - (show-version-and-exit "guix substitute-binary"))))) + (show-version-and-exit "guix substitute-binary")) + (("--help") + (show-help)) + (opts + (leave (_ "~a: unrecognized options~%") opts))))) ;;; Local Variables: -- cgit v1.2.3 From 803704418c4738ed63b3dd6aa893e3dc6da7d4db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 16 Sep 2013 19:00:47 +0200 Subject: gnu: dbus: Add dependency on libX11. * gnu/packages/glib.scm: Use #:export instead of 'define-public'. (dbus): Add LIBX11 as an input. --- gnu/packages/glib.scm | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm index da15d404dd..815fafcbfb 100644 --- a/gnu/packages/glib.scm +++ b/gnu/packages/glib.scm @@ -35,9 +35,18 @@ #:use-module (gnu packages python) #:use-module (gnu packages xml) #:use-module (gnu packages bash) - #:use-module (gnu packages file)) + #:use-module (gnu packages file) + #:use-module (gnu packages xorg) -(define-public dbus + ;; Export variables up-front to allow circular dependency with the 'xorg' + ;; module. + #:export (dbus + glib + dbus-glib + intltool + itstool)) + +(define dbus (package (name "dbus") (version "1.6.4") @@ -64,7 +73,12 @@ `(("expat" ,expat) ("pkg-config" ,pkg-config) ("patch/localstatedir" - ,(search-patch "dbus-localstatedir.patch")))) + ,(search-patch "dbus-localstatedir.patch")) + + ;; Add a dependency on libx11 so that 'dbus-launch' has support for + ;; '--autolaunch'. + ("libx11" ,libx11))) + (home-page "http://dbus.freedesktop.org/") (synopsis "Message bus for inter-process communication (IPC)") (description @@ -85,7 +99,7 @@ or through unencrypted TCP/IP suitable for use behind a firewall with shared NFS home directories.") (license license:gpl2+))) ; or Academic Free License 2.1 -(define-public glib +(define glib (package (name "glib") (version "2.37.1") @@ -157,7 +171,7 @@ dynamic loading, and an object system.") (home-page "http://developer.gnome.org/glib/") (license license:lgpl2.0+))) ; some files are under lgpl2.1+ -(define-public intltool +(define intltool (package (name "intltool") (version "0.50.2") @@ -198,7 +212,7 @@ The intltool collection can be used to do these things: oaf files. This merge step will happen at build resp. installation time.") (license license:gpl2+))) -(define-public itstool +(define itstool (package (name "itstool") (version "1.2.0") @@ -232,7 +246,7 @@ information in their documents, such as whether a particular element should be translated.") (license license:gpl3+))) -(define-public dbus-glib +(define dbus-glib (package (name "dbus-glib") (version "0.100.2") -- cgit v1.2.3 From 6a446d56801bfb197b1561bbe660675caa31c96c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 17 Sep 2013 23:00:55 +0200 Subject: derivations: Keep the .drv file name in objects. * guix/derivations.scm (): Add 'file-name' field. (%read-derivation): Use (port-filename DRV-PORT) as the file name for the result. (derivation): Set the 'file-name' field in the result. * tests/derivations.scm ("build derivation with 1 source"): Assert that 'derivation-file-name' returns the right thing. --- guix/derivations.scm | 40 ++++++++++++++++++++++++++-------------- tests/derivations.scm | 1 + 2 files changed, 27 insertions(+), 14 deletions(-) diff --git a/guix/derivations.scm b/guix/derivations.scm index c05644add2..f0f9ec7c21 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -36,6 +36,7 @@ derivation-system derivation-builder-arguments derivation-builder-environment-vars + derivation-file-name derivation-prerequisites derivation-prerequisites-to-build @@ -71,7 +72,8 @@ ;;; (define-record-type - (make-derivation outputs inputs sources system builder args env-vars) + (make-derivation outputs inputs sources system builder args env-vars + file-name) derivation? (outputs derivation-outputs) ; list of name/ pairs (inputs derivation-inputs) ; list of @@ -79,7 +81,8 @@ (system derivation-system) ; string (builder derivation-builder) ; store path (args derivation-builder-arguments) ; list of strings - (env-vars derivation-builder-environment-vars)) ; list of name/value pairs + (env-vars derivation-builder-environment-vars) ; list of name/value pairs + (file-name derivation-file-name)) ; the .drv file name (define-record-type (make-derivation-output path hash-algo hash) @@ -262,7 +265,8 @@ that second value is the empty list." (make-input-drvs input-drvs) input-srcs system builder args - (fold-right alist-cons '() var value))) + (fold-right alist-cons '() var value) + (port-filename drv-port))) (_ (error "failed to parse derivation" drv-port result))))) ((? (cut eq? <> comma)) @@ -470,7 +474,8 @@ in SIZE bytes." (make-derivation-input hash sub-drvs)))) inputs)) (drv (make-derivation outputs inputs sources - system builder args env-vars))) + system builder args env-vars + #f))) ;; XXX: At this point this remains faster than `port-sha256', because ;; the SHA256 port's `write' method gets called for every single @@ -545,7 +550,8 @@ the build environment in the corresponding file, in a simple text format." (or (and=> (assoc-ref outputs name) derivation-output-path) value)))) - env-vars)))))) + env-vars) + #f))))) (define (user+system-env-vars) ;; Some options are passed to the build daemon via the env. vars of @@ -578,6 +584,14 @@ the build environment in the corresponding file, in a simple text format." e outputs))) + (define (set-file-name drv file) + ;; Set FILE as the 'file-name' field of DRV. + (match drv + (($ outputs inputs sources system builder + args env-vars) + (make-derivation outputs inputs sources system builder + args env-vars file)))) + (let* ((outputs (map (lambda (name) ;; Return outputs with an empty path. (cons name @@ -604,17 +618,15 @@ the build environment in the corresponding file, in a simple text format." (and (not (derivation-path? p)) p))) inputs) - system builder args env-vars)) + system builder args env-vars #f)) (drv (add-output-paths drv-masked))) - ;; (write-derivation drv-masked (current-error-port)) - ;; (newline (current-error-port)) - (values (add-text-to-store store (string-append name ".drv") - (call-with-output-string - (cut write-derivation drv <>)) - (map derivation-input-path - inputs)) - drv))) + (let ((file (add-text-to-store store (string-append name ".drv") + (call-with-output-string + (cut write-derivation drv <>)) + (map derivation-input-path + inputs)))) + (values file (set-file-name drv file))))) ;;; diff --git a/tests/derivations.scm b/tests/derivations.scm index 9092e3acd6..e69dd0db31 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -134,6 +134,7 @@ (let ((path (derivation-output-path (assoc-ref (derivation-outputs drv) "out")))) (and (valid-path? %store path) + (string=? (derivation-file-name drv) drv-path) (string=? (call-with-input-file path read-line) "hello, world")))))) -- cgit v1.2.3 From 07c86312ca96d095ff5ebeae37940fd7c726c3e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 18 Sep 2013 11:10:02 +0200 Subject: derivations: Add a nicer printer. * guix/derivations.scm (): Add a printer. --- guix/derivations.scm | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/guix/derivations.scm b/guix/derivations.scm index f0f9ec7c21..43ea328b0e 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -19,6 +19,7 @@ (define-module (guix derivations) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-26) #:use-module (rnrs io ports) #:use-module (rnrs bytevectors) @@ -97,6 +98,17 @@ (path derivation-input-path) ; store path (sub-derivations derivation-input-sub-derivations)) ; list of strings +(set-record-type-printer! + (lambda (drv port) + (format port "# ~a ~a>" + (derivation-file-name drv) + (string-join + (map (match-lambda + ((_ . output) + (derivation-output-path output))) + (derivation-outputs drv))) + (number->string (object-address drv) 16)))) + (define (fixed-output-derivation? drv) "Return #t if DRV is a fixed-output derivation, such as the result of a download with a fixed hash (aka. `fetchurl')." -- cgit v1.2.3 From 81b66f8567ea2e3ecb0983318d5dedd3b1332e48 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 18 Sep 2013 16:42:51 +0200 Subject: tests: Clarify filtering of the "debug" output. * tests/guix-package.sh: Clearly filter out the "debug" output of 'gnu-make-boot0'. --- tests/guix-package.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/guix-package.sh b/tests/guix-package.sh index ee186ead83..60b42907a8 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -55,7 +55,7 @@ test "`guix package --search-paths -p "$profile" | wc -l`" = 0 if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null then boot_make="(@@ (gnu packages base) gnu-make-boot0)" - boot_make_drv="`guix build -e "$boot_make" | tail -1`" + boot_make_drv="`guix build -e "$boot_make" | grep -v -e -debug`" guix package --bootstrap -p "$profile" -i "$boot_make_drv" test -L "$profile-2-link" test -f "$profile/bin/make" && test -f "$profile/bin/guile" -- cgit v1.2.3 From 59688fc4b5cfac3e05610195a47795f5cc15f338 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 18 Sep 2013 17:01:40 +0200 Subject: derivations: 'derivation' and related procedures return a single value. * guix/derivations.scm (derivation->output-path, derivation->output-paths): New procedures. (derivation-path->output-path): Use 'derivation->output-path'. (derivation-path->output-paths): Use 'derivation->output-paths'. (derivation): Accept 'derivation?' objects as inputs. Return a single value. (build-derivations): New procedure. (compiled-modules): Use 'derivation->output-paths'. (build-expression->derivation)[source-path]: Add case for when the input matches 'derivation?'. [prologue]: Accept 'derivation?' objects in INPUTS. [mod-dir, go-dir]: Use 'derivation->output-path'. * guix/download.scm (url-fetch): Adjust to the single-value return. * guix/packages.scm (package-output): Use 'derivation->output-path'. * guix/scripts/build.scm (guix-build): When the argument is 'derivation-path?', pass it through 'read-derivation'. Use 'derivation-file-name' to print out the .drv file names, and to register them. Use 'derivation->output-path' instead of 'derivation-path->output-path'. * guix/scripts/package.scm (roll-back): Adjust to the single-value return. (guix-package): Use 'derivation->output-path'. * guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?' objects instead of .drv file names. * gnu/system/grub.scm (grub-configuration-file): Use 'derivation->output-path' instead of 'derivation-path->output-path'. * gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise. * tests/builders.scm, tests/derivations.scm, tests/packages.scm, tests/store.scm, tests/union.scm: Adjust to the new calling convention. * doc/guix.texi (Defining Packages, The Store, Derivations): Adjust accordingly. --- doc/guix.texi | 37 ++++---- gnu/system/grub.scm | 6 +- gnu/system/vm.scm | 12 +-- guix/build-system/cmake.scm | 6 +- guix/build-system/gnu.scm | 20 ++-- guix/build-system/perl.scm | 4 +- guix/build-system/python.scm | 4 +- guix/derivations.scm | 79 +++++++++++----- guix/download.scm | 32 +++---- guix/packages.scm | 11 +-- guix/scripts/build.scm | 23 +++-- guix/scripts/package.scm | 19 ++-- guix/ui.scm | 34 +++---- tests/builders.scm | 8 +- tests/derivations.scm | 219 ++++++++++++++++++++----------------------- tests/packages.scm | 38 ++++---- tests/store.scm | 31 +++--- tests/union.scm | 2 +- 18 files changed, 295 insertions(+), 290 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 5d1b780144..92c163c608 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -987,8 +987,8 @@ The build actions it prescribes may then be realized by using the @code{build-derivations} procedure (@pxref{The Store}). @deffn {Scheme Procedure} package-derivation @var{store} @var{package} [@var{system}] -Return the derivation path and corresponding @code{} object -of @var{package} for @var{system} (@pxref{Derivations}). +Return the @code{} object of @var{package} for @var{system} +(@pxref{Derivations}). @var{package} must be a valid @code{} object, and @var{system} must be a string denoting the target system type---e.g., @@ -1004,8 +1004,8 @@ package for some other system: @deffn {Scheme Procedure} package-cross-derivation @var{store} @ @var{package} @var{target} [@var{system}] -Return the derivation path and corresponding @code{} object -of @var{package} cross-built from @var{system} to @var{target}. +Return the @code{} object of @var{package} cross-built from +@var{system} to @var{target}. @var{target} must be a valid GNU triplet denoting the target hardware and operating system, such as @code{"mips64el-linux-gnu"} @@ -1068,8 +1068,9 @@ resulting store path. @end deffn @deffn {Scheme Procedure} build-derivations @var{server} @var{derivations} -Build @var{derivations} (a list of derivation paths), and return when -the worker is done building them. Return @code{#t} on success. +Build @var{derivations} (a list of @code{} objects or +derivation paths), and return when the worker is done building them. +Return @code{#t} on success. @end deffn @c FIXME @@ -1119,8 +1120,8 @@ otherwise manipulate derivations. The lowest-level primitive to create a derivation is the @code{derivation} procedure: @deffn {Scheme Procedure} derivation @var{store} @var{name} @var{builder} @var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] [#:hash-mode #f] [#:inputs '()] [#:env-vars '()] [#:system (%current-system)] [#:references-graphs #f] -Build a derivation with the given arguments. Return the resulting store -path and @code{} object. +Build a derivation with the given arguments, and return the resulting +@code{} object. When @var{hash}, @var{hash-algo}, and @var{hash-mode} are given, a @dfn{fixed-output derivation} is created---i.e., one whose result is @@ -1142,16 +1143,13 @@ to a Bash executable in the store: (guix store) (guix derivations)) -(call-with-values - (lambda () - (let ((builder ; add the Bash script to the store - (add-text-to-store store "my-builder.sh" - "echo hello world > $out\n" '()))) - (derivation store "foo" - bash `("-e" ,builder) - #:env-vars '(("HOME" . "/homeless"))))) - list) -@result{} ("/nix/store/@dots{}-foo.drv" #< @dots{}>) +(let ((builder ; add the Bash script to the store + (add-text-to-store store "my-builder.sh" + "echo hello world > $out\n" '()))) + (derivation store "foo" + bash `("-e" ,builder) + #:env-vars '(("HOME" . "/homeless")))) +@result{} # /nix/store/@dots{}-foo> @end lisp As can be guessed, this primitive is cumbersome to use directly. An @@ -1196,8 +1194,7 @@ containing one file: (build-expression->derivation store "goo" (%current-system) builder '())) -@result{} "/nix/store/@dots{}-goo.drv" -@result{} #< @dots{}> +@result{} # @dots{}> @end lisp @cindex strata of code diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 695a044bfa..b2438b9c5b 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -56,7 +56,7 @@ search.file ~a~%" (any (match-lambda (($ _ linux) (let* ((drv (package-derivation store linux system)) - (out (derivation-path->output-path drv))) + (out (derivation->output-path drv))) (string-append out "/bzImage")))) entries))) @@ -71,9 +71,9 @@ search.file ~a~%" initrd ~a/initrd }~%" label - (derivation-path->output-path linux-drv) + (derivation->output-path linux-drv) (string-join arguments) - (derivation-path->output-path initrd-drv)))))) + (derivation->output-path initrd-drv)))))) (add-text-to-store store "grub.cfg" (string-append prologue diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 192ed1d5a3..68d205d82a 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -206,10 +206,10 @@ It can be used to provide additional files, such as /etc files." (define input->name+derivation (match-lambda ((name (? package? package)) - `(,name . ,(derivation-path->output-path + `(,name . ,(derivation->output-path (package-derivation store package system)))) ((name (? package? package) sub-drv) - `(,name . ,(derivation-path->output-path + `(,name . ,(derivation->output-path (package-derivation store package system) sub-drv))) ((input (and (? string?) (? store-path?) file)) @@ -361,14 +361,14 @@ It can be used to provide additional files, such as /etc files." (parameterize ((%guile-for-build (package-derivation store guile-final))) (let* ((bash-drv (package-derivation store bash)) - (bash-file (string-append (derivation-path->output-path bash-drv) + (bash-file (string-append (derivation->output-path bash-drv) "/bin/bash")) (accounts (list (vector "root" "" 0 0 "System administrator" "/" bash-file))) (passwd (passwd-file store accounts)) (shadow (passwd-file store accounts #:shadow? #t)) (pam.d-drv (pam-services->directory store %pam-services)) - (pam.d (derivation-path->output-path pam.d-drv)) + (pam.d (derivation->output-path pam.d-drv)) (populate (add-text-to-store store "populate-qemu-image" (object->string @@ -381,11 +381,11 @@ It can be used to provide additional files, such as /etc files." (symlink ,pam.d "etc/pam.d") (mkdir-p "var/run"))) (list passwd))) - (out (derivation-path->output-path + (out (derivation->output-path (package-derivation store mingetty))) (getty (string-append out "/sbin/mingetty")) (iu-drv (package-derivation store inetutils)) - (syslogd (string-append (derivation-path->output-path iu-drv) + (syslogd (string-append (derivation->output-path iu-drv) "/libexec/syslogd")) (boot (add-text-to-store store "boot" (object->string diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm index 76a9a3befe..9461b19a2e 100644 --- a/guix/build-system/cmake.scm +++ b/guix/build-system/cmake.scm @@ -72,9 +72,9 @@ provides a 'CMakeLists.txt' file as its build system." (define builder `(begin (use-modules ,@modules) - (cmake-build #:source ,(if (and source (derivation-path? source)) - (derivation-path->output-path source) - source) + (cmake-build #:source ,(if (derivation? source) + (derivation->output-path source) + source) #:system ,system #:outputs %outputs #:inputs %build-inputs diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 03d56edadf..5f13f8ee29 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -291,8 +291,8 @@ which could lead to gratuitous input divergence." (define builder `(begin (use-modules ,@modules) - (gnu-build #:source ,(if (and source (derivation-path? source)) - (derivation-path->output-path source) + (gnu-build #:source ,(if (derivation? source) + (derivation->output-path source) source) #:system ,system #:outputs %outputs @@ -319,8 +319,8 @@ which could lead to gratuitous input divergence." (match guile ((? package?) (package-derivation store guile system)) - ((and (? string?) (? derivation-path?)) - guile) + ;; ((and (? string?) (? derivation-path?)) + ;; guile) (#f ; the default (let* ((distro (resolve-interface '(gnu packages base))) (guile (module-ref distro 'guile-final))) @@ -438,6 +438,8 @@ platform." (let () (define %build-host-inputs ',(map (match-lambda + ((name (? derivation? drv) sub ...) + `(,name . ,(apply derivation->output-path drv sub))) ((name (? derivation-path? drv-path) sub ...) `(,name . ,(apply derivation-path->output-path drv-path sub))) @@ -447,6 +449,8 @@ platform." (define %build-target-inputs ',(map (match-lambda + ((name (? derivation? drv) sub ...) + `(,name . ,(apply derivation->output-path drv sub))) ((name (? derivation-path? drv-path) sub ...) `(,name . ,(apply derivation-path->output-path drv-path sub))) @@ -454,8 +458,8 @@ platform." `(,name . ,path))) (append (or implicit-target-inputs '()) inputs))) - (gnu-build #:source ,(if (and source (derivation-path? source)) - (derivation-path->output-path source) + (gnu-build #:source ,(if (derivation? source) + (derivation->output-path source) source) #:system ,system #:target ,target @@ -488,8 +492,8 @@ platform." (match guile ((? package?) (package-derivation store guile system)) - ((and (? string?) (? derivation-path?)) - guile) + ;; ((and (? string?) (? derivation-path?)) + ;; guile) (#f ; the default (let* ((distro (resolve-interface '(gnu packages base))) (guile (module-ref distro 'guile-final))) diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm index 1ff9fd2674..6661689efb 100644 --- a/guix/build-system/perl.scm +++ b/guix/build-system/perl.scm @@ -62,8 +62,8 @@ provides a `Makefile.PL' file as its build system." `(begin (use-modules ,@modules) (perl-build #:name ,name - #:source ,(if (and source (derivation-path? source)) - (derivation-path->output-path source) + #:source ,(if (derivation? source) + (derivation->output-path source) source) #:search-paths ',(map search-path-specification->sexp (append perl-search-paths diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index 03e587ba01..cf7ca7d3e1 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -120,8 +120,8 @@ provides a 'setup.py' file as its build system." `(begin (use-modules ,@modules) (python-build #:name ,name - #:source ,(if (and source (derivation-path? source)) - (derivation-path->output-path source) + #:source ,(if (derivation? source) + (derivation->output-path source) source) #:configure-flags ,configure-flags #:system ,system diff --git a/guix/derivations.scm b/guix/derivations.scm index 43ea328b0e..433a8f145e 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -58,6 +58,8 @@ read-derivation write-derivation + derivation->output-path + derivation->output-paths derivation-path->output-path derivation-path->output-paths derivation @@ -66,7 +68,8 @@ imported-modules compiled-modules build-expression->derivation - imported-files)) + imported-files) + #:replace (build-derivations)) ;;; ;;; Nix derivations, as implemented in Nix's `derivations.cc'. @@ -420,25 +423,30 @@ that form." port) (display ")" port)))) +(define* (derivation->output-path drv #:optional (output "out")) + "Return the store path of its output OUTPUT." + (let ((outputs (derivation-outputs drv))) + (and=> (assoc-ref outputs output) derivation-output-path))) + +(define (derivation->output-paths drv) + "Return the list of name/path pairs of the outputs of DRV." + (map (match-lambda + ((name . output) + (cons name (derivation-output-path output)))) + (derivation-outputs drv))) + (define derivation-path->output-path ;; This procedure is called frequently, so memoize it. (memoize (lambda* (path #:optional (output "out")) "Read the derivation from PATH (`/nix/store/xxx.drv'), and return the store path of its output OUTPUT." - (let* ((drv (call-with-input-file path read-derivation)) - (outputs (derivation-outputs drv))) - (and=> (assoc-ref outputs output) derivation-output-path))))) + (derivation->output-path (call-with-input-file path read-derivation))))) (define (derivation-path->output-paths path) "Read the derivation from PATH (`/nix/store/xxx.drv'), and return the list of name/path pairs of its outputs." - (let* ((drv (call-with-input-file path read-derivation)) - (outputs (derivation-outputs drv))) - (map (match-lambda - ((name . output) - (cons name (derivation-output-path output)))) - outputs))) + (derivation->output-paths (call-with-input-file path read-derivation))) ;;; @@ -522,10 +530,10 @@ the derivation called NAME with hash HASH." (inputs '()) (outputs '("out")) hash hash-algo hash-mode references-graphs) - "Build a derivation with the given arguments. Return the resulting -store path and object. When HASH, HASH-ALGO, and HASH-MODE -are given, a fixed-output derivation is created---i.e., one whose result is -known in advance, such as a file download. + "Build a derivation with the given arguments, and return the resulting + object. When HASH, HASH-ALGO, and HASH-MODE are given, a +fixed-output derivation is created---i.e., one whose result is known in +advance, such as a file download. When REFERENCES-GRAPHS is true, it must be a list of file name/store path pairs. In that case, the reference graph of each store path is exported in @@ -610,6 +618,12 @@ the build environment in the corresponding file, in a simple text format." (make-derivation-output "" hash-algo hash))) outputs)) (inputs (map (match-lambda + (((? derivation? drv)) + (make-derivation-input (derivation-file-name drv) + '("out"))) + (((? derivation? drv) sub-drvs ...) + (make-derivation-input (derivation-file-name drv) + sub-drvs)) (((? direct-store-path? input)) (make-derivation-input input '("out"))) (((? direct-store-path? input) sub-drvs ...) @@ -638,7 +652,21 @@ the build environment in the corresponding file, in a simple text format." (cut write-derivation drv <>)) (map derivation-input-path inputs)))) - (values file (set-file-name drv file))))) + (set-file-name drv file)))) + + +;;; +;;; Store compatibility layer. +;;; + +(define (build-derivations store derivations) + "Build DERIVATIONS, a list of objects or .drv file names." + (let ((build (@ (guix store) build-derivations))) + (build store (map (match-lambda + ((? string? file) file) + ((and drv ($ )) + (derivation-file-name drv))) + derivations)))) ;;; @@ -730,7 +758,7 @@ they can refer to each other." #:system system #:guile guile #:module-path module-path)) - (module-dir (derivation-path->output-path module-drv)) + (module-dir (derivation->output-path module-drv)) (files (map (lambda (m) (let ((f (string-join (map symbol->string m) "/"))) @@ -794,7 +822,7 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS." (or guile-for-build (%guile-for-build))) (define guile - (string-append (derivation-path->output-path guile-drv) + (string-append (derivation->output-path guile-drv) "/bin/guile")) (define module-form? @@ -806,6 +834,8 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS." ;; When passed an input that is a source, return its path; otherwise ;; return #f. (match-lambda + ((_ (? derivation?) _ ...) + #f) ((_ path _ ...) (and (not (derivation-path? path)) path)))) @@ -830,10 +860,13 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS." (() "out") ((x) x)))) (cons name - (if (derivation-path? drv) - (derivation-path->output-path drv - sub) - drv))))) + (cond + ((derivation? drv) + (derivation->output-path drv sub)) + ((derivation-path? drv) + (derivation-path->output-path drv + sub)) + (else drv)))))) inputs)) ,@(if (null? modules) @@ -878,13 +911,13 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS." #:guile guile-drv #:system system))) (mod-dir (and mod-drv - (derivation-path->output-path mod-drv))) + (derivation->output-path mod-drv))) (go-drv (and (pair? modules) (compiled-modules store modules #:guile guile-drv #:system system))) (go-dir (and go-drv - (derivation-path->output-path go-drv)))) + (derivation->output-path go-drv)))) (derivation store name guile `("--no-auto-compile" ,@(if mod-dir `("-L" ,mod-dir) '()) diff --git a/guix/download.scm b/guix/download.scm index fa76615ef2..8b1d15f273 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -25,7 +25,6 @@ #:use-module ((guix build download) #:renamer (symbol-prefix-proc 'build:)) #:use-module (guix utils) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:export (%mirrors url-fetch @@ -212,27 +211,22 @@ must be a list of symbol/URL-list pairs." ((url ...) (any https? url))))) - (let*-values (((gnutls-drv-path gnutls-drv) - (if need-gnutls? - (gnutls-derivation store system) - (values #f #f))) - ((gnutls) - (and gnutls-drv - (derivation-output-path - (assoc-ref (derivation-outputs gnutls-drv) - "out")))) - ((env-vars) - (if gnutls - (let ((dir (string-append gnutls "/share/guile/site"))) - ;; XXX: `GUILE_LOAD_COMPILED_PATH' is overridden - ;; by `build-expression->derivation', so we can't - ;; set it here. - `(("GUILE_LOAD_PATH" . ,dir))) - '()))) + (let* ((gnutls-drv (if need-gnutls? + (gnutls-derivation store system) + (values #f #f))) + (gnutls (and gnutls-drv + (derivation->output-path gnutls-drv "out"))) + (env-vars (if gnutls + (let ((dir (string-append gnutls "/share/guile/site"))) + ;; XXX: `GUILE_LOAD_COMPILED_PATH' is overridden + ;; by `build-expression->derivation', so we can't + ;; set it here. + `(("GUILE_LOAD_PATH" . ,dir))) + '()))) (build-expression->derivation store (or name file-name) system builder (if gnutls-drv - `(("gnutls" ,gnutls-drv-path)) + `(("gnutls" ,gnutls-drv)) '()) #:hash-algo hash-algo #:hash hash diff --git a/guix/packages.scm b/guix/packages.scm index f63727dd32..efec414675 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -26,7 +26,6 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9 gnu) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) @@ -370,8 +369,8 @@ information in exceptions." (define* (package-derivation store package #:optional (system (%current-system))) - "Return the derivation path and corresponding object of -PACKAGE for SYSTEM." + "Return the object of PACKAGE for SYSTEM." + ;; Compute the derivation and cache the result. Caching is important ;; because some derivations, such as the implicit inputs of the GNU build ;; system, will be queried many, many times in a row. @@ -468,7 +467,5 @@ system identifying string)." "Return the output path of PACKAGE's OUTPUT for SYSTEM---where OUTPUT is the symbolic output name, such as \"out\". Note that this procedure calls `package-derivation', which is costly." - (let-values (((_ drv) - (package-derivation store package system))) - (derivation-output-path - (assoc-ref (derivation-outputs drv) output)))) + (let ((drv (package-derivation store package system))) + (derivation->output-path drv output))) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 26cd28215e..a06755dc7a 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -250,7 +250,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (derivations-from-package-expressions str package->derivation sys src?)) (('argument . (? derivation-path? drv)) - drv) + (call-with-input-file drv read-derivation)) (('argument . (? string? x)) (let ((p (find-package x))) (if src? @@ -280,24 +280,23 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (if (assoc-ref opts 'derivations-only?) (begin - (format #t "~{~a~%~}" drv) + (format #t "~{~a~%~}" (map derivation-file-name drv)) (for-each (cut register-root <> <>) - (map list drv) roots)) + (map (compose list derivation-file-name) drv) + roots)) (or (assoc-ref opts 'dry-run?) (and (build-derivations (%store) drv) (for-each (lambda (d) - (let ((drv (call-with-input-file d - read-derivation))) - (format #t "~{~a~%~}" - (map (match-lambda - ((out-name . out) - (derivation-path->output-path - d out-name))) - (derivation-outputs drv))))) + (format #t "~{~a~%~}" + (map (match-lambda + ((out-name . out) + (derivation->output-path + d out-name))) + (derivation-outputs d)))) drv) (for-each (cut register-root <> <>) (map (lambda (drv) (map cdr - (derivation-path->output-paths drv))) + (derivation->output-paths drv))) drv) roots))))))))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 1393ca3180..862b82612a 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -234,12 +234,9 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (_ "nothing to do: already at the empty profile~%"))) ((or (zero? previous-number) ; going to emptiness (not (file-exists? previous-generation))) - (let*-values (((drv-path drv) - (profile-derivation (%store) '())) - ((prof) - (derivation-output-path - (assoc-ref (derivation-outputs drv) "out")))) - (when (not (build-derivations (%store) (list drv-path))) + (let* ((drv (profile-derivation (%store) '())) + (prof (derivation->output-path drv "out"))) + (when (not (build-derivations (%store) (list drv))) (leave (_ "failed to build the empty profile~%"))) (switch-symlinks previous-generation prof) @@ -558,7 +555,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (define (guile-missing?) ;; Return #t if %GUILE-FOR-BUILD is not available yet. - (let ((out (derivation-path->output-path (%guile-for-build)))) + (let ((out (derivation->output-path (%guile-for-build)))) (not (valid-path? (%store) out)))) (define newest-available-packages @@ -617,7 +614,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (case (version-compare candidate-version current-version) ((>) #t) ((<) #f) - ((=) (let ((candidate-path (derivation-path->output-path + ((=) (let ((candidate-path (derivation->output-path (package-derivation (%store) pkg)))) (not (string=? current-path candidate-path)))))) (#f #f))) @@ -808,7 +805,7 @@ more information.~%")) (match tuple ((name version sub-drv _ (deps ...)) (let ((output-path - (derivation-path->output-path + (derivation->output-path drv sub-drv))) `(,name ,version ,sub-drv ,output-path ,(canonicalize-deps deps)))))) @@ -841,11 +838,11 @@ more information.~%")) (or dry-run? (and (build-derivations (%store) drv) (let* ((prof-drv (profile-derivation (%store) packages)) - (prof (derivation-path->output-path prof-drv)) + (prof (derivation->output-path prof-drv)) (old-drv (profile-derivation (%store) (manifest-packages (profile-manifest profile)))) - (old-prof (derivation-path->output-path old-drv)) + (old-prof (derivation->output-path old-drv)) (number (generation-number profile)) ;; Always use NUMBER + 1 for the new profile, diff --git a/guix/ui.scm b/guix/ui.scm index 720d01be02..293730308e 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -210,27 +210,27 @@ derivations listed in DRV. Return #t if there's something to build, #f otherwise. When USE-SUBSTITUTES?, check and report what is prerequisites are available for download." (let*-values (((build download) - (fold2 (lambda (drv-path build download) - (let ((drv (call-with-input-file drv-path - read-derivation))) - (let-values (((b d) - (derivation-prerequisites-to-build - store drv - #:use-substitutes? - use-substitutes?))) - (values (append b build) - (append d download))))) + (fold2 (lambda (drv build download) + (let-values (((b d) + (derivation-prerequisites-to-build + store drv + #:use-substitutes? + use-substitutes?))) + (values (append b build) + (append d download)))) '() '() drv)) ((build) ; add the DRV themselves (delete-duplicates - (append (remove (compose (lambda (out) - (or (valid-path? store out) - (and use-substitutes? - (has-substitutes? store - out)))) - derivation-path->output-path) - drv) + (append (map derivation-file-name + (remove (lambda (drv) + (let ((out (derivation->output-path + drv))) + (or (valid-path? store out) + (and use-substitutes? + (has-substitutes? store + out))))) + drv)) (map derivation-input-path build)))) ((download) ; add the references of DOWNLOAD (if use-substitutes? diff --git a/tests/builders.scm b/tests/builders.scm index 1e6b62ee6a..0ed5d74a22 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -70,10 +70,10 @@ "ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")) (hash (nix-base32-string->bytevector "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")) - (drv-path (url-fetch %store url 'sha256 hash + (drv (url-fetch %store url 'sha256 hash #:guile %bootstrap-guile)) - (out-path (derivation-path->output-path drv-path))) - (and (build-derivations %store (list drv-path)) + (out-path (derivation->output-path drv))) + (and (build-derivations %store (list drv)) (file-exists? out-path) (valid-path? %store out-path)))) @@ -93,7 +93,7 @@ #:implicit-inputs? #f #:guile %bootstrap-guile #:search-paths %bootstrap-search-paths)) - (out (derivation-path->output-path build))) + (out (derivation->output-path build))) (and (build-derivations %store (list (pk 'hello-drv build))) (valid-path? %store out) (file-exists? (string-append out "/bin/hello"))))) diff --git a/tests/derivations.scm b/tests/derivations.scm index e69dd0db31..4756fb9cba 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -110,31 +110,27 @@ (let* ((builder (add-text-to-store %store "my-builder.sh" "echo hello, world\n" '())) - (drv-path (derivation %store "foo" + (drv (derivation %store "foo" %bash `("-e" ,builder) #:env-vars '(("HOME" . "/homeless"))))) - (and (store-path? drv-path) - (valid-path? %store drv-path)))) + (and (store-path? (derivation-file-name drv)) + (valid-path? %store (derivation-file-name drv))))) (test-assert "build derivation with 1 source" - (let*-values (((builder) - (add-text-to-store %store "my-builder.sh" - "echo hello, world > \"$out\"\n" - '())) - ((drv-path drv) - (derivation %store "foo" - %bash `(,builder) - #:env-vars '(("HOME" . "/homeless") - ("zzz" . "Z!") - ("AAA" . "A!")) - #:inputs `((,builder)))) - ((succeeded?) - (build-derivations %store (list drv-path)))) + (let* ((builder (add-text-to-store %store "my-builder.sh" + "echo hello, world > \"$out\"\n" + '())) + (drv (derivation %store "foo" + %bash `(,builder) + #:env-vars '(("HOME" . "/homeless") + ("zzz" . "Z!") + ("AAA" . "A!")) + #:inputs `((,builder)))) + (succeeded? + (build-derivations %store (list drv)))) (and succeeded? - (let ((path (derivation-output-path - (assoc-ref (derivation-outputs drv) "out")))) + (let ((path (derivation->output-path drv))) (and (valid-path? %store path) - (string=? (derivation-file-name drv) drv-path) (string=? (call-with-input-file path read-line) "hello, world")))))) @@ -146,7 +142,7 @@ (input (search-path %load-path "ice-9/boot-9.scm")) (input* (add-to-store %store (basename input) #t "sha256" input)) - (drv-path (derivation %store "derivation-with-input-file" + (drv (derivation %store "derivation-with-input-file" %bash `(,builder) ;; Cheat to pass the actual file name to the @@ -155,22 +151,22 @@ #:inputs `((,builder) (,input))))) ; ← local file name - (and (build-derivations %store (list drv-path)) + (and (build-derivations %store (list drv)) ;; Note: we can't compare the files because the above trick alters ;; the contents. - (valid-path? %store (derivation-path->output-path drv-path))))) + (valid-path? %store (derivation->output-path drv))))) (test-assert "fixed-output derivation" (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo -n hello > $out" '())) (hash (sha256 (string->utf8 "hello"))) - (drv-path (derivation %store "fixed" + (drv (derivation %store "fixed" %bash `(,builder) #:inputs `((,builder)) ; optional #:hash hash #:hash-algo 'sha256)) - (succeeded? (build-derivations %store (list drv-path)))) + (succeeded? (build-derivations %store (list drv)))) (and succeeded? - (let ((p (derivation-path->output-path drv-path))) + (let ((p (derivation->output-path drv))) (and (equal? (string->utf8 "hello") (call-with-input-file p get-bytevector-all)) (bytevector? (query-path-hash %store p))))))) @@ -181,17 +177,16 @@ (builder2 (add-text-to-store %store "fixed-builder2.sh" "echo hey; echo -n hello > $out" '())) (hash (sha256 (string->utf8 "hello"))) - (drv-path1 (derivation %store "fixed" + (drv1 (derivation %store "fixed" %bash `(,builder1) #:hash hash #:hash-algo 'sha256)) - (drv-path2 (derivation %store "fixed" + (drv2 (derivation %store "fixed" %bash `(,builder2) #:hash hash #:hash-algo 'sha256)) - (succeeded? (build-derivations %store - (list drv-path1 drv-path2)))) + (succeeded? (build-derivations %store (list drv1 drv2)))) (and succeeded? - (equal? (derivation-path->output-path drv-path1) - (derivation-path->output-path drv-path2))))) + (equal? (derivation->output-path drv1) + (derivation->output-path drv2))))) (test-assert "derivation with a fixed-output input" ;; A derivation D using a fixed-output derivation F doesn't has the same @@ -208,7 +203,7 @@ (fixed2 (derivation %store "fixed" %bash `(,builder2) #:hash hash #:hash-algo 'sha256)) - (fixed-out (derivation-path->output-path fixed1)) + (fixed-out (derivation->output-path fixed1)) (builder3 (add-text-to-store %store "final-builder.sh" ;; Use Bash hackery to avoid Coreutils. @@ -224,26 +219,26 @@ (succeeded? (build-derivations %store (list final1 final2)))) (and succeeded? - (equal? (derivation-path->output-path final1) - (derivation-path->output-path final2))))) + (equal? (derivation->output-path final1) + (derivation->output-path final2))))) (test-assert "multiple-output derivation" (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo one > $out ; echo two > $second" '())) - (drv-path (derivation %store "fixed" + (drv (derivation %store "fixed" %bash `(,builder) #:env-vars '(("HOME" . "/homeless") ("zzz" . "Z!") ("AAA" . "A!")) #:inputs `((,builder)) #:outputs '("out" "second"))) - (succeeded? (build-derivations %store (list drv-path)))) + (succeeded? (build-derivations %store (list drv)))) (and succeeded? - (let ((one (derivation-path->output-path drv-path "out")) - (two (derivation-path->output-path drv-path "second"))) + (let ((one (derivation->output-path drv "out")) + (two (derivation->output-path drv "second"))) (and (lset= equal? - (derivation-path->output-paths drv-path) + (derivation->output-paths drv) `(("out" . ,one) ("second" . ,two))) (eq? 'one (call-with-input-file one read)) (eq? 'two (call-with-input-file two read))))))) @@ -254,14 +249,14 @@ (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo one > $out ; echo two > $AAA" '())) - (drv-path (derivation %store "fixed" + (drv (derivation %store "fixed" %bash `(,builder) #:inputs `((,builder)) #:outputs '("out" "AAA"))) - (succeeded? (build-derivations %store (list drv-path)))) + (succeeded? (build-derivations %store (list drv)))) (and succeeded? - (let ((one (derivation-path->output-path drv-path "out")) - (two (derivation-path->output-path drv-path "AAA"))) + (let ((one (derivation->output-path drv "out")) + (two (derivation->output-path drv "AAA"))) (and (eq? 'one (call-with-input-file one read)) (eq? 'two (call-with-input-file two read))))))) @@ -283,17 +278,17 @@ (udrv (derivation %store "multiple-output-user" %bash `(,builder2) #:env-vars `(("one" - . ,(derivation-path->output-path + . ,(derivation->output-path mdrv "out")) ("two" - . ,(derivation-path->output-path + . ,(derivation->output-path mdrv "two"))) #:inputs `((,builder2) ;; two occurrences of MDRV: (,mdrv) (,mdrv "two"))))) (and (build-derivations %store (list (pk 'udrv udrv))) - (let ((p (derivation-path->output-path udrv))) + (let ((p (derivation->output-path udrv))) (and (valid-path? %store p) (equal? '(one two) (call-with-input-file p read))))))) @@ -318,7 +313,7 @@ ("input1" . ,input1) ("input2" . ,input2)) #:inputs `((,%bash) (,builder)))) - (out (derivation-path->output-path drv))) + (out (derivation->output-path drv))) (define (deps path . deps) (let ((count (length deps))) (string-append path "\n\n" (number->string count) "\n" @@ -361,31 +356,30 @@ (add-text-to-store %store "build-with-coreutils.sh" "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good" '())) - (drv-path + (drv (derivation %store "foo" %bash `(,builder) #:env-vars `(("PATH" . ,(string-append - (derivation-path->output-path %coreutils) + (derivation->output-path %coreutils) "/bin"))) #:inputs `((,builder) (,%coreutils)))) (succeeded? - (build-derivations %store (list drv-path)))) + (build-derivations %store (list drv)))) (and succeeded? - (let ((p (derivation-path->output-path drv-path))) + (let ((p (derivation->output-path drv))) (and (valid-path? %store p) (file-exists? (string-append p "/good"))))))) (test-skip (if (%guile-for-build) 0 8)) (test-assert "build-expression->derivation and derivation-prerequisites" - (let-values (((drv-path drv) - (build-expression->derivation %store "fail" (%current-system) - #f '()))) + (let ((drv (build-expression->derivation %store "fail" (%current-system) + #f '()))) (any (match-lambda (($ path) - (string=? path (%guile-for-build)))) + (string=? path (derivation-file-name (%guile-for-build))))) (derivation-prerequisites drv)))) (test-assert "build-expression->derivation without inputs" @@ -394,11 +388,11 @@ (call-with-output-file (string-append %output "/test") (lambda (p) (display '(hello guix) p))))) - (drv-path (build-expression->derivation %store "goo" (%current-system) + (drv (build-expression->derivation %store "goo" (%current-system) builder '())) - (succeeded? (build-derivations %store (list drv-path)))) + (succeeded? (build-derivations %store (list drv)))) (and succeeded? - (let ((p (derivation-path->output-path drv-path))) + (let ((p (derivation->output-path drv))) (equal? '(hello guix) (call-with-input-file (string-append p "/test") read)))))) @@ -407,43 +401,35 @@ (set-build-options s #:max-silent-time 1) s)) (builder '(sleep 100)) - (drv-path (build-expression->derivation %store "silent" + (drv (build-expression->derivation %store "silent" (%current-system) builder '())) - (out-path (derivation-path->output-path drv-path))) + (out-path (derivation->output-path drv))) (guard (c ((nix-protocol-error? c) (and (string-contains (nix-protocol-error-message c) "failed") (not (valid-path? store out-path))))) - (build-derivations %store (list drv-path))))) + (build-derivations %store (list drv))))) (test-assert "build-expression->derivation and derivation-prerequisites-to-build" - (let-values (((drv-path drv) - (build-expression->derivation %store "fail" (%current-system) - #f '()))) + (let ((drv (build-expression->derivation %store "fail" (%current-system) + #f '()))) ;; The only direct dependency is (%guile-for-build) and it's already ;; built. (null? (derivation-prerequisites-to-build %store drv)))) (test-assert "derivation-prerequisites-to-build when outputs already present" - (let*-values (((builder) - '(begin (mkdir %output) #t)) - ((input-drv-path input-drv) - (build-expression->derivation %store "input" - (%current-system) - builder '())) - ((input-path) - (derivation-output-path - (assoc-ref (derivation-outputs input-drv) - "out"))) - ((drv-path drv) - (build-expression->derivation %store "something" - (%current-system) - builder - `(("i" ,input-drv-path)))) - ((output) - (derivation-output-path - (assoc-ref (derivation-outputs drv) "out")))) + (let* ((builder '(begin (mkdir %output) #t)) + (input-drv (build-expression->derivation %store "input" + (%current-system) + builder '())) + (input-path (derivation-output-path + (assoc-ref (derivation-outputs input-drv) + "out"))) + (drv (build-expression->derivation %store "something" + (%current-system) builder + `(("i" ,input-drv)))) + (output (derivation->output-path drv))) ;; Make sure these things are not already built. (when (valid-path? %store input-path) (delete-paths %store (list input-path))) @@ -452,10 +438,10 @@ (and (equal? (map derivation-input-path (derivation-prerequisites-to-build %store drv)) - (list input-drv-path)) + (list (derivation-file-name input-drv))) ;; Build DRV and delete its input. - (build-derivations %store (list drv-path)) + (build-derivations %store (list drv)) (delete-paths %store (list input-path)) (not (valid-path? %store input-path)) @@ -465,17 +451,12 @@ (test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1)) (test-assert "derivation-prerequisites-to-build and substitutes" - (let*-values (((store) - (open-connection)) - ((drv-path drv) - (build-expression->derivation store "prereq-subst" + (let* ((store (open-connection)) + (drv (build-expression->derivation store "prereq-subst" (%current-system) (random 1000) '())) - ((output) - (derivation-output-path - (assoc-ref (derivation-outputs drv) "out"))) - ((dir) - (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") + (output (derivation->output-path drv)) + (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) ;; Create fake substituter data, to be read by `substitute-binary'. (call-with-output-file (string-append dir "/nix-cache-info") @@ -495,7 +476,8 @@ Deriver: ~a~%" output ; StorePath (string-append dir "/example.nar") ; URL (%current-system) ; System - (basename drv-path)))) ; Deriver + (basename + (derivation-file-name drv))))) ; Deriver (let-values (((build download) (derivation-prerequisites-to-build store drv)) @@ -512,16 +494,16 @@ Deriver: ~a~%" (let* ((builder '(begin (mkdir %output) #f)) ; fail! - (drv-path (build-expression->derivation %store "fail" (%current-system) + (drv (build-expression->derivation %store "fail" (%current-system) builder '())) - (out-path (derivation-path->output-path drv-path))) + (out-path (derivation->output-path drv))) (guard (c ((nix-protocol-error? c) ;; Note that the output path may exist at this point, but it ;; is invalid. (and (string-match "build .* failed" (nix-protocol-error-message c)) (not (valid-path? %store out-path))))) - (build-derivations %store (list drv-path)) + (build-derivations %store (list drv)) #f))) (test-assert "build-expression->derivation with two outputs" @@ -532,15 +514,15 @@ Deriver: ~a~%" (call-with-output-file (assoc-ref %outputs "second") (lambda (p) (display '(world) p))))) - (drv-path (build-expression->derivation %store "double" + (drv (build-expression->derivation %store "double" (%current-system) builder '() #:outputs '("out" "second"))) - (succeeded? (build-derivations %store (list drv-path)))) + (succeeded? (build-derivations %store (list drv)))) (and succeeded? - (let ((one (derivation-path->output-path drv-path)) - (two (derivation-path->output-path drv-path "second"))) + (let ((one (derivation->output-path drv)) + (two (derivation->output-path drv "second"))) (and (equal? '(hello) (call-with-input-file one read)) (equal? '(world) (call-with-input-file two read))))))) @@ -553,12 +535,12 @@ Deriver: ~a~%" (dup2 (port->fdes p) 1) (execl (string-append cu "/bin/uname") "uname" "-a"))))) - (drv-path (build-expression->derivation %store "uname" (%current-system) + (drv (build-expression->derivation %store "uname" (%current-system) builder `(("cu" ,%coreutils)))) - (succeeded? (build-derivations %store (list drv-path)))) + (succeeded? (build-derivations %store (list drv)))) (and succeeded? - (let ((p (derivation-path->output-path drv-path))) + (let ((p (derivation->output-path drv))) (string-contains (call-with-input-file p read-line) "GNU"))))) (test-assert "imported-files" @@ -567,9 +549,9 @@ Deriver: ~a~%" "guix/derivations.scm")) ("p/q" . ,(search-path %load-path "guix.scm")) ("p/z" . ,(search-path %load-path "guix/store.scm")))) - (drv-path (imported-files %store files))) - (and (build-derivations %store (list drv-path)) - (let ((dir (derivation-path->output-path drv-path))) + (drv (imported-files %store files))) + (and (build-derivations %store (list drv)) + (let ((dir (derivation->output-path drv))) (every (match-lambda ((path . source) (equal? (call-with-input-file (string-append dir "/" path) @@ -584,14 +566,13 @@ Deriver: ~a~%" (let ((out (assoc-ref %outputs "out"))) (mkdir-p (string-append out "/guile/guix/nix")) #t))) - (drv-path (build-expression->derivation %store - "test-with-modules" + (drv (build-expression->derivation %store "test-with-modules" (%current-system) builder '() #:modules '((guix build utils))))) - (and (build-derivations %store (list drv-path)) - (let* ((p (derivation-path->output-path drv-path)) + (and (build-derivations %store (list drv)) + (let* ((p (derivation->output-path drv)) (s (stat (string-append p "/guile/guix/nix")))) (eq? (stat:type s) 'directory))))) @@ -615,9 +596,10 @@ Deriver: ~a~%" #:hash-algo 'sha256)) (succeeded? (build-derivations %store (list input1 input2)))) (and succeeded? - (not (string=? input1 input2)) - (string=? (derivation-path->output-path input1) - (derivation-path->output-path input2))))) + (not (string=? (derivation-file-name input1) + (derivation-file-name input2))) + (string=? (derivation->output-path input1) + (derivation->output-path input2))))) (test-assert "build-expression->derivation with a fixed-output input" (let* ((builder1 '(call-with-output-file %output @@ -649,8 +631,11 @@ Deriver: ~a~%" (%current-system) builder3 `(("input" ,input2))))) - (and (string=? (derivation-path->output-path final1) - (derivation-path->output-path final2)) + (and (string=? (derivation->output-path final1) + (derivation->output-path final2)) + (string=? (derivation->output-path final1) + (derivation-path->output-path + (derivation-file-name final1))) (build-derivations %store (list final1 final2))))) (test-assert "build-expression->derivation with #:references-graphs" @@ -662,7 +647,7 @@ Deriver: ~a~%" builder '() #:references-graphs `(("input" . ,input)))) - (out (derivation-path->output-path drv))) + (out (derivation->output-path drv))) (define (deps path . deps) (let ((count (length deps))) (string-append path "\n\n" (number->string count) "\n" diff --git a/tests/packages.scm b/tests/packages.scm index 8619011f59..706739fb70 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -121,17 +121,16 @@ (package-source package)))) (string=? file source))) -(test-assert "return values" - (let-values (((drv-path drv) - (package-derivation %store (dummy-package "p")))) - (and (derivation-path? drv-path) - (derivation? drv)))) +(test-assert "return value" + (let ((drv (package-derivation %store (dummy-package "p")))) + (and (derivation? drv) + (file-exists? (derivation-file-name drv))))) (test-assert "package-output" (let* ((package (dummy-package "p")) - (drv-path (package-derivation %store package))) - (and (derivation-path? drv-path) - (string=? (derivation-path->output-path drv-path) + (drv (package-derivation %store package))) + (and (derivation? drv) + (string=? (derivation->output-path drv) (package-output %store package "out"))))) (test-assert "trivial" @@ -148,7 +147,7 @@ (display '(hello guix) p)))))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) - (let ((p (pk 'drv d (derivation-path->output-path d)))) + (let ((p (pk 'drv d (derivation->output-path d)))) (equal? '(hello guix) (call-with-input-file (string-append p "/test") read)))))) @@ -164,7 +163,7 @@ (inputs `(("input" ,i))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) - (let ((p (pk 'drv d (derivation-path->output-path d)))) + (let ((p (pk 'drv d (derivation->output-path d)))) (equal? (call-with-input-file p get-bytevector-all) (call-with-input-file i get-bytevector-all)))))) @@ -183,7 +182,7 @@ (%current-system))))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) - (let ((p (pk 'drv d (derivation-path->output-path d)))) + (let ((p (pk 'drv d (derivation->output-path d)))) (eq? 'hello (call-with-input-file p read)))))) (test-assert "search paths" @@ -222,20 +221,17 @@ (equal? x (collect (package-derivation %store c))))))) (test-assert "package-cross-derivation" - (let-values (((drv-path drv) - (package-cross-derivation %store (dummy-package "p") - "mips64el-linux-gnu"))) - (and (derivation-path? drv-path) - (derivation? drv)))) + (let ((drv (package-cross-derivation %store (dummy-package "p") + "mips64el-linux-gnu"))) + (and (derivation? drv) + (file-exists? (derivation-file-name drv))))) (test-assert "package-cross-derivation, trivial-build-system" (let ((p (package (inherit (dummy-package "p")) (build-system trivial-build-system) (arguments '(#:builder (exit 1)))))) - (let-values (((drv-path drv) - (package-cross-derivation %store p "mips64el-linux-gnu"))) - (and (derivation-path? drv-path) - (derivation? drv))))) + (let ((drv (package-cross-derivation %store p "mips64el-linux-gnu"))) + (derivation? drv)))) (test-assert "package-cross-derivation, no cross builder" (let* ((b (build-system (inherit trivial-build-system) @@ -257,7 +253,7 @@ (or (location? (package-location gnu-make)) (not (package-location gnu-make))) (let* ((drv (package-derivation %store gnu-make)) - (out (derivation-path->output-path drv))) + (out (derivation->output-path drv))) (and (build-derivations %store (list drv)) (file-exists? (string-append out "/bin/make"))))))) diff --git a/tests/store.scm b/tests/store.scm index 0280713191..b5e0cb0eab 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -82,7 +82,7 @@ ;; (d1 (derivation %store "link" ;; "/bin/sh" `("-e" ,b) ;; #:inputs `((,b) (,p1)))) -;; (p2 (derivation-path->output-path d1))) +;; (p2 (derivation->output-path d1))) ;; (and (add-temp-root %store p2) ;; (build-derivations %store (list d1)) ;; (valid-path? %store p1) @@ -133,21 +133,21 @@ s `("-e" ,b) #:env-vars `(("foo" . ,(random-text))) #:inputs `((,b) (,s)))) - (o (derivation-path->output-path d))) + (o (derivation->output-path d))) (and (build-derivations %store (list d)) - (equal? (query-derivation-outputs %store d) + (equal? (query-derivation-outputs %store (derivation-file-name d)) (list o)) (equal? (valid-derivers %store o) - (list d))))) + (list (derivation-file-name d)))))) (test-assert "no substitutes" (let* ((s (open-connection)) (d1 (package-derivation s %bootstrap-guile (%current-system))) (d2 (package-derivation s %bootstrap-glibc (%current-system))) - (o (map derivation-path->output-path (list d1 d2)))) + (o (map derivation->output-path (list d1 d2)))) (set-build-options s #:use-substitutes? #f) - (and (not (has-substitutes? s d1)) - (not (has-substitutes? s d2)) + (and (not (has-substitutes? s (derivation-file-name d1))) + (not (has-substitutes? s (derivation-file-name d2))) (null? (substitutable-paths s o)) (null? (substitutable-path-info s o))))) @@ -156,7 +156,7 @@ (test-assert "substitute query" (let* ((s (open-connection)) (d (package-derivation s %bootstrap-guile (%current-system))) - (o (derivation-path->output-path d)) + (o (derivation->output-path d)) (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) ;; Create fake substituter data, to be read by `substitute-binary'. @@ -177,7 +177,8 @@ Deriver: ~a~%" o ; StorePath (string-append dir "/example.nar") ; URL (%current-system) ; System - (basename d)))) ; Deriver + (basename + (derivation-file-name d))))) ; Deriver ;; Remove entry from the local cache. (false-if-exception @@ -191,7 +192,7 @@ Deriver: ~a~%" (equal? (list o) (substitutable-paths s (list o))) (match (pk 'spi (substitutable-path-info s (list o))) (((? substitutable? s)) - (and (equal? (substitutable-deriver s) d) + (and (string=? (substitutable-deriver s) (derivation-file-name d)) (null? (substitutable-references s)) (equal? (substitutable-nar-size s) 1234))))))) @@ -207,7 +208,7 @@ Deriver: ~a~%" '() #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) - (o (derivation-path->output-path d)) + (o (derivation->output-path d)) (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) ;; Create fake substituter data, to be read by `substitute-binary'. @@ -238,7 +239,8 @@ Deriver: ~a~%" (compose bytevector->nix-base32-string sha256 get-bytevector-all)) (%current-system) ; System - (basename d)))) ; Deriver + (basename + (derivation-file-name d))))) ; Deriver ;; Make sure we use `substitute-binary'. (set-build-options s #:use-substitutes? #t) @@ -257,7 +259,7 @@ Deriver: ~a~%" '() #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) - (o (derivation-path->output-path d)) + (o (derivation->output-path d)) (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) ;; Create fake substituter data, to be read by `substitute-binary'. @@ -279,7 +281,8 @@ Deriver: ~a~%" o ; StorePath "does-not-exist.nar" ; relative URL (%current-system) ; System - (basename d)))) ; Deriver + (basename + (derivation-file-name d))))) ; Deriver ;; Make sure we use `substitute-binary'. (set-build-options s #:use-substitutes? #t) diff --git a/tests/union.scm b/tests/union.scm index 6287cffc38..cb110c3b1e 100644 --- a/tests/union.scm +++ b/tests/union.scm @@ -108,7 +108,7 @@ builder inputs #:modules '((guix build union))))) (and (build-derivations %store (list (pk 'drv drv))) - (with-directory-excursion (derivation-path->output-path drv) + (with-directory-excursion (derivation->output-path drv) (and (file-exists? "bin/touch") (file-exists? "bin/gcc") (file-exists? "bin/ld") -- cgit v1.2.3 From 37c0ce3d279450d5f33f7bc405989c570249f032 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 18 Sep 2013 19:00:03 +0200 Subject: hydra: Point the Git submodule to our local copy. * build-aux/hydra/guix.scm (tarball-package): Add 'nix-checkout' parameter. Replace 'patch-bootstrap-script' phase by 'set-nix-module'. (hydra-jobs): Get the 'nix' value from ARGUMENTS, and pass it to 'tarball-package'. --- build-aux/hydra/guix.scm | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/build-aux/hydra/guix.scm b/build-aux/hydra/guix.scm index dbc935d897..59e3172e1f 100644 --- a/build-aux/hydra/guix.scm +++ b/build-aux/hydra/guix.scm @@ -63,7 +63,7 @@ (home-page . ,(package-home-page package)) (maintainers . ("bug-guix@gnu.org")))) -(define (tarball-package checkout) +(define (tarball-package checkout nix-checkout) "Return a package that does `make distcheck' from CHECKOUT, a directory containing a Git checkout of Guix." (let ((dist (dist-package guix checkout))) @@ -72,12 +72,12 @@ containing a Git checkout of Guix." (arguments (substitute-keyword-arguments (package-arguments dist) ((#:phases p) `(alist-cons-before - 'autoreconf 'patch-bootstrap-script + 'autoreconf 'set-nix-submodule (lambda _ - ;; Comment out `git' invocations, since Hydra provides - ;; us with a checkout that includes sub-modules. - (substitute* "bootstrap" - (("git ") "true git "))) + ;; 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) @@ -99,8 +99,12 @@ containing a Git checkout of Guix." (define checkout (assq-ref arguments 'guix)) - (format (current-error-port) "using checkout ~s~%" checkout) + (define nix-checkout + (assq-ref arguments 'nix)) + + (format (current-error-port) "using checkout ~s (Nix: ~s)~%" + checkout nix-checkout) (let ((directory (assq-ref checkout 'file-name))) `((tarball . ,(cute package->alist store - (tarball-package directory) + (tarball-package directory nix-checkout) (%current-system)))))) -- cgit v1.2.3 From 3301f179709d4ef4d5a1f50a634698d9abdb0519 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 18 Sep 2013 19:37:50 +0200 Subject: hydra: Return the .drv file names, not the objects. * build-aux/hydra/gnu-system.scm (package->alist): Call 'derivation-file-name' on the result of 'package-derivation'. * build-aux/hydra/guix.scm (package->alist): Likewise. --- build-aux/hydra/gnu-system.scm | 3 ++- build-aux/hydra/guix.scm | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index 8206be22ff..abc107cb1c 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -58,7 +58,8 @@ (define* (package->alist store package system #:optional (package-derivation package-derivation)) "Convert PACKAGE to an alist suitable for Hydra." - `((derivation . ,(package-derivation store package system)) + `((derivation . ,(derivation-file-name + (package-derivation store package system))) (description . ,(package-synopsis package)) (long-description . ,(package-description package)) (license . ,(package-license package)) diff --git a/build-aux/hydra/guix.scm b/build-aux/hydra/guix.scm index 59e3172e1f..189b973a69 100644 --- a/build-aux/hydra/guix.scm +++ b/build-aux/hydra/guix.scm @@ -56,7 +56,8 @@ (define* (package->alist store package system #:optional (package-derivation package-derivation)) "Convert PACKAGE to an alist suitable for Hydra." - `((derivation . ,(package-derivation store package system)) + `((derivation . ,(derivation-file-name + (package-derivation store package system))) (description . ,(package-synopsis package)) (long-description . ,(package-description package)) (license . ,(package-license package)) -- cgit v1.2.3 From 97d010b7f8acbe8e609f401996d72d84ba2bbdbd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 18 Sep 2013 20:49:47 +0200 Subject: hydra: Add missing import. * build-aux/hydra/gnu-system.scm, build-aux/hydra/guix.scm: Use (guix derivations). --- build-aux/hydra/gnu-system.scm | 1 + build-aux/hydra/guix.scm | 1 + 2 files changed, 2 insertions(+) diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index abc107cb1c..72e4c35537 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -38,6 +38,7 @@ (use-modules (guix store) (guix packages) + (guix derivations) ((guix utils) #:select (%current-system)) (gnu packages) (gnu packages base) diff --git a/build-aux/hydra/guix.scm b/build-aux/hydra/guix.scm index 189b973a69..9800c1991d 100644 --- a/build-aux/hydra/guix.scm +++ b/build-aux/hydra/guix.scm @@ -40,6 +40,7 @@ (use-modules (guix store) (guix packages) (guix utils) + (guix derivations) (guix build-system gnu) (gnu packages version-control) (gnu packages package-management) -- cgit v1.2.3 From 1210c32eccbc62f3711dacc306cd5e94a94580d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 18 Sep 2013 20:58:49 +0200 Subject: hydra: Fix typo. * build-aux/hydra/guix.scm (tarball-package): Unquote 'nix-checkout'. --- build-aux/hydra/guix.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build-aux/hydra/guix.scm b/build-aux/hydra/guix.scm index 9800c1991d..941d240233 100644 --- a/build-aux/hydra/guix.scm +++ b/build-aux/hydra/guix.scm @@ -79,7 +79,7 @@ containing a Git checkout of Guix." ;; Tell Git to use the Nix checkout that Hydra gave us. (zero? (system* "git" "config" "submodule.nix-upstream.url" - nix-checkout))) + ,nix-checkout))) ,p)))) (native-inputs `(("git" ,git) ("graphviz" ,graphviz) -- cgit v1.2.3 From 72d9148fbf6e097cd8838b51c49f107c5176287a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 18 Sep 2013 23:07:45 +0200 Subject: hydra: Pass the directory name of the Nix checkout. * build-aux/hydra/guix.scm (hydra-jobs): Extract the 'file-name' item from NIX-CHECKOUT, and pass that to 'tarball-package'. --- build-aux/hydra/guix.scm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/build-aux/hydra/guix.scm b/build-aux/hydra/guix.scm index 941d240233..57041d695f 100644 --- a/build-aux/hydra/guix.scm +++ b/build-aux/hydra/guix.scm @@ -98,15 +98,16 @@ containing a Git checkout of Guix." (_ (list (%current-system))))) - (define checkout + (define guix-checkout (assq-ref arguments 'guix)) (define nix-checkout (assq-ref arguments 'nix)) (format (current-error-port) "using checkout ~s (Nix: ~s)~%" - checkout nix-checkout) - (let ((directory (assq-ref checkout 'file-name))) + guix-checkout nix-checkout) + (let ((guix (assq-ref guix-checkout 'file-name)) + (nix (assq-ref nix-checkout 'file-name))) `((tarball . ,(cute package->alist store - (tarball-package directory nix-checkout) + (tarball-package guix nix) (%current-system)))))) -- cgit v1.2.3 From 2cd09108c9b316c9c8aa1c1b87b85a1c32cef089 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Thu, 19 Sep 2013 11:07:39 +0000 Subject: guix package: Add '--list-generations'. * guix/scripts/package.scm: Import (srfi srfi-19). (generation-time, matching-generations): New functions. (show-help): Add '--list-generations'. (%options): Likewise. (guix-package)[process-query]: Add support for '--list-generations'. * guix/ui.scm: Import (srfi srfi-19) and (ice-9 regex). (string->generations, string->duration): New functions. * tests/guix-package.sh: Test '--list-generations'. * tests/ui.scm: Import (srfi srfi-19). Test 'string->generations' and 'string->duration'. * doc/guix.texi (Invoking guix-package): Document '--list-generations'. --- doc/guix.texi | 33 +++++++++++++++ guix/scripts/package.scm | 107 +++++++++++++++++++++++++++++++++++++++++++++++ guix/ui.scm | 68 ++++++++++++++++++++++++++++++ tests/guix-package.sh | 4 ++ tests/ui.scm | 85 +++++++++++++++++++++++++++++++++++++ 5 files changed, 297 insertions(+) diff --git a/doc/guix.texi b/doc/guix.texi index 92c163c608..fdddcc52c3 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -606,6 +606,39 @@ 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. +@item --list-generations[=@var{pattern}] +@itemx -l [@var{pattern}] +Return a list of generations along with their creation dates. + +For each installed package, print the following items, separated by +tabs: the name of a package, its version string, the part of the package +that is installed (@pxref{Packages with Multiple Outputs}), and the +location of this package in the store. + +When @var{pattern} is used, the command returns only matching +generations. Valid patterns include: + +@itemize +@item @emph{Integers and comma-separated integers}. Both patterns denote +generation numbers. For instance, @code{--list-generations=1} returns +the first one. + +And @code{--list-generations=1,8,2} outputs three generations in the +specified order. Neither spaces nor trailing commas are allowed. + +@item @emph{Ranges}. @code{--list-generations=2..9} prints the +specified generations and everything in between. Note that the start of +a range must be lesser than its end. + +It is also possible to omit the endpoint. For example, +@code{--list-generations=2..}, returns all generations starting from the +second one. + +@item @emph{Durations}. You can also get the last @emph{N}@tie{}days, weeks, +or months by passing an integer along with the first letter of the +duration, e.g., @code{--list-generations=20d}. +@end itemize + @item --profile=@var{profile} @itemx -p @var{profile} Use @var{profile} instead of the user's default profile. diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 862b82612a..98b8aedfc9 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -34,6 +34,7 @@ #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) @@ -243,6 +244,74 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (switch-link))) (else (switch-link))))) ; anything else +(define (generation-time profile number) + "Return the creation time of a generation in the UTC format." + (make-time time-utc 0 + (stat:ctime (stat (format #f "~a-~a-link" profile number))))) + +(define* (matching-generations str #:optional (profile %current-profile)) + "Return the list of available generations matching a pattern in STR. See +'string->generations' and 'string->duration' for the list of valid patterns." + (define (valid-generations lst) + (define (valid-generation? n) + (any (cut = n <>) (generation-numbers profile))) + + (fold-right (lambda (x acc) + (if (valid-generation? x) + (cons x acc) + acc)) + '() + lst)) + + (define (filter-generations generations) + (match generations + (() '()) + (('>= n) + (drop-while (cut > n <>) + (generation-numbers profile))) + (('<= n) + (valid-generations (iota n 1))) + ((lst ..1) + (valid-generations lst)) + (_ #f))) + + (define (filter-by-duration duration) + (define (time-at-midnight time) + ;; Return TIME at midnight by setting nanoseconds, seconds, minutes, and + ;; hours to zeros. + (let ((d (time-utc->date time))) + (date->time-utc + (make-date 0 0 0 0 + (date-day d) (date-month d) + (date-year d) (date-zone-offset d))))) + + (define generation-ctime-alist + (map (lambda (number) + (cons number + (time-second + (time-at-midnight + (generation-time profile number))))) + (generation-numbers profile))) + + (match duration + (#f #f) + (res + (let ((s (time-second + (subtract-duration (time-at-midnight (current-time)) + duration)))) + (delete #f (map (lambda (x) + (and (<= s (cdr x)) + (first x))) + generation-ctime-alist)))))) + + (cond ((string->generations str) + => + filter-generations) + ((string->duration str) + => + filter-by-duration) + (else #f))) + (define (find-packages-by-description rx) "Search in SYNOPSIS and DESCRIPTION using RX. Return a list of matching packages." @@ -438,6 +507,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) --roll-back roll back to the previous generation")) (display (_ " --search-paths display needed environment variable definitions")) + (display (_ " + -l, --list-generations[=PATTERN] + list generations matching PATTERN")) (newline) (display (_ " -p, --profile=PROFILE use PROFILE instead of the user's default profile")) @@ -497,6 +569,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (option '("roll-back") #f #f (lambda (opt name arg result) (alist-cons 'roll-back? #t result))) + (option '(#\l "list-generations") #f #t + (lambda (opt name arg result) + (cons `(query list-generations ,(or arg "")) + result))) (option '("search-paths") #f #f (lambda (opt name arg result) (cons `(query search-paths) result))) @@ -876,6 +952,37 @@ more information.~%")) ;; actually processed, #f otherwise. (let ((profile (assoc-ref opts 'profile))) (match (assoc-ref opts 'query) + (('list-generations pattern) + (define (list-generation number) + (begin + (format #t "Generation ~a\t~a~%" number + (date->string + (time-utc->date + (generation-time profile number)) + "~b ~d ~Y ~T")) + (for-each (match-lambda + ((name version output location _) + (format #t " ~a\t~a\t~a\t~a~%" + name version output location))) + (manifest-packages + (profile-manifest + (format #f "~a-~a-link" profile number)))) + (newline))) + + (cond ((not (file-exists? profile)) ; XXX: race condition + (leave (_ "profile '~a' does not exist~%") + profile)) + ((string-null? pattern) + (for-each list-generation + (generation-numbers profile))) + ((matching-generations pattern profile) + => + (cut for-each list-generation <>)) + (else + (leave (_ "invalid syntax: ~a~%") + pattern))) + #t) + (('list-installed regexp) (let* ((regexp (and regexp (make-regexp regexp))) (manifest (profile-manifest profile)) diff --git a/guix/ui.scm b/guix/ui.scm index 293730308e..4415997252 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -28,12 +28,14 @@ #:use-module ((guix licenses) #:select (license? license-name)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) #:autoload (ice-9 ftw) (scandir) #:use-module (ice-9 match) #:use-module (ice-9 format) + #:use-module (ice-9 regex) #:export (_ N_ leave @@ -50,6 +52,8 @@ fill-paragraph string->recutils package->recutils + string->generations + string->duration args-fold* run-guix-command program-name @@ -404,6 +408,70 @@ WIDTH columns." (and=> (package-description p) description->recutils)) (newline port)) +(define (string->generations str) + "Return the list of generations matching a pattern in STR. This function +accepts the following patterns: \"1\", \"1,2,3\", \"1..9\", \"1..\", \"..9\"." + (define (maybe-integer) + (let ((x (string->number str))) + (and (integer? x) + x))) + + (define (maybe-comma-separated-integers) + (let ((lst (delete-duplicates + (map string->number + (string-split str #\,))))) + (and (every integer? lst) + lst))) + + (cond ((maybe-integer) + => + list) + ((maybe-comma-separated-integers) + => + identity) + ((string-match "^([0-9]+)\\.\\.([0-9]+)$" str) + => + (lambda (match) + (let ((s (string->number (match:substring match 1))) + (e (string->number (match:substring match 2)))) + (and (every integer? (list s e)) + (<= s e) + (iota (1+ (- e s)) s))))) + ((string-match "^([0-9]+)\\.\\.$" str) + => + (lambda (match) + (let ((s (string->number (match:substring match 1)))) + (and (integer? s) + `(>= ,s))))) + ((string-match "^\\.\\.([0-9]+)$" str) + => + (lambda (match) + (let ((e (string->number (match:substring match 1)))) + (and (integer? e) + `(<= ,e))))) + (else #f))) + +(define (string->duration str) + "Return the duration matching a pattern in STR. This function accepts the +following patterns: \"1d\", \"1w\", \"1m\"." + (define (hours->duration hours match) + (make-time time-duration 0 + (* 3600 hours (string->number (match:substring match 1))))) + + (cond ((string-match "^([0-9]+)d$" str) + => + (lambda (match) + (hours->duration 24 match))) + ((string-match "^([0-9]+)w$" str) + => + (lambda (match) + (hours->duration (* 24 7) match))) + ((string-match "^([0-9]+)m$" str) + => + (lambda (match) + (hours->duration (* 24 30) match))) + (else #f))) + (define (args-fold* options unrecognized-option-proc operand-proc . seeds) "A wrapper on top of `args-fold' that does proper user-facing error reporting." diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 60b42907a8..b09a9c0173 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -81,6 +81,10 @@ then "name: hello" test "`guix package -s "n0t4r341p4ck4g3"`" = "" + # List generations. + test "`guix package -p "$profile" -l | cut -f1 | grep guile | head -n1`" \ + = " guile-bootstrap" + # Remove a package. guix package --bootstrap -p "$profile" -r "guile-bootstrap" test -L "$profile-3-link" diff --git a/tests/ui.scm b/tests/ui.scm index 0b6f3c5815..3d5c3e7969 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -20,6 +20,7 @@ (define-module (test-ui) #:use-module (guix ui) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-64)) ;; Test the (guix ui) module. @@ -64,6 +65,90 @@ interface, and powerful string processing.") 10) #\newline)) +(test-equal "integer" + '(1) + (string->generations "1")) + +(test-equal "comma-separated integers" + '(3 7 1 4 6) + (string->generations "3,7,1,4,6")) + +(test-equal "closed range" + '(4 5 6 7 8 9 10 11 12) + (string->generations "4..12")) + +(test-equal "closed range, equal endpoints" + '(3) + (string->generations "3..3")) + +(test-equal "indefinite end range" + '(>= 7) + (string->generations "7..")) + +(test-equal "indefinite start range" + '(<= 42) + (string->generations "..42")) + +(test-equal "integer, char" + #f + (string->generations "a")) + +(test-equal "comma-separated integers, consecutive comma" + #f + (string->generations "1,,2")) + +(test-equal "comma-separated integers, trailing comma" + #f + (string->generations "1,2,")) + +(test-equal "comma-separated integers, chars" + #f + (string->generations "a,b")) + +(test-equal "closed range, start > end" + #f + (string->generations "9..2")) + +(test-equal "closed range, chars" + #f + (string->generations "a..b")) + +(test-equal "indefinite end range, char" + #f + (string->generations "a..")) + +(test-equal "indefinite start range, char" + #f + (string->generations "..a")) + +(test-equal "duration, 1 day" + (make-time time-duration 0 (* 3600 24)) + (string->duration "1d")) + +(test-equal "duration, 1 week" + (make-time time-duration 0 (* 3600 24 7)) + (string->duration "1w")) + +(test-equal "duration, 1 month" + (make-time time-duration 0 (* 3600 24 30)) + (string->duration "1m")) + +(test-equal "duration, 1 week == 7 days" + (string->duration "1w") + (string->duration "7d")) + +(test-equal "duration, 1 month == 30 days" + (string->duration "1m") + (string->duration "30d")) + +(test-equal "duration, integer" + #f + (string->duration "1")) + +(test-equal "duration, char" + #f + (string->duration "d")) + (test-end "ui") -- cgit v1.2.3 From f15164e79127a7148fadc98adf6776d37f257044 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 21 Sep 2013 00:09:56 +0200 Subject: gnu: Add GNU dmd. * gnu/packages/system.scm (dmd): New variable. --- gnu/packages/system.scm | 34 +++++++++++++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) diff --git a/gnu/packages/system.scm b/gnu/packages/system.scm index 7c733f9575..9af0365812 100644 --- a/gnu/packages/system.scm +++ b/gnu/packages/system.scm @@ -25,7 +25,39 @@ #:use-module (guix build-system gnu) #:use-module (gnu packages) #:use-module (gnu packages ncurses) - #:use-module (gnu packages linux)) + #:use-module (gnu packages linux) + #:use-module (gnu packages guile) + #:use-module (gnu packages pkg-config)) + +(define-public dmd + (package + (name "dmd") + (version "-0.4") + (source (origin + (method url-fetch) + + ;; XXX: Temporary location until dmd gets back home. + (uri (string-append + "http://www.fdn.fr/~lcourtes/software/guix/dmd-" + version ".tar.gz")) + (sha256 + (base32 + "094ja3xvk9ljghhxmy39if67cfjd1hy6m4svnp399n0wpxvaryvy")))) + (build-system gnu-build-system) + (arguments + '(#:configure-flags '("--localstatedir=/var"))) + (inputs `(("pkg-config" ,pkg-config) + ("guile" ,guile-2.0))) + (synopsis "Daemon managing daemons") + (description "'DMD' is a \"Daemon managing Daemons\" (or +\"Daemons-managing Daemon\"?)---i.e. a service manager that provides a +replacement for the service-managing capabilities of SysV-init (or any other +init) with a both powerful and beautiful dependency-based system with a +convenient interface. It is intended for use on GNU/Hurd, but it is supposed +to work on every POSIX-like system where Guile is available. In particular, +it has been tested on GNU/Linux.") + (license gpl3+) + (home-page "http://www.gnu.org/software/dmd/"))) (define-public dfc (package -- cgit v1.2.3 From 4646e30a7a1588d37814d6c78d27302f80783583 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 21 Sep 2013 01:08:42 +0200 Subject: gnu: QEMU images boots into dmd. * gnu/system/dmd.scm: New file. * gnu/system/vm.scm (system-qemu-image): Define dmd services. [populate]: Make var/log and etc/group. [boot]: Execute dmd directly. Add dmd and etc-group as inputs; add the inputs of dmd services. * gnu-system.am (GNU_SYSTEM_MODULES): Add gnu/system/dmd.scm. --- gnu-system.am | 1 + gnu/system/dmd.scm | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++++ gnu/system/vm.scm | 51 ++++++++++++---------- 3 files changed, 154 insertions(+), 24 deletions(-) create mode 100644 gnu/system/dmd.scm diff --git a/gnu-system.am b/gnu-system.am index 4069301fe7..3809cb7ad3 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -180,6 +180,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/zile.scm \ gnu/packages/zip.scm \ \ + gnu/system/dmd.scm \ gnu/system/grub.scm \ gnu/system/linux.scm \ gnu/system/shadow.scm \ diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm new file mode 100644 index 0000000000..1e8767e357 --- /dev/null +++ b/gnu/system/dmd.scm @@ -0,0 +1,126 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu system dmd) + #:use-module (guix store) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (guix records) + #:use-module ((gnu packages system) + #:select (mingetty inetutils)) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (service? + service + service-provision + service-requirement + service-respawn? + service-start + service-stop + service-inputs + + syslog-service + mingetty-service + dmd-configuration-file)) + +;;; Commentary: +;;; +;;; System services as cajoled by dmd. +;;; +;;; Code: + +(define-record-type* + service make-service + service? + (provision service-provision) ; list of symbols + (requirement service-requirement ; list of symbols + (default '())) + (respawn? service-respawn? ; Boolean + (default #t)) + (start service-start) ; expression + (stop service-stop ; expression + (default #f)) + (inputs service-inputs ; list of inputs + (default '()))) + +(define (mingetty-service store tty) + "Return a service to run mingetty on TTY." + (let* ((mingetty-drv (package-derivation store mingetty)) + (mingetty-bin (string-append (derivation->output-path mingetty-drv) + "/sbin/mingetty"))) + (service + (provision (list (symbol-append 'term- (string->symbol tty)))) + (start `(make-forkexec-constructor ,mingetty-bin "--noclear" ,tty)) + (inputs `(("mingetty" ,mingetty)))))) + +(define (syslog-service store) + "Return a service that runs 'syslogd' with reasonable default settings." + + (define syslog.conf + ;; Snippet adapted from the GNU inetutils manual. + (add-text-to-store store "syslog.conf" " + # Log all kernel messages, authentication messages of + # level notice or higher and anything of level err or + # higher to the console. + # Don't log private authentication messages! + *.err;kern.*;auth.notice;authpriv.none /dev/console + + # Log anything (except mail) of level info or higher. + # Don't log private authentication messages! + *.info;mail.none;authpriv.none /var/log/messages + + # Same, in a different place. + *.info;mail.none;authpriv.none /dev/tty12 + + # The authpriv file has restricted access. + authpriv.* /var/log/secure + + # Log all the mail messages in one place. + mail.* /var/log/maillog +")) + + (let* ((inetutils-drv (package-derivation store inetutils)) + (syslogd (string-append (derivation->output-path inetutils-drv) + "/libexec/syslogd"))) + (service + (provision '(syslogd)) + (start `(make-forkexec-constructor ,syslogd + "--rcfile" ,syslog.conf)) + (inputs `(("inetutils" ,inetutils) + ("syslog.conf" ,syslog.conf)))))) + +(define (dmd-configuration-file store services) + "Return the dmd configuration file for SERVICES." + (define config + `(begin + (register-services + ,@(map (match-lambda + (($ provision requirement respawn? start stop) + `(make + #:provides ',provision + #:requires ',requirement + #:respawn? ,respawn? + #:start ,start + #:stop ,stop))) + services)) + (for-each start ',(append-map service-provision services)))) + + (add-text-to-store store "dmd.conf" + (object->string config))) + +;;; dmd.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 68d205d82a..df55f7c94e 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -38,6 +38,7 @@ #:use-module (gnu system shadow) #:use-module (gnu system linux) #:use-module (gnu system grub) + #:use-module (gnu system dmd) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -359,14 +360,27 @@ It can be used to provide additional files, such as /etc files." (list %pam-other-services (unix-pam-service "login" #:allow-empty-passwords? #t))) + (define %dmd-services + ;; Services run by dmd. + (list (mingetty-service store "tty1") + (mingetty-service store "tty2") + (mingetty-service store "tty3") + (syslog-service store))) + (parameterize ((%guile-for-build (package-derivation store guile-final))) (let* ((bash-drv (package-derivation store bash)) (bash-file (string-append (derivation->output-path bash-drv) "/bin/bash")) + (dmd-drv (package-derivation store dmd)) + (dmd-file (string-append (derivation->output-path dmd-drv) + "/bin/dmd")) + (dmd-conf (dmd-configuration-file store %dmd-services)) (accounts (list (vector "root" "" 0 0 "System administrator" "/" bash-file))) (passwd (passwd-file store accounts)) (shadow (passwd-file store accounts #:shadow? #t)) + (group (add-text-to-store store "group" + "root:x:0:\n")) (pam.d-drv (pam-services->directory store %pam-services)) (pam.d (derivation->output-path pam.d-drv)) (populate @@ -374,8 +388,10 @@ It can be used to provide additional files, such as /etc files." (object->string `(begin (mkdir-p "etc") + (mkdir-p "var/log") ; for dmd (symlink ,shadow "etc/shadow") (symlink ,passwd "etc/passwd") + (symlink ,group "etc/group") (symlink "/dev/null" "etc/login.defs") (symlink ,pam.d "etc/pam.d") @@ -383,28 +399,11 @@ It can be used to provide additional files, such as /etc files." (list passwd))) (out (derivation->output-path (package-derivation store mingetty))) - (getty (string-append out "/sbin/mingetty")) - (iu-drv (package-derivation store inetutils)) - (syslogd (string-append (derivation->output-path iu-drv) - "/libexec/syslogd")) - (boot (add-text-to-store store "boot" - (object->string - `(begin - ;; Become the session leader, - ;; so that mingetty can do - ;; 'TIOCSCTTY'. - (setsid) - - (when (zero? (primitive-fork)) - (format #t "starting syslogd as ~a~%" - (getpid)) - (execl ,syslogd "syslogd")) - - ;; Directly into mingetty. XXX - ;; (execl ,getty "mingetty" - ;; "--noclear" "tty1") - (execl ,bash-file "bash"))) - (list out))) + (boot (add-text-to-store store "boot" + (object->string + `(execl ,dmd-file "dmd" + "--config" ,dmd-conf)) + (list out))) (entries (list (menu-entry (label "Boot-to-Guile! (GNU System technology preview)") (linux linux-libre) @@ -424,11 +423,15 @@ It can be used to provide additional files, such as /etc files." ("bash" ,bash) ("guile" ,guile-2.0) ("mingetty" ,mingetty) - ("inetutils" ,inetutils) + ("dmd" ,dmd) ;; Configuration. + ("dmd.conf" ,dmd-conf) ("etc-pam.d" ,pam.d) ("etc-passwd" ,passwd) - ("etc-shadow" ,shadow)))))) + ("etc-shadow" ,shadow) + ("etc-group" ,group) + ,@(append-map service-inputs + %dmd-services)))))) ;;; vm.scm ends here -- cgit v1.2.3 From ed0cdf837d74a5760608a19e128eb036eea56d9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 21 Sep 2013 01:59:46 +0200 Subject: gnu: python2-pysqlite: Fix 'license'. * gnu/packages/python.scm (python2-pysqlite): Refer to (@ (guix licenses) zlib), not to the same-named package. --- gnu/packages/python.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index be33bf6570..d6d450e22f 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -21,7 +21,7 @@ (define-module (gnu packages python) #:use-module ((guix licenses) #:select (bsd-3 bsd-style psfl x11)) #:use-module ((guix licenses) #:select (zlib) - #:renamer (symbol-prefix-proc 'license)) + #:renamer (symbol-prefix-proc 'license:)) #:use-module (gnu packages) #:use-module (gnu packages compression) #:use-module (gnu packages gdbm) @@ -342,7 +342,7 @@ datetime module, available in Python 2.3+.") (description "Pysqlite provides SQLite bindings for Python that comply to the Database API 2.0T.") - (license zlib))) + (license license:zlib))) (define-public python2-mechanize -- cgit v1.2.3 From 0352532e6a3340411f10ff9ca7475343f7df25fc Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 21 Sep 2013 21:14:19 +0200 Subject: gnu: Add python-simplejson, python2-simplejson. * gnu/packages/python.scm (python-simplejson, python2-simplejson): New variables. --- gnu/packages/python.scm | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index d6d450e22f..1b20029865 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -379,3 +379,34 @@ after Andy Lester’s Perl module WWW::Mechanize.") (license (bsd-style "file://COPYING" "See COPYING in the distribution.")))) + +(define-public python-simplejson + (package + (name "python-simplejson") + (version "3.3.0") + (source + (origin + (method url-fetch) + (uri (string-append "https://pypi.python.org/packages/source/s/simplejson/simplejson-" + version ".tar.gz")) + (sha256 + (base32 + "07wsry5j44l5zzm74l4j2bvasiq8n5m32f31n2p7c68i5vc6p2ks")))) + (build-system python-build-system) + (home-page "http://simplejson.readthedocs.org/en/latest/") + (synopsis + "Json library for Python") + (description + "JSON (JavaScript Object Notation) is a subset of JavaScript syntax +(ECMA-262 3rd edition) used as a lightweight data interchange format. + +Simplejson exposes an API familiar to users of the standard library marshal +and pickle modules. It is the externally maintained version of the json +library contained in Python 2.6, but maintains compatibility with Python 2.5 +and (currently) has significant performance advantages, even without using +the optional C extension for speedups. Simplejson is also supported on +Python 3.3+.") + (license x11))) + +(define-public python2-simplejson + (package-with-python2 python-simplejson)) -- cgit v1.2.3 From 3b627eac48de41b1dc3a1132be961855dd9d0321 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 21 Sep 2013 22:12:20 +0200 Subject: pull: Adjust to 'derivation' API change. Fixes . Reported by Cyrill Schenkel . * guix/scripts/pull.scm (guix-pull): 'unpack' returns a single value. --- guix/scripts/pull.scm | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index f3d87a63c0..a1b5cdc991 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -29,7 +29,6 @@ #:use-module (gnu packages compression) #:use-module (gnu packages gnupg) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) #:export (guix-pull)) @@ -200,13 +199,9 @@ Download and deploy the latest version of Guix.\n")) (if (assoc-ref opts 'verbose?) (current-error-port) (%make-void-port "w")))) - (let*-values (((config-dir) - (config-directory)) - ((source drv) - (unpack store tarball)) - ((source-dir) - (derivation-output-path - (assoc-ref (derivation-outputs drv) "out")))) + (let* ((config-dir (config-directory)) + (source (unpack store tarball)) + (source-dir (derivation->output-path source))) (if (show-what-to-build store (list source)) (if (build-derivations store (list source)) (let ((latest (string-append config-dir "/latest"))) -- cgit v1.2.3 From 35aee909f714061105a50b697e167ae17366eb34 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 21 Sep 2013 22:12:49 +0200 Subject: Thank Cyrill. --- THANKS | 1 + 1 file changed, 1 insertion(+) diff --git a/THANKS b/THANKS index c19fd2e8a7..68576f7ea0 100644 --- a/THANKS +++ b/THANKS @@ -17,6 +17,7 @@ infrastructure help: Matthew Lien Yutaka Niibe Alex Sassmannshausen + Cyrill Schenkel Jason Self Alen Skondro Matthias Wachs -- cgit v1.2.3 From 4d497632ce56287cc56cfb73abad7e562129b43e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 21 Sep 2013 22:32:20 +0200 Subject: guix package: Internationalize "Generation" string. * guix/scripts/package.scm (guix-package): Internationalize generation listing. --- guix/scripts/package.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 98b8aedfc9..dcc2bc74aa 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -955,7 +955,7 @@ more information.~%")) (('list-generations pattern) (define (list-generation number) (begin - (format #t "Generation ~a\t~a~%" number + (format #t (_ "Generation ~a\t~a~%") number (date->string (time-utc->date (generation-time profile number)) -- cgit v1.2.3 From 99882c613ca29d0020f507b76cc6da955dd70afa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 21 Sep 2013 22:35:14 +0200 Subject: guix package: Sort the list of generation numbers in '--list-generations'. * guix/scripts/package.scm (generation-numbers): Sort the result. --- guix/scripts/package.scm | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index dcc2bc74aa..c0cedcd4a8 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -97,7 +97,7 @@ "-([0-9]+)"))) (define (generation-numbers profile) - "Return the list of generation numbers of PROFILE, or '(0) if no + "Return the sorted list of generation numbers of PROFILE, or '(0) if no former profiles were found." (define* (scandir name #:optional (select? (const #t)) (entrynumber - (cut match:substring <> 1) - (cute regexp-exec (profile-regexp profile) <>)) - profiles)))) + (sort (map (compose string->number + (cut match:substring <> 1) + (cute regexp-exec (profile-regexp profile) <>)) + profiles) + <)))) (define (previous-generation-number profile number) "Return the number of the generation before generation NUMBER of -- cgit v1.2.3 From 421a80a2b22e3d29c7491dd3540cb938ffb1c6b0 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 22 Sep 2013 09:44:49 +0200 Subject: gnu: Add python2-pyicu. * gnu/packages/python.scm (python2-pyicu): New variable. --- gnu/packages/python.scm | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 1b20029865..d64ed1a131 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -25,6 +25,7 @@ #:use-module (gnu packages) #:use-module (gnu packages compression) #:use-module (gnu packages gdbm) + #:use-module (gnu packages icu4c) #:use-module (gnu packages readline) #:use-module (gnu packages openssl) #:use-module (gnu packages patchelf) @@ -410,3 +411,30 @@ Python 3.3+.") (define-public python2-simplejson (package-with-python2 python-simplejson)) + + +(define-public python2-pyicu + (package + (name "python2-pyicu") + (version "1.5") + (source + (origin + (method url-fetch) + (uri (string-append "https://pypi.python.org/packages/source/P/PyICU/PyICU-" + version ".tar.gz")) + (sha256 + (base32 + "011vwflpir8wvh48mvi6d9a7vw0f43bkwv0w6bzxbzmvz20ax5vm")))) + (build-system python-build-system) + (inputs + `(("icu4c" ,icu4c))) + (arguments + `(#:python ,python-2 ; Python 3 works also, but needs special care for + ; linking with libpython3.3m + #:tests? #f)) ; no check target + (home-page "http://pyicu.osafoundation.org/") + (synopsis + "Python extension wrapping the ICU C++ API.") + (description + "PyICU is a python extension wrapping the ICU C++ API.") + (license x11))) -- cgit v1.2.3 From 93be8dc4c93dec03b68fcbb8a8955f9b4b562ba6 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 22 Sep 2013 11:16:08 +0200 Subject: gnu: xcursor-themes: Install data into package output directory. * gnu/packages/xorg.scm (xcursor-themes): Install icons into output directory instead of libxcursor. --- gnu/packages/xorg.scm | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm index 9a0e3e274b..0659c8d10c 100644 --- a/gnu/packages/xorg.scm +++ b/gnu/packages/xorg.scm @@ -1929,6 +1929,11 @@ tracking.") `(("libxcursor" ,libxcursor) ("pkg-config" ,pkg-config) ("xcursorgen" ,xcursorgen))) + (arguments + `(#:configure-flags + (list (string-append "--with-cursordir=" + (assoc-ref %outputs "out") + "/share/icons")))) (home-page "http://www.x.org/wiki/") (synopsis "xorg implementation of the X Window System") (description "X.org provides an implementation of the X Window System") -- cgit v1.2.3 From 22885fb845c67cc48a426a989e2a45de18a8e888 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 22 Sep 2013 16:22:00 +0200 Subject: gnu: Add gstreamer. * gnu/packages/gstreamer.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add module. --- gnu-system.am | 1 + gnu/packages/gstreamer.scm | 65 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 66 insertions(+) create mode 100644 gnu/packages/gstreamer.scm diff --git a/gnu-system.am b/gnu-system.am index 3809cb7ad3..01df377c90 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -79,6 +79,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/grub.scm \ gnu/packages/grue-hunter.scm \ gnu/packages/gsasl.scm \ + gnu/packages/gstreamer.scm \ gnu/packages/gtk.scm \ gnu/packages/guile.scm \ gnu/packages/gv.scm \ diff --git a/gnu/packages/gstreamer.scm b/gnu/packages/gstreamer.scm new file mode 100644 index 0000000000..01448563a9 --- /dev/null +++ b/gnu/packages/gstreamer.scm @@ -0,0 +1,65 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Andreas Enge +;;; +;;; 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 . + +(define-module (gnu packages gstreamer) + #:use-module ((guix licenses) #:select (lgpl2.0+)) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages bison) + #:use-module (gnu packages flex) + #:use-module (gnu packages glib) + #:use-module (gnu packages perl) + #:use-module (gnu packages pkg-config) + #:use-module (gnu packages python)) + +(define-public gstreamer + (package + (name "gstreamer") + (version "1.0.10") + (source + (origin + (method url-fetch) + (uri (string-append "http://gstreamer.freedesktop.org/src/gstreamer/gstreamer-" + version ".tar.xz")) + (sha256 + (base32 + "0c0irk85jd2cihm5pmf4zxhlpg08qpxjcqv1l9qn2n3h2gsaj2lf")))) + (build-system gnu-build-system) + (inputs + `(("bison" ,bison) + ("flex" ,flex) + ("glib" ,glib) + ("perl" ,perl) + ("pkg-config" ,pkg-config) + ("python" ,python))) + (home-page "http://gstreamer.freedesktop.org/") + (synopsis + "Multimedia library") + (description + "GStreamer is a library for constructing graphs of media-handling +components. The applications it supports range from simple Ogg/Vorbis +playback, audio/video streaming to complex audio (mixing) and video +(non-linear editing) processing. + +Applications can take advantage of advances in codec and filter technology +transparently. Developers can add new codecs and filters by writing a +simple plugin with a clean, generic interface. + +This package provides the core library and elements.") + (license lgpl2.0+))) -- cgit v1.2.3 From 144f9f251dd596897b9f8e1710c5dc7a21c92404 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 22 Sep 2013 16:41:29 +0200 Subject: gnu: gstreamer: Depend on python-wrapper. * gnu/packages/gstreamer.scm (gstreamer): Replace input python by python-wrapper. --- gnu/packages/gstreamer.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/gstreamer.scm b/gnu/packages/gstreamer.scm index 01448563a9..085061fe90 100644 --- a/gnu/packages/gstreamer.scm +++ b/gnu/packages/gstreamer.scm @@ -47,7 +47,7 @@ ("glib" ,glib) ("perl" ,perl) ("pkg-config" ,pkg-config) - ("python" ,python))) + ("python-wrapper" ,python-wrapper))) (home-page "http://gstreamer.freedesktop.org/") (synopsis "Multimedia library") -- cgit v1.2.3 From 477c91ce736b28b39a9a46a310f905b78dd45dfb Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 22 Sep 2013 17:25:12 +0200 Subject: gnu: Add gst-plugins-base. * gnu/packages/gstreamer.scm (gst-plugins-base): New variable. --- gnu/packages/gstreamer.scm | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/gnu/packages/gstreamer.scm b/gnu/packages/gstreamer.scm index 085061fe90..7478dc3188 100644 --- a/gnu/packages/gstreamer.scm +++ b/gnu/packages/gstreamer.scm @@ -63,3 +63,47 @@ simple plugin with a clean, generic interface. This package provides the core library and elements.") (license lgpl2.0+))) + +(define-public gst-plugins-base + (package + (name "gst-plugins-base") + (version "1.0.10") + (source + (origin + (method url-fetch) + (uri (string-append "http://gstreamer.freedesktop.org/src/gst-plugins-base/gst-plugins-base-" + version ".tar.xz")) + (sha256 + (base32 + "1s4pphbb5kpdh4rrmb8rala4sp499k4by59925k15xiz58xyhm4p")))) + (build-system gnu-build-system) + ;; FIXME: Add more dependencies for further plugins. + (inputs + `(("glib" ,glib) + ("gstreamer" ,gstreamer) + ("pkg-config" ,pkg-config) + ("python-wrapper" ,python-wrapper))) + (arguments + `(#:tests? #f)) + ;; All tests pass except for one: + ;; Running suite(s): pbutils library + ;; 85%: Checks: 7, Failures: 1, Errors: 0 + ;; libs/pbutils.c:522:F:general:test_pb_utils_install_plugins:0: gst_install_plugins_sync() failed ;; with unexpected ret 201, which is neither HELPER_MISSING nor 1 + ;; FAIL: libs/pbutils + ;; According to the documentation, "gst_install_plugins_sync (...) + ;; should almost never be used". + (home-page "http://gstreamer.freedesktop.org/") + (synopsis + "Plugins for the gstreamer multimedia library") + (description + "GStreamer is a library for constructing graphs of media-handling +components. The applications it supports range from simple Ogg/Vorbis +playback, audio/video streaming to complex audio (mixing) and video +(non-linear editing) processing. + +Applications can take advantage of advances in codec and filter technology +transparently. Developers can add new codecs and filters by writing a +simple plugin with a clean, generic interface. + +This package provides an essential exemplary set of elements.") + (license lgpl2.0+))) -- cgit v1.2.3 From 995b726131259f8480772ee8469ef69a42f608cd Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 22 Sep 2013 17:53:01 +0200 Subject: gnu: Add gnome-doc-utils. * gnu/packages/gnome.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add module. --- gnu-system.am | 1 + gnu/packages/gnome.scm | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+) create mode 100644 gnu/packages/gnome.scm diff --git a/gnu-system.am b/gnu-system.am index 01df377c90..a5c17f6f42 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -69,6 +69,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/gkrellm.scm \ gnu/packages/glib.scm \ gnu/packages/global.scm \ + gnu/packages/gnome.scm \ gnu/packages/gnunet.scm \ gnu/packages/gnupg.scm \ gnu/packages/gnutls.scm \ diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm new file mode 100644 index 0000000000..c66af51c98 --- /dev/null +++ b/gnu/packages/gnome.scm @@ -0,0 +1,57 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Andreas Enge +;;; +;;; 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 . + +(define-module (gnu packages gnome) + #:use-module ((guix licenses) #:select (gpl2+)) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages glib) + #:use-module (gnu packages pkg-config) + #:use-module (gnu packages python) + #:use-module (gnu packages xml)) + +(define-public gnome-doc-utils + (package + (name "gnome-doc-utils") + (version "0.20.10") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/0.20/" + name "-" version ".tar.xz")) + (sha256 + (base32 + "19n4x25ndzngaciiyd8dd6s2mf9gv6nv3wv27ggns2smm7zkj1nb")))) + (build-system gnu-build-system) + (inputs + `(("intltool" ,intltool) + ("libxml2" ,libxml2) + ("libxslt" ,libxslt) + ("pkg-config" ,pkg-config) + ("python-2" ,python-2))) + (arguments + `(#:tests? #f)) ; tries to load http://www.oasis-open.org/docbook/xml/4.4/docbookx.dtd + (home-page "https://wiki.gnome.org/GnomeDocUtils") + (synopsis + "Documentation utilities for the Gnome project") + (description + "Gnome-doc-utils is a collection of documentation utilities for the +Gnome project. It includes xml2po tool which makes it easier to translate +and keep up to date translations of documentation.") + (license gpl2+))) ; xslt under lgpl -- cgit v1.2.3 From 1fdd3ee2a680d3a7fd2e76d49e2f0120b888a72a Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 22 Sep 2013 21:01:40 +0200 Subject: gnu: Rename module mailutils to mail. * gnu/packages/mail.scm: Rename from gnu/packages/mailutils.scm. * gnu-system.am: Rename the module. --- gnu-system.am | 2 +- gnu/packages/mail.scm | 106 +++++++++++++++++++++++++++++++++++++++++++++ gnu/packages/mailutils.scm | 106 --------------------------------------------- 3 files changed, 107 insertions(+), 107 deletions(-) create mode 100644 gnu/packages/mail.scm delete mode 100644 gnu/packages/mailutils.scm diff --git a/gnu-system.am b/gnu-system.am index a5c17f6f42..a7fbb27252 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -115,7 +115,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/lua.scm \ gnu/packages/lvm.scm \ gnu/packages/m4.scm \ - gnu/packages/mailutils.scm \ + gnu/packages/mail.scm \ gnu/packages/make-bootstrap.scm \ gnu/packages/maths.scm \ gnu/packages/mit-krb5.scm \ diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm new file mode 100644 index 0000000000..a6507c3b71 --- /dev/null +++ b/gnu/packages/mail.scm @@ -0,0 +1,106 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu packages mail) + #:use-module (gnu packages) + #:use-module (gnu packages linux) + #:use-module (gnu packages gnutls) + #:use-module (gnu packages gdbm) + #:use-module (gnu packages guile) + #:use-module (gnu packages ncurses) + #:use-module (gnu packages readline) + #:use-module (gnu packages dejagnu) + #:use-module (gnu packages m4) + #:use-module (gnu packages texinfo) + #:use-module (gnu packages mysql) + #:use-module (gnu packages autotools) + #:use-module (guix licenses) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu)) + +(define-public mailutils + (package + (name "mailutils") + (version "2.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnu/mailutils/mailutils-" + version ".tar.bz2")) + (sha256 + (base32 + "0szbqa12zqzldqyw97lxqax3ja2adis83i7brdfsxmrfw68iaf65")))) + (build-system gnu-build-system) + (arguments + '(;; TODO: Add `--with-sql'. + #:patches (list (assoc-ref %build-inputs + "patch/gets-undeclared")) + #:phases (alist-cons-before + 'build 'pre-build + (lambda _ + ;; Use Guile 2.0's public API. + (substitute* "libmu_scm/mu_message.c" + (("scm_i_string_length") + "scm_c_string_length")) + + ;; This file should be generated to use the right + ;; value of $(libdir) et al. + (delete-file "libmu_scm/mailutils.scm") + + ;; Use the right file name for `cat'. + (substitute* "testsuite/lib/mailutils.exp" + (("/bin/cat") + (which "cat")))) + %standard-phases) + #:parallel-tests? #f)) + (inputs + `(("dejagnu" ,dejagnu) + ("m4" ,m4) + ("texinfo" ,texinfo) + ("guile" ,guile-2.0) + ("gnutls" ,gnutls) + ("ncurses" ,ncurses) + ("readline" ,readline) + ("linux-pam" ,linux-pam) + ("libtool" ,libtool) + ("gdbm" ,gdbm) + ("patch/gets-undeclared" + ,(search-patch "m4-gets-undeclared.patch")))) + (home-page "http://www.gnu.org/software/mailutils/") + (synopsis "Utilities and library for reading and serving mail") + (description + "GNU Mailutils is a rich and powerful protocol-independent mail +framework. It contains a series of useful mail libraries, clients, and +servers. These are the primary mail utilities for the GNU system. The +central library is capable of handling electronic mail in various +mailbox formats and protocols, both local and remote. Specifically, +this project contains a POP3 server, an IMAP4 server, and a Sieve mail +filter. It also provides a POSIX `mailx' client, and a collection of +other handy tools. + +The GNU Mailutils libraries supply an ample set of primitives for +handling electronic mail in programs written in C, C++, Python or +Scheme. + +The utilities provided by Mailutils include imap4d and pop3d mail +servers, mail reporting utility comsatd, general-purpose mail delivery +agent maidag, mail filtering program sieve, and an implementation of MH +message handling system.") + (license + ;; Libraries are under LGPLv3+, and programs under GPLv3+. + (list gpl3+ lgpl3+)))) diff --git a/gnu/packages/mailutils.scm b/gnu/packages/mailutils.scm deleted file mode 100644 index 15ca939e66..0000000000 --- a/gnu/packages/mailutils.scm +++ /dev/null @@ -1,106 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès -;;; -;;; 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 . - -(define-module (gnu packages mailutils) - #:use-module (gnu packages) - #:use-module (gnu packages linux) - #:use-module (gnu packages gnutls) - #:use-module (gnu packages gdbm) - #:use-module (gnu packages guile) - #:use-module (gnu packages ncurses) - #:use-module (gnu packages readline) - #:use-module (gnu packages dejagnu) - #:use-module (gnu packages m4) - #:use-module (gnu packages texinfo) - #:use-module (gnu packages mysql) - #:use-module (gnu packages autotools) - #:use-module (guix licenses) - #:use-module (guix packages) - #:use-module (guix download) - #:use-module (guix build-system gnu)) - -(define-public mailutils - (package - (name "mailutils") - (version "2.2") - (source (origin - (method url-fetch) - (uri (string-append "mirror://gnu/mailutils/mailutils-" - version ".tar.bz2")) - (sha256 - (base32 - "0szbqa12zqzldqyw97lxqax3ja2adis83i7brdfsxmrfw68iaf65")))) - (build-system gnu-build-system) - (arguments - '(;; TODO: Add `--with-sql'. - #:patches (list (assoc-ref %build-inputs - "patch/gets-undeclared")) - #:phases (alist-cons-before - 'build 'pre-build - (lambda _ - ;; Use Guile 2.0's public API. - (substitute* "libmu_scm/mu_message.c" - (("scm_i_string_length") - "scm_c_string_length")) - - ;; This file should be generated to use the right - ;; value of $(libdir) et al. - (delete-file "libmu_scm/mailutils.scm") - - ;; Use the right file name for `cat'. - (substitute* "testsuite/lib/mailutils.exp" - (("/bin/cat") - (which "cat")))) - %standard-phases) - #:parallel-tests? #f)) - (inputs - `(("dejagnu" ,dejagnu) - ("m4" ,m4) - ("texinfo" ,texinfo) - ("guile" ,guile-2.0) - ("gnutls" ,gnutls) - ("ncurses" ,ncurses) - ("readline" ,readline) - ("linux-pam" ,linux-pam) - ("libtool" ,libtool) - ("gdbm" ,gdbm) - ("patch/gets-undeclared" - ,(search-patch "m4-gets-undeclared.patch")))) - (home-page "http://www.gnu.org/software/mailutils/") - (synopsis "Utilities and library for reading and serving mail") - (description - "GNU Mailutils is a rich and powerful protocol-independent mail -framework. It contains a series of useful mail libraries, clients, and -servers. These are the primary mail utilities for the GNU system. The -central library is capable of handling electronic mail in various -mailbox formats and protocols, both local and remote. Specifically, -this project contains a POP3 server, an IMAP4 server, and a Sieve mail -filter. It also provides a POSIX `mailx' client, and a collection of -other handy tools. - -The GNU Mailutils libraries supply an ample set of primitives for -handling electronic mail in programs written in C, C++, Python or -Scheme. - -The utilities provided by Mailutils include imap4d and pop3d mail -servers, mail reporting utility comsatd, general-purpose mail delivery -agent maidag, mail filtering program sieve, and an implementation of MH -message handling system.") - (license - ;; Libraries are under LGPLv3+, and programs under GPLv3+. - (list gpl3+ lgpl3+)))) -- cgit v1.2.3 From d983a14f81379eacd51a35239760fe4e36ef1517 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 22 Sep 2013 21:56:36 +0200 Subject: gnu: Add fetchmail. * gnu/packages/mail.scm (fetchmail): New variable. --- gnu/packages/mail.scm | 49 ++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 42 insertions(+), 7 deletions(-) diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index a6507c3b71..e411aecf85 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -18,18 +18,20 @@ (define-module (gnu packages mail) #:use-module (gnu packages) - #:use-module (gnu packages linux) - #:use-module (gnu packages gnutls) + #:use-module (gnu packages autotools) + #:use-module (gnu packages dejagnu) #:use-module (gnu packages gdbm) + #:use-module (gnu packages gnutls) #:use-module (gnu packages guile) + #:use-module (gnu packages linux) + #:use-module (gnu packages m4) + #:use-module (gnu packages mysql) #:use-module (gnu packages ncurses) + #:use-module (gnu packages openssl) #:use-module (gnu packages readline) - #:use-module (gnu packages dejagnu) - #:use-module (gnu packages m4) #:use-module (gnu packages texinfo) - #:use-module (gnu packages mysql) - #:use-module (gnu packages autotools) - #:use-module (guix licenses) + #:use-module ((guix licenses) + #:select (gpl2+ gpl3+ lgpl3+)) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu)) @@ -104,3 +106,36 @@ message handling system.") (license ;; Libraries are under LGPLv3+, and programs under GPLv3+. (list gpl3+ lgpl3+)))) + +(define-public fetchmail + (package + (name "fetchmail") + (version "6.3.26") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/fetchmail/branch_6.3/fetchmail-" + version ".tar.xz")) + (sha256 + (base32 + "0l78ayvi9dm8hd190gl139cs2xqsrf7r9ncilslw20mgvd6cbd3r")))) + (build-system gnu-build-system) + (inputs + `(("openssl" ,openssl))) + (arguments + `(#:configure-flags (list (string-append "--with-ssl=" + (assoc-ref %build-inputs "openssl"))))) + (home-page "http://fetchmail.berlios.de/") + (synopsis "Remote-mailr etrieval and forwarding utility") + (description + "Fetchmail is a full-featured, robust, well-documented remote-mail +retrieval and forwarding utility intended to be used over on-demand +TCP/IP links (such as SLIP or PPP connections). It supports every +remote-mail protocol now in use on the Internet: POP2, POP3, RPOP, APOP, +KPOP, all flavors of IMAP, ETRN, and ODMR. It can even support IPv6 +and IPSEC. + +Fetchmail retrieves mail from remote mail servers and forwards it via SMTP, +so it can then be read by normal mail user agents such as mutt, elm +or BSD Mail. It allows all your system MTA's filtering, forwarding, and +aliasing facilities to work just as they would on normal mail.") + (license gpl2+))) ; most files are actually public domain or x11 -- cgit v1.2.3 From 13f04f48d0f5b4338ef5d4aa27b892bb0f28c7c2 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 22 Sep 2013 22:30:18 +0200 Subject: gnu: Add mutt. * gnu/packages/mail.scm (mutt): New variable. --- gnu/packages/mail.scm | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index e411aecf85..b8ddcd71e1 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -28,6 +28,7 @@ #:use-module (gnu packages mysql) #:use-module (gnu packages ncurses) #:use-module (gnu packages openssl) + #:use-module (gnu packages perl) #:use-module (gnu packages readline) #:use-module (gnu packages texinfo) #:use-module ((guix licenses) @@ -139,3 +140,34 @@ so it can then be read by normal mail user agents such as mutt, elm or BSD Mail. It allows all your system MTA's filtering, forwarding, and aliasing facilities to work just as they would on normal mail.") (license gpl2+))) ; most files are actually public domain or x11 + +(define-public mutt + (package + (name "mutt") + (version "1.5.21") + (source (origin + (method url-fetch) + (uri (string-append "ftp://ftp.mutt.org/mutt/devel/mutt-" + version ".tar.gz")) + (sha256 + (base32 + "1864cwz240gh0zy56fb47qqzwyf6ghg01037rb4p2kqgimpg6h91")))) + (build-system gnu-build-system) + (inputs + `(("ncurses" ,ncurses) + ("openssl" ,openssl) + ("perl" ,perl))) + (arguments + `(#:configure-flags '("--enable-smtp" + "--enable-imap" + "--enable-pop" + "--with-ssl" + ;; so that mutt does not check whether the path + ;; exists, which it does not in the chroot + "--with-mailpath=/var/mail"))) + (home-page "http://www.mutt.org/") + (synopsis "Mail client") + (description + "Mutt is a small but very powerful text-based mail client for Unix +operating systems.") + (license gpl2+))) -- cgit v1.2.3 From 996ed6acd5586f9db08a9388442acdd044285fe4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 22 Sep 2013 16:40:18 +0200 Subject: build: Build the daemon with -Wall. * daemon.am (AM_CXXFLAGS): New variable. --- daemon.am | 2 ++ 1 file changed, 2 insertions(+) diff --git a/daemon.am b/daemon.am index 069700b1b6..8c21dbc328 100644 --- a/daemon.am +++ b/daemon.am @@ -25,6 +25,8 @@ CLEANFILES += $(BUILT_SOURCES) noinst_LIBRARIES = libformat.a libutil.a libstore.a +AM_CXXFLAGS = -Wall + libformat_a_SOURCES = \ nix/boost/format/free_funcs.cc \ nix/boost/format/parsing.cc \ -- cgit v1.2.3 From a7a4e6a4f719da8d0b26d9a60ff8ed42691d263f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 22 Sep 2013 23:23:38 +0200 Subject: Add 'guix-register'. * nix/guix-register/guix-register.cc, tests/guix-register.sh: New files. * Makefile.am (SH_TESTS)[BUILD_DAEMON]: Add tests/guix-register.sh. * daemon.am (sbin_PROGRAMS, guix_register_SOURCES, guix_register_CPPFLAGS, guix_register_LDADD): New variables. * test-env.in: Export 'storedir', 'prefix', 'datarootdir', 'datadir', and 'localstatedir'. --- .gitignore | 1 + Makefile.am | 7 ++ daemon.am | 16 ++++ nix/guix-register/guix-register.cc | 168 +++++++++++++++++++++++++++++++++++++ test-env.in | 7 ++ tests/guix-register.sh | 74 ++++++++++++++++ 6 files changed, 273 insertions(+) create mode 100644 nix/guix-register/guix-register.cc create mode 100644 tests/guix-register.sh diff --git a/.gitignore b/.gitignore index f97a3b5f3d..78b16800bf 100644 --- a/.gitignore +++ b/.gitignore @@ -76,3 +76,4 @@ stamp-h[0-9] /nix/scripts/substitute-binary /doc/images/bootstrap-graph.png /doc/images/bootstrap-graph.eps +/guix-register diff --git a/Makefile.am b/Makefile.am index bf9c1d0e91..7dc79e26e4 100644 --- a/Makefile.am +++ b/Makefile.am @@ -117,6 +117,13 @@ SH_TESTS = \ tests/guix-hash.sh \ tests/guix-package.sh +if BUILD_DAEMON + +SH_TESTS += tests/guix-register.sh + +endif BUILD_DAEMON + + TESTS = $(SCM_TESTS) $(SH_TESTS) TEST_EXTENSIONS = .scm .sh diff --git a/daemon.am b/daemon.am index 8c21dbc328..77bfe71987 100644 --- a/daemon.am +++ b/daemon.am @@ -121,6 +121,7 @@ libstore_a_CXXFLAGS = \ $(SQLITE3_CFLAGS) $(LIBGCRYPT_CFLAGS) bin_PROGRAMS = guix-daemon +sbin_PROGRAMS = guix-register guix_daemon_SOURCES = \ nix/nix-daemon/nix-daemon.cc \ @@ -137,6 +138,21 @@ guix_daemon_LDADD = \ guix_daemon_headers = \ nix/nix-daemon/shared.hh + +guix_register_SOURCES = \ + nix/guix-register/guix-register.cc + +guix_register_CPPFLAGS = \ + $(libutil_a_CPPFLAGS) \ + $(libstore_a_CPPFLAGS) \ + -I$(top_srcdir)/nix/libstore + +# XXX: Should we start using shared libs? +guix_register_LDADD = \ + libstore.a libutil.a libformat.a -lbz2 \ + $(SQLITE3_LIBS) $(LIBGCRYPT_LIBS) + + libexec_PROGRAMS = nix-setuid-helper nix_setuid_helper_SOURCES = \ nix/nix-setuid-helper/nix-setuid-helper.cc diff --git a/nix/guix-register/guix-register.cc b/nix/guix-register/guix-register.cc new file mode 100644 index 0000000000..0a028f0cfe --- /dev/null +++ b/nix/guix-register/guix-register.cc @@ -0,0 +1,168 @@ +/* GNU Guix --- Functional package management for GNU + Copyright (C) 2013 Ludovic Courtès + Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, + 2013 Eelco Dolstra + + 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 . */ + +/* This file derives from the implementation of 'nix-store + --register-validity', by Eelco Dolstra, as found in the Nix package + manager's src/nix-store/nix-store.cc. */ + +#include + +#include +#include + +#include +#include +#include +#include + +#include + +using namespace nix; + +/* Input stream where we read closure descriptions. */ +static std::istream *input = &std::cin; + + + +/* Command-line options. */ + +const char *argp_program_version = + "guix-register (" PACKAGE_NAME ") " PACKAGE_VERSION; +const char *argp_program_bug_address = PACKAGE_BUGREPORT; + +static char doc[] = +"guix-register -- register a closure as valid in a store\ +\v\ +This program is used internally when populating a store with data \ +from an existing store. It updates the new store's database with \ +information about which store files are valid, and what their \ +references are."; + +static const struct argp_option options[] = + { + { "prefix", 'p', "DIRECTORY", 0, + "Open the store that lies under DIRECTORY" }, + { 0, 0, 0, 0, 0 } + }; + +/* Parse a single option. */ +static error_t +parse_opt (int key, char *arg, struct argp_state *state) +{ + switch (key) + { + case 'p': + { + string prefix = canonPath (arg); + settings.nixStore = prefix + NIX_STORE_DIR; + settings.nixDataDir = prefix + NIX_DATA_DIR; + settings.nixLogDir = prefix + NIX_LOG_DIR; + settings.nixStateDir = prefix + NIX_STATE_DIR; + settings.nixDBPath = settings.nixStateDir + "/db"; + break; + } + + case ARGP_KEY_ARG: + { + std::ifstream *file; + + if (state->arg_num >= 2) + /* Too many arguments. */ + argp_usage (state); + + file = new std::ifstream (); + file->open (arg); + + input = file; + } + break; + + default: + return (error_t) ARGP_ERR_UNKNOWN; + } + + return (error_t) 0; +} + +/* Argument parsing. */ +static struct argp argp = { options, parse_opt, 0, doc }; + + +/* Read from INPUT the description of a closure, and register it as valid in + STORE. The expected format on INPUT is that used by #:references-graphs: + + FILE + DERIVER + NUMBER-OF-REFERENCES + REF1 + ... + REFN + + This is really meant as an internal format. */ +static void +register_validity (LocalStore *store, std::istream &input, + bool reregister = true, bool hashGiven = false, + bool canonicalise = true) +{ + ValidPathInfos infos; + + while (1) + { + ValidPathInfo info = decodeValidPathInfo (input, hashGiven); + if (info.path == "") + break; + if (!store->isValidPath (info.path) || reregister) + { + /* !!! races */ + if (canonicalise) + canonicalisePathMetaData (info.path, -1); + + if (!hashGiven) + { + HashResult hash = hashPath (htSHA256, info.path); + info.hash = hash.first; + info.narSize = hash.second; + } + infos.push_back (info); + } + } + + store->registerValidPaths (infos); +} + + +int +main (int argc, char *argv[]) +{ + try + { + argp_parse (&argp, argc, argv, 0, 0, 0); + + LocalStore store; + register_validity (&store, *input); + } + catch (std::exception &e) + { + fprintf (stderr, "error: %s\n", e.what ()); + return EXIT_FAILURE; + } + + return EXIT_SUCCESS; +} diff --git a/test-env.in b/test-env.in index e6b13c271e..ed31f88141 100644 --- a/test-env.in +++ b/test-env.in @@ -69,5 +69,12 @@ then trap "kill $daemon_pid ; rm -rf $NIX_STATE_DIR" EXIT fi +storedir="@storedir@" +prefix="@prefix@" +datarootdir="@datarootdir@" +datadir="@datadir@" +localstatedir="@localstatedir@" +export storedir prefix datarootdir datadir localstatedir + "@abs_top_builddir@/pre-inst-env" "$@" exit $? diff --git a/tests/guix-register.sh b/tests/guix-register.sh new file mode 100644 index 0000000000..b76a1af54f --- /dev/null +++ b/tests/guix-register.sh @@ -0,0 +1,74 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2013 Ludovic Courtès +# +# 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 . + +# +# Test the 'guix-register' command-line utility. +# + +guix-register --version + +new_store="t-register-$$" +closure="t-register-closure-$$" +rm -rf "$new_store" + +exit_hook=":" +trap "chmod -R +w $new_store ; rm -rf $new_store $closure ; \$exit_hook" EXIT + +mkdir -p "$new_store/$storedir" +new_store_dir="`cd "$new_store/$storedir" ; pwd`" +new_store="`cd "$new_store" ; pwd`" + +to_copy="`guix build guile-bootstrap`" +cp -r "$to_copy" "$new_store_dir" +copied="$new_store_dir/`basename $to_copy`" + +# Create a file representing a closure with zero references, and with an empty +# "deriver" field. +cat >> "$closure" < Date: Sun, 22 Sep 2013 21:50:11 +0200 Subject: guix package: Show most recently installed packages last. Suggested by Andreas Enge . * guix/scripts/package.scm (guix-package)[list-generations, list-installed]: Reverse the result of 'manifest-packages'. * doc/guix.texi (Invoking guix package): Document the order of packages for '--list-generations' and '--list-installed'. --- doc/guix.texi | 10 ++++++---- guix/scripts/package.scm | 13 +++++++++---- 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index fdddcc52c3..9eb67ecd01 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -608,7 +608,9 @@ suggest setting these variables to @code{@var{profile}/include} and @item --list-generations[=@var{pattern}] @itemx -l [@var{pattern}] -Return a list of generations along with their creation dates. +Return a list of generations along with their creation dates; for each +generation, show the installed packages, with the most recently +installed packages shown last. For each installed package, print the following items, separated by tabs: the name of a package, its version string, the part of the package @@ -692,9 +694,9 @@ version: 7.2alpha6 @item --list-installed[=@var{regexp}] @itemx -I [@var{regexp}] -List currently installed packages in the specified profile. When -@var{regexp} is specified, list only installed packages whose name -matches @var{regexp}. +List the currently installed packages in the specified profile, with the +most recently installed packages shown last. When @var{regexp} is +specified, list only installed packages whose name matches @var{regexp}. For each installed package, print the following items, separated by tabs: the package name, its version string, the part of the package that diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index c0cedcd4a8..1d00e39540 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -965,9 +965,12 @@ more information.~%")) ((name version output location _) (format #t " ~a\t~a\t~a\t~a~%" name version output location))) - (manifest-packages - (profile-manifest - (format #f "~a-~a-link" profile number)))) + + ;; Show most recently installed packages last. + (reverse + (manifest-packages + (profile-manifest + (format #f "~a-~a-link" profile number))))) (newline))) (cond ((not (file-exists? profile)) ; XXX: race condition @@ -994,7 +997,9 @@ more information.~%")) (regexp-exec regexp name)) (format #t "~a\t~a\t~a\t~a~%" name (or version "?") output path)))) - installed) + + ;; Show most recently installed packages last. + (reverse installed)) #t)) (('list-available regexp) -- cgit v1.2.3 From f566d765a1494e6c1194a5d7c84f4f16ae8fb81b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 22 Sep 2013 22:03:15 +0200 Subject: doc: Document '--list-generations' among the query options. * doc/guix.texi (Invoking guix package): Move '--list-generations' below "In addition to these actions". --- doc/guix.texi | 70 +++++++++++++++++++++++++++++------------------------------ 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 9eb67ecd01..90016a4496 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -606,41 +606,6 @@ 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. -@item --list-generations[=@var{pattern}] -@itemx -l [@var{pattern}] -Return a list of generations along with their creation dates; for each -generation, show the installed packages, with the most recently -installed packages shown last. - -For each installed package, print the following items, separated by -tabs: the name of a package, its version string, the part of the package -that is installed (@pxref{Packages with Multiple Outputs}), and the -location of this package in the store. - -When @var{pattern} is used, the command returns only matching -generations. Valid patterns include: - -@itemize -@item @emph{Integers and comma-separated integers}. Both patterns denote -generation numbers. For instance, @code{--list-generations=1} returns -the first one. - -And @code{--list-generations=1,8,2} outputs three generations in the -specified order. Neither spaces nor trailing commas are allowed. - -@item @emph{Ranges}. @code{--list-generations=2..9} prints the -specified generations and everything in between. Note that the start of -a range must be lesser than its end. - -It is also possible to omit the endpoint. For example, -@code{--list-generations=2..}, returns all generations starting from the -second one. - -@item @emph{Durations}. You can also get the last @emph{N}@tie{}days, weeks, -or months by passing an integer along with the first letter of the -duration, e.g., @code{--list-generations=20d}. -@end itemize - @item --profile=@var{profile} @itemx -p @var{profile} Use @var{profile} instead of the user's default profile. @@ -714,6 +679,41 @@ For each package, print the following items separated by tabs: its name, its version string, the parts of the package (@pxref{Packages with Multiple Outputs}), and the source location of its definition. +@item --list-generations[=@var{pattern}] +@itemx -l [@var{pattern}] +Return a list of generations along with their creation dates; for each +generation, show the installed packages, with the most recently +installed packages shown last. + +For each installed package, print the following items, separated by +tabs: the name of a package, its version string, the part of the package +that is installed (@pxref{Packages with Multiple Outputs}), and the +location of this package in the store. + +When @var{pattern} is used, the command returns only matching +generations. Valid patterns include: + +@itemize +@item @emph{Integers and comma-separated integers}. Both patterns denote +generation numbers. For instance, @code{--list-generations=1} returns +the first one. + +And @code{--list-generations=1,8,2} outputs three generations in the +specified order. Neither spaces nor trailing commas are allowed. + +@item @emph{Ranges}. @code{--list-generations=2..9} prints the +specified generations and everything in between. Note that the start of +a range must be lesser than its end. + +It is also possible to omit the endpoint. For example, +@code{--list-generations=2..}, returns all generations starting from the +second one. + +@item @emph{Durations}. You can also get the last @emph{N}@tie{}days, weeks, +or months by passing an integer along with the first letter of the +duration, e.g., @code{--list-generations=20d}. +@end itemize + @end table @node Packages with Multiple Outputs -- cgit v1.2.3 From 48e488eb2c2870088369d2dd69012abaa2376083 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 22 Sep 2013 22:13:51 +0200 Subject: nar: Fix file descriptor leak when writing a Nar. * guix/nar.scm (write-contents)[call-with-binary-input-file]: Always close PORT. --- guix/nar.scm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/guix/nar.scm b/guix/nar.scm index 29b57dc989..ea119a25fe 100644 --- a/guix/nar.scm +++ b/guix/nar.scm @@ -76,10 +76,11 @@ ;; avoid stat'ing like crazy. (with-fluids ((%file-port-name-canonicalization #f)) (let ((port (open-file file "rb"))) - (catch #t (cut proc port) - (lambda args - (close-port port) - (apply throw args)))))) + (dynamic-wind + (const #t) + (cut proc port) + (lambda () + (close-port port)))))) (write-string "contents" p) (write-long-long size p) -- cgit v1.2.3 From f59e9eaac87b4365c646a475d44b431e43949649 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 22 Sep 2013 22:14:46 +0200 Subject: build: check-available-binaries: Adjust to derivation API change. * build-aux/check-available-binaries.scm: Use 'derivation->output-path' instead of 'derivation-path->output-path'. --- build-aux/check-available-binaries.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build-aux/check-available-binaries.scm b/build-aux/check-available-binaries.scm index 8fd64fe2cb..92810795e1 100644 --- a/build-aux/check-available-binaries.scm +++ b/build-aux/check-available-binaries.scm @@ -49,7 +49,7 @@ #f)))) (let ((result (every (compose (warn (cut has-substitutes? store <>)) - derivation-path->output-path) + derivation->output-path) total))) (when result (format (current-error-port) "~a packages found substitutable~%" -- cgit v1.2.3