Merge branch 'master' into staging

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 '*)))