Warning added
[darcs-mirror-metainit.git] / arrange-sysvinit.pl
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Parse;
7
8 my $metainit_path = "./examples";
9 my $etc = "./etc";
10
11 my @new_scripts = @ARGV;
12
13 my %facilities = (
14         '$local_fs'  => 0,
15         '$network'   => 0,
16         '$named'     => 15,
17         '$portmap'   => 18,
18         '$remote_fs' => 21,
19         '$syslog'    => 10,
20         '$time'      => 0,
21 );
22
23 # Read in all meta-init scripts
24 my @metainit_files = <$metainit_path/*.metainit>;
25
26 my %metainits;
27
28 for my $metainit_file (@metainit_files) {
29         my $data = Parse::parse($metainit_file);
30         $metainits{$data->{Name}} = $data;
31 }
32
33
34 # Locate existing scripts
35 # We check for existing scripts only in /etc/rc2.d
36
37 my %startscripts;
38 for my $rc_file (<$etc/rc2.d/S??*>) {
39         my ($num, $name) = $rc_file =~ m!S(\d\d)([^/]+)!;
40         $startscripts{$name} = $num;
41 }
42
43
44 # Sort the scripts to existing and non-existing scripts
45 my @existing;
46 my @new;
47
48 for my $metainit (keys %metainits) {
49         if (exists $startscripts{$metainit}) {
50                 push @existing, $metainit;
51         } else {
52                 push @new, $metainit;
53         }
54 }
55
56 # Actually, we only want to treat the passed scripts as new
57 @new = @new_scripts;
58
59         
60 # Check the dependencies for existing scripts
61
62 for my $existing (@existing) {
63         my @deps = @{$metainits{$existing}{"Required-Start"}};
64         for my $dep (@deps) {
65                 if (exists $startscripts{$dep}) {
66                         if ($startscripts{$dep} >= $startscripts{$existing}) {
67                                 warn "Late dependency $dep of $existing.\n"
68                         }
69                 } elsif (exists $facilities{$dep}) {
70                         if ($facilities{$dep} >= $startscripts{$existing}) {
71                                 warn "Late facility $dep of $existing.\n"
72                         }
73                 } elsif (not exists $startscripts{$dep}){
74                         # Nothing to do here
75                 } else {
76                         
77                         warn "Unkown dependency $dep of $existing.\n";
78                 }
79         }
80
81 }
82
83 my @processed = ();
84
85 while (@new > 0) {
86         # Check Bounds 
87
88         my %lower;
89         my %upper;
90
91         for my $existing (@existing) {
92                 my @deps = @{$metainits{$existing}{"Required-Start"}};
93                 for my $dep (@deps) {
94                         if (exists $startscripts{$dep}){
95                                 $upper{$dep} = min($startscripts{$existing}, $upper{$dep})
96                         }
97                 }
98         }
99
100         for my $new (@new) {
101                 my @deps = @{$metainits{$new}{"Required-Start"}};
102                 for my $dep (@deps) {
103                         if (not exists $startscripts{$dep}){
104                                 $lower{$new} = $startscripts{$dep};
105                                 $lower{$new} = max($startscripts{$dep}, $lower{$new})
106                         }
107                 }
108         }
109
110         # Put a new scripts at appropriate location
111         my $current = pop @new;
112
113         # Standard case:
114         if (($lower{$current}||0) > ($upper{$current}||99)) {
115                 warn "Could not correctly fit in $current, please reorder manually.\n";
116                 $startscripts{$current} = $lower{$current}||10 + 10;
117                 push @processed, $current;
118                 push @existing,  $current;
119         } elsif (($lower{$current}||0 < 20) and not defined $upper{$current}) {
120                 $startscripts{$current} = 20;
121                 push @processed, $current;
122                 push @existing,  $current;
123         } else {
124                 $startscripts{$current} = mid($lower{$current}, $upper{$current});
125         }
126
127 }
128
129 for my $done (@processed) {
130         printf "%s %02d\n", $done, $startscripts{$done}
131 }
132
133
134 sub max {
135         return $_[1] if (defined $_[1] and $_[0] < $_[1]);
136         return $_[0]
137 }
138 sub min {
139         return $_[1] if (defined $_[1] and $_[0] > $_[1]);
140         return $_[0]
141 }
142 sub mid {
143         my ($a,$b) = @_;
144         return int(($a+$b)/2);
145 }