Updated dependency scripts (#20295).

CVS patchset: 4625
CVS date: 2001/03/15 13:58:16

13 files changed, 3049 insertions, 39 deletions

diff --git a/scripts/Makefile.am b/scripts/Makefile.am
index 971de3e79..2b2a764c6 100644
--- a/scripts/Makefile.am
+++ b/scripts/Makefile.am
@@ -9,7 +9,8 @@ EXTRA_DIST = \
 	find-prov.pl find-req.pl cpanflute find-provides.perl \
 	find-requires.perl get_magic.pl getpo.sh http.req \
 	magic.prov magic.req perl.prov perl.req rpmdiff rpmdiff.cgi \
-	trpm u_pkg.sh vpkg-provides.sh vpkg-provides2.sh
+	sql.prov sql.req tcl.req trpm u_pkg.sh \
+	vpkg-provides.sh vpkg-provides2.sh
 
 installprefix = $(DESTDIR)
 
@@ -22,5 +23,6 @@ config_SCRIPTS = \
 	brp-sparc64-linux check-prereqs convertrpmrc.sh find-lang.sh \
 	find-prov.pl find-req.pl cpanflute find-provides.perl \
 	find-requires.perl get_magic.pl getpo.sh http.req \
-	magic.prov magic.req perl.prov perl.req rpmdiff rpmdiff.cgi u_pkg.sh \
+	magic.prov magic.req perl.prov perl.req rpmdiff rpmdiff.cgi \
+	sql.prov sql.req tcl.req u_pkg.sh \
 	vpkg-provides.sh vpkg-provides2.sh
diff --git a/scripts/http.req b/scripts/http.req
index 617958893..5d04d0c63 100755
--- a/scripts/http.req
+++ b/scripts/http.req
@@ -25,12 +25,42 @@
 # (html with embedded java) since jhtml is deprecated so is this part
 # of the code.
 
+# These references create dependencies:
+
+#	<form action="signup.jhtml" method="POST">
+#
+#	<img src="images/spacer.gif" width=1>
+#
+#	<A HREF="signup.jhtml">
+#
+#	adWidget.writeAd(out, "login.html", "expired");
+#
+#	response.sendRedirect("http://"+request.getServerName()+"/mailcom/login.jhtml");
+
+
+# Notice how we look for strings WITH the proper ending. This is
+# because the java sometimes has really strange double quoting
+# conventions.  Look at how splitting out the strings in this
+# fragment would get you the wrong text.
+
+#      <img src="`c.getImage("bhunterlogo.gif")`" width=217 >
+
+# Ignore non relative references since these dependencies can not be
+# met. (ie, no package you install will ever provide
+# 'http://www.yahoo.com').
+
+# I use basename since I have seen too many http references which
+# begin with '../' and I can not figure out where the document root
+# is for the webserver this would just kill the dependnecy tracking
+# mechanism.
+
+
 
 use File::Basename;
 
 # this is the pattern of extensions to call requirements
 
-$DEPS_PAT = '\.((cgi)|(ps)|(pdf)|(png)|(jpg)|(gif)|(tiff)|(tif)|(xbm)|(html)|(htm)|(shtml)|(jhtml))$'; #'
+$DEPS_PAT = '\.((cgi)|(ps)|(pdf)|(png)|(jpg)|(gif)|(tiff)|(tif)|(xbm)|(html)|(htm)|(shtml)|(jhtml))'; #'
 
 if ("@ARGV") {
   foreach (@ARGV) {
@@ -81,18 +111,27 @@ sub process_file {
   s!/\*.*?\*/!!g;
   s/<!--.*?-->//g;
 
-  # html references other html documents inside strings.  Ignore non
-  # relative references since these dependencies can not be met. (ie,
-  # no package you install will ever provide 'http://www.yahoo.com').
+  # Ignore non relative references since these dependencies can not be
+  # met. (ie, no package you install will ever provide
+  # 'http://www.yahoo.com').
+
   # I use basename since I have seen too many http references which
-  # begin with '../' this would just kill the dependnecy tracking
+  # begin with '../' and I can not figure out where the document root
+  # is for the webserver this would just kill the dependnecy tracking
   # mechanism.
 
-  while ( m{\"([^\"]+)\"}g ) {
+
+  # Notice how we look for strings WITH the proper ending. This is
+  # because the java sometimes has really strange double quoting
+  # conventions.  Look at how splitting out the strings in this
+  # fragment would get you the wrong text.
+
+  #      <img src="`c.getImage("bhunterlogo.gif")`" width=217 >
+
+  while ( m{\"([^\"]+$DEPS_PAT)\"}g ) {
     my $string = $1;
     chomp $string;
-    if ( ( $string !~ m!http://! ) &&
-	 ( $string =~ m!$DEPS_PAT! ) ) {
+    if ( $string !~ m!http://! ) {
       $string = basename($string);
       $string =~ s!\s+!!g;
       $seen{"http(${string})"} = 1;
@@ -119,7 +158,7 @@ sub process_file {
     
   }
 
-  close(FILE, "<$file")||
+  close(FILE)||
     die("$0: Could not close file: '$file' : $!\n");
   
   return ;
diff --git a/scripts/perllocate b/scripts/perllocate
new file mode 100755
index 000000000..6cbe0e169
--- /dev/null
+++ b/scripts/perllocate
@@ -0,0 +1,246 @@
+#!/usr/bin/perl
+
+# perllocate - a perl replacement for GNU locate.  This allows perl
+# regular expressions instead of shell globs.
+
+# Written by Ken Estes, Mail.com.
+
+use Getopt::Long;
+
+
+sub usage {
+  
+    my $usage =<<EOF;
+
+$0  [--version]  [--help]
+	[-d path] [--database=path]  pattern...
+
+Arguments
+
+
+--version	Print version information for this program
+
+--help		Show this usage page
+
+-d path
+--database=path
+		Instead of searching the default  file  name  database,
+		search  the  file  name  databases  in path, which is a
+		colon-separated list of database file names.   You  can
+		also  use  the  environment variable LOCATE_PATH to set
+		the list of database files to search.  The option over-
+		rides the environment variable if both are used. If 
+		neither are used the default database file is $DEFAULT_DB.
+
+
+Synopsis
+
+A perl5 based replacement for GNU locate.  The arguments accepted are
+identical but the patterns matched are perl5 instead of the
+traditional locate glob patterns.  This program reads 'LOCATE02'
+databases which were first introduced with locate version 4.0.
+
+For each given pattern, locate searches one or more databases of file
+names and displays the file names that contain the pattern.  Patterns
+that contain metacharacters should be quoted to protect them from
+expansion by the shell.
+
+Patterns are perl5 regular expressions; see perlre(1).  The database
+entries are a stored as a case-insensitive (lowercase) sorted list.
+
+The file name databases contain lists of files that were on the system
+when the databases were last updated.  The system administrator can
+choose the file name of the default database, the frequency with
+which the databases are updated, and the directories for which they
+contain entries; see updatedb(1L).
+
+
+
+Environment
+
+     LOCATE_PATH
+          Colon-separated list of databases to search.
+
+Usage Example
+
+
+$0 --help
+$0 --version
+
+$0 gcc
+$0 perl5
+$0 'rpm$' 'tar$' 'gz$' 'ps$'
+$0 '^\s*' 
+$0 '/RPMS/'
+
+
+EOF
+
+    print $usage;
+    exit 0;
+
+}
+
+
+
+sub set_static_vars {
+
+# This functions sets all the static variables which are often
+# configuration parameters.  Since it only sets variables to static
+# quantites it can not fail at run time. Some of these variables are
+# adjusted by parse_args() but asside from that none of these
+# variables are ever written to. All global variables are defined here
+# so we have a list of them and a comment of what they are for.
+  
+  $DB_FILE_MAGIC = "\0LOCATE02\0";
+  
+  $DEFAULT_DB = '/usr/local/var/locatedb';
+
+  $VERSION = (qw$Revision: 1.1 $)[1];
+  
+  # set a known path.
+ 
+  $ENV{'PATH'}= (
+		 '/opt/gnu/bin'.
+		 ':/usr/local/bin'.
+		 ':/usr/bin'.
+		 ':/bin'.
+		 '');
+  
+  # taint perl requires we clean up these bad environmental variables.
+  
+  delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+  
+  return ;
+}
+
+
+sub parse_args{
+
+  if( !GetOptions("version", "help", "d=s", "database=s",) ) {
+    print("Illegal options in \@ARGV: '@ARGV'\n");
+    usage() ;
+    exit 1 ;
+  }
+  
+  if($opt_version) {
+    print "$0: Version: $VERSION\n";
+    exit 0;  
+  }
+  
+  if ($opt_help) {
+    usage();
+  }
+  
+  ($#ARGV == -1) &&
+    die("Must supply a pattern argument.\n");
+
+  $DB_PATH = ( $opt_database ||
+	       $opt_d ||
+	       ENV{'LOCATE_PATH'} ||
+	       $DEFAULT_DB );
+
+  return ;
+}
+
+
+# read the locatedb file into memory
+
+sub read_database {
+  my ($filename) = @_;
+
+  # read whole file into memory
+  {
+    open (DBFILE, "<$filename")||
+      die("$0: Could not open: $filename for reading. $!\n");
+
+    # not needed on unix but lets be very clear
+    binmode (DBFILE);
+
+    # slurp whole file
+    my $old_irs = $/;
+    undef $/;
+
+    $FILE = <DBFILE>;
+    
+    $/ = $old_irs;
+
+    close(DBFILE)||
+      die("$0: Could not close: $filename. $!\n");
+    
+    $FILE =~ m/^$DB_FILE_MAGIC/ ||
+      die("$0: file: $filename is not an GNU locatedb file. ".
+	  "No magic number found.\n");
+  }  
+  return ;
+}
+
+
+sub parse_database {
+  my ($pattern) = @_;
+
+  my $file_size = length($FILE);
+  my $position = length($DB_FILE_MAGIC);
+
+  my ( $new_prefix_size, $new_filename, 
+       $old_prefix_size, $old_filename, ) = ();
+
+  while ($position < $file_size) {
+    my ($offset, $suffix) = ();
+
+    # read offset
+
+    ($offset) = unpack("c", substr($FILE, $position, 1));
+    $position++;
+    if ($offest == 0x80) {
+
+      # offset is too large to store in one byte, the data we want is
+      # in the next two bytes.
+
+      ($offset) = unpack("n", substr($FILE, $position, 2));
+      $position += 2;
+    }
+
+    # read suffix
+
+    {
+      my $null_position = index ($FILE, "\0", $position);
+      my $length = $null_position - $position;
+      $suffix = substr($FILE, $position, $length);
+      $position += $length + 1;
+    }
+    
+    # new values depend on old values and the contents of the database.
+    
+    $new_prefix_size = $offset + $old_prefix_size;
+    
+    $new_filename = substr($old_filename, 0, $new_prefix_size)
+		      .$suffix;
+    
+    if ( $new_filename =~ m/$pattern/ ) {
+      print "$new_filename\n";
+    }
+
+    $old_prefix_size = $new_prefix_size;
+    $old_filename = $new_filename;
+  }
+
+  return ;
+}
+
+
+# -------------- main --------------
+{
+
+  set_static_vars();
+  parse_args();
+
+  foreach $file ( split(/:/, $DB_PATH) ) {
+    read_database($file);
+    my $pattern = '('.join(')|(', @ARGV).')';
+    parse_database($pattern);
+  }
+  
+  exit 0;
+}
+
diff --git a/scripts/perllocate.cgi b/scripts/perllocate.cgi
new file mode 100755
index 000000000..cabc0a844
--- /dev/null
+++ b/scripts/perllocate.cgi
@@ -0,0 +1,287 @@
+#!/usr/bin/perl
+
+# perllocate.cgi - a web interface to a perl version of the Unix
+# locate command.  This script makes it easy to query the RPM
+# repository and find out what packages are availible using Perl5
+# Patterns.
+
+# written by Ken Estes kestes@staff.mail.com
+
+use CGI ':standard';
+use File::Basename;
+use File::stat;
+
+
+
+sub usage {
+
+  # If they are asking for help then they are clueless so reset all
+  # their parameters for them, in case they are in a bad state.
+
+  param(-name=>'Defaults', -value=>'on');
+  my $rpmdiff_version = `perllocate --version`;
+
+  $usage =<<EOF;
+
+  $0          version: $VERSION
+  $perllocate_version
+
+This is a web interface into the perllocate command.
+
+
+EOF
+    print pre($usage);
+
+  return ;
+}
+
+
+sub set_static_vars {
+
+# This functions sets all the static variables which are often
+# configuration parameters.  Since it only sets variables to static
+# quantites it can not fail at run time. Some of these variables are
+# adjusted by parse_args() but asside from that none of these
+# variables are ever written to. All global variables are defined here
+# so we have a list of them and a comment of what they are for.
+
+
+  $VERSION = ( qw$Revision: 1.1 $ )[1];
+  
+  @ORIG_ARGV = @ARGV;
+  
+  $LOCATEDB = '/net/master-mm/export/rpms/redhat/rpmarchive.locatedb';
+
+  # a pattern which matches something inside the rpm archive mount point.
+
+  $MOUNT_DIR_PATTERN = '/redhat/';
+
+  # a pattern to limit the files which are displayed.
+
+  $FILES_TO_DISPLAY_PATTERN = '/RPMS/';
+
+
+  # set a known path.
+  
+  # the correct path has not been finalized yet, but this is close.
+  
+  $ENV{'PATH'}= (
+		 '/usr/local/bin'.
+		 ':/usr/bin'.
+		 ':/bin'.
+		 ':/usr/apache/cgibins/cgi-forms'.
+		 '');
+  
+  # taint perl requires we clean up these bad environmental
+  # variables.
+  
+  delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+  
+  return 1;
+} #set_static_vars
+
+
+
+
+sub get_env {
+
+# this function sets variables similar to set_static variables.  This
+# function may fail only if the OS is in a very strange state.  after
+# we leave this function we should be all set up to give good error
+# handling, should things fail.
+
+  umask 0022; 
+  $| = 1; 
+  $PID = $$; 
+  $PROGRAM = basename($0); 
+  $TIME = time();
+  $LOCALTIME = localtime($main::TIME); 
+  $START_TIME = $TIME;
+
+  { 
+
+    # We show the results as if they were located in the same
+    # directory as the locatedb appears to the cgi script.  The
+    # directory is exported from the repository machine in a slightly
+    # different place so that all its outputs would look wrong if we
+    # displayed it raw.  This hack is what $DISPLAY_PREFIX is used
+    # for, we try and compute it automatically.
+
+    $LOCATEDB =~ m!$MOUNT_DIR_PATTERN! || 
+      die("db file: $LOCATEDB must be located in a '$MOUNT_DIR_PATTERN' directory");
+    
+    $DISPLAY_PREFIX = $LOCATEDB;
+    $DISPLAY_PREFIX =~ s!$MOUNT_DIR_PATTERN(.*)!$MOUNT_DIR_PATTERN!;
+    
+    (-r $LOCATEDB) || 
+      die("The file: $LOCATEDB, must exists and be readable.");
+
+    my ($mtime) = stat($LOCATEDB)->mtime;
+    
+    $DB_UPDATE_TIME = localtime($mtime);
+  }
+
+  return 1;
+} # get_env
+
+
+# fatal errors need to be valid HTML
+
+sub fatal_error {
+  my  @error = @_;
+
+  print header;
+
+  foreach $_ (@error) {
+    print  $_;
+  }
+
+  print end_html;
+  print "\n\n\n";
+
+  die("\n");
+}
+
+
+
+
+sub print_query_page {
+
+  my @out;
+
+  push @out, start_form;  
+
+  push @out, (
+              "This page allows you to search for all packages ".
+	      "in the RPM repository which match a particular pattern.",
+	      p(),
+	     );
+
+  push @out, (
+	      
+              h3("Pattern",),
+              "Enter a valid Perl5 Pattern: ",
+              textfield(-name=>'pattern',
+                        -size=>30,),
+              p(),
+             );
+  
+  
+  push @out, (
+	      defaults(-name=>'Defaults'),
+	      submit(-name=>'Submit'),
+	      p(),
+	     );
+
+
+  push @out, (
+	      "Locate database created at: $DB_UPDATE_TIME\n",
+	      p(),
+	      "The time is now: $LOCALTIME\n",
+	      p(),
+	     );
+
+  push @out, ( 
+	      end_form(),
+	     );
+
+  print @out;
+
+  return ;
+}
+
+
+
+# given a pattern remove any "tainted" characters.
+
+sub clean_pattern {
+  my ($data) = @_;
+  my $out = '(none)';
+
+  # we do not allow single quotes in the pattern because of the way we
+  # invoke perllocate.  If we allowed \' then users could introduce
+  # strings like "'; rm -rf /' echo 'done".  Unfortunatly we can not
+  # be too strict about other characters because most characters are
+  # needed to specify regular expressions.
+
+  $data =~ s/\'//g;
+
+  if ( $data =~ m/(.*)/ ) {
+    $out = $1;
+  }
+  return $out;
+}
+
+
+
+# show the results of running perllocate on the chosen pattern.
+
+sub print_perllocate {
+  my($pattern, @args) = @_;
+
+  $pattern =~ s/\'/\\\'/g;
+
+  my $cmd = ( 
+	     "perllocate -d $LOCATEDB '$pattern' 2>&1 ".
+	     " | sed -e 's!.*$MOUNT_DIR_PATTERN!$DISPLAY_PREFIX!' ".
+	     " | grep '$FILES_TO_DISPLAY_PATTERN' ".
+	    "");
+
+  print $cmd, p();
+
+  my $result = "\n".qx{$cmd}."\n";
+
+  print pre($result);
+
+  return ;
+}
+
+
+#       Main        
+{
+
+  set_static_vars();
+  get_env();
+
+  my ($pattern) = clean_pattern(param("pattern"));
+
+  my (@perllocate_args) = param("perllocate arguments");
+  @perllocate_args = split(/\s+/, 
+			   '--'.(join(" --", @perllocate_args)));
+  push @perllocate_args, '--';
+ 
+  
+  print (
+	 header(),
+	 start_html(-title=>"perllocate"),
+	 h2({-align=>'CENTER'},"perllocate"),
+	 p(),
+	);
+
+
+  if (param("Help Screen")) {
+
+    usage();
+
+  } elsif ( grep {/^(\-\-)((help)|(version))$/} @perllocate_args ) {
+       
+    print_perllocate(@perllocate_args);
+
+  } else {
+ 
+    print_query_page();
+
+      ($pattern) &&
+	print_perllocate($pattern);
+
+  }
+
+  print (
+	 end_html(),
+	 "\n\n\n",
+	);
+
+
+  exit 0;
+}
+
diff --git a/scripts/print_deps b/scripts/print_deps
new file mode 100755
index 000000000..9e7689718
--- /dev/null
+++ b/scripts/print_deps
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+# a glue program for print out dependencies based on filenames
+# by Ken Estes kestes@staff.mail.com
+
+use File::Basename;
+use Getopt::Long;
+
+
+GetOptions (	
+	    qw( identifier=s basename! )
+	      );
+	    
+
+if ("@ARGV") {
+  foreach (@ARGV) {
+    process_file($_);
+  }
+} else {
+
+  # notice we are passed a list of filenames NOT as common in unix the
+  # contents of the file.
+
+  foreach (<>) {
+    process_file($_);
+  }
+}
+
+sub process_file {
+  my ($str) = @_;
+  chomp $str;
+
+  if ($opt_basename) {
+    $str = basename($str);
+  }
+
+  if ($opt_identifier) {
+    print "${opt_identifier}(${str})\n";
+  } else {
+    print "$str\n";
+  }
+
+  return ;
+}
+
diff --git a/scripts/rpm_fulldb_update b/scripts/rpm_fulldb_update
new file mode 100644
index 000000000..55886abd9
--- /dev/null
+++ b/scripts/rpm_fulldb_update
@@ -0,0 +1,386 @@
+#!/usr/bin/perl
+
+# A perl script to be run from cron which creates an rpm database of
+# all your binary RPMS.  This database contains the most recent
+# version of every branch of each package found in the package
+# repositories.  The database is useful for querying since it is as if
+# you have installed all these packages into your system.  You can
+# find which packages hold a file or which packages satify a
+# dependency.  We are only load the information from the packages and
+# do not save the contents of the packages into the file system.
+
+# Branch is a Version Control concept and is coded into the packages
+# rpm version by convention.  We build the same packages for many
+# different projects.  Each project works on its own branch and may
+# have different source code for the same rpm.  The branch name is
+# encouded in the version number of the package followed by a '.'.
+# The full database needs to have the most recent copy of each package
+# on each branch. For example rpm package version "3.43" would be the
+# "43" release of the branch "3" and rpm package version "potato.91"
+# would be the "91" release of the "potato" branch.
+
+# written by Ken Estes kestes@staff.mail.com
+
+
+use File::Basename;
+use File::stat;
+
+
+
+# An rpm_package is a hash of:
+#     $package{'fqn'}="perl-5.00502-3"
+#     $package{'rpm_file'}="$RPMS_DIR/".
+#                "./sparc/perl-5.00502-3.solaris2.6-sparc.rpm"
+#     $package{'srpm_file'}="$SRPMS_DIR/".
+#                           "./perl-5.00502-3.src.rpm"
+#     $package{'name'}="perl"
+#     $package{'version'}="5.00502"
+#     $package{'release'}="3"
+
+# fqn is "fully qualified name"
+
+# the packages are stored in the datastructure
+#	$BY_NAME{$name}{$branch}{$version}{$release};
+
+
+
+sub set_static_vars {
+
+# This functions sets all the static variables which are often
+# configuration parameters.  Since it only sets variables to static
+# quantites it can not fail at run time. Some of these variables are
+# adjusted by parse_args() but asside from that none of these
+# variables are ever written to. All global variables are defined here
+# so we have a list of them and a comment of what they are for.
+
+  $VERSION = ( qw$Revision: 1.1 $ )[1]; 
+
+  @ORIG_ARGV = @ARGV;
+
+  # The pattern for parsing fqn into ($name, $version, $release).
+  # This is difficult to parse since some hyphens are significant and
+  # others are not, some packages have alphabetic characters in the
+  # version number.
+
+  $PACKAGE_PAT ='(.*)-([^-]+)-([^-]+).solaris2.6-\w*.rpm';
+
+  # packages which will end up in the database match this pattern
+  # currently we are not retricting the packages which go into the
+  # database.
+
+  $PICKLIST_PAT = '.';
+
+  # the list of  directories where rpms are stored
+  @RPM_ARCHIVES = ('/export/rpms/redhat',);
+
+  # the full path name of the database we are creating.
+
+  $RPM_DB_DIR = "/export/rpms/redhat/repository.rpmdb";
+
+  # set a known path.
+  
+  # the correct path has not been finalized yet, but this is close.
+  
+  $ENV{'PATH'}= (
+		 '/usr/local/bin'.
+		 ':/usr/bin'.
+		 ':/bin'.
+		 '');
+  
+  # taint perl requires we clean up these bad environmental
+  # variables.
+  
+  delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+  
+  return 1;
+} #set_static_vars
+
+
+
+
+sub get_env {
+
+# this function sets variables similar to set_static variables.  This
+# function may fail only if the OS is in a very strange state.  after
+# we leave this function we should be all set up to give good error
+# handling, should things fail.
+
+  $| = 1; 
+  $PID = $$; 
+  $PROGRAM = basename($0); 
+  $TIME = time();
+  $LOCALTIME = localtime($main::TIME); 
+  $START_TIME = $TIME;
+
+  {
+    my ($sec,$min,$hour,$mday,$mon,
+	$year,$wday,$yday,$isdst) =
+	  localtime(time());
+    
+    # convert confusing perl time vars to what users expect
+    
+    $year += 1900;
+    $mon++;
+    
+    $DATE_STR = sprintf("%02u%02u%02u", $year, $mon, $mday, );
+    $TIME_STR = sprintf("%02u%02u", $hour, $min);
+  }
+  # a unique id for cache file generation
+  $UID = "$DATE_STR.$TIME_STR.$PID";
+
+  return 1;
+} # get_env
+
+
+
+sub parse_fqn {
+
+  # This is difficult to parse since some hyphens are significant and
+  # others are not, some packages have alphabetic characters in the
+  # version number. 
+
+  # Also remember that the format of the file is dependent on how RPM
+  # is configured so this may not be portable to all RPM users.
+
+  (!("@_" =~ m/^$PACKAGE_PAT$/)) &&
+    die("rpm_package_name: '@_' is not in a valid format");
+  
+  return ($1, $2, $3);
+}
+
+
+sub new_rpm_package {
+
+# An rpm_package is a hash of:
+#     $package{'fqn'}="perl-5.00502-3"
+#     $package{'rpm_file'}="$RPMS_DIR/".
+#                "./sparc/perl-5.00502-3.solaris2.6-sparc.rpm"
+#     $package{'srpm_file'}="$SRPMS_DIR/".
+#                           "./perl-5.00502-3.src.rpm"
+#     $package{'name'}="perl"
+#     $package{'version'}="5.00502"
+#     $package{'release'}="3"
+
+  my ($rpm_file) = @_;
+  my $error = '';  
+  my($name, $version, $release) = main::parse_fqn(basename($rpm_file));
+
+  my ($package) = ();
+  
+  $package->{'fqn'}="$name-$version-$release";
+  $package->{'name'}=$name;
+  $package->{'version'}=$version;
+  $package->{'release'}=$release;
+  $package->{'rpm_file'}=$rpm_file;
+
+  # these are needed to do proper sorting of major/minor numbers in
+  # the version of the package
+
+  $package->{'version_cmp'}=[split(/\./, $version)];
+  $package->{'release_cmp'}=[split(/\./, $release)]; 
+
+  # our packages have a naming convention where then branch name is
+  # the first part of the version.
+
+  $package->{'branch'}= @{ $package->{'version_cmp'} }[0];
+
+  return $package;
+}
+
+
+# return the most recent version of package for a given package name/branch pair
+
+sub get_latest_fqn {
+  my ($name, $branch) =(@_);
+
+  my @out = ();
+
+  foreach $version ( keys %{ $BY_NAME{$name}{$branch} }) {
+    foreach $release ( keys %{ $BY_NAME{$name}{$branch}{$version} }) {
+
+      push @out, $BY_NAME{$name}{$branch}{$version}{$release};
+
+    }
+  }
+
+  # the $BY_NAME datastructure is fairly good but the list can not be
+  # sorted right. Sort again using the Schwartzian Transform as
+  # discribed in perlfaq4
+
+  my @sorted = sort {
+
+    # compare the versions but make no assumptions
+    # about how many elements there are
+    
+    my $i=0;
+    my @a_version = @{ $a->{'version_cmp'} }; 
+    my @b_version = @{ $b->{'version_cmp'} };
+    while ( 
+	   ($#a_version > $i) && 
+	   ($#b_version > $i) && 
+	   ($a_version[$i] == $b_version[$i]) 
+	  ) {
+      $i++;
+    }
+    
+    my $j = 0;
+    my @a_release = @{ $a->{'release_cmp'} }; 
+    my @b_release = @{ $b->{'release_cmp'} };
+    while ( 
+	   ($#a_release > $j) && 
+	   ($#b_release > $j) &&
+	   ($a_release[$j] == $b_release[$j])
+	  ) {
+      $j++;
+    }
+    
+    return (
+	    ($b_version[$i] <=> $a_version[$i])
+	    ||
+	    ($b_release[$j] <=> $a_release[$j])
+	   );
+  }
+  @out;
+
+  return @sorted[0];
+}
+
+
+# traverse the package repositories and create a data structure of all
+# the packages we find.
+
+sub parse_package_names {
+  my $db_dir = basename($RPM_DB_DIR);
+  foreach $archive (@RPM_ARCHIVES) {
+    
+    open(FILES, "-|") || 
+      exec("find", $archive, "-print") ||
+	die("Could not run find. $!\n");
+
+    while ($filename = <FILES>) { 
+
+      # we want only the binary rpm files of interest
+
+      ($filename =~ m/\.rpm$/) || next;
+      ($filename =~ m/\.src\.rpm$/) && next;
+      ($filename =~ m/$PICKLIST_PAT/) || next;
+
+      # do not mistake database files for packages
+
+      ($filename =~ m!/$db_dir/!) && next;
+
+      chomp $filename;
+
+      $pkg = new_rpm_package($filename);
+      $BY_NAME{$pkg->{'name'}}{$pkg->{'branch'}}{$pkg->{'version'}}{$pkg->{'release'}} = $pkg;
+
+    }
+
+    close(FILES) || 
+      die("Could not close find. $!\n");
+    
+  }
+
+  return %BY_NAME;
+}
+
+
+
+# traverse the data structure of all the packages and load the most
+# recent version from each branch into the database.  We are only
+# loading the information from the package not saving the files into
+# the file system.
+
+sub create_new_db {
+
+
+  my $uid = $<;
+  
+  # eventually there will be a builder id who will run this code but
+  # for now.
+  
+  ($uid == 0 ) && 
+    die("Must not run this program as root\n");
+  
+  # set up to load the database
+
+  {
+
+    my $tmp_db = "$RPM_DB_DIR.$UID";
+    
+    system("mkdir", "-p", $tmp_db, );
+    ($?) && 
+      die("$0: System error: $! \n");
+    
+    system("rpm", "--initdb",
+	   "--dbpath", $tmp_db, );
+    ($?) && 
+      die("$0: System error: $! \n");
+    
+    open(README, ">$tmp_db/README") ||
+      die("Could not open $tmp_db/README. $! \n");
+    print README <<EOF;
+#
+# This directory is updated daily by a cron job. 
+# program: $0
+# version: $VERSION
+# updated ran at: $LOCALTIME
+
+# This directory contains an rpm database which has been loaded with
+# the most recent version of every package in our archive.  It is
+# intended to be used for queries to find packages. Example:
+
+# rpm --dbpath /net/master-mm/export/rpms/redhat/rpmfulldb 
+#	-q --whatprovides 'java(com.iname.site.context.LoginContext)'
+
+
+# rpm --dbpath /net/master-mm/export/rpms/redhat/rpmfulldb 
+# 	-qf /usr/local/bin/rpmdiff
+
+
+EOF
+    close(README) ||
+      die("Could not close $tmp_db/README. $! \n");
+  }
+
+  # load the database with the packages we want.
+
+  foreach $pkg_name (keys %BY_NAME) {
+    foreach $branch (keys %{ $BY_NAME{$pkg_name} }) {
+      $pkg_file = get_latest_fqn($pkg_name, $branch)->{'rpm_file'};
+
+      system("rpm", "-i", "--nodeps", "--noscripts", "--justdb", 
+	     "--dbpath", $tmp_db, 
+	     $pkg_file);
+      ($?) && 
+	die("$0: System error: $! \n");
+    }
+  }
+
+  # do the update as close to atomically as is practicale.
+
+  system("rm", "-rf", $RPM_DB_DIR,);
+  ($?) && 
+    die("$0: System error: $! \n");
+  
+  rename($tmp_db, $RPM_DB_DIR,) || 
+    die("Could not rename file: $tmp_db => $RPM_DB_DIR. $! \n");
+
+  return ;
+}
+
+
+
+
+
+#       Main        
+{
+  set_static_vars();
+  get_env();
+
+  my %by_name=parse_package_names();
+  create_new_db(%by_name);
+
+  exit 0;
+}
+
diff --git a/scripts/rpmsync b/scripts/rpmsync
new file mode 100644
index 000000000..63902c94f
--- /dev/null
+++ b/scripts/rpmsync
@@ -0,0 +1,1625 @@
+#!/usr/bin/perl
+
+
+# rpmsync - written by Ken Estes kestes@staff.mail.com
+
+# $Revision: 1.1 $
+# $Date: 2001/03/15 13:58:16 $
+# $Author: jbj $
+# $Source: /home/boston/jkeating/rpmcvs/cvs/devel/rpm/scripts/rpmsync,v $
+# $Name:  $
+
+use Fcntl;
+use File::Basename;
+use Getopt::Long;
+use IO::Socket;
+use IPC::Open3;
+use POSIX;
+use Symbol;
+use Sys::Hostname;
+use Sys::Syslog;
+
+
+# An rpm_package is a hash of:
+#     $package{'fqn'}="perl-5.00502-3"
+#     $package{'rpm_file'}="$RPMS_DIR/".
+#                "./sparc/perl-5.00502-3.solaris2.6-sparc.rpm"
+#     $package{'srpm_file'}="$SRPMS_DIR/".
+#                           "./perl-5.00502-3.src.rpm"
+#     $package{'name'}="perl"
+#     $package{'version'}="5.00502"
+#     $package{'release'}="3"
+
+# fqn is "fully qualified name"
+
+# The state of the system is a orderd list (topologically sorted by
+# dependendencies) of fqn's. The list may contain additional RPM flags
+# to be used on a particular list entry.
+
+# we are going to compare two states the actual state of the machine
+# %INSTALLED_BY_NAME this is indexed by package names and gives a list
+# of rpm_package objects which are installed currently on the machine.
+# Each entry is a list of the packages with the given name which are
+# installed.
+
+# The keys of the hash %LISTED_BY_FQN are the fqn's which are listed
+# in the manifest package list.
+
+
+# Here are a bunch of interesting RPM error messages:
+# rpm: --oldpackage may only be used during upgrades 
+
+sub usage {
+my $usage = <<"EOF";
+Usage:
+	$PROGRAM --update | --force |--force_and_verify | --rollback | --test
+		[--log_file file] [--manifest_file file]
+		[--script_file file]
+		[--skip_check] [--verbose] [--silent] 
+		[--help] [--version]
+
+
+Required Aguments:
+
+
+--test		test what an update would change.  Compare the installed 
+		packges with the packages listed in the manifest file.  
+		This option will show what commands would be executed if 
+		we were to run an update without actually changing anything.
+		When an --update finishes it automatically runs --test 
+		and exits with error if there is any work not
+		completed.  This command has nothing to do with the 
+		'--verify' (-V) option to rpm.
+
+--update	Update the packages installed on the system with the newer 
+		versions listed in the manifest file.  This will not reinstall
+		packages which are listed and already installed but are 
+		corrupted or were installed with the wrong set of arguments.  
+		It will erase packages which are installed on the system but 
+		not listed in the package list.  All packages must have a 
+		later version number then the previous packages.
+
+--rollback	Rollback a previously installed update.  This command 
+		requires that the pervious manfest file be reinstalled.  All 
+		update commands are run in the reverse order from the --update,
+		this ensures that the packages are undone exactly as they were
+		installed.
+
+--force		Ensure that the packages installed on the machine are 
+		exactly those packages listed in the manifest file and that no
+		installed files are currpted.  First each package in the 
+		manifest file is installed using --force (even if it is already
+		installed) then each package which is installed but not listed
+		in the manifest list is removed from the machine.
+
+--force_and_verify  This command behaves as if you ran this program first with
+		     --force then ran rpm -Va.  The program will exit with 
+		     error if either of these steps fail.  This allows you to 
+		     perform unsafe operations (changing the name of a package
+		     in a manifest list via a force) in a relatively safe 
+		     manner.
+
+
+Optional Aguments:
+
+
+--rpm_args	Specify additional arguments to pass to rpm for all package
+		operations.  This option is used by both the update and erase
+		commands.  This option can appear more then once on the
+		command line and the concatination of all options will be sent
+		to rpm.  This option should not be need somtimes it is useful,
+		in an emergency, to install packges with broken dependencies
+		or packages with duplicate files.  This is a quick way of 
+		getting the --nodeps and --force and any other needed 
+		arguments to rpm. 
+
+--log_file	specify a log file different from the default:
+			 $LOG_FILE
+
+--manifest_file	specify a manifest file different from the default:
+			 $MANIFEST_FILE
+
+--skip_check	turn off internal sanity checks used by this script.  This
+		is not related to the --check option or to rpm -V.
+
+--script_file   do not run any commands on this machine instead create a 
+		shell file which can be used to install all the packages 
+		in the manifest.  This script is useful during machine 
+		creation.  To use this option you must specify 
+		--update or --force.
+
+--verbose	provide verbose output, only useful for debugging 
+		this program.
+
+--silent	Do not send any output to stdout/stderr messages will 
+		still go to $LOG_FILE or syslog
+
+--help		show this usage page.
+
+--version	print the version number of this program.
+
+
+This program is used to ensure that the RPM packages installed on a
+system match the list of packages in a manifest.  The package list
+looks like the output of 'rpm -qa' but is required to be in a
+tolological order.  If special flags are needed for particular
+packages (like --nodeps or --force or --oldpackage or --noscriopts or
+--root <dir> or --relocate oldpath=newpath or --rcfile <file>) they
+can be added on the line after package name with a space separating
+the two.  Shell style comments (starting with \# and lasting till the
+next \\n) are legal in the package list.  The default package list
+file is $MANIFEST_FILE.
+
+It is expected that most updates will use the --update command with
+--force saved for those rare situations where the machine is known to
+be in a very bad state or there are installed packages which are
+currupted.
+
+
+
+Examples:
+
+
+rpmsync --help
+rpmsync --version
+rpmsync --update
+rpmsync --force
+rpmsync --test
+
+rpmsync --force --rpm_args nodeps
+
+rpmsync --update --rpm_args nodeps  --rpm_args noscripts \\
+	--skip_check --verbose
+
+rpmsync --update --script_file /tmp/rpmpkg.bootstrap.sh
+
+EOF
+
+print $usage;
+exit 0;
+}
+
+
+
+
+
+sub new_rpm_package {
+
+# An rpm_package is a hash of:
+#     $package{'fqn'}="perl-5.00502-3"
+#     $package{'rpm_file'}="$RPMS_DIR/".
+#                "./sparc/perl-5.00502-3.solaris2.6-sparc.rpm"
+#     $package{'srpm_file'}="$SRPMS_DIR/".
+#                           "./perl-5.00502-3.src.rpm"
+#     $package{'name'}="perl"
+#     $package{'version'}="5.00502"
+#     $package{'release'}="3"
+
+  my ($fqn, $error_context) = @_;
+  my $error = '';  
+  my($name, $version, $release) = main::parse_fqn($fqn, $error_context);
+
+  my ($rpm_file, $install_script_file) = 
+    main::which_binary_package_path($name, $version, $release);
+  ($rpm_file) ||
+    ($error .= "Could not find binary file for package: '$fqn'\n");
+  
+#  my ($srpm_file) = main::which_source_package_path($name, $version, $release);
+#  ($srpm_file) || 
+#    ($error .= "Could not find source file for package: '$fqn'\n");
+  
+  if ($error) {
+    if (!$SKIP_CHECK) {
+      die($error);
+    } else {
+      warn($error);
+    }
+  }
+
+  my ($package) = ();
+  
+  $package->{'fqn'}=$fqn;
+  $package->{'name'}=$name;
+  $package->{'version'}=$version;
+  $package->{'release'}=$release;
+  $package->{'rpm_file'}=$rpm_file;
+  $package->{'install_script_file'}=$install_script_file;
+  $package->{'srpm_file'}=$srpm_file;
+  
+  return bless($package, $class);
+}
+
+
+sub is_installed {
+
+# returns true iff the package passed in is in fact installed on the
+# machine.
+
+  my ($required_pkg) = @_;
+  my $installed_pkgs = $INSTALLED_BY_NAME{$required_pkg->{'name'}};
+  # look for the right version/release of this package
+  foreach $installed_pkg ( @{ $installed_pkgs } ) {
+    ($installed_pkg->{'fqn'} eq $required_pkg->{'fqn'}) && 
+      return 1;
+  }
+  
+  return 0;
+}
+
+
+
+sub clean_up {
+
+# any cleanup actions to be performed on exit should go here
+
+  closelog();
+  close(STDERR);
+  close(STDOUT);
+
+  return 1;
+} # clean_up
+
+
+
+sub fatal_error {
+  my  @error = @_;
+
+  foreach $_ (split("\n",join('',@error))) {
+    (!$SILENT) && print STDERR ("$PROGRAM (fatal): $_\n");
+    print LOG ("[$LOCALTIME] (fatal): $_\n");
+  }
+  syslog('crit', "fatal error at: ".localtime(time()));
+  clean_up();
+  die("[$LOCALTIME] $PROGRAM: fatal error at: ".localtime(time()) );
+}
+
+
+sub log_error {
+  my  @error = @_;
+
+  foreach $_ (split("\n",join('',@error))) {
+    (!$SILENT) && print STDERR ("$PROGRAM (warn): $_\n");
+    print LOG ("[$LOCALTIME] (warn): $_\n");
+  }
+
+}
+
+
+sub info_error {
+  my  @error = @_;
+
+  foreach $_ (split("\n",join('',@error))) {
+    (!$SILENT) && print STDERR ("$PROGRAM (info): $_\n");
+    print LOG ("[$LOCALTIME] (info): $_\n");
+  }
+
+}
+
+
+sub which_binary_package_path {
+
+# this line will depend on the 'rpmfilename: ' in the rpmrc file in
+# the future we will need to try 'noos' as well as noarch, it is not
+# implemented in our RPM version.
+
+  my ($name, $version, $release) = @_;
+  
+  foreach $dir ( split(':', $SEARCH_PATH) ) {
+    foreach $arch ($ARCH, 'noarch', '') {
+      foreach $os ($OS, 'noos', '') {
+	
+    my $filename = '';
+    my $install_script_filename = '';
+    
+    $filename = eval "return \"$BINARY_PACKAGE_FILE_PAT\";";
+    $install_script_filename = $filename;
+    $install_script_filename =~ s/^$dir/\$REPOSITORY/;
+    ( -f $filename ) && ( -s $filename ) && ( -r $filename ) 
+      && return ($filename, $install_script_filename);    
+    ;
+  }
+    }
+  } 
+  return ;
+}
+
+
+sub which_source_package_path {
+
+# Each binary rpm package encodes the name of the source file which it
+# came from.  This is important since some sources generate several
+# binary packages (emacs, vim, perl), given one of those packages it
+# would be hard to find the source file name just doing regular
+# expressions on the name.  We extract this information using an rpm
+# query.
+
+  my ($name, $version, $release) = @_;
+  
+  $binary_package_file =  (which_binary_package_path(@_))[0];
+
+  $binary_package_file || return ;
+
+  # this command would be better
+  # rpm -qp --queryformat '[%{SOURCERPM}\n]' 
+
+  my ($wait_status, $log_out, $log_err) = 
+    system3('cmd_vec' => [$SYS_CMDS{'rpm'}, '-qip', $binary_package_file],);
+
+  my ($source_rpm_file) = grep (/Source RPM: /, split(/\n+/, $log_out ));
+  
+  ( $source_rpm_file =~ m/Source RPM:\s([-.\w]+)/ ) ||
+    return ;
+  
+  $source_rpm_file = $1;
+
+  foreach $dir ( split(':', $SEARCH_PATH) ) {
+    my $filename = '';
+    
+    $filename = eval "return \"$SOURCE_PACKAGE_FILE_PAT\";";
+    ( -f $filename ) && ( -s $filename ) && ( -r $filename ) 
+      && return $filename;    
+  }
+  
+  return ;
+}
+
+
+sub parse_fqn {
+
+  # This is difficult to parse since some hyphens are significant and
+  # others are not, some packages have alphabetic characters in the
+  # version number. 
+
+  # Also remember that the format of the file is dependent on how RPM
+  # is configured so this may not be portable to all RPM users.
+  my ($fqn, $error_context) = @_;
+
+  (!("$fqn" =~ m/^$PACKAGE_PAT$/)) &&
+    die("package name '$fqn' is not in a valid format, $error_context");
+  
+  return ($1, $2, $3);
+}
+
+
+
+sub system3 {
+
+# Lanuch a new child and wait for it to die.  This is like a call to
+# system but we get the stdout and stderr in addition to $?.
+
+# call the function like this 
+
+# my  ($wait_status, $log_out, $log_err) = 
+# open3(
+#     'cmd_vec' => [],
+#     'stdin_str' => '',
+#     'log_cmds'=> '';
+#     'ingore_error' => ''
+#      );
+
+# cmd_vec is a command to run in execv format.  It is a list not a
+# string since we want the safe version of exec
+
+# stdin_str is a string to pass on the standard in to the child program.
+
+# If log_cmds is set then the command will be sent to syslog and the
+# log file.  All output from the command is also sent to the log file.
+
+# open3 signals all errors through a die so will I.  If the command
+# exits with nonzero wait_status then system3 calls die.  This feature
+# can be turned of fby setting ignore_errors.
+
+# the system3 function returns:
+
+# wait_status: the wait_status of the child process
+
+# log_out: the stdout that the child process wrote.
+
+# log_err: the stderr the child process wrote.
+
+  my (%args) = @_;
+
+  my ($log_cmds, $ignore_error, $cmd_ref, $stdin) = @_;
+
+#  if ( ! ( (-x $args{'cmd_vec'}->[0]) && (-f $args{'cmd_vec'}->[0]) ) ) {
+#    die ("Command not exectuable: '$args{'cmd_vec'}->[0]',\n");
+#  }      
+  
+  my $info ="executing: '@{ $args{'cmd_vec'} }',\n";
+  
+  if ($args{'log_cmds'} || ($VERBOSE) ) {
+    warn($info);
+  }
+  
+  # start the process
+  
+  my $fh_in  = gensym(); 
+  my $fh_out = gensym(); 
+  my $fh_err = gensym(); 
+
+  ($fh_in && $fh_out && $fh_err) || 
+    die ("Could not create new symbol, 'gensym()' object.\n");
+  
+  my $child_pid = IPC::Open3::open3(
+				    $fh_in,
+				    $fh_out,
+				    $fh_err,
+				    @{$args{'cmd_vec'}}
+				    );
+  
+  # this check should be redundant but better safe then sorry
+  
+  ($child_pid) || 
+      die ("Open3() did not start: '@{$cmd}'. $!\n");
+  
+    if ($args{'stdin_str'}) {
+
+      # we should not have a deadlock with this syswrite since this
+      # process writes and then the child reads.  It is hard to
+      # imagine how this could fail and the machine still be in a
+      # reasonable shape.
+
+      my $write_len = length($args{'stdin_str'})+1;
+      my $rc = syswrite ($fh_in, 
+			 $args{'stdin_str'}."\n", $write_len);
+      
+      (defined ($rc) && ( $rc == $write_len ) ) ||
+	die("Syswrite to child stdin failed. ".
+	    "Could not write: '$write_len' ".
+	    "only wrote: '$rc' characters. ".
+	    "Trying to write to stdin: '$stdin'. ".
+	    ": $!\n");
+    }
+
+
+  close($fh_in) || 
+    die("Could not close child stdin: $!\n");
+  
+  main::nonblock($fh_out);
+  main::nonblock($fh_err);
+  
+  my $log_out = undef;
+  my $log_err = undef; 
+
+  my $reaped_pid = -1;
+  my $wait_status = 0;
+
+  # wait for child to die, but keep clearing out stdout and stderr
+  # buffers for process so we do not deadlock.  
+
+  # WE seem to be loosing childrens signals occasionally, so actively
+  # check if the child is alive.
+
+  while ($reaped_pid != $child_pid) {    
+
+    sleep(1);
+    
+    $reaped_pid = waitpid(-1, &WNOHANG | POSIX::WUNTRACED);
+    
+    if ($reaped_pid == $child_pid) {
+      
+      ($wait_status = $?);
+      
+      # child signaled but did not exit
+      # set to the same pid as 'no child waiting'
+      
+      (WIFSTOPPED($wait_status)) &&
+	($reaped_pid = -1);
+    }
+    
+    my $data_out = '';
+    my $data_err = '';
+    my $rc = '';
+    
+    # do the reading after reaping so we are sure that we exit the
+    # loop only after draining the sockets.
+    
+    # I do not think we need to log $rc errors as they happen
+    # frequently and nothing seems wrong:
+    #      Resource temporarily unavailable file_handle
+    
+    do {
+      $rc = sysread($fh_out, $data_out, POSIX::BUFSIZ, 0);
+      $log_out .= $data_out;
+    } until ($rc <= 0);
+
+    do {
+      $rc = sysread($fh_err, $data_err, POSIX::BUFSIZ, 0);
+      $log_err .= $data_err;
+    } until ($rc <= 0);
+
+    ($data_err) && warn($data_err);   
+
+  } # while pid
+
+  # the reads are at the bottom of the loop so we do not need to do
+  # any more reading of the filehandles.
+
+  close($fh_out) || 
+      &$log_error("Could not close child stdout: $!\n");    
+  
+  close($fh_err) || 
+      &$log_error("Could not close child stderr: $!\n");
+  
+  my @info = (
+	      "command results: \n",
+	      "  wait_status: $wait_status\n",
+	      "  stdout: '\n",
+	      # turn string into a list and indent each element
+	      (map {"    $_\n"} (split /\n+/, $log_out)),
+	      "  stdout: '\n",
+	      "  stderr: '\n",
+	      # turn string into a list and indent each element
+	      (map {"    $_\n"} (split /\n+/, $log_err)),
+	      "  stderr: '\n",
+	     );
+  
+  if ( (!$args{'ignore_error'}) && ($wait_status) ) {
+    print "\n\n";
+    die("Cmd exited with error:\n",
+	"\t@{$args{'cmd_vec'}}\n",
+	@info);
+  }
+
+  if ( ($VERBOSE) ||
+       ( ($args{'log_cmds'})  &&
+	 ($wait_status || $log_out || $log_err) ) ) {
+    warn(@info);
+  }
+  
+  return ($wait_status, $log_out, $log_err);
+} # system3
+
+
+sub get_rpm_info {
+  my (@rpm_args) = @_;
+
+  update_time();
+  my (@rpm_info) = '';
+
+  my ($wait_status, $log_out, $log_err) = 
+    system3('cmd_vec' => [$SYS_CMDS{'rpm'}, '-qa'],);
+
+  (@rpm_info) = split(/\n+/, $log_out);
+
+  %INSTALLED_BY_NAME=();
+  my $lineno =0;
+  foreach $fqn (@rpm_info) {
+    $lineno++;
+    chomp $fqn;
+    my ($pkg) = new_rpm_package($fqn, "System Info lineno: $lineno");
+    push @{ $INSTALLED_BY_NAME{$pkg->{'name'}} }, $pkg;
+  }
+  
+  return ; 
+}
+
+
+sub remove_extra_packages {
+
+  # arguments are not used but allowed for symetry with other
+  # functions
+
+  my(@pkg_list) = @_;
+  
+  get_rpm_info();
+
+  # Remove packages installed on the machine but not not in the
+  # manifest.  This is important as we sometimes change the package
+  # names while upgrading them and if we did not remove all packages
+  # which are not listed these packages would remain.
+
+  # We also need to remove old versions of just upgraded packages.
+  # Currently we have a problem, some old packages are not being
+  # removed when we do an rpm update.  Since we are currently only
+  # installing one version of each package, remove all other versions
+  # then what was required.
+
+
+  # We would like to remove all packages in reverse topological order.
+  # I have no way of finding out what that order is, so I use a single
+  # command which removes all pacakges.  RPM will figure out the
+  # correct order at run time.  This will cause us to reach the
+  # command line limit if the list of packages to remove is large
+  # enough.
+
+  my @extra_packages = ();
+  
+  foreach $pkgname ( keys %INSTALLED_BY_NAME ) { 
+    foreach $pkg (@{ $INSTALLED_BY_NAME{$pkgname} }) {
+      
+      ($LISTED_BY_FQN{$pkg->{'fqn'}}) && next;
+      
+      push @extra_packages, $pkg->{'fqn'};
+    }
+  }
+
+  if (@extra_packages) {
+    my ($wait_status, $log_out, $log_err) = 
+      system3(
+	      'cmd_vec' => [$SYS_CMDS{'rpm'}, '-e', @RPM_ARGS,
+			  @extra_packages],
+	      'log_cmds'=> 1,
+	     );
+  }
+
+  return ;
+}
+
+
+# update the installation with packages
+
+sub update_packages {
+  my(@pkg_list) = @_;
+  
+  get_rpm_info();
+
+  
+  # first just test and see if this upgrade could work.
+  # this may blowup some OS maximal argument size limit
+
+#  my ($wait_status, $log_out, $log_err) = 
+#    system3(
+#	    'cmd_vec' => [$SYS_CMDS{'rpm'}, "--test", '-U', 
+#			  @RPM_ARGS,
+#			  @upgrade_list],
+#	    'log_cmds'=> 1,
+#	   );
+  
+  
+  foreach $pkg (@pkg_list) {
+    
+    (is_installed($pkg)) && next;
+    
+    my ($wait_status, $log_out, $log_err) = 
+      system3(
+	      'cmd_vec' => [ 
+			    $SYS_CMDS{'rpm'}, '-U',
+			    @{ $pkg->{'rpm_flags'} }, @RPM_ARGS, 
+			    $pkg->{'rpm_file'} ],
+	      'log_cmds'=> 1,
+	     );
+  } # each $fqn
+  
+  return ;
+} # update
+
+
+
+# rollback the previous update installation
+
+sub rollback_packages {
+  my(@pkg_list) = @_;
+  
+  get_rpm_info();
+
+  
+  # first just test and see if this upgrade could work.
+  # this may blowup some OS maximal argument size limit
+
+#  my ($wait_status, $log_out, $log_err) = 
+#    system3(
+#	    'cmd_vec' => [$SYS_CMDS{'rpm'}, "--test", '-U', 
+#			  @RPM_ARGS,
+#			  @upgrade_list],
+#	    'log_cmds'=> 1,
+#	   );
+  
+  
+  foreach $pkg (reverse @pkg_list) {
+
+    (is_installed($pkg)) && next;
+    
+    my ($wait_status, $log_out, $log_err) = 
+      system3(
+	      'cmd_vec' => [
+			    $SYS_CMDS{'rpm'}, '-U', '--oldpackage',
+ 			    @{ $pkg->{'rpm_flags'} }, @RPM_ARGS,
+			    $pkg->{'rpm_file'}
+			   ],
+	      'log_cmds'=> 1,
+	     );
+    
+  } # each $fqn
+
+  return ;
+} # rollback
+
+
+# force ALL the packages to be reinstalled
+
+sub force_packages {
+  my(@pkg_list) = @_;
+
+  # force all the packages in the list to be reinstalled
+
+  # first just test and see if this upgrade could work.
+  # this may blowup some maximal argument size
+  
+#  my ($wait_status, $log_out, $log_err) = 
+#    system3(
+#	    'cmd_vec' => [$SYS_CMDS{'rpm'}, "--test", '-U', '--force', 
+#			  @pkg_list],
+#	    'log_cmds'=> 1,
+#	   );
+  
+  
+  foreach $pkg (@pkg_list) {
+    my ($wait_status, $log_out, $log_err) = 
+      system3(
+	      'cmd_vec' => [
+			    $SYS_CMDS{'rpm'}, '-U', '--force', '--oldpackage', 
+			    @{ $pkg->{'rpm_flags'} }, @RPM_ARGS,
+			    $pkg->{rpm_file}
+			   ],
+	      'log_cmds'=> 1,
+	     );
+  } 
+  
+  return ;
+} # force 
+
+
+
+# check that the verify command exits without error.
+
+sub verify_packages {
+
+  my ($wait_status, $log_out, $log_err) = 
+    system3(
+	    'cmd_vec' => [
+			  $SYS_CMDS{'rpm'}, '-Va',
+			 ],
+	    'log_cmds'=> 1,
+	   );
+
+  return ;
+} # verify
+
+
+
+sub create_scriptfile {
+  my(@pkg_list) = @_;
+
+  my $num_pkgs = scalar(@pkg_list);
+
+  if ($FORCE) {
+    @args = ('-U', '--force');    
+  } elsif ($UPDATE) {
+    @args = ('-U', );
+  } else {
+    die("Scripts can only be created for --update or --force")
+  }
+
+  my $out = '';
+
+  $out =<<EOF
+
+# This file automatically generated by program: $0
+# version: $main::VERSION
+# on host: $main::HOSTNAME
+# localtime: $main::LOCALTIME
+# 
+# This install file automatically installs
+#    manifest file $MANIFEST_FILE
+
+    $SYS_CMDS{'rpm'} --rebuilddb
+
+EOF
+;
+
+  foreach $pkg (@pkg_list) {
+    my @cmd = (
+	       $SYS_CMDS{'rpm'}, @args, 
+	       @{ $pkg->{'rpm_flags'} }, @RPM_ARGS,
+	       $pkg->{install_script_file}
+	      );
+
+    $out .=<<EOF;
+
+    @cmd
+    if [ \$\? \-ne 0 ]; then
+      echo \>\&2 "\$0: Error running: @cmd"
+      exit 1;
+    fi
+
+EOF
+
+  } 
+
+  
+  $out .=<<EOF;
+
+  # check that the install for accuracy
+
+  $SYS_CMDS{'rpm'} --rebuilddb;
+
+  $SYS_CMDS{'rpm'} -Va;
+  if [ \$\? \-ne 0 ]; then
+    echo \>\&2 "\$0: Error installing Packages";
+    echo \>\&2 "\$0: 'rpm -Va' reports errors";
+    exit 1;
+  fi
+
+    num_installed_pkgs=\` $SYS_CMDS{'rpm'} -qa | wc \-\l | sed "s/[^0-9]//g" \`;
+    if [ \$num_installed_pkgs \-ne $num_pkgs ]; then
+      echo \>\&2 "\$0: Error installing Packages";
+      echo \>\&2 "\$0: rpm -qa gives \$num_installed_pkgs packages installed";
+      echo \>\&2 "\$0: expected $num_pkgs installed";
+      exit 1;
+    fi
+
+   exit 0;
+
+EOF
+
+  return $out;
+} # create_script
+
+
+
+
+# check what running with --update would do.  If I were to write a
+# check_rollback_packages the output would be similar but the packge
+# update order would be reversed.
+
+sub test_update {
+  my(@pkg_list) = @_;
+  
+  get_rpm_info();
+
+  # find what we will upgrade
+  
+  foreach $pkg (@pkg_list) {
+    is_installed($pkg) && next;
+    push @out, "out of sync, must update: $pkg->{'fqn'}\n";
+  } # each $fqn
+  
+
+  # remove old versions of what we installed.
+
+  foreach $pkgname ( keys %INSTALLED_BY_NAME ) { 
+    foreach $pkg (@{ $INSTALLED_BY_NAME{$pkgname} }) {
+
+      ($LISTED_BY_FQN{$pkg->{'fqn'}}) && next;
+
+      push @out, "out of sync, must delete: $pkg->{'fqn'}\n";
+    }
+  }
+
+  return @out;
+} # test_update
+
+
+
+sub nonblock {
+  
+    # unbuffer a fh so we can select on it
+    
+    my ($fh) = shift;
+    my $rc = '';
+    my $flags = '';
+    
+    $flags = fcntl($fh, F_GETFL, 0) ||
+	fatal_error("Could not get flags of socket: $fh : $!\n");
+    
+    $flags |= O_NONBLOCK;
+    
+    $rc = fcntl($fh, F_SETFL, $flags) ||
+	fatal_error("Could not set flags of socket: $fh : $!\n");
+    
+    return 1;
+}
+
+
+
+sub mkdir_R {
+# a recusive mkdir function
+
+  my ($dir, $mode) = @_;
+  my @dir = split('/', $dir);
+
+  foreach $i (0..$#dir) {
+
+    my ($dir) = join('/', @dir[0..$i]);
+    ($dir) || next;
+
+      (-d $dir) ||
+	mkdir($dir, $mode) ||
+	  die("Could not mkdir: $dir, for writing: $!\n");
+  }
+  
+  return ;
+}
+
+
+sub chk_system_config {
+  # refuse to start if the system is in a dangerous state
+
+  
+  @problem = ();
+
+  # this is just a placeholder for now
+  # checks go here and failures add to @problem
+
+  return @problem;
+}
+
+
+# park a bunch of unused function here for future scripts
+
+
+sub run_local_rcscripts {
+  my @script_args = @_;
+
+  (-d $LOCAL_RC2_DIR) || return ;
+
+  my @rc_files = ();
+
+  opendir(DIR, "$LOCAL_RC2_DIR") ||
+    die("Could not opendir: '$LOCAL_RC2_DIR': $!\n");
+
+  @rc_files = grep(/^S/, readdir(DIR));
+
+  closedir(DIR) ||
+    die("Could not closedir : '$LOCAL_RC2_DIR': $!\n");
+  
+  ( scalar(@rc_files) > 0 ) || return ;
+
+  if ($script_args[0] eq 'start') {
+    @rc_files =         sort @rc_files;
+  }else{
+    @rc_files = reverse sort @rc_files;
+  }
+
+  foreach $script (@rc_file) {
+    my ($wait_status, $log_out, $log_err) = 
+      system3(
+	      'cmd_vec' => ["$LOCAL_RC2_DIR/$script", @script_args],
+	      'log_cmds'=> 1,
+	     );
+  }
+
+  return ;
+}
+
+
+sub update_package_list {
+
+  my $update_script = '';
+  
+  # learn what updates we wish to make
+
+  {
+    open(FILELIST, "<$BUILD_FILE") ||
+      die("Could not open build file: '$BUILD_FILE': $!\n");
+
+    my $lineno = 0;
+    while ($fqn=<FILELIST>) {
+      $lineno++;
+      $fqn =~ s/\#.*$//;
+      $fqn =~ s/\s+//g;
+
+      # untaint the input. As a security precaution only allow a few
+      # "good characters" in the package name, or our eval of the
+      # update_script might do some really unexpected things.
+
+      if ($fqn =~ m/([-_.a-zA-Z0-9]+)/) {
+	my $pkg = new_rpm_package($1, "file: $BUILD_FILE lineno: $lineno");
+	$update_script .= "\$fqn =~ s/^$pkg->{'name'}-\\d.*\$/$pkg->{'fqn'}/;\n"
+      }
+    }
+    
+    close(FILELIST) ||
+      die("Could not close build file: '$BUILD_FILE': $!\n");
+  }
+
+  # Perform the modifications to the file list
+
+  {
+
+# co -l $MANIFEST_FILE
+
+    rename($MANIFEST_FILE, $MANIFEST_FILE.".bak") ||
+      die("Could not rename ".
+	  "file: $MANIFEST_FILE, ${PACKAGE_FILE}.bak: $!\n");
+
+    open(FILELIST_IN, "<${PACKAGE_FILE}.bak") ||
+      die("Could not open for writing ".
+	  "packagefile: '${PACKAGE_FILE}.bak': $!\n");
+
+    open(FILELIST_OUT, ">$MANIFEST_FILE") ||
+      die("Could not read from packagefile: '${PACKAGE_FILE}.bak': $!\n");
+    
+    while ($fqn=<FILELIST_IN>) {
+      eval $update_script;
+      print FILELIST_OUT $fqn;
+    }
+    
+    close(FILELIST_OUT) ||
+      die("Could not close packagefile: '$MANIFEST_FILE': $!\n");
+
+    close(FILELIST_IN) ||
+      die("Could not close packagefile: '${PACKAGE_FILE}.bak': $!\n");
+
+# ci -u $MANIFEST_FILE
+
+  }
+
+  return ;
+}
+
+
+sub include_file {
+  my ($filename) = @_;
+  my (@inc) = ();
+  my $fh = gensym();  
+  
+  (-f "$INCLUDE_DIR/$filename") ||
+    die("include file: $INCLUDE_DIR/$filename, \n".
+	"found while expanding: $BUILD_FILE, does not exist.\n");
+  
+  open($fh, ">$INCLUDE_DIR/$filename") ||
+    die("Could not open include file: '$INCLUDE_DIR/$filename': $!\n");
+  
+  while (defined($line = <$fh>) ) {
+    
+    if ($line =~ m/\w*\$([-_.a-zA-Z0-9]+)/) {
+      push @inc, include_file($line);
+    } else {
+      push @inc, $line;
+    }
+    
+  }
+  
+  close($fh) ||
+    die("Could not close include file: '$INCLUDE_DIR/$filename': $!\n");
+  
+  return @inc;
+}
+
+
+sub expand_package_list {
+
+  my $update_script = '';
+  
+  # learn what updates we wish to make
+
+    open(INFILE, "<$BUILD_FILE") ||
+      die("Could not open build file: '$BUILD_FILE': $!\n");
+    
+    open(OUTFILE, ">$TMP_FILE") ||
+      die("Could not open tmp file: '$TMP_FILE': $!\n");
+    
+    while ($line=<INFILE>) {
+
+      # untaint the input. As a security precaution only allow a few
+      # "good characters" in the package name.
+
+      if ($line =~ m/\w*\$([-_.a-zA-Z0-9]+)/) {
+	print include_file($1);
+      } else {
+	print $line;
+      }
+
+    }
+    
+    close(INFILE) ||
+      die("Could not close build file: '$BUILD_FILE': $!\n");
+
+    close(OUTFILE) ||
+      die("Could not close tmp file: '$TMP_FILE': $!\n");
+
+  return ;
+}
+
+
+sub update_time {
+
+  $TIME = time();
+  $LOCALTIME = localtime($main::TIME);
+
+  return ;
+}
+
+
+
+sub set_static_vars {
+
+# This functions sets all the static variables which are often
+# configuration parameters.  Since it only sets variables to static
+# quantites it can not fail at run time. Some of these variables are
+# adjusted by parse_args() but asside from that none of these
+# variables are ever written to. All global variables are defined here
+# so we have a list of them and a comment of what they are for.
+  
+  @ORIG_ARGV = @ARGV;
+  
+  $INCLUDE_DIR = "";
+  $TMP_FILE = "";
+
+  $LOG_FILE="/var/log/rpmsync/log";
+  $LOCK_FILE="/var/lock/rpmsync";
+  $MANIFEST_FILE="/usr/local/etc/rpmpkg.manifest";
+
+  $FTP_PATH='ftp://machine.iname.net/pub/redhat';
+  $SEARCH_PATH = (
+		  # the old hard mounted master-mm package repository
+		  '/net/master-mm/export/rpms/redhat'.
+
+		  # the new auto mounted master-mm package repository
+		  ':/network/master-mm.mail.com/export/rpms/redhat'.
+
+		  # look in obvious places on the machine for packages
+		  ':/tmp'.
+
+		  ':/usr/local/src/redhat/noarch'.
+		  ':/usr/local/src/redhat/sparc'.
+		  ':/usr/local/src/redhat/i386'.
+
+		  # for testing: this is how the current build machine
+		  # is set up.
+
+		  ':/data1/archive/redhat');
+
+  $VERSION = ( qw$Revision: 1.1 $ )[1];
+
+  $VERBOSE=0;
+  $SKIP_CHECK=0;
+
+  # The pattern for fqn.  remember that the format of the file is
+  # dependent on how RPM is configured so this may not be portable to
+  # all RPM users.
+
+  $BINARY_PACKAGE_FILE_PAT = ('$dir/RPMS/$arch/'.
+			      '$name-$version-$release.$os-$arch.rpm');
+  $SOURCE_PACKAGE_FILE_PAT = '$dir/SRPMS/$source_rpm_file';
+
+  # The pattern for parsing fqn into ($name, $version, $release).
+  # This is difficult to parse since some hyphens are significant and
+  # others are not, some packages have alphabetic characters in the
+  # version number.
+
+  $PACKAGE_PAT ='(.*)-([^-]+)-([^-]+)';
+
+  # set a known path
+  
+  $ENV{'PATH'}= (
+		 '/usr/bin'.
+		 ':/data/gnu/bin'.
+		 ':/data/local/bin'.
+		 ':/data/devel/bin'.
+		 ':/usr/local/bin'.
+		 ':/bin'.
+		 '');
+  
+  
+  # taint perl requires we clean up these bad environmental variables.
+  
+  delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+  
+  %SYS_CMDS = (
+	       'hostname' => 'hostname',
+	       'rpm' => 'rpm',
+	       'uname' => 'uname',
+	      );
+
+  $SIG{'CHLD'} = 'DEFAULT';
+
+  return ;
+}
+
+
+sub get_env {
+
+# this function sets variables similar to set_static variables.  This
+# function may fail only if the OS is in a very strange state.  after
+# we leave this function we should be all set up to give good error
+# handling, should things fail.
+
+  $| = 1;
+  $PROGRAM = basename($0);
+  $PID = $$; 
+  $TIME = time();
+  $LOCALTIME = localtime($main::TIME); 
+
+  $START_TIME = $TIME;
+  $UID = $<;
+
+  update_time();
+  my ($wait_status, $log_out, $log_err) = 
+    system3('cmd_vec' => ['hostname'],);
+
+  $HOSTNAME = $log_out;
+  chomp $HOSTNAME;
+
+  my ($wait_status, $log_out, $log_err) = 
+    system3('cmd_vec' => ['uname', '-a'],);
+  $uname = $log_out;
+
+  ( $uname =~ m/sparc/ ) && ( $ARCH="sparc");
+  ( $uname =~ m/i\d86/ ) && ( $ARCH="i386" );
+  
+  $osname = $^O;
+  ( $osname =~ m/solaris/ ) && ( $OS="solaris2.6" );
+  ( $osname =~ m/linux/ )   && ( $OS="linux" );
+  
+  return ;
+} # get_env
+
+
+sub parse_args {
+
+  Getopt::Long::config('require_order', 'auto_abbrev', 'ignore_case');
+
+  my ($help, $version, $force_and_verify);
+
+  %option_linkage = (
+		     "version" => \$version,
+		     "verbose" => \$VERBOSE,
+		     "silent" => \$SILENT,
+		     "help" => \$help,
+		     "skip_check" => \$SKIP_CHECK,
+		     "log_file" => \$LOG_FILE,
+		     "manifest_file" => \$MANIFEST_FILE,
+		     "update"=>\$UPDATE,
+		     "force"=>\$FORCE,
+		     "force_and_verify"=>\$force_and_verify,
+		     "rollback"=>\$ROLLBACK,
+		     "test"=>\$TEST,
+		     "rpm_args" =>\@RPM_ARGS,
+		     "script_file" =>\$SCRIPT_FILE,
+		    );
+
+
+  GetOptions (\%option_linkage, qw(
+		 silent! verbose! version! help! skip_check!
+		 update! force! force_and_verify! rollback! test! 
+		 manifest_file=s script_file=s
+		 log_file=s manifest_file=s
+		 rpm_args=s@
+		)) ||
+		    die("Illegal options in \@ARGV: '@ARGV',");
+
+  if ($force_and_verify) {
+    $FORCE = 1;
+    $VERIFY = 1;
+  }
+
+  if ($version) {
+    print "$0: Version: $VERSION\n";
+    exit 0;  
+  }
+  
+  if ($help) {
+    usage();
+  }
+
+  $Process::VERBOSE = $VERBOSE;
+
+  {
+
+    my $args=0;
+
+    ($UPDATE) &&
+      $args++;
+    
+    ($FORCE) &&
+      $args++;
+    
+    ($TEST) &&
+      $args++;
+    
+    ($ROLLBACK) &&
+      $args++;
+    
+    ($args == 0) &&
+      die("Must have: 'update', 'force', 'test', 'rollback', argument.\n");
+    
+    ($args > 1) &&
+      die("Can not choice more then one: ".
+	  "'update', 'force', 'test', 'rollback', arguments.\n");
+  }
+
+  return 1;
+} # parse_args
+
+
+sub set_logging {
+
+# setup the logging facilities to send errors to syslog/log file.
+
+# this needs to come after parse_args() so that we send usage and argv
+# errors to the stderr.
+
+  {
+    my $logopt = 'cons,ndelay';
+    my $facility = 'daemon';
+
+    # no need to test if this succeeds.  It calls croak so we will
+    # die if there is a problem.
+
+    openlog($PROGRAM, $logopt, $facility);
+  }
+
+  $SIG{'__WARN__'} = \&log_error;
+  $SIG{'__DIE__'} =  \&fatal_error;
+
+  my @sys_errors = chk_system_config();
+
+  if (@sys_errors) { 
+    if ($SKIP_CHECK) {
+
+      # even though we are skipping the test put a record of the
+      # problems in the log
+
+      warn(
+	   "Warning Error list:\n",
+	   @sys_errors,
+	   "End Warning Error list\n",
+	   "These Errors would be fatal, ".
+	   "if run without '--skip_check'\n"
+	  );
+
+    } else {
+
+      # should not start with these problems
+
+      die("Fatal Error list:\n",
+		  @sys_errors,
+		  "End Fatal Error list\n");
+    }
+  }
+
+  if ($LOG_FILE) {
+    # redirect error log
+    mkdir_R(dirname($LOG_FILE), 0755);
+
+    open (LOG, ">>$LOG_FILE") || 
+      die("Could not open log_file: $LOG_FILE, ".
+	  "for writing: $!\n");
+
+    print LOG "\n";
+    chmod 0744, $LOG_FILE;
+    LOG->autoflush(1);
+  } 
+
+  STDERR->autoflush(1);
+
+}
+
+    
+sub get_package_list  {
+
+# load the $package_file into memory
+
+# this fucntion must follow get_env() since we need $skip_check to be
+# respected, if set.
+
+  my ($package_file) = @_;
+  my @pkg_list = ();
+
+  (%LISTED_BY_FQN) = ();
+  
+  my %package_count = ();
+  open(FILELIST, "<$package_file") ||
+    die("Could not open packagefile: '$package_file': $!\n");
+
+  my $fqn;  
+  my $lineno = 0;
+
+  while ($fqn=<FILELIST>) {
+    $lineno++;
+    my $new_package = '';
+    my $pkg_flags = '';
+
+    chomp $fqn;
+    $fqn =~ s/\#.*$//;
+    if ($fqn =~ s/\s+(.*)$// ) {
+      $pkg_flags = $1;
+    }
+    ($fqn) || next;
+
+    $new_package = new_rpm_package($fqn, "file: BUILD_FILE lineno: $lineno");
+    ($pkg_flags) && 
+      ($new_package->{'rpm_flags'} = [ split(/\s+/, $pkg_flags) ] );
+    $package_count{ $new_package->{'name'} }++;
+    $LISTED_BY_FQN{$new_package->{'fqn'}} = 1;    
+    push @pkg_list, $new_package ;
+  }
+  
+  close(FILELIST) ||
+    die("Could not close packagefile: '$package_file': $!\n");
+
+  foreach $pkg_name (sort keys %package_count) {
+    ($package_count{ $pkg_name } > 1) && 
+      die("Package: $pkg_name is listed ".
+	  "$package_count{ $pkg_name } times ".
+	  "in file: $package_file\n");
+  }
+
+  return (@pkg_list);
+}
+
+
+sub get_package_hash  {
+
+# load the $package_file into memory
+
+# this fucntion must follow get_env() since we need $skip_check to be
+# respected, if set.
+
+  my $package_file = @_;
+  my $pkg_hash = ();
+
+  open(FILELIST, "<$package_file") ||
+    die("Could not open packagefile: '$package_file': $!\n");
+  my $lineno = 0;
+  
+  while ($fqn=<FILELIST>) {
+    $lineno++;
+    $fqn =~ s/\#.*$//;
+    $fqn =~ s/\s+//g;
+    chomp $fqn;
+    ($fqn) || next;
+
+    my ($pkg) = new_rpm_package($fqn, "file: $package_file lineno: $lineno");
+    push @{ $pkg_hash{$pkg->{'name'}} }, $pkg;
+  }
+  
+
+  close(FILELIST) ||
+    die("Could not close packagefile: '$package_file': $!\n");
+
+  return ($pkg_hash);
+}
+
+
+
+sub pkg_diff {
+
+  $hash0=get_package_hash($file0);
+  $hash1=get_package_hash($file1);
+
+  my ($pkg_out, $file_out);
+  my @warnings = ();
+  my %seen = ();
+
+  foreach $pkg_name ( keys %{$hash0}, keys %{$hash1} ) {
+
+    $seen{$pkg_name} && next;
+    $seen{$pkg_name} = 1;
+     if ( 
+	( scalar($hash0->{$pkg_name}) > 1) ||
+	( scalar($hash1->{$pkg_name} > 1 ) ) 
+       ) {
+      push @warnings, $pkg_name;
+    }
+
+    if ( ($hash0->{$pkg_name}) && 
+	 (!($hash1->{$pkg_name}) ) ) {
+      $pkg_out .= "missing $hash0->{$pkg_name}->{'fqn'}\n";
+      next;
+    } elsif ( (!($hash0->{$pkg_name})) && 
+	      ($hash1->{$pkg_name}) ) {
+      $pkg_out .= "added   $hash1->{$pkg_name}->{'fqn'}\n";
+      next;
+    } else {
+
+      my ($wait_status, $log_out, $log_err) = 
+	system3('cmd_vec' => [
+			      'rpmdiff',
+			      ($hash0->{$pkg_name}->{'name'}),
+			      ($hash1->{$pkg_name}->{'name'}),
+			     ],);
+      $file_out .= $log_out;      
+    }
+
+  } # each $pkg_name
+
+  print  ("Package Differences:\n\n".
+	  sort( split(/\n+/, $pkg_out) ).
+	  "\n\nFile Differences:\n\n".
+	  sort( split(/\n+/, $file_out) ) );
+  
+  if (@warnings) {
+    print STDERR ("The following packages have more then one version\n".
+		  " mentioned in the pkglist: ".
+		  join(", ", @warnings)."\n".
+		  "The diff algorithm assumes only single versions\n".
+		  "in pkglist file.\n");
+  }
+  
+  return ;
+}
+
+
+
+# -----------------------main--------------------------
+
+{
+  set_static_vars();
+  get_env();
+
+  parse_args();
+  set_logging();
+  @MANIFEST = get_package_list($MANIFEST_FILE);
+  
+  # Learn the state of the machine and ensure that we have the srpms
+  # and rpms for this state.  This must be done after parsing the
+  # arguments since we may have set '--skip_check'
+
+  get_rpm_info('-qa');
+
+  info_error("starting argv: '@ORIG_ARGV' \n");
+  syslog('info', "starting argv: '@ORIG_ARGV' \n");
+
+  my ($exit_with_error) = 0;
+
+  my ($wait_status, $log_out, $log_err) = ();
+
+  ($UID == 0 ) &&
+    ( ($wait_status, $log_out, $log_err) = 
+      system3('cmd_vec' => [$SYS_CMDS{'rpm'}, '--rebuilddb'],));
+
+  if ($TEST) {
+
+    my (@todo) = test_update(@MANIFEST);
+
+    if (@todo) {
+      warn(@todo);
+      $exit_with_error = 1;
+    }
+
+  } elsif ($SCRIPT_FILE) {
+
+    open(SCRIPT_FILE, ">$SCRIPT_FILE") ||
+      die("Could not write to file: $SCRIPT_FILE. $!\n");
+
+    my $script = create_scriptfile(@MANIFEST);
+    print SCRIPT_FILE $script;
+
+    close(SCRIPT_FILE) ||
+      die("Could not close file: $SCRIPT_FILE. $!\n");
+
+  } else {
+
+    # eventually there will be a installer id who will run this code but
+    # for now rpm must be run as  root.
+    
+    ($UID == 0 ) || 
+      die("Must run this program as root\n");
+
+    ($FORCE) && 
+      force_packages(@MANIFEST);
+    
+    ($UPDATE) && 
+      update_packages(@MANIFEST);
+    
+    ($ROLLBACK) &&
+      rollback_packages(@MANIFEST);
+    
+    remove_extra_packages(@MANIFEST);
+    
+    my ($wait_status, $log_out, $log_err) = 
+      system3('cmd_vec' => [$SYS_CMDS{'rpm'}, '--rebuilddb'],);
+    
+    my @problems = test_update(@MANIFEST);
+    
+    (@problems) && die("@problems");
+
+    ($VERIFY) &&
+      verify_packages(@MANIFEST);    
+  }
+  
+  info_error("finished argv: '@ORIG_ARGV' \n");
+  syslog('info', "finished argv: '@ORIG_ARGV' \n");
+  
+  clean_up();
+
+  ($exit_with_error) && 
+    exit 9;
+
+  exit 0;  
+}
+
diff --git a/scripts/sql.prov b/scripts/sql.prov
new file mode 100755
index 000000000..5d2b31860
--- /dev/null
+++ b/scripts/sql.prov
@@ -0,0 +1,115 @@
+#!/usr/bin/perl
+
+# RPM and it's source code are covered under two separate licenses. 
+
+# The entire code base may be distributed under the terms of the GNU
+# General Public License (GPL), which appears immediately below.
+# Alternatively, all of the source code in the lib subdirectory of the
+# RPM source code distribution as well as any code derived from that
+# code may instead be distributed under the GNU Library General Public
+# License (LGPL), at the choice of the distributor. The complete text
+# of the LGPL appears at the bottom of this file.
+
+# This alternatively is allowed to enable applications to be linked
+# against the RPM library (commonly called librpm) without forcing
+# such applications to be distributed under the GPL.
+
+# Any questions regarding the licensing of RPM should be addressed to
+# marc@redhat.com and ewt@redhat.com.
+
+
+# sql.prov - a simple script to print the proper name for sql from
+# both the sepecification and body files.
+
+
+# by Ken Estes Mail.com kestes@staff.mail.com
+
+if ("@ARGV") {
+  foreach (@ARGV) {
+    process_file($_);
+  }
+} else {
+
+  # notice we are passed a list of filenames NOT as common in unix the
+  # contents of the file.
+
+  foreach (<>) {
+    process_file($_);
+  }
+}
+
+
+
+foreach $module (sort keys %require) {
+  print "sql($module)\n";
+}
+
+exit 0;
+
+
+
+sub process_file {
+
+  my ($filename) = @_;
+  chomp $filename;
+  
+  open(FILE, "<$filename")||
+    die("$0: Could not open file: '$filename' : $!\n");
+
+  my ($package, $version) = ();
+
+  my (@file) = <FILE>;
+  
+  my ($file) = "@file";
+
+  close(FILE)||
+    die("$0: Could not close file: '$file' : $!\n");
+
+  # skip the comments
+
+  $file =~ s!/\*(.*?)\*/!!gs;
+  $file =~ s!\s*--(.*?)\n!\n!gm;
+
+  @file = split(/\n/, $file);
+
+  foreach (@file) {
+
+    # remove strings
+
+    s!\'[^\']*\'!!g;
+
+
+    # not everyone puts the package name of the file as the first
+    # package name so we report all namespaces as if they were
+    # provided packages (really ugly).
+
+    if (m/\bpackage\s+(body\s*)?(\S+)\s+[ia]s/i) {
+      $package=$2;
+      $package=lc($package);
+      $require{$package}=1;
+    }
+
+    if (m/((procedure)|(function))\s+(\S+)\s*\(/i) {
+      my $func = $4;
+      $func = lc($func);
+      if ($package) {
+	$require{"$package.$func"}=1;
+      } else {
+	$require{$func}=1;
+      }
+    }
+
+    # Each keyword can appear multiple times.  Don't
+    #  bother with datastructures to store these strings,
+    #  if we need to print it print it now.
+	
+    if ( m/^\s*\$RPM_Provides\s*:=\s*["'](.*)['"]/i) {
+      foreach $_ (spit(/\s+/, $1)) {
+        print "$_\n";
+      }
+    }
+
+  }
+
+  return ;
+}
diff --git a/scripts/sql.req b/scripts/sql.req
new file mode 100755
index 000000000..24fa97278
--- /dev/null
+++ b/scripts/sql.req
@@ -0,0 +1,108 @@
+#!/usr/bin/perl
+
+# RPM and it's source code are covered under two separate licenses. 
+
+# The entire code base may be distributed under the terms of the GNU
+# General Public License (GPL), which appears immediately below.
+# Alternatively, all of the source code in the lib subdirectory of the
+# RPM source code distribution as well as any code derived from that
+# code may instead be distributed under the GNU Library General Public
+# License (LGPL), at the choice of the distributor. The complete text
+# of the LGPL appears at the bottom of this file.
+
+# This alternatively is allowed to enable applications to be linked
+# against the RPM library (commonly called librpm) without forcing
+# such applications to be distributed under the GPL.
+
+# Any questions regarding the licensing of RPM should be addressed to
+# marc@redhat.com and ewt@redhat.com.
+
+
+# sql.req - a simple script to print the uses of sql functions.
+
+
+# by Ken Estes Mail.com kestes@staff.mail.com
+
+if ("@ARGV") {
+  foreach (@ARGV) {
+    process_file($_);
+  }
+} else {
+
+  # notice we are passed a list of filenames NOT as common in unix the
+  # contents of the file.
+
+  foreach (<>) {
+    process_file($_);
+  }
+}
+
+
+
+foreach $module (sort keys %require) {
+  print "sql($module)\n";
+}
+
+exit 0;
+
+
+
+sub process_file {
+
+  my ($filename) = @_;
+  chomp $filename;
+  
+  open(FILE, "<$filename")||
+    die("$0: Could not open file: '$filename' : $!\n");
+
+  my ($package, $version) = ();
+
+  my (@file) = <FILE>;
+  
+  my ($file) = "@file";
+
+  close(FILE)||
+    die("$0: Could not close file: '$file' : $!\n");
+
+  # skip the comments
+
+  # Suck the whole file in to make removing /* */ (multiple lines
+  # comments) comments easier
+
+  $file =~ s!/\*(.*?)\*/!!gs;
+  $file =~ s!^\s*--(.*?)\n!\n!gm;
+
+  @file = split(/\n/, $file);
+
+  foreach (@file) {
+
+    # remove strings
+
+    s!\'[^\']*\'!!g;
+
+
+    # we are interested in function names which have a dot in them and
+    # are followed by an open parenthesis
+
+    foreach ( m/([a-zA-Z0-9._-]+\.[a-zA-Z0-9._-]+)\s*\(/ ) {
+      my $func = $_;
+      $func=lc($func);
+      $func =~ m/\.\./ && 
+	next;
+      $require{$func}=1;
+    }
+    
+    # Each keyword can appear multiple times.  Don't
+    #  bother with datastructures to store these strings,
+    #  if we need to print it print it now.
+	
+    if ( m/^\s*\$RPM_Provides\s*:=\s*["'](.*)['"]/i) {
+      foreach $_ (spit(/\s+/, $1)) {
+        print "$_\n";
+      }
+    }
+
+  }
+
+  return ;
+}
diff --git a/scripts/tcl.req b/scripts/tcl.req
new file mode 100644
index 000000000..43c5920c9
--- /dev/null
+++ b/scripts/tcl.req
@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+
+# tcl.req - a simple makedepends like script for tcl.
+
+# I plan to rewrite this in C so that perl is not required by RPM at
+# build time.
+
+# by Ken Estes Mail.com kestes@staff.mail.com
+
+use File::Basename;
+
+if ("@ARGV") {
+  foreach (@ARGV) {
+    process_file($_);
+  }
+} else {
+  
+  # notice we are passed a list of filenames NOT as common in unix the
+  # contents of the file.
+  
+  foreach (<>) {
+    process_file($_);
+  }
+}
+
+
+foreach $module (sort keys %require) {
+    print "tcl($module)\n";
+}
+
+exit 0;
+
+
+
+sub process_file {
+  
+  my ($file) = @_;
+  chomp $file;
+  
+  open(FILE, "<$file")||
+    die("$0: Could not open file: '$file' : $!\n");
+  
+  while (<FILE>) {
+
+    # Each keyword can appear multiple times.  Don't
+    #  bother with datastructures to store these strings,
+    #  if we need to print it print it now.
+    
+    if ( m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i) {
+      foreach $_ (spit(/\s+/, $1)) {
+	print "$_\n";
+      }
+    }
+
+    s/\#.*//;
+    
+    # Each keyword can appear multiple times.  Don't
+    #  bother with datastructures to store these strings,
+    #  if we need to print it print it now.
+    
+    if ( m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i) {
+      foreach $_ (spit(/\s+/, $1))
+	print "$_\n";
+    }
+
+
+# we wish to capture these source statements:
+
+#  source "$PATH/lib/util.tcl"
+#  source "comconf.tcl"
+#  if {[catch {source $env(CONTROL_PANEL_LIB_DIR)/bindings.tcl}] != 0} {
+
+    # quick check to see if the complex regexps could possibly match.
+    # This should speed things up.
+
+    (m/source/) || next;
+
+    # note we include parethesis and '$' and '\' in the pattern
+
+    if ( 
+	(m!source\s+([\'\"])?([0-9A-Za-z/._\-\\\(\)\$]+)!)
+       ) {	
+      
+      my ($module) = $2;
+
+      # If there is some interpolation of variables, 
+      # see if taking the basename will give us the filename.
+
+      ($module =~ m/\$/) &&
+	($module = basename($module));
+      
+      ($module =~ m/\$/) ||
+	($require{$module}=1);
+    }
+  }
+
+  close(FILE)||
+    die("$0: Could not close file: '$file' : $!\n");
+  
+  return ; 
+}
diff --git a/scripts/u_pkg.sh b/scripts/u_pkg.sh
index 86ff951bf..7e5687b51 100755
--- a/scripts/u_pkg.sh
+++ b/scripts/u_pkg.sh
@@ -2,6 +2,12 @@
 
 # a universal interface to Unix OS package managment systems
 
+# This script is not finished.  It is a bunch of ideas for creating a
+# universal package manager using the OS package manager.  I wish to
+# only use tools which are installed in the OS by default and be
+# portable to all OS package managers.
+
+
 PATH="/bin:/usr/bin:/sbin:/usr/sbin:/usr/ucb:/usr/bsd:$PATH"
 export PATH
 
@@ -17,6 +23,10 @@ fi
 #
 # Set OS dependent defaults
 #
+
+# note: that the "package name" which are returned by this script
+# should always include the version and release number.
+
 case $osname in
 	Linux)
 		check_all_packages='rpm -Va'
diff --git a/scripts/vpkg-provides.sh b/scripts/vpkg-provides.sh
index fc13ed865..b0fbf18f1 100755
--- a/scripts/vpkg-provides.sh
+++ b/scripts/vpkg-provides.sh
@@ -6,14 +6,23 @@
 # 
 # This file is distributed under the terms of the GNU General Public License
 #
+
 # vpkg-provides.sh is part of RPM, the Red Hat Package Manager.
-# vpkg-provides.sh searches a list of directories (based on what OS it's
-# being executed on) for shared libraries and interpreters that have been
-# installed by some packaging system other than RPM.  It then generates a
-# spec file that can be used to build a "virtual package" that provides all
-# of these things without actually installing any files.  This makes it much
-# easier to use RPM on non-Linux systems.
-#
+
+# vpkg-provides.sh searches a list of directories (based on what OS
+# it's being executed on) for shared libraries and interpreter files
+# that have been installed by some packaging system other than RPM.
+# It then generates a spec file that can be used to build a "virtual
+# package" that provides all of these things without actually
+# installing any files.  The spec file in effect tells rpm what it
+# needs to know about operating system files which are not under rpm
+# control.  This makes it much easier to use RPM on non-Linux systems.
+
+# By default the script also generates a %verifyscript (with hard
+# coded $shlib_dirs, $ignore_dirs values) which will check that the
+# checksum of each file in the directories searched has not changed
+# since the package was built.
+
 # Comments: This script is a quick hack.  A better solution is to use the
 # vendor's package management commands to actually query what's installed, and
 # build one or more spec files based on that.  This is something
@@ -21,6 +30,8 @@
 # first effort was great, so I didn't want to wait until the better solution
 # was done.
 
+# The complete specfile will be sent to stdout.
+
 # you will need to create a spec_header for the virtual package.  This
 # header will provide such specfile information as:
 #
@@ -33,16 +44,19 @@
 #  Source: 
 
 
-usage= "usage: $0 [--spec_header '/path/to/os-base-header.spec'] \n"
-usage= "$usage\t[--find_provides '/path/to/find-provides']\n"
-usage= "$usage\t[--shlib_dirs 'dirs:which:contain:shared:libs']\n"
-usage= "$usage\t[--ignore_dirs 'egrep|pattern|of|paths|to|ignore']\n"
+# most of the command line arguments have defaults
+
+usage="usage: $0 --spec_header '/path/to/os-base-header.spec' \n"
+usage="$usage\t[--find_provides '/path/to/find-provides']\n"
+usage="$usage\t[--shlib_dirs 'dirs:which:contain:shared:libs']\n"
+usage="$usage\t[--ignore_dirs 'egrep|pattern|of|paths|to|ignore']\n"
 
 # these two should be unnessary as the regular dependency analysis
 # should take care of interpreters as well as shared libraries.
 
-usage= "$usage\t[--interp_dirs 'dirs:which:contain:interpreters']\n"
-usage= "$usage\t[--interps 'files:to:assume:are:installed']\n"
+usage="$usage\t[--interp_dirs 'dirs:which:contain:interpreters']\n"
+usage="$usage\t[--interps 'files:to:assume:are:installed']\n"
+usage="$usage\t[--no_verify]\n"
 
 
 # this command may not be portable to all OS's, does something else
@@ -55,7 +69,7 @@ hostname=`uname -n`
 
 # if some subdirectories of the system directories needs to be ignored
 # (eg /usr/local is a subdirectory of /usr but should not be part of
-# the virtual package) then call this script with IGNORE_DIRS set to a
+# the virtual package) then call this script with ignore_dirs set to a
 # vaild egrep pattern which discribes the directories to ignored.
 
 PATH=/bin:/usr/bin:/sbin:/usr/sbin:/usr/ucb:/usr/bsd
@@ -68,7 +82,11 @@ export PATH
 spec_header='/usr/lib/rpm/os-base-header.spec';
 interps="sh:csh:ksh:dtksh:wish:tclsh:perl:awk:gawk:nawk:oawk"
 find_provides='/usr/lib/rpm/find-provides';
-ignore_dirs="."
+
+    # no file names begin with this character so it is a good default
+    # for dirs to ignore.  
+
+ignore_dirs="@"
 
 
 osname=`uname -s`
@@ -174,6 +192,9 @@ do
 		interps=$1
 		shift
 		;;
+	--no_verify)
+		no_verify=1
+		;;
 	--help)
 		echo $usage
 		exit 0
@@ -223,7 +244,7 @@ fi
 #
 for d in `echo $shlib_dirs | sed -e 's/:/ /g'`
 do
-	find $d -type f -print 2>/dev/null | egrep -v \'$IGNORE_DIRS\' | $find_provides >> $provides_tmp
+	find $d -type f -print 2>/dev/null | egrep -v \'$ignore_dirs\' | $find_provides >> $provides_tmp
 done
 
 sum_tmp=/tmp/sum.$$
@@ -237,7 +258,7 @@ fi
 #
 for d in `echo $shlib_dirs | sed -e 's/:/ /g'`
 do
-	find $d -type f -print 2>/dev/null | egrep -v \'$IGNORE_DIRS\' | $sum_cmd >> $sum_tmp
+	find $d -type f -print 2>/dev/null | egrep -v \'$ignore_dirs\' | $sum_cmd >> $sum_tmp
 done
 
 
@@ -247,17 +268,20 @@ done
 cat $spec_header
 
 #
-# Output the shared libraries
+# output the 'Provides: ' part of the spec file
 #
 {
+    #
+    # Output the shared libraries
+    #
     for f in `cat $provides_tmp | sort -u`
     do
 	echo "Provides: $f"
     done
 
-#
-# Output the available shell interpreters
-#
+    #
+    # Output the available shell interpreters
+    #
     for d in `echo $interp_dirs | sed -e 's/:/ /g'`
     do
 	for f in `echo $interps | sed -e 's/:/ /g'`
@@ -280,17 +304,27 @@ cat <<_EIEIO_
 This is a virtual RPM package.  It contains no actual files.  It uses the
 \`Provides' token from RPM 3.x and later to list many of the shared libraries
 and interpreters that are part of the base operating system and associated
-subsets for $osname.
+OS packages for $osname.
 
 This virtual package was constructed based on the vendor/system software
-installed on the $osname machine named $hostname, as of the date
-$date.
+installed on the '$osname' machine named '$hostname', as of the date
+'$date'.
+
+Input to the script:
+
+                spec_header=$spec_header
+                ignore_dirs=$ignore_dirs
+                find_provides=$find_provides
+                shlib_dirs=$shlib_dirs
+                interp_dirs=$interp_dirs
+                interps=$interps
 
 _EIEIO_
 
 #
 # Output the build sections of the spec file
 #
+
 echo '%prep'
 echo '# nothing to do'
 echo '%build'
@@ -300,8 +334,10 @@ echo '# nothing to do'
 echo '%clean'
 echo '# nothing to do'
 
+if [ -z "${no_verify}" ]; then
+
 #
-# Output the verify section of the spec file
+# Output the optional verify section of the spec file
 #
 
 cat <<_EIEIO_
@@ -325,7 +361,7 @@ fi
 
 for d in `echo $shlib_dirs | sed -e 's/:/ /g'`
 do
-	find \$d -type f -print 2>/dev/null | egrep -v \'$IGNORE_DIRS\' | $sum_cmd >> \$sum_current_tmp
+	find \$d -type f -print 2>/dev/null | egrep -v \'$ignore_dirs\' | $sum_cmd >> \$sum_current_tmp
 done
 
 cat >\$sum_package_tmp <<_EOF_
@@ -342,16 +378,21 @@ _EOF_
 
 cmp \$sum_package_tmp \$sum_current_tmp 
 
-if [ $? -ne 0 ]; then
-	echo "Differences found by: cmp \$sum_package_tmp \$sum_current_tmp"
+if [ \$? -ne 0 ]; then
+	echo"Differences found by: cmp \$sum_package_tmp \$sum_current_tmp"
 	exit \$?
 fi
 
 _EIEIO_
 
+# end optional verify section
+fi
+
 #
 # Output the files section of the spec file
 #
 
 echo '%files'
 echo '# no files in a virtual package'
+
+exit 0
diff --git a/scripts/vpkg-provides2.sh b/scripts/vpkg-provides2.sh
index 86e39f805..dcbfcc509 100755
--- a/scripts/vpkg-provides2.sh
+++ b/scripts/vpkg-provides2.sh
@@ -1,5 +1,10 @@
 #!/bin/sh
 
+# This script is not finished.  It is a bunch of ideas for using the
+# OS package manager to create a spec file of virtual dependencies for
+# each OS package.  I wish to only use tools which are installed in
+# the OS by default.
+
 
 PATH=/bin:/usr/bin:/sbin:/usr/sbin:/usr/ucb:/usr/bsd
 export PATH