From 3e9066fcfc1fb249eeeb2708d98ae258a38c5b2b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 26 Aug 2013 16:04:15 +0200 Subject: gnu: Add Guile-Lib. * gnu/packages/guile.scm (guile-lib): New variable. --- gnu/packages/guile.scm | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) (limited to 'gnu') diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index 7d97adbe99..c580e0c324 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -298,4 +298,38 @@ flexibility in specifying when jobs should be run. Mcron was written by Dale Mellor.") (license gpl3+))) +(define-public guile-lib + (package + (name "guile-lib") + (version "0.2.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://savannah/guile-lib/guile-lib-" + version ".tar.gz")) + (sha256 + (base32 + "1f9n2b5b5r75lzjinyk6zp6g20g60msa0jpfrk5hhg4j8cy0ih4b")))) + (build-system gnu-build-system) + (arguments + '(#:phases (alist-cons-before + 'configure 'patch-module-dir + (lambda _ + (substitute* "src/Makefile.in" + (("^moddir[[:blank:]]*=[[:blank:]]*([[:graph:]]+)" _ rhs) + (string-append "moddir = " rhs "/2.0\n")))) + %standard-phases))) + (inputs `(("guile" ,guile-2.0))) + (home-page "http://www.nongnu.org/guile-lib/") + (synopsis "Collection of useful Guile Scheme modules") + (description + "guile-lib is intended as an accumulation place for pure-scheme Guile +modules, allowing for people to cooperate integrating their generic Guile +modules into a coherent library. Think \"a down-scaled, limited-scope CPAN +for Guile\".") + + ;; The whole is under GPLv3+, but some modules are under laxer + ;; distribution terms such as LGPL and public domain. See `COPYING' for + ;; details. + (license gpl3+))) + ;;; guile.scm ends here -- cgit v1.2.3 From a987d2c02525efd1bf37b4bb5b5df405a06bd15c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 26 Aug 2013 22:11:04 +0200 Subject: derivations: Move 3 positional parameters into keyword parameters. * guix/derivations.scm (derivation): Turn `system', `env-vars', and `inputs' into keyword parameters. (build-expression->derivation): Adjust accordingly. * gnu/packages/bootstrap.scm (%bootstrap-guile): Likewise. * tests/derivations.scm, tests/store.scm: Likewise. * doc/guix.texi (Derivations): Likewise. --- doc/guix.texi | 6 +-- gnu/packages/bootstrap.scm | 7 +-- guix/derivations.scm | 36 ++++++++------ tests/derivations.scm | 115 +++++++++++++++++++++------------------------ tests/store.scm | 13 ++--- 5 files changed, 89 insertions(+), 88 deletions(-) (limited to 'gnu') diff --git a/doc/guix.texi b/doc/guix.texi index 57b6412939..c82d5f7480 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1113,7 +1113,7 @@ derivations as Scheme objects, along with procedures to create and 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{system} @var{builder} @var{args} @var{env-vars} @var{inputs} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] [#:hash-mode #f] +@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)] Build a derivation with the given arguments. Return the resulting store path and @code{} object. @@ -1137,9 +1137,9 @@ to a Bash executable in the store: (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" (%current-system) + (derivation store "foo" bash `("-e" ,builder) - '(("HOME" . "/homeless")) '()))) + #:env-vars '(("HOME" . "/homeless"))))) list) @result{} ("/nix/store/@dots{}-foo.drv" #< @dots{}>) @end lisp diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm index 86723a9591..a1d4c7fc67 100644 --- a/gnu/packages/bootstrap.scm +++ b/gnu/packages/bootstrap.scm @@ -184,9 +184,10 @@ cd $out $out/bin/guile --version~%" mkdir xz guile tar) (list mkdir xz guile tar)))) - (derivation store name system - bash `(,builder) '() - `((,bash) (,builder))))))))) + (derivation store name + bash `(,builder) + #:system system + #:inputs `((,bash) (,builder))))))))) (package (name "guile-bootstrap") (version "2.0") diff --git a/guix/derivations.scm b/guix/derivations.scm index 8ddef117d4..3d7a30aaa8 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -497,8 +497,11 @@ the derivation called NAME with hash HASH." name (string-append name "-" output)))) -(define* (derivation store name system builder args env-vars inputs - #:key (outputs '("out")) hash hash-algo hash-mode) +(define* (derivation store name builder args + #:key + (system (%current-system)) (env-vars '()) + (inputs '()) (outputs '("out")) + hash hash-algo hash-mode) "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 @@ -747,8 +750,8 @@ omitted or is #f, the value of the `%guile-for-build' fluid is used instead." (define module-form? (match-lambda - (((or 'define-module 'use-modules) _ ...) #t) - (_ #f))) + (((or 'define-module 'use-modules) _ ...) #t) + (_ #f))) (define source-path ;; When passed an input that is a source, return its path; otherwise @@ -833,22 +836,25 @@ omitted or is #f, the value of the `%guile-for-build' fluid is used instead." #:system system))) (go-dir (and go-drv (derivation-path->output-path go-drv)))) - (derivation store name system guile + (derivation store name guile `("--no-auto-compile" ,@(if mod-dir `("-L" ,mod-dir) '()) ,builder) + #:system system + + #:inputs `((,(or guile-for-build (%guile-for-build))) + (,builder) + ,@(map cdr inputs) + ,@(if mod-drv `((,mod-drv) (,go-drv)) '())) + ;; When MODULES is non-empty, shamelessly clobber ;; $GUILE_LOAD_COMPILED_PATH. - (if go-dir - `(("GUILE_LOAD_COMPILED_PATH" . ,go-dir) - ,@(alist-delete "GUILE_LOAD_COMPILED_PATH" - env-vars)) - env-vars) - - `((,(or guile-for-build (%guile-for-build))) - (,builder) - ,@(map cdr inputs) - ,@(if mod-drv `((,mod-drv) (,go-drv)) '())) + #:env-vars (if go-dir + `(("GUILE_LOAD_COMPILED_PATH" . ,go-dir) + ,@(alist-delete "GUILE_LOAD_COMPILED_PATH" + env-vars)) + env-vars) + #:hash hash #:hash-algo hash-algo #:outputs outputs))) diff --git a/tests/derivations.scm b/tests/derivations.scm index 788cffd7ad..9833e15112 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -106,9 +106,9 @@ (let* ((builder (add-text-to-store %store "my-builder.sh" "echo hello, world\n" '())) - (drv-path (derivation %store "foo" (%current-system) + (drv-path (derivation %store "foo" %bash `("-e" ,builder) - '(("HOME" . "/homeless")) '()))) + #:env-vars '(("HOME" . "/homeless"))))) (and (store-path? drv-path) (valid-path? %store drv-path)))) @@ -118,12 +118,12 @@ "echo hello, world > \"$out\"\n" '())) ((drv-path drv) - (derivation %store "foo" (%current-system) + (derivation %store "foo" %bash `(,builder) - '(("HOME" . "/homeless") - ("zzz" . "Z!") - ("AAA" . "A!")) - `((,builder)))) + #:env-vars '(("HOME" . "/homeless") + ("zzz" . "Z!") + ("AAA" . "A!")) + #:inputs `((,builder)))) ((succeeded?) (build-derivations %store (list drv-path)))) (and succeeded? @@ -139,18 +139,17 @@ "(while read line ; do echo \"$line\" ; done) < $in > $out" '())) (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" - (%current-system) %bash `(,builder) - `(("in" - ;; Cheat to pass the actual file - ;; name to the builder. - . ,(add-to-store %store - (basename input) - #t "sha256" - input))) - `((,builder) - (,input))))) ; ← local file name + + ;; Cheat to pass the actual file name to the + ;; builder. + #:env-vars `(("in" . ,input*)) + + #:inputs `((,builder) + (,input))))) ; ← local file name (and (build-derivations %store (list drv-path)) ;; Note: we can't compare the files because the above trick alters ;; the contents. @@ -160,10 +159,9 @@ (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" (%current-system) + (drv-path (derivation %store "fixed" %bash `(,builder) - '() - `((,builder)) ; optional + #:inputs `((,builder)) ; optional #:hash hash #:hash-algo 'sha256)) (succeeded? (build-derivations %store (list drv-path)))) (and succeeded? @@ -178,13 +176,11 @@ (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" (%current-system) + (drv-path1 (derivation %store "fixed" %bash `(,builder1) - '() `() #:hash hash #:hash-algo 'sha256)) - (drv-path2 (derivation %store "fixed" (%current-system) + (drv-path2 (derivation %store "fixed" %bash `(,builder2) - '() `() #:hash hash #:hash-algo 'sha256)) (succeeded? (build-derivations %store (list drv-path1 drv-path2)))) @@ -201,27 +197,25 @@ (builder2 (add-text-to-store %store "fixed-builder2.sh" "echo hey; echo -n hello > $out" '())) (hash (sha256 (string->utf8 "hello"))) - (fixed1 (derivation %store "fixed" (%current-system) + (fixed1 (derivation %store "fixed" %bash `(,builder1) - '() `() #:hash hash #:hash-algo 'sha256)) - (fixed2 (derivation %store "fixed" (%current-system) + (fixed2 (derivation %store "fixed" %bash `(,builder2) - '() `() #:hash hash #:hash-algo 'sha256)) (fixed-out (derivation-path->output-path fixed1)) (builder3 (add-text-to-store %store "final-builder.sh" ;; Use Bash hackery to avoid Coreutils. "echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '())) - (final1 (derivation %store "final" (%current-system) + (final1 (derivation %store "final" %bash `(,builder3) - `(("in" . ,fixed-out)) - `((,builder3) (,fixed1)))) - (final2 (derivation %store "final" (%current-system) + #:env-vars `(("in" . ,fixed-out)) + #:inputs `((,builder3) (,fixed1)))) + (final2 (derivation %store "final" %bash `(,builder3) - `(("in" . ,fixed-out)) - `((,builder3) (,fixed2)))) + #:env-vars `(("in" . ,fixed-out)) + #:inputs `((,builder3) (,fixed2)))) (succeeded? (build-derivations %store (list final1 final2)))) (and succeeded? @@ -232,12 +226,12 @@ (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo one > $out ; echo two > $second" '())) - (drv-path (derivation %store "fixed" (%current-system) + (drv-path (derivation %store "fixed" %bash `(,builder) - '(("HOME" . "/homeless") - ("zzz" . "Z!") - ("AAA" . "A!")) - `((,builder)) + #:env-vars '(("HOME" . "/homeless") + ("zzz" . "Z!") + ("AAA" . "A!")) + #:inputs `((,builder)) #:outputs '("out" "second"))) (succeeded? (build-derivations %store (list drv-path)))) (and succeeded? @@ -255,10 +249,9 @@ (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo one > $out ; echo two > $AAA" '())) - (drv-path (derivation %store "fixed" (%current-system) + (drv-path (derivation %store "fixed" %bash `(,builder) - '() - `((,builder)) + #:inputs `((,builder)) #:outputs '("out" "AAA"))) (succeeded? (build-derivations %store (list drv-path)))) (and succeeded? @@ -273,10 +266,9 @@ (let* ((builder1 (add-text-to-store %store "my-mo-builder.sh" "echo one > $out ; echo two > $two" '())) - (mdrv (derivation %store "multiple-output" (%current-system) + (mdrv (derivation %store "multiple-output" %bash `(,builder1) - '() - `((,builder1)) + #:inputs `((,builder1)) #:outputs '("out" "two"))) (builder2 (add-text-to-store %store "my-mo-user-builder.sh" "read x < $one; @@ -284,16 +276,17 @@ echo \"($x $y)\" > $out" '())) (udrv (derivation %store "multiple-output-user" - (%current-system) %bash `(,builder2) - `(("one" . ,(derivation-path->output-path - mdrv "out")) - ("two" . ,(derivation-path->output-path - mdrv "two"))) - `((,builder2) - ;; two occurrences of MDRV: - (,mdrv) - (,mdrv "two"))))) + #:env-vars `(("one" + . ,(derivation-path->output-path + mdrv "out")) + ("two" + . ,(derivation-path->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))) (and (valid-path? %store p) @@ -314,14 +307,14 @@ "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good" '())) (drv-path - (derivation %store "foo" (%current-system) + (derivation %store "foo" %bash `(,builder) - `(("PATH" . - ,(string-append - (derivation-path->output-path %coreutils) - "/bin"))) - `((,builder) - (,%coreutils)))) + #:env-vars `(("PATH" . + ,(string-append + (derivation-path->output-path %coreutils) + "/bin"))) + #:inputs `((,builder) + (,%coreutils)))) (succeeded? (build-derivations %store (list drv-path)))) (and succeeded? diff --git a/tests/store.scm b/tests/store.scm index 3d5d59b991..9625a6b308 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -80,9 +80,9 @@ ;; (b (add-text-to-store %store "link-builder" ;; (format #f "echo ~a > $out" p1) ;; '())) -;; (d1 (derivation %store "link" (%current-system) -;; "/bin/sh" `("-e" ,b) '() -;; `((,b) (,p1)))) +;; (d1 (derivation %store "link" +;; "/bin/sh" `("-e" ,b) +;; #:inputs `((,b) (,p1)))) ;; (p2 (derivation-path->output-path d1))) ;; (and (add-temp-root %store p2) ;; (build-derivations %store (list d1)) @@ -130,9 +130,10 @@ (s (add-to-store %store "bash" #t "sha256" (search-bootstrap-binary "bash" (%current-system)))) - (d (derivation %store "the-thing" (%current-system) - s `("-e" ,b) `(("foo" . ,(random-text))) - `((,b) (,s)))) + (d (derivation %store "the-thing" + s `("-e" ,b) + #:env-vars `(("foo" . ,(random-text))) + #:inputs `((,b) (,s)))) (o (derivation-path->output-path d))) (and (build-derivations %store (list d)) (equal? (query-derivation-outputs %store d) -- cgit v1.2.3 From af807dea7f6382bbfa0db31f856529b23c29a43e Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Tue, 27 Aug 2013 10:49:43 +0200 Subject: gnu: Update python to 2.7.5. * gnu/packages/python.scm (python): Update to 2.7.5. --- gnu/packages/python.scm | 49 ++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 46 insertions(+), 3 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index c9893d9385..35d5b51e06 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013 Andreas Enge ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,7 +34,7 @@ (define-public python (package (name "python") - (version "2.7.4") + (version "2.7.5") (source (origin (method url-fetch) @@ -41,10 +42,52 @@ version "/Python-" version ".tar.xz")) (sha256 (base32 - "0bdn4dylm92n2dsvqvjfyask9jbz88aan5hi4lgkawkxs2v6wqmn")))) + "1c8xan2dlsqfq8q82r3mhl72v3knq3qyn71fjq89xikx2smlqg7k")))) (build-system gnu-build-system) (arguments - `(#:tests? #f ; XXX: some tests fail + `(#:tests? #f +;; 258 tests OK. +;; 103 tests failed: +;; test_bz2 test_distutils test_file test_file2k test_popen2 +;; test_shutil test_signal test_site test_slice test_smtplib +;; test_smtpnet test_socket test_socketserver test_softspace +;; test_sort test_sqlite test_ssl test_startfile test_str +;; test_strftime test_string test_stringprep test_strop test_strptime +;; test_strtod test_struct test_structmembers test_structseq +;; test_subprocess test_sunaudiodev test_sundry test_symtable +;; test_syntax test_sys test_sys_setprofile test_sys_settrace +;; test_sysconfig test_tarfile test_tcl test_telnetlib test_tempfile +;; test_textwrap test_thread test_threaded_import +;; test_threadedtempfile test_threading test_threading_local +;; test_threadsignals test_time test_timeout test_tk test_tokenize +;; test_tools test_trace test_traceback test_transformer +;; test_ttk_guionly test_ttk_textonly test_tuple test_typechecks +;; test_ucn test_unary test_undocumented_details test_unicode +;; test_unicode_file test_unicodedata test_univnewlines +;; test_univnewlines2k test_unpack test_urllib test_urllib2 +;; test_urllib2_localnet test_urllib2net test_urllibnet test_urlparse +;; test_userdict test_userlist test_userstring test_uu test_uuid +;; test_wait3 test_wait4 test_warnings test_wave test_weakref +;; test_weakset test_whichdb test_winreg test_winsound test_with +;; test_wsgiref test_xdrlib test_xml_etree test_xml_etree_c +;; test_xmllib test_xmlrpc test_xpickle test_xrange test_zipfile +;; test_zipfile64 test_zipimport test_zipimport_support test_zlib +;; 31 tests skipped: +;; test_aepack test_al test_applesingle test_ascii_formatd test_bsddb +;; test_bsddb185 test_bsddb3 test_cd test_cl test_codecmaps_cn +;; test_codecmaps_hk test_codecmaps_jp test_codecmaps_kr +;; test_codecmaps_tw test_ctypes test_curses test_dl test_gdb test_gl +;; test_imageop test_imgfile test_ioctl test_kqueue +;; test_linuxaudiodev test_macos test_macostools test_msilib +;; test_multiprocessing test_ossaudiodev test_pep277 +;; test_scriptpackages +;; 7 skips unexpected on linux2: +;; test_ascii_formatd test_bsddb test_bsddb3 test_ctypes test_gdb +;; test_ioctl test_multiprocessing +;; One of the typical errors: +;; test_unicode +;; test test_unicode crashed -- : [Errno 2] No such file or directory + #:test-target "test" #:configure-flags (let ((bz2 (assoc-ref %build-inputs "bzip2")) (gdbm (assoc-ref %build-inputs "gdbm")) -- cgit v1.2.3 From 2455085a1e845297584683405878a49f44c17567 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 27 Aug 2013 19:04:14 +0200 Subject: vm: Use more keyword parameters for `expression->derivation-in-linux-vm'. * gnu/system/vm.scm (expression->derivation-in-linux-vm): Turn `system' and `inputs' into keyword parameters. (qemu-image, example1): Adjust accordingly. --- gnu/system/vm.scm | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) (limited to 'gnu') diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index bc5677963d..fedf0ee322 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -40,8 +40,10 @@ ;;; ;;; Code: -(define* (expression->derivation-in-linux-vm store name system exp inputs +(define* (expression->derivation-in-linux-vm store name exp #:key + (system (%current-system)) + (inputs '()) (linux linux-libre) (initrd qemu-initrd) (qemu qemu/smb-shares) @@ -150,7 +152,7 @@ DISK-IMAGE-SIZE bytes and return it." (inputs '())) "Return a bootable, stand-alone QEMU image." (expression->derivation-in-linux-vm - store "qemu-image" system + store "qemu-image" `(let ((parted (string-append (assoc-ref %build-inputs "parted") "/sbin/parted")) (mkfs (string-append (assoc-ref %build-inputs "e2fsprogs") @@ -212,19 +214,20 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { (zero? (system* umount "/fs")) (reboot))))))) - `(("parted" ,parted) - ("grub" ,grub) - ("e2fsprogs" ,e2fsprogs) - ("linux" ,linux-libre) - ("initrd" ,qemu-initrd) + #:system system + #:inputs `(("parted" ,parted) + ("grub" ,grub) + ("e2fsprogs" ,e2fsprogs) + ("linux" ,linux-libre) + ("initrd" ,qemu-initrd) - ;; For shell scripts. - ("sed" ,(car (assoc-ref %final-inputs "sed"))) - ("grep" ,(car (assoc-ref %final-inputs "grep"))) - ("coreutils" ,(car (assoc-ref %final-inputs "coreutils"))) - ("findutils" ,(car (assoc-ref %final-inputs "findutils"))) - ("gawk" ,(car (assoc-ref %final-inputs "gawk"))) - ("util-linux" ,util-linux)) + ;; For shell scripts. + ("sed" ,(car (assoc-ref %final-inputs "sed"))) + ("grep" ,(car (assoc-ref %final-inputs "grep"))) + ("coreutils" ,(car (assoc-ref %final-inputs "coreutils"))) + ("findutils" ,(car (assoc-ref %final-inputs "findutils"))) + ("gawk" ,(car (assoc-ref %final-inputs "gawk"))) + ("util-linux" ,util-linux)) #:make-disk-image? #t #:disk-image-size disk-image-size)) @@ -241,13 +244,12 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { (lambda () (parameterize ((%guile-for-build (package-derivation store guile-final))) (expression->derivation-in-linux-vm - store "vm-test" (%current-system) + store "vm-test" '(begin (display "hello from boot!\n") (call-with-output-file "/xchg/hello" (lambda (p) - (display "world" p)))) - '()))) + (display "world" p))))))) (lambda () (close-connection store))))) -- cgit v1.2.3 From f02b5474f1ff93ffeb72e7aa7c7ee6e6b6b6b163 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 28 Aug 2013 23:33:24 +0200 Subject: gnu: imagemagick: Update to 6.8.6-9. * gnu/packages/imagemagick.scm (imagemagick): Update to 6.8.6-9. --- gnu/packages/imagemagick.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/imagemagick.scm b/gnu/packages/imagemagick.scm index e408b13fa3..98cd51fee3 100644 --- a/gnu/packages/imagemagick.scm +++ b/gnu/packages/imagemagick.scm @@ -37,14 +37,14 @@ (define-public imagemagick (package (name "imagemagick") - (version "6.8.6-0") + (version "6.8.6-9") (source (origin (method url-fetch) (uri (string-append "mirror://imagemagick/ImageMagick-" version ".tar.xz")) (sha256 (base32 - "1qmwpnq2mcxjnp0rjyb2g7v87lhmll19imx3iys6kplh8amrmqnv")))) + "1bpj8676mph5cvyjsdgf27i6yg2iw9iskk5c69mvpxkyawgjw1vg")))) (build-system gnu-build-system) (arguments `(#:phases (alist-cons-before -- cgit v1.2.3 From f989fa392f1786720cf18e75cc085e4f0f8d76d9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 28 Aug 2013 23:59:14 +0200 Subject: gnu: linux-initrd: Allow Guile modules to be embedded in the initrd. * gnu/packages/linux-initrd.scm (raw-build-system): New macro. (module-package, compiled-module-package): New procedures. (expression->initrd): Add `modules' keyword parameter. Add "modules" and "modules/compiled" inputs; copy them onto the initrd. * guix/derivations.scm (imported-modules, compiled-modules): Publicize. --- gnu/packages/linux-initrd.scm | 102 ++++++++++++++++++++++++++++++++++-------- guix/derivations.scm | 2 + 2 files changed, 85 insertions(+), 19 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm index 348e411d07..db54699ac1 100644 --- a/gnu/packages/linux-initrd.scm +++ b/gnu/packages/linux-initrd.scm @@ -19,10 +19,14 @@ (define-module (gnu packages linux-initrd) #:use-module (guix utils) #:use-module (guix licenses) + #:use-module (guix build-system) + #:use-module ((guix derivations) + #:select (imported-modules compiled-modules %guile-for-build)) #:use-module (gnu packages) #:use-module (gnu packages cpio) #:use-module (gnu packages compression) #:use-module (gnu packages linux) + #:use-module (gnu packages guile) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) #:use-module (guix packages) @@ -38,6 +42,49 @@ ;;; Code: +(define-syntax-rule (raw-build-system (store system name inputs) body ...) + "Lift BODY to a package build system." + ;; TODO: Generalize. + (build-system + (name "raw") + (description "Raw build system") + (build (lambda* (store name source inputs #:key system #:allow-other-keys) + (parameterize ((%guile-for-build (package-derivation store + guile-2.0))) + body ...))))) + +(define (module-package modules) + "Return a package that contains all of MODULES, a list of Guile module +names." + (package + (name "guile-modules") + (version "0") + (source #f) + (build-system (raw-build-system (store system name inputs) + (imported-modules store modules + #:name name + #:system system))) + (synopsis "Set of Guile modules") + (description synopsis) + (license gpl3+) + (home-page "http://www.gnu.org/software/guix/"))) + +(define (compiled-module-package modules) + "Return a package that contains the .go files corresponding to MODULES, a +list of Guile module names." + (package + (name "guile-compiled-modules") + (version "0") + (source #f) + (build-system (raw-build-system (store system name inputs) + (compiled-modules store modules + #:name name + #:system system))) + (synopsis "Set of compiled Guile modules") + (description synopsis) + (license gpl3+) + (home-page "http://www.gnu.org/software/guix/"))) + (define* (expression->initrd exp #:key (guile %guile-static-stripped) @@ -45,12 +92,13 @@ (gzip gzip) (name "guile-initrd") (system (%current-system)) + (modules '()) (linux #f) (linux-modules '())) "Return a package that contains a Linux initrd (a gzipped cpio archive) containing GUILE and that evaluates EXP upon booting. LINUX-MODULES is a list -of `.ko' file names to be copied from LINUX into the initrd." - ;; TODO: Add a `modules' parameter. +of `.ko' file names to be copied from LINUX into the initrd. MODULES is a +list of Guile module names to be embedded in the initrd." ;; General Linux overview in `Documentation/early-userspace/README' and ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'. @@ -67,12 +115,22 @@ of `.ko' file names to be copied from LINUX into the initrd." (rnrs bytevectors) ((system foreign) #:select (sizeof))) - (let ((guile (assoc-ref %build-inputs "guile")) - (cpio (string-append (assoc-ref %build-inputs "cpio") - "/bin/cpio")) - (gzip (string-append (assoc-ref %build-inputs "gzip") - "/bin/gzip")) - (out (assoc-ref %outputs "out"))) + (let ((guile (assoc-ref %build-inputs "guile")) + (cpio (string-append (assoc-ref %build-inputs "cpio") + "/bin/cpio")) + (gzip (string-append (assoc-ref %build-inputs "gzip") + "/bin/gzip")) + (modules (assoc-ref %build-inputs "modules")) + (gos (assoc-ref %build-inputs "modules/compiled")) + (scm-dir (string-append "share/guile/" (effective-version))) + (go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a" + (effective-version) + (if (eq? (native-endianness) (endianness little)) + "LE" + "BE") + (sizeof '*) + (effective-version))) + (out (assoc-ref %outputs "out"))) (mkdir out) (mkdir "contents") (with-directory-excursion "contents" @@ -84,19 +142,23 @@ of `.ko' file names to be copied from LINUX into the initrd." (chmod "init" #o555) (chmod "bin/guile" #o555) + ;; Copy Guile modules. + (chmod scm-dir #o777) + (copy-recursively modules scm-dir + #:follow-symlinks? #t) + (copy-recursively gos (string-append "lib/guile/" + (effective-version) "/ccache") + #:follow-symlinks? #t) + ;; Compile `init'. - (let ((go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a" - (effective-version) - (if (eq? (native-endianness) (endianness little)) - "LE" - "BE") - (sizeof '*) - (effective-version)))) - (mkdir-p go-dir) - (compile-file "init" - #:opts %auto-compilation-options - #:output-file (string-append go-dir "/init.go"))) + (mkdir-p go-dir) + (set! %load-path (cons modules %load-path)) + (set! %load-compiled-path (cons gos %load-compiled-path)) + (compile-file "init" + #:opts %auto-compilation-options + #:output-file (string-append go-dir "/init.go")) + ;; Copy Linux modules. (let* ((linux (assoc-ref %build-inputs "linux")) (module-dir (and linux (string-append linux "/lib/modules")))) @@ -161,6 +223,8 @@ of `.ko' file names to be copied from LINUX into the initrd." (inputs `(("guile" ,guile) ("cpio" ,cpio) ("gzip" ,gzip) + ("modules" ,(module-package modules)) + ("modules/compiled" ,(compiled-module-package modules)) ,@(if linux `(("linux" ,linux)) '()))) diff --git a/guix/derivations.scm b/guix/derivations.scm index 59a3957149..c05644add2 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -61,6 +61,8 @@ derivation %guile-for-build + imported-modules + compiled-modules build-expression->derivation imported-files)) -- cgit v1.2.3 From e47185a4a7214f1a6fb6d7e2d799f9734ccb49f0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 28 Aug 2013 22:43:01 +0200 Subject: gnu: make-bootstrap: Remove the `debug' output from the static Coreutils. * gnu/packages/make-bootstrap.scm (%static-inputs)[coreutils]: Add `outputs' field. --- gnu/packages/make-bootstrap.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'gnu') diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm index 6f33c07e58..ce270bd5c1 100644 --- a/gnu/packages/make-bootstrap.scm +++ b/gnu/packages/make-bootstrap.scm @@ -127,7 +127,10 @@ for `sh' in $PATH, and without nscd, and with static NSS modules." ;; cross-compiling). (inputs (match (assoc "perl" (package-inputs coreutils)) (#f '()) - (x (list x)))))) + (x (list x)))) + + ;; Remove the `debug' output. + (outputs '("out")))) (bzip2 (package (inherit bzip2) (arguments (substitute-keyword-arguments (package-arguments bzip2) -- cgit v1.2.3 From 88840f02469de4686d5d67f44baa47e436602e27 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 29 Aug 2013 00:04:04 +0200 Subject: gnu: linux-initrd: Add (guix build linux-initrd) and use it. * gnu/packages/linux-initrd.scm (qemu-initrd): Add #:modules argument. Factorize and move some of the code to... * guix/build/linux-initrd.scm: ... here. New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 1 + gnu/packages/linux-initrd.scm | 75 ++++++++--------------------- guix/build/linux-initrd.scm | 107 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 127 insertions(+), 56 deletions(-) create mode 100644 guix/build/linux-initrd.scm (limited to 'gnu') diff --git a/Makefile.am b/Makefile.am index ebe0f2559c..1d68e6516a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -61,6 +61,7 @@ MODULES = \ guix/build/cmake-build-system.scm \ guix/build/gnu-build-system.scm \ guix/build/gnu-dist.scm \ + guix/build/linux-initrd.scm \ guix/build/perl-build-system.scm \ guix/build/python-build-system.scm \ guix/build/utils.scm \ diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm index db54699ac1..2ed52e60f0 100644 --- a/gnu/packages/linux-initrd.scm +++ b/gnu/packages/linux-initrd.scm @@ -238,26 +238,17 @@ the Linux kernel.") (define-public qemu-initrd (expression->initrd '(begin - (use-modules (rnrs io ports) - (srfi srfi-1) + (use-modules (srfi srfi-1) (srfi srfi-26) (ice-9 match) - ((system foreign) #:select (string->pointer)) - ((system base compile) #:select (compile-file))) + ((system base compile) #:select (compile-file)) + (guix build linux-initrd)) - (display "Welcome, this is GNU/Guile!\n") + (display "Welcome, this is GNU's early boot Guile.\n") (display "Use '--repl' for an initrd REPL.\n\n") - (mkdir "/proc") - (mount "none" "/proc" "proc") - - (mkdir "/sys") - (mount "none" "/sys" "sysfs") - - (let* ((command (string-trim-both - (call-with-input-file "/proc/cmdline" - get-string-all))) - (args (string-split command char-set:blank)) + (mount-essential-file-systems) + (let* ((args (linux-command-line)) (option (lambda (opt) (let ((opt (string-append opt "="))) (and=> (find (cut string-prefix? opt <>) @@ -270,34 +261,13 @@ the Linux kernel.") (when (member "--repl" args) ((@ (system repl repl) start-repl))) - (let ((slurp (lambda (module) - (call-with-input-file - (string-append "/modules/" module) - get-bytevector-all)))) - (display "loading CIFS and companion modules...\n") - (for-each (compose load-linux-module slurp) - (list "md4.ko" "ecb.ko" "cifs.ko"))) + (display "loading CIFS and companion modules...\n") + (for-each (compose load-linux-module* + (cut string-append "/modules/" <>)) + (list "md4.ko" "ecb.ko" "cifs.ko")) - ;; See net/slirp.c for default QEMU networking values. - (display "configuring network...\n") - (let* ((sock (socket AF_INET SOCK_STREAM 0)) - (address (make-socket-address AF_INET - (inet-pton AF_INET - "10.0.2.10") - 0)) - (flags (network-interface-flags sock "eth0"))) - (set-network-interface-address sock "eth0" address) - (set-network-interface-flags sock "eth0" - (logior flags IFF_UP)) - (if (logand (network-interface-flags sock "eth0") IFF_UP) - (display "network interface is up\n") - (display "network interface is DOWN\n")) - - (mkdir "/etc") - (call-with-output-file "/etc/resolv.conf" - (lambda (p) - (display "nameserver 10.0.2.3\n" p))) - (sleep 1)) + (unless (configure-qemu-networking) + (display "network interface is DOWN\n")) ;; Prepare the real root file system under /root. (unless (file-exists? "/root") @@ -305,27 +275,19 @@ the Linux kernel.") (if root (mount root "/root" "ext3") (mount "none" "/root" "tmpfs")) - (mkdir "/root/proc") - (mount "none" "/root/proc" "proc") - (mkdir "/root/sys") - (mount "none" "/root/sys" "sysfs") + (mount-essential-file-systems #:root "/root") + (mkdir "/root/xchg") (mkdir "/root/nix") (mkdir "/root/nix/store") (mkdir "/root/dev") - (let ((makedev (lambda (major minor) - (+ (* major 256) minor)))) - (mknod "/root/dev/null" 'char-special #o666 (makedev 1 3)) - (mknod "/root/dev/zero" 'char-special #o666 (makedev 1 5))) + (mknod "/root/dev/null" 'char-special #o666 (device-number 1 3)) + (mknod "/root/dev/zero" 'char-special #o666 (device-number 1 5)) ;; Mount the host's store and exchange directory. - (display "mounting QEMU's SMB shares...\n") - (let ((server "10.0.2.4")) - (mount (string-append "//" server "/store") "/root/nix/store" "cifs" 0 - (string->pointer "guest,sec=none")) - (mount (string-append "//" server "/xchg") "/root/xchg" "cifs" 0 - (string->pointer "guest,sec=none"))) + (mount-qemu-smb-share "/store" "/root/nix/store") + (mount-qemu-smb-share "/xchg" "/root/xchg") (if to-load (begin @@ -346,6 +308,7 @@ the Linux kernel.") (display "entering a warm and cozy REPL\n") ((@ (system repl repl) start-repl)))))) #:name "qemu-initrd" + #:modules '((guix build linux-initrd)) #:linux linux-libre #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko"))) diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm new file mode 100644 index 0000000000..274eef7ff3 --- /dev/null +++ b/guix/build/linux-initrd.scm @@ -0,0 +1,107 @@ +;;; 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 (guix build linux-initrd) + #:use-module (rnrs io ports) + #:use-module (system foreign) + #:export (mount-essential-file-systems + linux-command-line + configure-qemu-networking + mount-qemu-smb-share + load-linux-module* + device-number)) + +;;; Commentary: +;;; +;;; Utility procedures useful in a Linux initial RAM disk (initrd). Note that +;;; many of these use procedures not yet available in vanilla Guile (`mount', +;;; `load-linux-module', etc.); these are provided by a Guile patch used in +;;; the GNU distribution. +;;; +;;; Code: + +(define* (mount-essential-file-systems #:key (root "/")) + "Mount /proc and /sys under ROOT." + (define (scope dir) + (string-append root + (if (string-suffix? "/" root) + "" + "/") + dir)) + + (unless (file-exists? (scope "proc")) + (mkdir (scope "proc"))) + (mount "none" (scope "proc") "proc") + + (unless (file-exists? (scope "sys")) + (mkdir (scope "sys"))) + (mount "none" (scope "sys") "sysfs")) + +(define (linux-command-line) + "Return the Linux kernel command line as a list of strings." + (string-tokenize + (call-with-input-file "/proc/cmdline" + get-string-all))) + +(define %host-qemu-ipv4-address + (inet-pton AF_INET "10.0.2.10")) + +(define* (configure-qemu-networking #:optional (interface "eth0")) + "Setup the INTERFACE network interface and /etc/resolv.conf according to +QEMU's default networking settings (see net/slirp.c in QEMU for default +networking values.) Return #t if INTERFACE is up, #f otherwise." + (display "configuring QEMU networking...\n") + (let* ((sock (socket AF_INET SOCK_STREAM 0)) + (address (make-socket-address AF_INET %host-qemu-ipv4-address 0)) + (flags (network-interface-flags sock interface))) + (set-network-interface-address sock interface address) + (set-network-interface-flags sock interface (logior flags IFF_UP)) + + (unless (file-exists? "/etc") + (mkdir "/etc")) + (call-with-output-file "/etc/resolv.conf" + (lambda (p) + (display "nameserver 10.0.2.3\n" p))) + + (logand (network-interface-flags sock interface) IFF_UP))) + +(define (mount-qemu-smb-share share mount-point) + "Mount QEMU's CIFS/SMB SHARE at MOUNT-POINT. + +Vanilla QEMU's `-smb' option just exports a /qemu share, whereas our +`qemu-with-multiple-smb-shares' package exports the /xchg and /store shares + (the latter allows the store to be shared between the host and guest.)" + + (format #t "mounting QEMU's SMB share `~a'...\n" share) + (let ((server "10.0.2.4")) + (mount (string-append "//" server share) mount-point "cifs" 0 + (string->pointer "guest,sec=none")))) + +(define (load-linux-module* file) + "Load Linux module from FILE, the name of a `.ko' file." + (define (slurp module) + (call-with-input-file file get-bytevector-all)) + + (load-linux-module (slurp file))) + +(define (device-number major minor) + "Return the device number for the device with MAJOR and MINOR, for use as +the last argument of `mknod'." + (+ (* major 256) minor)) + +;;; linux-initrd.scm ends here -- cgit v1.2.3 From 88bd1804a25056591237c4163faeb4e42449244d Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Thu, 29 Aug 2013 15:42:52 +0200 Subject: gnu: gsl: Move from module algebra to maths. * gnu/packages/algebra.scm (gsl): Move variable from here... * gnu/packages/maths.scm (gsl): ...to here. --- gnu/packages/algebra.scm | 26 -------------------------- gnu/packages/maths.scm | 27 ++++++++++++++++++++++++++- 2 files changed, 26 insertions(+), 27 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/algebra.scm b/gnu/packages/algebra.scm index 3a447d8591..b92882a100 100644 --- a/gnu/packages/algebra.scm +++ b/gnu/packages/algebra.scm @@ -78,32 +78,6 @@ solve the shortest vector problem.") (license lgpl2.1+) (home-page "http://perso.ens-lyon.fr/damien.stehle/fplll/"))) -(define-public gsl - (package - (name "gsl") - (version "1.15") - (source - (origin - (method url-fetch) - (uri (string-append "mirror://gnu/gsl/gsl-" - version ".tar.gz")) - (sha256 - (base32 - "18qf6jzz1r3mzb5qynywv4xx3z9g61hgkbpkdrhbgqh2g7jhgfc5")))) - (build-system gnu-build-system) - (home-page "http://www.gnu.org/software/gsl/") - (synopsis "Numerical library for C and C++") - (description - "The GNU Scientific Library (GSL) is a numerical library for C -and C++ programmers. It is free software under the GNU General -Public License. - -The library provides a wide range of mathematical routines such -as random number generators, special functions and least-squares -fitting. There are over 1000 functions in total with an -extensive test suite.") - (license gpl3+))) - (define-public pari-gp (package (name "pari-gp") diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index 7b900225b5..a2bb2a450e 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -23,7 +23,6 @@ #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) - #:use-module (gnu packages algebra) #:use-module (gnu packages compression) #:use-module ((gnu packages gettext) #:renamer (symbol-prefix-proc 'gnu:)) @@ -67,6 +66,32 @@ the standard data file.") (license license:gpl3+) (home-page "http://www.gnu.org/software/units/"))) +(define-public gsl + (package + (name "gsl") + (version "1.15") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/gsl/gsl-" + version ".tar.gz")) + (sha256 + (base32 + "18qf6jzz1r3mzb5qynywv4xx3z9g61hgkbpkdrhbgqh2g7jhgfc5")))) + (build-system gnu-build-system) + (home-page "http://www.gnu.org/software/gsl/") + (synopsis "Numerical library for C and C++") + (description + "The GNU Scientific Library (GSL) is a numerical library for C +and C++ programmers. It is free software under the GNU General +Public License. + +The library provides a wide range of mathematical routines such +as random number generators, special functions and least-squares +fitting. There are over 1000 functions in total with an +extensive test suite.") + (license license:gpl3+))) + (define-public pspp (package (name "pspp") -- cgit v1.2.3 From ffc1074f86be782035a2162c60515c0a9db999ca Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 30 Aug 2013 14:18:34 +0200 Subject: gnu: hop: Allow compilation with Bigloo 4.0b. Fixes . Reported by Mark H Weaver . * gnu/packages/patches/hop-bigloo-4.0b.patch: New file. * gnu-system.am (dist_patch_DATA): Add it. * gnu/packages/scheme.scm (hop): Use it. --- gnu-system.am | 1 + gnu/packages/patches/hop-bigloo-4.0b.patch | 122 +++++++++++++++++++++++++++++ gnu/packages/scheme.scm | 6 +- 3 files changed, 128 insertions(+), 1 deletion(-) create mode 100644 gnu/packages/patches/hop-bigloo-4.0b.patch (limited to 'gnu') diff --git a/gnu-system.am b/gnu-system.am index 920e1383f7..2600858fe0 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -207,6 +207,7 @@ dist_patch_DATA = \ gnu/packages/patches/guile-default-utf8.patch \ gnu/packages/patches/guile-linux-syscalls.patch \ gnu/packages/patches/guile-relocatable.patch \ + gnu/packages/patches/hop-bigloo-4.0b.patch \ gnu/packages/patches/libevent-dns-tests.patch \ gnu/packages/patches/libtool-skip-tests.patch \ gnu/packages/patches/m4-gets-undeclared.patch \ diff --git a/gnu/packages/patches/hop-bigloo-4.0b.patch b/gnu/packages/patches/hop-bigloo-4.0b.patch new file mode 100644 index 0000000000..312bfdd117 --- /dev/null +++ b/gnu/packages/patches/hop-bigloo-4.0b.patch @@ -0,0 +1,122 @@ +Bigloo 4.0b removes `xml-attribute-encode', which leads to a build failure +in Hop. + +This patch allows Hop to be compiled with Bigloo 4.0b. + + +changeset: 3327:3515f7f1aef2 +branch: 2.4.x +user: Manuel Serrano +date: Wed Jul 31 12:41:10 2013 +0200 +summary: Fix serialization bug + +diff -r 7244c4d30ad4 -r 3515f7f1aef2 runtime/js_comp.scm +--- a/runtime/js_comp.scm Fri Jul 19 08:28:13 2013 +0200 ++++ b/runtime/js_comp.scm Wed Jul 31 12:41:10 2013 +0200 +@@ -143,10 +143,17 @@ + (display "{ " op) + (display-seq fields op + (lambda (f op) ++ (let ((iv (class-field-info f))) + (display "'" op) + (display (class-field-name f) op) + (display "': " op) +- (compile ((class-field-accessor f) obj) op))) ++ (cond ++ ((and (pair? iv) (memq :client iv)) ++ => ++ (lambda (x) ++ (compile (when (pair? (cdr x)) (cadr x)) op))) ++ (else ++ (compile ((class-field-accessor f) obj) op)))))) + (display "}" op)) + + (let ((klass (object-class obj))) +diff -r 7244c4d30ad4 -r 3515f7f1aef2 runtime/xml.scm +--- a/runtime/xml.scm Fri Jul 19 08:28:13 2013 +0200 ++++ b/runtime/xml.scm Wed Jul 31 12:41:10 2013 +0200 +@@ -55,6 +55,7 @@ + (generic xml-write-attribute ::obj ::obj ::output-port ::xml-backend) + (generic xml-write-expression ::obj ::output-port) + (xml-write-attributes ::pair-nil ::output-port ::xml-backend) ++ (xml-attribute-encode obj) + + (xml->string ::obj ::xml-backend) + +@@ -613,6 +614,52 @@ + (display ">" p)))) + + ;*---------------------------------------------------------------------*/ ++;* xml-attribute-encode ... */ ++;*---------------------------------------------------------------------*/ ++(define (xml-attribute-encode obj) ++ (if (not (string? obj)) ++ obj ++ (let ((ol (string-length obj))) ++ (define (count str ol) ++ (let loop ((i 0) ++ (j 0)) ++ (if (=fx i ol) ++ j ++ (let ((c (string-ref str i))) ++ ;; attribute values should escape &#... ++ (if (or (char=? c #\') (char=? c #\&)) ++ (loop (+fx i 1) (+fx j 5)) ++ (loop (+fx i 1) (+fx j 1))))))) ++ (define (encode str ol nl) ++ (if (=fx nl ol) ++ obj ++ (let ((nstr (make-string nl))) ++ (let loop ((i 0) ++ (j 0)) ++ (if (=fx j nl) ++ nstr ++ (let ((c (string-ref str i))) ++ (case c ++ ((#\') ++ (string-set! nstr j #\&) ++ (string-set! nstr (+fx j 1) #\#) ++ (string-set! nstr (+fx j 2) #\3) ++ (string-set! nstr (+fx j 3) #\9) ++ (string-set! nstr (+fx j 4) #\;) ++ (loop (+fx i 1) (+fx j 5))) ++ ((#\&) ++ (string-set! nstr j #\&) ++ (string-set! nstr (+fx j 1) #\#) ++ (string-set! nstr (+fx j 2) #\3) ++ (string-set! nstr (+fx j 3) #\8) ++ (string-set! nstr (+fx j 4) #\;) ++ (loop (+fx i 1) (+fx j 5))) ++ (else ++ (string-set! nstr j c) ++ (loop (+fx i 1) (+fx j 1)))))))))) ++ (encode obj ol (count obj ol))))) ++ ++;*---------------------------------------------------------------------*/ + ;* xml-write-attributes ... */ + ;*---------------------------------------------------------------------*/ + (define (xml-write-attributes attr p backend) +diff -r 7244c4d30ad4 -r 3515f7f1aef2 share/hop-serialize.js +--- a/share/hop-serialize.js Fri Jul 19 08:28:13 2013 +0200 ++++ b/share/hop-serialize.js Wed Jul 31 12:41:10 2013 +0200 +@@ -942,7 +942,7 @@ + case 0x2e /* . */: return null; + case 0x3c /* < */: return read_cnst(); + case 0x22 /* " */: return read_string( s ); +- case 0x25 /* " */: return decodeURIComponent( read_string( s ) ); ++ case 0x25 /* % */: return decodeURIComponent( read_string( s ) ); + case 0x55 /* U */: return read_string( s ); + case 0x5b /* [ */: return read_vector( read_size( s ) ); + case 0x28 /* ( */: return read_list( read_size( s ) ); +diff -r 7244c4d30ad4 -r 3515f7f1aef2 src/main.scm +--- a/src/main.scm Fri Jul 19 08:28:13 2013 +0200 ++++ b/src/main.scm Wed Jul 31 12:41:10 2013 +0200 +@@ -59,8 +59,6 @@ + (for-each register-srfi! (cons 'hop-server (hop-srfis))) + ;; set the library load path + (bigloo-library-path-set! (hop-library-path)) +- ;; define the Hop macros +- (hop-install-expanders!) + ;; setup the hop readers + (bigloo-load-reader-set! hop-read) + (bigloo-load-module-set! diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index eb339d7236..43853fa08c 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -251,6 +251,7 @@ between Scheme and C# programs.") "\\.so$"))))) %standard-phases)) #:tests? #f ; no test suite + #:patches (list (assoc-ref %build-inputs "patch/bigloo-4.0b")) #:modules ((guix build gnu-build-system) (guix build utils) (ice-9 popen) @@ -259,7 +260,10 @@ between Scheme and C# programs.") (srfi srfi-1)))) (inputs `(("bigloo" ,bigloo) ("which" ,which) - ("patchelf" ,patchelf))) + ("patchelf" ,patchelf) + + ("patch/bigloo-4.0b" + ,(search-patch "hop-bigloo-4.0b.patch")))) (home-page "http://hop.inria.fr/") (synopsis "A multi-tier programming language for the Web 2.0") (description -- cgit v1.2.3 From 71e0f28856558a1c8da76ab55689a3d7a29acd5a Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 31 Aug 2013 12:18:53 +0200 Subject: gnu: gsl: Disable numerically unstable test on i686. * gnu/packages/maths.scm (gsl): Disable test. --- gnu/packages/maths.scm | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'gnu') diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index a2bb2a450e..75354122b5 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -79,6 +79,19 @@ the standard data file.") (base32 "18qf6jzz1r3mzb5qynywv4xx3z9g61hgkbpkdrhbgqh2g7jhgfc5")))) (build-system gnu-build-system) + (arguments + `(#:phases + (alist-replace + 'configure + (lambda* (#:key target system outputs #:allow-other-keys #:rest args) + (let ((configure (assoc-ref %standard-phases 'configure))) + ;; disable numerically unstable test on i686, see thread at + ;; http://lists.gnu.org/archive/html/bug-gsl/2011-11/msg00019.html + (if (string=? (or target system) "i686-linux") + (substitute* "ode-initval2/Makefile.in" + (("TESTS = \\$\\(check_PROGRAMS\\)") "TESTS ="))) + (apply configure args))) + %standard-phases))) (home-page "http://www.gnu.org/software/gsl/") (synopsis "Numerical library for C and C++") (description -- cgit v1.2.3 From d9c4b6e944918532382f999735b040125dc6ebe0 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 31 Aug 2013 12:20:55 +0200 Subject: gnu: pari-gp: Update to 2.5.4. * gnu/packages/algebra.scm (pari-gp): Update to 2.5.4. --- gnu/packages/algebra.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/algebra.scm b/gnu/packages/algebra.scm index b92882a100..6c294c814a 100644 --- a/gnu/packages/algebra.scm +++ b/gnu/packages/algebra.scm @@ -81,14 +81,14 @@ solve the shortest vector problem.") (define-public pari-gp (package (name "pari-gp") - (version "2.5.3") + (version "2.5.4") (source (origin (method url-fetch) (uri (string-append "http://pari.math.u-bordeaux.fr/pub/pari/unix/pari-" version ".tar.gz")) (sha256 (base32 - "0zsjccnnv00kwj2gk3ww2v530kjin1rgj8p8hbl4pwcnwc7m68gl")))) + "0gpsj5n8d1gyl7nq2y915sscs3d334ryrv8qgjdwqf3cr95f2dwz")))) (build-system gnu-build-system) (inputs `(("gmp" ,gmp) ("perl" ,perl) -- cgit v1.2.3 From 24b5c463f3b70e2d2da1219bf32db28f5bb4582c Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 31 Aug 2013 12:46:08 +0200 Subject: gnu: Add dbus-glib. * gnu/packages/glib.scm (dbus-glib): New variable. --- gnu/packages/glib.scm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'gnu') diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm index 15031179ff..63751bb510 100644 --- a/gnu/packages/glib.scm +++ b/gnu/packages/glib.scm @@ -185,3 +185,28 @@ The intltool collection can be used to do these things: Merge back the translations from .po files into .xml, .desktop and oaf files. This merge step will happen at build resp. installation time.") (license license:gpl2+))) + +(define-public dbus-glib + (package + (name "dbus-glib") + (version "0.100.2") + (source (origin + (method url-fetch) + (uri + (string-append "http://dbus.freedesktop.org/releases/dbus-glib/dbus-glib-" + version ".tar.gz")) + (sha256 + (base32 + "1ibav91yg70f2l3l18cr0hf4mna1h9d4mrg0c60w4l8zjbd45fx5")))) + (build-system gnu-build-system) + (inputs + `(("dbus" ,dbus) + ("expat" ,expat) + ("glib" ,glib) + ("pkg-config" ,pkg-config))) + (home-page "http://dbus.freedesktop.org/doc/dbus-glib/") + (synopsis "D-Bus GLib bindings") + (description + "GLib bindings for D-Bus. The package is obsolete and superseded +by GDBus included in Glib.") + (license license:gpl2))) ; or Academic Free License 2.1 -- cgit v1.2.3 From 37f9ff639ebbbcd3cfeac619282b1f8f8a672cf8 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 31 Aug 2013 13:47:46 +0200 Subject: gnu: Add xmlto. * gnu/packages/xml.scm (xmlto): New variable. --- gnu/packages/xml.scm | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) (limited to 'gnu') diff --git a/gnu/packages/xml.scm b/gnu/packages/xml.scm index 6edff473da..2f9d64b81a 100644 --- a/gnu/packages/xml.scm +++ b/gnu/packages/xml.scm @@ -28,7 +28,8 @@ #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) - #:use-module (guix build-system perl)) + #:use-module (guix build-system perl) + #:use-module (gnu packages linux)) (define-public expat (package @@ -138,3 +139,27 @@ then passed on to the Expat object on each parse call. They can also be given as extra arguments to the parse methods, in which case they override options given at XML::Parser creation time.") (home-page "http://search.cpan.org/~toddr/XML-Parser-2.41/Parser.pm"))) + +(define-public xmlto + (package + (name "xmlto") + (version "0.0.25") + (source + (origin + (method url-fetch) + (uri (string-append + "https://fedorahosted.org/releases/x/m/xmlto/xmlto-" + version ".tar.bz2")) + (sha256 + (base32 + "0dp5nxq491gymq806za0dk4hngfmq65ysrqbn0ypajqbbl6vf71n")))) + (build-system gnu-build-system) + (inputs + `(("util-linux" ,util-linux))) + (home-page "http://cyberelk.net/tim/software/xmlto/") + (synopsis "Front-end to an XSL toolchain") + (description + "Xmlto is a front-end to an XSL toolchain. It chooses an appropriate +stylesheet for the conversion you want and applies it using an external +XSL-T processor. It also performs any necessary post-processing.") + (license license:gpl2+))) -- cgit v1.2.3 From 91dcbafab95746827c6a9255599086afb55273c4 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 31 Aug 2013 14:12:24 +0200 Subject: gnu: Add yasm. * gnu/packages/yasm.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add module. --- gnu-system.am | 1 + gnu/packages/yasm.scm | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+) create mode 100644 gnu/packages/yasm.scm (limited to 'gnu') diff --git a/gnu-system.am b/gnu-system.am index 2600858fe0..a5000bcdfe 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -176,6 +176,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/xml.scm \ gnu/packages/xnee.scm \ gnu/packages/xorg.scm \ + gnu/packages/yasm.scm \ gnu/packages/zile.scm \ gnu/packages/zip.scm \ gnu/system/vm.scm diff --git a/gnu/packages/yasm.scm b/gnu/packages/yasm.scm new file mode 100644 index 0000000000..51cd3ed0a5 --- /dev/null +++ b/gnu/packages/yasm.scm @@ -0,0 +1,55 @@ +;;; 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 yasm) + #:use-module (gnu packages) + #:use-module ((guix licenses) + #:renamer (symbol-prefix-proc 'license:)) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages python) + #:use-module (gnu packages xml)) + +(define-public yasm + (package + (name "yasm") + (version "1.2.0") + (source + (origin + (method url-fetch) + (uri (string-append "http://www.tortall.net/projects/yasm/releases/yasm-" + version ".tar.gz")) + (sha256 + (base32 + "0cfg7ji3ia2in628w42wrfvw2ixmmm4rghwmv2k202mraysgm3vn")))) + (build-system gnu-build-system) + (inputs + `(("python" ,python) + ("xmlto" ,xmlto))) + (home-page "http://yasm.tortall.net/") + (synopsis "Rewrite of the NASM assembler") + (description + "Yasm is a complete rewrite of the NASM assembler. + +Yasm currently supports the x86 and AMD64 instruction sets, accepts NASM +and GAS assembler syntaxes, outputs binary, ELF32, ELF64, 32 and 64-bit +Mach-O, RDOFF2, COFF, Win32, and Win64 object formats, and generates source +debugging information in STABS, DWARF 2, and CodeView 8 formats.") + (license (license:bsd-style "file://COPYING" + "See COPYING in the distribution.")))) -- cgit v1.2.3 From f26a77ffbc68274591cdbc576185e37d583e21db Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 31 Aug 2013 14:52:24 +0200 Subject: gnu: Add Python 3. * gnu/packages/python.scm (python-2): Rename from python for version 2. * gnu/packages/python.scm (python): New variable for version 3. --- gnu/packages/python.scm | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'gnu') diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 35d5b51e06..090fd8239e 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,6 +151,18 @@ packages; exception-based error handling; and very high level dynamic data types.") (license psfl))) +(define-public python + (package (inherit python-2) + (version "3.3.2") + (source + (origin + (method url-fetch) + (uri (string-append "http://www.python.org/ftp/python/" + version "/Python-" version ".tar.xz")) + (sha256 + (base32 + "0hsbwqjnhr85a2w252c8d3yj8d9i5sy8s6a6cfk6zqqhp3234nvl")))))) + (define-public pytz (package (name "pytz") -- cgit v1.2.3 From 1aebc0cb2c8bb195457e321153f6d0868bbd7633 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 31 Aug 2013 18:43:17 +0200 Subject: gnu: python: Adapt native-search-paths for Python 3.3. * gnu/packages/python.scm (python): Modify native-search-paths. --- gnu/packages/python.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'gnu') diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 090fd8239e..0a3977aabb 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -161,7 +161,11 @@ data types.") version "/Python-" version ".tar.xz")) (sha256 (base32 - "0hsbwqjnhr85a2w252c8d3yj8d9i5sy8s6a6cfk6zqqhp3234nvl")))))) + "0hsbwqjnhr85a2w252c8d3yj8d9i5sy8s6a6cfk6zqqhp3234nvl")))) + (native-search-paths + (list (search-path-specification + (variable "PYTHONPATH") + (directories '("lib/python3.3/site-packages"))))))) (define-public pytz (package -- cgit v1.2.3 From 89bf140b10ae24755bf9d2b789b945d29ff11937 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 31 Aug 2013 14:52:12 +0200 Subject: gnu: linux-initrd: Make Guile modules accessible in the chroot. * gnu/packages/linux-initrd.scm (qemu-initrd): Add (guix build utils) to #:modules, and use it. Copy .scm and .go files to /root. * guix/build/linux-initrd.scm (bind-mount): New procedure. --- gnu/packages/linux-initrd.scm | 25 +++++++++++++++++++++---- guix/build/linux-initrd.scm | 7 +++++++ 2 files changed, 28 insertions(+), 4 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm index 2ed52e60f0..f1e488ad69 100644 --- a/gnu/packages/linux-initrd.scm +++ b/gnu/packages/linux-initrd.scm @@ -242,6 +242,7 @@ the Linux kernel.") (srfi srfi-26) (ice-9 match) ((system base compile) #:select (compile-file)) + (guix build utils) (guix build linux-initrd)) (display "Welcome, this is GNU's early boot Guile.\n") @@ -278,8 +279,7 @@ the Linux kernel.") (mount-essential-file-systems #:root "/root") (mkdir "/root/xchg") - (mkdir "/root/nix") - (mkdir "/root/nix/store") + (mkdir-p "/root/nix/store") (mkdir "/root/dev") (mknod "/root/dev/null" 'char-special #o666 (device-number 1 3)) @@ -289,6 +289,19 @@ the Linux kernel.") (mount-qemu-smb-share "/store" "/root/nix/store") (mount-qemu-smb-share "/xchg" "/root/xchg") + ;; Copy the directories that contain .scm and .go files so that the + ;; child process in the chroot can load modules (we would bind-mount + ;; them but for some reason that fails with EINVAL -- XXX). + (mkdir "/root/share") + (mkdir "/root/lib") + (mount "none" "/root/share" "tmpfs") + (mount "none" "/root/lib" "tmpfs") + (copy-recursively "/share" "/root/share" + #:log (%make-void-port "w")) + (copy-recursively "/lib" "/root/lib" + #:log (%make-void-port "w")) + + (if to-load (begin (format #t "loading boot file '~a'...\n" to-load) @@ -298,7 +311,10 @@ the Linux kernel.") (match (primitive-fork) (0 (chroot "/root") - (load-compiled "/loader.go")) + (load-compiled "/loader.go") + + ;; TODO: Remove /lib, /share, and /loader.go. + ) (pid (format #t "boot file loaded under PID ~a~%" pid) (let ((status (waitpid pid))) @@ -308,7 +324,8 @@ the Linux kernel.") (display "entering a warm and cozy REPL\n") ((@ (system repl repl) start-repl)))))) #:name "qemu-initrd" - #:modules '((guix build linux-initrd)) + #:modules '((guix build utils) + (guix build linux-initrd)) #:linux linux-libre #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko"))) diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index 274eef7ff3..81f9e46cfb 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -23,6 +23,7 @@ linux-command-line configure-qemu-networking mount-qemu-smb-share + bind-mount load-linux-module* device-number)) @@ -92,6 +93,12 @@ Vanilla QEMU's `-smb' option just exports a /qemu share, whereas our (mount (string-append "//" server share) mount-point "cifs" 0 (string->pointer "guest,sec=none")))) +(define (bind-mount source target) + "Bind-mount SOURCE at TARGET." + (define MS_BIND 4096) ; from libc's + + (mount source target "" MS_BIND)) + (define (load-linux-module* file) "Load Linux module from FILE, the name of a `.ko' file." (define (slurp module) -- cgit v1.2.3 From b48d21b24634399b41f6d5144691b58c159d72e2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 31 Aug 2013 22:46:52 +0200 Subject: gnu: linux-initrd: Make device nodes for QEMU's hard disk. * gnu/packages/linux-initrd.scm (qemu-initrd): Make /dev/vda*. --- gnu/packages/linux-initrd.scm | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'gnu') diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm index f1e488ad69..17f42652e8 100644 --- a/gnu/packages/linux-initrd.scm +++ b/gnu/packages/linux-initrd.scm @@ -270,6 +270,11 @@ the Linux kernel.") (unless (configure-qemu-networking) (display "network interface is DOWN\n")) + ;; Make the device nodes for QEMU's hard disk and partitions. + (mknod "/dev/vda" 'block-special #o644 (device-number 8 0)) + (mknod "/dev/vda1" 'block-special #o644 (device-number 8 1)) + (mknod "/dev/vda2" 'block-special #o644 (device-number 8 2)) + ;; Prepare the real root file system under /root. (unless (file-exists? "/root") (mkdir "/root")) -- cgit v1.2.3 From ca85d7bcc6dca82bea176052d0a2615cd9bd3074 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 31 Aug 2013 22:55:04 +0200 Subject: gnu: `expression->derivation-in-linux-vm' export references graphs. * gnu/system/vm.scm (expression->derivation-in-linux-vm): Add #:reference-graphs parameter. Honor it. Delete duplicates in #:modules argument. --- gnu/system/vm.scm | 33 +++++++++++++++++++++++++++------ 1 file changed, 27 insertions(+), 6 deletions(-) (limited to 'gnu') diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index fedf0ee322..f3e875bee1 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -28,6 +28,7 @@ #:use-module (gnu packages linux-initrd) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:export (expression->derivation-in-linux-vm @@ -53,6 +54,7 @@ (%guile-for-build)) (make-disk-image? #f) + (references-graphs #f) (disk-image-size (* 100 (expt 2 20)))) "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD. In the @@ -61,7 +63,11 @@ its output files in the `/xchg' directory, which is copied to the derivation's output when the VM terminates. When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of -DISK-IMAGE-SIZE bytes and return it." +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." (define input-alist (map (match-lambda ((input package) @@ -77,8 +83,10 @@ DISK-IMAGE-SIZE bytes and return it." (define builder ;; Code that launches the VM that evaluates EXP. - `(begin - (use-modules (guix build utils)) + `(let () + (use-modules (guix build utils) + (srfi srfi-1) + (ice-9 rdelim)) (let ((out (assoc-ref %outputs "out")) (cu (string-append (assoc-ref %build-inputs "coreutils") @@ -104,6 +112,17 @@ DISK-IMAGE-SIZE bytes and return it." '(begin)) (mkdir "xchg") + + ;; Copy the reference-graph files under xchg/ so EXP can access it. + (begin + ,@(match references-graphs + (((graph-files . _) ...) + (map (lambda (file) + `(copy-file ,file + ,(string-append "xchg/" file))) + graph-files)) + (#f '()))) + (and (zero? (system* qemu "-nographic" "-no-reboot" "-net" "nic,model=e1000" @@ -139,9 +158,11 @@ DISK-IMAGE-SIZE bytes and return it." ,@sub-drv))) inputs)) #:env-vars env-vars - #:modules `((guix build utils) - ,@modules) - #:guile-for-build guile-for-build))) + #:modules (delete-duplicates + `((guix build utils) + ,@modules)) + #:guile-for-build guile-for-build + #:references-graphs references-graphs))) (define* (qemu-image store #:key (name "qemu-image") -- cgit v1.2.3 From 4c0f0673b2334077ac11f3d835d045c81d9854e0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 31 Aug 2013 22:56:16 +0200 Subject: gnu: `expression->derivation-in-linux-vm' accepts files as inputs. * gnu/system/vm.scm (expression->derivation-in-linux-vm): Accept items in INPUTS that refer to a file instead of a package. --- gnu/system/vm.scm | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) (limited to 'gnu') diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index f3e875bee1..5b61136dc0 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -70,10 +70,12 @@ pairs, as for `derivation'. The files containing the reference graphs are made available under the /xchg CIFS share." (define input-alist (map (match-lambda - ((input package) + ((input (? package? package)) `(,input . ,(package-output store package "out" system))) - ((input package sub-drv) - `(,input . ,(package-output store package sub-drv system)))) + ((input (? package? package) sub-drv) + `(,input . ,(package-output store package sub-drv system))) + ((input (and (? string?) (? store-path?) file)) + `(,input . ,file))) inputs)) (define exp* @@ -153,9 +155,12 @@ made available under the /xchg CIFS share." ("coreutils" ,(->drv coreutils)) ("builder" ,user-builder) ,@(map (match-lambda - ((name package sub-drv ...) + ((name (? package? package) + sub-drv ...) `(,name ,(->drv package) - ,@sub-drv))) + ,@sub-drv)) + ((name (? string? file)) + `(,name ,file))) inputs)) #:env-vars env-vars #:modules (delete-duplicates -- cgit v1.2.3 From 93d44bd8decac576a5cd0bcd8356e6fcf6083ee5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 31 Aug 2013 23:01:56 +0200 Subject: gnu: vm: `qemu-image' can copy store closures into the target image. * gnu/system/vm.scm (qemu-image): Add #:inputs-to-copy and #:boot-expression parameters. Honor them. Append INPUTS-TO-COPY to the #:inputs argument for `expression->derivation-in-linux-vm'. (example2): Add #:boot-expression and #:inputs-to-copy arguments. --- gnu/system/vm.scm | 208 ++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 147 insertions(+), 61 deletions(-) (limited to 'gnu') diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 5b61136dc0..3bc94f4575 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu system vm) + #:use-module (guix config) #:use-module (guix store) #:use-module (guix derivations) #:use-module (guix packages) @@ -28,6 +29,8 @@ #:use-module (gnu packages linux-initrd) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) + #:use-module ((gnu packages system) + #:select (shadow)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) @@ -175,77 +178,150 @@ made available under the /xchg CIFS share." (disk-image-size (* 100 (expt 2 20))) (linux linux-libre) (initrd qemu-initrd) - (inputs '())) - "Return a bootable, stand-alone QEMU image." + (inputs '()) + (inputs-to-copy '()) + (boot-expression #f)) + "Return a bootable, stand-alone QEMU image. + +INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied +into the image being built. + +When BOOT-EXPRESSION is true, it is an expression to evaluate when the basic +initialization is done. A typical example is `(execl ...)' to launch the init +process." + (define input->name+derivation + (match-lambda + ((name (? package? package)) + `(,name . ,(derivation-path->output-path + (package-derivation store package system)))) + ((name (? package? package) sub-drv) + `(,name . ,(derivation-path->output-path + (package-derivation store package system) + sub-drv))))) + + (define loader + (and boot-expression + (add-text-to-store store "loader" + (object->string boot-expression) + '()))) + (expression->derivation-in-linux-vm store "qemu-image" - `(let ((parted (string-append (assoc-ref %build-inputs "parted") - "/sbin/parted")) - (mkfs (string-append (assoc-ref %build-inputs "e2fsprogs") - "/sbin/mkfs.ext3")) - (grub (string-append (assoc-ref %build-inputs "grub") - "/sbin/grub-install")) - (umount (string-append (assoc-ref %build-inputs "util-linux") - "/bin/umount")) ; XXX: add to Guile - (initrd (string-append (assoc-ref %build-inputs "initrd") - "/initrd")) - (linux (string-append (assoc-ref %build-inputs "linux") - "/bzImage")) - (makedev (lambda (major minor) - (+ (* major 256) minor)))) - - ;; GRUB is full of shell scripts. - (setenv "PATH" - (string-append (dirname grub) ":" - (assoc-ref %build-inputs "coreutils") "/bin:" - (assoc-ref %build-inputs "findutils") "/bin:" - (assoc-ref %build-inputs "sed") "/bin:" - (assoc-ref %build-inputs "grep") "/bin:" - (assoc-ref %build-inputs "gawk") "/bin")) - - (display "creating partition table...\n") - (mknod "/dev/vda" 'block-special #o644 (makedev 8 0)) - (and (zero? (system* parted "/dev/vda" "mklabel" "msdos" - "mkpart" "primary" "ext2" "1MiB" - ,(format #f "~aB" - (- disk-image-size - (* 5 (expt 2 20)))))) - (begin - (display "creating ext3 partition...\n") - (mknod "/dev/vda1" 'block-special #o644 (makedev 8 1)) - (and (zero? (system* mkfs "-F" "/dev/vda1")) - (begin - (display "mounting partition...\n") - (mkdir "/fs") - (mount "/dev/vda1" "/fs" "ext3") - (mkdir "/fs/boot") - (mkdir "/fs/boot/grub") - (copy-file linux "/fs/boot/bzImage") - (copy-file initrd "/fs/boot/initrd") - (call-with-output-file "/fs/boot/grub/grub.cfg" - (lambda (p) - (display " + `(let () + (use-modules (ice-9 rdelim) + (srfi srfi-1) + (guix build utils)) + + (let ((parted (string-append (assoc-ref %build-inputs "parted") + "/sbin/parted")) + (mkfs (string-append (assoc-ref %build-inputs "e2fsprogs") + "/sbin/mkfs.ext3")) + (grub (string-append (assoc-ref %build-inputs "grub") + "/sbin/grub-install")) + (umount (string-append (assoc-ref %build-inputs "util-linux") + "/bin/umount")) ; XXX: add to Guile + (initrd (string-append (assoc-ref %build-inputs "initrd") + "/initrd")) + (linux (string-append (assoc-ref %build-inputs "linux") + "/bzImage")) + (makedev (lambda (major minor) + (+ (* major 256) minor)))) + + (define (read-reference-graph port) + ;; Return a list of store paths from the reference graph at PORT. + ;; The data at PORT is the format produced by #:references-graphs. + (let loop ((line (read-line port)) + (result '())) + (cond ((eof-object? line) + (delete-duplicates result)) + ((string-prefix? "/" line) + (loop (read-line port) + (cons line result))) + (else + (loop (read-line port) + result))))) + + (define (things-to-copy) + ;; Return the list of store files to copy to the image. + (define (graph-from-file file) + (call-with-input-file file + read-reference-graph)) + + ,(match inputs-to-copy + (((graph-files . _) ...) + `(let* ((graph-files ',(map (cut string-append "/xchg/" <>) + graph-files)) + (paths (append-map graph-from-file graph-files))) + (delete-duplicates paths))) + (#f ''()))) + + ;; GRUB is full of shell scripts. + (setenv "PATH" + (string-append (dirname grub) ":" + (assoc-ref %build-inputs "coreutils") "/bin:" + (assoc-ref %build-inputs "findutils") "/bin:" + (assoc-ref %build-inputs "sed") "/bin:" + (assoc-ref %build-inputs "grep") "/bin:" + (assoc-ref %build-inputs "gawk") "/bin")) + + (display "creating partition table...\n") + (mknod "/dev/vda" 'block-special #o644 (makedev 8 0)) + (and (zero? (system* parted "/dev/vda" "mklabel" "msdos" + "mkpart" "primary" "ext2" "1MiB" + ,(format #f "~aB" + (- disk-image-size + (* 5 (expt 2 20)))))) + (begin + (display "creating ext3 partition...\n") + (mknod "/dev/vda1" 'block-special #o644 (makedev 8 1)) + (and (zero? (system* mkfs "-F" "/dev/vda1")) + (begin + (display "mounting partition...\n") + (mkdir "/fs") + (mount "/dev/vda1" "/fs" "ext3") + (mkdir-p "/fs/boot/grub") + (copy-file linux "/fs/boot/bzImage") + (copy-file initrd "/fs/boot/initrd") + + ;; Populate the image's store. + (mkdir-p (string-append "/fs" ,%store-directory)) + (for-each (lambda (thing) + (copy-recursively thing + (string-append "/fs" + thing))) + (things-to-copy)) + + (call-with-output-file "/fs/boot/grub/grub.cfg" + (lambda (p) + (format p " set default=1 set timeout=5 search.file /boot/bzImage menuentry \"Boot-to-Guile! (GNU System technology preview)\" { - linux /boot/bzImage --repl + linux /boot/bzImage --root=/dev/vda1 ~a initrd /boot/initrd -}" p))) - (and (zero? - (system* grub "--no-floppy" - "--boot-directory" "/fs/boot" - "/dev/vda")) - (zero? - (system* umount "/fs")) - (reboot))))))) +}" + ,(if loader + (string-append "--load=" loader) + "")))) + (and (zero? + (system* grub "--no-floppy" + "--boot-directory" "/fs/boot" + "/dev/vda")) + (zero? + (system* umount "/fs")) + (reboot)))))))) #:system system #:inputs `(("parted" ,parted) ("grub" ,grub) ("e2fsprogs" ,e2fsprogs) ("linux" ,linux-libre) - ("initrd" ,qemu-initrd) + ("initrd" ,initrd) + + ,@(if loader + `(("loader" ,loader)) + '()) ;; For shell scripts. ("sed" ,(car (assoc-ref %final-inputs "sed"))) @@ -253,9 +329,13 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { ("coreutils" ,(car (assoc-ref %final-inputs "coreutils"))) ("findutils" ,(car (assoc-ref %final-inputs "findutils"))) ("gawk" ,(car (assoc-ref %final-inputs "gawk"))) - ("util-linux" ,util-linux)) + ("util-linux" ,util-linux) + + ,@inputs-to-copy) #:make-disk-image? #t - #:disk-image-size disk-image-size)) + #:disk-image-size disk-image-size + #:references-graphs (map input->name+derivation inputs-to-copy) + #:modules '((guix build utils)))) ;;; @@ -286,7 +366,13 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { (set! store (open-connection))) (lambda () (parameterize ((%guile-for-build (package-derivation store guile-final))) - (qemu-image store #:disk-image-size (* 30 (expt 2 20))))) + (let* ((drv (package-derivation store shadow)) + (login (string-append (derivation-path->output-path drv) + "/bin/login"))) + (qemu-image store + #:boot-expression `(execl ,login "login" "tty1") + #:disk-image-size (* 400 (expt 2 20)) + #:inputs-to-copy `(("shadow" ,shadow)))))) (lambda () (close-connection store))))) -- cgit v1.2.3 From 77c7f8f41b558bab13690c843068af8ba996e5bf Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 1 Sep 2013 17:46:49 +0200 Subject: gnu: python: Temporarily make python 2 the default. * gnu/packages/python.scm (python-2): Rename this to... * gnu/packages/python.scm (python): ...this, rename this to... * gnu/packages/python.scm (python-3): ...this. Reverts to version 2 as the default input for packages requiring Python. --- gnu/packages/python.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 0a3977aabb..493068adde 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-2 +(define-public python (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 - (package (inherit python-2) +(define-public python-3 + (package (inherit python) (version "3.3.2") (source (origin -- cgit v1.2.3 From abac80c0fdcfdd4be1bd3e013c34a443ad7ddfa3 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 1 Sep 2013 18:13:48 +0200 Subject: gnu: Update harfbuzz to 0.9.20. * gnu/packages/gtk.scm (harfbuzz): Update to 0.9.20. --- gnu/packages/gtk.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/gtk.scm b/gnu/packages/gtk.scm index 102cb8ea2f..51c44b62ab 100644 --- a/gnu/packages/gtk.scm +++ b/gnu/packages/gtk.scm @@ -110,14 +110,14 @@ affine transformation (scale, rotation, shear, etc.)") (define-public harfbuzz (package (name "harfbuzz") - (version "0.9.19") + (version "0.9.20") (source (origin (method url-fetch) (uri (string-append "http://www.freedesktop.org/software/harfbuzz/release/harfbuzz-" version ".tar.bz2")) (sha256 (base32 - "0d9g02m5n28lp1bfkl8wxblfmfd43yr1ny68x2fsvxj71l30znnj")))) + "0rxwvd8j4vcadlhx4a7la33clzggxziblx1k43ccbw5w7yh4yf43")))) (build-system gnu-build-system) (inputs `(("cairo" ,cairo) -- cgit v1.2.3 From c3f3e150c44a997c487cde1827ef81c706c4691a Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 1 Sep 2013 18:21:08 +0200 Subject: gnu: cairo: Update to 1.12.16. * gnu/packages/gtk.scm (cairo): Update to 1.12.16. --- gnu/packages/gtk.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/gtk.scm b/gnu/packages/gtk.scm index 51c44b62ab..742cbf172e 100644 --- a/gnu/packages/gtk.scm +++ b/gnu/packages/gtk.scm @@ -60,14 +60,14 @@ tools have full access to view and control running applications.") (define-public cairo (package (name "cairo") - (version "1.12.14") + (version "1.12.16") (source (origin (method url-fetch) (uri (string-append "http://cairographics.org/releases/cairo-" version ".tar.xz")) (sha256 (base32 - "04xcykglff58ygs0dkrmmnqljmpjwp2qgwcz8sijqkdpz7ix3l4n")))) + "0inqwsylqkrzcjivdirkjx5nhdgxbdc62fq284c3xppinfg9a195")))) (build-system gnu-build-system) (propagated-inputs `(("fontconfig" ,fontconfig) -- cgit v1.2.3 From d9ff410fb279571826748dac51adc00379968bbc Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 1 Sep 2013 21:56:57 +0200 Subject: gnu: Add git. * gnu/packages/version-control.scm (git): New variable. --- gnu/packages/version-control.scm | 48 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 47 insertions(+), 1 deletion(-) (limited to 'gnu') diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 5059dcd5e1..14404f0bfe 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2013 Cyril Roelandt ;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013 Andreas Enge ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,7 +20,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu packages version-control) - #:use-module ((guix licenses) #:select (asl2.0 gpl1+ gpl2+ gpl3+)) + #:use-module ((guix licenses) #:select (asl2.0 gpl1+ gpl2 gpl2+ gpl3+)) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) @@ -28,11 +29,14 @@ #:use-module ((gnu packages gettext) #:renamer (symbol-prefix-proc 'guix:)) #:use-module (gnu packages apr) + #:use-module (gnu packages curl) #:use-module (gnu packages nano) + #:use-module (gnu packages openssl) #:use-module (gnu packages perl) #:use-module (gnu packages python) #:use-module (gnu packages sqlite) #:use-module (gnu packages system) + #:use-module (gnu packages xml) #:use-module (gnu packages emacs) #:use-module (gnu packages compression)) @@ -64,6 +68,48 @@ organize their workspace in whichever way they want. It is possible to work from a command line or use a GUI application.") (license gpl2+))) +(define-public git + (package + (name "git") + (version "1.8.4") + (source (origin + (method url-fetch) + (uri (string-append "http://git-core.googlecode.com/files/git-" + version ".tar.gz")) + (sha256 + (base32 + "156bwqqgaw65rsvbb4wih5jfg94bxyf6p16mdwf0ky3f4ln55s2i")))) + (build-system gnu-build-system) + (inputs + `(("curl" ,curl) + ("expat" ,expat) + ("gettext" ,guix:gettext) + ("openssl" ,openssl) + ("perl" ,perl) + ("python" ,python) ; CAVEAT: incompatible with python-3 according to INSTALL + ("zlib" ,zlib))) + (arguments + `(#:make-flags `("V=1") ; more verbose compilation + #:test-target "test" + #:tests? #f ; FIXME: Many tests are failing + #:phases + (alist-replace + 'configure + (lambda* (#:key #:allow-other-keys #:rest args) + (let ((configure (assoc-ref %standard-phases 'configure))) + (and (apply configure args) + (substitute* "Makefile" + (("/bin/sh") (which "sh")) + (("/usr/bin/perl") (which "perl")) + (("/usr/bin/python") (which "python")))))) + %standard-phases))) + (synopsis "Distributed version control system") + (description + "Git is a free distributed version control system designed to handle +everything from small to very large projects with speed and efficiency.") + (license gpl2) + (home-page "http://git-scm.com/"))) + (define-public subversion (package (name "subversion") -- cgit v1.2.3 From d91712ee894e3bcaabc51269d292cbe77ed89530 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 1 Sep 2013 23:13:56 +0200 Subject: gnu: linux-initrd: Factorize device node creation. * guix/build/linux-initrd.scm (make-essential-device-nodes): New procedure. * gnu/packages/linux-initrd.scm (qemu-initrd): Use it. --- gnu/packages/linux-initrd.scm | 9 +++------ guix/build/linux-initrd.scm | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+), 6 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm index 17f42652e8..4a4e437635 100644 --- a/gnu/packages/linux-initrd.scm +++ b/gnu/packages/linux-initrd.scm @@ -270,10 +270,8 @@ the Linux kernel.") (unless (configure-qemu-networking) (display "network interface is DOWN\n")) - ;; Make the device nodes for QEMU's hard disk and partitions. - (mknod "/dev/vda" 'block-special #o644 (device-number 8 0)) - (mknod "/dev/vda1" 'block-special #o644 (device-number 8 1)) - (mknod "/dev/vda2" 'block-special #o644 (device-number 8 2)) + ;; Make /dev nodes. + (make-essential-device-nodes) ;; Prepare the real root file system under /root. (unless (file-exists? "/root") @@ -287,8 +285,7 @@ the Linux kernel.") (mkdir-p "/root/nix/store") (mkdir "/root/dev") - (mknod "/root/dev/null" 'char-special #o666 (device-number 1 3)) - (mknod "/root/dev/zero" 'char-special #o666 (device-number 1 5)) + (make-essential-device-nodes #:root "/root/dev") ;; Mount the host's store and exchange directory. (mount-qemu-smb-share "/store" "/root/nix/store") diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index 81f9e46cfb..208ad711ef 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -21,6 +21,7 @@ #:use-module (system foreign) #:export (mount-essential-file-systems linux-command-line + make-essential-device-nodes configure-qemu-networking mount-qemu-smb-share bind-mount @@ -59,6 +60,37 @@ (call-with-input-file "/proc/cmdline" get-string-all))) +(define* (make-essential-device-nodes #:key (root "/")) + "Make essential device nodes under ROOT/dev." + ;; The hand-made udev! + + (define (scope dir) + (string-append root + (if (string-suffix? "/" root) + "" + "/") + dir)) + + (unless (file-exists? (scope "dev")) + (mkdir (scope "dev"))) + + ;; Make the device nodes for QEMU's hard disk and partitions. + (mknod (scope "dev/vda") 'block-special #o644 (device-number 8 0)) + (mknod (scope "dev/vda1") 'block-special #o644 (device-number 8 1)) + (mknod (scope "dev/vda2") 'block-special #o644 (device-number 8 2)) + + ;; TTYs. + (let loop ((n 0)) + (and (< n 50) + (let ((name (format #f "dev/tty~a" n))) + (mknod (scope name) 'block-special #o644 + (device-number 4 n)) + (loop (+ 1 n))))) + + ;; 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))) + (define %host-qemu-ipv4-address (inet-pton AF_INET "10.0.2.10")) -- cgit v1.2.3 From 1e151896d4fbd552a2e8dd66b16b7f746e0f6113 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 1 Sep 2013 23:13:00 +0200 Subject: gnu: Add mingetty. * gnu/packages/system.scm (mingetty): New variable. --- gnu/packages/system.scm | 50 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) (limited to 'gnu') diff --git a/gnu/packages/system.scm b/gnu/packages/system.scm index e326e498c5..47a57c54cc 100644 --- a/gnu/packages/system.scm +++ b/gnu/packages/system.scm @@ -141,3 +141,53 @@ login, passwd, su, groupadd, and useradd.") ;; The `vipw' program is GPLv2+. ;; libmisc/salt.c is public domain. (license bsd-3))) + +(define-public mingetty + (package + (name "mingetty") + (version "1.08") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/mingetty/mingetty-" + version ".tar.gz")) + (sha256 + (base32 + "05yxrp44ky2kg6qknk1ih0kvwkgbn9fbz77r3vci7agslh5wjm8g")))) + (build-system gnu-build-system) + (arguments + `(#:phases (alist-replace 'configure + (lambda* (#:key inputs outputs + #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (man8 (string-append + out "/share/man/man8")) + (sbin (string-append out "/sbin")) + (shadow (assoc-ref inputs "shadow")) + (login (string-append shadow + "/bin/login"))) + (substitute* "Makefile" + (("^SBINDIR.*") + (string-append "SBINDIR = " out + "/sbin\n")) + (("^MANDIR.*") + (string-append "MANDIR = " out + "/share/man/man8\n"))) + + ;; Pick the right 'login' by default. + (substitute* "mingetty.c" + (("\"/bin/login\"") + (string-append "\"" login "\""))) + + (mkdir-p sbin) + (mkdir-p man8))) + %standard-phases) + #:tests? #f)) ; no tests + (inputs `(("shadow" ,shadow))) + + (home-page "http://sourceforge.net/projects/mingetty") + (synopsis "Getty for the text console") + (description + "Small console getty that is started on the Linux text console, +asks for a login name and then transfers over to 'login'. It is extended to +allow automatic login and starting any app.") + (license gpl2+))) -- cgit v1.2.3 From 340c7033a89a81242f5e55e9fc1473a274dd9ad2 Mon Sep 17 00:00:00 2001 From: Cyril Roelandt Date: Fri, 30 Aug 2013 21:19:56 +0200 Subject: gnu: Add htop. * gnu/packages/system.scm (htop): New variable. --- gnu/packages/system.scm | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) (limited to 'gnu') diff --git a/gnu/packages/system.scm b/gnu/packages/system.scm index 47a57c54cc..2307393f85 100644 --- a/gnu/packages/system.scm +++ b/gnu/packages/system.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2013 Cyril Roelandt ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +26,27 @@ #:use-module (gnu packages ncurses) #:use-module (gnu packages linux)) +(define-public htop + (package + (name "htop") + (version "1.0.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/htop/" + version "/htop-" version ".tar.gz")) + (sha256 + (base32 + "18fqrhvnm7h4c3939av8lpiwrwxbyw6hcly0jvq0vkjf0ixnaq7f")))) + (build-system gnu-build-system) + (inputs + `(("ncurses" ,ncurses))) + (home-page "http://htop.sourceforge.net/") + (synopsis "Interactive process viewer") + (description + "This is htop, an interactive process viewer. It is a text-mode +application (for console or X terminals) and requires ncurses.") + (license gpl2))) + (define-public pies (package (name "pies") -- cgit v1.2.3 From fbc1a58f4071c8a3ce2ac781b7cd363b8d21a364 Mon Sep 17 00:00:00 2001 From: Cyril Roelandt Date: Sun, 1 Sep 2013 19:42:00 +0200 Subject: gnu: Add dfc. * gnu/packages/system.scm (dfc): New variable. --- gnu/packages/system.scm | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) (limited to 'gnu') diff --git a/gnu/packages/system.scm b/gnu/packages/system.scm index 2307393f85..7c733f9575 100644 --- a/gnu/packages/system.scm +++ b/gnu/packages/system.scm @@ -21,11 +21,34 @@ #:use-module (guix licenses) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix build-system cmake) #:use-module (guix build-system gnu) #:use-module (gnu packages) #:use-module (gnu packages ncurses) #:use-module (gnu packages linux)) +(define-public dfc + (package + (name "dfc") + (version "3.0.3") + (source + (origin + (method url-fetch) + (uri (string-append + "http://projects.gw-computing.net/attachments/download/78/dfc-" + version ".tar.gz")) + (sha256 + (base32 + "1b4hfqv23l87cb37fxwzfk2sgspkyxpr3ig2hsd23hr6mm982j7z")))) + (build-system cmake-build-system) + (arguments '(#:tests? #f)) ; There are no tests. + (home-page "http://projects.gw-computing.net/projects/dfc") + (synopsis "Display file system space usage using graphs and colors") + (description + "dfc (df color) is a modern version of df. It uses colors, draws pretty +graphs and can export its output to different formats.") + (license bsd-3))) + (define-public htop (package (name "htop") -- cgit v1.2.3 From 165fd9d5e628120a8355aec2d03f0b6f497d3db2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Sep 2013 22:27:23 +0200 Subject: gnu: lzo: Build the shared library. * gnu/packages/compression.scm (lzo): Build the shared library. --- gnu/packages/compression.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'gnu') diff --git a/gnu/packages/compression.scm b/gnu/packages/compression.scm index 9528cf3199..83ef7a86d8 100644 --- a/gnu/packages/compression.scm +++ b/gnu/packages/compression.scm @@ -189,6 +189,7 @@ than gzip and 15 % smaller output than bzip2.") (base32 "0wryshs446s7cclrbjykyj766znhcpnr7s3cxy33ybfn6vwfcygz")))) (build-system gnu-build-system) + (arguments '(#:configure-flags '("--enable-shared"))) (home-page "http://www.oberhumer.com/opensource/lzo") (synopsis "A data compresion library suitable for real-time data de-/compression") -- cgit v1.2.3 From 6c76c45145b63721947191f0eb741e0201f4ee30 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 4 Sep 2013 11:16:22 +0200 Subject: gnu: libdrm: Update to 2.4.46. * gnu/packages/xorg.scm (libdrm): Update to 2.4.46. --- gnu/packages/xorg.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm index 5f07401e98..73d329506f 100644 --- a/gnu/packages/xorg.scm +++ b/gnu/packages/xorg.scm @@ -100,7 +100,7 @@ rasterisation.") (define-public libdrm (package (name "libdrm") - (version "2.4.42") + (version "2.4.46") (source (origin (method url-fetch) @@ -110,7 +110,7 @@ rasterisation.") ".tar.bz2")) (sha256 (base32 - "1qbnpi64hyqzd650hj6jki1d50pzypdhj3rw9m3whwbqly110rz0")))) + "1wah4qmrrcv0gnx65lhrlxb6gprxch92wy8lhxv6102fml6k5krk")))) (build-system gnu-build-system) (inputs `(("libpciaccess" ,libpciaccess) -- cgit v1.2.3 From e911470857069b20c767d2a581b3ab640ac876db Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Wed, 4 Sep 2013 18:02:58 +0200 Subject: gnu: xorg: Update comment for mesa. * gnu/packages/xorg.scm (mesa): New compilation trial with 9.2. --- gnu/packages/xorg.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm index 73d329506f..98f104b0b6 100644 --- a/gnu/packages/xorg.scm +++ b/gnu/packages/xorg.scm @@ -4139,9 +4139,9 @@ tracking.") (define-public mesa (package (name "mesa") - ;; In newer versions (9.0.5 and 9.1 tested), "make" results in an + ;; In newer versions (9.0.5, 9.1 and 9.2 tested), "make" results in an ;; infinite configure loop, see - ;; https://bugs.freedesktop.org/show_bug.cgi?id=61527 + ;; https://bugs.freedesktop.org/show_bug.cgi?id=58812 (version "8.0.5") (source (origin -- cgit v1.2.3 From 7c1d8146a770d6b37b35cefc0ad8662f4c07df62 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 4 Sep 2013 23:21:37 +0200 Subject: gnu: vm: 'qemu-image' populates /dev on the target root file system. * gnu/system/vm.scm (qemu-image): Use (guix build linux-initrd). Remove 'mknod' calls; use 'make-essential-device-nodes' to populate /dev on the target image. * gnu/packages/linux-initrd.scm (qemu-initrd): When /root/dev exists, don't call 'make-essential-device-nodes'. --- gnu/packages/linux-initrd.scm | 5 +++-- gnu/system/vm.scm | 15 ++++++++------- 2 files changed, 11 insertions(+), 9 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm index 4a4e437635..ab8787f02c 100644 --- a/gnu/packages/linux-initrd.scm +++ b/gnu/packages/linux-initrd.scm @@ -284,8 +284,9 @@ the Linux kernel.") (mkdir "/root/xchg") (mkdir-p "/root/nix/store") - (mkdir "/root/dev") - (make-essential-device-nodes #:root "/root/dev") + (unless (file-exists? "/root/dev") + (mkdir "/root/dev") + (make-essential-device-nodes #:root "/root")) ;; Mount the host's store and exchange directory. (mount-qemu-smb-share "/store" "/root/nix/store") diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 3bc94f4575..596a697738 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -210,7 +210,8 @@ process." `(let () (use-modules (ice-9 rdelim) (srfi srfi-1) - (guix build utils)) + (guix build utils) + (guix build linux-initrd)) (let ((parted (string-append (assoc-ref %build-inputs "parted") "/sbin/parted")) @@ -223,9 +224,7 @@ process." (initrd (string-append (assoc-ref %build-inputs "initrd") "/initrd")) (linux (string-append (assoc-ref %build-inputs "linux") - "/bzImage")) - (makedev (lambda (major minor) - (+ (* major 256) minor)))) + "/bzImage"))) (define (read-reference-graph port) ;; Return a list of store paths from the reference graph at PORT. @@ -265,7 +264,6 @@ process." (assoc-ref %build-inputs "gawk") "/bin")) (display "creating partition table...\n") - (mknod "/dev/vda" 'block-special #o644 (makedev 8 0)) (and (zero? (system* parted "/dev/vda" "mklabel" "msdos" "mkpart" "primary" "ext2" "1MiB" ,(format #f "~aB" @@ -273,7 +271,6 @@ process." (* 5 (expt 2 20)))))) (begin (display "creating ext3 partition...\n") - (mknod "/dev/vda1" 'block-special #o644 (makedev 8 1)) (and (zero? (system* mkfs "-F" "/dev/vda1")) (begin (display "mounting partition...\n") @@ -291,6 +288,9 @@ process." thing))) (things-to-copy)) + ;; Populate /dev. + (make-essential-device-nodes #:root "/fs") + (call-with-output-file "/fs/boot/grub/grub.cfg" (lambda (p) (format p " @@ -335,7 +335,8 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { #:make-disk-image? #t #:disk-image-size disk-image-size #:references-graphs (map input->name+derivation inputs-to-copy) - #:modules '((guix build utils)))) + #:modules '((guix build utils) + (guix build linux-initrd)))) ;;; -- cgit v1.2.3 From 1b89a66e1badbb8a597db0529e468f9950119a30 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 5 Sep 2013 00:45:53 +0200 Subject: gnu: vm: First stab at building a populated QEMU image. * gnu/packages/linux-initrd.scm (gnu-system-initrd): New variable. * gnu/system/vm.scm (qemu-image): Add #:linux-arguments parameter. [input->name+derivation]: Add case for 'store-path?' items. Remove LOADER from `inputs'. --- gnu/packages/linux-initrd.scm | 66 +++++++++++++++++++++++++++++++++++++++++++ gnu/system/vm.scm | 61 ++++++++++++++++++++++++--------------- 2 files changed, 104 insertions(+), 23 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm index ab8787f02c..6dd2a10e53 100644 --- a/gnu/packages/linux-initrd.scm +++ b/gnu/packages/linux-initrd.scm @@ -332,4 +332,70 @@ the Linux kernel.") #:linux linux-libre #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko"))) +(define-public gnu-system-initrd + ;; Initrd for the GNU system itself, with nothing QEMU-specific. + (expression->initrd + '(begin + (use-modules (srfi srfi-1) + (srfi srfi-26) + (ice-9 match) + (guix build utils) + (guix build linux-initrd)) + + (display "Welcome, this is GNU's early boot Guile.\n") + (display "Use '--repl' for an initrd REPL.\n\n") + + (mount-essential-file-systems) + (let* ((args (linux-command-line)) + (option (lambda (opt) + (let ((opt (string-append opt "="))) + (and=> (find (cut string-prefix? opt <>) + args) + (lambda (arg) + (substring arg (+ 1 (string-index arg #\=)))))))) + (to-load (option "--load")) + (root (option "--root"))) + + (when (member "--repl" args) + ((@ (system repl repl) start-repl))) + + ;; Make /dev nodes. + (make-essential-device-nodes) + + ;; Prepare the real root file system under /root. + (unless (file-exists? "/root") + (mkdir "/root")) + (if root + ;; Assume ROOT has a usable /dev tree. + (mount root "/root" "ext3") + (begin + (mount "none" "/root" "tmpfs") + (make-essential-device-nodes #:root "/root"))) + + (mount-essential-file-systems #:root "/root") + + ;; XXX: We don't copy our fellow Guile modules to /root (see + ;; 'qemu-initrd'), so if TO-LOAD tries to load a module (which can + ;; happen if it throws, to display the exception!), then we're + ;; screwed. Hopefully TO-LOAD is a simple expression that just does + ;; '(execlp ...)'. + + (if to-load + (begin + (format #t "loading '~a'...\n" to-load) + (chroot "/root") + (primitive-load to-load) + (format (current-error-port) + "boot program '~a' terminated, rebooting~%") + (sleep 2) + (reboot)) + (begin + (display "no init file passed via '--exec'\n") + (display "entering a warm and cozy REPL\n") + ((@ (system repl repl) start-repl)))))) + #:name "qemu-system-initrd" + #:modules '((guix build linux-initrd) + (guix build utils)) + #:linux linux-libre)) + ;;; linux-initrd.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 596a697738..86430ea168 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -21,7 +21,11 @@ #:use-module (guix store) #:use-module (guix derivations) #:use-module (guix packages) - #:use-module ((gnu packages base) #:select (%final-inputs guile-final)) + #:use-module ((gnu packages base) #:select (%final-inputs + guile-final + coreutils)) + #:use-module (gnu packages guile) + #:use-module (gnu packages bash) #:use-module (gnu packages qemu) #:use-module (gnu packages parted) #:use-module (gnu packages grub) @@ -30,7 +34,7 @@ #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) #:use-module ((gnu packages system) - #:select (shadow)) + #:select (mingetty)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) @@ -177,11 +181,14 @@ made available under the /xchg CIFS share." (system (%current-system)) (disk-image-size (* 100 (expt 2 20))) (linux linux-libre) + (linux-arguments '()) (initrd qemu-initrd) (inputs '()) (inputs-to-copy '()) (boot-expression #f)) - "Return a bootable, stand-alone QEMU image. + "Return a bootable, stand-alone QEMU image. The returned image is a full +disk image, with a GRUB installation whose default entry boots LINUX, with the +arguments LINUX-ARGUMENTS, and using INITRD as its initial RAM disk. INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied into the image being built. @@ -197,13 +204,9 @@ process." ((name (? package? package) sub-drv) `(,name . ,(derivation-path->output-path (package-derivation store package system) - sub-drv))))) - - (define loader - (and boot-expression - (add-text-to-store store "loader" - (object->string boot-expression) - '()))) + sub-drv))) + ((input (and (? string?) (? store-path?) file)) + `(,input . ,file)))) (expression->derivation-in-linux-vm store "qemu-image" @@ -299,12 +302,10 @@ set timeout=5 search.file /boot/bzImage menuentry \"Boot-to-Guile! (GNU System technology preview)\" { - linux /boot/bzImage --root=/dev/vda1 ~a + linux /boot/bzImage ~a initrd /boot/initrd }" - ,(if loader - (string-append "--load=" loader) - "")))) + ,(string-join linux-arguments)))) (and (zero? (system* grub "--no-floppy" "--boot-directory" "/fs/boot" @@ -319,10 +320,6 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { ("linux" ,linux-libre) ("initrd" ,initrd) - ,@(if loader - `(("loader" ,loader)) - '()) - ;; For shell scripts. ("sed" ,(car (assoc-ref %final-inputs "sed"))) ("grep" ,(car (assoc-ref %final-inputs "grep"))) @@ -367,13 +364,31 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { (set! store (open-connection))) (lambda () (parameterize ((%guile-for-build (package-derivation store guile-final))) - (let* ((drv (package-derivation store shadow)) - (login (string-append (derivation-path->output-path drv) - "/bin/login"))) + (let* ((out (derivation-path->output-path + (package-derivation store mingetty))) + (getty (string-append out "/sbin/mingetty")) + (boot (add-text-to-store store "boot" + (object->string + `(begin + ;; Become the session leader, + ;; so that mingetty can do + ;; 'TIOCSCTTY'. + (setsid) + + ;; Directly into mingetty. + (execl ,getty "mingetty" + "--noclear" "tty1"))) + (list out)))) (qemu-image store - #:boot-expression `(execl ,login "login" "tty1") + #:initrd gnu-system-initrd + #:linux-arguments `("--root=/dev/vda1" + ,(string-append "--load=" boot)) #:disk-image-size (* 400 (expt 2 20)) - #:inputs-to-copy `(("shadow" ,shadow)))))) + #:inputs-to-copy `(("boot" ,boot) + ("coreutils" ,coreutils) + ("bash" ,bash) + ("guile" ,guile-2.0) + ("mingetty" ,mingetty)))))) (lambda () (close-connection store))))) -- cgit v1.2.3 From 002e5ba887837fd353c38eca64596859570ad820 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 5 Sep 2013 22:14:21 +0200 Subject: gnu: vm: Remove unused 'qemu-image' argument. * gnu/system/vm.scm (qemu-image): Remove 'boot-expression' parameter, superseded by 'linux-arguments'. --- gnu/system/vm.scm | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) (limited to 'gnu') diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 86430ea168..952cbe45ba 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -184,18 +184,13 @@ made available under the /xchg CIFS share." (linux-arguments '()) (initrd qemu-initrd) (inputs '()) - (inputs-to-copy '()) - (boot-expression #f)) + (inputs-to-copy '())) "Return a bootable, stand-alone QEMU image. The returned image is a full disk image, with a GRUB installation whose default entry boots LINUX, with the arguments LINUX-ARGUMENTS, and using INITRD as its initial RAM disk. INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied -into the image being built. - -When BOOT-EXPRESSION is true, it is an expression to evaluate when the basic -initialization is done. A typical example is `(execl ...)' to launch the init -process." +into the image being built." (define input->name+derivation (match-lambda ((name (? package? package)) -- cgit v1.2.3 From 785859d306eaffcb3488f2d23e4d6c9e4f5db3a5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 5 Sep 2013 23:57:40 +0200 Subject: gnu: vm: Add /etc/shadow in the QEMU image. * gnu/system/vm.scm (qemu-image): Add 'populate' keyword parameter and honor it; make it an input. (/etc/shadow): New procedure. (example2): Call it; build 'populate' script, and pass it to 'qemu-image'. --- gnu/system/vm.scm | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 53 insertions(+), 3 deletions(-) (limited to 'gnu') diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 952cbe45ba..28ab4663b3 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -183,6 +183,7 @@ made available under the /xchg CIFS share." (linux linux-libre) (linux-arguments '()) (initrd qemu-initrd) + (populate #f) (inputs '()) (inputs-to-copy '())) "Return a bootable, stand-alone QEMU image. The returned image is a full @@ -190,7 +191,11 @@ disk image, with a GRUB installation whose default entry boots LINUX, with the arguments LINUX-ARGUMENTS, and using INITRD as its initial RAM disk. INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied -into the image being built." +into the image being built. + +When POPULATE is true, it must be the store file name of a Guile script to run +in the disk image partition once it has been populated with INPUTS-TO-COPY. +It can be used to provide additional files, such as /etc files." (define input->name+derivation (match-lambda ((name (? package? package)) @@ -289,6 +294,13 @@ into the image being built." ;; Populate /dev. (make-essential-device-nodes #:root "/fs") + (and=> (assoc-ref %build-inputs "populate") + (lambda (populate) + (chdir "/fs") + (primitive-load populate) + (chdir "/"))) + + ;; TODO: Move to a GRUB menu builder. (call-with-output-file "/fs/boot/grub/grub.cfg" (lambda (p) (format p " @@ -323,6 +335,10 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { ("gawk" ,(car (assoc-ref %final-inputs "gawk"))) ("util-linux" ,util-linux) + ,@(if populate + `(("populate" ,populate)) + '()) + ,@inputs-to-copy) #:make-disk-image? #t #:disk-image-size disk-image-size @@ -352,6 +368,23 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { (lambda () (close-connection store))))) +(define (/etc/shadow store accounts) + "Return a /etc/shadow file for ACCOUNTS." + (define contents + (let loop ((accounts accounts) + (result '())) + (match accounts + (((name uid gid comment home-dir shell) rest ...) + (loop rest + (cons (string-append name "::" (number->string uid) + ":" (number->string gid) + comment ":" home-dir ":" shell) + result))) + (() + (string-concatenate-reverse result))))) + + (add-text-to-store store "shadow" contents '())) + (define (example2) (let ((store #f)) (dynamic-wind @@ -359,7 +392,21 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { (set! store (open-connection))) (lambda () (parameterize ((%guile-for-build (package-derivation store guile-final))) - (let* ((out (derivation-path->output-path + (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)))) + (populate + (add-text-to-store store "populate-qemu-image" + (object->string + `(begin + (mkdir-p "etc") + (symlink ,(substring passwd 1) + "etc/shadow"))) + (list passwd))) + (out (derivation-path->output-path (package-derivation store mingetty))) (getty (string-append out "/sbin/mingetty")) (boot (add-text-to-store store "boot" @@ -375,6 +422,7 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { "--noclear" "tty1"))) (list out)))) (qemu-image store + #:populate populate #:initrd gnu-system-initrd #:linux-arguments `("--root=/dev/vda1" ,(string-append "--load=" boot)) @@ -383,7 +431,9 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { ("coreutils" ,coreutils) ("bash" ,bash) ("guile" ,guile-2.0) - ("mingetty" ,mingetty)))))) + ("mingetty" ,mingetty) + + ("shadow" ,passwd)))))) (lambda () (close-connection store))))) -- cgit v1.2.3 From 20a26ff546a5b200785f84eb361d1db271edd0f4 Mon Sep 17 00:00:00 2001 From: Cyril Roelandt Date: Wed, 4 Sep 2013 19:21:38 +0200 Subject: gnu: Add itstool. * gnu/packages/glib.scm (itstool): New variable. --- gnu/packages/glib.scm | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) (limited to 'gnu') diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm index 63751bb510..c95ecb5672 100644 --- a/gnu/packages/glib.scm +++ b/gnu/packages/glib.scm @@ -186,6 +186,40 @@ 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 + (package + (name "itstool") + (version "1.2.0") + (source (origin + (method url-fetch) + (uri (string-append "http://files.itstool.org/itstool/itstool-" + version ".tar.bz2")) + (sha256 + (base32 + "1akq75aflihm3y7js8biy7b5mw2g11vl8yq90gydnwlwp0zxdzj6")))) + (build-system gnu-build-system) + (home-page "http://www.itstool.org") + (synopsis "Tool to translate XML documents with PO files") + (description + "ITS Tool allows you to translate your XML documents with PO files, using +rules from the W3C Internationalization Tag Set (ITS) to determine what to +translate and how to separate it into PO file messages. + +PO files are the standard translation format for GNU and other Unix-like +systems. They present translatable information as discrete messages, allowing +each message to be translated independently. In contrast to whole-page +translation, translating with a message-based format like PO means you can +easily track changes to the source document down to the paragraph. When new +strings are added or existing strings are modified, you only need to update the +corresponding messages. + +ITS Tool is designed to make XML documents translatable through PO files by +applying standard ITS rules, as well as extension rules specific to ITS Tool. +ITS also provides an industry standard way for authors to override translation +information in their documents, such as whether a particular element should be +translated.") + (license gpl3+))) + (define-public dbus-glib (package (name "dbus-glib") -- cgit v1.2.3 From a129e0d877f125693f58457d55973d184468b461 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Sat, 7 Sep 2013 07:44:57 +0000 Subject: gnu: Add the 'license:' prefix. * gnu/packages/glib.scm (itstool): Change 'gpl3+' to 'license:gpl3+'. --- gnu/packages/glib.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu') diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm index c95ecb5672..fee834f9f9 100644 --- a/gnu/packages/glib.scm +++ b/gnu/packages/glib.scm @@ -218,7 +218,7 @@ applying standard ITS rules, as well as extension rules specific to ITS Tool. ITS also provides an industry standard way for authors to override translation information in their documents, such as whether a particular element should be translated.") - (license gpl3+))) + (license license:gpl3+))) (define-public dbus-glib (package -- cgit v1.2.3 From 0e2ddecd8e9a0f2dc856f2a2da9a9c98688d195c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 7 Sep 2013 17:23:23 +0200 Subject: gnu: grub: Add support for building configuration files. * gnu/packages/grub.scm (): New record type. (grub-configuration-file): New procedure. * gnu/system/vm.scm (qemu-image): Remove parameters 'linux', 'linux-arguments', and 'initrd'. Add 'grub-configuration' parameter. Honor them, and remove grub.cfg generation code accordingly. (example2): Use `grub-configuration-file', and adjust accordingly. --- gnu/packages/grub.scm | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++- gnu/system/vm.scm | 52 ++++++++++++++++-------------------------- 2 files changed, 80 insertions(+), 34 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/grub.scm b/gnu/packages/grub.scm index 8c981bf88d..71c4fad781 100644 --- a/gnu/packages/grub.scm +++ b/gnu/packages/grub.scm @@ -19,6 +19,9 @@ (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) @@ -30,7 +33,11 @@ #:use-module (gnu packages qemu) #:use-module (gnu packages ncurses) #:use-module (gnu packages cdrom) - #:use-module (srfi srfi-1)) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:export (menu-entry + menu-entry? + grub-configuration-file)) (define qemu-for-tests ;; Newer QEMU versions, such as 1.5.1, no longer support the 'shutdown' @@ -110,3 +117,56 @@ 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/system/vm.scm b/gnu/system/vm.scm index 28ab4663b3..73543896ef 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -180,15 +180,13 @@ made available under the /xchg CIFS share." (name "qemu-image") (system (%current-system)) (disk-image-size (* 100 (expt 2 20))) - (linux linux-libre) - (linux-arguments '()) - (initrd qemu-initrd) + grub-configuration (populate #f) (inputs '()) (inputs-to-copy '())) "Return a bootable, stand-alone QEMU image. The returned image is a full -disk image, with a GRUB installation whose default entry boots LINUX, with the -arguments LINUX-ARGUMENTS, and using INITRD as its initial RAM disk. +disk image, with a GRUB installation that uses GRUB-CONFIGURATION as its +configuration file. INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied into the image being built. @@ -224,10 +222,7 @@ It can be used to provide additional files, such as /etc files." "/sbin/grub-install")) (umount (string-append (assoc-ref %build-inputs "util-linux") "/bin/umount")) ; XXX: add to Guile - (initrd (string-append (assoc-ref %build-inputs "initrd") - "/initrd")) - (linux (string-append (assoc-ref %build-inputs "linux") - "/bzImage"))) + (grub.cfg (assoc-ref %build-inputs "grub.cfg"))) (define (read-reference-graph port) ;; Return a list of store paths from the reference graph at PORT. @@ -280,8 +275,7 @@ It can be used to provide additional files, such as /etc files." (mkdir "/fs") (mount "/dev/vda1" "/fs" "ext3") (mkdir-p "/fs/boot/grub") - (copy-file linux "/fs/boot/bzImage") - (copy-file initrd "/fs/boot/initrd") + (symlink grub.cfg "/fs/boot/grub/grub.cfg") ;; Populate the image's store. (mkdir-p (string-append "/fs" ,%store-directory)) @@ -289,7 +283,7 @@ It can be used to provide additional files, such as /etc files." (copy-recursively thing (string-append "/fs" thing))) - (things-to-copy)) + (cons grub.cfg (things-to-copy))) ;; Populate /dev. (make-essential-device-nodes #:root "/fs") @@ -300,32 +294,17 @@ It can be used to provide additional files, such as /etc files." (primitive-load populate) (chdir "/"))) - ;; TODO: Move to a GRUB menu builder. - (call-with-output-file "/fs/boot/grub/grub.cfg" - (lambda (p) - (format p " -set default=1 -set timeout=5 -search.file /boot/bzImage - -menuentry \"Boot-to-Guile! (GNU System technology preview)\" { - linux /boot/bzImage ~a - initrd /boot/initrd -}" - ,(string-join linux-arguments)))) (and (zero? (system* grub "--no-floppy" "--boot-directory" "/fs/boot" "/dev/vda")) - (zero? - (system* umount "/fs")) + (zero? (system* umount "/fs")) (reboot)))))))) #:system system #:inputs `(("parted" ,parted) ("grub" ,grub) ("e2fsprogs" ,e2fsprogs) - ("linux" ,linux-libre) - ("initrd" ,initrd) + ("grub.cfg" ,grub-configuration) ;; For shell scripts. ("sed" ,(car (assoc-ref %final-inputs "sed"))) @@ -420,14 +399,21 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" { ;; Directly into mingetty. (execl ,getty "mingetty" "--noclear" "tty1"))) - (list out)))) + (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))) (qemu-image store + #:grub-configuration grub.cfg #:populate populate - #:initrd gnu-system-initrd - #:linux-arguments `("--root=/dev/vda1" - ,(string-append "--load=" boot)) #: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) -- cgit v1.2.3 From e7b385008ca0f0817c3514357cf53151cea0f511 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 8 Sep 2013 01:30:54 +0200 Subject: gnu: linux-libre: Upgrade to 3.11. * gnu/packages/linux.scm (linux-libre): Upgrade to 3.11. Add bc as an input. --- gnu/packages/linux.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index e434de477e..b5ed92e198 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -29,6 +29,7 @@ #:use-module (gnu packages bdb) #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) + #:use-module (gnu packages algebra) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu)) @@ -146,7 +147,7 @@ (license gpl2+))) (define-public linux-libre - (let* ((version* "3.3.8") + (let* ((version* "3.11") (build-phase '(lambda* (#:key system #:allow-other-keys #:rest args) (let ((arch (car (string-split system #\-)))) @@ -192,9 +193,10 @@ (uri (linux-libre-urls version)) (sha256 (base32 - "0jkfh0z1s6izvdnc3njm39dhzp1cg8i06jv06izwqz9w9qsprvnl")))) + "1vlk04xkvyy1kc9zz556md173rn1qzlnvhz7c9sljv4bpk3mdspl")))) (build-system gnu-build-system) (native-inputs `(("perl" ,perl) + ("bc" ,bc) ("module-init-tools" ,module-init-tools))) (arguments `(#:modules ((guix build gnu-build-system) -- cgit v1.2.3