scripts/rpmdiff.cgi

   1 #!/usr/bin/perl
   2
   3 # a web interface to 'cvs rdiff'.  This script makes it easy to query
   4 # the tags which are created by the build script.
   5
   6
   7 use CGI ':standard';
   8 use File::Basename;
   9 use File::stat;
  10 use Data::Dumper;
  11
  12 # the big datastructures are:
  13
  14 #    $RPM_FILE_BY_FQN{$fqn} is the full path rpm wich is discribed by the fqn
  15
  16 #    keys %SORTED_RECENT_FQN is the set of all package names
  17
  18 #    $SORTED_RECENT_FQN{$name} is an ordered list of the most recent
  19 #                                   versions of this package
  20
  21 # for a short time there are these datastrutures but they are large
  22 # and expensive to save to disk.
  23
  24
  25 # An rpm_package is a hash of:
  26 #     $package{'fqn'}="perl-5.00502-3"
  27 #     $package{'rpm_file'}="$RPMS_DIR/".
  28 #                "./sparc/perl-5.00502-3.solaris2.6-sparc.rpm"
  29 #     $package{'srpm_file'}="$SRPMS_DIR/".
  30 #                           "./perl-5.00502-3.src.rpm"
  31 #     $package{'name'}="perl"
  32 #     $package{'version'}="5.00502"
  33 #     $package{'release'}="3"
  34
  35 # fqn is "fully qualified name"
  36
  37 # while the $pkg structure exists we find the pkg we want by looking
  38 # it up in this structure.  This will hold many more packages then the
  39 # web page ever knows about.
  40 #       $BY_NAME{$name}{$version}{$release};
  41
  42
  43 sub usage {
  44
  45   # If they are asking for help then they are clueless so reset all
  46   # their parameters for them, in case they are in a bad state.
  47
  48   param(-name=>'Defaults', -value=>'on');
  49   my $rpmdiff_version = `rpmdiff --version`;
  50
  51   $usage =<<EOF;
  52
  53   $0          version: $VERSION
  54   $rpmdiff_version
  55
  56 This is a web interface into the rpmdiff command.
  57
  58 The user is requested to enter two different packages to diff after
  59 any one of the multiple submit buttons is pressed the difference will
  60 be the next webpage loaded.  For convenience each package name is
  61 listed once (in alphabetical order) and below it is checkbox of the
  62 most recent $MAX_PICK_LIST versions of this package.  Any pick list
  63 which is not actively picked by the user contains the string '(none)'.
  64
  65 The user should pick one package in the first column (this represents
  66 the "old package") and one package in the second column (this
  67 represents the "new package").  When the user wants to run the
  68 difference any 'submit' button can be pressed.  The multiple submit
  69 buttons are listed only for convenience to reduce hunting for a button
  70 on the page.
  71
  72 Error reporting is very minimal and if an incorrect number of packages
  73 is picked then the main page is displayed again.  It is suggested that
  74 the user hit the default button if any problems are encountered using
  75 the program.
  76
  77 Most users are only interested in differences in the contents of files
  78 and the contents of soft links.  The defaults for the program reflect
  79 this interest.  However sometimes users are also interested in changes
  80 in permissions or ownership.  Alternatively it may happen that a user
  81 is only interested in the set of files whose size changes and changes
  82 to files which keep the same size should be ignored.  To acomidate all
  83 possible uses we gave the user great flexibility in determining what
  84 set of changes are significant.  There is a pick list at the top of
  85 the main screen which displays the current criterion for a difference
  86 to be displayed.  A file which has changes made to properties which
  87 are not picked will not be considered different and will not be
  88 displayed.  Of special note the options:
  89
  90 help    will display the help screen for rpmdiff which contains an
  91         explanation of how to read the diff format.
  92
  93 all     will require that all differences are considered important.
  94         This is the same as checking all the boxes of differences
  95
  96 version will display the version of rpmdiff that is being used by
  97         this webpage.
  98
  99 The organization of the pick list page keeps the total number of
 100 packages hidden from the user.  The pick list page takes a long time
 101 to load because the number of choices is very large.  To save time the
 102 set of package pick lists is not regenerated each time the page is
 103 loaded.  There may have been new packages added to the package
 104 repository since the page was generated and these packages will not be
 105 displayed until the page is regenerated again.  The page will never be
 106 more then one day old.  If you need to use the latest contents of the
 107 package repository check the box at the bottom of the page marked
 108 "Flush Cache" this will increase the loading time of the page but
 109 ensure the freshness of the data.
 110
 111 EOF
 112     print pre($usage);
 113
 114   return ;
 115 }
 116
 117
 118 sub set_static_vars {
 119
 120 # This functions sets all the static variables which are often
 121 # configuration parameters.  Since it only sets variables to static
 122 # quantites it can not fail at run time. Some of these variables are
 123 # adjusted by parse_args() but asside from that none of these
 124 # variables are ever written to. All global variables are defined here
 125 # so we have a list of them and a comment of what they are for.
 126
 127
 128   $ARCHIVE = "/devel/java_repository";
 129   $RCS_REVISION = ' $Revision: 1.1 $ ';
 130
 131   @ORIG_ARGV= @ARGV;
 132
 133   # The pattern for parsing fqn into ($name, $version, $release).
 134   # This is difficult to parse since some hyphens are significant and
 135   # others are not, some packages have alphabetic characters in the
 136   # version number.
 137
 138   $PACKAGE_PAT ='(.*)-([^-]+)-([^-]+).solaris2.6-\w*.rpm';
 139
 140   # packages which will end up in the picklists  match this pattern
 141
 142   $PICKLIST_PAT = '/((htdocs)|(djava)|(devel))';
 143
 144   # only show the most recent packages
 145
 146   $MAX_PICK_LIST = 20;
 147
 148   # the list of allowable arguments to rpmdiff
 149
 150   @RPMDIFF_ARGS= qw(
 151                     version help all
 152                     size mode md5 dev link user group mtime
 153                    );
 154
 155   @RPMDIFF_ARGS_DEFAULT = qw(size md5 link);
 156
 157   # the list of  directories where rpms are stored
 158   @RPM_ARCHIVES = ('/net/master-mm/export/rpms/redhat',);
 159
 160   $CACHE_DIR = "/tmp/webtools";
 161
 162   # In an effort to make the cache update atomic we write to one file
 163   # name and only move it into the gobally known name when the whole
 164   # file is ready.
 165
 166   $TMP_CACHE_FILE= "$CACHE_DIR/rpmfiles.cache.$UID";
 167   $CACHE_FILE= "$CACHE_DIR/rpmfiles.cache";
 168
 169   # set a known path.
 170
 171   # the correct path has not been finalized yet, but this is close.
 172
 173   $ENV{'PATH'}= (
 174                  '/usr/local/bin'.
 175                  ':/usr/bin'.
 176                  ':/bin'.
 177                  ':/usr/apache/cgibins/cgi-forms'.
 178                  ':/tmp'.
 179                  '');
 180
 181   # taint perl requires we clean up these bad environmental
 182   # variables.
 183
 184   delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
 185
 186   return 1;
 187 } #set_static_vars
 188
 189
 190
 191
 192 sub get_env {
 193
 194 # this function sets variables similar to set_static variables.  This
 195 # function may fail only if the OS is in a very strange state.  after
 196 # we leave this function we should be all set up to give good error
 197 # handling, should things fail.
 198
 199   $| = 1;
 200   $PID = $$;
 201   $PROGRAM = basename($0);
 202   $TIME = time();
 203   $LOCALTIME = localtime($main::TIME);
 204   $START_TIME = $TIME;
 205
 206   {
 207     my ($sec,$min,$hour,$mday,$mon,
 208         $year,$wday,$yday,$isdst) =
 209           localtime(time());
 210
 211     # convert confusing perl time vars to what users expect
 212
 213     $year += 1900;
 214     $mon++;
 215
 216     $CVS_DATE_STR = sprintf("%02u/%02u/%02u", $mday, $mon, $year, );
 217     $TAG_DATE_STR = sprintf("%02u%02u%02u", $year, $mon, $mday, );
 218     $TIME_STR = sprintf("%02u%02u", $hour, $min);
 219   }
 220   # a unique id for cache file generation
 221   $UID = "$TAG_DATE_STR.$TIME_STR.$PID";
 222   $VERSION = 'NONE';
 223   if ( $RCS_REVISION =~ m/([.0-9]+)/ ) {
 224     $VERSION = $1;
 225   }
 226
 227   (-d $CACHE_DIR) ||
 228     mkdir($CACHE_DIR, 0664) ||
 229       die("Could not mkdir: $CACHE_DIR: $!\n");
 230
 231   return 1;
 232 } # get_env
 233
 234
 235
 236 sub parse_fqn {
 237
 238   # This is difficult to parse since some hyphens are significant and
 239   # others are not, some packages have alphabetic characters in the
 240   # version number.
 241
 242   # Also remember that the format of the file is dependent on how RPM
 243   # is configured so this may not be portable to all RPM users.
 244
 245   (!("@_" =~ m/^$PACKAGE_PAT$/)) &&
 246     die("rpm_package_name: '$@_' is not in a valid format");
 247
 248   return ($1, $2, $3);
 249 }
 250
 251
 252 sub new_rpm_package {
 253
 254 # An rpm_package is a hash of:
 255 #     $package{'fqn'}="perl-5.00502-3"
 256 #     $package{'rpm_file'}="$RPMS_DIR/".
 257 #                "./sparc/perl-5.00502-3.solaris2.6-sparc.rpm"
 258 #     $package{'srpm_file'}="$SRPMS_DIR/".
 259 #                           "./perl-5.00502-3.src.rpm"
 260 #     $package{'name'}="perl"
 261 #     $package{'version'}="5.00502"
 262 #     $package{'release'}="3"
 263
 264   my ($rpm_file) = @_;
 265   my $error = '';
 266   my($name, $version, $release) = main::parse_fqn(basename($rpm_file));
 267
 268   my ($package) = ();
 269
 270   $package->{'fqn'}="$name-$version-$release";
 271   $package->{'name'}=$name;
 272   $package->{'version'}=$version;
 273   $package->{'release'}=$release;
 274   $package->{'rpm_file'}=$rpm_file;
 275
 276   # these are needed to do proper sorting of major/minor numbers in
 277   # the version of the package
 278
 279   $package->{'version_cmp'}=[split(/\./, $version)];
 280   $package->{'release_cmp'}=[split(/\./, $release)];
 281
 282   return $package;
 283 }
 284
 285
 286 sub get_recent_fqn {
 287   my ($name) =(@_);
 288
 289   my @out = ();
 290
 291   foreach $version ( keys %{ $BY_NAME{$name} }) {
 292     foreach $release ( keys %{ $BY_NAME{$name}{$version} }) {
 293
 294       push @out, $BY_NAME{$name}{$version}{$release};
 295
 296     }
 297   }
 298
 299   # the $BY_NAME datastructure is fairly good but the list can not be
 300   # sorted right. Sort again using the Schwartzian Transform as
 301   # discribed in perlfaq4
 302
 303   my @sorted = sort {
 304
 305     # compare the versions but make no assumptions
 306     # about how many elements there are
 307
 308     my $i=0;
 309     my @a_version = @{ $a->{'version_cmp'} };
 310     my @b_version = @{ $b->{'version_cmp'} };
 311     while (
 312            ($#a_version > $i) &&
 313            ($#b_version > $i) &&
 314            ($a_version[$i] == $b_version[$i])
 315           ) {
 316       $i++;
 317     }
 318
 319     my $j = 0;
 320     my @a_release = @{ $a->{'release_cmp'} };
 321     my @b_release = @{ $b->{'release_cmp'} };
 322     while (
 323            ($#a_release > $j) &&
 324            ($#b_release > $j) &&
 325            ($a_release[$j] == $b_release[$j])
 326           ) {
 327       $j++;
 328     }
 329
 330     return (
 331             ($b_version[$i] <=> $a_version[$i])
 332             ||
 333             ($b_release[$j] <=> $a_release[$j])
 334            );
 335   }
 336   @out;
 337
 338   ($#sorted > $MAX_PICK_LIST) &&
 339     (@sorted = @sorted[0 .. $MAX_PICK_LIST]);
 340
 341   # dumping data to disk is expensive so we only save the data we
 342   # need.  Limit RPM_FILE_BY_FQN to only those packages which appear
 343   # in the picklist and this explains why we do not store the whole
 344   # pkg in a BY_FQN hash.
 345
 346   foreach $pkg (@sorted) {
 347     $RPM_FILE_BY_FQN{$pkg->{'fqn'}}=$pkg->{'rpm_file'}
 348   }
 349
 350   my @fqns = map { $_->{'fqn'} } @sorted;
 351
 352   return @fqns;
 353 }
 354
 355
 356
 357 sub parse_package_names {
 358
 359   $flush_cache = param("Flush Cache");
 360   if ( (!($flush_cache)) && (-e $CACHE_FILE) && ( -M $CACHE_FILE < 1 ) ) {
 361     my $st = stat($CACHE_FILE) ||
 362       die ("Could not stat: $CACHE_FILE: $!");
 363     $CACHE_LOCALTIME=localtime($st->mtime);
 364     require $CACHE_FILE;
 365     return ;
 366   }
 367
 368   $CACHE_LOCALTIME=$LOCALTIME;
 369
 370   foreach $archive (@RPM_ARCHIVES) {
 371
 372     open(FILES, "-|") ||
 373       exec("find", $archive, "-print") ||
 374         die("Could not run find. $!\n");
 375
 376     while ($filename = <FILES>) {
 377
 378       # we want only the binary rpm files of interest
 379
 380       ($filename =~ m/\.rpm$/) || next;
 381       ($filename =~ m/\.src\.rpm$/) && next;
 382       ($filename =~ m/$PICKLIST_PAT/) || next;
 383       chomp $filename;
 384
 385       $pkg = new_rpm_package($filename);
 386       $BY_NAME{$pkg->{'name'}}{$pkg->{'version'}}{$pkg->{'release'}} = $pkg;
 387
 388     }
 389
 390     close(FILES) ||
 391       die("Could not close find. $!\n");
 392
 393   }
 394
 395   foreach $group (keys %BY_NAME) {
 396     $SORTED_RECENT_FQN{$group} = [get_recent_fqn($group)];
 397
 398   }
 399
 400   open(FILE, ">$TMP_CACHE_FILE") ||
 401     die("Could not open filename: '$TMP_CACHE_FILE': $!\n");
 402
 403   print FILE "# cache file created by $0\n";
 404   print FILE "# at $LOCALTIME\n\n";
 405
 406   print FILE Data::Dumper->Dump( [\%RPM_FILE_BY_FQN,  \%SORTED_RECENT_FQN],
 407                                  ["SAVED_FQN", "SAVED_SORTED",], );
 408
 409   print FILE "\n\n";
 410   print FILE '%RPM_FILE_BY_FQN = %{ $SAVED_FQN };'."\n";
 411   print FILE '%SORTED_RECENT_FQN = %{ $SAVED_SORTED };'."\n";
 412   print FILE "1;\n";
 413
 414   close(FILE) ||
 415     die("Could not close filename: '$TMP_CACHE_FILE': $!\n");
 416
 417   # In an effort to make the cache update atomic we write to one file
 418   # name and only move it into the gobally known name when the whole
 419   # file is ready.
 420
 421   (!(-e $CACHE_FILE)) ||
 422     unlink($CACHE_FILE) ||
 423       die("Could not unlink $CACHE_FILE: $!\n");
 424
 425   rename($TMP_CACHE_FILE, $CACHE_FILE) ||
 426     die("Could not rename ($TMP_CACHE_FILE, $CACHE_FILE): $!\n");
 427
 428   return ;
 429 }
 430
 431
 432
 433
 434
 435 sub print_pkg_picklists {
 436
 437   print start_form;
 438   # create a set of picklists for the packages based on the package names.
 439
 440   print h3("Choose the criterion for a difference"),
 441   checkbox_group(
 442                  -name=>"rpmdiff arguments",
 443                  -value=>[ @RPMDIFF_ARGS ],
 444                  -default=>[ @RPMDIFF_ARGS_DEFAULT ],
 445                 ),p();
 446
 447   print h3("Choose one package in each column then hit any submit"),p();
 448
 449   my @rows = ();
 450
 451   foreach $name (sort keys %SORTED_RECENT_FQN) {
 452
 453     push @rows,
 454     # column A
 455     td(
 456        strong("$name "),
 457        p(),
 458        popup_menu(
 459                   -name=>"old$name",
 460                   -value=>[
 461                            '(none)',
 462                            @{ $SORTED_RECENT_FQN{$name} },
 463                           ],
 464                   -default=>'(none)',
 465                  ),
 466       ).
 467         # column B
 468         td(
 469            strong("$name "),
 470            p(),
 471            popup_menu(
 472                       -name=>"new$name",
 473                       -value=>[
 474                                '(none)',
 475                                @{ $SORTED_RECENT_FQN{$name} },
 476                               ],
 477                       -default=>'(none)',
 478                      ),
 479           ).
 480             td(
 481                defaults(-name=>'Defaults'),
 482                submit(-name=>'Submit'),
 483               ).
 484                 '';
 485   }
 486
 487   print table(Tr(\@rows));
 488
 489   my $footer_info=<<EOF;
 490
 491 Try 'rpmdiff --help' for information about what constitues a
 492 difference.  The output of rpmdiff is exactly the same as the output
 493 of rpm verify, 'rpm -V'.  The --help option documents the format of
 494 rpm verify and the format of rpmdiff and is a handy reference for this
 495 terse table.  rpmdiff is included in the devel-build-tools package.
 496
 497
 498 This web interface is for taking differences in the binary code.  To
 499 take differences of the binaries use <a href="cvs_tag_diff.cgi">'cvs tag diff'</a>.
 500
 501 EOF
 502
 503   print pre($footer_info);
 504
 505   print "This page generated with data cached at: $CACHE_LOCALTIME\n",p(),
 506         "The time is now: $LOCALTIME\n",p(),
 507         submit(-name=>"Flush Cache"),p(),
 508         submit(-name=>"Help Screen"),p();
 509
 510   print end_form;
 511
 512   return ;
 513 }
 514
 515
 516
 517 sub print_diff {
 518   my($oldpkg_file, $newpkg_file, @args) = @_;
 519
 520   my $cmd = "rpmdiff @args $oldpkg_file $newpkg_file 2>&1";
 521
 522   my $result = "\n".qx{$cmd}."\n";
 523   print pre($result);
 524
 525   return ;
 526 }
 527
 528
 529 #       Main
 530 {
 531
 532   set_static_vars();
 533   get_env();
 534
 535   parse_package_names();
 536
 537   my @picked_rpmdiff_args = param("rpmdiff arguments");
 538   @picked_rpmdiff_args = split(/\s+/,
 539                                '--'.(join(" --", @picked_rpmdiff_args)));
 540   push @picked_rpmdiff_args, '--';
 541
 542   foreach $name (sort keys %SORTED_RECENT_FQN) {
 543
 544     if ( (param("old$name")) && (param("old$name") ne "(none)") ) {
 545       push @picked_oldpkg, param("old$name");
 546     }
 547
 548     if ( (param("new$name")) && (param("new$name") ne "(none)") ) {
 549       push @picked_newpkg, param("new$name");
 550     }
 551
 552   }
 553
 554   print (header.
 555          start_html(-title=>'rpmdiff'),
 556          h2("rpmdiff"));
 557
 558   if (param("Help Screen")) {
 559
 560     usage();
 561
 562   } elsif ( grep {/^(\-\-)((help)|(version))$/} @picked_rpmdiff_args ) {
 563
 564     print_diff(
 565                '/dev/null',
 566                '/dev/null',
 567                @picked_rpmdiff_args,
 568               );
 569
 570   } elsif (
 571            ($#picked_oldpkg == 0) &&
 572            ($#picked_newpkg == 0)
 573           ) {
 574
 575     print_diff(
 576                $RPM_FILE_BY_FQN{$picked_oldpkg[0]},
 577                $RPM_FILE_BY_FQN{$picked_newpkg[0]},
 578                @picked_rpmdiff_args,
 579               );
 580
 581   } else {
 582
 583     print_pkg_picklists();
 584
 585     print end_html;
 586     print "\n\n\n";
 587   }
 588
 589 }
 590