aboutsummaryrefslogtreecommitdiffstats
path: root/distriblint
diff options
context:
space:
mode:
Diffstat (limited to 'distriblint')
-rwxr-xr-xdistriblint214
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);
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-22 00:37:15 +0000