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