sysconftool

   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 }