[shepherd] 05/07: Remove runlevels.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit e0823eb9c08fde985d84689eab625d206e484514
Author: Ludovic Courtès <address@hidden>
Date:   Wed Sep 19 16:29:16 2018 +0200

    Remove runlevels.
    
    This feature was never fully implemented and there's little interest in
    having it nowadays.
    
    * modules/shepherd/runlevel.scm: Remove.
    * Makefile.am (dist_shepherdsub_DATA): Remove it.
    * doc/shepherd.texi (Runlevels): Remove node.
    * modules/shepherd.scm: Remove use of (shepherd runlevel).
    * modules/shepherd.scm (start-in-order): New procedure, salvaged from
    runlevel.scm.
---
 Makefile.am                   |   1 -
 doc/shepherd.texi             |  20 -----
 modules/shepherd.scm          |  21 ++++-
 modules/shepherd/runlevel.scm | 196 ------------------------------------------
 4 files changed, 20 insertions(+), 218 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index d9e21e9..58438fe 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -40,7 +40,6 @@ dist_shepherdsub_DATA =                               \
   modules/shepherd/args.scm                    \
   modules/shepherd/service.scm                 \
   modules/shepherd/support.scm                 \
-  modules/shepherd/runlevel.scm                        \
   modules/shepherd/comm.scm
 nodist_shepherdsub_DATA =                      \
   modules/shepherd/config.scm                  \
diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index f0498d6..f54fa6f 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -59,7 +59,6 @@ service manager for the GNU system.
 * Jump Start::        How to do simple things with the Shepherd.
 * herd and shepherd:: User interface to service management.
 * Services::          Details on services.
-* Runlevels::         Details on runlevels.
 * Misc Facilities::   Generally useful things provided by the Shepherd.
 * Internals::         Hacking shepherd.
 
@@ -1039,25 +1038,6 @@ of unusual things.
 
 @c @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 
address@hidden Runlevels
address@hidden Runlevels
-
-RUNLEVELS DO NOT WORK YET! Do not use them! Ignore this section!
-
address@hidden runlevel
address@hidden <runlevel>
-A @dfn{runlevel} makes it easier to start and stop groups of services,
-to bring the system into a certain state.  An object of class
address@hidden<runlevel>} is an abstract runlevel, and has the following
-methods:
-
address@hidden {method} enter (rl <runlevel>) services
-This will be called when the runlevel should be entered.
address@hidden is the list of the currently running services.
address@hidden deffn
-
address@hidden @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-
 @node Misc Facilities
 @chapter Misc Facilities
 
diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 4547e93..5aeda33 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -32,7 +32,6 @@
   #:use-module (shepherd support)
   #:use-module (shepherd service)
   #:use-module (shepherd system)
-  #:use-module (shepherd runlevel)
   #:use-module (shepherd args)
   #:use-module (shepherd comm)
   #:export (main))
@@ -275,6 +274,26 @@
                 (check-for-dead-services))
               (next-command)))))))
 
