Make local testing dependent on $METAINIT_PREFIX
[darcs-mirror-metainit.git] / translators / sysvinit
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use MetaInit::Parse;
7
8 my $prefix = "";
9 $prefix = $ENV{METAINIT_PREFIX} if $ENV{METAINIT_PREFIX};
10
11 my $metainit_dir = "$prefix/etc/metainit";
12 my $etc = "$prefix/etc";
13 my $updatercd = "$prefix/usr/sbin/update-rc.d";
14
15 #
16 # Rough plan of operation:
17 #    (Maybe:
18 #     Check all init files, find all generated ones, see if the metainit 
19 #     file is missing and delete them then)
20 #    Check all metainit files, whether the init.d file is out of date.
21 #    If the init.d file was created, find a suitable rc2.d/ number and run update-rc.
22 #
23
24 use Getopt::Long;
25
26 my $remove = '';
27 GetOptions( 'remove-metainit=s' => \$remove );
28
29 if ($remove) {
30         # Operation: Remove all geranted files for the given metainit name
31         remove($remove)
32 } else {
33         # Operation: Rebuild everything
34         
35         #check_orphaned_initscripts()
36         my @metainits = read_metainits();
37         my @generated = ();
38         foreach my $metainit (@metainits) {
39                 my $created = regenerate_initscript($metainit);
40                 push @generated, $metainit->{Name} if $created;
41         }
42
43         my %arrangement = ();
44         open(ARRANGE, '-|',"$utils/arrange-sysvinit",@generated) or die $!;
45         while (<ARRANGE>) {
46                 if (/^([\w\.-]+) (\d\d)$/){
47                         $arrangement{$1} = $2;
48                 } else {
49                         die "Can't parse $_";
50                 }
51         }
52         close ARRANGE;
53
54         while (my ($initname,$num) = each %arrangement) {
55                 system($updatercd, $initname, "defaults", $num);
56         }
57
58
59 }
60
61 sub read_metainits{
62         my @metainits;
63         for my $metainit_file (<$metainit_dir/*.metainit>) {
64                 push @metainits, MetaInit::Parse::parse($metainit_file);
65         }
66         return @metainits;
67 }
68
69 sub regenerate_initscript {
70         my ($metainit) = @_;
71         my $initscript = init_script_name($metainit);
72         my $new = not -e $initscript;
73
74         
75         if (not $new) {
76                 my $can_touch = 0;
77                 open INIT, '<', $initscript or die $!;
78                 while (<INIT>) {
79                         if (/DO NOT EDIT THIS FILE/) {
80                                 $can_touch = 1;
81                                 last;
82                         }
83                 }
84                 close INIT;
85                 warn "Not overriding user-modified init script $initscript.\n";
86                 return 0 if (not $can_touch);
87         } else {
88                 # Here me might want to check if the file is up-to-date.
89                 # For now, we just override it always.
90         }
91
92         system("$utils/create-sysvinit-file", $metainit->{File}, $initscript);
93
94         return $new;
95
96 }
97
98 sub init_script_name {
99         my ($metainit) = @_;
100         return sprintf "%s/init.d/%s", $etc, $metainit->{Name};
101 }
102
103 sub remove {
104         die "Remove not yet implemented"
105 }