diff options
Diffstat (limited to 'guix/scripts/system.scm')
| -rw-r--r-- | guix/scripts/system.scm | 50 |
1 files changed, 32 insertions, 18 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 1db788a534..414e931c8a 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -57,6 +57,7 @@ #:use-module (guix build utils) #:use-module (guix progress) #:use-module ((guix build syscalls) #:select (terminal-columns)) + #:use-module (gnu build image) #:use-module (gnu build install) #:autoload (gnu build file-systems) (find-partition-by-label find-partition-by-uuid) @@ -689,6 +690,7 @@ checking this by themselves in their 'check' procedure." (define* (system-derivation-for-action image action #:key full-boot? + volatile? (graphic? #t) container-shared-network? mappings) @@ -707,22 +709,18 @@ checking this by themselves in their 'check' procedure." ((vm) (system-qemu-image/shared-store-script os #:full-boot? full-boot? + #:volatile? volatile? #:graphic? graphic? - #:disk-image-size - (if full-boot? - image-size - (* 70 (expt 2 20))) + #:disk-image-size image-size #:mappings mappings)) - ((image disk-image vm-image) + ((image disk-image vm-image docker-image) (when (eq? action 'disk-image) (warning (G_ "'disk-image' is deprecated: use 'image' instead~%"))) (when (eq? action 'vm-image) (warning (G_ "'vm-image' is deprecated: use 'image' instead~%"))) - (lower-object (system-image image))) - ((docker-image) - (system-docker-image os - #:memory-size 1024 - #:shared-network? container-shared-network?))))) + (when (eq? action 'docker-image) + (warning (G_ "'docker-image' is deprecated: use 'image' instead~%"))) + (lower-object (system-image image)))))) (define (maybe-suggest-running-guix-pull) "Suggest running 'guix pull' if this has never been done before." @@ -774,6 +772,7 @@ and TARGET arguments." dry-run? derivations-only? use-substitutes? target full-boot? + volatile-vm-root? (graphic? #t) container-shared-network? (mappings '()) @@ -828,6 +827,8 @@ static checks." (mlet* %store-monad ((sys (system-derivation-for-action image action #:full-boot? full-boot? + #:volatile? + volatile-vm-root? #:graphic? graphic? #:container-shared-network? container-shared-network? #:mappings mappings)) @@ -999,6 +1000,8 @@ Some ACTIONS support additional ARGS.\n")) (display (G_ " --volatile for 'image', make the root file system volatile")) (display (G_ " + --persistent for 'vm', make the root file system persistent")) + (display (G_ " --label=LABEL for 'image', label disk image with LABEL")) (display (G_ " --save-provenance save provenance information")) @@ -1080,7 +1083,10 @@ Some ACTIONS support additional ARGS.\n")) (alist-cons 'install-bootloader? #f result))) (option '("volatile") #f #f (lambda (opt name arg result) - (alist-cons 'volatile-root? #t result))) + (alist-cons 'volatile-image-root? #t result))) + (option '("persistent") #f #f + (lambda (opt name arg result) + (alist-cons 'volatile-vm-root? #f result))) (option '("label") #t #f (lambda (opt name arg result) (alist-cons 'label arg result))) @@ -1149,7 +1155,8 @@ Some ACTIONS support additional ARGS.\n")) (image-size . guess) (install-bootloader? . #t) (label . #f) - (volatile-root? . #f) + (volatile-image-root? . #f) + (volatile-vm-root? . #t) (graph-backend . "graphviz"))) (define (verbosity-level opts) @@ -1214,11 +1221,15 @@ resulting from command-line parsing." (label (assoc-ref opts 'label)) (image-type (lookup-image-type-by-name (assoc-ref opts 'image-type))) - (image (let* ((image-type (if (eq? action 'vm-image) - qcow2-image-type - image-type)) + (image (let* ((image-type (case action + ((vm-image) qcow2-image-type) + ((docker-image) docker-image-type) + (else image-type))) (image-size (assoc-ref opts 'image-size)) - (volatile? (assoc-ref opts 'volatile-root?)) + (volatile? + (assoc-ref opts 'volatile-image-root?)) + (shared-network? + (assoc-ref opts 'container-shared-network?)) (base-image (if (operating-system? obj) (os->image obj #:type image-type) @@ -1228,7 +1239,8 @@ resulting from command-line parsing." (image-with-label base-image label) base-image)) (size image-size) - (volatile-root? volatile?)))) + (volatile-root? volatile?) + (shared-network? shared-network?)))) (os (image-operating-system image)) (target-file (match args ((first second) second) @@ -1275,6 +1287,8 @@ resulting from command-line parsing." #:validate-reconfigure (assoc-ref opts 'validate-reconfigure) #:full-boot? (assoc-ref opts 'full-boot?) + #:volatile-vm-root? + (assoc-ref opts 'volatile-vm-root?) #:graphic? (not (assoc-ref opts 'no-graphic?)) #:container-shared-network? (assoc-ref opts 'container-shared-network?) @@ -1316,7 +1330,7 @@ argument list and OPTS is the option alist." ((describe) (match (generation-number %system-profile) (0 - (error (G_ "no system generation, nothing to describe~%"))) + (leave (G_ "no system generation, nothing to describe~%"))) (generation (display-system-generation generation)))) ((search) |