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