diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/system.scm | 24 | ||||
| -rw-r--r-- | guix/scripts/system/search.scm | 37 |
2 files changed, 59 insertions, 2 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index b50cabcd1a..af501eb8f7 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -583,7 +583,8 @@ any, are available. Raise an error if they're not." (define relevant (filter (lambda (fs) (and (file-system-mount? fs) - (not (string=? "tmpfs" (file-system-type fs))) + (not (member (file-system-type fs) + %pseudo-file-system-types)) (not (memq 'bind-mount (file-system-flags fs))))) file-systems)) @@ -592,6 +593,11 @@ any, are available. Raise an error if they're not." (eq? (file-system-title fs) 'label)) relevant)) + (define literal + (filter (lambda (fs) + (eq? (file-system-title fs) 'device)) + relevant)) + (define uuid (filter (lambda (fs) (eq? (file-system-title fs) 'uuid)) @@ -611,6 +617,22 @@ any, are available. Raise an error if they're not." (format (current-error-port) args ...)))))) (for-each (lambda (fs) + (catch 'system-error + (lambda () + (stat (file-system-device fs))) + (lambda args + (let ((errno (system-error-errno args)) + (device (file-system-device fs))) + (error (G_ "~a: error: device '~a' not found: ~a~%") + (file-system-location* fs) device + (strerror errno)) + (unless (string-prefix? "/" device) + (display-hint (format #f (G_ "If '~a' is a file system +label, you need to add @code{(title 'label)} to your @code{file-system} +definition.") + device))))))) + literal) + (for-each (lambda (fs) (unless (find-partition-by-label (file-system-device fs)) (error (G_ "~a: error: file system with label '~a' not found~%") (file-system-location* fs) diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm index b4f790c9bf..7229c60a02 100644 --- a/guix/scripts/system/search.scm +++ b/guix/scripts/system/search.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,9 +20,11 @@ #:use-module (guix ui) #:use-module (guix utils) #:use-module (gnu services) + #:use-module (gnu services shepherd) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) #:use-module (ice-9 regex) #:use-module (ice-9 match) #:export (service-type->recutils @@ -39,6 +41,29 @@ (define service-type-name* (compose symbol->string service-type-name)) +(define (service-type-default-shepherd-services type) + "Return the list of Shepherd services created by default instances of TYPE, +provided TYPE has a default value." + (match (guard (c ((service-error? c) #f)) + (service type)) + (#f '()) + ((? service? service) + (let* ((extension (find (lambda (extension) + (eq? (service-extension-target extension) + shepherd-root-service-type)) + (service-type-extensions type))) + (compute (and extension (service-extension-compute extension)))) + (if compute + (compute (service-value service)) + '()))))) + +(define (service-type-shepherd-names type) + "Return the default names of Shepherd services created for TYPE." + (match (map shepherd-service-provision + (service-type-default-shepherd-services type)) + (((names . _) ...) + names))) + (define* (service-type->recutils type port #:optional (width (%text-width)) #:key (extra-fields '())) @@ -66,6 +91,16 @@ columns." (format port "extends: ~a~%" (extensions->recutils (service-type-extensions type))) + ;; If possible, display the list of *default* Shepherd service names. Note + ;; that we may not always be able to do this (e.g., if the service type + ;; lacks a default value); furthermore, it could be that the service + ;; generates Shepherd services with different names if we give it different + ;; parameters (this is the case, for instance, for + ;; 'console-font-service-type'.) + (match (service-type-shepherd-names type) + (() #f) + (names (format port "shepherdnames:~{ ~a~}~%" names))) + (when (service-type-description type) (format port "~a~%" (string->recutils |