From 10bb4e165056199dfc3b3f0910a83dd7b4aa5e55 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Sun, 26 May 2019 10:15:28 +0200 Subject: guix: Add helper for generating desktop entry files. * guix/build/utils.scm (make-desktop-entry-file): New procedure. --- guix/build/utils.scm | 99 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 99 insertions(+) (limited to 'guix/build') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index b8be73ead4..cee4e8aaa2 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -1324,6 +1324,105 @@ not supported." (&wrap-error (program prog) (type 'no-interpreter-found))))))))) +(define* (make-desktop-entry-file destination #:key + (type "Application") ; One of "Application", "Link" or "Directory". + (version "1.1") + name + (generic-name name) + (no-display #f) + comment + icon + (hidden #f) + only-show-in + not-show-in + (d-bus-activatable #f) + try-exec + exec + path + (terminal #f) + actions + mime-type + (categories "Application") + implements + keywords + (startup-notify #t) + startup-w-m-class + #:rest all-args) + "Create a desktop entry file at DESTINATION. +You must specify NAME. + +Values can be booleans, numbers, strings or list of strings. + +Additionally, locales can be specified with an alist where the key is the +locale. The #f key specifies the default. Example: + + #:name '((#f \"I love Guix\") (\"fr\" \"J'aime Guix\")) + +produces + + Name=I love Guix + Name[fr]=J'aime Guix + +For a complete description of the format, see the specifications at +https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-latest.html." + (define (escape-semicolon s) + (string-join (string-split s #\;) "\\;")) + (define* (parse key value #:optional locale) + (set! value (match value + (#t "true") + (#f "false") + ((? number? n) n) + ((? string? s) (escape-semicolon s)) + ((? list? value) + (catch 'wrong-type-arg + (lambda () (string-join (map escape-semicolon value) ";")) + (lambda args (error "List arguments can only contain strings: ~a" args)))) + (_ (error "Value must be a boolean, number, string or list of strings")))) + (format #t "~a=~a~%" + (if locale + (format #f "~a[~a]" key locale) + key) + value)) + + (define key-error-message "This procedure only takes key arguments beside DESTINATION") + + (unless name + (error "Missing NAME key argument")) + (unless (member #:type all-args) + (set! all-args (append (list #:type type) all-args))) + (mkdir-p (dirname destination)) + + (with-output-to-file destination + (lambda () + (format #t "[Desktop Entry]~%") + (let loop ((args all-args)) + (match args + (() #t) + ((_) (error key-error-message)) + ((key value . ...) + (unless (keyword? key) + (error key-error-message)) + (set! key + (string-join (map string-titlecase + (string-split (symbol->string + (keyword->symbol key)) + #\-)) + "")) + (match value + (((_ . _) . _) + (for-each (lambda (locale-subvalue) + (parse key + (if (and (list? (cdr locale-subvalue)) + (= 1 (length (cdr locale-subvalue)))) + ;; Support both proper and improper lists for convenience. + (cadr locale-subvalue) + (cdr locale-subvalue)) + (car locale-subvalue))) + value)) + (_ + (parse key value))) + (loop (cddr args)))))))) + ;;; ;;; Locales. -- cgit v1.2.3 From 38746d026cb4179edc18cbb1d1472a0f4c96b5cc Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sun, 26 Jan 2020 13:00:30 +0100 Subject: build-system/cmake: Specify C++ compiler when cross-compiling. * guix/build/cmake-build-system.scm (configure)[args]: Add "-DCMAKE_CXX_COMPILER" when cross-compiling. --- guix/build/cmake-build-system.scm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'guix/build') diff --git a/guix/build/cmake-build-system.scm b/guix/build/cmake-build-system.scm index 9b1112f2d6..d1ff5071be 100644 --- a/guix/build/cmake-build-system.scm +++ b/guix/build/cmake-build-system.scm @@ -67,6 +67,8 @@ ,@(if target (list (string-append "-DCMAKE_C_COMPILER=" target "-gcc") + (string-append "-DCMAKE_CXX_COMPILER=" + target "-g++") (if (string-contains target "mingw") "-DCMAKE_SYSTEM_NAME=Windows" "-DCMAKE_SYSTEM_NAME=Linux")) -- cgit v1.2.3 From 5db7df2eab8c0dc0f91aaaf8431f0ba0d72d6049 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 30 Jan 2020 16:53:44 +0100 Subject: guix: Fix missing export for make-desktop-entry-file. * guix/build/utils.scm: Export make-desktop-entry-file. --- guix/build/utils.scm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'guix/build') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index cee4e8aaa2..a398bf9b90 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -108,6 +108,8 @@ invoke/quiet + make-desktop-entry-file + locale-category->string)) -- cgit v1.2.3 From 481a0f1a7ceac666a011b28324220584ead07698 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Thu, 13 Feb 2020 10:54:29 +0200 Subject: build: gnu-build-system: Don't run configure during bootstrap. * guix/build/gnu-build-system.scm (bootstrap): Add NOCONFIGURE environment variable before running bootstrap scripts. --- guix/build/gnu-build-system.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix/build') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 4df0bb4904..22805c84ea 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -190,6 +190,7 @@ working directory." (if (executable-file? script) (begin (patch-shebang script) + (setenv "NOCONFIGURE" "true") (invoke script)) (invoke "sh" script))) (if (or (file-exists? "configure.ac") -- cgit v1.2.3 From a21bd6d5c208111fbf96e9b402cc5ca872f95109 Mon Sep 17 00:00:00 2001 From: Brendan Tildesley Date: Tue, 8 Oct 2019 02:55:03 +1100 Subject: build-system/gnu: Don't try executing directories in bootstrap phase. * guix/build/gnu-build-system.scm: (bootstrap): Change the file-exists? procedure to one that excludes directories, so that we do not mistake it for a script. For example if the source includes a bootstrap/ directory. Signed-off-by: Marius Bakke --- guix/build/gnu-build-system.scm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 22805c84ea..96913ef9f0 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2018 Mark H Weaver +;;; Copyright © 2020 Brendan Tildesley ;;; ;;; This file is part of GNU Guix. ;;; @@ -173,12 +174,16 @@ working directory." \"autoreconf\". Otherwise do nothing." ;; Note: Run that right after 'unpack' so that the generated files are ;; visible when the 'patch-source-shebangs' phase runs. - (if (not (file-exists? "configure")) + (define (script-exists? file) + (and (file-exists? file) + (not (file-is-directory? file)))) + + (if (not (script-exists? "configure")) ;; First try one of the BOOTSTRAP-SCRIPTS. If none exists, and it's ;; clearly an Autoconf-based project, run 'autoreconf'. Otherwise, do ;; nothing (perhaps the user removed or overrode the 'configure' phase.) - (let ((script (find file-exists? bootstrap-scripts))) + (let ((script (find script-exists? bootstrap-scripts))) ;; GNU packages often invoke the 'git-version-gen' script from ;; 'configure.ac' so make sure it has a valid shebang. (false-if-file-not-found -- cgit v1.2.3 From 1b2b7765a027908cdbeef7c96fd203509c9492de Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Sun, 16 Feb 2020 18:45:37 +0200 Subject: build: gnu-build-system: Adjust NOCONFIGURE variable. This ia a follow-up to 481a0f1a7ceac666a011b28324220584ead07698. * guix/build/gnu-build-system.scm (bootstrap): Set NOCONFIGURE for all bootstrap scripts. Clean up variable after use. --- guix/build/gnu-build-system.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 96913ef9f0..2e7dff2034 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -191,13 +191,15 @@ working directory." (if script (let ((script (string-append "./" script))) + (setenv "NOCONFIGURE" "true") (format #t "running '~a'~%" script) (if (executable-file? script) (begin (patch-shebang script) - (setenv "NOCONFIGURE" "true") (invoke script)) - (invoke "sh" script))) + (invoke "sh" script)) + ;; Let's clean up after ourselves. + (unsetenv "NOCONFIGURE")) (if (or (file-exists? "configure.ac") (file-exists? "configure.in")) (invoke "autoreconf" "-vif") -- cgit v1.2.3 From 88f85494491a0cd4d4262c97860f01e99c2bc313 Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Mon, 17 Feb 2020 16:52:55 +0100 Subject: utils: Change 'patch-shebang' to not try to patch Rust source files. * guix/build/utils.scm (patch-shebang): Match only absolute paths. --- guix/build/utils.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index a398bf9b90..419c10195b 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -894,7 +894,7 @@ transferred and the continuation of the transfer as a thunk." (x x))) (define patch-shebang - (let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)[[:blank:]]*([[:graph:]]*)(.*)$"))) + (let ((shebang-rx (make-regexp "^[[:blank:]]*(/[[:graph:]]+)[[:blank:]]*([[:graph:]]*)(.*)$"))) (lambda* (file #:optional (path (search-path-as-string->list (getenv "PATH"))) -- cgit v1.2.3 From 9c9407f746aa6ad365c0604ef9668009f4dbe8fd Mon Sep 17 00:00:00 2001 From: Timothy Sample Date: Sat, 8 Feb 2020 09:57:21 -0500 Subject: Add (guix build gnu-bootstrap). * guix/build/gnu-bootstrap.scm: New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 1 + guix/build/gnu-bootstrap.scm | 114 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 115 insertions(+) create mode 100644 guix/build/gnu-bootstrap.scm (limited to 'guix/build') diff --git a/Makefile.am b/Makefile.am index c6a2e6cf6c..0371d92d7c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -172,6 +172,7 @@ MODULES = \ guix/build/git.scm \ guix/build/hg.scm \ guix/build/glib-or-gtk-build-system.scm \ + guix/build/gnu-bootstrap.scm \ guix/build/gnu-build-system.scm \ guix/build/gnu-dist.scm \ guix/build/guile-build-system.scm \ diff --git a/guix/build/gnu-bootstrap.scm b/guix/build/gnu-bootstrap.scm new file mode 100644 index 0000000000..1cb9dc5512 --- /dev/null +++ b/guix/build/gnu-bootstrap.scm @@ -0,0 +1,114 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Timothy Sample +;;; +;;; 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 . + +;; Commentary: +;; +;; These procedures can be used to adapt the GNU Build System to build +;; pure Scheme packages targeting the bootstrap Guile. +;; +;; Code: + +(define-module (guix build gnu-bootstrap) + #:use-module (guix build utils) + #:use-module (system base compile) + #:export (bootstrap-configure + bootstrap-build + bootstrap-install)) + +(define (bootstrap-configure version modules scripts) + "Create a procedure that configures an early bootstrap package. The +procedure will search the MODULES directory and configure all of the +'.in' files with VERSION. It will then search the SCRIPTS directory and +configure all of the '.in' files with the bootstrap Guile and its module +and object directories." + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (guile-dir (assoc-ref inputs "guile")) + (guile (string-append guile-dir "/bin/guile")) + (moddir (string-append out "/share/guile/site/" + (effective-version))) + (godir (string-append out "/lib/guile/" + (effective-version) + "/site-ccache"))) + (for-each (lambda (template) + (format #t "Configuring ~a~%" template) + (let ((target (string-drop-right template 3))) + (copy-file template target) + (substitute* target + (("@VERSION@") version)))) + (find-files modules + (lambda (fn st) + (string-suffix? ".in" fn)))) + (for-each (lambda (template) + (format #t "Configuring ~a~%" template) + (let ((target (string-drop-right template 3))) + (copy-file template target) + (substitute* target + (("@GUILE@") guile) + (("@MODDIR@") moddir) + (("@GODIR@") godir)) + (chmod target #o755))) + (find-files scripts + (lambda (fn st) + (string-suffix? ".in" fn)))) + #t))) + +(define (bootstrap-build modules) + "Create a procedure that builds an early bootstrap package. The +procedure will search the MODULES directory and compile all of the +'.scm' files." + (lambda _ + (add-to-load-path (getcwd)) + (for-each (lambda (scm) + (let* ((base (string-drop-right scm 4)) + (go (string-append base ".go")) + (dir (dirname scm))) + (format #t "Compiling ~a~%" scm) + (compile-file scm #:output-file go))) + (find-files modules "\\.scm$")) + #t)) + +(define (bootstrap-install modules scripts) + "Create a procedure that installs an early bootstrap package. The +procedure will install all of the '.scm' and '.go' files in the MODULES +directory, and all the executable files in the SCRIPTS directory." + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (guile-dir (assoc-ref inputs "guile")) + (guile (string-append guile-dir "/bin/guile")) + (moddir (string-append out "/share/guile/site/" + (effective-version))) + (godir (string-append out "/lib/guile/" + (effective-version) + "/site-ccache"))) + (for-each (lambda (scm) + (let* ((base (string-drop-right scm 4)) + (go (string-append base ".go")) + (dir (dirname scm))) + (format #t "Installing ~a~%" scm) + (install-file scm (string-append moddir "/" dir)) + (format #t "Installing ~a~%" go) + (install-file go (string-append godir "/" dir)))) + (find-files modules "\\.scm$")) + (for-each (lambda (script) + (format #t "Installing ~a~%" script) + (install-file script (string-append out "/bin"))) + (find-files scripts + (lambda (fn st) + (executable-file? fn)))) + #t))) -- cgit v1.2.3 From fd1351ab0a209fb2cd3bd4de04fb9e2a515dea31 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Tue, 28 Apr 2020 14:14:21 +0200 Subject: build: store-copy: Export file-size procedure. * guix/build/store-copy.scm (file-size): Export it. --- guix/build/store-copy.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix/build') diff --git a/guix/build/store-copy.scm b/guix/build/store-copy.scm index 549aa4f28b..ad551bca98 100644 --- a/guix/build/store-copy.scm +++ b/guix/build/store-copy.scm @@ -35,6 +35,7 @@ read-reference-graph + file-size closure-size populate-store)) -- cgit v1.2.3 From 86f5decd2066889bf2e60df388d6c812aede0917 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 5 May 2020 12:13:43 +0200 Subject: syscalls: 'define-c-struct' supports cross-compilation. Reported by Jan (janneke) Nieuwenhuizen . Before that, we'd always use the 'sizeof' and 'alignof' value obtained from the host at macro-expansion time. * guix/build/syscalls.scm (sizeof*, alignof*): When the target word size differs from the host word size, emit a call to 'sizeof'/'alignof'. --- guix/build/syscalls.scm | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 73b439fb7d..00d8ceb480 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -23,6 +23,7 @@ (define-module (guix build syscalls) #:use-module (system foreign) + #:use-module (system base target) #:use-module (rnrs bytevectors) #:autoload (ice-9 binary-ports) (get-bytevector-n) #:use-module (srfi srfi-1) @@ -194,9 +195,14 @@ (* (sizeof* type) n)) ((_ type) (let-syntax ((v (lambda (s) - (let ((val (sizeof type))) - (syntax-case s () - (_ val)))))) + ;; When compiling natively, call 'sizeof' at expansion + ;; time; otherwise, emit code to call it at run time. + (syntax-case s () + (_ + (if (= (target-word-size) + (with-target %host-type target-word-size)) + (sizeof type) + #'(sizeof type))))))) v)))) (define-syntax alignof* @@ -208,9 +214,14 @@ (alignof* type)) ((_ type) (let-syntax ((v (lambda (s) - (let ((val (alignof type))) - (syntax-case s () - (_ val)))))) + ;; When compiling natively, call 'sizeof' at expansion + ;; time; otherwise, emit code to call it at run time. + (syntax-case s () + (_ + (if (= (target-word-size) + (with-target %host-type target-word-size)) + (alignof type) + #'(alignof type))))))) v)))) (define-syntax align ;as found in (system foreign) -- cgit v1.2.3 From 598be42dfa3aa1f6a92b5562397742b3fa96a3e0 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Wed, 6 May 2020 18:18:45 +0200 Subject: syscalls: Add ioctl flags for the Hurd. Use #include #include #include int main () { printf ("SIOCSIFFLAGS #x%x\n", SIOCSIFFLAGS); printf ("SIOCGIFADDR #x%x\n", SIOCGIFADDR); printf ("SIOCSIFADDR #x%x\n", SIOCSIFADDR); printf ("SIOCGIFNETMASK #x%x\n", SIOCGIFNETMASK); printf ("SIOCSIFNETMASK #x%x\n", SIOCSIFNETMASK); #if 0 printf ("SIOCADDRT #x%x\n", SIOCADDRT); printf ("SIOCDELRT #x%x\n", SIOCDELRT); #endif } to fill in some blanks. Adding and removing route apparently not supported. * guix/build/syscalls.scm (SIOCSIFFLAGS SIOCGIFADDR, SIOCSIFADDR, SIOCGIFNETMASK, SIOCSIFNETMASK): --- guix/build/syscalls.scm | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 00d8ceb480..4ee2b97e76 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2019 Guillaume Le Vaillant ;;; Copyright © 2020 Julien Lepiller +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -1205,6 +1206,8 @@ bytes." ;;; (define SIOCGIFCONF ;from + ; + ; (if (string-contains %host-type "linux") #x8912 ;GNU/Linux #xf00801a4)) ;GNU/Hurd @@ -1215,23 +1218,23 @@ bytes." (define SIOCSIFFLAGS (if (string-contains %host-type "linux") #x8914 ;GNU/Linux - -1)) ;FIXME: GNU/Hurd? + #x84804190)) ;GNU/Hurd (define SIOCGIFADDR (if (string-contains %host-type "linux") #x8915 ;GNU/Linux - -1)) ;FIXME: GNU/Hurd? + #xc08401a1)) ;GNU/Hurd (define SIOCSIFADDR (if (string-contains %host-type "linux") #x8916 ;GNU/Linux - -1)) ;FIXME: GNU/Hurd? + #x8084018c)) ;GNU/Hurd (define SIOCGIFNETMASK (if (string-contains %host-type "linux") #x891b ;GNU/Linux - -1)) ;FIXME: GNU/Hurd? + #xc08401a5)) ;GNU/Hurd (define SIOCSIFNETMASK (if (string-contains %host-type "linux") #x891c ;GNU/Linux - -1)) ;FIXME: GNU/Hurd? + #x80840196)) ;GNU/Hurd (define SIOCADDRT (if (string-contains %host-type "linux") #x890B ;GNU/Linux -- cgit v1.2.3 From 2ca603f113a24f89284ade0771defadfbfed9972 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Thu, 7 May 2020 15:14:46 +0200 Subject: build-system/emacs: Hide the 'delete' binding from (guix build utils). This gets rid of a warning from 'compute-guix-derivation.drv' when running on Guile 3.0. (guix build emacs-build-system) includes (srfi srfi-1) anyway. * guix/build/emacs-build-system.scm: Do not import 'delete' from (guix build utils). --- guix/build/emacs-build-system.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm index 219310cf08..26ea59bc25 100644 --- a/guix/build/emacs-build-system.scm +++ b/guix/build/emacs-build-system.scm @@ -21,7 +21,7 @@ (define-module (guix build emacs-build-system) #:use-module ((guix build gnu-build-system) #:prefix gnu:) - #:use-module (guix build utils) + #:use-module ((guix build utils) #:hide (delete)) #:use-module (guix build emacs-utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) -- cgit v1.2.3 From d155c9d93496ae620829fbc33b5694e74cda9683 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Wed, 13 May 2020 22:49:54 +0200 Subject: syscalls: Add 'setxattr'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/syscalls.scm (setxattr): New procedure. Co-authored-by: Ludovic Courtès --- guix/build/syscalls.scm | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 4ee2b97e76..3bb4545c04 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -79,6 +79,7 @@ fdatasync pivot-root scandir* + setxattr fcntl-flock lock-file @@ -723,6 +724,23 @@ backend device." (list (strerror err)) (list err)))))) +(define setxattr + (let ((proc (syscall->procedure int "setxattr" + `(* * * ,size_t ,int)))) + (lambda* (file key value #:optional (flags 0)) + "Set extended attribute KEY to VALUE on FILE." + (let*-values (((bv) (string->utf8 value)) + ((ret err) + (proc (string->pointer/utf-8 file) + (string->pointer key) + (bytevector->pointer bv) + (bytevector-length bv) + flags))) + (unless (zero? ret) + (throw 'system-error "setxattr" "~S: ~A" + (list file key value (strerror err)) + (list err))))))) + ;;; ;;; Random. -- cgit v1.2.3 From a4d76a514fed7bdd5f6dc0fdc69942d7ad3f65f1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 May 2020 23:17:49 +0200 Subject: compile: Reduce optimization levels for gnu/services and gnu/packages. * guix/build/compile.scm (optimization-options)[strip-option] [override-option]: New procedures. Add case for "gnu/services". Change "gnu/packages" to '-O0 -Opartial-eval'. --- guix/build/compile.scm | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) (limited to 'guix/build') diff --git a/guix/build/compile.scm b/guix/build/compile.scm index c4dbb6e34c..63f24fa7d4 100644 --- a/guix/build/compile.scm +++ b/guix/build/compile.scm @@ -84,9 +84,32 @@ (define (optimization-options file) "Return the default set of optimizations options for FILE." - (if (string-contains file "gnu/packages/") - (optimizations-for-level 1) ;build faster - (optimizations-for-level 3))) + (define (strip-option option lst) + (let loop ((lst lst) + (result '())) + (match lst + (() + (reverse result)) + ((kw value rest ...) + (if (eq? kw option) + (append (reverse result) rest) + (loop rest (cons* value kw result))))))) + + (define (override-option option value lst) + `(,option ,value ,@(strip-option option lst))) + + (cond ((string-contains file "gnu/packages/") + ;; Level 0 is good enough but partial evaluation helps preserve the + ;; "macro writer's bill of rights". + (override-option #:partial-eval? #t + (optimizations-for-level 0))) + ((string-contains file "gnu/services/") + ;; '-O2 -Ono-letrectify' compiles about ~20% faster than '-O2' for + ;; large files like gnu/services/mail.scm. + (override-option #:letrectify? #f + (optimizations-for-level 2))) + (else + (optimizations-for-level 3)))) (define (scm->go file) "Strip the \".scm\" suffix from FILE, and append \".go\"." -- cgit v1.2.3 From df05842332be80ed7f53022402b95cf711163b41 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Thu, 14 May 2020 00:30:57 +0200 Subject: syscalls: Add 'getxattr'. * guix/build/syscalls.scm (getxattr): New procedure. * tests/syscalls.scm ("getxattr, setxattr"): Test it, together with setxattr. --- guix/build/syscalls.scm | 27 +++++++++++++++++++++++++++ tests/syscalls.scm | 8 ++++++++ 2 files changed, 35 insertions(+) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 3bb4545c04..ff008c5b78 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -79,6 +79,7 @@ fdatasync pivot-root scandir* + getxattr setxattr fcntl-flock @@ -724,6 +725,32 @@ backend device." (list (strerror err)) (list err)))))) +(define getxattr + (let ((proc (syscall->procedure ssize_t "getxattr" + `(* * * ,size_t)))) + (lambda (file key) + "Get the extended attribute value for KEY on FILE." + (let-values (((size err) + ;; Get size of VALUE for buffer. + (proc (string->pointer/utf-8 file) + (string->pointer key) + (string->pointer "") + 0))) + (cond ((< size 0) #f) + ((zero? size) "") + ;; Get VALUE in buffer of SIZE. XXX actual size can race. + (else (let*-values (((buf) (make-bytevector size)) + ((size err) + (proc (string->pointer/utf-8 file) + (string->pointer key) + (bytevector->pointer buf) + size))) + (if (>= size 0) + (utf8->string buf) + (throw 'system-error "getxattr" "~S: ~A" + (list file key (strerror err)) + (list err)))))))))) + (define setxattr (let ((proc (syscall->procedure int "setxattr" `(* * * ,size_t ,int)))) diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 7fe0cd1545..3823de7c1e 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -270,6 +270,14 @@ (scandir* directory) (scandir directory (const #t) string