#!/usr/bin/perl

# a web interface to 'cvs rdiff'.  This script makes it easy to query
# the tags which are created by the build script.


use CGI ':standard';
use File::Basename;
use File::stat;
use Data::Dumper;

# the big datastructures are:

#    $RPM_FILE_BY_FQN{$fqn} is the full path rpm wich is discribed by the fqn

#    keys %SORTED_RECENT_FQN is the set of all package names

#    $SORTED_RECENT_FQN{$name} is an ordered list of the most recent
#				    versions of this package

# for a short time there are these datastrutures but they are large
# and expensive to save to disk.


# 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"

# while the $pkg structure exists we find the pkg we want by looking
# it up in this structure.  This will hold many more packages then the
# web page ever knows about.
#	$BY_NAME{$name}{$version}{$release};


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 = `rpmdiff --version`;

  $usage =<<EOF;

  $0          version: $VERSION
  $rpmdiff_version

This is a web interface into the rpmdiff command.

The user is requested to enter two different packages to diff after
any one of the multiple submit buttons is pressed the difference will
be the next webpage loaded.  For convenience each package name is
listed once (in alphabetical order) and below it is checkbox of the
most recent $MAX_PICK_LIST versions of this package.  Any pick list
which is not actively picked by the user contains the string '(none)'.

The user should pick one package in the first column (this represents
the "old package") and one package in the second column (this
represents the "new package").  When the user wants to run the
difference any 'submit' button can be pressed.  The multiple submit
buttons are listed only for convenience to reduce hunting for a button
on the page.

Error reporting is very minimal and if an incorrect number of packages
is picked then the main page is displayed again.  It is suggested that
the user hit the default button if any problems are encountered using
the program.

Most users are only interested in differences in the contents of files
and the contents of soft links.  The defaults for the program reflect
this interest.  However sometimes users are also interested in changes
in permissions or ownership.  Alternatively it may happen that a user
is only interested in the set of files whose size changes and changes
to files which keep the same size should be ignored.  To acomidate all
possible uses we gave the user great flexibility in determining what
set of changes are significant.  There is a pick list at the top of
the main screen which displays the current criterion for a difference
to be displayed.  A file which has changes made to properties which
are not picked will not be considered different and will not be
displayed.  Of special note the options:

help	will display the help screen for rpmdiff which contains an
	explanation of how to read the diff format.

all	will require that all differences are considered important.
	This is the same as checking all the boxes of differences

version will display the version of rpmdiff that is being used by
	this webpage.

The organization of the pick list page keeps the total number of
packages hidden from the user.  The pick list page takes a long time
to load because the number of choices is very large.  To save time the
set of package pick lists is not regenerated each time the page is
loaded.  There may have been new packages added to the package
repository since the page was generated and these packages will not be
displayed until the page is regenerated again.  The page will never be
more then one day old.  If you need to use the latest contents of the
package repository check the box at the bottom of the page marked
"Flush Cache" this will increase the loading time of the page but
ensure the freshness of the data.

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.


  $ARCHIVE = "/devel/java_repository";
  $RCS_REVISION = ' $Revision: 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 picklists  match this pattern

  $PICKLIST_PAT = '/((htdocs)|(djava)|(devel))';

  # only show the most recent packages
  
  $MAX_PICK_LIST = 20;

  # the list of allowable arguments to rpmdiff

  @RPMDIFF_ARGS= qw(
		    version help all 
		    size mode md5 dev link user group mtime 
		   );

  @RPMDIFF_ARGS_DEFAULT = qw(size md5 link);

  # the list of  directories where rpms are stored
  @RPM_ARCHIVES = ('/net/master-mm/export/rpms/redhat',);

  $CACHE_DIR = "/tmp/webtools"; 

  # In an effort to make the cache update atomic we write to one file
  # name and only move it into the gobally known name when the whole
  # file is ready.

  $TMP_CACHE_FILE= "$CACHE_DIR/rpmfiles.cache.$UID"; 
  $CACHE_FILE= "$CACHE_DIR/rpmfiles.cache"; 
 
  # 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'.
		 ':/tmp'.
		 '');
  
  # 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++;
    
    $CVS_DATE_STR = sprintf("%02u/%02u/%02u", $mday, $mon, $year, );
    $TAG_DATE_STR = sprintf("%02u%02u%02u", $year, $mon, $mday, );
    $TIME_STR = sprintf("%02u%02u", $hour, $min);
  }
  # a unique id for cache file generation
  $UID = "$TAG_DATE_STR.$TIME_STR.$PID";
  $VERSION = 'NONE';
  if ( $RCS_REVISION =~ m/([.0-9]+)/ ) {
    $VERSION = $1;
  }

  (-d $CACHE_DIR) ||
    mkdir($CACHE_DIR, 0664) ||
      die("Could not mkdir: $CACHE_DIR: $!\n");

  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)]; 

  return $package;
}


