diff options
author | Marius Bakke <marius@gnu.org> | 2020-05-26 22:34:46 +0200 |
---|---|---|
committer | Marius Bakke <marius@gnu.org> | 2020-05-26 22:34:46 +0200 |
commit | aa13c5657d4f8b5dd52beda88a9a8ccc59ebca86 (patch) | |
tree | 856094a6541a72b70d471ed5265d6e940cb11e55 /guix/build | |
parent | 8ab211dbdb7df000a64aceadfe7b53488819d245 (diff) | |
parent | b4f04e0efff1fb6112b84dc6d36ea46215c336b2 (diff) | |
download | guix-patches-aa13c5657d4f8b5dd52beda88a9a8ccc59ebca86.tar guix-patches-aa13c5657d4f8b5dd52beda88a9a8ccc59ebca86.tar.gz |
Merge branch 'master' into staging
Diffstat (limited to 'guix/build')
-rw-r--r-- | guix/build/asdf-build-system.scm | 54 | ||||
-rw-r--r-- | guix/build/minify-build-system.scm | 9 | ||||
-rw-r--r-- | guix/build/syscalls.scm | 113 |
3 files changed, 146 insertions, 30 deletions
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." 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 <rekado@elephly.net> +;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> ;;; ;;; 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 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 ;<linux/in.h> - sizeof-sockaddrin +(define-c-struct sockaddr-in/linux ;<linux/in.h> + 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 ;<linux/in6.h> - sizeof-sockaddr-in6 +(define-c-struct sockaddr-in/hurd ;<netinet/in.h> + 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 ;<linux/in6.h> + 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 ;<netinet/in.h> + 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) ;<bits/socket.h> (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 '*))) |