projects/guix·blob ruby-team · refs

708 lines · 29.6 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016 Jan Nieuwenhuizen <[email protected]>
3;;; Copyright © 2016-2026 Ludovic Courtès <[email protected]>
4;;; Copyright © 2020 Brice Waegeneire <[email protected]>
5;;; Copyright © 2023 Giacomo Leidi <[email protected]>
6;;; Copyright © 2024 Gabriel Wicki <[email protected]>
7;;; Copyright © 2024 Richard Sent <[email protected]>
8;;;
9;;; This file is part of GNU Guix.
10;;;
11;;; GNU Guix is free software; you can redistribute it and/or modify it
12;;; under the terms of the GNU General Public License as published by
13;;; the Free Software Foundation; either version 3 of the License, or (at
14;;; your option) any later version.
15;;;
16;;; GNU Guix is distributed in the hope that it will be useful, but
17;;; WITHOUT ANY WARRANTY; without even the implied warranty of
18;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;;; GNU General Public License for more details.
20;;;
21;;; You should have received a copy of the GNU General Public License
22;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
23
24(define-module (gnu services admin)
25 #:use-module (gnu system file-systems)
26 #:use-module (gnu packages admin)
27 #:use-module ((gnu packages base)
28 #:select (canonical-package findutils coreutils sed))
29 #:use-module (gnu packages file-systems)
30 #:use-module (gnu packages nss)
31 #:use-module (gnu packages disk)
32 #:use-module (gnu packages package-management)
33 #:use-module (gnu packages linux)
34 #:use-module (gnu services)
35 #:use-module (gnu services configuration)
36 #:use-module (gnu services mcron)
37 #:use-module (gnu services shepherd)
38 #:use-module (gnu system accounts)
39 #:use-module ((gnu system shadow) #:select (account-service-type))
40 #:use-module ((guix store) #:select (%store-prefix))
41 #:use-module (guix deprecation)
42 #:use-module (guix gexp)
43 #:use-module (guix modules)
44 #:use-module (guix packages)
45 #:use-module (guix records)
46 #:use-module (srfi srfi-1)
47 #:use-module (ice-9 match)
48 #:use-module (ice-9 vlist)
49 #:export (log-rotation-configuration
50 log-rotation-configuration?
51 log-rotation-configuration-provision
52 log-rotation-configuration-requirement
53 log-rotation-configuration-calendar-event
54 log-rotation-configuration-external-log-files
55 log-rotation-configuration-compression
56 log-rotation-configuration-expiry
57 log-rotation-configuration-size-threshold
58 log-rotation-service-type
59
60 log-cleanup-service-type
61 log-cleanup-configuration
62 log-cleanup-configuration?
63 log-cleanup-configuration-directory
64 log-cleanup-configuration-expiry
65 log-cleanup-configuration-schedule
66
67 file-database-service-type
68 file-database-configuration
69 file-database-configuration?
70 file-database-configuration-package
71 file-database-configuration-schedule
72 file-database-configuration-excluded-directories
73 %default-file-database-update-schedule
74 %default-file-database-excluded-directories
75
76 package-database-service-type
77 package-database-configuration
78 package-database-configuration?
79 package-database-configuration-package
80 package-database-configuration-schedule
81 package-database-configuration-method
82 package-database-configuration-channels
83
84 unattended-upgrade-service-type
85 unattended-upgrade-configuration
86 unattended-upgrade-configuration?
87 unattended-upgrade-configuration-operating-system-file
88 unattended-upgrade-configuration-operating-system-expression
89 unattended-upgrade-configuration-channels
90 unattended-upgrade-configuration-schedule
91 unattended-upgrade-configuration-services-to-restart
92 unattended-upgrade-configuration-system-expiration
93 unattended-upgrade-configuration-maximum-duration
94 unattended-upgrade-configuration-log-file
95
96 resize-file-system-service-type
97 resize-file-system-configuration
98 resize-file-system-configuration?
99 resize-file-system-configuration-file-system
100 resize-file-system-configuration-cloud-utils
101 resize-file-system-configuration-e2fsprogs
102 resize-file-system-configuration-btrfs-progs
103 resize-file-system-configuration-bcachefs-tools))
104
105;;; Commentary:
106;;;
107;;; This module provides basic system administration tools: log rotation,
108;;; unattended upgrades, etc.
109;;;
110;;; Code:
111
112
113;;;
114;;; Shepherd's log rotation service.
115;;;
116
117(define %default-log-rotation-calendar-event
118 ;; Default calendar event when log rotation is triggered.
119 #~(calendar-event #:minutes '(0)
120 #:hours '(22)
121 #:days-of-week '(sunday)))
122
123(define (gexp-or-integer? x)
124 (or (gexp? x) (integer? x)))
125
126(define (gexp-or-symbol? x)
127 (or (gexp? x) (symbol? x)))
128
129(define-configuration log-rotation-configuration
130 (provision
131 (list-of-symbols '(log-rotation))
132 "The name(s) of the log rotation Shepherd service."
133 empty-serializer)
134 (requirement
135 (list-of-symbols (if for-home? '() '(user-processes)))
136 "Dependencies of the log rotation Shepherd service."
137 empty-serializer)
138 (calendar-event
139 (gexp %default-log-rotation-calendar-event)
140 "Gexp containing the @dfn{calendar event} when log rotation occurs.
141@xref{Timers,,, shepherd, The GNU Shepherd Manual}, for more information on
142calendar events."
143 empty-serializer)
144 (external-log-files
145 (list-of-strings '())
146 "List of file names, external log files that should also be
147rotated."
148 empty-serializer)
149 (compression
150 (gexp-or-symbol 'zstd)
151 "The compression method used for rotated log files, one of @code{'none},
152@code{'gzip}, and @code{'zstd}. Alternatively, it can be a gexp that evaluates
153to a procedure; that procedure gets called with the file to be rotated."
154 empty-serializer)
155 (expiry
156 (gexp-or-integer #~(%default-log-expiry))
157 "Age in seconds after which a log file is deleted."
158 empty-serializer)
159 (size-threshold
160 (gexp-or-integer #~(%default-rotation-size-threshold))
161 "Size in bytes below which a log file is @emph{not} rotated."
162 empty-serializer))
163
164(define (log-rotation-shepherd-services config)
165 (let* ((compression-raw (log-rotation-configuration-compression config))
166 (compression
167 (if (symbol? compression-raw)
168 #~'#$compression-raw
169 compression-raw)))
170 (list (shepherd-service
171 (provision (log-rotation-configuration-provision config))
172 (requirement (log-rotation-configuration-requirement config))
173 (modules '((shepherd service timer) ;for 'calendar-event'
174 (shepherd service log-rotation)))
175 (free-form #~(log-rotation-service
176 #$(log-rotation-configuration-calendar-event config)
177 #:provision
178 '#$(log-rotation-configuration-provision config)
179 #:requirement
180 '#$(log-rotation-configuration-requirement config)
181 #:external-log-files
182 '#$(log-rotation-configuration-external-log-files
183 config)
184 #:compression
185 #$compression
186 #:expiry
187 #$(log-rotation-configuration-expiry config)
188 #:rotation-size-threshold
189 #$(log-rotation-configuration-size-threshold
190 config)))))))
191
192(define log-rotation-service-type
193 (service-type
194 (name 'log-rotation)
195 (description
196 "Periodically rotate log files using the Shepherd's log rotation service.
197Run @command{herd status log-rotation} to view its status, @command{herd files
198log-rotation} to list files subject to log rotation.")
199 (extensions (list (service-extension shepherd-root-service-type
200 log-rotation-shepherd-services)))
201 (compose concatenate)
202 (extend (lambda (config log-files)
203 (log-rotation-configuration
204 (inherit config)
205 (external-log-files
206 (append (log-rotation-configuration-external-log-files config)
207 log-files)))))
208 (default-value (log-rotation-configuration))))
209
210
211;;;
212;;; Build log removal.
213;;;
214
215(define-record-type* <log-cleanup-configuration>
216 log-cleanup-configuration make-log-cleanup-configuration
217 log-cleanup-configuration?
218 (directory log-cleanup-configuration-directory) ;string
219 (expiry log-cleanup-configuration-expiry ;integer (seconds)
220 (default (* 6 30 24 3600)))
221 (schedule log-cleanup-configuration-schedule ;string or gexp
222 (default "30 12 01,08,15,22 * *")))
223
224(define (log-cleanup-program directory expiry)
225 (program-file "delete-old-logs"
226 (with-imported-modules '((guix build utils))
227 #~(begin
228 (use-modules (guix build utils))
229 (let* ((now (car (gettimeofday)))
230 (logs (find-files #$directory
231 (lambda (file stat)
232 (> (- now (stat:mtime stat))
233 #$expiry)))))
234 (format #t "deleting ~a log files from '~a'...~%"
235 (length logs) #$directory)
236 (for-each delete-file logs))))))
237
238(define (log-cleanup-shepherd-services configuration)
239 (match-record configuration <log-cleanup-configuration>
240 (directory expiry schedule)
241 (let ((program (log-cleanup-program directory expiry)))
242 (list (shepherd-service
243 (provision '(log-cleanup))
244 (requirement '(user-processes))
245 (modules '((shepherd service timer)))
246 (start #~(make-timer-constructor
247 #$(if (string? schedule)
248 #~(cron-string->calendar-event #$schedule)
249 schedule)
250 (command '(#$program))))
251 (stop #~(make-timer-destructor))
252 (actions (list shepherd-trigger-action))
253 (documentation "Periodically delete old log files."))))))
254
255(define log-cleanup-service-type
256 (service-type
257 (name 'log-cleanup)
258 (extensions
259 (list (service-extension shepherd-root-service-type
260 log-cleanup-shepherd-services)))
261 (description
262 "Periodically delete old log files.")))
263
264
265;;;
266;;; File databases.
267;;;
268
269(define %default-file-database-update-schedule
270 ;; Default mcron schedule for the periodic 'updatedb' job: once every
271 ;; Sunday.
272 "10 23 * * 0")
273
274(define %default-file-database-excluded-directories
275 ;; Regexps of directories excluded from the 'locate' database.
276 (list (%store-prefix)
277 "/tmp" "/var/tmp" "/var/cache" ".*/\\.cache"
278 "/run/udev" "/dev"))
279
280(define (string-or-gexp? obj)
281 (or (string? obj) (gexp? obj)))
282
283(define string-list?
284 (match-lambda
285 (((? string?) ...) #t)
286 (_ #f)))
287
288(define-configuration/no-serialization file-database-configuration
289 (package
290 (file-like (let-system (system target)
291 ;; Unless we're cross-compiling, avoid pulling a second copy
292 ;; of findutils.
293 (if target
294 findutils
295 (canonical-package findutils))))
296 "The package from which the @command{updatedb} command is taken.
297Examples of such packages are GNU@tie{}Findutils and Plocate.")
298 (schedule
299 (string-or-gexp %default-file-database-update-schedule)
300 "String or G-exp denoting an mcron schedule for the periodic
301@command{updatedb} job (@pxref{Guile Syntax,,, mcron, GNU@tie{}mcron}).")
302 (excluded-directories
303 (string-list %default-file-database-excluded-directories)
304 "List of regular expressions of directories to ignore when building the
305file database. By default, this includes @file{/tmp} and @file{/gnu/store};
306the latter should instead be indexed by @command{guix locate} (@pxref{Invoking
307guix locate}). This list is passed to the @option{--prunepaths} option of
308@command{updatedb} (@pxref{Invoking updatedb,,, find, GNU@tie{}Findutils})."))
309
310(define (file-database-shepherd-services configuration)
311 (match-record configuration <file-database-configuration>
312 (package schedule excluded-directories)
313 (let ((updatedb (program-file
314 "updatedb"
315 #~(begin
316 (define updatedb
317 (let ((try (lambda (file)
318 (and (file-exists? file) file))))
319 (or (try #$(file-append package "/bin/updatedb"))
320 (try #$(file-append package "/sbin/updatedb")))))
321 ;; 'updatedb' is a shell script that expects various
322 ;; commands in $PATH.
323 (setenv "PATH"
324 (string-append (dirname updatedb) ":"
325 #$(canonical-package coreutils)
326 "/bin:"
327 #$(canonical-package sed)
328 "/bin"))
329 (execl updatedb
330 "updatedb"
331 #$(string-append "--prunepaths="
332 (string-join
333 excluded-directories)))))))
334 (list (shepherd-service
335 (provision '(file-database-update))
336 (requirement '(user-processes))
337 (modules '((shepherd service timer)))
338 (start #~(make-timer-constructor
339 #$(if (string? schedule)
340 #~(cron-string->calendar-event #$schedule)
341 schedule)
342 (command '(#$updatedb))
343 #:wait-for-termination? #t))
344 (stop #~(make-timer-destructor))
345 (documentation
346 "Periodically update the system-wide file database that can be
347queried by the 'locate' command.")
348 (actions (list shepherd-trigger-action)))))))
349
350(define file-database-service-type
351 (service-type
352 (name 'file-database)
353 (extensions (list (service-extension shepherd-root-service-type
354 file-database-shepherd-services)))
355 (description
356 "Periodically update the file database used by the @command{locate} command,
357which lets you search for files by name. The database is created by running
358the @command{updatedb} command.")
359 (default-value (file-database-configuration))))
360
361(define %default-package-database-update-schedule
362 ;; Default mcron schedule for the periodic 'guix locate --update' job: once
363 ;; every Monday.
364 "10 23 * * 1")
365
366(define-configuration/no-serialization package-database-configuration
367 (package (file-like guix)
368 "The Guix package to use.")
369 (schedule (string-or-gexp
370 %default-package-database-update-schedule)
371 "String or G-exp denoting an mcron schedule for the periodic
372@command{guix locate --update} job (@pxref{Guile Syntax,,, mcron,
373GNU@tie{}mcron}).")
374 (method (symbol 'store)
375 "Indexing method for @command{guix locate}. The default value,
376@code{'store}, yields a more complete database but is relatively expensive in
377terms of CPU and input/output.")
378 (channels (gexp #~%default-channels)
379 "G-exp denoting the channels to use when updating the database
380(@pxref{Channels})."))
381
382(define %package-database-file
383 ;; System-wide package database used by 'guix locate'.
384 ;; See 'system-database-file' in (guix scripts locate).
385 "/var/cache/guix/locate/db.sqlite")
386
387(define %package-database-accounts
388 (list (user-account
389 (name "guix-locate")
390 (group "guix-locate")
391 (system? #t)
392 (comment "Account running 'guix locate'")
393 (home-directory "/var/run/guix-locate"))
394 (user-group
395 (name "guix-locate")
396 (system? #t))))
397
398(define %package-database-activation
399 ;; Create the package database directory at activation time. Make it
400 ;; writable by 'guix-locate' and world-readable.
401 #~(begin
402 (use-modules (guix build utils))
403 (let ((directory #$(dirname %package-database-file))
404 (owner (getpwnam "guix-locate")))
405 (mkdir-p/perms directory owner #o755))))
406
407(define (package-database-shepherd-services configuration)
408 (match-record configuration <package-database-configuration>
409 (package schedule method channels)
410 (let ((channels (scheme-file "channels.scm" channels)))
411 (list (shepherd-service
412 (provision '(package-database-update))
413 (requirement '(user-processes guix-daemon))
414 (modules '((shepherd service timer)))
415 (start #~(make-timer-constructor
416 #$(if (string? schedule)
417 #~(cron-string->calendar-event #$schedule)
418 schedule)
419 (command '(#$(file-append package "/bin/guix")
420 "time-machine" "-C" #$channels
421 "--" "locate" "--update"
422 #$(string-append "--database="
423 %package-database-file)
424 #$(string-append
425 "--method=" (symbol->string method)))
426 #:user "guix-locate"
427 #:group "guix-locate")
428 #:log-file "/var/log/guix-locate.log"
429 #:wait-for-termination? #t))
430 (stop #~(make-timer-destructor))
431 (documentation
432 "Periodically update the system-wide package database that can
433be queried by the 'guix locate' command.")
434 (actions (list shepherd-trigger-action)))))))
435
436(define package-database-service-type
437 (service-type
438 (name 'package-database)
439 (extensions (list (service-extension shepherd-root-service-type
440 package-database-shepherd-services)
441 (service-extension activation-service-type
442 (const %package-database-activation))
443 (service-extension account-service-type
444 (const %package-database-accounts))))
445 (description
446 "Periodically update the package database used by the @code{guix locate} command,
447which lets you search for packages that provide a given file.")
448 (default-value (package-database-configuration))))
449
450
451;;;
452;;; Unattended upgrade.
453;;;
454
455(define-record-type* <unattended-upgrade-configuration>
456 unattended-upgrade-configuration make-unattended-upgrade-configuration
457 unattended-upgrade-configuration?
458 (operating-system-file unattended-upgrade-operating-system-file
459 (default "/run/current-system/configuration.scm"))
460 (operating-system-expression unattended-upgrade-operating-system-expression
461 (default #f))
462 (schedule unattended-upgrade-configuration-schedule
463 (default "30 01 * * 0"))
464 (channels unattended-upgrade-configuration-channels
465 (default #~%default-channels))
466 (reboot? unattended-upgrade-configuration-reboot?
467 (default #f))
468 (services-to-restart unattended-upgrade-configuration-services-to-restart
469 (default '(unattended-upgrade)))
470 (system-expiration unattended-upgrade-system-expiration
471 (default (* 3 30 24 3600)))
472 (maximum-duration unattended-upgrade-maximum-duration
473 (default 3600))
474 (log-file unattended-upgrade-configuration-log-file
475 (default %unattended-upgrade-log-file)))
476
477(define %unattended-upgrade-log-file
478 "/var/log/unattended-upgrade.log")
479
480(define (unattended-upgrade-shepherd-services config)
481 (define channels
482 (scheme-file "channels.scm"
483 (unattended-upgrade-configuration-channels config)))
484
485 (define log
486 (unattended-upgrade-configuration-log-file config))
487
488 (define schedule
489 (unattended-upgrade-configuration-schedule config))
490
491 (define services
492 (unattended-upgrade-configuration-services-to-restart config))
493
494 (define reboot?
495 (unattended-upgrade-configuration-reboot? config))
496
497 (define expiration
498 (unattended-upgrade-system-expiration config))
499
500 (define config-file
501 (unattended-upgrade-operating-system-file config))
502
503 (define expression
504 (unattended-upgrade-operating-system-expression config))
505
506 (define arguments
507 (if expression
508 #~(list "-e" (object->string '#$expression))
509 #~(list #$config-file)))
510
511 (define code
512 (with-imported-modules (source-module-closure '((guix build utils)
513 (gnu services herd)))
514 #~(begin
515 (use-modules (guix build utils)
516 (gnu services herd)
517 (srfi srfi-34))
518
519 (setvbuf (current-output-port) 'line)
520 (setvbuf (current-error-port) 'line)
521
522 ;; 'guix time-machine' needs X.509 certificates to authenticate the
523 ;; Git host.
524 (setenv "SSL_CERT_DIR"
525 #$(file-append nss-certs "/etc/ssl/certs"))
526
527 (format #t "starting upgrade...~%")
528 (guard (c ((invoke-error? c)
529 (report-invoke-error c)
530 (exit 1)))
531 (apply invoke #$(file-append guix "/bin/guix")
532 "time-machine" "-C" #$channels
533 "--" "system" "reconfigure" #$arguments)
534
535 ;; 'guix system delete-generations' fails when there's no
536 ;; matching generation. Thus, catch 'invoke-error?'.
537 (guard (c ((invoke-error? c)
538 (report-invoke-error c)))
539 (invoke #$(file-append guix "/bin/guix")
540 "system" "delete-generations"
541 #$(string-append (number->string expiration)
542 "s")))
543
544 (unless #$reboot?
545 ;; Rebooting effectively restarts services anyway and execution
546 ;; would be halted here if mcron is restarted.
547 (format #t "restarting services...~%")
548 (for-each restart-service '#$services))
549
550 ;; XXX: If this service has been restarted, this is not reached.
551 (format #t "upgrade complete~%")
552
553 ;; Stopping the root shepherd service triggers a reboot.
554 (when #$reboot?
555 (format #t "rebooting system~%")
556 (force-output) ;ensure the entire log is written.
557 (stop-service 'root))))))
558
559 (define upgrade
560 (program-file "unattended-upgrade" code))
561
562 (list (shepherd-service
563 (provision '(unattended-upgrade))
564 (requirement '(user-processes networking))
565 (modules '((shepherd service timer)))
566 (start #~(make-timer-constructor
567 #$(if (string? schedule)
568 #~(cron-string->calendar-event #$schedule)
569 schedule)
570 (command '(#$upgrade))
571
572 #:log-file #$log
573
574 ;; Make sure the upgrade doesn't take too long.
575 #:max-duration
576 #$(unattended-upgrade-maximum-duration config)
577
578 ;; Wait for the previous attempt to terminate before trying
579 ;; again.
580 #:wait-for-termination? #t))
581 (stop #~(make-timer-destructor))
582 (actions (list shepherd-trigger-action)))))
583
584(define unattended-upgrade-service-type
585 (service-type
586 (name 'unattended-upgrade)
587 (extensions
588 (list (service-extension shepherd-root-service-type
589 unattended-upgrade-shepherd-services)))
590 (description
591 "Periodically upgrade the system from the current configuration.")
592 (default-value (unattended-upgrade-configuration))))
593
594;;;
595;;; Resize file system.
596;;;
597
598(define-record-type* <resize-file-system-configuration>
599 resize-file-system-configuration make-resize-file-system-configuration
600 resize-file-system-configuration?
601 (file-system resize-file-system-file-system)
602 (cloud-utils resize-file-system-cloud-utils
603 (default cloud-utils))
604 (e2fsprogs resize-file-system-e2fsprogs
605 (default e2fsprogs))
606 (btrfs-progs resize-file-system-btrfs-progs
607 (default btrfs-progs))
608 (bcachefs-tools resize-file-system-bcachefs-tools
609 (default bcachefs-tools)))
610
611(define (resize-file-system-shepherd-service config)
612 "Returns a <shepherd-service> for resize-file-system-service for CONFIG."
613 (match-record config <resize-file-system-configuration>
614 (file-system cloud-utils e2fsprogs btrfs-progs
615 bcachefs-tools)
616 (let ((fs-spec (file-system->spec file-system)))
617 (shepherd-service
618 (documentation "Resize a file system. Intended for Guix Systems that
619are booted from a system image flashed onto a larger medium.")
620 ;; XXX: This could be extended with file-system info.
621 (provision '(resize-file-system))
622 (requirement '(user-processes))
623 (one-shot? #t)
624 (respawn? #f)
625 (modules '((guix build utils)
626 (gnu build file-systems)
627 (gnu system file-systems)
628 (ice-9 control)
629 (ice-9 match)
630 (ice-9 ftw)
631 (ice-9 rdelim)
632 (srfi srfi-34)))
633 (start (with-imported-modules (source-module-closure
634 '((guix build utils)
635 (gnu build file-systems)
636 (gnu system file-systems)))
637 #~(lambda _
638 (use-modules (guix build utils)
639 (gnu build file-systems)
640 (gnu system file-systems)
641 (ice-9 control)
642 (ice-9 match)
643 (ice-9 ftw)
644 (ice-9 rdelim)
645 (srfi srfi-34))
646
647 (define file-system
648 (spec->file-system '#$fs-spec))
649
650 ;; Shepherd recommends the start constructor takes <1
651 ;; minute, canonicalize-device-spec will hang for up to
652 ;; max-trials seconds (20 seconds) if an invalid device is
653 ;; connected. Revisit this if max-trials increases.
654 (define device (canonicalize-device-spec
655 (file-system-device file-system)))
656
657 (define grow-partition-command
658 (let* ((sysfs-device
659 (string-append "/sys/class/block/"
660 (basename device)))
661 (partition-number
662 (with-input-from-file
663 (string-append sysfs-device
664 "/partition")
665 read-line))
666 (parent (string-append
667 "/dev/"
668 (basename (dirname (readlink sysfs-device))))))
669 (list #$(file-append cloud-utils "/bin/growpart")
670 parent partition-number)))
671
672 (define grow-filesystem-command
673 (match (file-system-type file-system)
674 ((or "ext2" "ext3" "ext4")
675 (list #$(file-append e2fsprogs "/sbin/resize2fs") device))
676 ("btrfs"
677 (list #$(file-append btrfs-progs "/bin/btrfs")
678 "filesystem" "resize" device))
679 ("bcachefs"
680 (list #$(file-append bcachefs-tools "/sbin/bcachefs")
681 "device" "resize" device))
682 (e (error "Unsupported filesystem type" e))))
683
684 (let/ec return
685 (guard (c ((and (invoke-error? c)
686 ;; growpart NOCHANGE exits with 1. It is
687 ;; unlikely the partition was resized
688 ;; while the file system was not. Just
689 ;; exit.
690 (equal? (invoke-error-exit-status c) 1))
691 (format (current-error-port)
692 "The device ~a is already resized.~%" device)
693 ;; Must return something or Shepherd considers
694 ;; the service perpetually starting.
695 (return 0)))
696 (apply invoke grow-partition-command))
697 (apply invoke grow-filesystem-command)))))))))
698
699(define resize-file-system-service-type
700 (service-type
701 (name 'resize-file-system)
702 (description "Resize a partition and the underlying file system during boot.")
703 (extensions
704 (list
705 (service-extension shepherd-root-service-type
706 (compose list resize-file-system-shepherd-service))))))
707
708;;; admin.scm ends here