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