sysconftool

   1 #!/usr/bin/perl
   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
  15 my $myversion="0.17";
  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 }