From f83e943fe7b7a4db93a6c603b9fdde57a35e918d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 25 Sep 2013 23:26:08 +0200
Subject: [PATCH] gnu: vm: Add 'networking' service.

* gnu/system/vm.scm (system-qemu-image): Use
  'static-networking-service'.  Add /etc/resolv.conf.  Add Inetutils to
  the profile.
* gnu/system/dmd.scm (static-networking-service): New procedure.
---
 gnu/system/dmd.scm | 18 ++++++++++++++++++
 gnu/system/vm.scm  | 13 ++++++++++++-
 2 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm
index 5bdf7b7a05..7fc4650c25 100644
--- a/gnu/system/dmd.scm
+++ b/gnu/system/dmd.scm
@@ -40,6 +40,8 @@ (define-module (gnu system dmd)
             syslog-service
             mingetty-service
             guix-service
+            static-networking-service
+
             dmd-configuration-file))
 
 ;;; Commentary:
@@ -131,6 +133,22 @@ (define* (guix-service store #:key (guix guix))
      (start `(make-forkexec-constructor ,daemon))
      (inputs `(("guix" ,guix))))))
 
+(define* (static-networking-service store interface ip
+                                    #:key (inetutils inetutils))
+  "Return a service that starts INTERFACE with address IP."
+
+  ;; TODO: Eventually we should do this using Guile's networking procedures,
+  ;; like 'configure-qemu-networking' does, but the patch that does this is
+  ;; not yet in stock Guile.
+  (let ((ifconfig (string-append (package-output store inetutils)
+                                 "/bin/ifconfig")))
+    (service
+     (provision '(networking))
+     (start `(make-forkexec-constructor ,ifconfig ,interface ,ip "up"))
+     (stop  `(make-forkexec-constructor ,ifconfig ,interface "down"))
+     (respawn? #f)
+     (inputs `(("inetutils" ,inetutils))))))
+
 
 (define (dmd-configuration-file store services)
   "Return the dmd configuration file for SERVICES."
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index dd97e5ee0d..b873386606 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -455,7 +455,15 @@ (define %dmd-services
           (mingetty-service store "tty5")
           (mingetty-service store "tty6")
           (syslog-service store)
-          (guix-service store #:guix guix-0.4)))
+          (guix-service store #:guix guix-0.4)
+
+          ;; QEMU networking settings.
+          (static-networking-service store "eth0" "10.0.2.10")))
+
+  (define resolv.conf
+    ;; Name resolution for default QEMU settings.
+    (add-text-to-store store "resolv.conf"
+                       "nameserver 10.0.2.3\n"))
 
   (parameterize ((%guile-for-build (package-derivation store guile-final)))
     (let* ((bash-drv  (package-derivation store bash))
@@ -480,6 +488,7 @@ (define %dmd-services
                        ("dmd" ,dmd)
                        ("gcc" ,gcc-final)
                        ("libc" ,glibc-final)
+                       ("inetutils" ,inetutils)
                        ("guix" ,guix-0.4)))
 
            ;; TODO: Replace with a real profile with a manifest.
@@ -514,6 +523,7 @@ (define %dmd-services
                        ("/etc/passwd" -> ,passwd)
                        ("/etc/login.defs" -> "/dev/null")
                        ("/etc/pam.d" -> ,pam.d)
+                       ("/etc/resolv.conf" -> ,resolv.conf)
                        ("/etc/profile" -> ,bashrc)
                        ("/etc/issue" -> ,issue)
                        (directory "/var/nix/gcroots")
@@ -552,6 +562,7 @@ (define %dmd-services
                                      ("etc-passwd" ,passwd)
                                      ("etc-shadow" ,shadow)
                                      ("etc-group" ,group)
+                                     ("etc-resolv.conf" ,resolv.conf)
                                      ("etc-bashrc" ,bashrc)
                                      ("etc-issue" ,issue)
                                      ("etc-motd" ,motd)