d9898ee8 |
1 | #!/usr/bin/perl |
2 | # $Id: sysconftool.in,v 1.1 2000/12/10 01:19:48 mrsam Exp $ |
3 | # Copyright 2000 Double Precision, Inc. See COPYING for |
4 | # distribution information. |
5 | |
6 | use IO::File; |
7 | use Getopt::Long; |
8 | |
9 | my $exitcode=0; |
10 | |
11 | my $ver; |
12 | my $noclobber; |
13 | my $force; |
14 | my $require; |
15 | |
16 | my $myversion="0.15"; |
17 | |
18 | exit 1 unless GetOptions("v" => \$ver, "n" => \$noclobber, |
19 | "f" => \$force, "r=s" => \$require); |
20 | |
21 | print "$myversion\n" if $ver; |
22 | |
23 | die "$0: Version not supported.\n" |
24 | if $require && versioncmp($myversion, $require) < 0; |
25 | |
26 | while ($#ARGV >= 0) |
27 | { |
28 | my $filename=shift @ARGV; |
29 | |
30 | $filename =~ s/\.dist$//; |
31 | |
32 | my $rc; |
33 | |
34 | eval { |
35 | $rc=sysconftool($filename, $noclobber, $force); |
36 | } ; |
37 | |
38 | if ($@) |
39 | { |
40 | $rc=9; |
41 | |
42 | $@ .= "\n" unless $@ =~ /\n/s; |
43 | print "$@"; |
44 | } |
45 | |
46 | $exitcode=$rc if $rc > $exitcode; |
47 | } |
48 | |
49 | exit ($exitcode); |
50 | |
51 | sub sysconftool { |
52 | my $filename=shift; |
53 | my $noclobber=shift; |
54 | my $force=shift; |
55 | |
56 | my $distfile=new IO::File; |
57 | |
58 | die "$filename.dist: $!\n" if ! $distfile->open("< $filename.dist"); |
59 | |
60 | my ($distheader, $distver); |
61 | |
62 | ($distheader, $distver)= sysconftool_readver($distfile); |
63 | |
64 | die "$filename.dist: configuration header not found.\n" unless $distver; |
65 | |
66 | my $oldfile=new IO::File; |
67 | |
68 | if ( ! $oldfile->open($filename)) |
69 | { |
70 | $oldfile=undef; |
71 | } |
72 | else |
73 | { |
74 | my ($dummy, $configver); |
75 | |
76 | ($dummy, $configver)= sysconftool_readver($oldfile); |
77 | |
78 | if (! defined $dummy) |
79 | { |
80 | $oldfile=undef; # Legacy config file |
81 | } |
82 | elsif ($configver eq $distver) |
83 | { |
84 | return 0 unless $force; |
85 | } |
86 | } |
87 | |
88 | my %old_settings; |
89 | my %old_version; |
90 | |
91 | # If there's an old file, read old settings. |
92 | |
93 | if (defined $oldfile) |
94 | { |
95 | my $configname=""; |
96 | my $configversion=""; |
97 | my $line; |
98 | my $resetflag=0; |
99 | |
100 | while (defined ($line=<$oldfile>)) |
101 | { |
102 | if ($line =~ /^\#/) |
103 | { |
104 | $configname=$configversion="" if $resetflag; |
105 | $resetflag=0; |
106 | |
107 | if ($line =~ /^\#\#NAME:(.*):(.*)/) |
108 | { |
109 | ($configname, $configversion)=($1, $2); |
110 | |
111 | $configname =~ s/[ \t]//g; |
112 | $configversion =~ s/[ \t]//g; |
113 | |
114 | $old_version{$configname}=$configversion; |
115 | } |
116 | } |
117 | else |
118 | { |
119 | $resetflag=1; |
120 | $old_settings{$configname} .= $line |
121 | if $configname; |
122 | } |
123 | } |
124 | $oldfile=undef; |
125 | } |
126 | |
127 | my $newfile=new IO::File; |
128 | |
129 | die "$filename.new: $!\n" |
130 | if ! $newfile->open($noclobber ? ">/dev/null":">$filename.new"); |
131 | |
132 | eval { |
133 | { |
134 | my $f=$filename; |
135 | |
136 | $f =~ s:^.*/([^/]*)$:$1:; |
137 | |
138 | print $f . ":\n"; |
139 | } |
140 | |
141 | # Try to carry over ownership and perms |
142 | |
143 | my @inode=stat($distfile); |
144 | |
145 | die $! unless $#inode > 0; |
146 | |
147 | if (! $noclobber) |
148 | { |
149 | chown $inode[4], $inode[5], "$filename.new"; |
150 | chmod $inode[2], "$filename.new"; |
151 | } |
152 | |
153 | (print $newfile $distheader) || die $!; |
154 | |
155 | sysconftool_writeout($newfile, $distfile, \%old_settings, |
156 | \%old_version, "$filename.dist"); |
157 | } ; |
158 | |
159 | if ($@) |
160 | { |
161 | $newfile=undef; |
162 | unlink "$filename.new"; |
163 | die "$filename.new: $@"; |
164 | } |
165 | |
166 | $newfile=undef; |
167 | |
168 | rename "$filename", "$filename.bak" unless $noclobber; |
169 | rename "$filename.new", "$filename" unless $noclobber; |
170 | return 0; |
171 | } |
172 | |
173 | # Read the version header from the file. |
174 | |
175 | sub sysconftool_readver { |
176 | my $fh=shift; |
177 | |
178 | my $header; |
179 | my $cnt; |
180 | |
181 | for (;;) |
182 | { |
183 | my $line=<$fh>; |
184 | |
185 | last if ! defined $line || ++$cnt > 20; |
186 | |
187 | $header .= $line; |
188 | |
189 | return ($header, $line) if $line =~ /^\#\#VERSION:/; |
190 | } |
191 | |
192 | return undef; |
193 | } |
194 | |
195 | # |
196 | # Read the dist file, write out the config file, and try to piece it back |
197 | # from the old config file. |
198 | |
199 | sub sysconftool_writeout { |
200 | my $newfile=shift; |
201 | my $oldfile=shift; |
202 | my $old_settings=shift; |
203 | my $old_version=shift; |
204 | my $filename=shift; |
205 | |
206 | my $line; |
207 | |
208 | my $prefix_comment=0; |
209 | my $old_setting=""; |
210 | |
211 | my $last_setting=undef; |
212 | my $prev_setting=undef; |
213 | |
214 | while (defined($line=<$oldfile>)) |
215 | { |
216 | if (! ($line =~ /^\#/)) |
217 | { |
218 | if ($prev_setting) |
219 | { |
220 | # Before the first line of a new configuration setting |
221 | # print the obsoleted config setting (commented out). |
222 | |
223 | (print $newfile $prev_setting) || die $!; |
224 | $prev_setting=undef; |
225 | } |
226 | if ($prefix_comment > 0) |
227 | { |
228 | # Keeping old config setting, comment out the new dist |
229 | # setting. |
230 | |
231 | if ($prefix_comment < 2) |
232 | { |
233 | $prefix_comment=2; |
234 | (print $newfile "#\n# DEFAULT SETTING from $filename:\n") || die $!; |
235 | } |
236 | $line = "#$line"; |
237 | } |
238 | } |
239 | elsif ($line =~ /^\#\#NAME:(.*):(.*)/) |
240 | { |
241 | ($configname, $configversion)=($1, $2); |
242 | |
243 | $configname =~ s/[ \t]//g; |
244 | $configversion =~ s/[ \t]//g; |
245 | |
246 | $prefix_comment=0; |
247 | |
248 | if (defined $last_setting) |
249 | { |
250 | # Write out old config setting before we go to the next |
251 | # setting in the dist file. |
252 | |
253 | (print $newfile $last_setting) || die $!; |
254 | $last_setting=undef; |
255 | } |
256 | |
257 | if ( defined $$old_settings{$configname}) |
258 | { |
259 | if ($$old_version{$configname} eq $configversion) |
260 | { |
261 | # Setting didn't change in the dist file, keep |
262 | # current settings. |
263 | |
264 | print " $configname: unchanged\n"; |
265 | $prefix_comment=1; |
266 | $last_setting=$$old_settings{$configname}; |
267 | } |
268 | else |
269 | { |
270 | # Must install updated setting. Carefully comment |
271 | # out the current setting. |
272 | |
273 | print " $configname: UPDATED\n"; |
274 | |
275 | my @lines= |
276 | split (/\n/s,"$$old_settings{$configname}\n"); |
277 | |
278 | push @lines, "" if $#lines < 0; |
279 | |
280 | grep (s/^/\# /, @lines); |
281 | |
282 | $prev_setting= "#\n# Previous setting (inserted by sysconftool):\n#\n" . |
283 | join("\n", @lines) . "\n#\n"; |
284 | } |
285 | } |
286 | else |
287 | { |
288 | print " $configname: new\n"; |
289 | } |
290 | } |
291 | |
292 | (print $newfile $line) || die $!; |
293 | } |
294 | |
295 | # Write out any pending settings. |
296 | |
297 | if (defined $last_setting) |
298 | { |
299 | (print $newfile $last_setting) || die $!; |
300 | $last_setting=undef; |
301 | } |
302 | |
303 | if ($prev_setting) |
304 | { |
305 | (print $newfile $prev_setting) || die $!; |
306 | } |
307 | } |
308 | |
309 | ####### |
310 | |
311 | # Not everyone has Sort::Version, so we roll our own here. It's not that bad. |
312 | |
313 | sub versioncmp { |
314 | my @a=split (/\./, shift); |
315 | my @b=split (/\./, shift); |
316 | |
317 | for (;;) |
318 | { |
319 | my $a=shift @a; |
320 | my $b=shift @b; |
321 | |
322 | last if (! defined $a) && (! defined $b); |
323 | |
324 | return -1 if ! defined $a; |
325 | return 1 if ! defined $b; |
326 | |
327 | my @ap=versionsplitclass($a); |
328 | my @bp=versionsplitclass($b); |
329 | |
330 | for (;;) |
331 | { |
332 | my $a=shift @ap; |
333 | my $b=shift @bp; |
334 | |
335 | last if (! defined $a) && (! defined $b); |
336 | |
337 | return -1 if ! defined $a; |
338 | return 1 if ! defined $b; |
339 | |
340 | my $n; |
341 | |
342 | if ( $a =~ /[0-9]/) |
343 | { |
344 | $n= $a <=> $b; |
345 | } |
346 | else |
347 | { |
348 | $n= $a cmp $b; |
349 | } |
350 | |
351 | return $n if $n; |
352 | } |
353 | } |
354 | return 0; |
355 | } |
356 | |
357 | sub versionsplitclass { |
358 | my $v=shift; |
359 | my @a; |
360 | |
361 | while ( $v ne "") |
362 | { |
363 | if ($v =~ /^([0-9]+)(.*)/) |
364 | { |
365 | push @a, $1; |
366 | $v=$2; |
367 | } |
368 | else |
369 | { |
370 | die unless $v =~ /^([^0-9]+)(.*)/; |
371 | push @a, $1; |
372 | $v=$2; |
373 | } |
374 | } |
375 | return @a; |
376 | } |