diff options
Diffstat (limited to 'lib/Youri/Submit/Check')
-rw-r--r-- | lib/Youri/Submit/Check/ACL.pm | 71 | ||||
-rw-r--r-- | lib/Youri/Submit/Check/History.pm | 61 | ||||
-rw-r--r-- | lib/Youri/Submit/Check/Host.pm | 63 | ||||
-rw-r--r-- | lib/Youri/Submit/Check/Precedence.pm | 58 | ||||
-rw-r--r-- | lib/Youri/Submit/Check/Queue_recency.pm | 40 | ||||
-rw-r--r-- | lib/Youri/Submit/Check/Recency.pm | 46 | ||||
-rw-r--r-- | lib/Youri/Submit/Check/Rpmlint.pm | 89 | ||||
-rw-r--r-- | lib/Youri/Submit/Check/SVN.pm | 79 | ||||
-rw-r--r-- | lib/Youri/Submit/Check/Section.pm | 58 | ||||
-rw-r--r-- | lib/Youri/Submit/Check/Source.pm | 45 | ||||
-rw-r--r-- | lib/Youri/Submit/Check/Tag.pm | 61 | ||||
-rw-r--r-- | lib/Youri/Submit/Check/Type.pm | 54 | ||||
-rw-r--r-- | lib/Youri/Submit/Check/Version.pm | 100 |
13 files changed, 0 insertions, 825 deletions
diff --git a/lib/Youri/Submit/Check/ACL.pm b/lib/Youri/Submit/Check/ACL.pm deleted file mode 100644 index 34bf48a..0000000 --- a/lib/Youri/Submit/Check/ACL.pm +++ /dev/null @@ -1,71 +0,0 @@ -# $Id$ -package Youri::Submit::Check::ACL; - -=head1 NAME - -Youri::Submit::Check::Tag - Incorrect tag values check - -=head1 DESCRIPTION - -This check plugin rejects packages with incorrect tag values, based on regular -expressions. - -=cut - -use strict; -use Carp; -use base qw/Youri::Submit::Check/; -my $acl; - -sub _init { - my $self = shift; - my %options = ( - acl_file => '', - @_ - ); - $acl = get_acl($options{acl_file}); -} - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - my $file = $package->get_full_name(); - my $arch = $package->get_arch(); - my $srpm = $package->get_canonical_name; - my $section = $repository->_get_section($package, $target, $define); - my $user = $define->{user}; - foreach my $t (keys %$acl) { - next if $target !~ /$t/; - foreach my $acl (@{$acl->{$t}}) { - my ($a, $media, $r, $users) = @$acl; - next if $arch !~ $a || $srpm !~ $r || $section !~ $media; - if ($user =~ /$users/) { - return - } else { - return "$user is not authorized to upload packages belonging to $srpm in section $section (authorized persons: " . join(', ', split '\|', $users) . ")"; - } - } - } - return -} - -sub get_acl { - my ($file) = @_; - my %acl; - open my $f, $file; - while (<$f>) { - my ($dis, $arch, $media, $regexp, $users) = split ' '; - push @{$acl{$dis}}, [ $arch , $media, $regexp, $users ] - } - \%acl -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, YOURI project - -This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Youri/Submit/Check/History.pm b/lib/Youri/Submit/Check/History.pm deleted file mode 100644 index 326f2f1..0000000 --- a/lib/Youri/Submit/Check/History.pm +++ /dev/null @@ -1,61 +0,0 @@ -# $Id$ -package Youri::Submit::Check::History; - -=head1 NAME - -Youri::Submit::Check::History - Non-linear history check - -=head1 DESCRIPTION - -This check plugin rejects packages whose history does not include last -available revision one. - -=cut - -use warnings; -use strict; -use Carp; -use Youri::Package; -use base qw/Youri::Submit::Check/; - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - my @errors; - - my $last_revision = - $repository->get_last_older_revision($package, $target, $define); - - if ($last_revision) { - # skip the test if last revision has been produced from another source package, as it occurs during package split/merges - return - if $last_revision->get_canonical_name() - ne $package->get_canonical_name(); - - my ($last_revision_number) = $last_revision->get_last_change()->[Youri::Package::CHANGE_AUTHOR] =~ /(\S+)\s*$/; - my %entries = - map { $_ => 1 } - map { /(\S+)\s*$/ } - map { $_->[Youri::Package::CHANGE_AUTHOR] } - $package->get_changes(); - unless ($entries{$last_revision_number}) { - push( - @errors, - "Last changelog entry $last_revision_number from last revision " . $last_revision->get_full_name() . " missing from current changelog" - ); - } - } - - return @errors; -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, YOURI project - -This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Youri/Submit/Check/Host.pm b/lib/Youri/Submit/Check/Host.pm deleted file mode 100644 index b2b392a..0000000 --- a/lib/Youri/Submit/Check/Host.pm +++ /dev/null @@ -1,63 +0,0 @@ -# $Id$ -package Youri::Submit::Check::Host; - -=head1 NAME - -Youri::Submit::Check::Tag - Incorrect tag values check - -=head1 DESCRIPTION - -This check plugin rejects packages with incorrect tag values, based on regular -expressions. - -=cut - -use strict; -use Carp; -use base qw/Youri::Submit::Check/; -my $host; - -sub _init { - my $self = shift; - my %options = ( - host_file => '', - @_ - ); - $host = get_host($options{host_file}) -} - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - my $file = $package->get_file; - my $arch = $package->get_arch; - my $buildhost = $package->as_formated_string('%{buildhost}'); - foreach my $h (keys %$host) { - next if $buildhost !~ $h; - if ($arch =~ $host->{$h}) { - return - } - } - "Packages build on host $buildhost are not authorized"; -} - -sub get_host { - my ($file) = @_; - my %host; - open my $f, $file; - while (<$f>) { - my ($host, $arch) = split ' '; - $host{$host} = $arch - } - \%host -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, YOURI project - -This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Youri/Submit/Check/Precedence.pm b/lib/Youri/Submit/Check/Precedence.pm deleted file mode 100644 index c73446b..0000000 --- a/lib/Youri/Submit/Check/Precedence.pm +++ /dev/null @@ -1,58 +0,0 @@ -# $Id$ -package Youri::Submit::Check::Precedence; - -=head1 NAME - -Youri::Submit::Check::Precedence - Release check against another check - -=head1 DESCRIPTION - -This check plugin rejects packages whose an older revision already exists for -another upload target. - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Check/; - -sub _init { - my $self = shift; - my %options = ( - _target => undef, # mandatory targets - @_ - ); - - die "undefined target" unless $options{target}; - - $self->{_target} = $options{target}; -} - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - my @errors; - - my @older_revisions = - $repository->get_older_revisions($package, $self->{_target}, $define); - if (@older_revisions) { - push( - @errors, - "Older revisions still exists for $self->{_target}: " . join(', ', @older_revisions) - ); - } - - return @errors; -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, YOURI project - -This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Youri/Submit/Check/Queue_recency.pm b/lib/Youri/Submit/Check/Queue_recency.pm deleted file mode 100644 index 42c4f42..0000000 --- a/lib/Youri/Submit/Check/Queue_recency.pm +++ /dev/null @@ -1,40 +0,0 @@ -# $Id$ -package Youri::Submit::Check::Queue_recency; - -=head1 NAME - -Youri::Submit::Check::Recency - Release check against current target - -=head1 DESCRIPTION - -This check plugin rejects packages whose a current or newer revision already -exists for current upload target. - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Check/; - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - my @newer_revisions = - $repository->get_upload_newer_revisions($package, $target, $define); - if (@newer_revisions) { - return "Newer revisions already exists for $target in upload queue: " . join(', ', @newer_revisions); - } - return -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, YOURI project - -This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Youri/Submit/Check/Recency.pm b/lib/Youri/Submit/Check/Recency.pm deleted file mode 100644 index f8aa5b7..0000000 --- a/lib/Youri/Submit/Check/Recency.pm +++ /dev/null @@ -1,46 +0,0 @@ -# $Id$ -package Youri::Submit::Check::Recency; - -=head1 NAME - -Youri::Submit::Check::Recency - Release check against current target - -=head1 DESCRIPTION - -This check plugin rejects packages whose a current or newer revision already -exists for current upload target. - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Check/; - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - my @errors; - - my @revisions = $repository->get_revisions($package, $target, $define, undef, sub { return $_[0]->compare($package) >= 0 }); - if (@revisions) { - push( - @errors, - "Current or newer revision(s) already exists for $target: " . - join(', ', @revisions) - ); - } - - return @errors; -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, YOURI project - -This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Youri/Submit/Check/Rpmlint.pm b/lib/Youri/Submit/Check/Rpmlint.pm deleted file mode 100644 index a38f2ba..0000000 --- a/lib/Youri/Submit/Check/Rpmlint.pm +++ /dev/null @@ -1,89 +0,0 @@ -# $Id$ -package Youri::Submit::Check::Rpmlint; - -=head1 NAME - -Youri::Submit::Check::Rpmlint - Rpmlint-based check - -=head1 DESCRIPTION - -This check plugin wraps rpmlint, and reject packages triggering results -declared as fatal. - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Check/; - -=head2 new(%args) - -Creates and returns a new Youri::Submit::Check::Rpmlint object. - -Specific parameters: - -=over - -=item results $results - -List of rpmlint result id considered as fatal. - -=item path $path - -Path to the rpmlint executable (default: /usr/bin/rpmlint) - -=item config $config - -Specific rpmlint configuration. - -=back - -=cut - - -sub _init { - my $self = shift; - my %options = ( - results => undef, - path => '/usr/bin/rpmlint', - config => '', - @_ - ); - - croak "no results to check" unless $options{results}; - croak "fatal should be an arrayref" unless ref $options{results} eq 'ARRAY'; - - $self->{_config} = $options{config}; - $self->{_path} = $options{path}; - $self->{_pattern} = '^(?:' . join('|', @{$options{results}}) . ')$'; -} - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - my @errors; - - my $command = "$self->{_path} -f $self->{_config} " . $package->as_file(); - open(RPMLINT, "$command |") or die "Can't run $command: $!"; - while (my $line = <RPMLINT>) { - my ($id, $value) = $line =~ /^[EW]: \S+ (\S+)(.*)$/; - $id or next; - if ($id =~ /$self->{_pattern}/o) { - push(@errors, "$id$value"); - } - } - - return @errors; -} -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, YOURI project - -This program is free software; you can redistribute it and/or modify it under -the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Youri/Submit/Check/SVN.pm b/lib/Youri/Submit/Check/SVN.pm deleted file mode 100644 index 10ab810..0000000 --- a/lib/Youri/Submit/Check/SVN.pm +++ /dev/null @@ -1,79 +0,0 @@ -# $Id$ -package Youri::Submit::Check::SVN; - -=head1 NAME - -Youri::Submit::Check::Tag - Incorrect tag values check - -=head1 DESCRIPTION - -This check plugin rejects packages with incorrect tag values, based on regular -expressions. - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Check/; - -sub _init { - my $self = shift; - my %options = ( - svn => '', - @_ - ); - $self->{_svn} = $options{svn}; -} - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - my $section = $repository->_get_section($package, $target, $define); - if ($section =~ /\/(testing|backport)$/) { - # FIXME, right now ignore packages in SVN for testing and backports - # we need to find a clean way to handle them - return - } - - $package->is_source or return; - my $file = $package->get_file_name; - my $srpm_name = $package->get_canonical_name; - if ($repository->package_in_svn($srpm_name)) { - if ($file !~ /(^|\/|$define->{prefix}_)@\d+:\Q$srpm_name/) { - return "package $srpm_name is in the SVN, the uploaded SRPM must look like @<svn rev>:$srpm_name-<version>-<release>.src.rpm (created with getsrpm-mdk $srpm_name)"; - } else { - print "Package $file is correct\n"; - } - } - return -} - -sub simple_prompt { - my $cred = shift; - my $realm = shift; - my $default_username = shift; - my $may_save = shift; - my $pool = shift; - - print "Enter authentication info for realm: $realm\n"; - print "Username: "; - my $username = <>; - chomp($username); - $cred->username($username); - print "Password: "; - my $password = <>; - chomp($password); - $cred->password($password); -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, YOURI project - -This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Youri/Submit/Check/Section.pm b/lib/Youri/Submit/Check/Section.pm deleted file mode 100644 index 4ff1675..0000000 --- a/lib/Youri/Submit/Check/Section.pm +++ /dev/null @@ -1,58 +0,0 @@ -# $Id: Precedence.pm 1707 2006-10-16 16:26:42Z warly $ -package Youri::Submit::Check::Section; - -=head1 NAME - -Youri::Submit::Check::Section - Check if package was submitted to the right section - -=head1 DESCRIPTION - -This check plugin rejects packages which were submitted to a section -different than the one where an older version already exists. - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Check/; - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - my @errors; - - my $submitted_main_section = $repository->_get_main_section($package, $target, $define); - - # undefine section, so that Repository::_get_section() of Mandriva_upload.pm - # finds the section from existing packages - my $defined_section = $define->{section}; - undef $define->{section}; - - my $old_main_section = $repository->_get_main_section($package, $target, $define); - my @older_revisions = $repository->get_older_revisions($package, $target, $define); - - # restore defined section - $define->{section} = $defined_section; - - if (@older_revisions && $submitted_main_section ne $old_main_section) { - push( - @errors, - "Section should be $old_main_section, not $submitted_main_section." - ); - } - - - return @errors; -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2007, Mandriva - -This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Youri/Submit/Check/Source.pm b/lib/Youri/Submit/Check/Source.pm deleted file mode 100644 index ab64e6c..0000000 --- a/lib/Youri/Submit/Check/Source.pm +++ /dev/null @@ -1,45 +0,0 @@ -# $Id$ -package Youri::Submit::Check::Source; - -=head1 NAME - -Youri::Submit::Check::Tag - Incorrect tag values check - -=head1 DESCRIPTION - -This check plugin rejects packages with incorrect tag values, based on regular -expressions. - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Check/; - -sub _init { - my $self = shift; - my %options = ( - @_ - ); -} - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - my $file = $package->as_file(); - if (!$package->is_source()) { - return "Package $file is not a source rpm"; - } - return -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, YOURI project - -This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Youri/Submit/Check/Tag.pm b/lib/Youri/Submit/Check/Tag.pm deleted file mode 100644 index 3fadfa3..0000000 --- a/lib/Youri/Submit/Check/Tag.pm +++ /dev/null @@ -1,61 +0,0 @@ -# $Id$ -package Youri::Submit::Check::Tag; - -=head1 NAME - -Youri::Submit::Check::Tag - Incorrect tag values check - -=head1 DESCRIPTION - -This check plugin rejects packages with incorrect tag values, based on regular -expressions. - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Check/; - -sub _init { - my $self = shift; - my %options = ( - tags => undef, # expected tag values - @_ - ); - - croak "no tags to check" unless $options{tags}; - croak "tag should be an hashref" unless ref $options{tags} eq 'HASH'; - - $self->{_tags} = $options{tags}; -} - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - my @errors; - - foreach my $tag (keys %{$self->{_tags}}) { - my $value = $package->get_tag($tag); - if ($value !~ /$self->{_tags}->{$tag}/) { - push( - @errors, - "invalid value $value for tag $tag" - ); - } - } - - return @errors; - -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, YOURI project - -This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Youri/Submit/Check/Type.pm b/lib/Youri/Submit/Check/Type.pm deleted file mode 100644 index 2c0be9b..0000000 --- a/lib/Youri/Submit/Check/Type.pm +++ /dev/null @@ -1,54 +0,0 @@ -# $Id$ -package Youri::Submit::Check::Type; - -=head1 NAME - -Youri::Submit::Check::Type - Type check - -=head1 DESCRIPTION - -This check plugin rejects packages with incorrect type. - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Check/; - -sub _init { - my $self = shift; - my %options = ( - type => undef, # expected type - @_ - ); - - croak "no type to check" unless $options{type}; - croak "invalid type value" unless $options{type} =~ /^(?:source|binary)$/; - - $self->{_type} = $options{type}; -} - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - my @errors; - - my $type = $package->get_type(); - if ($type ne $self->{_type}) { - push(@errors, "invalid type $type"); - } - - return @errors; -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, YOURI project - -This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut - -1; diff --git a/lib/Youri/Submit/Check/Version.pm b/lib/Youri/Submit/Check/Version.pm deleted file mode 100644 index 289ffe0..0000000 --- a/lib/Youri/Submit/Check/Version.pm +++ /dev/null @@ -1,100 +0,0 @@ -# $Id$ -package Youri::Submit::Check::Version; - -=head1 NAME - -Youri::Submit::Check::Version - Check if older version already exist in cooker (used in freeze period) - -=head1 DESCRIPTION - -This check plugin rejects new version of packages if they are not mentioned as authorized -in the configuration file or in a non frozen section. - -=cut - -use warnings; -use strict; -use Carp; -use URPM; -use base qw/Youri::Submit::Check/; - -sub _init { - my $self = shift; - my %options = ( - @_ - ); - - foreach my $target (keys %options) { - $self->{$target} = $options{$target} - } -} - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - my $opt = $self->{$target}; - return if $opt->{mode} eq 'normal'; - my $section = $repository->_get_section($package, $target, $define); - my $name = $package->get_canonical_name; - return if $name =~ /$opt->{authorized_packages}/; - my $arch = $repository->get_arch($package, $target, $define); - return if $arch =~ /$opt->{authorized_arches}/; - if ($opt->{mode} eq 'version_freeze') { - return if $section =~ /$opt->{authorized_sections}/; - my $user = $define->{user}; - return if $user =~ /$opt->{authorized_users}/; - my ($package_version) = $package =~ /-([^-]+)-[^-]+\.src$/; - $define->{arch} = 'src'; - my @revisions = $repository->get_revisions($package, $target, $define, undef, - sub { - my ($version) = $_[0] =~ /-([^-]+)-[^-]+\.src$/; - URPM::ranges_overlap("== $version", "< $package_version") - } - ); - $define->{arch} = ''; - if (@revisions) { - return "FREEZE, package @revisions of different versions exist in $target\n"; - } - } - # FIXME: The following code is not working and must be reviewed. - elsif ($opt->{mode} eq 'freeze') { - # XXX: So freeze mode really only check for this exceptions? - if ($section !~ /$opt->{authorized_sections}/) { - return "FREEZE: repository $target section $section is frozen, you can still submit your packages in testing\nTo do so use your.devel --define section=<section> $target <package 1> <package 2> ... <package n>"; - } - } else { - # FIXME: Calls to get_source_package seems invalid nowadays. - # This results on $source having a null content. - my $source = $package->get_source_package; - my ($package_version) = $source =~ /-([^-]+)-[^-]+\.src\.rpm$/; - $define->{arch} = 'src'; - # FIXME: get_revisions now expects the filter as the 5th element, and not the 4th. - my @revisions = $repository->get_revisions($package, $target, $define, - sub { - # FIXME: Calls to get_source_package seems invalid nowadays. - # This results on $source_package having a null content. - my $source_package = $_[0]->get_source_package; - my ($version) = $source_package =~ /-([^-]+)-[^-]+\.src\.rpm$/; - print STDERR "Found version $version\n"; - URPM::ranges_overlap("== $version", "< $package_version") - } - ); - $define->{arch} = ''; - if (@revisions) { - return "FREEZE, package @revisions of different versions exist in $target\n"; - } - } - return -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2006, YOURI project -Copyright (C) 2006, Mandriva - -This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut - -1; - |