mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
Add supporting tools for the GNU Build System.
* guix/derivations.scm (build-expression->derivation): Add all of INPUTS
as inputs to the final derivation.
* guix/build/gnu-build-system.scm, guix/build/utils.scm,
guix/gnu-build-system.scm: New files.
* tests/builders.scm ("gnu-build"): New test.
This commit is contained in:
Ludovic Courtès
parent
bcdd83ec69
commit
c36db98c8e
5 changed files with 218 additions and 0 deletions
79
guix/build/gnu-build-system.scm
Normal file
79
guix/build/gnu-build-system.scm
Normal file
|
|
@ -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"))
|
||||
65
guix/build/utils.scm
Normal file
65
guix/build/utils.scm
Normal file
|
|
@ -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)))
|
||||
|
|
@ -482,6 +482,7 @@ (define %build-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)))
|
||||
|
|
|
|||
61
guix/gnu-build-system.scm
Normal file
61
guix/gnu-build-system.scm
Normal file
|
|
@ -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))))
|
||||
|
|
@ -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 @@ (define %store
|
|||
(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")
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue