From 6ac8b7359a1ac80e558f41dd37004ffa727dd3c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 30 Apr 2018 12:57:23 +0200 Subject: [PATCH] guix system: search: Display default Shepherd service names. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . Reported by Clément Lassieur . * guix/scripts/system/search.scm (service-type-default-shepherd-services) (service-type-shepherd-names): New procedures. (service-type->recutils): Use it. * tests/guix-system.sh: Add test. --- guix/scripts/system/search.scm | 37 +++++++++++++++++++++++++++++++++- tests/guix-system.sh | 3 ++- 2 files changed, 38 insertions(+), 2 deletions(-) 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 +;;; Copyright © 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,9 +20,11 @@ (define-module (guix scripts system search) #: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-module (guix scripts system search) (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 @@ (define (extensions->recutils extensions) (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 diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 211c26f43d..ff9114ab74 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès +# Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès # Copyright © 2017 Tobias Geerinckx-Rice # Copyright © 2018 Chris Marusich # @@ -267,6 +267,7 @@ guix system build "$tmpdir/config.scm" -n # Searching. guix system search tor | grep "^name: tor" +guix system search tor | grep "^shepherdnames: tor" guix system search anonym network | grep "^name: tor" # Below, use -n (--dry-run) for the tests because if we actually tried to