11/16: syscalls: add missing pieces for derivation build environment

[guix-commits]

reepca pushed a commit to branch guile-daemon
in repository guix.

commit 9a3504c8af42ea50950ea88cfb9f5cfba1f702d7
Author: Caleb Ristvedt <address@hidden>
Date:   Sun Apr 7 00:15:50 2019 -0500

    syscalls: add missing pieces for derivation build environment
    
    * guix/build/syscalls.scm (ADDR_NO_RANDOMIZE, UNAME26, PER_LINUX32): new
      variables. Flags needed for improving determinism / doing certain 32-bit
      builds.
      (initialize-loopback, setdomainname): New procedures. Needed in setting up
      container.
      (octal-escaped): moved here from (guix store build-derivations).
      (mount-points): uses octal-escaped to properly handle odd characters in
      mount point filenames.
    
    * guix/store/build-derivations.scm (initialize-loopback): remove stub, use
      above new procedure.
      (octal-escaped): moved to (guix build syscalls).
---
 guix/build/syscalls.scm          | 53 ++++++++++++++++++++++++++++++++++++++--
 guix/store/build-derivations.scm | 31 -----------------------
 2 files changed, 51 insertions(+), 33 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 85b3f50..2fb5387 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -111,6 +111,7 @@
             configure-network-interface
             add-network-route/gateway
             delete-network-route
+            initialize-loopback
 
             interface?
             interface-name
@@ -159,7 +160,10 @@
             utmpx-entries
             (read-utmpx-from-port . read-utmpx)
             personality
-            ADDR_NO_RANDOMIZE))
+            ADDR_NO_RANDOMIZE
+            setdomainname
+            UNAME26
+            PER_LINUX32))
 
 ;;; Commentary:
 ;;;
@@ -511,6 +515,27 @@ constants from <sys/mount.h>."
       (when update-mtab?
         (remove-from-mtab target)))))
 
+(define (octal-escaped str)
+  "Convert a string that may contain octal-escaped characters of the form \\ooo
+to a string with the corresponding code points."
+    ;; I'm using "octet" here like I would normally use "digit".
+  (define (octal-triplet->char octet1 octet2 octet3)
+   (integer->char (string->number (string octet1 octet2 octet3)
+                                   8)))
+
+  (let next-char ((result-list '())
+                  (to-convert (string->list str)))
+    (match to-convert
+      ((#\\ octet1 octet2 octet3 . others)
+       (next-char (cons (octal-triplet->char octet1 octet2 octet3)
+                        result-list)
+                  others))
+      ((char . others)
+       (next-char (cons char result-list)
+                  others))
+      (()
+       (list->string (reverse! result-list))))))
+
 (define (mount-points)
   "Return the mounts points for currently mounted file systems."
   (call-with-input-file "/proc/mounts"
@@ -521,7 +546,7 @@ constants from <sys/mount.h>."
               (reverse result)
               (match (string-tokenize line)
                 ((source mount-point _ ...)
-                 (loop (cons mount-point result))))))))))
+                 (loop (cons (octal-escaped mount-point) result))))))))))
 
 (define swapon
   (let ((proc (syscall->procedure int "swapon" (list '* int))))
@@ -1455,6 +1480,16 @@ is true, it must be a socket address to use as the 
network mask."
       (lambda ()
         (close-port sock)))))
 
+(define (initialize-loopback)
+  (let ((sock (socket PF_INET SOCK_DGRAM IPPROTO_IP)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (set-network-interface-flags sock "lo"
+                                     (logior IFF_UP IFF_LOOPBACK IFF_RUNNING)))
+      (lambda ()
+        (close sock)))))
+
 
 ;;;
 ;;; Network routes.
@@ -1960,6 +1995,8 @@ entry."
      (read-utmpx bv))))
 
 (define ADDR_NO_RANDOMIZE #x0040000)
+(define UNAME26           #x0020000)
+(define PER_LINUX32          #x0008)
 
 (define personality
   (let ((proc (syscall->procedure int "personality" `(,unsigned-long))))
@@ -1971,4 +2008,16 @@ entry."
                    (list err))
             ret)))))
 
+(define setdomainname
+  (let ((proc (syscall->procedure int "setdomainname" (list '* int))))
+    (lambda (domain-name)
+      (let-values (((ret err) (proc (string->pointer/utf-8 domain-name)
+                                    (bytevector-length (string->utf8
+                                                        domain-name)))))
+        (if (= -1 ret)
+            (throw 'system-error "setdomainname" "~A"
+                   (list (strerror err))
+                   (list err))
+            ret)))))
+
 ;;; syscalls.scm ends here 
diff --git a/guix/store/build-derivations.scm b/guix/store/build-derivations.scm
index d531459..6d8b22a 100644
--- a/guix/store/build-derivations.scm
+++ b/guix/store/build-derivations.scm
@@ -312,30 +312,6 @@ provide."
                         ,@(derivation-sources drv)
                         ,@input-paths)))))
 
-;; Sigh... I just HAD to go and ask "what if there are spaces in the mountinfo
-;; entries"... I couldn't find the behavior documented anywhere, but
-;; experimentally it appears to be octal-escaped.
-(define (octal-escaped str)
-  "Converts octal escapes of the form \\abc to the corresponding character
-code points."
-  (define (octal-triplet->char octet1 octet2 octet3) 
-    ;; I'm using "octet" here like I would normally use "digit".
-    (integer->char (string->number (string octet1 octet2 octet3)
-                                   8)))
-
-  (let next-char ((result-list '())
-                  (to-convert (string->list str)))
-    (match to-convert
-      ((#\\ octet1 octet2 octet3 . others)
-       (next-char (cons (octal-triplet->char octet1 octet2 octet3)
-                        result-list)
-                  others))
-      ((char . others)
-       (next-char (cons char result-list)
-                  others))
-      (()
-       (list->string (reverse! result-list))))))
-
 (define (special-filesystems input-paths)
   "Returns whatever new filesystems need to be created in the container, which
 depends on whether they're already set to be bind-mounted. INPUT-PATHS must be
@@ -365,13 +341,6 @@ a list of paths or pairs of paths."
           '())
     ))
 
-(define (initialize-loopback)
-  ;; XXX: Implement this. I couldn't find anything in the manual about ioctl,
-  ;; which we need to use, soo...
-  ;; (let ((sock (socket PF_INET SOCK_DGRAM IPPROTO_IP)))
-  ;;   )
-  #f)
-
 (define (disable-address-randomization)
   (let ((current-persona (personality #xffffffff)))
     (personality (logior current-persona