+;; Start all of SERVICES, which is a list of canonical names (FIXME?),
+;; but in a order where all dependencies are fulfilled before we
+;; attempt to start a service.  It is assumed that this is possible (FIXME?).
+;; FIXME: This procedure is untested!
+(define (start-in-order services)
+  ;; Same thing with an association list where the cdr of each pair is
+  ;; `#f' if the service is not yet started.
+  (define (start-in-order-assoc assoc-services)
+    (while (any not (map cdr assoc-services))
+      (for-each (lambda (x)
+                 (let ((service (car (lookup-services (car x)))))
+                   (and (not (cdr x))
+                        (depends-resolved? service)
+                        (set-cdr! x (start service)))))
+               assoc-services)))
+
+  (start-in-order-assoc (map (lambda (x)
+                              (cons x #f))
+                            services)))
+
 (define (process-connection sock)
   "Process client connection SOCK, reading and processing commands."
   (catch 'system-error
diff --git a/modules/shepherd/runlevel.scm b/modules/shepherd/runlevel.scm
deleted file mode 100644
index 48e36ba..0000000
--- a/modules/shepherd/runlevel.scm
+++ /dev/null
@@ -1,196 +0,0 @@
-;; runlevel.scm -- Different kinds of runlevels.
-;; Copyright (C) 2013 Ludovic Court�s <address@hidden>
-;; Copyright (C) 2002 Wolfgang J�hrling <address@hidden>
-;;
-;; This file is part of the GNU Shepherd.
-;;
-;; The GNU Shepherd is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3 of the License, or (at
-;; your option) any later version.
-;;
-;; The GNU Shepherd is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with the GNU Shepherd.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (shepherd runlevel)
-  #:use-module (oop goops)
-  #:use-module (srfi srfi-1)
-  #:use-module (shepherd support)
-  #:use-module (shepherd service)
-  #:export (<runlevel>
-            enter
-            enter-selector
-            leave-selector
-
-            <runlevel-exact>
-            <runlevel-changes>
-
-            current-runlevel
-            register-runlevels
-
-            start-in-order))
-
-;; How runlevels (should) work: A runlevel has a enter-selector and a
-;; leave-selector, which are called when the runlevels are entered or
-;; left.  They are called with the list of currently running services
-;; as argument, and return a list of services they want to have
-;; running.  How exactly they implement this is up to them, so this is
-;; a very generic interface.  The difficult part is to get from the
-;; current into the desired state.  I have an idea how to implement it
-;; though.  See the Texinfo manual for details.
-
-;; FIXME: Hmm... just a thought: It might be _much_ easier to
-;; implement if the selectors return what they want to start and stop.
-
-;; The actual code below is not finished.
-
-;; An abstract runlevel.
-(define-class <runlevel> ()
-  (name #:init-keyword #:name))
-
-;; Enter the runlevel (and leave the previous).
-(define-method (enter (obj <runlevel>))
-  ;; Return currently running services.
-  (define (compute-current-services)
-    (let ((services '()))
-      (for-each-service
-       (lambda (serv)
-        (and (running? serv)
-             (set! services (cons (canonical-name serv)
-                                  services)))))
-      services))
-
-  ;; Return the canonical names of SERVICES, but with dependencies
-  ;; added.
-  (define (canonical-with-dependencies services)
-    ;; FIXME: Hmmm... conflicting services..?  If A and B both provide
-    ;; X and Y, and C depends on X, D depends on Y, we might fail very
-    ;; ungracefully.
-    (let ((result '()))
-      ;; Return the canonical names of SERVICES.
-      (define (canon services)
-       (map (lambda (s)
-              ;; FIXME: Here, we should avoid adding conflicts.
-              (canonical-name (car (lookup-services s))))
-            services))
-
-      (letrec ((add
-               (lambda (name)
-                 (set! result (cons name result))
-                 (for-each add
-                           (canon (required-by
-                                   (car (lookup-services name))))))))
-       (for-each add (canon services)))
-      (delete-duplicates! result)))
-
-  (let* ((current-services (compute-current-services))
-         (destination-services
-          ;; Find out what to run.
-          (enter-selector obj
-                          (leave-selector current-runlevel
-                                          current-services))))
-    (set! current-runlevel obj)
-    ;; We don't have the guarantee that `next-services' consists of
-    ;; only canonical names, thus it is a bit harder.  We first have
-    ;; to create a possible ending point and then try to reach it.  If
-    ;; we fail, we restart with the current situation, marking the
-    ;; failed service as currently unstartable.  We repeat this until
-    ;; we loose completely.
-    (let ((unstartables '())
-         (ending-point '()))
-      (for-each (lambda (sym)
-                 ;; We try to be clever: When there is a service that
-                 ;; provides this symbol already running, we use that
-                 ;; one.
-                 (let ((possibilities #f))
-                   #f)) ;; FIXME
-               next-services)
-      #f))) ;; FIXME
-
-;; Subclasses must define their own implementation.  This method is
-;; called when the runlevel is entered.  SERVICES is the list of the
-;; currently running services.  It returns the list of services that
-;; should be run.  Dependencies will be resolved later automatically.
-(define-method (enter-selector (obj <runlevel>)
-                              services)
-  (assert #f))
-
-;; Redefining this in subclasses is optional.  It works like `enter',
-;; except for that it is called when the runlevel is left.
-(define-method (leave-selector (obj <runlevel>)
-                              services)
-  services) ;; Default is no change.
-
-
-
-;; A runlevel where you explicitly specify the services to run.
-(define-class <runlevel-exact> (<runlevel>)
-  (services #:init-value '()
-           #:init-keyword #:services))
-
-;; FIXME: Implement
-(define-method (enter-selector (obj <runlevel-exact>)
-                              services)
-  #t)
-
-
-
-;; A runlevel where you only specify the changes, i.e. which services
-;; to start (if not running) and which to stop (if running) on enter
-;; and leave.
-(define-class <runlevel-changes> (<runlevel>)
-  (start-on-enter #:init-value '()
-                 #:init-keyword #:start-on-enter)
-  (stop-on-enter #:init-value '()
-                #:init-keyword #:stop-on-enter)
-  (start-on-leave #:init-value '()
-                 #:init-keyword #:start-on-leave)
-  (stop-on-leave #:init-value '()
-                #:init-keyword #:stop-on-leave))
-
-;; FIXME: Implement
-(define-method (enter-selector (obj <runlevel-changes>)
-                              services)
-  #t)
-
-;; FIXME: Implement
-(define-method (leave-selector (obj <runlevel-changes>)
-                              services)
-  #t)
-
-
-
-;; List of runlevels.
-(define runlevels '())
-
-;; The currently active runlevel.
-(define current-runlevel (make <runlevel> #:name 'dummy))
-
-(define (register-runlevels . new-runlevels)
-  (set! runlevels (append! runlevels new-runlevels)))
-
-;; Start all of SERVICES, which is a list of canonical names (FIXME?),
-;; but in a order where all dependencies are fulfilled before we
-;; attempt to start a service.  It is assumed that this is possible
-;; (FIXME?).
-(define (start-in-order services)
-  ;; Same thing with an association list where the cdr of each pair is
-  ;; `#f' if the service is not yet started.
-  (define (start-in-order-assoc assoc-services)
-    (while (any not (map cdr assoc-services))
-          (for-each (lambda (x)
-                      (let ((service (car (lookup-services (car x)))))
-                        (and (not (cdr x))
-                             (depends-resolved? service)
-                             (set-cdr! x (start service)))))
-                    assoc-services)))
-
-  (start-in-order-assoc (map (lambda (x)
-                              (cons x #f))
-                            services)))
-