diff options
Diffstat (limited to 'guix/scripts/system.scm')
| -rw-r--r-- | guix/scripts/system.scm | 67 |
1 files changed, 45 insertions, 22 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 65eb98e4b2..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) @@ -64,6 +65,7 @@ (device-module-aliases matching-modules) #:use-module (gnu system linux-initrd) #:use-module (gnu image) + #:use-module (gnu platform) #:use-module (gnu system) #:use-module (gnu bootloader) #:use-module (gnu system file-systems) @@ -253,7 +255,7 @@ the ownership of '~a' may be incorrect!~%") (install-bootloader local-eval bootloader bootcfg #:target target) (return - (info (G_ "bootloader successfully installed on '~a'~%") + (info (G_ "bootloader successfully installed on~{ ~a~}~%") (bootloader-configuration-targets bootloader)))))))) @@ -688,6 +690,8 @@ 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) "Return as a monadic value the derivation for IMAGE according to ACTION." @@ -705,21 +709,18 @@ checking this by themselves in their 'check' procedure." ((vm) (system-qemu-image/shared-store-script os #:full-boot? full-boot? - #:disk-image-size - (if full-boot? - image-size - (* 70 (expt 2 20))) + #:volatile? volatile? + #:graphic? graphic? + #: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." @@ -771,6 +772,8 @@ and TARGET arguments." dry-run? derivations-only? use-substitutes? target full-boot? + volatile-vm-root? + (graphic? #t) container-shared-network? (mappings '()) (gc-root #f)) @@ -824,6 +827,9 @@ 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)) @@ -994,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")) @@ -1012,6 +1020,8 @@ Some ACTIONS support additional ARGS.\n")) (display (G_ " --full-boot for 'vm', make a full boot sequence")) (display (G_ " + --no-graphic for 'vm', use the tty that we are started in for IO")) + (display (G_ " --skip-checks skip file system and initrd module safety checks")) (display (G_ " --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) @@ -1073,13 +1083,19 @@ 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))) (option '("full-boot") #f #f (lambda (opt name arg result) (alist-cons 'full-boot? #t result))) + (option '("no-graphic") #f #f + (lambda (opt name arg result) + (alist-cons 'no-graphic? #t result))) (option '("save-provenance") #f #f (lambda (opt name arg result) (alist-cons 'save-provenance? #t result))) @@ -1139,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) @@ -1204,23 +1221,26 @@ 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) - obj)) - (base-target (image-target base-image))) + obj))) (image (inherit (if label (image-with-label base-image label) base-image)) - (target (or base-target target)) (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) @@ -1267,6 +1287,9 @@ 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?) #:mappings (filter-map (match-lambda @@ -1307,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) |