From 3718b0cb0ef9673e57b6a55c8feb5a6b97e9cbc2 Mon Sep 17 00:00:00 2001
From: Caleb Ristvedt <caleb.ristvedt@cune.org>
Date: Sun, 21 Apr 2024 10:42:21 +0100
Subject: 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 / impersonating a 32-bit
machine on a 64-bit machine.
(initialize-loopback, setdomainname, personality): New procedures.
(octal-escaped): New procedure.
(mount-points): Use octal-escaped to properly handle unusual characters in
mount point filenames.

Signed-off-by: Christopher Baines <mail@cbaines.net>
Change-Id: I2f2aa38fe8f97f2565461d20331b95040a2d7539
---
 guix/build/syscalls.scm | 45 ++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 44 insertions(+), 1 deletion(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 92f2bb21fc..487ee68b43 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -162,6 +162,7 @@
             configure-network-interface
             add-network-route/gateway
             delete-network-route
+            initialize-loopback
 
             interface?
             interface-name
@@ -212,7 +213,12 @@
             utmpx-address
             login-type
             utmpx-entries
-            (read-utmpx-from-port . read-utmpx)))
+            (read-utmpx-from-port . read-utmpx)
+            personality
+            ADDR_NO_RANDOMIZE
+            setdomainname
+            UNAME26
+            PER_LINUX32))
 
 ;;; Commentary:
 ;;;
@@ -1952,6 +1958,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.
@@ -2523,4 +2539,31 @@ entry."
     ((? bytevector? bv)
      (read-utmpx bv))))
 
+;; TODO: verify these constants are correct on platforms other than x86-64
+(define ADDR_NO_RANDOMIZE #x0040000)
+(define UNAME26           #x0020000)
+(define PER_LINUX32          #x0008)
+
+(define personality
+  (let ((proc (syscall->procedure int "personality" `(,unsigned-long))))
+    (lambda (persona)
+      (let-values (((ret err) (proc persona)))
+        (if (= -1 ret)
+            (throw 'system-error "personality" "~A"
+                   (list (strerror err))
+                   (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
-- 
cgit v1.2.3