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

Merge branch 'master' into nix-integration 

Conflicts:
	guix/store.scm
master
Ludovic Courtès 2012-12-09 23:54:37 +01:00
parent 4ce823c424 3259877d35
commit 4d152bf1d9
12 changed files with 570 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
AUTHORS
View File

@ -1 +1,11 @@
Ludovic Courtès <ludo@gnu.org>
GNU Guix is consists of Scheme code that implements the deployment model
of the Nix package management tool. In fact, it currently talks to a
build daemon whose code comes from Nix (see the manual for details.)
Nix was initially written by Eelco Dolstra; other people have been
contributing to it. See `nix/AUTHORS' for details.
GNU Guix was initiated by Ludovic Courtès <ludo@gnu.org>, but it would
not be what it is without the contributions of the following people:
Nikita Karetnikov <nikita@karetnikov.org>

5
Makefile.am
View File

@ -27,6 +27,8 @@ MODULES = \
guix/utils.scm \
guix/derivations.scm \
guix/download.scm \
guix/gnu-maintenance.scm \
guix/licenses.scm \
guix/build-system.scm \
guix/build-system/gnu.scm \
guix/build-system/trivial.scm \
@ -41,6 +43,8 @@ MODULES = \
guix/snix.scm \
guix.scm \
distro.scm \
distro/packages/acl.scm \
distro/packages/attr.scm \
distro/packages/autotools.scm \
distro/packages/base.scm \
distro/packages/bash.scm \
@ -172,6 +176,7 @@ TESTS = \
tests/build-utils.scm \
tests/packages.scm \
tests/snix.scm \
tests/store.scm \
tests/union.scm \
tests/guix-build.sh \
tests/guix-download.sh \

6
THANKS
View File

@ -1,3 +1,9 @@
A big thanks to Eelco Dolstra, who designed and implemented Nix.
Transposing functional programming discipline to package management
proved to be inspiring and fruitful.
Thanks to the following people who contributed to GNU Guix through
suggestions, bug reports, patches, or general infrastructure help:
Andreas Enge <andreas@enge.fr>
Jason Self <jself@gnu.org>

1
TODO
View File

@ -104,7 +104,6 @@ etc.
** add ‘--roll-back’
** add ‘--list-generations’, and ‘--delete-generations’
** add ‘--upgrade’
** add ‘--list-installed’ and ‘--list-available’
** add ‘--search’
* guix build utils

61
distro/packages/acl.scm Normal file
View File

@ -0,0 +1,61 @@
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
;;; Copyright (C) 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;;
;;; This file is part of Guix.
;;;
;;; 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.
;;;
;;; 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 Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (distro packages acl)
#:use-module (distro packages attr)
#:use-module (distro packages perl)
#:use-module ((distro packages gettext)
#:renamer (symbol-prefix-proc 'guix:))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
(define-public acl
(package
(name "acl")
(version "2.2.51")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://savannah/acl/acl-"
version ".src.tar.gz"))
(sha256
(base32
"09aj30m49ivycl3irram8c3givc0crivjm3ymw0nhfaxrwhlb186"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(alist-replace 'check
(lambda _
(patch-shebang "test/run")
(system* "make" "tests" "-C" "test")
;; XXX: Ignore the test result since this is
;; dependent on the underlying file system.
#t)
%standard-phases)))
(inputs `(("attr" ,attr)
("gettext" ,guix:gettext)
("perl" ,perl)))
(home-page
"http://savannah.nongnu.org/projects/acl")
(synopsis
"Library and tools for manipulating access control lists")
(description
"Library and tools for manipulating access control lists.")
(license '("GPLv2+" "LGPLv2.1+"))))

68
distro/packages/attr.scm Normal file
View File

@ -0,0 +1,68 @@
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
;;; Copyright (C) 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of Guix.
;;;
;;; 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.
;;;
;;; 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 Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (distro packages attr)
#:use-module (distro packages perl)
#:use-module ((distro packages gettext)
#:renamer (symbol-prefix-proc 'guix:))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu))
(define-public attr
(package
(name "attr")
(version "2.4.46")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://savannah/attr/attr-"
version ".src.tar.gz"))
(sha256
(base32
"07qf6kb2zk512az481bbnsk9jycn477xpva1a726n5pzlzf9pmnw"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(alist-replace 'install
(lambda _
(zero? (system* "make"
"install"
"install-lib"
"install-dev")))
(alist-replace 'check
(lambda _
(for-each patch-shebang
(find-files "test" ".*"))
(system* "make" "tests" "-C" "test")
;; XXX: Ignore the test result since
;; this is dependent on the underlying
;; file system.
#t)
%standard-phases))))
(inputs `(("perl" ,perl)
("gettext" ,guix:gettext)))
(home-page
"http://savannah.nongnu.org/projects/attr/")
(synopsis
"Library and tools for manipulating extended attributes")
(description
"Portable library and tools for manipulating extended attributes.")
(license '("GPLv2+" "LGPLv2.1+"))))

2
doc/guix.texi
View File

@ -210,7 +210,7 @@ want to roll back.
@table @code
@item --install=@var{package}
@itemx -x @var{package}
@itemx -i @var{package}
Install @var{package}.
@var{package} may specify either a simple package name, such as

2
guix/download.scm
View File

@ -65,7 +65,7 @@
"ftp://mirror.cict.fr/gnupg/"
"ftp://ftp.strasbourg.linuxfr.org/pub/gnupg/")
(savannah
"http://download.savannah.gnu.org/"
"http://download.savannah.gnu.org/releases/"
"ftp://ftp.twaren.net/Unix/NonGNU/"
"ftp://mirror.csclub.uwaterloo.ca/nongnu/"
"ftp://mirror.publicns.net/pub/nongnu/"

57
guix/gnu-maintenance.scm Normal file
View File

@ -0,0 +1,57 @@
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
;;; Copyright (C) 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of Guix.
;;;
;;; 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.
;;;
;;; 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 Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix gnu-maintenance)
#:use-module (web uri)
#:use-module (web client)
#:use-module (web response)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (official-gnu-packages))
(define (http-fetch uri)
"Return a string containing the textual data at URI, a string."
(let*-values (((resp data)
(http-get (string->uri uri)))
((code)
(response-code resp)))
(case code
((200)
data)
(else
(error "download failed:" uri code
(response-reason-phrase resp))))))
(define %package-list-url
(string-append "http://cvs.savannah.gnu.org/"
"viewvc/*checkout*/gnumaint/"
"gnupackages.txt?root=womb"))
(define (official-gnu-packages)
"Return a list of GNU packages."
(define %package-line-rx
(make-regexp "^package: (.+)$"))
(let ((lst (string-split (http-fetch %package-list-url) #\nl)))
(filter-map (lambda (line)
(and=> (regexp-exec %package-line-rx line)
(cut match:substring <> 1)))
lst)))

171
guix/licenses.scm Normal file
View File

@ -0,0 +1,171 @@
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
;;; Copyright (C) 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;;
;;; This file is part of Guix.
;;;
;;; 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.
;;;
;;; 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 Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix licenses)
#:use-module (srfi srfi-9)
#:export (license? license-name license-uri license-comment
asl2.0
boost1.0
bsd-2 bsd-3 bsd-4
cddl1.0
cpl1.0
epl1.0
gpl2 gpl2+ gpl3 gpl3+
ijg
ibmpl1.0
lgpl2.1 lgpl2.1+ lgpl3 lgpl3+
mpl2.0
openssl
public-domain
x11
zlib))
(define-record-type <license>
(license name uri comment)
license?
(name license-name)
(uri license-uri)
(comment license-comment))
;;; Commentary:
;;;
;;; Available licenses.
;;;
;;; This list is based on these links:
;;; https://github.com/NixOS/nixpkgs/blob/master/pkgs/lib/licenses.nix
;;; https://www.gnu.org/licenses/license-list
;;;
;;; Code:
(define asl2.0
(license "ASL 2.0"
"http://directory.fsf.org/wiki/License:Apache2.0"
"https://www.gnu.org/licenses/license-list#apache2"))
(define boost1.0
(license "Boost 1.0"
"http://directory.fsf.org/wiki/License:Boost1.0"
"https://www.gnu.org/licenses/license-list#boost"))
(define bsd-2
(license "FreeBSD"
"http://directory.fsf.org/wiki/License:FreeBSD"
"https://www.gnu.org/licenses/license-list#FreeBSD"))
(define bsd-3
(license "Modified BSD"
"http://directory.fsf.org/wiki/License:BSD_3Clause"
"https://www.gnu.org/licenses/license-list#ModifiedBSD"))
(define bsd-4
(license "Original BSD"
"http://directory.fsf.org/wiki/License:BSD_4Clause"
"https://www.gnu.org/licenses/license-list#OriginalBSD"))
(define cddl1.0
(license "CDDL 1.0"
"http://directory.fsf.org/wiki/License:CDDLv1.0"
"https://www.gnu.org/licenses/license-list#CDDL"))
(define cpl1.0
(license "CPL 1.0"
"http://directory.fsf.org/wiki/License:CPLv1.0"
"https://www.gnu.org/licenses/license-list#CommonPublicLicense10"))
(define epl1.0
(license "EPL 1.0"
"http://directory.fsf.org/wiki/License:EPLv1.0"
"https://www.gnu.org/licenses/license-list#EPL"))
(define gpl2
(license "GPL 2"
"https://www.gnu.org/licenses/old-licenses/gpl-2.0.html"
"https://www.gnu.org/licenses/license-list#GPLv2"))
(define gpl2+
(license "GPL 2+"
"https://www.gnu.org/licenses/old-licenses/gpl-2.0.html"
"https://www.gnu.org/licenses/license-list#GPLv2"))
(define gpl3
(license "GPL 3"
"https://www.gnu.org/licenses/gpl.html"
"https://www.gnu.org/licenses/license-list#GNUGPLv3"))
(define gpl3+
(license "GPL 3+"
"https://www.gnu.org/licenses/gpl.html"
"https://www.gnu.org/licenses/license-list#GNUGPLv3"))
(define ijg
(license "IJG"
"http://directory.fsf.org/wiki/License:JPEG"
"https://www.gnu.org/licenses/license-list#ijg"))
(define ibmpl1.0
(license "IBMPL 1.0"
"http://directory.fsf.org/wiki/License:IBMPLv1.0"
"https://www.gnu.org/licenses/license-list#IBMPL"))
(define lgpl2.1
(license "LGPL 2.1"
"https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html"
"https://www.gnu.org/licenses/license-list#LGPLv2.1"))
(define lgpl2.1+
(license "LGPL 2.1+"
"https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html"
"https://www.gnu.org/licenses/license-list#LGPLv2.1"))
(define lgpl3
(license "LGPL 3"
"https://www.gnu.org/licenses/lgpl.html"
"https://www.gnu.org/licenses/license-list#LGPLv3"))
(define lgpl3+
(license "LGPL 3+"
"https://www.gnu.org/licenses/lgpl.html"
"https://www.gnu.org/licenses/license-list#LGPLv3"))
(define mpl2.0
(license "MPL 2.0"
"http://directory.fsf.org/wiki/License:MPLv2.0"
"https://www.gnu.org/licenses/license-list#MPL-2.0"))
(define openssl
(license "OpenSSL"
"http://directory.fsf.org/wiki/License:OpenSSL"
"https://www.gnu.org/licenses/license-list#OpenSSL"))
(define public-domain
(license "Public Domain"
"http://directory.fsf.org/wiki/License:PublicDomain"
"https://www.gnu.org/licenses/license-list#PublicDomain"))
(define x11
(license "X11"
"http://directory.fsf.org/wiki/License:X11"
"https://www.gnu.org/licenses/license-list#X11License"))
(define zlib
(license "Zlib"
"http://www.gzip.org/zlib/zlib_license.html"
"https://www.gnu.org/licenses/license-list#ZLib"))
;;; licenses.scm ends here

106
guix/store.scm
View File

@ -51,8 +51,14 @@
add-text-to-store
add-to-store
build-derivations
add-temp-root
add-indirect-root
live-paths
dead-paths
collect-garbage
delete-paths
current-build-output-port
%store-prefix
@ -112,6 +118,13 @@
(sha1 2)
(sha256 3))
(define-enumerate-type gc-action
;; store-api.hh
(return-live 0)
(return-dead 1)
(delete-dead 2)
(delete-specific 3))
(define %default-socket-path
(string-append (or (getenv "NIX_STATE_DIR") %state-directory)
"/daemon-socket/socket"))
@ -133,6 +146,10 @@
(bytevector-u64-set! b 0 n (endianness little))
(put-bytevector p b)))
(define (read-long-long p)
(let ((b (get-bytevector-n p 8)))
(bytevector-u64-ref b 0 (endianness little))))
(define write-padding
(let ((zero (make-bytevector 8 0)))
(lambda (n p)
@ -159,9 +176,23 @@
(write-int (length l) p)
(for-each (cut write-string <> p) l))
(define (read-string-list p)
(let ((len (read-int p)))
(unfold (cut >= <> len)
(lambda (i)
(read-string p))
1+
0)))
(define (write-store-path f p)
(write-string f p)) ; TODO: assert path
(define (read-store-path p)
(read-string p)) ; TODO: assert path
(define write-store-path-list write-string-list)
(define read-store-path-list read-string-list)
(define (write-contents file p)
"Write the contents of FILE to output port P."
(define (dump in size)
@ -223,7 +254,8 @@
(write-string ")" p))))
(define-syntax write-arg
(syntax-rules (integer boolean file string string-list base16)
(syntax-rules (integer boolean file string string-list
store-path store-path-list base16)
((_ integer arg p)
(write-int arg p))
((_ boolean arg p)
@ -234,11 +266,15 @@
(write-string arg p))
((_ string-list arg p)
(write-string-list arg p))
((_ store-path arg p)
(write-store-path arg p))
((_ store-path-list arg p)
(write-store-path-list arg p))
((_ base16 arg p)
(write-string (bytevector->base16-string arg) p))))
(define-syntax read-arg
(syntax-rules (integer boolean string store-path base16)
(syntax-rules (integer boolean string store-path store-path-list base16)
((_ integer p)
(read-int p))
((_ boolean p)
@ -247,6 +283,8 @@
(read-string p))
((_ store-path p)
(read-store-path p))
((_ store-path-list p)
(read-store-path-list p))
((_ hash p)
(base16-string->bytevector (read-string p)))))
@ -385,7 +423,7 @@ again until #t is returned or an error is raised."
(define-syntax define-operation
(syntax-rules ()
((_ (name (type arg) ...) docstring return)
((_ (name (type arg) ...) docstring return ...)
(define (name server arg ...)
docstring
(let ((s (nix-server-socket server)))
@ -395,7 +433,7 @@ again until #t is returned or an error is raised."
;; Loop until the server is done sending error output.
(let loop ((done? (process-stderr server)))
(or done? (loop (process-stderr server))))
(read-arg return s))))))
(values (read-arg return s) ...))))))
(define-operation (valid-path? (string path))
"Return #t when PATH is a valid store path."
@ -424,6 +462,11 @@ FIXED? is for backward compatibility with old Nix versions and must be #t."
Return #t on success."
boolean)
(define-operation (add-temp-root (store-path path))
"Make PATH a temporary root for the duration of the current session.
Return #t."
boolean)
(define-operation (add-indirect-root (string file-name))
"Make FILE-NAME an indirect root for the garbage collector; FILE-NAME
can be anywhere on the file system, but it must be an absolute file
@ -431,6 +474,61 @@ name--it is the caller's responsibility to ensure that it is an absolute
file name. Return #t on success."
boolean)
(define (run-gc server action to-delete min-freed)
"Perform the garbage-collector operation ACTION, one of the
`gc-action' values. When ACTION is `delete-specific', the TO-DELETE is
the list of store paths to delete. IGNORE-LIVENESS? should always be
#f. MIN-FREED is the minimum amount of disk space to be freed, in
bytes, before the GC can stop. Return the list of store paths delete,
and the number of bytes freed."
(let ((s (nix-server-socket server)))
(write-int (operation-id collect-garbage) s)
(write-int action s)
(write-store-path-list to-delete s)
(write-arg boolean #f s) ; ignore-liveness?
(write-long-long min-freed s)
(write-int 0 s) ; obsolete
(when (>= (nix-server-minor-version server) 5)
;; Obsolete `use-atime' and `max-atime' parameters.
(write-int 0 s)
(write-int 0 s))
;; Loop until the server is done sending error output.
(let loop ((done? (process-stderr server)))
(or done? (loop (process-stderr server))))
(let ((paths (read-store-path-list s))
(freed (read-long-long s))
(obsolete (read-long-long s)))
(values paths freed))))
(define-syntax-rule (%long-long-max)
;; Maximum unsigned 64-bit integer.
(- (expt 2 64) 1))
(define (live-paths server)
"Return the list of live store paths---i.e., store paths still
referenced, and thus not subject to being garbage-collected."
(run-gc server (gc-action return-live) '() (%long-long-max)))
(define (dead-paths server)
"Return the list of dead store paths---i.e., store paths no longer
referenced, and thus subject to being garbage-collected."
(run-gc server (gc-action return-dead) '() (%long-long-max)))
(define* (collect-garbage server #:optional (min-freed (%long-long-max)))
"Collect garbage from the store at SERVER. If MIN-FREED is non-zero,
then collect at least MIN-FREED bytes. Return the paths that were
collected, and the number of bytes freed."
(run-gc server (gc-action delete-dead) '() min-freed))
(define* (delete-paths server paths #:optional (min-freed (%long-long-max)))
"Delete PATHS from the store at SERVER, if they are no longer
referenced. If MIN-FREED is non-zero, then stop after at least
MIN-FREED bytes have been collected. Return the paths that were
collected, and the number of bytes freed."
(run-gc server (gc-action delete-specific) paths min-freed))
;;;
;;; Store paths.

87
tests/store.scm Normal file
View File

@ -0,0 +1,87 @@
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of Guix.
;;;
;;; 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.
;;;
;;; 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 Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-store)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix base32)
#:use-module (distro packages bootstrap)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-64))
;; Test the (guix store) module.
(define %store
(false-if-exception (open-connection)))
(when %store
;; Make sure we build everything by ourselves.
(set-build-options %store #:use-substitutes? #f))
(define %seed
(seed->random-state (logxor (getpid) (car (gettimeofday)))))
(define (random-text)
(number->string (random (expt 2 256) %seed) 16))
(test-begin "store")
(test-skip (if %store 0 10))
(test-assert "dead-paths"
(let ((p (add-text-to-store %store "random-text"
(random-text) '())))
(member p (dead-paths %store))))
;; FIXME: Find a test for `live-paths'.
;;
;; (test-assert "temporary root is in live-paths"
;; (let* ((p1 (add-text-to-store %store "random-text"
;; (random-text) '()))
;; (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))))
;; (p2 (derivation-path->output-path d1)))
;; (and (add-temp-root %store p2)
;; (build-derivations %store (list d1))
;; (valid-path? %store p1)
;; (member (pk p2) (live-paths %store)))))
(test-assert "dead path can be explicitly collected"
(let ((p (add-text-to-store %store "random-text"
(random-text) '())))
(let-values (((paths freed) (delete-paths %store (list p))))
(and (equal? paths (list p))
(> freed 0)
(not (file-exists? p))))))
(test-end "store")
(exit (= (test-runner-fail-count (test-runner-current)) 0))
;;; Local Variables:
;;; eval: (put 'test-assert 'scheme-indent-function 1)
;;; End: