diff options
| -rwxr-xr-x | distriblint | 214 |
1 files changed, 0 insertions, 214 deletions
diff --git a/distriblint b/distriblint deleted file mode 100755 index 1fae09c..0000000 --- a/distriblint +++ /dev/null @@ -1,214 +0,0 @@ -#!/usr/bin/perl - -#- Mandrakelinux Distribution Checker. -#- Copyright (C) 2002 MandrakeSoft (fpons@mandrakesoft.com) -#- -#- This program is free software; you can redistribute it and/or modify -#- it under the terms of the GNU General Public License as published by -#- the Free Software Foundation; either version 2, or (at your option) -#- any later version. -#- -#- This program is distributed in the hope that it will be useful, -#- but WITHOUT ANY WARRANTY; without even the implied warranty of -#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -#- GNU General Public License for more details. -#- -#- You should have received a copy of the GNU General Public License -#- along with this program; if not, write to the Free Software -#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -#- check a whole distribution RPMS, SRPMS, compss and contribs associated : -#- rpms dependancy check (including provides), script usage. -#- srpms checking with version. -#- contrib rpms dependancy check with rpms, script usage. -#- contrib srpms checkig with version. -#- compss checking, doublons, packages extension and size. - -#- options are : -#- --distrib : distribution top directory. -use strict qw(subs vars refs); - -#- passtest arrays (contains function for test). -my @passtest = ( - \&pass_get_hdlists, - \&pass_check_filenames, - \&pass_check_requires, - ); - -#- pass function for getting all package and simple checking. -sub pass_get_hdlists { - my ($o) = @_; - - $o->{c}->("parsing hdlists from distrib $o->{root}."); - local *F; - open F, "$o->{root}/media/media_info/hdlists" or die "unable to open $o->{root}/media/media_info/hdlists"; - foreach (<F>) { - chomp; - s/\s*#.*$//; - /^\s*$/ and next; - /^(?:askmedia|suppl)/ and next; - m/^\s*(?:noauto:)?(hdlist\S*\.cz2?)\s+(\S+)\s*(.*)$/ or die "invalid hdlist description \"$_\" in hdlists file"; - - push @{$o->{hdlists}}, { synthesis => "$o->{root}/media/media_info/synthesis.$1", - hdlist => "$o->{root}/media/media_info/$1", - dir => $2, - descr => $3 }; - } - close F; - - foreach (@{$o->{hdlists}}) { - $o->{c}->("parsing hdlist $_->{hdlist}."); - ($_->{start}, $_->{end}) = $o->parse_hdlist($_->{hdlist}); - } - - $o->{c}->("found " . scalar(@{$o->{depslist}}) . " packages."); - - #- now the real works, check no more than one package is listed. - #- use provides access to simplify. - foreach my $pkg (@{$o->{depslist}}) { - my ($self_found, $name_found) = (0, 0); - foreach (keys %{$o->{provides}{$pkg->name}}) { - my $p = $o->{depslist}[$_]; - $p == $pkg and ++$self_found; - $p->name eq $pkg->name and ++$name_found; - } - if ($self_found == 1 && $name_found == 1) { - $o->{cok}->(); - } else { - $o->{cwarn}->("package ".$pkg->fullname." has same name as other packages."); - } - } -} - -#- pass function for filenames checking, avoiding doublons of different files. -sub pass_check_filenames { - my ($o) = @_; - - $o->{c}->("check files of all packages, avoid multiple different definition of files without conflicts."); - - foreach my $pkg (@{$o->{depslist}}) { - my %files; - - my @files = $pkg->files; - my @md5sums = $pkg->files_md5sum; - my @modes = $pkg->files_mode; - my @sizes = $pkg->files_size; - my @owners = $pkg->files_owner; - my @groups = $pkg->files_group; - - foreach (0 .. $#files) { - my $file = $files[$_]; - my $key = join ' ', $md5sums[$_], $modes[$_], $sizes[$_], $owners[$_], $groups[$_]; - my ($existing_id, $existing_key) = $o->{files}{$file} =~ /([^:]*):(.*)/; - if (exists $o->{files}{$file} && $existing_key ne $key) { - #- check if package is marked as conflicting with this one. - #- if this is the case, everything is right, else complains... - my $p = $o->{depslist}[$existing_id]; - my $ok = 0; - - my $provide_p = $p->name." == ".$p->epoch.":".$p->version."-".$p->release; - foreach ($pkg->conflicts) { - URPM::ranges_overlap($provide_p, $_) and $ok = 1, last; - } - - my $provide_pkg = $pkg->name." == ".$pkg->epoch.":".$pkg->version."-".$pkg->release; - foreach ($p->conflicts) { - URPM::ranges_overlap($provide_pkg, $_) and $ok = 1, last; - } - - $ok or push @{$files{$p->fullname}}, $file; #- conflicting package name is used. - } else { - $o->{files}{$file} = $pkg->id . ':' . $key unless exists $o->{files}{$file}; - } - } - - #- print summary informations on conflicts. - if (%files) { - my $s = "conflict between ".$pkg->fullname." ..."; - foreach (keys %files) { - my @filenames = @{$files{$_}}; - $s .= "\n ... and $_ on ". scalar @filenames ." file(s)"; - if (scalar @filenames < 10) { - $s .= ":"; - foreach (@filenames) { - $s .= "\n $_"; - } - } else { - $s .= "."; - } - } - $o->{cerr}->($s); - } else { - $o->{cok}->(); - } - } -} - -#- pass function for requires checking, at least one provide should be allowed. -sub pass_check_requires { - my ($o) = @_; - - $o->{c}->("check requires of all packages, avoid unresolved."); - - foreach my $pkg (@{$o->{depslist}}) { - foreach ($pkg->requires) { - if (my ($property, $name) = /^(([^\s\[]*).*)/) { - my $ok = 0; - foreach my $id (keys %{$o->{provides}{$name} || {}}) { - my $p = $o->{depslist}[$id]; - foreach ($p->provides) { - URPM::ranges_overlap($_, $property) and ++$ok; - } - } - #- for files, check directly into files created by above test. - exists $o->{files}{$name} and ++$ok; - if ($ok) { - $o->{cok}->(); - } else { - $o->{cerr}->($pkg->fullname." has unresolved require [$property]."); - } - } else { - $o->{cerr}->($pkg->fullname." has non parseable require [$_]."); - } - } - } -} - -#- main program. -sub main { - require URPM; - my $o = new URPM; - - while (@_) { - local $_ = shift; - $_ eq '--distrib' and do { $o->{root} = shift; next }; - die "usage: $0 --distrib <d>"; - } - - #- perform all tests, $i is used for pass numbering. - print "Starting tests..."; - my $i = 1; - foreach (@passtest) { - my ($count_ok, $count_warn, $count_err) = (0, 0, 0); - - $o->{c} = sub { print "\nPASS$i: @_" if @_ }; - $o->{cok} = sub { ++$count_ok; print "\nPASS$i: @_" if @_ }; - $o->{cwarn} = sub { ++$count_warn; print "\nPASS$i: warning: @_" if @_ }; - $o->{cerr} = sub { ++$count_err; print "\nPASS$i: error: @_" if @_ }; - - eval { &$_($o) }; - if ($@) { - $o->{c}->("exiting due to fatal: $@"); - exit 1; - } - if ($count_ok < 0 || $count_warn < 0 || $count_err < 0) { - $o->{c}->("fatal test result integrity, exiting."); - exit 1; - } - $o->{c}->("completed [ok=$count_ok, warn=$count_warn, error=$count_err]\n"); - ++$i; - } -} - -#- execute the tests. -main(@ARGV); |