summary refs log tree commit diff
path: root/gnu/build
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/file-systems.scm27
-rw-r--r--gnu/build/vm.scm16
2 files changed, 32 insertions, 11 deletions
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 0d55e91978..431b287d0c 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -464,6 +464,27 @@ form:
 DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f;
 FLAGS must be a list of symbols.  CHECK? is a Boolean indicating whether to
 run a file system check."
+
+  (define (mount-nfs source mount-point type flags options)
+    (let* ((idx (string-rindex source #\:))
+           (host-part (string-take source idx))
+           ;; Strip [] from around host if present
+           (host (match (string-split host-part (string->char-set "[]"))
+                 (("" h "") h)
+                 ((h) h)))
+           (aa (match (getaddrinfo host "nfs") ((x . _) x)))
+           (sa (addrinfo:addr aa))
+           (inet-addr (inet-ntop (sockaddr:fam sa)
+                                 (sockaddr:addr sa))))
+
+      ;; Mounting an NFS file system requires passing the address
+      ;; of the server in the addr= option
+      (mount source mount-point type flags
+             (string-append "addr="
+                            inet-addr
+                            (if options
+                                (string-append "," options)
+                                "")))))
   (match spec
     ((source title mount-point type (flags ...) options check?)
      (let ((source      (canonicalize-device-spec source title))
@@ -481,7 +502,11 @@ run a file system check."
              (call-with-output-file mount-point (const #t)))
            (mkdir-p mount-point))
 
-       (mount source mount-point type flags options)
+       (cond
+        ((string-prefix? "nfs" type)
+         (mount-nfs source mount-point type flags options))
+        (else
+         (mount source mount-point type flags options)))
 
        ;; For read-only bind mounts, an extra remount is needed, as per
        ;; <http://lwn.net/Articles/281157/>, which still applies to Linux 4.0.
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index cc5cf45362..60ee18ebe0 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -79,12 +79,9 @@ it via /dev/hda.
 
 REFERENCES-GRAPHS can specify a list of reference-graph files as produced by
 the #:references-graphs parameter of 'derivation'."
-  (define image-file
-    (string-append "image." disk-image-format))
-
   (when make-disk-image?
     (unless (zero? (system* "qemu-img" "create" "-f" disk-image-format
-                            image-file
+                            output
                             (number->string disk-image-size)))
       (error "qemu-img failed")))
 
@@ -115,7 +112,7 @@ the #:references-graphs parameter of 'derivation'."
                                            builder)
                   (append
                    (if make-disk-image?
-                       `("-drive" ,(string-append "file=" image-file
+                       `("-drive" ,(string-append "file=" output
                                                   ",if=virtio"))
                        '())
                    ;; Only enable kvm if we see /dev/kvm exists.
@@ -126,11 +123,10 @@ the #:references-graphs parameter of 'derivation'."
                        '()))))
     (error "qemu failed" qemu))
 
-  (if make-disk-image?
-      (copy-file image-file output)
-      (begin
-        (mkdir output)
-        (copy-recursively "xchg" output))))
+  ;; When MAKE-DISK-IMAGE? is true, the image is in OUTPUT already.
+  (unless make-disk-image?
+    (mkdir output)
+    (copy-recursively "xchg" output)))
 
 
 ;;;