sub get_recent_fqn {
  my ($name) =(@_);

  my @out = ();

  foreach $version ( keys %{ $BY_NAME{$name} }) {
    foreach $release ( keys %{ $BY_NAME{$name}{$version} }) {

      push @out, $BY_NAME{$name}{$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;
  
  ($#sorted > $MAX_PICK_LIST) &&
    (@sorted = @sorted[0 .. $MAX_PICK_LIST]);

  # dumping data to disk is expensive so we only save the data we
  # need.  Limit RPM_FILE_BY_FQN to only those packages which appear
  # in the picklist and this explains why we do not store the whole
  # pkg in a BY_FQN hash.

  foreach $pkg (@sorted) {
    $RPM_FILE_BY_FQN{$pkg->{'fqn'}}=$pkg->{'rpm_file'}
  }

  my @fqns = map { $_->{'fqn'} } @sorted;

  return @fqns;  
}



sub parse_package_names {

  $flush_cache = param("Flush Cache");
  if ( (!($flush_cache)) && (-e $CACHE_FILE) && ( -M $CACHE_FILE < 1 ) ) {
    my $st = stat($CACHE_FILE) ||
      die ("Could not stat: $CACHE_FILE: $!");
    $CACHE_LOCALTIME=localtime($st->mtime);
    require $CACHE_FILE;
    return ;
  }

  $CACHE_LOCALTIME=$LOCALTIME;

  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;
      chomp $filename;

      $pkg = new_rpm_package($filename);
      $BY_NAME{$pkg->{'name'}}{$pkg->{'version'}}{$pkg->{'release'}} = $pkg;

    }

    close(FILES) || 
      die("Could not close find. $!\n");
    
  }

  foreach $group (keys %BY_NAME) {
    $SORTED_RECENT_FQN{$group} = [get_recent_fqn($group)];

  }

  open(FILE, ">$TMP_CACHE_FILE") ||
    die("Could not open filename: '$TMP_CACHE_FILE': $!\n");

  print FILE "# cache file created by $0\n";
  print FILE "# at $LOCALTIME\n\n";

  print FILE Data::Dumper->Dump( [\%RPM_FILE_BY_FQN,  \%SORTED_RECENT_FQN],
				 ["SAVED_FQN", "SAVED_SORTED",], );

  print FILE "\n\n";
  print FILE '%RPM_FILE_BY_FQN = %{ $SAVED_FQN };'."\n";
  print FILE '%SORTED_RECENT_FQN = %{ $SAVED_SORTED };'."\n";
  print FILE "1;\n";

  close(FILE) ||
    die("Could not close filename: '$TMP_CACHE_FILE': $!\n");

  # In an effort to make the cache update atomic we write to one file
  # name and only move it into the gobally known name when the whole
  # file is ready.

  (!(-e $CACHE_FILE)) ||
    unlink($CACHE_FILE) ||
      die("Could not unlink $CACHE_FILE: $!\n");

  rename($TMP_CACHE_FILE, $CACHE_FILE) ||
    die("Could not rename ($TMP_CACHE_FILE, $CACHE_FILE): $!\n");

  return ;
}





sub print_pkg_picklists {

  print start_form;  
  # create a set of picklists for the packages based on the package names.

  print h3("Choose the criterion for a difference"),
  checkbox_group( 
		 -name=>"rpmdiff arguments",
		 -value=>[ @RPMDIFF_ARGS ],
		 -default=>[ @RPMDIFF_ARGS_DEFAULT ],
		),p();
    
  print h3("Choose one package in each column then hit any submit"),p();
  
  my @rows = ();
  
  foreach $name (sort keys %SORTED_RECENT_FQN) {
    
    push @rows,
    # column A
    td(
       strong("$name "),
       p(),
       popup_menu( 
		  -name=>"old$name",
		  -value=>[
			   '(none)', 
			   @{ $SORTED_RECENT_FQN{$name} },
			  ],
		  -default=>'(none)',
		 ),
      ).
	# column B
	td(
	   strong("$name "),
	   p(),
	   popup_menu( 
		      -name=>"new$name",
		      -value=>[
			       '(none)', 
			       @{ $SORTED_RECENT_FQN{$name} },
			      ],
		      -default=>'(none)',
		     ),
	  ).
	    td(
	       defaults(-name=>'Defaults'),
	       submit(-name=>'Submit'),
	      ).
		'';
  }
  
  print table(Tr(\@rows));

  my $footer_info=<<EOF;

Try 'rpmdiff --help' for information about what constitues a
difference.  The output of rpmdiff is exactly the same as the output
of rpm verify, 'rpm -V'.  The --help option documents the format of
rpm verify and the format of rpmdiff and is a handy reference for this
terse table.  rpmdiff is included in the devel-build-tools package.


This web interface is for taking differences in the binary code.  To
take differences of the binaries use <a href="cvs_tag_diff.cgi">'cvs tag diff'</a>.  

EOF

  print pre($footer_info);

  print "This page generated with data cached at: $CACHE_LOCALTIME\n",p(),
        "The time is now: $LOCALTIME\n",p(),
        submit(-name=>"Flush Cache"),p(),
        submit(-name=>"Help Screen"),p();

  print end_form;  

  return ;
}



sub print_diff {
  my($oldpkg_file, $newpkg_file, @args) = @_;

  my $cmd = "rpmdiff @args $oldpkg_file $newpkg_file 2>&1";

  my $result = "\n".qx{$cmd}."\n";
  print pre($result);

  return ;
}


#       Main        
{

  set_static_vars();
  get_env();

  parse_package_names();

  my @picked_rpmdiff_args = param("rpmdiff arguments");
  @picked_rpmdiff_args = split(/\s+/, 
			       '--'.(join(" --", @picked_rpmdiff_args)));
  push @picked_rpmdiff_args, '--';
 
  foreach $name (sort keys %SORTED_RECENT_FQN) {
    
    if ( (param("old$name")) && (param("old$name") ne "(none)") ) {
      push @picked_oldpkg, param("old$name");
    }
    
    if ( (param("new$name")) && (param("new$name") ne "(none)") ) {
      push @picked_newpkg, param("new$name");
    }
    
  }

  print (header.
	 start_html(-title=>'rpmdiff'),
	 h2("rpmdiff"));
  
  if (param("Help Screen")) {

    usage();

  } elsif ( grep {/^(\-\-)((help)|(version))$/} @picked_rpmdiff_args ) {
       
    print_diff(
	       '/dev/null', 
	       '/dev/null', 
	       @picked_rpmdiff_args, 
	      );
    
  } elsif (
	   ($#picked_oldpkg == 0) &&
	   ($#picked_newpkg == 0)
	  ) {
    
    print_diff(
	       $RPM_FILE_BY_FQN{$picked_oldpkg[0]}, 
	       $RPM_FILE_BY_FQN{$picked_newpkg[0]}, 
	       @picked_rpmdiff_args, 
	      );
    
  } else {

    print_pkg_picklists();

    print end_html;
    print "\n\n\n";
  }

}