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