A guix/build/gnu-build-system.scm => guix/build/gnu-build-system.scm +79 -0
@@ 0,0 1,79 @@
+;;; 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 (guix build gnu-build-system)
+ #:use-module (guix build utils)
+ #:use-module (ice-9 ftw)
+ #:export (gnu-build))
+
+;; Commentary:
+;;
+;; Standard build procedure for packages using the GNU Build System or
+;; something compatible ("./configure && make && make install"). This is the
+;; builder-side code.
+;;
+;; Code:
+
+(define (first-subdirectory dir)
+ "Return the path of the first sub-directory of DIR."
+ (file-system-fold (lambda (path stat result)
+ (string=? path dir))
+ (lambda (path stat result) result) ; leaf
+ (lambda (path stat result) result) ; down
+ (lambda (path stat result) result) ; up
+ (lambda (path stat result) ; skip
+ (or result path))
+ (lambda (path stat errno result) ; error
+ (error "first-subdirectory" (strerror errno)))
+ #f
+ dir))
+
+(define (unpack source)
+ (system* "tar" "xvf" source)
+ (chdir (first-subdirectory ".")))
+
+(define (configure outputs flags)
+ (let ((prefix (assoc-ref outputs "out"))
+ (libdir (assoc-ref outputs "lib"))
+ (includedir (assoc-ref outputs "include")))
+ (apply system* "./configure"
+ "--enable-fast-install"
+ (string-append "--prefix=" prefix)
+ `(,@(if libdir
+ (list (string-append "--libdir=" libdir))
+ '())
+ ,@(if includedir
+ (list (string-append "--includedir=" includedir))
+ '())
+ ,@flags))))
+
+(define* (gnu-build source outputs inputs
+ #:key (configure-flags '()))
+ "Build from SOURCE to OUTPUTS, using INPUTS."
+ (let ((inputs (map cdr inputs)))
+ (set-path-environment-variable "PATH" '("bin") inputs)
+ (set-path-environment-variable "CPATH" '("include") inputs)
+ (set-path-environment-variable "LIBRARY_PATH" '("lib" "lib64") inputs))
+ (pk (getenv "PATH"))
+ (pk 'inputs inputs)
+ (system* "ls" "/nix/store")
+ (unpack source)
+ (configure outputs configure-flags)
+ (system* "make")
+ (system* "make" "check")
+ (system* "make" "install"))
A guix/build/utils.scm => guix/build/utils.scm +65 -0
@@ 0,0 1,65 @@
+;;; 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 (guix build utils)
+ #:use-module (srfi srfi-1)
+ #:export (directory-exists?
+ set-path-environment-variable))
+
+(define (directory-exists? dir)
+ "Return #t if DIR exists and is a directory."
+ (pk 'dir-exists? dir
+ (let ((s (pk 'stat dir (stat dir #f))))
+ (and s
+ (eq? 'directory (stat:type s))))))
+
+(define (search-path-as-list sub-directories input-dirs)
+ "Return the list of directories among SUB-DIRECTORIES that exist in
+INPUT-DIRS. Example:
+
+ (search-path-as-list '(\"share/emacs/site-lisp\" \"share/emacs/24.1\")
+ (list \"/package1\" \"/package2\" \"/package3\"))
+ => (\"/package1/share/emacs/site-lisp\"
+ \"/package3/share/emacs/site-lisp\")
+
+"
+ (append-map (lambda (input)
+ (filter-map (lambda (dir)
+ (let ((dir (string-append input "/"
+ dir)))
+ (and (directory-exists? dir)
+ dir)))
+ sub-directories))
+ input-dirs))
+
+(define (list->search-path-as-string lst separator)
+ (string-join lst separator))
+
+(define* (set-path-environment-variable env-var sub-directories input-dirs
+ #:key (separator ":"))
+ "Look for each of SUB-DIRECTORIES in INPUT-DIRS. Set ENV-VAR to a
+SEPARATOR-separated path accordingly. Example:
+
+ (set-path-environment-variable \"PKG_CONFIG\"
+ '(\"lib/pkgconfig\")
+ (list package1 package2))
+"
+ (setenv env-var
+ (list->search-path-as-string (search-path-as-list sub-directories
+ input-dirs)
+ separator)))
M guix/derivations.scm => guix/derivations.scm +1 -0
@@ 482,6 482,7 @@ INPUTS."
'(("HOME" . "/homeless"))
`((,(%guile-for-build))
(,builder)
+ ,@(map (compose list cdr) inputs)
,@(if mod-drv `((,mod-drv)) '()))
#:hash hash #:hash-algo hash-algo
#:outputs outputs)))
A guix/gnu-build-system.scm => guix/gnu-build-system.scm +61 -0
@@ 0,0 1,61 @@
+;;; 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 (guix gnu-build-system)
+ #:use-module (guix store)
+ #:use-module (guix utils)
+ #:use-module (guix derivations)
+ #:use-module (srfi srfi-1)
+ #:export (gnu-build))
+
+;; Commentary:
+;;
+;; Standard build procedure for packages using the GNU Build System or
+;; something compatible ("./configure && make && make install").
+;;
+;; Code:
+
+(define %standard-inputs
+ (map (lambda (name)
+ (cons name (nixpkgs-derivation name)))
+ '("gnutar" "gzip" "bzip2" "xz"
+ "coreutils" "gnused" "gnugrep" "bash"
+ "gcc" "binutils" "gnumake" "glibc")))
+
+(define* (gnu-build store name source inputs
+ #:key (outputs '("out")) (configure-flags '())
+ (system (%current-system)))
+ "Return a derivation called NAME that builds from tarball SOURCE, with
+input derivation INPUTS, using the usual procedure of the GNU Build System."
+ (define builder
+ `(begin
+ (use-modules (guix build gnu-build-system))
+ (gnu-build ,(if (derivation-path? source)
+ (derivation-path->output-path source)
+ source)
+ %outputs
+ %build-inputs
+ #:configure-flags ',configure-flags)))
+
+ (build-expression->derivation store name system
+ builder
+ (alist-cons "source" source
+ (append inputs %standard-inputs))
+ #:outputs outputs
+ #:modules '((guix build gnu-build-system)
+ (guix build utils))))
M tests/builders.scm => tests/builders.scm +12 -0
@@ 19,6 19,7 @@
(define-module (test-builders)
#:use-module (guix http)
+ #:use-module (guix gnu-build-system)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
@@ 40,6 41,17 @@
(and (build-derivations %store (list drv-path))
(file-exists? (derivation-path->output-path drv-path)))))
+(test-assert "gnu-build"
+ (let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")
+ (hash (nix-base32-string->bytevector
+ "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
+ (tarball (http-fetch %store url 'sha256 hash))
+ (build (gnu-build %store "hello-2.8" tarball
+ `(("gawk" . ,(nixpkgs-derivation "gawk"))))))
+ (and (build-derivations %store (list (pk 'hello-drv build)))
+ (file-exists? (string-append (derivation-path->output-path build)
+ "/bin/hello")))))
+
(test-end "builders")