From 0d371c633f7308cfde2432d6119d386a5c63198c Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Sat, 9 May 2020 08:43:39 +0200 Subject: syscalls: Adjust 'sockaddr-in', 'sockaddr-in6' structs for the Hurd. * guix/build/syscalls.scm (sockaddr-in,sockaddr-in6): Rename to ... (sockaddr-in/linux, sockaddr-in6/linux): ... this. Rename introduced bindings as well. (write-socket-address!/linux,read-socket-address/linux): Rename from (write-socket-address!, read-socket-address): ... new switches between those and ... (write-socket-address!/hurd, read-socket-address/hurd): ... these new function. --- guix/build/syscalls.scm | 113 ++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 91 insertions(+), 22 deletions(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index ff008c5b78..8070c5546f 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1315,62 +1315,131 @@ bytes." 40 32)) -(define-c-struct sockaddr-in ; - sizeof-sockaddrin +(define-c-struct sockaddr-in/linux ; + sizeof-sockaddr-in/linux (lambda (family port address) (make-socket-address family address port)) - read-sockaddr-in - write-sockaddr-in! + read-sockaddr-in/linux + write-sockaddr-in!/linux (family unsigned-short) (port (int16 ~ big)) (address (int32 ~ big))) -(define-c-struct sockaddr-in6 ; - sizeof-sockaddr-in6 +(define-c-struct sockaddr-in/hurd ; + sizeof-sockaddr-in/hurd + (lambda (len family port address zero) + (make-socket-address family address port)) + read-sockaddr-in/hurd + write-sockaddr-in!/hurd + (len uint8) + (family uint8) + (port (int16 ~ big)) + (address (int32 ~ big)) + (zero (array uint8 8))) + +(define-c-struct sockaddr-in6/linux ; + sizeof-sockaddr-in6/linux (lambda (family port flowinfo address scopeid) (make-socket-address family address port flowinfo scopeid)) - read-sockaddr-in6 - write-sockaddr-in6! + read-sockaddr-in6/linux + write-sockaddr-in6!/linux (family unsigned-short) (port (int16 ~ big)) (flowinfo (int32 ~ big)) (address (int128 ~ big)) (scopeid int32)) -(define (write-socket-address! sockaddr bv index) +(define-c-struct sockaddr-in6/hurd ; + sizeof-sockaddr-in6/hurd + (lambda (len family port flowinfo address scopeid) + (make-socket-address family address port flowinfo scopeid)) + read-sockaddr-in6/hurd + write-sockaddr-in6!/hurd + (len uint8) + (family uint8) + (port (int16 ~ big)) + (flowinfo (int32 ~ big)) + (address (int128 ~ big)) + (scopeid int32)) + +(define (write-socket-address!/linux sockaddr bv index) + "Write SOCKADDR, a socket address as returned by 'make-socket-address', to +bytevector BV at INDEX." + (let ((family (sockaddr:fam sockaddr))) + (cond ((= family AF_INET) + (write-sockaddr-in!/linux bv index + family + (sockaddr:port sockaddr) + (sockaddr:addr sockaddr))) + ((= family AF_INET6) + (write-sockaddr-in6!/linux bv index + family + (sockaddr:port sockaddr) + (sockaddr:flowinfo sockaddr) + (sockaddr:addr sockaddr) + (sockaddr:scopeid sockaddr))) + (else + (error "unsupported socket address" sockaddr))))) + +(define (write-socket-address!/hurd sockaddr bv index) "Write SOCKADDR, a socket address as returned by 'make-socket-address', to bytevector BV at INDEX." (let ((family (sockaddr:fam sockaddr))) (cond ((= family AF_INET) - (write-sockaddr-in! bv index - family - (sockaddr:port sockaddr) - (sockaddr:addr sockaddr))) + (write-sockaddr-in!/hurd bv index + sizeof-sockaddr-in/hurd + family + (sockaddr:port sockaddr) + (sockaddr:addr sockaddr) + '(0 0 0 0 0 0 0 0))) ((= family AF_INET6) - (write-sockaddr-in6! bv index - family - (sockaddr:port sockaddr) - (sockaddr:flowinfo sockaddr) - (sockaddr:addr sockaddr) - (sockaddr:scopeid sockaddr))) + (write-sockaddr-in6!/hurd bv index + sizeof-sockaddr-in6/hurd + family + (sockaddr:port sockaddr) + (sockaddr:flowinfo sockaddr) + (sockaddr:addr sockaddr) + (sockaddr:scopeid sockaddr))) (else (error "unsupported socket address" sockaddr))))) +(define write-socket-address! + (if (string-suffix? "linux-gnu" %host-type) + write-socket-address!/linux + write-socket-address!/hurd)) + (define PF_PACKET 17) ; (define AF_PACKET PF_PACKET) -(define* (read-socket-address bv #:optional (index 0)) +(define* (read-socket-address/linux bv #:optional (index 0)) + "Read a socket address from bytevector BV at INDEX." + (let ((family (bytevector-u16-native-ref bv index))) + (cond ((= family AF_INET) + (read-sockaddr-in/linux bv index)) + ((= family AF_INET6) + (read-sockaddr-in6/linux bv index)) + (else + ;; XXX: Unsupported address family, such as AF_PACKET. Return a + ;; vector such that the vector can at least call 'sockaddr:fam'. + (vector family))))) + +(define* (read-socket-address/hurd bv #:optional (index 0)) "Read a socket address from bytevector BV at INDEX." (let ((family (bytevector-u16-native-ref bv index))) (cond ((= family AF_INET) - (read-sockaddr-in bv index)) + (read-sockaddr-in/hurd bv index)) ((= family AF_INET6) - (read-sockaddr-in6 bv index)) + (read-sockaddr-in6/hurd bv index)) (else ;; XXX: Unsupported address family, such as AF_PACKET. Return a ;; vector such that the vector can at least call 'sockaddr:fam'. (vector family))))) +(define read-socket-address + (if (string-suffix? "linux-gnu" %host-type) + read-socket-address/linux + read-socket-address/hurd)) + (define %ioctl ;; The most terrible interface, live from Scheme. (syscall->procedure int "ioctl" (list int unsigned-long '*))) -- cgit v1.2.3 From 5b77e9ca14ff7fc74b849492e96353939f29664b Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Wed, 6 May 2020 11:27:48 +0300 Subject: build: minify-build-system: Fail to install empty files. * guix/build/minify-build-system.scm (install): Produce an error if the minified file is zero bytes. --- guix/build/minify-build-system.scm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/minify-build-system.scm b/guix/build/minify-build-system.scm index 563def88e9..92158a033f 100644 --- a/guix/build/minify-build-system.scm +++ b/guix/build/minify-build-system.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Ricardo Wurmus +;;; Copyright © 2020 Efraim Flashner ;;; ;;; This file is part of GNU Guix. ;;; @@ -54,8 +55,12 @@ (let* ((out (assoc-ref outputs "out")) (js (string-append out "/share/javascript/"))) (mkdir-p js) - (for-each (cut install-file <> js) - (find-files "guix/build" "\\.min\\.js$"))) + (for-each + (lambda (file) + (if (not (zero? (stat:size (stat file)))) + (install-file file js) + (error "File is empty: " file))) + (find-files "guix/build" "\\.min\\.js$"))) #t) (define %standard-phases -- cgit v1.2.3 From c3f1f09586967c3fefbb280014a4d46b57786696 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 7 May 2020 14:25:51 +0200 Subject: build: asdf-build-system: Use SBCL source in CL packages. * guix/build/asdf-build-system.scm (copy-files-to-output): Don't attempt to reset timestamps on files without write access. (install): When parent SBCL package is in the inputs, use its source. This way we get possibly patched sources in CL packages as well (e.g. for FFI). This is also useful for sources that generate files on load-op, like cl-unicode. * guix/build-system/asdf.scm (package-with-build-system): Forward the SBCL parent as a native input so that it can be used in the above install phase. --- guix/build-system/asdf.scm | 5 +++- guix/build/asdf-build-system.scm | 54 +++++++++++++++++++++++++++++++++++----- 2 files changed, 52 insertions(+), 7 deletions(-) (limited to 'guix/build') diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index f794bf006b..630b99e2bf 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -230,7 +230,10 @@ set up using CL source package conventions." ((#:phases phases) (list phases-transformer phases)))) (inputs (new-inputs package-inputs)) (propagated-inputs (new-propagated-inputs)) - (native-inputs (new-inputs package-native-inputs)) + (native-inputs (append (if target-is-source? + (list (list (package-name pkg) pkg)) + '()) + (new-inputs package-native-inputs))) (outputs (if target-is-source? '("out") (package-outputs pkg))))) diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index f3f4b49bcf..25dd031962 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -85,7 +85,8 @@ valid." ;; files before compiling. (for-each (lambda (file) (let ((s (lstat file))) - (unless (eq? (stat:type s) 'symlink) + (unless (or (eq? (stat:type s) 'symlink) + (not (access? file W_OK))) (utime file 0 0 0 0)))) (find-files source #:directories? #t)) (copy-recursively source target #:keep-mtime? #t) @@ -97,12 +98,53 @@ valid." (find-files target "\\.asd$")) #t)) -(define* (install #:key outputs #:allow-other-keys) - "Copy and symlink all the source files." +(define* (install #:key inputs outputs #:allow-other-keys) + "Copy and symlink all the source files. +The source files are taken from the corresponding compile package (e.g. SBCL) +if it's present in the native-inputs." (define output (assoc-ref outputs "out")) - (copy-files-to-output output - (package-name->name+version - (strip-store-file-name output)))) + (define package-name + (package-name->name+version + (strip-store-file-name output))) + (define (no-prefix pkgname) + (if (string-index pkgname #\-) + (string-drop pkgname (1+ (string-index pkgname #\-))) + pkgname)) + (define parent + (match (assoc package-name inputs + (lambda (key alist-car) + (let* ((alt-key (no-prefix key)) + (alist-car (no-prefix alist-car))) + (or (string=? alist-car key) + (string=? alist-car alt-key))))) + (#f #f) + (p (cdr p)))) + (define parent-name + (and parent + (package-name->name+version (strip-store-file-name parent)))) + (define parent-source + (and parent + (string-append parent "/share/common-lisp/" + (string-take parent-name + (string-index parent-name #\-)) + "-source"))) + + (define (first-subdirectory directory) ; From gnu-build-system. + "Return the file name of the first sub-directory of DIRECTORY." + (match (scandir directory + (lambda (file) + (and (not (member file '("." ".."))) + (file-is-directory? (string-append directory "/" + file))))) + ((first . _) first))) + (define source-directory + (if (and parent-source + (file-exists? parent-source)) + (string-append parent-source "/" (first-subdirectory parent-source)) + ".")) + + (with-directory-excursion source-directory + (copy-files-to-output output package-name))) (define* (copy-source #:key outputs asd-system-name #:allow-other-keys) "Copy the source to the library output." -- cgit v1.2.3