17/21: HACK services: hurd: Add dummy `loopback'.

[guix-commits]

janneke pushed a commit to branch wip-hurd-vm
in repository guix.

commit 7f48e0560f264732e5d5fb95665e230fe3375d67
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Mon Apr 13 22:51:00 2020 +0200

    HACK services: hurd: Add dummy `loopback'.
    
    TODO Fix running this:
    
    --8<---------------cut here---------------start------------->8---
    (use-modules (guix build syscalls))
    
    (define LOOPBACK? #t)
    (define IP "127.0.0.1" )
    (define INTERFACE "lo")
    (define NETMASK "255.0.0.0")
    (define GATEWAY #f)
    
    (format #t "ifreq-struct-size: ~a\n" (@@ (guix build syscalls) 
ifreq-struct-size))
    (format #t "sizeof-ifconf: ~s\n" (@@ (guix build syscalls) sizeof-ifconf))
    (define (test)
      (let* ((addr     (inet-pton AF_INET IP))
             (sockaddr (make-socket-address AF_INET addr 0))
             (mask     (and NETMASK
                            (inet-pton AF_INET NETMASK)))
             (maskaddr (and mask
                            (make-socket-address AF_INET
                                                 mask 0)))
             (gateway  (and GATEWAY
                            (inet-pton AF_INET GATEWAY)))
             (gatewayaddr (and gateway
                               (make-socket-address AF_INET
                                                    gateway 0))))
        (configure-network-interface INTERFACE sockaddr
                                     (logior IFF_UP
                                             (if LOOPBACK?
                                                 IFF_LOOPBACK
                                                 0))
                                     #:netmask maskaddr)
        (when gateway
          (let ((sock (socket AF_INET SOCK_DGRAM 0)))
            (add-network-route/gateway sock gatewayaddr)
            (close-port sock)))))
    
    ;; (test)
    (catch #t
      test
      (lambda args
        (pk "caught args=" args)
        (let ((errno (system-error-errno args)))
          (pk errno (strerror errno)))))
    --8<---------------cut here---------------end--------------->8---
    
    on a cross-built (guix build syscalls).
    
    * gnu/services/hurd.scm (hurd-loopback-shepherd-service,
    hurd-loopback-service-type): New function.
    (hurd-service->shepherd-service): Use them to support entry for dummy
    loopback.
---
 gnu/services/hurd.scm | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

diff --git a/gnu/services/hurd.scm b/gnu/services/hurd.scm
index e2505ae..7264109 100644
--- a/gnu/services/hurd.scm
+++ b/gnu/services/hurd.scm
@@ -28,7 +28,8 @@
             hurd-console-service-type
             hurd-etc-service
             hurd-getty-configuration
-            hurd-getty-service-type))
+            hurd-getty-service-type
+            hurd-loopback-service-type))
 
 ;;; Commentary:
 ;;;
@@ -104,6 +105,32 @@ fi\n"))
 
 
 ;;;
+;;; Dummy hurd-loopback service, for use until cross-built Hurd
+;;; static-networking loopback bug is fixed.
+;;;
+
+(define (hurd-loopback-shepherd-service _)
+  "Return the 'loopback' Shepherd service."
+
+  (list (shepherd-service
+         (documentation "Dummy for bootstrapping (gnu services) on the Hurd.")
+         (provision '(loopback))
+         (requirement '())
+         (start #~(const #t))
+         (stop #~(const #t))
+         (respawn? #f))))
+
+(define hurd-loopback-service-type
+  (service-type
+   (name 'loopback)
+   (extensions (list (service-extension shepherd-root-service-type
+                                        hurd-loopback-shepherd-service)))
+   (default-value #f)
+   (description "Dummy service to bootstrap (gnu services) on the
+Hurd.")))
+
+
+;;;
 ;;; The Hurd getty service.
 ;;;