scripts/rpmsync

   1 #!/usr/bin/perl
   2
   3
   4 # rpmsync - written by Ken Estes kestes@staff.mail.com
   5
   6 # $Revision: 1.2 $
   7 # $Date: 2001/09/15 13:49:39 $
   8 # $Author: jbj $
   9 # $Source: /home/boston/jkeating/rpmcvs/cvs/devel/rpm/scripts/rpmsync,v $
  10 # $Name:  $
  11
  12 use Fcntl;
  13 use File::Basename;
  14 use Getopt::Long;
  15 use IO::Socket;
  16 use IPC::Open3;
  17 use POSIX;
  18 use Symbol;
  19 use Sys::Hostname;
  20 use Sys::Syslog;
  21
  22
  23 # An rpm_package is a hash of:
  24 #     $package{'fqn'}="perl-5.00502-3"
  25 #     $package{'rpm_file'}="$RPMS_DIR/".
  26 #                "./sparc/perl-5.00502-3.solaris2.6-sparc.rpm"
  27 #     $package{'srpm_file'}="$SRPMS_DIR/".
  28 #                           "./perl-5.00502-3.src.rpm"
  29 #     $package{'name'}="perl"
  30 #     $package{'version'}="5.00502"
  31 #     $package{'release'}="3"
  32
  33 # fqn is "fully qualified name"
  34
  35 # The state of the system is a orderd list (topologically sorted by
  36 # dependendencies) of fqn's. The list may contain additional RPM flags
  37 # to be used on a particular list entry.
  38
  39 # we are going to compare two states the actual state of the machine
  40 # %INSTALLED_BY_NAME this is indexed by package names and gives a list
  41 # of rpm_package objects which are installed currently on the machine.
  42 # Each entry is a list of the packages with the given name which are
  43 # installed.
  44
  45 # The keys of the hash %LISTED_BY_FQN are the fqn's which are listed
  46 # in the manifest package list.
  47
  48
  49 # Here are a bunch of interesting RPM error messages:
  50 # rpm: --oldpackage may only be used during upgrades
  51
  52 sub usage {
  53 my $usage = <<"EOF";
  54 Usage:
  55         $PROGRAM --update | --force |--force_and_verify | --rollback | --test
  56                 [--log_file file] [--manifest_file file]
  57                 [--script_file file]
  58                 [--skip_check] [--verbose] [--silent]
  59                 [--help] [--version]
  60
  61
  62 Required Aguments:
  63
  64
  65 --test          test what an update would change.  Compare the installed
  66                 packges with the packages listed in the manifest file.
  67                 This option will show what commands would be executed if
  68                 we were to run an update without actually changing anything.
  69                 When an --update finishes it automatically runs --test
  70                 and exits with error if there is any work not
  71                 completed.  This command has nothing to do with the
  72                 '--verify' (-V) option to rpm.
  73
  74 --update        Update the packages installed on the system with the newer
  75                 versions listed in the manifest file.  This will not reinstall
  76                 packages which are listed and already installed but are
  77                 corrupted or were installed with the wrong set of arguments.
  78                 It will erase packages which are installed on the system but
  79                 not listed in the package list.  All packages must have a
  80                 later version number then the previous packages.
  81
  82 --rollback      Rollback a previously installed update.  This command
  83                 requires that the pervious manfest file be reinstalled.  All
  84                 update commands are run in the reverse order from the --update,
  85                 this ensures that the packages are undone exactly as they were
  86                 installed.
  87
  88 --force         Ensure that the packages installed on the machine are
  89                 exactly those packages listed in the manifest file and that no
  90                 installed files are currpted.  First each package in the
  91                 manifest file is installed using --force (even if it is already
  92                 installed) then each package which is installed but not listed
  93                 in the manifest list is removed from the machine.
  94
  95 --force_and_verify  This command behaves as if you ran this program first with
  96                      --force then ran rpm -Va.  The program will exit with
  97                      error if either of these steps fail.  This allows you to
  98                      perform unsafe operations (changing the name of a package
  99                      in a manifest list via a force) in a relatively safe
 100                      manner.
 101
 102
 103 Optional Aguments:
 104
 105
 106 --rpm_args      Specify additional arguments to pass to rpm for all package
 107                 operations.  This option is used by both the update and erase
 108                 commands.  This option can appear more then once on the
 109                 command line and the concatination of all options will be sent
 110                 to rpm.  This option should not be need somtimes it is useful,
 111                 in an emergency, to install packges with broken dependencies
 112                 or packages with duplicate files.  This is a quick way of
 113                 getting the --nodeps and --force and any other needed
 114                 arguments to rpm.
 115
 116 --log_file      specify a log file different from the default:
 117                          $LOG_FILE
 118
 119 --manifest_file specify a manifest file different from the default:
 120                          $MANIFEST_FILE
 121
 122 --skip_check    turn off internal sanity checks used by this script.  This
 123                 is not related to the --check option or to rpm -V.
 124
 125 --script_file   do not run any commands on this machine instead create a
 126                 shell file which can be used to install all the packages
 127                 in the manifest.  This script is useful during machine
 128                 creation.  To use this option you must specify
 129                 --update or --force.
 130
 131 --verbose       provide verbose output, only useful for debugging
 132                 this program.
 133
 134 --silent        Do not send any output to stdout/stderr messages will
 135                 still go to $LOG_FILE or syslog
 136
 137 --help          show this usage page.
 138
 139 --version       print the version number of this program.
 140
 141
 142 This program is used to ensure that the RPM packages installed on a
 143 system match the list of packages in a manifest.  The package list
 144 looks like the output of 'rpm -qa' but is required to be in a
 145 tolological order.  If special flags are needed for particular
 146 packages (like --nodeps or --force or --oldpackage or --noscriopts or
 147 --root <dir> or --relocate oldpath=newpath or --rcfile <file>) they
 148 can be added on the line after package name with a space separating
 149 the two.  Shell style comments (starting with \# and lasting till the
 150 next \\n) are legal in the package list.  The default package list
 151 file is $MANIFEST_FILE.
 152
 153 It is expected that most updates will use the --update command with
 154 --force saved for those rare situations where the machine is known to
 155 be in a very bad state or there are installed packages which are
 156 currupted.
 157
 158
 159
 160 Examples:
 161
 162
 163 rpmsync --help
 164 rpmsync --version
 165 rpmsync --update
 166 rpmsync --force
 167 rpmsync --test
 168
 169 rpmsync --force --rpm_args nodeps
 170
 171 rpmsync --update --rpm_args nodeps  --rpm_args noscripts \\
 172         --skip_check --verbose
 173
 174 rpmsync --update --script_file /tmp/rpmpkg.bootstrap.sh
 175
 176 EOF
 177
 178 print $usage;
 179 exit 0;
 180 }
 181
 182
 183
 184
 185
 186 sub new_rpm_package {
 187
 188 # An rpm_package is a hash of:
 189 #     $package{'fqn'}="perl-5.00502-3"
 190 #     $package{'rpm_file'}="$RPMS_DIR/".
 191 #                "./sparc/perl-5.00502-3.solaris2.6-sparc.rpm"
 192 #     $package{'srpm_file'}="$SRPMS_DIR/".
 193 #                           "./perl-5.00502-3.src.rpm"
 194 #     $package{'name'}="perl"
 195 #     $package{'version'}="5.00502"
 196 #     $package{'release'}="3"
 197
 198   my ($fqn, $error_context) = @_;
 199   my $error = '';
 200   my($name, $version, $release) = main::parse_fqn($fqn, $error_context);
 201
 202   my ($rpm_file, $install_script_file) =
 203     main::which_binary_package_path($name, $version, $release);
 204   ($rpm_file) ||
 205     ($error .= "Could not find binary file for package: '$fqn'\n");
 206
 207 #  my ($srpm_file) = main::which_source_package_path($name, $version, $release);
 208 #  ($srpm_file) ||
 209 #    ($error .= "Could not find source file for package: '$fqn'\n");
 210
 211   if ($error) {
 212     if (!$SKIP_CHECK) {
 213       die($error);
 214     } else {
 215       warn($error);
 216     }
 217   }
 218
 219   my ($package) = ();
 220
 221   $package->{'fqn'}=$fqn;
 222   $package->{'name'}=$name;
 223   $package->{'version'}=$version;
 224   $package->{'release'}=$release;
 225   $package->{'rpm_file'}=$rpm_file;
 226   $package->{'install_script_file'}=$install_script_file;
 227   $package->{'srpm_file'}=$srpm_file;
 228
 229   return bless($package, $class);
 230 }
 231
 232
 233 sub is_installed {
 234
 235 # returns true iff the package passed in is in fact installed on the
 236 # machine.
 237
 238   my ($required_pkg) = @_;
 239   my $installed_pkgs = $INSTALLED_BY_NAME{$required_pkg->{'name'}};
 240   # look for the right version/release of this package
 241   foreach $installed_pkg ( @{ $installed_pkgs } ) {
 242     ($installed_pkg->{'fqn'} eq $required_pkg->{'fqn'}) &&
 243       return 1;
 244   }
 245
 246   return 0;
 247 }
 248
 249
 250
 251 sub clean_up {
 252
 253 # any cleanup actions to be performed on exit should go here
 254
 255   closelog();
 256   close(STDERR);
 257   close(STDOUT);
 258
 259   return 1;
 260 } # clean_up
 261
 262
 263
 264 sub fatal_error {
 265   my  @error = @_;
 266
 267   foreach $_ (split("\n",join('',@error))) {
 268     (!$SILENT) && print STDERR ("$PROGRAM (fatal): $_\n");
 269     print LOG ("[$LOCALTIME] (fatal): $_\n");
 270   }
 271   syslog('crit', "fatal error at: ".localtime(time()));
 272   clean_up();
 273   die("[$LOCALTIME] $PROGRAM: fatal error at: ".localtime(time()) );
 274 }
 275
 276
 277 sub log_error {
 278   my  @error = @_;
 279
 280   foreach $_ (split("\n",join('',@error))) {
 281     (!$SILENT) && print STDERR ("$PROGRAM (warn): $_\n");
 282     print LOG ("[$LOCALTIME] (warn): $_\n");
 283   }
 284
 285 }
 286
 287
 288 sub info_error {
 289   my  @error = @_;
 290
 291   foreach $_ (split("\n",join('',@error))) {
 292     (!$SILENT) && print STDERR ("$PROGRAM (info): $_\n");
 293     print LOG ("[$LOCALTIME] (info): $_\n");
 294   }
 295
 296 }
 297
 298
 299 sub which_binary_package_path {
 300
 301 # this line will depend on the 'rpmfilename: ' in the rpmrc file in
 302 # the future we will need to try 'noos' as well as noarch, it is not
 303 # implemented in our RPM version.
 304
 305   my ($name, $version, $release) = @_;
 306
 307   foreach $dir ( split(':', $SEARCH_PATH) ) {
 308     foreach $arch ($ARCH, 'noarch', '') {
 309       foreach $os ($OS, 'noos', '') {
 310
 311     my $filename = '';
 312     my $install_script_filename = '';
 313
 314     $filename = eval "return \"$BINARY_PACKAGE_FILE_PAT\";";
 315     $install_script_filename = $filename;
 316     $install_script_filename =~ s/^$dir/\$REPOSITORY/;
 317     ( -f $filename ) && ( -s $filename ) && ( -r $filename )
 318       && return ($filename, $install_script_filename);
 319     ;
 320   }
 321     }
 322   }
 323   return ;
 324 }
 325
 326
 327 sub which_source_package_path {
 328
 329 # Each binary rpm package encodes the name of the source file which it
 330 # came from.  This is important since some sources generate several
 331 # binary packages (emacs, vim, perl), given one of those packages it
 332 # would be hard to find the source file name just doing regular
 333 # expressions on the name.  We extract this information using an rpm
 334 # query.
 335
 336   my ($name, $version, $release) = @_;
 337
 338   $binary_package_file =  (which_binary_package_path(@_))[0];
 339
 340   $binary_package_file || return ;
 341
 342   # this command would be better
 343   # rpm -qp --queryformat '[%{SOURCERPM}\n]'
 344
 345   my ($wait_status, $log_out, $log_err) =
 346     system3('cmd_vec' => [$SYS_CMDS{'rpm'}, '-qip', $binary_package_file],);
 347
 348   my ($source_rpm_file) = grep (/Source RPM: /, split(/\n+/, $log_out ));
 349
 350   ( $source_rpm_file =~ m/Source RPM:\s([-.\w]+)/ ) ||
 351     return ;
 352
 353   $source_rpm_file = $1;
 354
 355   foreach $dir ( split(':', $SEARCH_PATH) ) {
 356     my $filename = '';
 357
 358     $filename = eval "return \"$SOURCE_PACKAGE_FILE_PAT\";";
 359     ( -f $filename ) && ( -s $filename ) && ( -r $filename )
 360       && return $filename;
 361   }
 362
 363   return ;
 364 }
 365
 366
 367 sub parse_fqn {
 368
 369   # This is difficult to parse since some hyphens are significant and
 370   # others are not, some packages have alphabetic characters in the
 371   # version number.
 372
 373   # Also remember that the format of the file is dependent on how RPM
 374   # is configured so this may not be portable to all RPM users.
 375   my ($fqn, $error_context) = @_;
 376
 377   (!("$fqn" =~ m/^$PACKAGE_PAT$/)) &&
 378     die("package name '$fqn' is not in a valid format, $error_context");
 379
 380   return ($1, $2, $3);
 381 }
 382
 383
 384
 385 sub system3 {
 386
 387 # Lanuch a new child and wait for it to die.  This is like a call to
 388 # system but we get the stdout and stderr in addition to $?.
 389
 390 # call the function like this
 391
 392 # my  ($wait_status, $log_out, $log_err) =
 393 # open3(
 394 #     'cmd_vec' => [],
 395 #     'stdin_str' => '',
 396 #     'log_cmds'=> '';
 397 #     'ingore_error' => ''
 398 #      );
 399
 400 # cmd_vec is a command to run in execv format.  It is a list not a
 401 # string since we want the safe version of exec
 402
 403 # stdin_str is a string to pass on the standard in to the child program.
 404
 405 # If log_cmds is set then the command will be sent to syslog and the
 406 # log file.  All output from the command is also sent to the log file.
 407
 408 # open3 signals all errors through a die so will I.  If the command
 409 # exits with nonzero wait_status then system3 calls die.  This feature
 410 # can be turned of fby setting ignore_errors.
 411
 412 # the system3 function returns:
 413
 414 # wait_status: the wait_status of the child process
 415
 416 # log_out: the stdout that the child process wrote.
 417
 418 # log_err: the stderr the child process wrote.
 419
 420   my (%args) = @_;
 421
 422   my ($log_cmds, $ignore_error, $cmd_ref, $stdin) = @_;
 423
 424 #  if ( ! ( (-x $args{'cmd_vec'}->[0]) && (-f $args{'cmd_vec'}->[0]) ) ) {
 425 #    die ("Command not exectuable: '$args{'cmd_vec'}->[0]',\n");
 426 #  }
 427
 428   my $info ="executing: '@{ $args{'cmd_vec'} }',\n";
 429
 430   if ($args{'log_cmds'} || ($VERBOSE) ) {
 431     warn($info);
 432   }
 433
 434   # start the process
 435
 436   my $fh_in  = gensym();
 437   my $fh_out = gensym();
 438   my $fh_err = gensym();
 439
 440   ($fh_in && $fh_out && $fh_err) ||
 441     die ("Could not create new symbol, 'gensym()' object.\n");
 442
 443   my $child_pid = IPC::Open3::open3(
 444                                     $fh_in,
 445                                     $fh_out,
 446                                     $fh_err,
 447                                     @{$args{'cmd_vec'}}
 448                                     );
 449
 450   # this check should be redundant but better safe then sorry
 451
 452   ($child_pid) ||
 453       die ("Open3() did not start: '@{$cmd}'. $!\n");
 454
 455     if ($args{'stdin_str'}) {
 456
 457       # we should not have a deadlock with this syswrite since this
 458       # process writes and then the child reads.  It is hard to
 459       # imagine how this could fail and the machine still be in a
 460       # reasonable shape.
 461
 462       my $write_len = length($args{'stdin_str'})+1;
 463       my $rc = syswrite ($fh_in,
 464                          $args{'stdin_str'}."\n", $write_len);
 465
 466       (defined ($rc) && ( $rc == $write_len ) ) ||
 467         die("Syswrite to child stdin failed. ".
 468             "Could not write: '$write_len' ".
 469             "only wrote: '$rc' characters. ".
 470             "Trying to write to stdin: '$stdin'. ".
 471             ": $!\n");
 472     }
 473
 474
 475   close($fh_in) ||
 476     die("Could not close child stdin: $!\n");
 477
 478   main::nonblock($fh_out);
 479   main::nonblock($fh_err);
 480
 481   my $log_out = undef;
 482   my $log_err = undef;
 483
 484   my $reaped_pid = -1;
 485   my $wait_status = 0;
 486
 487   # wait for child to die, but keep clearing out stdout and stderr
 488   # buffers for process so we do not deadlock.
 489
 490   # WE seem to be loosing childrens signals occasionally, so actively
 491   # check if the child is alive.
 492
 493   while ($reaped_pid != $child_pid) {
 494
 495     sleep(1);
 496
 497     $reaped_pid = waitpid(-1, &WNOHANG | POSIX::WUNTRACED);
 498
 499     if ($reaped_pid == $child_pid) {
 500
 501       ($wait_status = $?);
 502
 503       # child signaled but did not exit
 504       # set to the same pid as 'no child waiting'
 505
 506       (WIFSTOPPED($wait_status)) &&
 507         ($reaped_pid = -1);
 508     }
 509
 510     my $data_out = '';
 511     my $data_err = '';
 512     my $rc = '';
 513
 514     # do the reading after reaping so we are sure that we exit the
 515     # loop only after draining the sockets.
 516
 517     # I do not think we need to log $rc errors as they happen
 518     # frequently and nothing seems wrong:
 519     #      Resource temporarily unavailable file_handle
 520
 521     do {
 522       $rc = sysread($fh_out, $data_out, POSIX::BUFSIZ, 0);
 523       $log_out .= $data_out;
 524     } until ($rc <= 0);
 525
 526     do {
 527       $rc = sysread($fh_err, $data_err, POSIX::BUFSIZ, 0);
 528       $log_err .= $data_err;
 529     } until ($rc <= 0);
 530
 531     ($data_err) && warn($data_err);
 532
 533   } # while pid
 534
 535   # the reads are at the bottom of the loop so we do not need to do
 536   # any more reading of the filehandles.
 537
 538   close($fh_out) ||
 539       &$log_error("Could not close child stdout: $!\n");
 540
 541   close($fh_err) ||
 542       &$log_error("Could not close child stderr: $!\n");
 543
 544   my @info = (
 545               "command results: \n",
 546               "  wait_status: $wait_status\n",
 547               "  stdout: '\n",
 548               # turn string into a list and indent each element
 549               (map {"    $_\n"} (split /\n+/, $log_out)),
 550               "  stdout: '\n",
 551               "  stderr: '\n",
 552               # turn string into a list and indent each element
 553               (map {"    $_\n"} (split /\n+/, $log_err)),
 554               "  stderr: '\n",
 555              );
 556
 557   if ( (!$args{'ignore_error'}) && ($wait_status) ) {
 558     print "\n\n";
 559     die("Cmd exited with error:\n",
 560         "\t@{$args{'cmd_vec'}}\n",
 561         @info);
 562   }
 563
 564   if ( ($VERBOSE) ||
 565        ( ($args{'log_cmds'})  &&
 566          ($wait_status || $log_out || $log_err) ) ) {
 567     warn(@info);
 568   }
 569
 570   return ($wait_status, $log_out, $log_err);
 571 } # system3
 572
 573
 574 sub get_rpm_info {
 575   my (@rpm_args) = @_;
 576
 577   update_time();
 578   my (@rpm_info) = '';
 579
 580   my ($wait_status, $log_out, $log_err) =
 581     system3('cmd_vec' => [$SYS_CMDS{'rpm'}, '-qa'],);
 582
 583   (@rpm_info) = split(/\n+/, $log_out);
 584
 585   %INSTALLED_BY_NAME=();
 586   my $lineno =0;
 587   foreach $fqn (@rpm_info) {
 588     $lineno++;
 589     chomp $fqn;
 590     my ($pkg) = new_rpm_package($fqn, "System Info lineno: $lineno");
 591     push @{ $INSTALLED_BY_NAME{$pkg->{'name'}} }, $pkg;
 592   }
 593
 594   return ;
 595 }
 596
 597
 598 sub remove_extra_packages {
 599
 600   # arguments are not used but allowed for symetry with other
 601   # functions
 602
 603   my(@pkg_list) = @_;
 604
 605   get_rpm_info();
 606
 607   # Remove packages installed on the machine but not not in the
 608   # manifest.  This is important as we sometimes change the package
 609   # names while upgrading them and if we did not remove all packages
 610   # which are not listed these packages would remain.
 611
 612   # We also need to remove old versions of just upgraded packages.
 613   # Currently we have a problem, some old packages are not being
 614   # removed when we do an rpm update.  Since we are currently only
 615   # installing one version of each package, remove all other versions
 616   # then what was required.
 617
 618
 619   # We would like to remove all packages in reverse topological order.
 620   # I have no way of finding out what that order is, so I use a single
 621   # command which removes all pacakges.  RPM will figure out the
 622   # correct order at run time.  This will cause us to reach the
 623   # command line limit if the list of packages to remove is large
 624   # enough.
 625
 626   my @extra_packages = ();
 627
 628   foreach $pkgname ( keys %INSTALLED_BY_NAME ) {
 629     foreach $pkg (@{ $INSTALLED_BY_NAME{$pkgname} }) {
 630
 631       ($LISTED_BY_FQN{$pkg->{'fqn'}}) && next;
 632
 633       push @extra_packages, $pkg->{'fqn'};
 634     }
 635   }
 636
 637   if (@extra_packages) {
 638     my ($wait_status, $log_out, $log_err) =
 639       system3(
 640               'cmd_vec' => [$SYS_CMDS{'rpm'}, '-e', @RPM_ARGS,
 641                           @extra_packages],
 642               'log_cmds'=> 1,
 643              );
 644   }
 645
 646   return ;
 647 }
 648
 649
 650 # update the installation with packages
 651
 652 sub update_packages {
 653   my(@pkg_list) = @_;
 654
 655   get_rpm_info();
 656
 657
 658   # first just test and see if this upgrade could work.
 659   # this may blowup some OS maximal argument size limit
 660
 661 #  my ($wait_status, $log_out, $log_err) =
 662 #    system3(
 663 #           'cmd_vec' => [$SYS_CMDS{'rpm'}, "--test", '-U',
 664 #                         @RPM_ARGS,
 665 #                         @upgrade_list],
 666 #           'log_cmds'=> 1,
 667 #          );
 668
 669
 670   foreach $pkg (@pkg_list) {
 671
 672     (is_installed($pkg)) && next;
 673
 674     my ($wait_status, $log_out, $log_err) =
 675       system3(
 676               'cmd_vec' => [
 677                             $SYS_CMDS{'rpm'}, '-U',
 678                             @{ $pkg->{'rpm_flags'} }, @RPM_ARGS,
 679                             $pkg->{'rpm_file'} ],
 680               'log_cmds'=> 1,
 681              );
 682   } # each $fqn
 683
 684   return ;
 685 } # update
 686
 687
 688
 689 # rollback the previous update installation
 690
 691 sub rollback_packages {
 692   my(@pkg_list) = @_;
 693
 694   get_rpm_info();
 695
 696
 697   # first just test and see if this upgrade could work.
 698   # this may blowup some OS maximal argument size limit
 699
 700 #  my ($wait_status, $log_out, $log_err) =
 701 #    system3(
 702 #           'cmd_vec' => [$SYS_CMDS{'rpm'}, "--test", '-U',
 703 #                         @RPM_ARGS,
 704 #                         @upgrade_list],
 705 #           'log_cmds'=> 1,
 706 #          );
 707
 708
 709   foreach $pkg (reverse @pkg_list) {
 710
 711     (is_installed($pkg)) && next;
 712
 713     my ($wait_status, $log_out, $log_err) =
 714       system3(
 715               'cmd_vec' => [
 716                             $SYS_CMDS{'rpm'}, '-U', '--oldpackage',
 717                             @{ $pkg->{'rpm_flags'} }, @RPM_ARGS,
 718                             $pkg->{'rpm_file'}
 719                            ],
 720               'log_cmds'=> 1,
 721              );
 722
 723   } # each $fqn
 724
 725   return ;
 726 } # rollback
 727
 728
 729 # force ALL the packages to be reinstalled
 730
 731 sub force_packages {
 732   my(@pkg_list) = @_;
 733
 734   # force all the packages in the list to be reinstalled
 735
 736   # first just test and see if this upgrade could work.
 737   # this may blowup some maximal argument size
 738
 739 #  my ($wait_status, $log_out, $log_err) =
 740 #    system3(
 741 #           'cmd_vec' => [$SYS_CMDS{'rpm'}, "--test", '-U', '--force',
 742 #                         @pkg_list],
 743 #           'log_cmds'=> 1,
 744 #          );
 745
 746
 747   foreach $pkg (@pkg_list) {
 748     my ($wait_status, $log_out, $log_err) =
 749       system3(
 750               'cmd_vec' => [
 751                             $SYS_CMDS{'rpm'}, '-U', '--force', '--oldpackage',
 752                             @{ $pkg->{'rpm_flags'} }, @RPM_ARGS,
 753                             $pkg->{rpm_file}
 754                            ],
 755               'log_cmds'=> 1,
 756              );
 757   }
 758
 759   return ;
 760 } # force
 761
 762
 763
 764 # check that the verify command exits without error.
 765
 766 sub verify_packages {
 767
 768   my ($wait_status, $log_out, $log_err) =
 769     system3(
 770             'cmd_vec' => [
 771                           $SYS_CMDS{'rpm'}, '-Va',
 772                          ],
 773             'log_cmds'=> 1,
 774            );
 775
 776   return ;
 777 } # verify
 778
 779
 780
 781 sub create_scriptfile {
 782   my(@pkg_list) = @_;
 783
 784   my $num_pkgs = scalar(@pkg_list);
 785
 786   if ($FORCE) {
 787     @args = ('-U', '--force');
 788   } elsif ($UPDATE) {
 789     @args = ('-U', );
 790   } else {
 791     die("Scripts can only be created for --update or --force")
 792   }
 793
 794   my $out = '';
 795
 796   $out =<<EOF
 797
 798 # This file automatically generated by program: $0
 799 # version: $main::VERSION
 800 # on host: $main::HOSTNAME
 801 # localtime: $main::LOCALTIME
 802 #
 803 # This install file automatically installs
 804 #    manifest file $MANIFEST_FILE
 805
 806     $SYS_CMDS{'rpm'} --rebuilddb
 807
 808 EOF
 809 ;
 810
 811   foreach $pkg (@pkg_list) {
 812     my @cmd = (
 813                $SYS_CMDS{'rpm'}, @args,
 814                @{ $pkg->{'rpm_flags'} }, @RPM_ARGS,
 815                $pkg->{install_script_file}
 816               );
 817
 818     $out .=<<EOF;
 819
 820     @cmd
 821     if [ \$\? \-ne 0 ]; then
 822       echo \>\&2 "\$0: Error running: @cmd"
 823       exit 1;
 824     fi
 825
 826 EOF
 827
 828   }
 829
 830
 831   $out .=<<EOF;
 832
 833   # check that the install for accuracy
 834
 835   $SYS_CMDS{'rpm'} --rebuilddb;
 836
 837   $SYS_CMDS{'rpm'} -Va;
 838   if [ \$\? \-ne 0 ]; then
 839     echo \>\&2 "\$0: Error installing Packages";
 840     echo \>\&2 "\$0: 'rpm -Va' reports errors";
 841     exit 1;
 842   fi
 843
 844     num_installed_pkgs=\` $SYS_CMDS{'rpm'} -qa | wc \-\l | sed "s/[^0-9]//g" \`;
 845     if [ \$num_installed_pkgs \-ne $num_pkgs ]; then
 846       echo \>\&2 "\$0: Error installing Packages";
 847       echo \>\&2 "\$0: rpm -qa gives \$num_installed_pkgs packages installed";
 848       echo \>\&2 "\$0: expected $num_pkgs installed";
 849       exit 1;
 850     fi
 851
 852    exit 0;
 853
 854 EOF
 855
 856   return $out;
 857 } # create_script
 858
 859
 860
 861
 862 # check what running with --update would do.  If I were to write a
 863 # check_rollback_packages the output would be similar but the packge
 864 # update order would be reversed.
 865
 866 sub test_update {
 867   my(@pkg_list) = @_;
 868
 869   get_rpm_info();
 870
 871   # find what we will upgrade
 872
 873   foreach $pkg (@pkg_list) {
 874     is_installed($pkg) && next;
 875     push @out, "out of sync, must update: $pkg->{'fqn'}\n";
 876   } # each $fqn
 877
 878
 879   # remove old versions of what we installed.
 880
 881   foreach $pkgname ( keys %INSTALLED_BY_NAME ) {
 882     foreach $pkg (@{ $INSTALLED_BY_NAME{$pkgname} }) {
 883
 884       ($LISTED_BY_FQN{$pkg->{'fqn'}}) && next;
 885
 886       push @out, "out of sync, must delete: $pkg->{'fqn'}\n";
 887     }
 888   }
 889
 890   return @out;
 891 } # test_update
 892
 893
 894
 895 sub nonblock {
 896
 897     # unbuffer a fh so we can select on it
 898
 899     my ($fh) = shift;
 900     my $rc = '';
 901     my $flags = '';
 902
 903     $flags = fcntl($fh, F_GETFL, 0) ||
 904         fatal_error("Could not get flags of socket: $fh : $!\n");
 905
 906     $flags |= O_NONBLOCK;
 907
 908     $rc = fcntl($fh, F_SETFL, $flags) ||
 909         fatal_error("Could not set flags of socket: $fh : $!\n");
 910
 911     return 1;
 912 }
 913
 914
 915
 916 sub mkdir_R {
 917 # a recusive mkdir function
 918
 919   my ($dir, $mode) = @_;
 920   my @dir = split('/', $dir);
 921
 922   foreach $i (0..$#dir) {
 923
 924     my ($dir) = join('/', @dir[0..$i]);
 925     ($dir) || next;
 926
 927       (-d $dir) ||
 928         mkdir($dir, $mode) ||
 929           die("Could not mkdir: $dir, for writing: $!\n");
 930   }
 931
 932   return ;
 933 }
 934
 935
 936 sub chk_system_config {
 937   # refuse to start if the system is in a dangerous state
 938
 939
 940   @problem = ();
 941
 942   # this is just a placeholder for now
 943   # checks go here and failures add to @problem
 944
 945   return @problem;
 946 }
 947
 948
 949 # park a bunch of unused function here for future scripts
 950
 951
 952 sub run_local_rcscripts {
 953   my @script_args = @_;
 954
 955   (-d $LOCAL_RC2_DIR) || return ;
 956
 957   my @rc_files = ();
 958
 959   opendir(DIR, "$LOCAL_RC2_DIR") ||
 960     die("Could not opendir: '$LOCAL_RC2_DIR': $!\n");
 961
 962   @rc_files = grep(/^S/, readdir(DIR));
 963
 964   closedir(DIR) ||
 965     die("Could not closedir : '$LOCAL_RC2_DIR': $!\n");
 966
 967   ( scalar(@rc_files) > 0 ) || return ;
 968
 969   if ($script_args[0] eq 'start') {
 970     @rc_files =         sort @rc_files;
 971   }else{
 972     @rc_files = reverse sort @rc_files;
 973   }
 974
 975   foreach $script (@rc_file) {
 976     my ($wait_status, $log_out, $log_err) =
 977       system3(
 978               'cmd_vec' => ["$LOCAL_RC2_DIR/$script", @script_args],
 979               'log_cmds'=> 1,
 980              );
 981   }
 982
 983   return ;
 984 }
 985
 986
 987 sub update_package_list {
 988
 989   my $update_script = '';
 990
 991   # learn what updates we wish to make
 992
 993   {
 994     open(FILELIST, "<$BUILD_FILE") ||
 995       die("Could not open build file: '$BUILD_FILE': $!\n");
 996
 997     my $lineno = 0;
 998     while ($fqn=<FILELIST>) {
 999       $lineno++;
1000       $fqn =~ s/\#.*$//;
1001       $fqn =~ s/\s+//g;
1002
1003       # untaint the input. As a security precaution only allow a few
1004       # "good characters" in the package name, or our eval of the
1005       # update_script might do some really unexpected things.
1006
1007       if ($fqn =~ m/([-_.a-zA-Z0-9]+)/) {
1008         my $pkg = new_rpm_package($1, "file: $BUILD_FILE lineno: $lineno");
1009         $update_script .= "\$fqn =~ s/^$pkg->{'name'}-\\d.*\$/$pkg->{'fqn'}/;\n"
1010       }
1011     }
1012
1013     close(FILELIST) ||
1014       die("Could not close build file: '$BUILD_FILE': $!\n");
1015   }
1016
1017   # Perform the modifications to the file list
1018
1019   {
1020
1021 # co -l $MANIFEST_FILE
1022
1023     rename($MANIFEST_FILE, $MANIFEST_FILE.".bak") ||
1024       die("Could not rename ".
1025           "file: $MANIFEST_FILE, ${PACKAGE_FILE}.bak: $!\n");
1026
1027     open(FILELIST_IN, "<${PACKAGE_FILE}.bak") ||
1028       die("Could not open for writing ".
1029           "packagefile: '${PACKAGE_FILE}.bak': $!\n");
1030
1031     open(FILELIST_OUT, ">$MANIFEST_FILE") ||
1032       die("Could not read from packagefile: '${PACKAGE_FILE}.bak': $!\n");
1033
1034     while ($fqn=<FILELIST_IN>) {
1035       eval $update_script;
1036       print FILELIST_OUT $fqn;
1037     }
1038
1039     close(FILELIST_OUT) ||
1040       die("Could not close packagefile: '$MANIFEST_FILE': $!\n");
1041
1042     close(FILELIST_IN) ||
1043       die("Could not close packagefile: '${PACKAGE_FILE}.bak': $!\n");
1044
1045 # ci -u $MANIFEST_FILE
1046
1047   }
1048
1049   return ;
1050 }
1051
1052
1053 sub include_file {
1054   my ($filename) = @_;
1055   my (@inc) = ();
1056   my $fh = gensym();
1057
1058   (-f "$INCLUDE_DIR/$filename") ||
1059     die("include file: $INCLUDE_DIR/$filename, \n".
1060         "found while expanding: $BUILD_FILE, does not exist.\n");
1061
1062   open($fh, ">$INCLUDE_DIR/$filename") ||
1063     die("Could not open include file: '$INCLUDE_DIR/$filename': $!\n");
1064
1065   while (defined($line = <$fh>) ) {
1066
1067     if ($line =~ m/\w*\$([-_.a-zA-Z0-9]+)/) {
1068       push @inc, include_file($line);
1069     } else {
1070       push @inc, $line;
1071     }
1072
1073   }
1074
1075   close($fh) ||
1076     die("Could not close include file: '$INCLUDE_DIR/$filename': $!\n");
1077
1078   return @inc;
1079 }
1080
1081
1082 sub expand_package_list {
1083
1084   my $update_script = '';
1085
1086   # learn what updates we wish to make
1087
1088     open(INFILE, "<$BUILD_FILE") ||
1089       die("Could not open build file: '$BUILD_FILE': $!\n");
1090
1091     open(OUTFILE, ">$TMP_FILE") ||
1092       die("Could not open tmp file: '$TMP_FILE': $!\n");
1093
1094     while ($line=<INFILE>) {
1095
1096       # untaint the input. As a security precaution only allow a few
1097       # "good characters" in the package name.
1098
1099       if ($line =~ m/\w*\$([-_.a-zA-Z0-9]+)/) {
1100         print include_file($1);
1101       } else {
1102         print $line;
1103       }
1104
1105     }
1106
1107     close(INFILE) ||
1108       die("Could not close build file: '$BUILD_FILE': $!\n");
1109
1110     close(OUTFILE) ||
1111       die("Could not close tmp file: '$TMP_FILE': $!\n");
1112
1113   return ;
1114 }
1115
1116
1117 sub update_time {
1118
1119   $TIME = time();
1120   $LOCALTIME = localtime($main::TIME);
1121
1122   return ;
1123 }
1124
1125
1126
1127 sub set_static_vars {
1128
1129 # This functions sets all the static variables which are often
1130 # configuration parameters.  Since it only sets variables to static
1131 # quantites it can not fail at run time. Some of these variables are
1132 # adjusted by parse_args() but asside from that none of these
1133 # variables are ever written to. All global variables are defined here
1134 # so we have a list of them and a comment of what they are for.
1135
1136   @ORIG_ARGV = @ARGV;
1137
1138   $INCLUDE_DIR = "";
1139   $TMP_FILE = "";
1140
1141   $LOG_FILE="/var/log/rpmsync/log";
1142   $LOCK_FILE="/var/lock/rpmsync";
1143   $MANIFEST_FILE="/usr/local/etc/rpmpkg.manifest";
1144
1145   $FTP_PATH='ftp://machine.iname.net/pub/redhat';
1146   $SEARCH_PATH = (
1147                   # the old hard mounted master-mm package repository
1148                   '/net/master-mm/export/rpms/redhat'.
1149
1150                   # the new auto mounted master-mm package repository
1151                   ':/network/master-mm.mail.com/export/rpms/redhat'.
1152
1153                   # look in obvious places on the machine for packages
1154                   ':/tmp'.
1155
1156                   ':/usr/local/src/redhat/noarch'.
1157                   ':/usr/local/src/redhat/sparc'.
1158                   ':/usr/local/src/redhat/i386'.
1159
1160                   # for testing: this is how the current build machine
1161                   # is set up.
1162
1163                   ':/data1/archive/redhat');
1164
1165   $VERSION = ( qw$Revision: 1.2 $ )[1];
1166
1167   $VERBOSE=0;
1168   $SKIP_CHECK=0;
1169
1170   # The pattern for fqn.  remember that the format of the file is
1171   # dependent on how RPM is configured so this may not be portable to
1172   # all RPM users.
1173
1174   $BINARY_PACKAGE_FILE_PAT = ('$dir/RPMS/$arch/'.
1175                               '$name-$version-$release.$os-$arch.rpm');
1176   $SOURCE_PACKAGE_FILE_PAT = '$dir/SRPMS/$source_rpm_file';
1177
1178   # The pattern for parsing fqn into ($name, $version, $release).
1179   # This is difficult to parse since some hyphens are significant and
1180   # others are not, some packages have alphabetic characters in the
1181   # version number.
1182
1183   $PACKAGE_PAT ='(.*)-([^-]+)-([^-]+)';
1184
1185   # set a known path
1186
1187   $ENV{'PATH'}= (
1188                  '/usr/bin'.
1189                  ':/data/gnu/bin'.
1190                  ':/data/local/bin'.
1191                  ':/data/devel/bin'.
1192                  ':/usr/local/bin'.
1193                  ':/bin'.
1194                  '');
1195
1196
1197   # taint perl requires we clean up these bad environmental variables.
1198
1199   delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
1200
1201   %SYS_CMDS = (
1202                'hostname' => 'hostname',
1203                'rpm' => 'rpm',
1204                'uname' => 'uname',
1205               );
1206
1207   $SIG{'CHLD'} = 'DEFAULT';
1208
1209   return ;
1210 }
1211
1212
1213 sub get_env {
1214
1215 # this function sets variables similar to set_static variables.  This
1216 # function may fail only if the OS is in a very strange state.  after
1217 # we leave this function we should be all set up to give good error
1218 # handling, should things fail.
1219
1220   $| = 1;
1221   $PROGRAM = basename($0);
1222   $PID = $$;
1223   $TIME = time();
1224   $LOCALTIME = localtime($main::TIME);
1225
1226   $START_TIME = $TIME;
1227   $UID = $<;
1228
1229   update_time();
1230   my ($wait_status, $log_out, $log_err) =
1231     system3('cmd_vec' => ['hostname'],);
1232
1233   $HOSTNAME = $log_out;
1234   chomp $HOSTNAME;
1235
1236   my ($wait_status, $log_out, $log_err) =
1237     system3('cmd_vec' => ['uname', '-a'],);
1238   $uname = $log_out;
1239
1240   ( $uname =~ m/sparc/ ) && ( $ARCH="sparc");
1241   ( $uname =~ m/i\d86/ ) && ( $ARCH="i386" );
1242
1243   $osname = $^O;
1244   ( $osname =~ m/solaris/ ) && ( $OS="solaris2.6" );
1245   ( $osname =~ m/linux/ )   && ( $OS="linux" );
1246
1247   return ;
1248 } # get_env
1249
1250
1251 sub parse_args {
1252
1253   Getopt::Long::config('require_order', 'auto_abbrev', 'ignore_case');
1254
1255   my ($help, $version, $force_and_verify);
1256
1257   %option_linkage = (
1258                      "version" => \$version,
1259                      "verbose" => \$VERBOSE,
1260                      "silent" => \$SILENT,
1261                      "help" => \$help,
1262                      "skip_check" => \$SKIP_CHECK,
1263                      "log_file" => \$LOG_FILE,
1264                      "manifest_file" => \$MANIFEST_FILE,
1265                      "update"=>\$UPDATE,
1266                      "force"=>\$FORCE,
1267                      "force_and_verify"=>\$force_and_verify,
1268                      "rollback"=>\$ROLLBACK,
1269                      "test"=>\$TEST,
1270                      "rpm_args" =>\@RPM_ARGS,
1271                      "script_file" =>\$SCRIPT_FILE,
1272                     );
1273
1274
1275   GetOptions (\%option_linkage, qw(
1276                  silent! verbose! version! help! skip_check!
1277                  update! force! force_and_verify! rollback! test!
1278                  manifest_file=s script_file=s
1279                  log_file=s manifest_file=s
1280                  rpm_args=s@
1281                 )) ||
1282                     die("Illegal options in \@ARGV: '@ARGV',");
1283
1284   if ($force_and_verify) {
1285     $FORCE = 1;
1286     $VERIFY = 1;
1287   }
1288
1289   if ($version) {
1290     print "$0: Version: $VERSION\n";
1291     exit 0;
1292   }
1293
1294   if ($help) {
1295     usage();
1296   }
1297
1298   $Process::VERBOSE = $VERBOSE;
1299
1300   {
1301
1302     my $args=0;
1303
1304     ($UPDATE) &&
1305       $args++;
1306
1307     ($FORCE) &&
1308       $args++;
1309
1310     ($TEST) &&
1311       $args++;
1312
1313     ($ROLLBACK) &&
1314       $args++;
1315
1316     ($args == 0) &&
1317       die("Must have: 'update', 'force', 'test', 'rollback', argument.\n");
1318
1319     ($args > 1) &&
1320       die("Can not choice more then one: ".
1321           "'update', 'force', 'test', 'rollback', arguments.\n");
1322   }
1323
1324   return 1;
1325 } # parse_args
1326
1327
1328 sub set_logging {
1329
1330 # setup the logging facilities to send errors to syslog/log file.
1331
1332 # this needs to come after parse_args() so that we send usage and argv
1333 # errors to the stderr.
1334
1335   {
1336     my $logopt = 'cons,ndelay';
1337     my $facility = 'daemon';
1338
1339     # no need to test if this succeeds.  It calls croak so we will
1340     # die if there is a problem.
1341
1342     openlog($PROGRAM, $logopt, $facility);
1343   }
1344
1345   $SIG{'__WARN__'} = \&log_error;
1346   $SIG{'__DIE__'} =  \&fatal_error;
1347
1348   my @sys_errors = chk_system_config();
1349
1350   if (@sys_errors) {
1351     if ($SKIP_CHECK) {
1352
1353       # even though we are skipping the test put a record of the
1354       # problems in the log
1355
1356       warn(
1357            "Warning Error list:\n",
1358            @sys_errors,
1359            "End Warning Error list\n",
1360            "These Errors would be fatal, ".
1361            "if run without '--skip_check'\n"
1362           );
1363
1364     } else {
1365
1366       # should not start with these problems
1367
1368       die("Fatal Error list:\n",
1369                   @sys_errors,
1370                   "End Fatal Error list\n");
1371     }
1372   }
1373
1374   if ($LOG_FILE) {
1375     # redirect error log
1376     mkdir_R(dirname($LOG_FILE), 0755);
1377
1378     open (LOG, ">>$LOG_FILE") ||
1379       die("Could not open log_file: $LOG_FILE, ".
1380           "for writing: $!\n");
1381
1382     print LOG "\n";
1383     chmod 0744, $LOG_FILE;
1384     LOG->autoflush(1);
1385   }
1386
1387   STDERR->autoflush(1);
1388
1389 }
1390
1391
1392 sub get_package_list  {
1393
1394 # load the $package_file into memory
1395
1396 # this fucntion must follow get_env() since we need $skip_check to be
1397 # respected, if set.
1398
1399   my ($package_file) = @_;
1400   my @pkg_list = ();
1401
1402   (%LISTED_BY_FQN) = ();
1403
1404   my %package_count = ();
1405   open(FILELIST, "<$package_file") ||
1406     die("Could not open packagefile: '$package_file': $!\n");
1407
1408   my $fqn;
1409   my $lineno = 0;
1410
1411   while ($fqn=<FILELIST>) {
1412     $lineno++;
1413     my $new_package = '';
1414     my $pkg_flags = '';
1415
1416     chomp $fqn;
1417     $fqn =~ s/\#.*$//;
1418     if ($fqn =~ s/\s+(.*)$// ) {
1419       $pkg_flags = $1;
1420     }
1421     ($fqn) || next;
1422
1423     $new_package = new_rpm_package($fqn, "file: BUILD_FILE lineno: $lineno");
1424     ($pkg_flags) &&
1425       ($new_package->{'rpm_flags'} = [ split(/\s+/, $pkg_flags) ] );
1426     $package_count{ $new_package->{'name'} }++;
1427     $LISTED_BY_FQN{$new_package->{'fqn'}} = 1;
1428     push @pkg_list, $new_package ;
1429   }
1430
1431   close(FILELIST) ||
1432     die("Could not close packagefile: '$package_file': $!\n");
1433
1434   foreach $pkg_name (sort keys %package_count) {
1435     ($package_count{ $pkg_name } > 1) &&
1436       die("Package: $pkg_name is listed ".
1437           "$package_count{ $pkg_name } times ".
1438           "in file: $package_file\n");
1439   }
1440
1441   return (@pkg_list);
1442 }
1443
1444
1445 sub get_package_hash  {
1446
1447 # load the $package_file into memory
1448
1449 # this fucntion must follow get_env() since we need $skip_check to be
1450 # respected, if set.
1451
1452   my $package_file = @_;
1453   my $pkg_hash = ();
1454
1455   open(FILELIST, "<$package_file") ||
1456     die("Could not open packagefile: '$package_file': $!\n");
1457   my $lineno = 0;
1458
1459   while ($fqn=<FILELIST>) {
1460     $lineno++;
1461     $fqn =~ s/\#.*$//;
1462     $fqn =~ s/\s+//g;
1463     chomp $fqn;
1464     ($fqn) || next;
1465
1466     my ($pkg) = new_rpm_package($fqn, "file: $package_file lineno: $lineno");
1467     push @{ $pkg_hash{$pkg->{'name'}} }, $pkg;
1468   }
1469
1470
1471   close(FILELIST) ||
1472     die("Could not close packagefile: '$package_file': $!\n");
1473
1474   return ($pkg_hash);
1475 }
1476
1477
1478
1479 sub pkg_diff {
1480
1481   $hash0=get_package_hash($file0);
1482   $hash1=get_package_hash($file1);
1483
1484   my ($pkg_out, $file_out);
1485   my @warnings = ();
1486   my %seen = ();
1487
1488   foreach $pkg_name ( keys %{$hash0}, keys %{$hash1} ) {
1489
1490     $seen{$pkg_name} && next;
1491     $seen{$pkg_name} = 1;
1492      if (
1493         ( scalar($hash0->{$pkg_name}) > 1) ||
1494         ( scalar($hash1->{$pkg_name} > 1 ) )
1495        ) {
1496       push @warnings, $pkg_name;
1497     }
1498
1499     if ( ($hash0->{$pkg_name}) &&
1500          (!($hash1->{$pkg_name}) ) ) {
1501       $pkg_out .= "missing $hash0->{$pkg_name}->{'fqn'}\n";
1502       next;
1503     } elsif ( (!($hash0->{$pkg_name})) &&
1504               ($hash1->{$pkg_name}) ) {
1505       $pkg_out .= "added   $hash1->{$pkg_name}->{'fqn'}\n";
1506       next;
1507     } else {
1508
1509       my ($wait_status, $log_out, $log_err) =
1510         system3('cmd_vec' => [
1511                               'rpmdiff',
1512                               ($hash0->{$pkg_name}->{'name'}),
1513                               ($hash1->{$pkg_name}->{'name'}),
1514                              ],);
1515       $file_out .= $log_out;
1516     }
1517
1518   } # each $pkg_name
1519
1520   print  ("Package Differences:\n\n".
1521           sort( split(/\n+/, $pkg_out) ).
1522           "\n\nFile Differences:\n\n".
1523           sort( split(/\n+/, $file_out) ) );
1524
1525   if (@warnings) {
1526     print STDERR ("The following packages have more then one version\n".
1527                   " mentioned in the pkglist: ".
1528                   join(", ", @warnings)."\n".
1529                   "The diff algorithm assumes only single versions\n".
1530                   "in pkglist file.\n");
1531   }
1532
1533   return ;
1534 }
1535
1536
1537
1538 # -----------------------main--------------------------
1539
1540 {
1541   set_static_vars();
1542   get_env();
1543
1544   parse_args();
1545   set_logging();
1546   @MANIFEST = get_package_list($MANIFEST_FILE);
1547
1548   # Learn the state of the machine and ensure that we have the srpms
1549   # and rpms for this state.  This must be done after parsing the
1550   # arguments since we may have set '--skip_check'
1551
1552   get_rpm_info('-qa');
1553
1554   info_error("starting argv: '@ORIG_ARGV' \n");
1555   syslog('info', "starting argv: '@ORIG_ARGV' \n");
1556
1557   my ($exit_with_error) = 0;
1558
1559   my ($wait_status, $log_out, $log_err) = ();
1560
1561   ($UID == 0 ) &&
1562     ( ($wait_status, $log_out, $log_err) =
1563       system3('cmd_vec' => [$SYS_CMDS{'rpm'}, '--rebuilddb'],));
1564
1565   if ($TEST) {
1566
1567     my (@todo) = test_update(@MANIFEST);
1568
1569     if (@todo) {
1570       warn(@todo);
1571       $exit_with_error = 1;
1572     }
1573
1574   } elsif ($SCRIPT_FILE) {
1575
1576     open(SCRIPT_FILE, ">$SCRIPT_FILE") ||
1577       die("Could not write to file: $SCRIPT_FILE. $!\n");
1578
1579     my $script = create_scriptfile(@MANIFEST);
1580     print SCRIPT_FILE $script;
1581
1582     close(SCRIPT_FILE) ||
1583       die("Could not close file: $SCRIPT_FILE. $!\n");
1584
1585   } else {
1586
1587     # eventually there will be a installer id who will run this code but
1588     # for now rpm must be run as  root.
1589
1590     ($UID == 0 ) ||
1591       die("Must run this program as root\n");
1592
1593     ($FORCE) &&
1594       force_packages(@MANIFEST);
1595
1596     ($UPDATE) &&
1597       update_packages(@MANIFEST);
1598
1599     ($ROLLBACK) &&
1600       rollback_packages(@MANIFEST);
1601
1602     remove_extra_packages(@MANIFEST);
1603
1604     my ($wait_status, $log_out, $log_err) =
1605       system3('cmd_vec' => [$SYS_CMDS{'rpm'}, '--rebuilddb'],);
1606
1607     my @problems = test_update(@MANIFEST);
1608
1609     (@problems) && die("@problems");
1610
1611     ($VERIFY) &&
1612       verify_packages(@MANIFEST);
1613   }
1614
1615   info_error("finished argv: '@ORIG_ARGV' \n");
1616   syslog('info', "finished argv: '@ORIG_ARGV' \n");
1617
1618   clean_up();
1619
1620   ($exit_with_error) &&
1621     exit 9;
1622
1623   exit 0;
1624 }
1625