0e17e36d24965a205dc8d2a809d613daca67cdd6
[darcs-mirror-metainit.git] / update-rc.d
1 #! /usr/bin/perl
2 #
3 # update-rc.d   Update the links in /etc/rc[0-9S].d/
4 #
5
6 use strict;
7 use warnings;
8
9 my $initd = "$ENV{PWD}/etc/init.d";
10 my $etcd  = "$ENV{PWD}/etc/rc";
11 my $notreally = 0;
12
13 # Only parse the LSB headers when this flag exist.  It is to be used
14 # while we test this new feature, and should be removed when we are
15 # confident that LSB headers are correct. [pere 2006-09-06]
16 my $lsbparseflag = "/etc/update-rc.d-lsbparse";
17
18 # Print usage message and die.
19
20 sub usage {
21         print STDERR "update-rc.d: error: @_\n" if ($#_ >= 0);
22         print STDERR <<EOF;
23 usage: update-rc.d [-n] [-f] <basename> remove
24        update-rc.d [-n] <basename> defaults [NN | sNN kNN]
25        update-rc.d [-n] <basename> start|stop NN runlvl [runlvl] [...] .
26                 -n: not really
27                 -f: force
28 EOF
29         exit (1);
30 }
31
32 # Check out options.
33 my $force;
34
35 while($#ARGV >= 0 && ($_ = $ARGV[0]) =~ /^-/) {
36         shift @ARGV;
37         if (/^-n$/) { $notreally++; next }
38         if (/^-f$/) { $force++; next }
39         if (/^-h|--help$/) { &usage; }
40         &usage("unknown option");
41 }
42
43 # Action.
44
45 &usage() if ($#ARGV < 1);
46 my $bn = shift @ARGV;
47 if ($ARGV[0] ne 'remove') {
48     if (! -f "$initd/$bn") {
49         print STDERR "update-rc.d: $initd/$bn: file does not exist\n";
50         exit (1);
51     }
52 } elsif (-f "$initd/$bn") {
53     if (!$force) {
54         printf STDERR "update-rc.d: $initd/$bn exists during rc.d purge (use -f to force)\n";
55         exit (1);
56     }
57 }
58
59 my @startlinks;
60 my @stoplinks;
61
62 $_ = $ARGV[0];
63 if    (/^remove$/)       { &checklinks ("remove"); }
64 elsif (/^defaults$/)     { &defaults; &makelinks }
65 elsif (/^(start|stop)$/) { &startstop; &makelinks; }
66 else                     { &usage; }
67
68 exit (0);
69
70 # Check if there are links in /etc/rc[0-9S].d/ 
71 # Remove if the first argument is "remove" and the links 
72 # point to $bn.
73
74 sub is_link () {
75     my ($op, $fn, $bn) = @_;
76     if (! -l $fn) {
77         print STDERR "update-rc.d: warning: $fn is not a symbolic link\n";
78         return 0;
79     } else {
80         my $linkdst = readlink ($fn);
81         if (! defined $linkdst) {
82             die ("update-rc.d: error reading symbolic link: $!\n");
83         }
84         if (($linkdst ne "../init.d/$bn") && ($linkdst ne "$initd/$bn")) {
85             print STDERR "update-rc.d: warning: $fn is not a link to ../init.d/$bn or $initd/$bn\n";
86             return 0;
87         }
88     }
89     return 1;
90 }
91
92 sub checklinks {
93     my ($i, $found, $fn, $islnk);
94
95     print " Removing any system startup links for $initd/$bn ...\n"
96         if (defined $_[0] && $_[0] eq 'remove');
97
98     $found = 0;
99
100     foreach $i (0..9, 'S') {
101         unless (chdir ("$etcd$i.d")) {
102             next if ($i =~ m/^[789S]$/);
103             die("update-rc.d: chdir $etcd$i.d: $!\n");
104         }
105         opendir(DIR, ".");
106         foreach $_ (readdir(DIR)) {
107             next unless (/^[SK]\d\d$bn$/);
108             $fn = "$etcd$i.d/$_";
109             $found = 1;
110             $islnk = &is_link ($_[0], $fn, $bn);
111             next unless (defined $_[0] and $_[0] eq 'remove');
112             if (! $islnk) {
113                 print "   $fn is not a link to ../init.d/$bn; not removing\n"; 
114                 next;
115             }
116             print "   $etcd$i.d/$_\n";
117             next if ($notreally);
118             unlink ("$etcd$i.d/$_") ||
119                 die("update-rc.d: unlink: $!\n");
120         }
121         closedir(DIR);
122     }
123     $found;
124 }
125
126 sub parse_lsb_header {
127     my $initdscript = shift;
128     my %lsbinfo;
129     if (-e $lsbparseflag) {
130         my $lsbfound = 0;
131         my $lsbheaders = "Provides|Default-Start|Default-Stop";
132         open(INIT, "<$initdscript") || die "error: unable to read $initdscript";
133         while (<INIT>) {
134             chomp;
135             $lsbfound = 1 if (m/^\#\#\# BEGIN INIT INFO$/);
136             last if (m/\#\#\# END INIT INFO$/);
137             if (m/^\# (Default-Start|Default-stop):\s*(\S?.*)$/i) {
138                 $lsbinfo{lc($1)} = $2;
139             }
140         }
141         close(INIT);
142     }
143     return %lsbinfo;
144 }
145
146
147 # Process the arguments after the "defaults" keyword.
148
149 sub defaults {
150     my ($start, $stop) = (20, 20);
151
152     &usage ("defaults takes only one or two codenumbers") if ($#ARGV > 2);
153     $start = $stop = $ARGV[1] if ($#ARGV >= 1);
154     $stop  =         $ARGV[2] if ($#ARGV >= 2);
155     &usage ("codenumber must be a number between 0 and 99")
156         if ($start !~ /^\d\d?$/ || $stop  !~ /^\d\d?$/);
157
158     $start = sprintf("%02d", $start);
159     $stop  = sprintf("%02d", $stop);
160
161     my %lsbinfo = parse_lsb_header("$initd/$bn");
162
163     if (exists $lsbinfo{'default-stop'}) {
164         for my $level (split(/\s+/, $lsbinfo{'default-stop'})) {
165             $level = 99 if ($level eq 'S');
166             $stoplinks[$level] = "K$stop";
167         }
168     } else {
169         $stoplinks[0] = $stoplinks[1] = $stoplinks[6] = "K$stop";
170     }
171
172     if (exists $lsbinfo{'default-start'}) {
173         for my $level (split(/\s+/, $lsbinfo{'default-start'})) {
174             $level = 99 if ($level eq 'S');
175             $startlinks[$level] = "S$start";
176         }
177     } else {
178         $startlinks[2] = $startlinks[3] =
179             $startlinks[4] = $startlinks[5] = "S$start";
180     }
181
182     1;
183 }
184
185 # Process the arguments after the start or stop keyword.
186
187 sub startstop {
188
189     my($letter, $NN, $level);
190
191     while ($#ARGV >= 0) {
192         if    ($ARGV[0] eq 'start') { $letter = 'S'; }
193         elsif ($ARGV[0] eq 'stop')  { $letter = 'K' }
194         else {
195             &usage("expected start|stop");
196         }
197
198         if ($ARGV[1] !~ /^\d\d?$/) {
199             &usage("expected NN after $ARGV[0]");
200         }
201         $NN = sprintf("%02d", $ARGV[1]);
202
203         shift @ARGV; shift @ARGV;
204         $level = shift @ARGV;
205         do {
206             if ($level !~ m/^[0-9S]$/) {
207                 &usage(
208                        "expected runlevel [0-9S] (did you forget \".\" ?)");
209             }
210             if (! -d "$etcd$level.d") {
211                 print STDERR
212                     "update-rc.d: $etcd$level.d: no such directory\n";
213                 exit(1);
214             }
215             $level = 99 if ($level eq 'S');
216             $startlinks[$level] = "$letter$NN" if ($letter eq 'S');
217             $stoplinks[$level]  = "$letter$NN" if ($letter eq 'K');
218         } while (($level = shift @ARGV) ne '.');
219         &usage("action with list of runlevels not terminated by \`.'")
220             if ($level ne '.');
221     }
222     1;
223 }
224
225 # Create the links.
226
227 sub makelinks {
228     my($t, $i);
229     my @links;
230
231     if (&checklinks) {
232         print " System startup links for $initd/$bn already exist.\n";
233         exit (0);
234     }
235     print " Adding system startup for $initd/$bn ...\n";
236
237     # nice unreadable perl mess :)
238
239     for($t = 0; $t < 2; $t++) {
240         @links = $t ? @startlinks : @stoplinks;
241         for($i = 0; $i <= $#links; $i++) {
242             my $lvl = $i;
243             $lvl = 'S' if ($i == 99);
244             next if (!defined $links[$i] or $links[$i] eq '');
245             print "   $etcd$lvl.d/$links[$i]$bn -> ../init.d/$bn\n";
246             next if ($notreally);
247             symlink("../init.d/$bn", "$etcd$lvl.d/$links[$i]$bn")
248                 || die("update-rc.d: symlink: $!\n");
249         }
250     }
251
252     1;
253 }