1#!/usr/bin/perl
2# Copyright 2000 Double Precision, Inc.  See COPYING for
3# distribution information.
4
5use IO::File;
6use Getopt::Long;
7
8my $exitcode=0;
9
10my $ver;
11my $noclobber;
12my $force;
13my $require;
14
15my $myversion="0.18";
16
17exit 1 unless GetOptions("v" => \$ver, "n" => \$noclobber,
18			 "f" => \$force, "r=s" => \$require);
19
20print "$myversion\n" if $ver;
21
22die "$0: Version not supported.\n"
23    if $require && versioncmp($myversion, $require) < 0;
24
25while ($#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
48exit ($exitcode);
49
50sub 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
174sub 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
198sub 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
312sub 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
356sub 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}
376