From 205794c8684076696a3e474a6c9f6d53460b744d Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 9 Jun 2017 11:46:14 +0200 Subject: build-system: Add 'texlive-build-system'. * guix/build-system/texlive.scm: New file. * guix/build/texlive-build-system.scm: New file. * Makefile.am (MODULES): Add them. * doc/guix.texi (Build Systems): Document it. * gnu/packages/tex.scm (%texlive-tag, %texlive-revision): Remove variables. (texlife-ref): Remove procedure. --- guix/build/texlive-build-system.scm | 89 +++++++++++++++++++++++++++++++++++++ 1 file changed, 89 insertions(+) create mode 100644 guix/build/texlive-build-system.scm (limited to 'guix/build') diff --git a/guix/build/texlive-build-system.scm b/guix/build/texlive-build-system.scm new file mode 100644 index 0000000000..c1fd9fd9af --- /dev/null +++ b/guix/build/texlive-build-system.scm @@ -0,0 +1,89 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ricardo Wurmus +;;; +;;; 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 texlive-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (%standard-phases + texlive-build)) + +;; Commentary: +;; +;; Builder-side code of the standard build procedure for TeX Live packages. +;; +;; Code: + +(define (compile-with-latex format file) + (zero? (system* format + "-interaction=batchmode" + "-output-directory=build" + (string-append "&" format) + file))) + +(define* (build #:key inputs build-targets tex-format #:allow-other-keys) + ;; Find additional tex and sty files + (setenv "TEXINPUTS" + (string-append + (getcwd) ":" (getcwd) "/build:" + (string-join + (append-map (match-lambda + ((_ . dir) + (find-files dir + (lambda (_ stat) + (eq? 'directory (stat:type stat))) + #:directories? #t + #:stat stat))) + inputs) + ":"))) + (setenv "TEXFORMATS" + (string-append (assoc-ref inputs "texlive-latex-base") + "/share/texmf-dist/web2c/")) + (setenv "LUAINPUTS" + (string-append (assoc-ref inputs "texlive-latex-base") + "/share/texmf-dist/tex/latex/base/")) + (mkdir "build") + (every (cut compile-with-latex tex-format <>) + (if build-targets build-targets + (find-files "." "\\.ins$")))) + +(define* (install #:key outputs tex-directory #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (target (string-append + out "/share/texmf-dist/tex/" tex-directory))) + (mkdir-p target) + (for-each delete-file (find-files "." "\\.(log|aux)$")) + (for-each (cut install-file <> target) + (find-files "build" ".*")) + #t)) + +(define %standard-phases + (modify-phases gnu:%standard-phases + (delete 'configure) + (replace 'build build) + (delete 'check) + (replace 'install install))) + +(define* (texlive-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given TeX Live package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) + +;;; texlive-build-system.scm ends here -- cgit v1.2.3 From fa73c1937364872560c509f02b3d7648a5bed006 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 30 May 2017 12:03:54 +0200 Subject: syscalls: Add 'scandir*'. * guix/build/syscalls.scm (%struct-dirent-header): New C struct. (string->pointer/utf-8, pointer->string/utf-8): New procedures. (opendir*, closedir*, readdir*, scandir*): New procedures. * tests/syscalls.scm ("scandir*, ENOENT") ("scandir*, ASCII file names", "scandir*, UTF-8 file names") ("scandir*, properties): New tests. --- guix/build/syscalls.scm | 124 ++++++++++++++++++++++++++++++++++++++++++++++++ tests/syscalls.scm | 60 +++++++++++++++++++++++ 2 files changed, 184 insertions(+) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 2def2a108f..624941253a 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -28,6 +28,7 @@ #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 match) @@ -68,6 +69,7 @@ mkdtemp! fdatasync pivot-root + scandir* fcntl-flock set-thread-name @@ -817,6 +819,128 @@ system to PUT-OLD." (list new-root put-old (strerror err)) (list err))))))) + +;;; +;;; Opendir & co. +;;; + +(define-c-struct %struct-dirent-header + sizeof-dirent-header + (lambda (inode offset length type name) + ;; Convert TYPE to symbols like 'stat:type' does. + (let ((type (cond ((= type DT_REG) 'regular) + ((= type DT_LNK) 'symlink) + ((= type DT_DIR) 'directory) + ((= type DT_FIFO) 'fifo) + ((= type DT_CHR) 'char-special) + ((= type DT_BLK) 'block-special) + ((= type DT_SOCK) 'socket) + (else 'unknown)))) + `((type . ,type) + (inode . ,inode)))) + read-dirent-header + write-dirent-header! + (inode int64) + (offset int64) + (length unsigned-short) + (type uint8) + (name uint8)) ;first byte of 'd_name' + +;; Constants for the 'type' field, from . +(define DT_UNKNOWN 0) +(define DT_FIFO 1) +(define DT_CHR 2) +(define DT_DIR 4) +(define DT_BLK 6) +(define DT_REG 8) +(define DT_LNK 10) +(define DT_SOCK 12) +(define DT_WHT 14) + +(define string->pointer/utf-8 + (cut string->pointer <> "UTF-8")) + +(define pointer->string/utf-8 + (cut pointer->string <> <> "UTF-8")) + +(define opendir* + (let ((proc (syscall->procedure '* "opendir" '(*)))) + (lambda* (name #:optional (string->pointer string->pointer/utf-8)) + (let-values (((ptr err) + (proc (string->pointer name)))) + (if (null-pointer? ptr) + (throw 'system-error "opendir*" + "opendir*: ~A" + (list (strerror err)) + (list err)) + ptr))))) + +(define closedir* + (let ((proc (syscall->procedure int "closedir" '(*)))) + (lambda (directory) + (let-values (((ret err) + (proc directory))) + (unless (zero? ret) + (throw 'system-error "closedir" + "closedir: ~A" (list (strerror err)) + (list err))))))) + +(define readdir* + (let ((proc (syscall->procedure '* "readdir64" '(*)))) + (lambda* (directory #:optional (pointer->string pointer->string/utf-8)) + (let ((ptr (proc directory))) + (and (not (null-pointer? ptr)) + (cons (pointer->string + (make-pointer (+ (pointer-address ptr) + (c-struct-field-offset + %struct-dirent-header name))) + -1) + (read-dirent-header + (pointer->bytevector ptr sizeof-dirent-header)))))))) + +(define* (scandir* name #:optional + (select? (const #t)) + (entrypointer string->pointer/utf-8) + (pointer->string pointer->string/utf-8)) + "This procedure improves on Guile's 'scandir' procedure in several ways: + + 1. Systematically encode decode file names using STRING->POINTER and + POINTER->STRING (UTF-8 by default; this works around a defect in Guile 2.0/2.2 + where 'scandir' decodes file names according to the current locale, which is + not always desirable. + + 2. Each entry that is returned has the form (NAME . PROPERTIES). + PROPERTIES is an alist showing additional properties about the entry, as + found in 'struct dirent'. An entry may look like this: + + (\"foo.scm\" (type . regular) (inode . 123456)) + + Callers must be prepared to deal with the case where 'type' is 'unknown' + since some file systems do not provide that information. + + 3. Raise to 'system-error' when NAME cannot be opened." + (let ((directory (opendir* name string->pointer))) + (dynamic-wind + (const #t) + (lambda () + (let loop ((result '())) + (match (readdir* directory pointer->string) + (#f + (sort result entryprocedure int + (dynamic-func "creat" (dynamic-link)) + (list '* int)))) + (creat (string->pointer (string-append directory "/α") + "UTF-8") + #o644) + (creat (string->pointer (string-append directory "/λ") + "UTF-8") + #o644) + (let ((locale (setlocale LC_ALL))) + (dynamic-wind + (lambda () + ;; Make sure that even in a C locale we get the right result. + (setlocale LC_ALL "C")) + (lambda () + (match (scandir* directory) + (((names . properties) ...) + names))) + (lambda () + (setlocale LC_ALL locale)))))))) + +(test-assert "scandir*, properties" + (let ((directory (dirname (search-path %load-path "guix/base32.scm")))) + (every (lambda (entry name) + (match entry + ((name2 . properties) + (and (string=? name2 name) + (let* ((full (string-append directory "/" name)) + (stat (lstat full)) + (inode (assoc-ref properties 'inode)) + (type (assoc-ref properties 'type))) + (and (= inode (stat:ino stat)) + (or (eq? type 'unknown) + (eq? type (stat:type stat))))))))) + (scandir* directory) + (scandir directory (const #t) string Date: Sun, 18 Jun 2017 00:01:03 +0200 Subject: syscalls: 'opendir*' error message shows the file name. * guix/build/syscalls.scm (opendir*): Add NAME to the 'system-error' message. --- guix/build/syscalls.scm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 624941253a..9c082b4352 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -870,8 +870,7 @@ system to PUT-OLD." (proc (string->pointer name)))) (if (null-pointer? ptr) (throw 'system-error "opendir*" - "opendir*: ~A" - (list (strerror err)) + "~A: ~A" (list name (strerror err)) (list err)) ptr))))) -- cgit v1.2.3