From f36deffb742a8d801280606006807f2ad95f3849 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Fri, 29 Jun 2007 13:36:22 +0000 Subject: prepare merge --- lib/Youri/Submit/Action/CleanRpmsrate.pm | 53 ++++++++++++++++ lib/Youri/Submit/Action/Gendistrib.pm | 66 ++++++++++++++++++++ lib/Youri/Submit/Action/Genhdlist2.pm | 74 +++++++++++++++++++++++ lib/Youri/Submit/Action/Rsync.pm | 87 +++++++++++++++++++++++++++ lib/Youri/Submit/Check/ACL.pm | 71 ---------------------- lib/Youri/Submit/Check/History.pm | 61 ------------------- lib/Youri/Submit/Check/Host.pm | 63 ------------------- lib/Youri/Submit/Check/Precedence.pm | 58 ------------------ lib/Youri/Submit/Check/Queue_recency.pm | 40 ------------- lib/Youri/Submit/Check/Recency.pm | 46 -------------- lib/Youri/Submit/Check/Rpmlint.pm | 89 --------------------------- lib/Youri/Submit/Check/SVN.pm | 79 ------------------------ lib/Youri/Submit/Check/Section.pm | 58 ------------------ lib/Youri/Submit/Check/Source.pm | 45 -------------- lib/Youri/Submit/Check/Tag.pm | 61 ------------------- lib/Youri/Submit/Check/Type.pm | 54 ----------------- lib/Youri/Submit/Check/Version.pm | 100 ------------------------------- lib/Youri/Submit/Post/CleanRpmsrate.pm | 53 ---------------- lib/Youri/Submit/Post/Gendistrib.pm | 66 -------------------- lib/Youri/Submit/Post/Genhdlist2.pm | 74 ----------------------- lib/Youri/Submit/Pre/Rsync.pm | 87 --------------------------- lib/Youri/Submit/Test/ACL.pm | 71 ++++++++++++++++++++++ lib/Youri/Submit/Test/History.pm | 61 +++++++++++++++++++ lib/Youri/Submit/Test/Host.pm | 63 +++++++++++++++++++ lib/Youri/Submit/Test/Precedence.pm | 58 ++++++++++++++++++ lib/Youri/Submit/Test/Queue_recency.pm | 40 +++++++++++++ lib/Youri/Submit/Test/Recency.pm | 46 ++++++++++++++ lib/Youri/Submit/Test/Rpmlint.pm | 89 +++++++++++++++++++++++++++ lib/Youri/Submit/Test/SVN.pm | 79 ++++++++++++++++++++++++ lib/Youri/Submit/Test/Section.pm | 58 ++++++++++++++++++ lib/Youri/Submit/Test/Source.pm | 45 ++++++++++++++ lib/Youri/Submit/Test/Tag.pm | 61 +++++++++++++++++++ lib/Youri/Submit/Test/Type.pm | 54 +++++++++++++++++ lib/Youri/Submit/Test/Version.pm | 100 +++++++++++++++++++++++++++++++ 34 files changed, 1105 insertions(+), 1105 deletions(-) create mode 100644 lib/Youri/Submit/Action/CleanRpmsrate.pm create mode 100644 lib/Youri/Submit/Action/Gendistrib.pm create mode 100644 lib/Youri/Submit/Action/Genhdlist2.pm create mode 100644 lib/Youri/Submit/Action/Rsync.pm delete mode 100644 lib/Youri/Submit/Check/ACL.pm delete mode 100644 lib/Youri/Submit/Check/History.pm delete mode 100644 lib/Youri/Submit/Check/Host.pm delete mode 100644 lib/Youri/Submit/Check/Precedence.pm delete mode 100644 lib/Youri/Submit/Check/Queue_recency.pm delete mode 100644 lib/Youri/Submit/Check/Recency.pm delete mode 100644 lib/Youri/Submit/Check/Rpmlint.pm delete mode 100644 lib/Youri/Submit/Check/SVN.pm delete mode 100644 lib/Youri/Submit/Check/Section.pm delete mode 100644 lib/Youri/Submit/Check/Source.pm delete mode 100644 lib/Youri/Submit/Check/Tag.pm delete mode 100644 lib/Youri/Submit/Check/Type.pm delete mode 100644 lib/Youri/Submit/Check/Version.pm delete mode 100644 lib/Youri/Submit/Post/CleanRpmsrate.pm delete mode 100644 lib/Youri/Submit/Post/Gendistrib.pm delete mode 100644 lib/Youri/Submit/Post/Genhdlist2.pm delete mode 100644 lib/Youri/Submit/Pre/Rsync.pm create mode 100644 lib/Youri/Submit/Test/ACL.pm create mode 100644 lib/Youri/Submit/Test/History.pm create mode 100644 lib/Youri/Submit/Test/Host.pm create mode 100644 lib/Youri/Submit/Test/Precedence.pm create mode 100644 lib/Youri/Submit/Test/Queue_recency.pm create mode 100644 lib/Youri/Submit/Test/Recency.pm create mode 100644 lib/Youri/Submit/Test/Rpmlint.pm create mode 100644 lib/Youri/Submit/Test/SVN.pm create mode 100644 lib/Youri/Submit/Test/Section.pm create mode 100644 lib/Youri/Submit/Test/Source.pm create mode 100644 lib/Youri/Submit/Test/Tag.pm create mode 100644 lib/Youri/Submit/Test/Type.pm create mode 100644 lib/Youri/Submit/Test/Version.pm diff --git a/lib/Youri/Submit/Action/CleanRpmsrate.pm b/lib/Youri/Submit/Action/CleanRpmsrate.pm new file mode 100644 index 0000000..977e2a0 --- /dev/null +++ b/lib/Youri/Submit/Action/CleanRpmsrate.pm @@ -0,0 +1,53 @@ +# $Id: CleanRpmsrate.pm 115367 2007-01-30 09:47:04Z pixel $ +package Youri::Submit::Post::CleanRpmsrate; + +=head1 NAME + +Youri::Submit::Post::CleanRpmsrate - calls clean-rpmsrate + +=head1 DESCRIPTION + +Calls clean-rpmsrate + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Post/; + +#- inlined from MDK::Common::DataStructure +sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ } + +sub _init { +} + +sub run { + my ($self, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $root = $repository->get_install_root(); + my @changed = @{$repository->get_arch_changed($target)}; + if (grep { $_ eq 'i586' } @changed) { + # x86_64 uses i586 pkgs, so rpmsrate need to be rebuild + @changed = uniq(@changed, 'x86_64'); + } + foreach my $arch (@changed) { + my $rpmsrate = "$root/$target/$arch/media/media_info/rpmsrate"; + my @media = "$root/$target/$arch/media/main/release"; + system("cp", "$rpmsrate-raw", "$rpmsrate-new"); + system("clean-rpmsrate", "$rpmsrate-new", @media); + system("mv", "-f", "$rpmsrate-new", $rpmsrate); + } + return +} + +=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/Action/Gendistrib.pm b/lib/Youri/Submit/Action/Gendistrib.pm new file mode 100644 index 0000000..98205c7 --- /dev/null +++ b/lib/Youri/Submit/Action/Gendistrib.pm @@ -0,0 +1,66 @@ +# $Id: Gendistrib.pm 115367 2007-01-30 09:47:04Z pixel $ +package Youri::Submit::Post::Gendistrib; + +=head1 NAME + +Youri::Submit::Post::Gendistrib - calls gendistrib + +=head1 DESCRIPTION + +Calls gendistrib + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Post/; + +sub _init { + my $self = shift; + my %options = ( + user => '', + host => '', + source => '', + destination => '', + @_ + ); + + foreach my $var ('tmpdir', 'command') { + $self->{"_$var"} = $options{$var}; + } +} + +sub run { + my ($self, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $root = $repository->get_install_root(); + (undef, undef, my $hour) = gmtime(time); + # during the night, use complete hdlist rebuild + my $fast = '--fast'; + $fast = ''; # blino: don't use fast for now, it might be broken + if ($hour > 22 && $hour < 5) { + if ($hour < 4) { + $fast = '--blind' + } else { + $fast = '' + } + } + foreach my $arch (@{$repository->get_arch_changed($target)}) { + my $cmd = "TMPDIR=$self->{_tmpdir}/$target/$arch time $self->{_command} --nochkdep --nobadrpm $fast --noclean $root/$target/$arch"; + print "$cmd\n"; + system($cmd); + } + return +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, 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/Action/Genhdlist2.pm b/lib/Youri/Submit/Action/Genhdlist2.pm new file mode 100644 index 0000000..e9c3e24 --- /dev/null +++ b/lib/Youri/Submit/Action/Genhdlist2.pm @@ -0,0 +1,74 @@ +# $Id: Gendistrib.pm 115367 2007-01-30 09:47:04Z pixel $ +package Youri::Submit::Post::Genhdlist2; + +=head1 NAME + +Youri::Submit::Post::Genhdlist2 - calls genhdlist2 + +=head1 DESCRIPTION + +Calls genhdlist2 + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Post/; + +sub _init { + my $self = shift; + my %options = ( + user => '', + host => '', + source => '', + destination => '', + @_ + ); + + foreach my $var ('command') { + $self->{"_$var"} = $options{$var}; + } +} + +sub run { + my ($self, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $root = $repository->get_install_root(); + (undef, undef, my $hour) = gmtime(time); + my @changed = @{$repository->get_install_dir_changed($target)}; + if (!@changed) { + print "nothing to do\n"; + return; + } + foreach my $dir (@changed) { + my $file_deps = "$dir/../../media_info/file-deps"; + my $file_deps_option = -e $file_deps ? "--file-deps $file_deps" : ''; + my $cmd = "time $self->{_command} -v --allow-empty-media $file_deps_option $dir"; + print "$cmd\n"; + system($cmd) == 0 or print "ERROR: $cmd failed\n"; + } + + # need to redo global MD5SUM. This MD5SUM is mostly obsolete, but is still needed up to 2007.1 + # (and even on cooker for existing urpmi.cfg) + foreach my $arch (@{$repository->get_arch_changed($target)}) { + my $dir = "$root/$target/$arch/media/media_info"; + my $cmd = "cd $dir ; time md5sum hdlist_* synthesis.*"; + print "$cmd\n"; + my $m = `$cmd`; + open my $f, '>', "$dir/MD5SUM" or die "Can't write $dir/MD5SUM: $!\n"; + print $f $m; + } + return; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, 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/Action/Rsync.pm b/lib/Youri/Submit/Action/Rsync.pm new file mode 100644 index 0000000..036612c --- /dev/null +++ b/lib/Youri/Submit/Action/Rsync.pm @@ -0,0 +1,87 @@ +# $Id$ +package Youri::Submit::Pre::Rsync; + +=head1 NAME + +Youri::Submit::Pre::Rsync - Old revisions archiving + +=head1 DESCRIPTION + +This action plugin ensures archiving of old package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Pre/; + +sub _init { + my $self = shift; + my %options = ( + user => '', + host => '', + source => '', + destination => '', + @_ + ); + + foreach my $var ('user', 'host', 'source', 'destination') { + $self->{"_$var"} = $options{$var}; + } +} + +sub run { + my ($self, $pre_packages, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + if (system("rsync --remove-sent-files -avlPHe 'ssh -xc arcfour' $self->{_user}\@$self->{_host}:$self->{_source}/$target/ $self->{_destination}/$target/")) { + $self->{_error} = "Rsync command failed ($!)"; + return + } + my $queue = "$self->{_destination}/$target"; + $self->{_error} = "Reading queue directory failed"; + # now get the packages downloaded + my %packages; + opendir my $queuedh, "$self->{_destination}/$target/" or return "Could not open $self->{_destination}/$target"; + opendir my $targetdh, $queue or return "Could not open $queue"; + my $idx; + foreach my $media (readdir $targetdh) { + $media =~ /^\.{1,2}$/ and next; + print "$target - $media\n"; + if (-d "$queue/$media") { + opendir my $submediadh, "$queue/$media" or return "Could not open $queue/$media"; + foreach my $submedia (readdir $submediadh) { + $submedia =~ /^\.{1,2}$/ and next; + print "$target - $media - $submedia\n"; + opendir my $rpmdh, "$queue/$media/$submedia" or return "Could not open $queue/$media/$submedia"; + foreach my $rpm (readdir $rpmdh) { + $rpm =~ /^\.{1,2}$/ and next; + print "$target - $media - $submedia : $rpm\n"; + my $file = "$queue/$media/$submedia/$rpm"; + $file =~ s/\/+/\//g; + if ($rpm =~ /^(\d{14}\.\w+\.\w+\.\d+)_.*\.rpm$/) { + push @{$packages{$1}{rpms}}, { section => "$media/$submedia", file => $file }; + } elsif ($rpm =~ /\.rpm$/) { + $idx++; + push @{$packages{"independant_$idx"}{rpms}}, { section => "$media/$submedia", file => $file } + } + } + } + } + } + foreach my $key (keys %packages) { + push @$pre_packages, $packages{$key}{rpms} + } + return +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, 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/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 = ) { - 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 @:$srpm_name--.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=
$target ... "; - } - } 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; - diff --git a/lib/Youri/Submit/Post/CleanRpmsrate.pm b/lib/Youri/Submit/Post/CleanRpmsrate.pm deleted file mode 100644 index 977e2a0..0000000 --- a/lib/Youri/Submit/Post/CleanRpmsrate.pm +++ /dev/null @@ -1,53 +0,0 @@ -# $Id: CleanRpmsrate.pm 115367 2007-01-30 09:47:04Z pixel $ -package Youri::Submit::Post::CleanRpmsrate; - -=head1 NAME - -Youri::Submit::Post::CleanRpmsrate - calls clean-rpmsrate - -=head1 DESCRIPTION - -Calls clean-rpmsrate - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Post/; - -#- inlined from MDK::Common::DataStructure -sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ } - -sub _init { -} - -sub run { - my ($self, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - my $root = $repository->get_install_root(); - my @changed = @{$repository->get_arch_changed($target)}; - if (grep { $_ eq 'i586' } @changed) { - # x86_64 uses i586 pkgs, so rpmsrate need to be rebuild - @changed = uniq(@changed, 'x86_64'); - } - foreach my $arch (@changed) { - my $rpmsrate = "$root/$target/$arch/media/media_info/rpmsrate"; - my @media = "$root/$target/$arch/media/main/release"; - system("cp", "$rpmsrate-raw", "$rpmsrate-new"); - system("clean-rpmsrate", "$rpmsrate-new", @media); - system("mv", "-f", "$rpmsrate-new", $rpmsrate); - } - return -} - -=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/Post/Gendistrib.pm b/lib/Youri/Submit/Post/Gendistrib.pm deleted file mode 100644 index 98205c7..0000000 --- a/lib/Youri/Submit/Post/Gendistrib.pm +++ /dev/null @@ -1,66 +0,0 @@ -# $Id: Gendistrib.pm 115367 2007-01-30 09:47:04Z pixel $ -package Youri::Submit::Post::Gendistrib; - -=head1 NAME - -Youri::Submit::Post::Gendistrib - calls gendistrib - -=head1 DESCRIPTION - -Calls gendistrib - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Post/; - -sub _init { - my $self = shift; - my %options = ( - user => '', - host => '', - source => '', - destination => '', - @_ - ); - - foreach my $var ('tmpdir', 'command') { - $self->{"_$var"} = $options{$var}; - } -} - -sub run { - my ($self, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - my $root = $repository->get_install_root(); - (undef, undef, my $hour) = gmtime(time); - # during the night, use complete hdlist rebuild - my $fast = '--fast'; - $fast = ''; # blino: don't use fast for now, it might be broken - if ($hour > 22 && $hour < 5) { - if ($hour < 4) { - $fast = '--blind' - } else { - $fast = '' - } - } - foreach my $arch (@{$repository->get_arch_changed($target)}) { - my $cmd = "TMPDIR=$self->{_tmpdir}/$target/$arch time $self->{_command} --nochkdep --nobadrpm $fast --noclean $root/$target/$arch"; - print "$cmd\n"; - system($cmd); - } - return -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, 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/Post/Genhdlist2.pm b/lib/Youri/Submit/Post/Genhdlist2.pm deleted file mode 100644 index e9c3e24..0000000 --- a/lib/Youri/Submit/Post/Genhdlist2.pm +++ /dev/null @@ -1,74 +0,0 @@ -# $Id: Gendistrib.pm 115367 2007-01-30 09:47:04Z pixel $ -package Youri::Submit::Post::Genhdlist2; - -=head1 NAME - -Youri::Submit::Post::Genhdlist2 - calls genhdlist2 - -=head1 DESCRIPTION - -Calls genhdlist2 - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Post/; - -sub _init { - my $self = shift; - my %options = ( - user => '', - host => '', - source => '', - destination => '', - @_ - ); - - foreach my $var ('command') { - $self->{"_$var"} = $options{$var}; - } -} - -sub run { - my ($self, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - my $root = $repository->get_install_root(); - (undef, undef, my $hour) = gmtime(time); - my @changed = @{$repository->get_install_dir_changed($target)}; - if (!@changed) { - print "nothing to do\n"; - return; - } - foreach my $dir (@changed) { - my $file_deps = "$dir/../../media_info/file-deps"; - my $file_deps_option = -e $file_deps ? "--file-deps $file_deps" : ''; - my $cmd = "time $self->{_command} -v --allow-empty-media $file_deps_option $dir"; - print "$cmd\n"; - system($cmd) == 0 or print "ERROR: $cmd failed\n"; - } - - # need to redo global MD5SUM. This MD5SUM is mostly obsolete, but is still needed up to 2007.1 - # (and even on cooker for existing urpmi.cfg) - foreach my $arch (@{$repository->get_arch_changed($target)}) { - my $dir = "$root/$target/$arch/media/media_info"; - my $cmd = "cd $dir ; time md5sum hdlist_* synthesis.*"; - print "$cmd\n"; - my $m = `$cmd`; - open my $f, '>', "$dir/MD5SUM" or die "Can't write $dir/MD5SUM: $!\n"; - print $f $m; - } - return; -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, 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/Pre/Rsync.pm b/lib/Youri/Submit/Pre/Rsync.pm deleted file mode 100644 index 036612c..0000000 --- a/lib/Youri/Submit/Pre/Rsync.pm +++ /dev/null @@ -1,87 +0,0 @@ -# $Id$ -package Youri::Submit::Pre::Rsync; - -=head1 NAME - -Youri::Submit::Pre::Rsync - Old revisions archiving - -=head1 DESCRIPTION - -This action plugin ensures archiving of old package revisions. - -=cut - -use warnings; -use strict; -use Carp; -use base qw/Youri::Submit::Pre/; - -sub _init { - my $self = shift; - my %options = ( - user => '', - host => '', - source => '', - destination => '', - @_ - ); - - foreach my $var ('user', 'host', 'source', 'destination') { - $self->{"_$var"} = $options{$var}; - } -} - -sub run { - my ($self, $pre_packages, $repository, $target, $define) = @_; - croak "Not a class method" unless ref $self; - - if (system("rsync --remove-sent-files -avlPHe 'ssh -xc arcfour' $self->{_user}\@$self->{_host}:$self->{_source}/$target/ $self->{_destination}/$target/")) { - $self->{_error} = "Rsync command failed ($!)"; - return - } - my $queue = "$self->{_destination}/$target"; - $self->{_error} = "Reading queue directory failed"; - # now get the packages downloaded - my %packages; - opendir my $queuedh, "$self->{_destination}/$target/" or return "Could not open $self->{_destination}/$target"; - opendir my $targetdh, $queue or return "Could not open $queue"; - my $idx; - foreach my $media (readdir $targetdh) { - $media =~ /^\.{1,2}$/ and next; - print "$target - $media\n"; - if (-d "$queue/$media") { - opendir my $submediadh, "$queue/$media" or return "Could not open $queue/$media"; - foreach my $submedia (readdir $submediadh) { - $submedia =~ /^\.{1,2}$/ and next; - print "$target - $media - $submedia\n"; - opendir my $rpmdh, "$queue/$media/$submedia" or return "Could not open $queue/$media/$submedia"; - foreach my $rpm (readdir $rpmdh) { - $rpm =~ /^\.{1,2}$/ and next; - print "$target - $media - $submedia : $rpm\n"; - my $file = "$queue/$media/$submedia/$rpm"; - $file =~ s/\/+/\//g; - if ($rpm =~ /^(\d{14}\.\w+\.\w+\.\d+)_.*\.rpm$/) { - push @{$packages{$1}{rpms}}, { section => "$media/$submedia", file => $file }; - } elsif ($rpm =~ /\.rpm$/) { - $idx++; - push @{$packages{"independant_$idx"}{rpms}}, { section => "$media/$submedia", file => $file } - } - } - } - } - } - foreach my $key (keys %packages) { - push @$pre_packages, $packages{$key}{rpms} - } - return -} - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2002-2006, 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/Test/ACL.pm b/lib/Youri/Submit/Test/ACL.pm new file mode 100644 index 0000000..34bf48a --- /dev/null +++ b/lib/Youri/Submit/Test/ACL.pm @@ -0,0 +1,71 @@ +# $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/Test/History.pm b/lib/Youri/Submit/Test/History.pm new file mode 100644 index 0000000..326f2f1 --- /dev/null +++ b/lib/Youri/Submit/Test/History.pm @@ -0,0 +1,61 @@ +# $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/Test/Host.pm b/lib/Youri/Submit/Test/Host.pm new file mode 100644 index 0000000..b2b392a --- /dev/null +++ b/lib/Youri/Submit/Test/Host.pm @@ -0,0 +1,63 @@ +# $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/Test/Precedence.pm b/lib/Youri/Submit/Test/Precedence.pm new file mode 100644 index 0000000..c73446b --- /dev/null +++ b/lib/Youri/Submit/Test/Precedence.pm @@ -0,0 +1,58 @@ +# $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/Test/Queue_recency.pm b/lib/Youri/Submit/Test/Queue_recency.pm new file mode 100644 index 0000000..42c4f42 --- /dev/null +++ b/lib/Youri/Submit/Test/Queue_recency.pm @@ -0,0 +1,40 @@ +# $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/Test/Recency.pm b/lib/Youri/Submit/Test/Recency.pm new file mode 100644 index 0000000..f8aa5b7 --- /dev/null +++ b/lib/Youri/Submit/Test/Recency.pm @@ -0,0 +1,46 @@ +# $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/Test/Rpmlint.pm b/lib/Youri/Submit/Test/Rpmlint.pm new file mode 100644 index 0000000..a38f2ba --- /dev/null +++ b/lib/Youri/Submit/Test/Rpmlint.pm @@ -0,0 +1,89 @@ +# $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 = ) { + 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/Test/SVN.pm b/lib/Youri/Submit/Test/SVN.pm new file mode 100644 index 0000000..10ab810 --- /dev/null +++ b/lib/Youri/Submit/Test/SVN.pm @@ -0,0 +1,79 @@ +# $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 @:$srpm_name--.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/Test/Section.pm b/lib/Youri/Submit/Test/Section.pm new file mode 100644 index 0000000..4ff1675 --- /dev/null +++ b/lib/Youri/Submit/Test/Section.pm @@ -0,0 +1,58 @@ +# $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/Test/Source.pm b/lib/Youri/Submit/Test/Source.pm new file mode 100644 index 0000000..ab64e6c --- /dev/null +++ b/lib/Youri/Submit/Test/Source.pm @@ -0,0 +1,45 @@ +# $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/Test/Tag.pm b/lib/Youri/Submit/Test/Tag.pm new file mode 100644 index 0000000..3fadfa3 --- /dev/null +++ b/lib/Youri/Submit/Test/Tag.pm @@ -0,0 +1,61 @@ +# $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/Test/Type.pm b/lib/Youri/Submit/Test/Type.pm new file mode 100644 index 0000000..2c0be9b --- /dev/null +++ b/lib/Youri/Submit/Test/Type.pm @@ -0,0 +1,54 @@ +# $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/Test/Version.pm b/lib/Youri/Submit/Test/Version.pm new file mode 100644 index 0000000..289ffe0 --- /dev/null +++ b/lib/Youri/Submit/Test/Version.pm @@ -0,0 +1,100 @@ +# $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=
$target ... "; + } + } 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; + -- cgit v1.2.1