diff options
Diffstat (limited to 'gnu/build')
-rw-r--r-- | gnu/build/file-systems.scm | 27 | ||||
-rw-r--r-- | gnu/build/vm.scm | 16 |
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))) ;;; |