diff options
Diffstat (limited to 'lib/Youri/Upload/Check')
-rw-r--r-- | lib/Youri/Upload/Check/ACL.pm | 72 | ||||
-rw-r--r-- | lib/Youri/Upload/Check/History.pm | 56 | ||||
-rw-r--r-- | lib/Youri/Upload/Check/Host.pm | 64 | ||||
-rw-r--r-- | lib/Youri/Upload/Check/Precedence.pm | 54 | ||||
-rw-r--r-- | lib/Youri/Upload/Check/Queue_recency.pm | 42 | ||||
-rw-r--r-- | lib/Youri/Upload/Check/Recency.pm | 48 | ||||
-rw-r--r-- | lib/Youri/Upload/Check/Rpmlint.pm | 57 | ||||
-rw-r--r-- | lib/Youri/Upload/Check/SVN.pm | 81 | ||||
-rw-r--r-- | lib/Youri/Upload/Check/Source.pm | 47 | ||||
-rw-r--r-- | lib/Youri/Upload/Check/Tag.pm | 56 | ||||
-rw-r--r-- | lib/Youri/Upload/Check/Type.pm | 53 | ||||
-rw-r--r-- | lib/Youri/Upload/Check/Version.pm | 72 |
12 files changed, 0 insertions, 702 deletions
diff --git a/lib/Youri/Upload/Check/ACL.pm b/lib/Youri/Upload/Check/ACL.pm deleted file mode 100644 index 9e19e35..0000000 --- a/lib/Youri/Upload/Check/ACL.pm +++ /dev/null @@ -1,72 +0,0 @@ -# $Id: Tag.pm 867 2006-04-11 20:34:56Z guillomovitch $ -package Youri::Upload::Check::ACL; - -=head1 NAME - -Youri::Upload::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::Upload::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 ($arch, $media, $r, $users) = @$acl; - next if $arch !~ $a || $srpm !~ $r || $media !~ $media; - if ($user =~ /$users/) { - return 1 - } else { - $self->{_error} = "$user is not authorized to upload packages belonging to $srpm (authorized persons: " . join(', ', split '\|', $users) . ")"; - return 0 - } - } - } - 1 -} - -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/Upload/Check/History.pm b/lib/Youri/Upload/Check/History.pm deleted file mode 100644 index 82a1b05..0000000 --- a/lib/Youri/Upload/Check/History.pm +++ /dev/null @@ -1,56 +0,0 @@ -# $Id$ -package Youri::Upload::Check::History; - -=head1 NAME - -Youri::Upload::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::Upload::Check/; - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - 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 1 - 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}) { - $self->{_error} = "Last changelog entry $last_revision_number from last revision " . $last_revision->get_full_name() . " missing from current changelog"; - return 0; - } - } - - return 1; -} - -=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/Upload/Check/Host.pm b/lib/Youri/Upload/Check/Host.pm deleted file mode 100644 index d6cae8d..0000000 --- a/lib/Youri/Upload/Check/Host.pm +++ /dev/null @@ -1,64 +0,0 @@ -# $Id: Tag.pm 867 2006-04-11 20:34:56Z guillomovitch $ -package Youri::Upload::Check::Host; - -=head1 NAME - -Youri::Upload::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::Upload::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->get_buildhost; - foreach my $h (keys %$host) { - next if $buildhost !~ $h; - if ($arch =~ $host->{$h}) { - return 1 - } - } - $self->{_error} = "Packages build on host $buildhost are not authorized"; - 0 -} - -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/Upload/Check/Precedence.pm b/lib/Youri/Upload/Check/Precedence.pm deleted file mode 100644 index 296c154..0000000 --- a/lib/Youri/Upload/Check/Precedence.pm +++ /dev/null @@ -1,54 +0,0 @@ -# $Id$ -package Youri::Upload::Check::Precedence; - -=head1 NAME - -Youri::Upload::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::Upload::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 @older_revisions = - $repository->get_older_revisions($package, $self->{_target}, $define); - if (@older_revisions) { - $self->{_error} = "Older revisions still exists for $self->{_target}: " . join(', ', @older_revisions); - return 0; - } - - return 1; -} - -=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/Upload/Check/Queue_recency.pm b/lib/Youri/Upload/Check/Queue_recency.pm deleted file mode 100644 index f7f5940..0000000 --- a/lib/Youri/Upload/Check/Queue_recency.pm +++ /dev/null @@ -1,42 +0,0 @@ -# $Id: Recency.pm 873 2006-04-15 17:04:27Z guillomovitch $ -package Youri::Upload::Check::Queue_recency; - -=head1 NAME - -Youri::Upload::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::Upload::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) { - $self->{_error} = "Newer revisions already exists for $target in upload queue: " . join(', ', @newer_revisions); - return 0; - } - - return 1; -} - -=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/Upload/Check/Recency.pm b/lib/Youri/Upload/Check/Recency.pm deleted file mode 100644 index 58452a6..0000000 --- a/lib/Youri/Upload/Check/Recency.pm +++ /dev/null @@ -1,48 +0,0 @@ -# $Id$ -package Youri::Upload::Check::Recency; - -=head1 NAME - -Youri::Upload::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::Upload::Check/; - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - my $file = $repository->get_install_file($package, $target, $define); - if (-f $file) { - $self->{_error} = "Current revision of package $file already exists for $target"; - return 0; - } - - my @newer_revisions = - $repository->get_newer_revisions($package, $target, $define); - if (@newer_revisions) { - $self->{_error} = "Newer revisions of package $package already exists for $target: " . join(', ', @newer_revisions); - return 0; - } - - return 1; -} - -=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/Upload/Check/Rpmlint.pm b/lib/Youri/Upload/Check/Rpmlint.pm deleted file mode 100644 index 20e478b..0000000 --- a/lib/Youri/Upload/Check/Rpmlint.pm +++ /dev/null @@ -1,57 +0,0 @@ -# $Id: Tag.pm 867 2006-04-11 20:34:56Z guillomovitch $ -package Youri::Upload::Check::Rpmlint; - -=head1 NAME - -Youri::Upload::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::Upload::Check/; - -sub _init { - my $self = shift; - my %options = ( - fatal_error => '', - @_ - ); - $self->{_fatal_error} = $options{fatal_error}; -} - -sub run { - my ($self, $package, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - my $file = $package->get_file; - open my $rpmlint, "/usr/bin/rpmlint $file |"; - my $fatal; - my $error = "fatal errors detected, upload rejected:\n"; - while (<$rpmlint>) { - if (/$self->{_fatal_error}/) { - $fatal = 1; - $error .= "- $_" - } - } - if ($fatal) { - $self->{_error} = $error; - return 0 - } - 1 -} -=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/Upload/Check/SVN.pm b/lib/Youri/Upload/Check/SVN.pm deleted file mode 100644 index f824f4a..0000000 --- a/lib/Youri/Upload/Check/SVN.pm +++ /dev/null @@ -1,81 +0,0 @@ -# $Id: Tag.pm 867 2006-04-11 20:34:56Z guillomovitch $ -package Youri::Upload::Check::SVN; - -=head1 NAME - -Youri::Upload::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::Upload::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 1 - } - - $package->is_source or return 1; - 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/) { - $self->{_error} = "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)"; - return 0 - } else { - print "Package $file is correct\n"; - return 1 - } - } - 1 -} - -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/Upload/Check/Source.pm b/lib/Youri/Upload/Check/Source.pm deleted file mode 100644 index 7d8ea03..0000000 --- a/lib/Youri/Upload/Check/Source.pm +++ /dev/null @@ -1,47 +0,0 @@ -# $Id: Tag.pm 867 2006-04-11 20:34:56Z guillomovitch $ -package Youri::Upload::Check::Source; - -=head1 NAME - -Youri::Upload::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::Upload::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->get_file(); - if (!$package->is_source()) { - print - $self->{_error} = "Package $file is not a source rpm"; - return 0 - } - return 1; -} - -=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/Upload/Check/Tag.pm b/lib/Youri/Upload/Check/Tag.pm deleted file mode 100644 index 453534c..0000000 --- a/lib/Youri/Upload/Check/Tag.pm +++ /dev/null @@ -1,56 +0,0 @@ -# $Id$ -package Youri::Upload::Check::Tag; - -=head1 NAME - -Youri::Upload::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::Upload::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; - - foreach my $tag (keys %{$self->{_tags}}) { - my $value = $package->get_tag($tag); - if ($value !~ /$self->{_tags}->{$tag}/) { - $self->{_error} = "invalid value $value for tag $tag"; - return 0; - } - } - - return 1; -} - -=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/Upload/Check/Type.pm b/lib/Youri/Upload/Check/Type.pm deleted file mode 100644 index e03fa80..0000000 --- a/lib/Youri/Upload/Check/Type.pm +++ /dev/null @@ -1,53 +0,0 @@ -# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Check/Tag.pm 1642 2006-03-29T06:49:43.840267Z guillaume $ -package Youri::Upload::Check::Type; - -=head1 NAME - -Youri::Upload::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::Upload::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 $type = $package->get_type(); - if ($type ne $self->{_type}) { - $self->{_error} = "invalid type $type"; - return 0; - } - - return 1; -} - -=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/Upload/Check/Version.pm b/lib/Youri/Upload/Check/Version.pm deleted file mode 100644 index fe9f42b..0000000 --- a/lib/Youri/Upload/Check/Version.pm +++ /dev/null @@ -1,72 +0,0 @@ -# $Id: /youri.mdv/trunk/lib/Youri/Upload/Check/Recency.pm 975 2006-08-05T08:30:57.188281Z warly $ -package Youri::Upload::Check::Version; - -=head1 NAME - -Youri::Upload::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::Upload::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 1 if $opt->{mode} eq 'normal'; - my $section = $repository->_get_section($package, $target, $define); - my $name = $package->get_canonical_name; - return 1 if $name =~ /$opt->{authorized_packages}/; - my $arch = $repository->get_arch($package, $target, $define); - return 1 if $arch =~ /$opt->{authorized_arches}/; - if ($opt->{mode} eq 'version_freeze') { - return 1 if $section =~ /$opt->{authorized_sections}/ - } elsif ($opt->{mode} eq 'freeze') { - if ($section !~ /$opt->{authorized_sections}/) { - $self->{_error} = "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>"; - return 0 - } - } - my $source = $package->get_source_package; - my ($package_version) = $source =~ /-([^-]+)-[^-]+\.src\.rpm$/; - $define->{arch} = 'src'; - my @revisions = $repository->get_revisions($package, $target, $define, sub { 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) { - $self->{_error} = "VERSION FREEZE, package @revisions of different versions exist in cooker\n"; - return 0 - } - return 1 -} - -=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; - |