home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / boot / i386 / rescue / usr / lib / rpm / rpmdiff.cgi < prev    next >
Text File  |  2006-11-29  |  16KB  |  591 lines
  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.  
  591.