home *** CD-ROM | disk | FTP | other *** search
/ PCMania 9 / Pcmania_Ep2_09_CD-Linux_Mandrake.iso / misc / mdkdischk < prev    next >
Encoding:
Text File  |  1999-11-04  |  10.8 KB  |  373 lines
  1. #!/usr/bin/perl
  2.  
  3. #- Mandrake Distribution Checking.
  4. #- Copyright (C) 1999 MandrakeSoft (fpons@mandrakesoft.com)
  5. #-
  6. #- This program is free software; you can redistribute it and/or modify
  7. #- it under the terms of the GNU General Public License as published by
  8. #- the Free Software Foundation; either version 2, or (at your option)
  9. #- any later version.
  10. #-
  11. #- This program is distributed in the hope that it will be useful,
  12. #- but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. #- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. #- GNU General Public License for more details.
  15. #-
  16. #- You should have received a copy of the GNU General Public License
  17. #- along with this program; if not, write to the Free Software
  18. #- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  19.  
  20. #- check a whole distribution RPMS, SRPMS, compss and contribs associated :
  21. #-   rpms dependancy check (including provides), script usage.
  22. #-   srpms checking with version.
  23. #-   contrib rpms dependancy check with rpms, script usage.
  24. #-   contrib srpms checkig with version.
  25. #-   compss checking, doublons, packages extension and size.
  26.  
  27. #- options are :
  28. #-   --rpms            : RPMS directory
  29. #-   --srpms           : SRPMS directory
  30. #-   --contrib-rpms    : contrib RPMS directory
  31. #-   --contrib-srpms   : contrib SRPMS directory
  32. #-   --compss          : compss file
  33. use strict qw(subs vars refs);
  34.  
  35. #- base RPM tags to take into account.
  36. my @rpmtags = qw(NAME VERSION RELEASE BUILDTIME SIZE COPYRIGHT ARCH);
  37. my $formats; $formats .= $_ . '=%{' . $_ . '}\\n' foreach @rpmtags;
  38.  
  39. #- passtest arrays (contains function for test).
  40. my @passtest = (
  41.         \&pass_get_rpms,
  42.         \&pass_check_compss,
  43.         \&pass_check_categories_in_compss,
  44.         \&pass_check_packages_in_compss,
  45.         \&pass_check_filenames,
  46.         \&pass_check_provides,
  47.         \&pass_check_requires,
  48.            );
  49.  
  50. #- get basename for a file.
  51. sub basename { $_[0] =~ /([^\/]*)$/ ? $1 : $_[0]; }
  52.  
  53. #- compare a version string.
  54. sub version_compare {
  55.     my ($a, $b) = @_;
  56.     local $_;
  57.  
  58.     while ($a && $b) {
  59.     my ($sb, $sa) =  map { $1 if $a =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D+)// } ($b, $a);
  60.     $_ = length($sa) cmp length($sb) || $sa cmp $sb and return $_;
  61.     }
  62. }
  63.  
  64. #- read information about a RPMS file.
  65. sub read_rpms_info {
  66.     my ($file) = @_;
  67.     
  68.     -f $file or die "cannot read $file";
  69.     local *F;
  70.     open F, "rpm -qp --queryformat \"$formats\" $file |" or die "cannot examine $file: $!";
  71.     { FILE => $file, map { /^(\w*)=(.*)$/ } <F> }
  72. }
  73.  
  74. #- check that NAME, VERSION, RELEASE, ARCH are coherent with package filename.
  75. sub check_rpms_info_from_filename {
  76.     my ($p) = @_;
  77.     my $s;
  78.     
  79.     if ($p->{FILE} =~ /([^\/]*?)-([^-]*)-([^-]*)\.([^-]*)\.rpm$/) {
  80.     do { $s .= ", " if $s;
  81.          $s .= "name($p->{NAME} and $1)" } if $p->{NAME} ne $1;
  82.     do { $s .= ", " if $s;
  83.          $s .= "version($p->{VERSION} and $2)" } if $p->{VERSION} ne $2;
  84.     do { $s .= ", " if $s;
  85.          $s .= "release($p->{RELEASE} and $3)" } if $p->{RELEASE} ne $3;
  86.     do { $s .= ", " if $s;
  87.          $s .= "arch($p->{ARCH} and $4)" } if $p->{ARCH} ne $4;
  88.     $s = "mismatch of $s on " . basename($p->{FILE}) if $s;
  89.     } else {
  90.     $s = "unable to parse filename " . basename($p->{FILE});
  91.     }
  92.     $s;
  93. }
  94.  
  95. #- pass function for getting all RPMS and simple checking.
  96. sub pass_get_rpms {
  97.     my ($o) = @_;
  98.     
  99.     $o->{c}->("read RPMS directory $o->{rpms}, simple package checking.");
  100.     -d $o->{rpms} or die "cannot read directory $o->{rpms}";
  101.     
  102.     local *D;
  103.     opendir D, $o->{rpms};
  104.     map {
  105.     my $p = read_rpms_info("$o->{rpms}/$_");
  106.     if ($p) {
  107.         if (exists $o->{PACKAGES}{$p->{NAME}}) {
  108.         $o->{cerr}->("package $p->{NAME} from " . basename($p->{FILE}) . " already defined in " . basename($o->{PACKAGES}{$p->{NAME}}{FILE}));
  109.         } else {
  110.         $o->{PACKAGES}{$p->{NAME}} = $p;
  111.         local $_ = check_rpms_info_from_filename($p);
  112.         $_ ? $o->{cwarn}->($_) : $o->{cok}->();
  113.         }
  114.     } else {
  115.         $o->{cerr}->("package from file $_ is unreadable");
  116.     }
  117.     } grep { /\.rpm$/ } readdir D;
  118. }
  119.  
  120. #- pass function for checking consistency of compss file
  121. sub pass_check_compss {
  122.     my ($o) = @_;
  123.  
  124.     $o->{c}->("read compss file, check consistency.");
  125.     return unless $o->{compss};
  126.     -r $o->{compss} or die "cannot read compss file $o->{compss}";
  127.  
  128.     my ($cat);
  129.     local *F;
  130.     open F, $o->{compss};
  131.     while (<F>) {
  132.     chomp;
  133.     if (/^([^\s]+)/) {
  134.         if ($o->{COMPSS}{$1}) {
  135.         $o->{cerr}->("multiple definition of category $1 at line $. in compss");
  136.         } else {
  137.         $o->{COMPSS}{$1} = {};
  138.         $cat = $1;
  139.         $o->{cok}->();
  140.         }
  141.     } elsif (/\s+([^\s]+)/ && defined $cat) {
  142.         if ($o->{PACKAGES}{$1}) {
  143.         $o->{PACKAGES}{$1}{COMPSS} ||= [];
  144.         if (exists $o->{COMPSS}{$cat}{$1}) {
  145.             $o->{cerr}->("multiple definition of package $1 in category $cat at line $. in compss");
  146.         } else {
  147.             $o->{COMPSS}{$cat}{$1} = undef;
  148.             push @{$o->{PACKAGES}{$1}{COMPSS}}, $o->{COMPSS}{$cat};
  149.             $o->{cok}->();
  150.         }
  151.         } else {
  152.         $o->{cwarn}->("undefined package $1 at line $. in compss");
  153.         }
  154.     } elsif (/^\s*$/) {
  155.         $cat = undef;
  156.         $o->{cok}->();
  157.     } else {
  158.         $o->{cerr}->("error at line $. in compss");
  159.     }
  160.     }
  161. }
  162.  
  163. #- search for categories in compss.
  164. sub pass_check_categories_in_compss {
  165.     my ($o) = @_;
  166.  
  167.     $o->{c}->("check for empty categories in compss file.");
  168.     return unless $o->{COMPSS};
  169.  
  170.     foreach (keys %{$o->{COMPSS}}) {
  171.     if ($o->{COMPSS}{$_}) {
  172.         $o->{cok}->();
  173.     } else {
  174.         $o->{cwarn}->("category $_ is empty in compss");
  175.     }
  176.     }
  177. }
  178.  
  179. #- search for package which have not been described in compss.
  180. sub pass_check_packages_in_compss {
  181.     my ($o) = @_;
  182.  
  183.     $o->{c}->("check all defined packages are referenced in compss file.");
  184.     return unless $o->{COMPSS};
  185.     
  186.     foreach (values %{$o->{PACKAGES}}) {
  187.     if ($_->{COMPSS}) {
  188.         $o->{cok}->();
  189.     } else {
  190.         $o->{cwarn}->("package $_->{NAME} is not in compss");
  191.     }
  192.     }
  193. }
  194.  
  195. #- pass function for filenames checking, avoiding doublons of different files.
  196. sub pass_check_filenames {
  197.     my ($o) = @_;
  198.     
  199.     $o->{c}->("check files of all RPMS, avoid multiple different definition of files.");
  200.     
  201.     foreach (values %{$o->{PACKAGES}}) {
  202.     my $p = $_;
  203.     my %files;
  204.     
  205.     local *F;
  206.     open F, "rpm -qpl --dump $p->{FILE} |" or die "cannot examine $p->{FILE}";
  207.     while (<F>) {
  208.         chomp;
  209.         my @d = split(/ /, $_);
  210.         my $k = join(' ', @d[3,4,5,6,10]);
  211.         if (exists $o->{FILENAMES}{$d[0]} && $o->{FILENAMES}{$d[0]}[1] ne $k) {
  212.         my $filenames = $files{basename($o->{FILENAMES}{$d[0]}[0]{FILE})} ||= [];
  213.         push @{$filenames}, $d[0];
  214.         } else {
  215.         $o->{FILENAMES}{$d[0]} = [$p, $k] unless exists $o->{FILENAMES}{$d[0]};
  216.         }
  217.     }
  218.     
  219.     #- print summary informations on conflicts.
  220.     if (%files) {
  221.         my $s = "conflict between " . basename($p->{FILE} . " ...");
  222.         foreach (keys %files) {
  223.         my @filenames = @{$files{$_}};
  224.         $s .= "\n        ... and $_ on ". scalar @filenames ." file(s)";
  225.         if (scalar @filenames < 10) {
  226.             $s .= ":";
  227.             foreach (@filenames) {
  228.             $s .= "\n          $_";
  229.             }
  230.         } else {
  231.             $s .= ".";
  232.         }
  233.         }
  234.         $o->{cerr}->($s);
  235.     } else {
  236.         $o->{cok}->();
  237.     }
  238.     }
  239. }
  240.  
  241. #- pass function for provides checking.
  242. sub pass_check_provides {
  243.     my ($o) = @_;
  244.     
  245.     $o->{c}->("check provides of all RPMS, check multiple provides.");
  246.     
  247.     foreach (values %{$o->{PACKAGES}}) {
  248.     my $p = $_;
  249.     my %files;
  250.  
  251.     local *F;
  252.     open F, "rpm -qp --provides $p->{FILE} |" or die "cannot examine $p->{FILE}";
  253.     while (<F>) {
  254.         chomp;
  255.         s/^(.*?)\s*$/$1/;
  256.         if (exists $o->{PROVIDES}{$_}) {
  257.         unless ($o->{MULTIPLE_PROVIDES}{$_}) {
  258.             $o->{MULTIPLE_PROVIDES}{$_} = 1;
  259.             $o->{PROVIDES}{$_} = [ $o->{PROVIDES}{$_} ];
  260.         }
  261.         $o->{MULTIPLE_PROVIDES}{$_}++;
  262.         push @{$o->{PROVIDES}{$_}}, $p;
  263.         } else {
  264.         $o->{PROVIDES}{$_} = $p;
  265.         }
  266.     }
  267.     }
  268.  
  269.     foreach (keys %{$o->{PROVIDES}}) {
  270.     if ($o->{MULTIPLE_PROVIDES}{$_}) {
  271.         my $s = "$_ is provided $o->{MULTIPLE_PROVIDES}{$_} times by :";
  272.         $s .= "\n          ". basename($_->{FILE}) foreach @{$o->{PROVIDES}{$_}};
  273.         $o->{cwarn}->($s);
  274.     } else {
  275.         $o->{cok}->();
  276.     }
  277.     }
  278. }
  279.  
  280. #- pass function for requires checking.
  281. sub pass_check_requires {
  282.     my ($o) = @_;
  283.     
  284.     $o->{c}->("check requires of all RPMS, check dependancies.");
  285.     
  286.     foreach (values %{$o->{PACKAGES}}) {
  287.     my $p = $_;
  288.     my %files;
  289.  
  290.     local *F;
  291.     open F, "rpm -qp --requires $p->{FILE} |" or die "cannot examine $p->{FILE}";
  292.     while (<F>) {
  293.         chomp;
  294.         s/\s*$//;
  295.         if (/^(.*?) (>|>=|=|<=|<) ([^-]*)(?:-(.*))?/) {
  296.         #- this is a require with a package name and version.
  297.         my ($name, $op, $version, $release) = ($1, $2, $3, $4);
  298.         $op = '==' if $op eq '=';
  299.  
  300.         if ($o->{PACKAGES}{$name}) {
  301.             my ($ins_version, $ins_release) = ($o->{PACKAGES}{$name}{VERSION}, $o->{PACKAGES}{$name}{RELEASE});
  302.             my $cmp_version = eval "version_compare(\"$ins_version\", \"$version\")" || 0;
  303.  
  304.             if (($release && $cmp_version == 0 && eval "version_compare(\"$ins_release\", \"$release\") $op 0") ||
  305.             eval "$cmp_version $op 0") {
  306.             $o->{cok}->();
  307.             } else {
  308.             $o->{cerr}->(basename($p->{FILE}) ." requires package $name with version $op $version".
  309.                      ($release && "-$release") .", only have ". $ins_version . ($release && "-$ins_release"));
  310.             }
  311.         } else {
  312.             $o->{cerr}->(basename($p->{FILE}) ." requires package $name which is not available.");
  313.         }
  314.         } else {
  315.         #- this is a require of a provide, package name or filename.
  316.         if ($o->{PROVIDES}{$_}) {
  317.             if ($o->{MULTIPLE_PROVIDES}{$_}) {
  318.             $o->{cwarn}->(basename($p->{FILE}) ." requires multiple provides $_");
  319.             } else {
  320.             $o->{cok}->();
  321.             }
  322.         } elsif ($o->{PACKAGES}{$_} || $o->{FILENAMES}{$_}) {
  323.             $o->{cok}->();
  324.         } else {
  325.             $o->{cerr}->(basename($p->{FILE}) ." requires property $_ which is not available.");
  326.         }
  327.         }
  328.     }
  329.     }
  330. }
  331.  
  332. #- main program.
  333. sub main {
  334.     my %o;
  335.     
  336.     while (@_) {
  337.     local $_ = shift;
  338.     $_ eq '--rpms' and do { $o{rpms} = shift; next };
  339.     $_ eq '--srpms' and do { $o{srpms} = shift; next };
  340.     $_ eq '--contrib-rpms' and do { $o{contrib_rpms} = shift; next };
  341.     $_ eq '--contrib-srpms' and do { $o{contrib_srpms} = shift; next };
  342.     $_ eq '--compss' and do { $o{compss} = shift; next };
  343.     die "usage: $0 --rpms <d> --srpms <d> --contrib-rpms <d> --contrib-srpms <d> --compss <f>";
  344.     }
  345.     
  346.     #- perform all test, $i is used for pass numbering.
  347.     print "Starting tests...";
  348.     my $i = 1;
  349.     foreach (@passtest) {
  350.     my ($count_ok, $count_warn, $count_err) = (0, 0, 0);
  351.     
  352.     $o{c} = sub { print "\nPASS$i: @_" if @_ };
  353.     $o{cok} = sub { ++$count_ok; print "\nPASS$i: @_" if @_ };
  354.     $o{cwarn} = sub { ++$count_warn; print "\nPASS$i: warning: @_" if @_ };
  355.     $o{cerr} = sub { ++$count_err; print "\nPASS$i: error: @_" if @_ };
  356.     
  357.     eval { &$_(\%o) };
  358.     if ($@) {
  359.         $o{c}->("exiting due to fatal: $@");
  360.         exit 1;
  361.     }
  362.     if ($count_ok < 0 || $count_warn < 0 || $count_err < 0) {
  363.         $o{c}->("fatal test result integrity, exiting.");
  364.         exit 1;
  365.     }
  366.     $o{c}->("completed [ok=$count_ok, warn=$count_warn, error=$count_err]\n");
  367.     ++$i;
  368.     }
  369. }
  370.  
  371. #- execute the tests.
  372. main(@ARGV);
  373.