From 59c5c4dee1f95e26f018ba4f88666f7cdf824ff6 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 26 Sep 2013 21:10:53 +0200
Subject: gnu: vm: Set the default networking route.

* gnu/system/dmd.scm (static-networking-service): Add #:gateway
  parameter and honor it.
* gnu/system/vm.scm (system-qemu-image): Pass #:gateway to
  'static-networking-service'.
---
 gnu/system/dmd.scm | 26 +++++++++++++++++++++-----
 gnu/system/vm.scm  |  3 ++-
 2 files changed, 23 insertions(+), 6 deletions(-)

diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm
index b248d9f0c5..bcafd910dd 100644
--- a/gnu/system/dmd.scm
+++ b/gnu/system/dmd.scm
@@ -27,6 +27,8 @@
                 #:select (mingetty inetutils))
   #:use-module ((gnu packages package-management)
                 #:select (guix))
+  #:use-module ((gnu packages linux)
+                #:select (net-tools))
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:export (service?
@@ -155,20 +157,34 @@
      (inputs `(("guix" ,guix))))))
 
 (define* (static-networking-service store interface ip
-                                    #:key (inetutils inetutils))
-  "Return a service that starts INTERFACE with address IP."
+                                    #:key
+                                    gateway
+                                    (inetutils inetutils)
+                                    (net-tools net-tools))
+  "Return a service that starts INTERFACE with address IP.  If GATEWAY is
+true, it must be a string specifying the default network gateway."
 
   ;; 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")))
+                                 "/bin/ifconfig"))
+        (route    (string-append (package-output store net-tools)
+                                 "/sbin/route")))
     (service
      (provision '(networking))
-     (start `(make-forkexec-constructor ,ifconfig ,interface ,ip "up"))
+     (start `(lambda _
+               (and (zero? (system* ,ifconfig ,interface ,ip "up"))
+                    ,(if gateway
+                         `(zero? (system* ,route "add" "-net" "default"
+                                          "gw" ,gateway))
+                         #t))))
      (stop  `(make-forkexec-constructor ,ifconfig ,interface "down"))
      (respawn? #f)
-     (inputs `(("inetutils" ,inetutils))))))
+     (inputs `(("inetutils" ,inetutils)
+               ,@(if gateway
+                     `(("net-tools" ,net-tools))
+                     '()))))))
 
 
 (define (dmd-configuration-file store services)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 0ed805510a..72530e3809 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -459,7 +459,8 @@ Happy birthday, GNU!                                http://www.gnu.org/gnu30
           (nscd-service store)
 
           ;; QEMU networking settings.
-          (static-networking-service store "eth0" "10.0.2.10")))
+          (static-networking-service store "eth0" "10.0.2.10"
+                                     #:gateway "10.0.2.2")))
 
   (define resolv.conf
     ;; Name resolution for default QEMU settings.
-- 
cgit v1.2.3