diff --git a/Makefile.am b/Makefile.am index 6ebd0f1..2985a86 100644 --- a/Makefile.am +++ b/Makefile.am @@ -67,7 +67,6 @@ CLEANFILES = \ # Documentation. info_TEXINFOS = shepherd.texi -SUBDIRS = examples AM_V_HELP2MAN = $(AM_V_HELP2MAN_$(V)) AM_V_HELP2MAN_ = $(AM_V_HELP2MAN_$(AM_DEFAULT_VERBOSITY)) @@ -97,7 +96,14 @@ dist_man1_MANS = shepherd.1 herd.1 dist_man8_MANS = halt.8 reboot.8 # Things not automatically included in the distribution. -EXTRA_DIST = $(templates) QUESTIONS fdl-1.3.texi ChangeLog-2003 +EXTRA_DIST = \ + ChangeLog-2003 \ + fdl-1.3.texi \ + QUESTIONS \ + $(templates) \ + doc/examples/README \ + doc/examples/_unknown.scm \ + doc/examples/wolfgangj.scm # Create the socket directory (aka. 'default-socket-dir'.) Make it # accessible only by its owner since otherwise 'shepherd' suggests using diff --git a/configure.ac b/configure.ac index 339167c..abab3fa 100644 --- a/configure.ac +++ b/configure.ac @@ -94,7 +94,6 @@ AM_MISSING_PROG([HELP2MAN], [help2man]) dnl Finish. AC_CONFIG_FILES([Makefile - examples/Makefile - modules/shepherd/system.scm]) + modules/shepherd/system.scm]) AC_OUTPUT diff --git a/doc/examples/README b/doc/examples/README new file mode 100644 index 0000000..86b4b6a --- /dev/null +++ b/doc/examples/README @@ -0,0 +1,17 @@ +Example configurations for dmd +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- + +This directory contains personal configuration files and interesting +configuration possibilities, the latter being in the files starting +with an underscore character. You can send me your configuration too +(or your cute configuration code snippets), and I will include it +here, provided that it is available under a license that makes it Free +Software. Note that for personal configurations I don't want +ChangeLogs, since I won't maintain your configuration anyway :-) but +changes in the snippets should be documented like other changes. + +Hint: If you send my your configuration, then not only can other +people learn from it, but I can also make sure that I do not break +your code too often by making incompatible changes, and if I do it +anyway but notice it, I might tell you how to change the code to work +with a new version. diff --git a/doc/examples/_unknown.scm b/doc/examples/_unknown.scm new file mode 100644 index 0000000..fb639ab --- /dev/null +++ b/doc/examples/_unknown.scm @@ -0,0 +1,153 @@ +;; _unknown.scm -- An example for an `unknown' service. +;; Copyright (C) 2003 Wolfgang Jährling +;; +;; 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 . + +;; Return true if STR1 lacks a character that exists in STR2, but +;; otherwise both are identical. +(define (lacks-char-from? str1 str2) + (and (= (string-length str1) + (+ (string-length str2) 1)) + (letrec ((next + (lambda (pos) + (and (not (= pos (string-length str1))) + (or (string=? str2 + (string-append + (substring str1 0 pos) + (substring str1 + (+ pos 1) + (string-length str1)))) + (next (+ pos 1))))))) + (next 0)))) + +;; Return true if either of STR1 and STR2 lacks a character found in +;; the other one, but otherwise both are identical (e.g. as is the +;; case for "blah" and "bla"). +(define (differs-by-missing-char? str1 str2) + (or (lacks-char-from? str1 str2) + (lacks-char-from? str2 str1))) + +;; Return true if the only difference between STR1 and STR2 is that a +;; successive pair of characters is switched in one of them. +(define (differs-by-switched-chars? str1 str2) + (and (= (string-length str1) + (string-length str2)) + (> (string-length str1) 1) + (letrec ((next + (lambda (pos) + (and (not (= pos (string-length str1))) + (or (string=? str2 + (string-append + (substring str1 0 (- pos 1)) + (string (string-ref str1 pos) + (string-ref str1 (- pos 1))) + (substring str1 + (+ pos 1) + (string-length str1)))) + (next (+ pos 1))))))) + (next 1)))) + +;; Return true if they differ by exactly one character (e.g. as is the +;; case for "blah" and "bleh"), if it isn't the only one. +(define (differs-by-one-char? str1 str2) + (and (= (string-length str1) + (string-length str2)) + (> (string-length str1) 1) + (letrec ((next + (lambda (pos found-difference) + (if (= pos (string-length str1)) + found-difference + (if (char=? (string-ref str1 pos) + (string-ref str2 pos)) + (next (+ pos 1) found-difference) + (and (not found-difference) + (next (+ pos 1) #t))))))) + (next 0 #f)))) + +;; Return true if STR1 and STR2 are identical, except for case +;; (e.g. this gives true for "foobar" and "FooBAR"). +(define (differs-only-in-case? str1 str2) + (and (not (string=? str1 str2)) + (string-ci=? str1 str2))) + +;; Return true if STR1 and STR2 are `similar' strings, meaning that +;; they only differ in a minor way. +(define (similar? str1 str2) + (any (lambda (pred?) + (pred? str1 str2)) + (list differs-by-missing-char? + differs-by-switched-chars? + differs-by-one-char? + differs-only-in-case?))) + + + +;; TODO +;; - We could look for non-running services first on `start' etc. +;; - We also should do `unknown-action' (if service is known) +;; - If doing this, we should enable the service to handle it +;; - Make this the `default unknown service' +;; - Messages if nothing found. + +;; Suggest a service that satisfies PRED?, if given, and has a name +;; similar to SERVICE-SYMBOL. +(define look-for-service + (case-lambda + ((service-symbol) (look-for-service service-symbol (lambda (x) #t))) + ((service-symbol pred?) + (call/ec + (lambda (return) + (for-each-service + (lambda (s) + (and (pred? s) + (similar? (symbol->string service-symbol) + (symbol->string (canonical-name s))) + (begin + (format #t "Did you mean ~a maybe?" (canonical-name s)) + (newline) + (return #t))))) + #f))))) + +;; The classical compose. +(define (compose f g) + (lambda (x) + (f (g x))) + + (define unknown-service + (make + #:provides '(unknown) + #:actions (make-actions + (start + "Called if user wants to start an unknown service." + (lambda (running service-sym . args) + (or (look-for-service service-sym (compose not running?)) + (look-for-service service-sym)) + running)) + (stop + "Called if user wants to stop an unknown service." + (lambda (running service-sym . args) + (or (look-for-service service-sym running?) + (look-for-service service-sym)) + running)) + (action + "Called if user frobs an unknown service." + (lambda (running service-sym the-action . args) + (or (look-for-service service-sym running?) + (look-for-service service-sym)) + running))))) + + (register-services unknown-service) + (start unknown-service) diff --git a/doc/examples/wolfgangj.scm b/doc/examples/wolfgangj.scm new file mode 100644 index 0000000..0c16108 --- /dev/null +++ b/doc/examples/wolfgangj.scm @@ -0,0 +1,132 @@ +;; wolfgangj.scm -- Personal dmd configuration of Wolfgang Jährling. +;; Copyright (C) 2002, 2003 Wolfgang Jährling +;; +;; 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 . + + + +;; A few notes about the computer this setup is for: It is a PC +;; running Debian GNU/Linux 3.0, on which I am usually using screen, +;; which is why I need few terminals. I am using it to connect to the +;; internet via ISDN, but I'm also using it in my local network, in +;; which case it is running Apache. Because I don't want to have +;; Apache running when I am online, I made Apache conflict with the +;; ISDN setup. + +;; Laziness. +(define (number->symbol num) + (string->symbol (number->string num))) + +;; Even more laziness. +(define cat string-append) + +;; Some values for this system. +(define getty "/sbin/getty") +(define ifconfig "/sbin/ifconfig") +(define isdnctrl "/usr/sbin/isdnctrl") + +(define inet-interface "ippp0") +(define inet-dial (cat isdnctrl " dial " inet-interface)) +(define inet-hangup (cat isdnctrl " hangup " inet-interface)) + +(define local-interface "eth0") +(define local-ip "192.168.0.9") + +(define init.d-dir "/etc/init.d/") +(define apache (cat init.d-dir "apache")) +(define inet (cat init.d-dir "isdnutils")) +(define exim (cat init.d-dir "exim")) + +;; Create a service providing a terminal. +(define (make-term num) + (let ((sym (symbol-append 'term- (number->symbol num)))) + (make + #:provides (list sym) + #:respawn? #t + #:start (make-forkexec-constructor getty "38400" + (cat "tty" (number->string num))) + #:stop-delay? #t))) + +;; Number of terminals created by default. +(define default-terms 3) + +;; How many terms have been created with `add-new-term'. +(define term-counter 0) + +;; Add a new terminal to the list of registered services. +(define (add-new-term) + (set! term-counter (+ term-counter 1)) + (register-services (make-term term-counter))) + +(register-services + (make + #:provides '(term) + #:actions (make-actions + (create "Create a new terminal." + (lambda (running) + (add-new-term))) + (counter-set "Set the terminal creation counter." + (lambda (running num) + (set! term-counter (string->number num)))) + (status "Display the terminal creation counter." + (lambda (running) + (local-output "Terminal counter is at ~a." + term-counter))))) + (make + #:provides '(apache insecurity) + #:requires '(local-net) + #:start (make-system-constructor apache " start") + #:stop (make-system-destructor apache " stop")) + (make + #:provides '(inet insecurity) + #:start (make-system-constructor inet " start") + #:stop (make-system-destructor inet " stop") + #:actions (make-actions + (dial "Connect to the big, evil internet." + (lambda (running) + (system inet-dial) + #t)) + (hangup "Cut the internet connection." + (lambda (running) + (system inet-hangup) + #t)))) + (make + #:provides '(local-net) + #:start (make-system-constructor ifconfig " " local-interface " " local-ip) + #:stop (make-system-destructor ifconfig " " local-interface " down")) + (make + #:provides '(exim mailer-daemon) + #:requires '(inet) + #:start (make-system-constructor exim " start") + #:stop (make-system-destructor exim " stop"))) + +;; Create a few terminals. +(letrec ((loop (lambda (i) + (and (not (zero? i)) + (begin + (add-new-term) + (loop (- i 1))))))) + (loop default-terms)) + +;; Go into background. +(action 'dmd 'daemonize) + +;; Setup internet, a mailer and a few terms. +(for-each start + (append '(term inet mailer-daemon) + (map (lambda (x) + (symbol-append 'term- (number->symbol x))) + (iota default-terms 1)))) diff --git a/examples/Makefile.am b/examples/Makefile.am deleted file mode 100644 index 648b244..0000000 --- a/examples/Makefile.am +++ /dev/null @@ -1,3 +0,0 @@ -# examples/Makefile.am -- Add a few examples to the distribution. - -EXTRA_DIST = README _unknown.scm wolfgangj.scm diff --git a/examples/README b/examples/README deleted file mode 100644 index 86b4b6a..0000000 --- a/examples/README +++ /dev/null @@ -1,17 +0,0 @@ -Example configurations for dmd -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- - -This directory contains personal configuration files and interesting -configuration possibilities, the latter being in the files starting -with an underscore character. You can send me your configuration too -(or your cute configuration code snippets), and I will include it -here, provided that it is available under a license that makes it Free -Software. Note that for personal configurations I don't want -ChangeLogs, since I won't maintain your configuration anyway :-) but -changes in the snippets should be documented like other changes. - -Hint: If you send my your configuration, then not only can other -people learn from it, but I can also make sure that I do not break -your code too often by making incompatible changes, and if I do it -anyway but notice it, I might tell you how to change the code to work -with a new version. diff --git a/examples/_unknown.scm b/examples/_unknown.scm deleted file mode 100644 index 9e425df..0000000 --- a/examples/_unknown.scm +++ /dev/null @@ -1,153 +0,0 @@ -;; _unknown.scm -- An example for an `unknown' service. -;; Copyright (C) 2003 Wolfgang Jährling -;; -;; 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 . - -;; Return true if STR1 lacks a character that exists in STR2, but -;; otherwise both are identical. -(define (lacks-char-from? str1 str2) - (and (= (string-length str1) - (+ (string-length str2) 1)) - (letrec ((next - (lambda (pos) - (and (not (= pos (string-length str1))) - (or (string=? str2 - (string-append - (substring str1 0 pos) - (substring str1 - (+ pos 1) - (string-length str1)))) - (next (+ pos 1))))))) - (next 0)))) - -;; Return true if either of STR1 and STR2 lacks a character found in -;; the other one, but otherwise both are identical (e.g. as is the -;; case for "blah" and "bla"). -(define (differs-by-missing-char? str1 str2) - (or (lacks-char-from? str1 str2) - (lacks-char-from? str2 str1))) - -;; Return true if the only difference between STR1 and STR2 is that a -;; successive pair of characters is switched in one of them. -(define (differs-by-switched-chars? str1 str2) - (and (= (string-length str1) - (string-length str2)) - (> (string-length str1) 1) - (letrec ((next - (lambda (pos) - (and (not (= pos (string-length str1))) - (or (string=? str2 - (string-append - (substring str1 0 (- pos 1)) - (string (string-ref str1 pos) - (string-ref str1 (- pos 1))) - (substring str1 - (+ pos 1) - (string-length str1)))) - (next (+ pos 1))))))) - (next 1)))) - -;; Return true if they differ by exactly one character (e.g. as is the -;; case for "blah" and "bleh"), if it isn't the only one. -(define (differs-by-one-char? str1 str2) - (and (= (string-length str1) - (string-length str2)) - (> (string-length str1) 1) - (letrec ((next - (lambda (pos found-difference) - (if (= pos (string-length str1)) - found-difference - (if (char=? (string-ref str1 pos) - (string-ref str2 pos)) - (next (+ pos 1) found-difference) - (and (not found-difference) - (next (+ pos 1) #t))))))) - (next 0 #f)))) - -;; Return true if STR1 and STR2 are identical, except for case -;; (e.g. this gives true for "foobar" and "FooBAR"). -(define (differs-only-in-case? str1 str2) - (and (not (string=? str1 str2)) - (string-ci=? str1 str2))) - -;; Return true if STR1 and STR2 are `similar' strings, meaning that -;; they only differ in a minor way. -(define (similar? str1 str2) - (any (lambda (pred?) - (pred? str1 str2)) - (list differs-by-missing-char? - differs-by-switched-chars? - differs-by-one-char? - differs-only-in-case?))) - - - -;; TODO -;; - We could look for non-running services first on `start' etc. -;; - We also should do `unknown-action' (if service is known) -;; - If doing this, we should enable the service to handle it -;; - Make this the `default unknown service' -;; - Messages if nothing found. - -;; Suggest a service that satisfies PRED?, if given, and has a name -;; similar to SERVICE-SYMBOL. -(define look-for-service - (case-lambda - ((service-symbol) (look-for-service service-symbol (lambda (x) #t))) - ((service-symbol pred?) - (call/ec - (lambda (return) - (for-each-service - (lambda (s) - (and (pred? s) - (similar? (symbol->string service-symbol) - (symbol->string (canonical-name s))) - (begin - (format #t "Did you mean ~a maybe?" (canonical-name s)) - (newline) - (return #t))))) - #f))))) - -;; The classical compose. -(define (compose f g) - (lambda (x) - (f (g x))) - -(define unknown-service - (make - #:provides '(unknown) - #:actions (make-actions - (start - "Called if user wants to start an unknown service." - (lambda (running service-sym . args) - (or (look-for-service service-sym (compose not running?)) - (look-for-service service-sym)) - running)) - (stop - "Called if user wants to stop an unknown service." - (lambda (running service-sym . args) - (or (look-for-service service-sym running?) - (look-for-service service-sym)) - running)) - (action - "Called if user frobs an unknown service." - (lambda (running service-sym the-action . args) - (or (look-for-service service-sym running?) - (look-for-service service-sym)) - running))))) - -(register-services unknown-service) -(start unknown-service) diff --git a/examples/wolfgangj.scm b/examples/wolfgangj.scm deleted file mode 100644 index b01ddd0..0000000 --- a/examples/wolfgangj.scm +++ /dev/null @@ -1,132 +0,0 @@ -;; wolfgangj.scm -- Personal dmd configuration of Wolfgang Jährling. -;; Copyright (C) 2002, 2003 Wolfgang Jährling -;; -;; 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 . - - - -;; A few notes about the computer this setup is for: It is a PC -;; running Debian GNU/Linux 3.0, on which I am usually using screen, -;; which is why I need few terminals. I am using it to connect to the -;; internet via ISDN, but I'm also using it in my local network, in -;; which case it is running Apache. Because I don't want to have -;; Apache running when I am online, I made Apache conflict with the -;; ISDN setup. - -;; Laziness. -(define (number->symbol num) - (string->symbol (number->string num))) - -;; Even more laziness. -(define cat string-append) - -;; Some values for this system. -(define getty "/sbin/getty") -(define ifconfig "/sbin/ifconfig") -(define isdnctrl "/usr/sbin/isdnctrl") - -(define inet-interface "ippp0") -(define inet-dial (cat isdnctrl " dial " inet-interface)) -(define inet-hangup (cat isdnctrl " hangup " inet-interface)) - -(define local-interface "eth0") -(define local-ip "192.168.0.9") - -(define init.d-dir "/etc/init.d/") -(define apache (cat init.d-dir "apache")) -(define inet (cat init.d-dir "isdnutils")) -(define exim (cat init.d-dir "exim")) - -;; Create a service providing a terminal. -(define (make-term num) - (let ((sym (symbol-append 'term- (number->symbol num)))) - (make - #:provides (list sym) - #:respawn? #t - #:start (make-forkexec-constructor getty "38400" - (cat "tty" (number->string num))) - #:stop-delay? #t))) - -;; Number of terminals created by default. -(define default-terms 3) - -;; How many terms have been created with `add-new-term'. -(define term-counter 0) - -;; Add a new terminal to the list of registered services. -(define (add-new-term) - (set! term-counter (+ term-counter 1)) - (register-services (make-term term-counter))) - -(register-services - (make - #:provides '(term) - #:actions (make-actions - (create "Create a new terminal." - (lambda (running) - (add-new-term))) - (counter-set "Set the terminal creation counter." - (lambda (running num) - (set! term-counter (string->number num)))) - (status "Display the terminal creation counter." - (lambda (running) - (local-output "Terminal counter is at ~a." - term-counter))))) - (make - #:provides '(apache insecurity) - #:requires '(local-net) - #:start (make-system-constructor apache " start") - #:stop (make-system-destructor apache " stop")) - (make - #:provides '(inet insecurity) - #:start (make-system-constructor inet " start") - #:stop (make-system-destructor inet " stop") - #:actions (make-actions - (dial "Connect to the big, evil internet." - (lambda (running) - (system inet-dial) - #t)) - (hangup "Cut the internet connection." - (lambda (running) - (system inet-hangup) - #t)))) - (make - #:provides '(local-net) - #:start (make-system-constructor ifconfig " " local-interface " " local-ip) - #:stop (make-system-destructor ifconfig " " local-interface " down")) - (make - #:provides '(exim mailer-daemon) - #:requires '(inet) - #:start (make-system-constructor exim " start") - #:stop (make-system-destructor exim " stop"))) - -;; Create a few terminals. -(letrec ((loop (lambda (i) - (and (not (zero? i)) - (begin - (add-new-term) - (loop (- i 1))))))) - (loop default-terms)) - -;; Go into background. -(action 'dmd 'daemonize) - -;; Setup internet, a mailer and a few terms. -(for-each start - (append '(term inet mailer-daemon) - (map (lambda (x) - (symbol-append 'term- (number->symbol x))) - (iota default-terms 1))))