From abc9a802404902718dc808fdce36f226533f02de Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Fri, 7 Jan 2011 08:07:11 +0000 Subject: get_file_name returns a full path, which Install does not like --- lib/Youri/Submit/Action.pm | 27 ++++++ lib/Youri/Submit/Action/Archive.pm | 90 ++++++++++++++++++++ lib/Youri/Submit/Action/Bugzilla.pm | 81 ++++++++++++++++++ lib/Youri/Submit/Action/CVS.pm | 135 ++++++++++++++++++++++++++++++ lib/Youri/Submit/Action/Clean.pm | 40 +++++++++ lib/Youri/Submit/Action/DkmsModuleInfo.pm | 111 ++++++++++++++++++++++++ lib/Youri/Submit/Action/Install.pm | 75 +++++++++++++++++ lib/Youri/Submit/Action/Link.pm | 80 ++++++++++++++++++ lib/Youri/Submit/Action/Mail.pm | 131 +++++++++++++++++++++++++++++ lib/Youri/Submit/Action/Markrelease.pm | 56 +++++++++++++ lib/Youri/Submit/Action/RSS.pm | 102 ++++++++++++++++++++++ lib/Youri/Submit/Action/Rpminfo.pm | 69 +++++++++++++++ lib/Youri/Submit/Action/Send.pm | 77 +++++++++++++++++ lib/Youri/Submit/Action/Sendcache.pm | 81 ++++++++++++++++++ lib/Youri/Submit/Action/Sign.pm | 56 +++++++++++++ lib/Youri/Submit/Action/Unpack.pm | 82 ++++++++++++++++++ lib/Youri/Submit/Action/UpdateMdvDb.pm | 62 ++++++++++++++ lib/Youri/Submit/Check.pm | 27 ++++++ 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 | 64 ++++++++++++++ lib/Youri/Submit/Check/Rpmlint.pm | 90 ++++++++++++++++++++ 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 | 102 ++++++++++++++++++++++ lib/Youri/Submit/Plugin.pm | 93 ++++++++++++++++++++ lib/Youri/Submit/Post.pm | 27 ++++++ lib/Youri/Submit/Post/CleanRpmsrate.pm | 53 ++++++++++++ lib/Youri/Submit/Post/Gendistrib.pm | 66 +++++++++++++++ lib/Youri/Submit/Post/Genhdlist2.pm | 82 ++++++++++++++++++ lib/Youri/Submit/Pre.pm | 27 ++++++ lib/Youri/Submit/Pre/Rsync.pm | 87 +++++++++++++++++++ lib/Youri/Submit/Reject.pm | 27 ++++++ lib/Youri/Submit/Reject/Archive.pm | 61 ++++++++++++++ lib/Youri/Submit/Reject/Clean.pm | 36 ++++++++ lib/Youri/Submit/Reject/Install.pm | 63 ++++++++++++++ lib/Youri/Submit/Reject/Mail.pm | 112 +++++++++++++++++++++++++ 43 files changed, 2962 insertions(+) create mode 100644 lib/Youri/Submit/Action.pm create mode 100644 lib/Youri/Submit/Action/Archive.pm create mode 100644 lib/Youri/Submit/Action/Bugzilla.pm create mode 100644 lib/Youri/Submit/Action/CVS.pm create mode 100644 lib/Youri/Submit/Action/Clean.pm create mode 100644 lib/Youri/Submit/Action/DkmsModuleInfo.pm create mode 100644 lib/Youri/Submit/Action/Install.pm create mode 100644 lib/Youri/Submit/Action/Link.pm create mode 100644 lib/Youri/Submit/Action/Mail.pm create mode 100644 lib/Youri/Submit/Action/Markrelease.pm create mode 100644 lib/Youri/Submit/Action/RSS.pm create mode 100644 lib/Youri/Submit/Action/Rpminfo.pm create mode 100644 lib/Youri/Submit/Action/Send.pm create mode 100644 lib/Youri/Submit/Action/Sendcache.pm create mode 100644 lib/Youri/Submit/Action/Sign.pm create mode 100644 lib/Youri/Submit/Action/Unpack.pm create mode 100644 lib/Youri/Submit/Action/UpdateMdvDb.pm create mode 100644 lib/Youri/Submit/Check.pm create mode 100644 lib/Youri/Submit/Check/ACL.pm create mode 100644 lib/Youri/Submit/Check/History.pm create mode 100644 lib/Youri/Submit/Check/Host.pm create mode 100644 lib/Youri/Submit/Check/Precedence.pm create mode 100644 lib/Youri/Submit/Check/Queue_recency.pm create mode 100644 lib/Youri/Submit/Check/Recency.pm create mode 100644 lib/Youri/Submit/Check/Rpmlint.pm create mode 100644 lib/Youri/Submit/Check/SVN.pm create mode 100644 lib/Youri/Submit/Check/Section.pm create mode 100644 lib/Youri/Submit/Check/Source.pm create mode 100644 lib/Youri/Submit/Check/Tag.pm create mode 100644 lib/Youri/Submit/Check/Type.pm create mode 100644 lib/Youri/Submit/Check/Version.pm create mode 100644 lib/Youri/Submit/Plugin.pm create mode 100644 lib/Youri/Submit/Post.pm create mode 100644 lib/Youri/Submit/Post/CleanRpmsrate.pm create mode 100644 lib/Youri/Submit/Post/Gendistrib.pm create mode 100644 lib/Youri/Submit/Post/Genhdlist2.pm create mode 100644 lib/Youri/Submit/Pre.pm create mode 100644 lib/Youri/Submit/Pre/Rsync.pm create mode 100644 lib/Youri/Submit/Reject.pm create mode 100644 lib/Youri/Submit/Reject/Archive.pm create mode 100644 lib/Youri/Submit/Reject/Clean.pm create mode 100644 lib/Youri/Submit/Reject/Install.pm create mode 100644 lib/Youri/Submit/Reject/Mail.pm (limited to 'lib') diff --git a/lib/Youri/Submit/Action.pm b/lib/Youri/Submit/Action.pm new file mode 100644 index 0000000..983fdc8 --- /dev/null +++ b/lib/Youri/Submit/Action.pm @@ -0,0 +1,27 @@ +# $Id: Base.pm 631 2006-01-26 22:22:23Z guillomovitch $ +package Youri::Submit::Action; + +=head1 NAME + +Youri::Submit::Action - Abstract action plugin + +=head1 DESCRIPTION + +This abstract class defines action plugin interface. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Plugin/; + +=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/Action/Archive.pm b/lib/Youri/Submit/Action/Archive.pm new file mode 100644 index 0000000..98ff37c --- /dev/null +++ b/lib/Youri/Submit/Action/Archive.pm @@ -0,0 +1,90 @@ +# $Id: Archive.pm 265457 2010-01-28 13:09:30Z pterjan $ +package Youri::Submit::Action::Archive; + +=head1 NAME + +Youri::Submit::Action::Archive - 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::Action/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + @_ + ); + + $self->{_perms} = $options{perms}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + # FIXME: workaround for $self->{_verbose} not being initialized properly + $self->{_verbose} = 1; + # all this should be in Mandriva_upload.pm + my $section = $repository->_get_section($package, $target, $define); + my $main_section = $repository->_get_main_section($package, $target, $define); + print "section $section main_section $main_section\n" if $self->{_verbose}; + my $arch = $package->get_arch(); + $arch = $self->{_noarch} if $arch eq 'noarch'; + my $path = $arch eq 'src' ? "$target/SRPMS" : "$target/$arch/media"; + $path = "$repository->{_install_root}/$path"; + $path =~ s,/+,/,g; + foreach my $replaced_package ( + $repository->get_replaced_packages($package, $target, $define) + ) { + my $file = $replaced_package->get_file(); + + # trap for debugging bug 34999 + if ($file =~ /\/[\d.]+\/(main\/updates|.*\/release)/) { + my $bugmsg = "BUG#34999 WARNING: trying to remove from a release: $file\n"; + open(BUG34999LOG, '>>', "/home/mandrake/bug34999.log"); + print $bugmsg; + print BUG34999LOG localtime().": ".$bugmsg; + close BUG34999LOG; + + next; + } + + my ($rep_section, $rep_main_section) = $file =~ m,$path/(([^/]+)/.*)/[^/]+.rpm,; + # We do accept duplicate version for other submedia of the same main media section + print "(path '$path') file '$file' section '$rep_section' main_section '$rep_main_section'\n" if $self->{_verbose}; + next if $rep_main_section eq $main_section && $rep_section ne $section; + my $dest = $repository->get_archive_dir($package, $target, $define); + + print "archiving file $file to $dest\n" if $self->{_verbose}; + + unless ($self->{_test}) { + # create destination dir if needed + system("install -d -m " . ($self->{_perms} + 111) . " $dest") + unless -d $dest; + + # install file to new location + system("install -m $self->{_perms} $file $dest"); + + print "deleting file $file\n" if $self->{_verbose}; + unlink $file unless $self->{_test}; + } + } +} + +=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/Action/Bugzilla.pm b/lib/Youri/Submit/Action/Bugzilla.pm new file mode 100644 index 0000000..04eaa4c --- /dev/null +++ b/lib/Youri/Submit/Action/Bugzilla.pm @@ -0,0 +1,81 @@ +# $Id: Bugzilla.pm 1700 2006-10-16 12:57:42Z warly $ +package Youri::Submit::Action::Bugzilla; + +=head1 NAME + +Youri::Submit::Action::Bugzilla - Bugzilla synchronisation + +=head1 DESCRIPTION + +This action plugin ensures synchronisation with Bugzilla. + +=cut + +use warnings; +use strict; +use Carp; +use Youri::Bugzilla; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + host => '', + base => '', + user => '', + pass => '', + contact => '', + @_ + ); + + $self->{_bugzilla} = Youri::Bugzilla->new( + $options{host}, + $options{base}, + $options{user}, + $options{pass} + ); + $self->{_contact} = $options{contact}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + return unless $package->is_source(); + + my $name = $package->get_name(); + my $version = $package->get_version(); + my $summary = $package->get_summary(); + my $packager = $package->get_packager(); + $packager =~ s/.*<(.*)>/$1/; + + if ($self->{_bugzilla}->has_package($name)) { + my %versions = + map { $_ => 1 } + $self->{_bugzilla}->get_versions($name); + unless ($versions{$version}) { + print "adding version $version to bugzilla\n" if $self->{_verbose}; + $self->{_bugzilla}->add_version($name, $version) + unless $self->{_test}; + } + } else { + print "adding package $name to bugzilla\n" if $self->{_verbose}; + $self->{_bugzilla}->add_package( + $name, + $summary, + $version, + $packager, + $self->{_contact} + ) unless $self->{_test}; + } +} + +=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/Action/CVS.pm b/lib/Youri/Submit/Action/CVS.pm new file mode 100644 index 0000000..e9f1f4f --- /dev/null +++ b/lib/Youri/Submit/Action/CVS.pm @@ -0,0 +1,135 @@ +# $Id: CVS.pm 224115 2007-07-02 09:17:15Z pixel $ +package Youri::Submit::Action::CVS; + +=head1 NAME + +Youri::Submit::Action::CVS - CVS versionning + +=head1 DESCRIPTION + +This action plugin ensures CVS versionning of package sources. + +=cut + +use warnings; +use strict; +use Carp; +use Cwd; +use File::Temp qw/tempdir/; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + exclude => '\.(tar(\.(gz|bz2))?|zip)$', + perms => 644, + @_ + ); + + $self->{_exclude} = $options{exclude}; + $self->{_perms} = $options{perms}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + return unless $package->is_source(); + + my $name = $package->get_name(); + my $version = $package->get_version(); + my $release = $package->get_release(); + + my $root = $repository->get_version_root(); + my $path = $repository->get_version_path($package, $target, $define); + + # remember original directory + my $original_dir = cwd(); + + # get a safe temporary directory + my $dir = tempdir( CLEANUP => 1 ); + chdir $dir; + + # first checkout base directory only + system("cvs -Q -d $root co -l $path"); + + # try to checkout package directory + my $dest = $path . '/' . $name; + system("cvs -Q -d $root co $dest"); + + # create directory if previous import failed + unless (-d $dest) { + print "adding directory $dest\n" if $self->{_verbose}; + system("install -d -m " . ($self->{_perms} + 111) . " $dest"); + system("cvs -Q -d $root add $dest"); + } + + chdir $dest; + + # remove all files + unlink grep { -f } glob '*'; + + # extract all rpm files locally + $package->extract(); + + # remove excluded files + if ($self->{_exclude}) { + unlink grep { -f && /$self->{_exclude}/ } glob '*'; + } + + # uncompress all compressed files + system("bunzip2 *.bz2 2>/dev/null"); + system("gunzip *.gz 2>/dev/null"); + + my (@to_remove, @to_add, @to_add_binary); + foreach my $line (`cvs -nq update`) { + if ($line =~ /^\? (\S+)/) { + if (-B $1) { + push(@to_add_binary, $1); + } else { + push(@to_add, $1); + } + } + if ($line =~ /^U (\S+)/) { + push(@to_remove, $1); + } + } + if (@to_remove) { + my $to_remove = join(' ', @to_remove); + print "removing file(s) $to_remove\n" if $self->{_verbose}; + system("cvs -Q remove $to_remove"); + } + if (@to_add) { + my $to_add = join(' ', @to_add); + print "adding text file(s) $to_add\n" if $self->{_verbose}; + system("cvs -Q add $to_add"); + } + if (@to_add_binary) { + my $to_add_binary = join(' ', @to_add_binary); + print "adding binary file(s) $to_add_binary\n" if $self->{_verbose}; + system("cvs -Q add -kb $to_add_binary"); + } + + print "committing current directory\n" if $self->{_verbose}; + system("cvs -Q commit -m $version-$release") unless $self->{_test}; + + # tag new release + my $tag = "r$version-$release"; + $tag =~ s/\./_/g; + print "tagging current directory as $tag\n" if $self->{_verbose}; + system("cvs -Q tag $tag") unless $self->{_test}; + + # get back to original directory + chdir $original_dir; + +} + +=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/Action/Clean.pm b/lib/Youri/Submit/Action/Clean.pm new file mode 100644 index 0000000..fa19254 --- /dev/null +++ b/lib/Youri/Submit/Action/Clean.pm @@ -0,0 +1,40 @@ +# $Id: Clean.pm 4742 2007-01-30 09:49:58Z pixel $ +package Youri::Submit::Action::Clean; + +=head1 NAME + +Youri::Submit::Action::Clean - Old revisions cleanup + +=head1 DESCRIPTION + +This action plugin ensures cleanup of old package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Action/; + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + foreach my $replaced_package ( + $repository->get_replaced_packages($package, $target, $define) + ) { + my $file = $replaced_package->as_file(); + print "deleting file $file\n" if $self->{_verbose}; + unlink $file unless $self->{_test}; + } +} + +=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/Action/DkmsModuleInfo.pm b/lib/Youri/Submit/Action/DkmsModuleInfo.pm new file mode 100644 index 0000000..d1dd4a8 --- /dev/null +++ b/lib/Youri/Submit/Action/DkmsModuleInfo.pm @@ -0,0 +1,111 @@ +# $Id$ +package Youri::Submit::Action::DkmsModuleInfo; + +=head1 NAME + +Youri::Submit::Action::DkmsModuleInfo - extract and commit info from dkms package. + +=head1 DESCRIPTION + +This action plugin extract modalias and description from dkms packages and commit them +on a SVN module. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Action/; +use File::Temp qw/tempdir/; +use File::Basename; +use SVN::Client; + +#- inlineed from MDK::Common::Various +sub chomp_ { my @l = @_; chomp @l; wantarray() ? @l : $l[0] } + +sub _init { + my ($self, %options) = @_; + + croak "undefined svn module" unless $options{svn_module}; + + foreach my $var ('svn_module') { + $self->{"_$var"} = $options{$var}; + } + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my ($dkms_name) = $package->get_canonical_name =~ /^dkms-(.*)$/ or return; + my $package_name = $package->get_name; + my ($kver) = $package_name =~ /^$dkms_name-kernel-(.*)$/ or return; + + my @files = map { $_->[0] } $package->get_files; + my @module_files = grep { m!^(/lib/modules/|/var/lib/dkms-binary/).*\.ko(\.gz)?$! } @files + or return; + + print "Submit::Action::DkmsModuleInfo: proceeding with $package_name\n" if $self->{_verbose}; + + my $tempdir = tempdir(CLEANUP => 1); + my $file = $package->as_file; + my $cmd = "rpm2cpio $file | (cd $tempdir ; cpio --quiet -id)"; + print "Submit::Action::DkmsModuleInfo: doing $cmd\n" if $self->{_verbose}; + if (system($cmd) != 0) { + print "Submit::Action::DkmsModuleInfo: failed!\n" if $self->{_verbose}; + return; + } + + my @fields = qw(description alias); + + my (%modules); + foreach my $file (@module_files) { + print "Submit::Action::DkmsModuleInfo: extracting $file\n" if $self->{_verbose}; + my $module = $file; + $module =~ s!.*/!!; + $module =~ s!\.ko(\.gz)$!!; + $modules{$module}{$_} = [ chomp_(`/sbin/modinfo -F $_ $tempdir$file`) ] + foreach @fields; + } + + eval { + my $svn = SVN::Client->new(); + my $dir = $tempdir . '/' . basename($self->{_svn_module}); + my $revision = $svn->checkout($self->{_svn_module}, $dir, 'HEAD', 0); + my $vdir = $dir . '/' . $kver; + $svn->update($vdir, 'HEAD', 0); + -d $vdir or $svn->mkdir($vdir); + foreach my $module (keys %modules) { + print "Submit::Action::DkmsModuleInfo: adding module $module\n" if $self->{_verbose}; + foreach my $field (@fields) { + my $file = "$vdir/$module.$field"; + $svn->update($file, 'HEAD', 0); + my $exists = -f $file; + open(my $fh, ">", $file); + print $fh map { "$_\n" } @{$modules{$module}{$field}}; + $svn->add($file, 1) if !$exists; + } + } + + $svn->log_msg(sub { $_[0] = \"add dkms info for $dkms_name with kernel $kver" }); + $svn->commit($vdir, 0); + }; + if (my $error = $@) { + print "Submit::Action::DkmsModuleInfo: commit to svn failed ($error)!\n" if $self->{_verbose}; + 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/Submit/Action/Install.pm b/lib/Youri/Submit/Action/Install.pm new file mode 100644 index 0000000..80e8de2 --- /dev/null +++ b/lib/Youri/Submit/Action/Install.pm @@ -0,0 +1,75 @@ +# $Id: Install.pm 229772 2007-09-26 11:21:07Z blino $ +package Youri::Submit::Action::Install; + +=head1 NAME + +Youri::Submit::Action::Install - Package installation + +=head1 DESCRIPTION + +This action plugin ensures installation of new package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use File::Basename; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + @_ + ); + + $self->{_perms} = $options{perms}; + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->as_file(); + my $rpm = basename($package->get_file_name()); + my $dest = $repository->get_install_dir($package, $target, $define); + + # FIXME remove prefix this should be done by a function + $rpm =~ s/^\d{14}\.\w*\.\w+\.\d+_//; + $rpm =~ s/^\@\d+://; + print "installing file $file to $dest/$rpm\n" if $self->{_verbose}; + + unless ($self->{_test}) { + # create destination dir if needed + if (! -d $dest) { + my $status = + system("install -d -m " . ($self->{_perms} + 111) . " $dest"); + croak "Unable to create directory $dest: $?" if $status; + } + + # install file to new location + my $status = + system("install -m $self->{_perms} $file $dest/$rpm"); + croak "Unable to install file $file to $dest/$rpm: $?" if $status; + + my $arch = $package->get_arch(); + $repository->set_arch_changed($target, $arch); + $repository->set_install_dir_changed($dest); + } + $package->{_file} = "$dest/$rpm"; + print "deleting file $file\n" if $self->{_verbose}; + unlink $file unless $self->{_test}; +} + +=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/Action/Link.pm b/lib/Youri/Submit/Action/Link.pm new file mode 100644 index 0000000..336eafb --- /dev/null +++ b/lib/Youri/Submit/Action/Link.pm @@ -0,0 +1,80 @@ +# $Id: Link.pm 233641 2008-01-31 16:35:55Z pixel $ +package Youri::Submit::Action::Link; + +=head1 NAME + +Youri::Submit::Action::Link - Noarch packages linking + +=head1 DESCRIPTION + +This action plugin ensures linking of noarch packages between arch-specific +directories. + +=cut + +use warnings; +use strict; +use Carp; +use Cwd; +use File::Spec; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + symbolic => 0, # use symbolic linking + @_ + ); + + $self->{_symbolic} = $options{symbolic}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + # only needed for noarch packages + return unless $package->get_arch() eq 'noarch'; + + my $default_dir = $repository->get_install_dir($package, $target, $define); + my $file = $package->get_file_name(); + + # FIXME remove prefix this should be done by a function + $file =~ s/^\d{14}\.\w*\.\w+\.\d+_//; + $file =~ s/^\@\d+://; + + foreach my $arch ($repository->get_extra_arches()) { + # compute installation target, forcing arch + my $other_dir = $repository->get_install_dir( + $package, + $target, + $define, + { arch => $arch } + ); + + if (! $self->{_test}) { + my $current_dir = cwd(); + chdir $other_dir; + my $default_file = File::Spec->abs2rel($default_dir) . '/' . $file; + if ($self->{_symbolic}) { + symlink $default_file, $file; + } else { + link $default_file, $file; + } + chdir $current_dir; + print "set_install_dir_changed($other_dir) for updated $file\n"; + $repository->set_install_dir_changed($other_dir); + $repository->set_arch_changed($target, $arch); + } + } +} + +=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/Action/Mail.pm b/lib/Youri/Submit/Action/Mail.pm new file mode 100644 index 0000000..c9bbcbe --- /dev/null +++ b/lib/Youri/Submit/Action/Mail.pm @@ -0,0 +1,131 @@ +# $Id: Mail.pm 223952 2007-06-23 13:54:13Z pixel $ +package Youri::Submit::Action::Mail; + +=head1 NAME + +Youri::Submit::Action::Mail - Mail notification + +=head1 DESCRIPTION + +This action plugin ensures mail notification of new package revisions. + +=cut + +use warnings; +use strict; +use MIME::Entity; +use Encode qw/from_to/; +use Carp; +use Youri::Package; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + mta => '/usr/sbin/sendmail', + to => '', + from => '', + cc => '', + prefix => '', + encoding => 'quoted-printable', + charset => 'iso-8859-1', + @_ + ); + + croak "undefined mail MTA" unless $options{mta}; + croak "invalid mail MTA $options{mta}" unless -x $options{mta}; + croak "undefined to" unless $options{to}; + if ($options{cc}) { + croak "cc should be an hashref" unless ref $options{cc} eq 'HASH'; + } + croak "invalid charset $options{charset}" + unless Encode::resolve_alias($options{charset}); + + $self->{_mta} = $options{mta}; + $self->{_to} = $options{to}; + $self->{_from} = $options{from}; + $self->{_cc} = $options{cc}; + $self->{_prefix} = $options{prefix}; + $self->{_encoding} = $options{encoding}; + $self->{_charset} = $options{charset}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + return unless $package->is_source(); + + my $from = $package->get_packager(); + + # force from adress if defined + $from =~ s/<.*>/<$self->{_from}>/ if $self->{_from}; + + my $subject = $self->get_subject($package, $repository, $target, $define); + my $content = $self->get_content($package, $repository, $target, $define); + + # ensure proper codeset conversion + # for informations coming from package + my $charset = $repository->get_package_charset(); + from_to($content, $charset, $self->{_charset}); + from_to($subject, $charset, $self->{_charset}); + + my $mail = MIME::Entity->build( + Type => 'text/plain', + Charset => $self->{_charset}, + Encoding => $self->{_encoding}, + From => $from, + To => $self->{_to}, + Subject => $subject, + Data => $content, + ); + + if ($self->{_cc}) { + my $cc = $self->{_cc}->{$package->get_name()}; + $mail->head()->add('cc', $cc) if $cc; + } + + if ($self->{_test}) { + $mail->print(\*STDOUT); + } else { + open(MAIL, "| $self->{_mta} -t -oi -oem") or die "Can't open MTA program: $!"; + $mail->print(\*MAIL); + close MAIL; + } + +} + +sub get_subject { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $section = $repository->_get_section($package, $target, $define); + return + ($self->{_prefix} ? '[' . $self->{_prefix} . '] ' : '' ) . + "$target " . ($section ? "$section " : '' ) . + $package->as_formated_string('%{name}-%{version}-%{release}'); +} + +sub get_content { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $information = $package->get_information(); + my $last_change = $package->get_last_change(); + + return + $information . "\n" . + $last_change->[Youri::Package::CHANGE_AUTHOR] . ":\n" . + $last_change->[Youri::Package::CHANGE_TEXT]; +} + + +=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/Action/Markrelease.pm b/lib/Youri/Submit/Action/Markrelease.pm new file mode 100644 index 0000000..a409c7c --- /dev/null +++ b/lib/Youri/Submit/Action/Markrelease.pm @@ -0,0 +1,56 @@ +# $Id: Markrelease.pm 4743 2007-01-30 09:58:30Z pixel $ +package Youri::Submit::Action::Markrelease; + +=head1 NAME + +Youri::Submit::Action::Markrelease - calls markrelease + +=head1 DESCRIPTION + +This action plugin calls markrelease + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + @_ + ); + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + $package->is_source or return 1; + my $file = $package->get_file(); + my $srpm_name = $package->get_canonical_name; + + if ($repository->package_in_svn($srpm_name)) { + my $svn = $repository->get_svn_url(); + my ($rev) = $file =~ /.*\/.*?\@(\d+):/; + print "Run repsys markrelease -f $file -r $rev $svn/$srpm_name\n"; + # FIXME repsys ask for a username and password + # FIXME we should use the key in /var/home/mandrake so that /home/mandrake does not + # need to be mounted + system('repsys', 'markrelease', '-f', $file, '-r', $rev, "$svn/$srpm_name"); + } + 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/Submit/Action/RSS.pm b/lib/Youri/Submit/Action/RSS.pm new file mode 100644 index 0000000..51da825 --- /dev/null +++ b/lib/Youri/Submit/Action/RSS.pm @@ -0,0 +1,102 @@ +# $Id: RSS.pm 1700 2006-10-16 12:57:42Z warly $ +package Youri::Submit::Action::RSS; + +=head1 NAME + +Youri::Submit::Action::RSS - RSS notification + +=head1 DESCRIPTION + +This action plugin ensures RSS notification of new package revisions. + +=cut + +use warnings; +use strict; +use XML::RSS; +use Encode qw/from_to/; +use Carp; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + file => '', + title => '', + link => '', + description => '', + charset => 'iso-8859-1', + max_items => 10, + @_ + ); + + croak "undefined rss file" unless $options{file}; + croak "invalid charset $options{charset}" + unless Encode::resolve_alias($options{charset}); + + $self->{_file} = $options{file}; + $self->{_title} = $options{title}; + $self->{_link} = $options{link}; + $self->{_description} = $options{description}; + $self->{_charset} = $options{charset}; + $self->{_max_items} = $options{max_items}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + return unless $package->is_source(); + + my $subject = $package->as_formated_string('%{name}-%{version}-%{release}'); + my $content = $package->get_information(); + + $content =~ s/$//mg; + + # ensure proper codeset conversion + # for informations coming from package + my $charset = $repository->get_package_charset(); + from_to($content, $charset, $self->{_charset}); + from_to($subject, $charset, $self->{_charset}); + + my $rss = XML::RSS->new( + encoding => $self->{_charset}, + encode_output => 1 + ); + + my $file = $self->{_file}; + if (-e $file) { + $rss->parsefile($file); + splice(@{$rss->{items}}, $self->{_max_items}) + if @{$rss->{items}} >= $self->{_max_items}; + } else { + $rss->channel( + title => $self->{_title}, + link => $self->{_link}, + description => $self->{_description}, + language => 'en' + ); + } + + $rss->add_item( + title => $subject, + description => $content, + mode => 'insert' + ); + + if ($self->{_test}) { + print $rss->as_string(); + } else { + $rss->save($file); + } +} + +=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/Action/Rpminfo.pm b/lib/Youri/Submit/Action/Rpminfo.pm new file mode 100644 index 0000000..c96efb1 --- /dev/null +++ b/lib/Youri/Submit/Action/Rpminfo.pm @@ -0,0 +1,69 @@ +# $Id: Rpminfo.pm 4742 2007-01-30 09:49:58Z pixel $ +package Youri::Submit::Action::Rpminfo; + +=head1 NAME + +Youri::Submit::Action::RpmInfo - Creates .info files + +=head1 DESCRIPTION + +This action plugin ensures the creation of .info files + +=cut + +use warnings; +use strict; +use Carp; +use File::Basename; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + uphost => '', + user => '', + ssh_key => '', + verbose => '', + @_ + ); + croak "undefined upload host" unless $options{uphost}; + croak "undefined ssh key" unless $options{ssh_key}; + + foreach my $var ('perms', 'user', 'uphost', 'ssh_key', 'verbose') { + $self->{"_$var"} = $options{$var}; + } + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->get_file(); + my $dest = $repository->get_upload_dir($package, $target, $define); + + print "Caching rpm information $file on $dest\n" if $self->{_verbose}; + my $base = basename ($file); + $dest =~ s/\/[0-9]{14}\./\/*./; + + my $cmd = "ssh -i $self->{_ssh_key} $self->{_user}\@$self->{_uphost} \"srpm=`echo /$dest$base`; rpm -q --qf '\%{name}\n\%{epoch}\n\%{version}-\%{release}\n\%{summary}\n' -p \\\$srpm > \\\$srpm.info\""; + print "Submit::Action::RpmInfo: doing $cmd\n" if $self->{_verbose}; + if (!$self->{_test}) { + if (!system($cmd)) { + print "Submit::Action::RpmInfo: rpminfo succeeded!\n"; + return 1 + } + print "Submit::Action::RpmInfo: rpminfo failed!\n"; + } +} +=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/Action/Send.pm b/lib/Youri/Submit/Action/Send.pm new file mode 100644 index 0000000..9ba630b --- /dev/null +++ b/lib/Youri/Submit/Action/Send.pm @@ -0,0 +1,77 @@ +# $Id: Send.pm 4744 2007-01-30 09:59:07Z pixel $ +package Youri::Submit::Action::Send; + +=head1 NAME + +Youri::Submit::Action::Send - upload package + +=head1 DESCRIPTION + +This action plugin uploads the package on uphost + +=cut + +use warnings; +use strict; +use Carp; +use File::Basename; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + uphost => '', + user => '', + ssh_key => '', + verbose => '', + keep_svn_release => '', + @_ + ); + croak "undefined upload host" unless $options{uphost}; + croak "undefined ssh key" unless $options{ssh_key}; + + foreach my $var ('perms', 'user', 'uphost', 'ssh_key', 'verbose', 'keep_svn_release') { + $self->{"_$var"} = $options{$var}; + } + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->get_file(); + my $dest = $repository->get_upload_dir($package, $target, $define); + + print "Sending file $file to $dest\n" if $self->{_verbose}; + my $base; + if ($self->{_keep_svn_release}) { + $base = basename($file) + } else { + ($base) = $file =~ /.*\/(?:@\d+:)?([^\/]*)/ + } + + my $cmd = "scp -i $self->{_ssh_key} $file $self->{_user}\@$self->{_uphost}:/$dest$base.new"; + my $cmd2 = "ssh -i $self->{_ssh_key} $self->{_user}\@$self->{_uphost} \"mv /$dest$base.new /$dest$base\""; + print "Submit::Action::Send: doing $cmd\n$cmd2\n" if 1 || $self->{_verbose}; + if (!$self->{_test}) { + if (!system($cmd)) { + if (!system($cmd2)) { + print "Submit::Action::Send: upload succeeded!\n"; + return 1 + } + } + print "Submit::Action::Send: upload failed!\n"; + } +} +=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/Action/Sendcache.pm b/lib/Youri/Submit/Action/Sendcache.pm new file mode 100644 index 0000000..9ea14ea --- /dev/null +++ b/lib/Youri/Submit/Action/Sendcache.pm @@ -0,0 +1,81 @@ +# $Id: Sendcache.pm 232350 2007-12-07 18:26:17Z spuk $ +package Youri::Submit::Action::Sendcache; + +=head1 NAME + +Youri::Submit::Action::Sendcache - upload package to cache + +=head1 DESCRIPTION + +This action plugin uploads the package on uphost + +=cut + +use warnings; +use strict; +use Carp; +use File::Basename; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + uphost => '', + user => '', + ssh_key => '', + verbose => '', + root => '', + debug_pkgs => 0, + @_ + ); + croak "undefined upload host" unless $options{uphost}; + croak "undefined ssh key" unless $options{ssh_key}; + + foreach my $var ('perms', 'user', 'uphost', 'ssh_key', 'verbose', 'root', 'debug_pkgs') { + $self->{"_$var"} = $options{$var}; + } + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + # only cache debug packages if option debug_pkgs is true + return if ($package->is_debug() && !$self->{_debug_pkgs}); + + my $file = $package->get_file(); + my $dest = $repository->get_upload_dir($package, $target, $define); + $dest =~ s!$repository->{_upload_root}/$repository->{_queue}!$self->{_root}!; + + print "Sending file $file to $dest\n" if $self->{_verbose}; + my $destfile = "$dest".basename($file); + $destfile =~ s,/[^/_]+_([^/]+)$,/$1,; + $destfile =~ s,/@\d+:,/,; + my $destfilehidden = $destfile; + $destfilehidden =~ s,/([^/]+)$,/.$1,; + + my $cmd = "scp -i $self->{_ssh_key} $file $self->{_user}\@$self->{_uphost}:/$destfilehidden"; + my $cmd2 = "ssh -i $self->{_ssh_key} $self->{_user}\@$self->{_uphost} \"mv /$destfilehidden /$destfile\""; + print "Submit::Action::Send: doing $cmd\n$cmd2\n" if 1 || $self->{_verbose}; + if (!$self->{_test}) { + if (!system($cmd)) { + if (!system($cmd2)) { + print "Submit::Action::Sendcache: upload succeeded!\n"; + return 1 + } + } + print "Submit::Action::Sendcache: upload failed!\n"; + } +} +=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/Action/Sign.pm b/lib/Youri/Submit/Action/Sign.pm new file mode 100644 index 0000000..f016351 --- /dev/null +++ b/lib/Youri/Submit/Action/Sign.pm @@ -0,0 +1,56 @@ +# $Id: Sign.pm 1700 2006-10-16 12:57:42Z warly $ +package Youri::Submit::Action::Sign; + +=head1 NAME + +Youri::Submit::Action::Sign - GPG signature + +=head1 DESCRIPTION + +This action plugin ensures GPG signature of packages. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + name => '', + path => $ENV{HOME} . '/.gnupg', + passphrase => '', + @_ + ); + + croak "undefined name" unless $options{name}; + croak "undefined path" unless $options{path}; + croak "invalid path $options{path}" unless -d $options{path}; + + $self->{_name} = $options{name}; + $self->{_path} = $options{path}; + $self->{_passphrase} = $options{passphrase}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + $package->sign( + $self->{_name}, + $self->{_path}, + $self->{_passphrase} + ) unless $self->{_test}; +} + +=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/Action/Unpack.pm b/lib/Youri/Submit/Action/Unpack.pm new file mode 100644 index 0000000..03444df --- /dev/null +++ b/lib/Youri/Submit/Action/Unpack.pm @@ -0,0 +1,82 @@ +# $Id: Unpack.pm 115370 2007-01-30 09:59:07Z pixel $ +package Youri::Submit::Action::Unpack; + +=head1 NAME + +Youri::Submit::Action::Unpack - unpack package files + +=head1 DESCRIPTION + +This action plugin unpack package files somewhere. +When unpack_inside_distribution_root is set, dest_directory is relative to the distribution root. +When the package is a noarch, the wanted files are unpacked in distribution root of each archs. + +=cut + +use warnings; +use strict; +use Carp; +use File::Temp qw/tempdir/; +use base qw/Youri::Submit::Action/; + +sub _init { + my ($self, %options) = @_; + + croak "undefined package name" unless $options{name}; + croak "undefined source sub directory" unless $options{source_subdir}; + croak "undefined destination directory" unless $options{dest_directory}; + + foreach my $var ('name', 'dest_directory', 'source_subdir', 'grep_files', 'unpack_inside_distribution_root') { + $self->{"_$var"} = $options{$var}; + } + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + $package->get_name eq $self->{_name} or return; + + my @dests = $self->{_unpack_inside_distribution_root} ? + (map { "$_/$self->{_dest_directory}" } $repository->get_distribution_roots($package, $target)) + : $self->{_dest_directory}; + my $file = $package->as_file; + print "Unpacking rpm $file$self->{_source_subdir} to @dests\n" if $self->{_verbose}; + + my $tempdir = tempdir(CLEANUP => 1); + + my $cmd = "rpm2cpio $file | (cd $tempdir ; cpio -id)"; + print "Submit::Action::Unpack: doing $cmd\n" if $self->{_verbose}; + if (!$self->{_test} && system($cmd) != 0) { + print "Submit::Action::Unpack: failed!\n" if $self->{_verbose}; + return; + } + + foreach my $dest (@dests) { + my $find_grep = $self->{_grep_files} ? "find | grep '$self->{_grep_files}'" : 'find'; + my $cmd = "cd $tempdir/$self->{_source_subdir}; $find_grep | cpio -pdu $dest"; + print "Submit::Action::Unpack: doing $cmd\n" if $self->{_verbose}; + if (!$self->{_test}) { + my @l = glob("$tempdir/$self->{_source_subdir}"); + if (@l == 1 && -d $l[0]) { + if (system($cmd) != 0) { + print "Submit::Action::Unpack: failed!\n" if $self->{_verbose}; + } + } else { + print "Submit::Action::Unpack: directory $self->{_source_subdir} doesn't exist in package $self->{_name}\n"; + } + } + } +} + +=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/Action/UpdateMdvDb.pm b/lib/Youri/Submit/Action/UpdateMdvDb.pm new file mode 100644 index 0000000..7906080 --- /dev/null +++ b/lib/Youri/Submit/Action/UpdateMdvDb.pm @@ -0,0 +1,62 @@ +# $Id$ +package Youri::Submit::Action::UpdateMdvDb; + +=head1 NAME + +Youri::Submit::Action::UpdateMdvDb - Mandriva maintainers database updater + +=head1 DESCRIPTION + +This action plugin calls an external script to update last commit info, as +well as add new packages, in the package maintainers database at +. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Action/; + +sub _init { + my $self = shift; + my %options = ( + @_ + ); + + # path for mdvdb-updaterep script + $self->{_mdvdb_updaterep} = $options{mdvdb_updaterep}; + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + # only SRPMs matter + return unless $package->is_source(); + + unless ($self->{_test}) { + my $pkg_name = $package->get_name(); + my $pkg_media = $repository->_get_main_section($package, $target, $define); + $package->get_packager() =~ m/(\w[-_.\w]+\@[-_.\w]+)\W/; + my $pkg_commiter = $1; + + if (system($self->{_mdvdb_updaterep}, "update", $pkg_name, $pkg_media, $pkg_commiter, "youri")) { + print "ERROR: ".$self->{_mdvdb_updaterep}." failed for '$pkg_name', '$pkg_media', '$pkg_commiter'.\n"; + } else { + print "Updated package maintainers DB for '$pkg_name', '$pkg_media', '$pkg_commiter'.\n" if $self->{_verbose}; + } + } +} + +=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.pm b/lib/Youri/Submit/Check.pm new file mode 100644 index 0000000..cfa8f04 --- /dev/null +++ b/lib/Youri/Submit/Check.pm @@ -0,0 +1,27 @@ +# $Id: Base.pm 631 2006-01-26 22:22:23Z guillomovitch $ +package Youri::Submit::Check; + +=head1 NAME + +Youri::Submit::Check - Abstract check plugin + +=head1 DESCRIPTION + +This abstract class defines check plugin interface. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Plugin/; + +=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/ACL.pm b/lib/Youri/Submit/Check/ACL.pm new file mode 100644 index 0000000..925dc00 --- /dev/null +++ b/lib/Youri/Submit/Check/ACL.pm @@ -0,0 +1,71 @@ +# $Id: ACL.pm 4817 2007-02-09 19:39:05Z blino $ +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 new file mode 100644 index 0000000..c127ed6 --- /dev/null +++ b/lib/Youri/Submit/Check/History.pm @@ -0,0 +1,61 @@ +# $Id: History.pm 1707 2006-10-16 16:26:42Z warly $ +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 new file mode 100644 index 0000000..cadda4c --- /dev/null +++ b/lib/Youri/Submit/Check/Host.pm @@ -0,0 +1,63 @@ +# $Id: Host.pm 230850 2007-10-04 20:07:25Z blino $ +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 for arch $arch"; +} + +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 new file mode 100644 index 0000000..c5f1a9e --- /dev/null +++ b/lib/Youri/Submit/Check/Precedence.pm @@ -0,0 +1,58 @@ +# $Id: Precedence.pm 1707 2006-10-16 16:26:42Z warly $ +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 new file mode 100644 index 0000000..170d2af --- /dev/null +++ b/lib/Youri/Submit/Check/Queue_recency.pm @@ -0,0 +1,40 @@ +# $Id: Queue_recency.pm 4747 2007-01-30 10:02:41Z pixel $ +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 new file mode 100644 index 0000000..04994b8 --- /dev/null +++ b/lib/Youri/Submit/Check/Recency.pm @@ -0,0 +1,64 @@ +# $Id: Recency.pm 224793 2007-07-08 02:44:48Z spuk $ +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) { + my $section = $repository->_get_section($package, $target, $define); + push( + @errors, + "Current or newer revision(s) already exists in $section for $target: " . + join(', ', @revisions) + ); + } + + my $defined_section = $define->{section}; + + # if the user provided a section, check also in the default section + if ($defined_section) { + $define->{section} = undef; + my @default_revisions = $repository->get_revisions($package, $target, $define, undef, sub { return $_[0]->compare($package) >= 0 }); + if (@default_revisions) { + my $section = $repository->_get_section($package, $target, $define); + push( + @errors, + "Current or newer revision(s) already exists in $section for $target: " . + join(', ', @default_revisions) + ); + } + $define->{section} = $defined_section; + } + + 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 new file mode 100644 index 0000000..c57dd60 --- /dev/null +++ b/lib/Youri/Submit/Check/Rpmlint.pm @@ -0,0 +1,90 @@ +# $Id: Rpmlint.pm 234384 2008-02-12 09:42:32Z blino $ +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(my $RPMLINT, "$command |") or die "Can't run $command: $!"; + while (my $line = <$RPMLINT>) { + $line =~ /^[EW]: \S+ (\S+)(.*)$/ # old rpmlint format + || $line =~ /^\S+: [EW]: (\S+)(.*)$/ or next; # new rpmlint format + my ($id, $value) = ($1, $2); + 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 new file mode 100644 index 0000000..e3362c8 --- /dev/null +++ b/lib/Youri/Submit/Check/SVN.pm @@ -0,0 +1,79 @@ +# $Id: SVN.pm 4747 2007-01-30 10:02:41Z pixel $ +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 new file mode 100644 index 0000000..4ff1675 --- /dev/null +++ b/lib/Youri/Submit/Check/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/Check/Source.pm b/lib/Youri/Submit/Check/Source.pm new file mode 100644 index 0000000..9c47f5d --- /dev/null +++ b/lib/Youri/Submit/Check/Source.pm @@ -0,0 +1,45 @@ +# $Id: Source.pm 4747 2007-01-30 10:02:41Z pixel $ +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 new file mode 100644 index 0000000..c0f9b9c --- /dev/null +++ b/lib/Youri/Submit/Check/Tag.pm @@ -0,0 +1,61 @@ +# $Id: Tag.pm 1707 2006-10-16 16:26:42Z warly $ +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 new file mode 100644 index 0000000..d95af5a --- /dev/null +++ b/lib/Youri/Submit/Check/Type.pm @@ -0,0 +1,54 @@ +# $Id: Type.pm 4747 2007-01-30 10:02:41Z pixel $ +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 new file mode 100644 index 0000000..a9c2ae8 --- /dev/null +++ b/lib/Youri/Submit/Check/Version.pm @@ -0,0 +1,102 @@ +# $Id: Version.pm 267050 2010-03-23 17:36:49Z nvigier $ +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') { + my $user = $define->{user}; + return if (defined($opt->{authorized_users}) && $user =~ /^($opt->{authorized_users})$/); + # 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/Plugin.pm b/lib/Youri/Submit/Plugin.pm new file mode 100644 index 0000000..4c72ff7 --- /dev/null +++ b/lib/Youri/Submit/Plugin.pm @@ -0,0 +1,93 @@ +# $Id: Plugin.pm 4746 2007-01-30 10:01:14Z pixel $ +package Youri::Submit::Plugin; + +=head1 NAME + +Youri::Submit::Plugin - Abstract youri-submit plugin + +=head1 DESCRIPTION + +This abstract class defines youri-submit plugin interface. + +=cut + +use warnings; +use strict; +use Carp; + +=head1 CLASS METHODS + +=head2 new(%args) + +Creates and returns a new Youri::Submit::Plugin object. + +No generic parameters (subclasses may define additional ones). + +Warning: do not call directly, call subclass constructor instead. + +=cut + +sub new { + my $class = shift; + croak "Abstract class" if $class eq __PACKAGE__; + + my %options = ( + id => '', # object id + test => 0, # test mode + verbose => 0, # verbose mode + @_ + ); + + my $self = bless { + _id => $options{id}, + _test => $options{test}, + _verbose => $options{verbose}, + }, $class; + + $self->_init(%options); + + return $self; +} + +sub _init { + # do nothing +} + +=head1 INSTANCE METHODS + +=head2 get_id() + +Returns plugin identity. + +=cut + +sub get_id { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_id}; +} + +=head2 run($package, $repository, $target, $define) + +Execute action on given L object. + +=head1 SUBCLASSING + +The following methods have to be implemented: + +=over + +=item run + +=back + +=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/Post.pm b/lib/Youri/Submit/Post.pm new file mode 100644 index 0000000..b708b11 --- /dev/null +++ b/lib/Youri/Submit/Post.pm @@ -0,0 +1,27 @@ +# $Id: Post.pm 4746 2007-01-30 10:01:14Z pixel $ +package Youri::Submit::Post; + +=head1 NAME + +Youri::Submit::Post - Abstract post plugin + +=head1 DESCRIPTION + +This abstract class defines post plugin interface. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Plugin/; + +=head1 COPYRIGHT AND LICENSE + +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 new file mode 100644 index 0000000..977e2a0 --- /dev/null +++ b/lib/Youri/Submit/Post/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/Post/Gendistrib.pm b/lib/Youri/Submit/Post/Gendistrib.pm new file mode 100644 index 0000000..98205c7 --- /dev/null +++ b/lib/Youri/Submit/Post/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/Post/Genhdlist2.pm b/lib/Youri/Submit/Post/Genhdlist2.pm new file mode 100644 index 0000000..60886ef --- /dev/null +++ b/lib/Youri/Submit/Post/Genhdlist2.pm @@ -0,0 +1,82 @@ +# $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(); + 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 --versioned --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; + + { + require MDV::Distribconf::Build; + my $distrib = MDV::Distribconf::Build->new("$root/$target/$arch"); + $distrib->loadtree or die "$root/$target/$arch does not seem to be a distribution tree\n"; + $distrib->parse_mediacfg; + $distrib->write_version($distrib->getfullpath(undef, "VERSION")); + print "updated $root/$target/$arch/VERSION\n"; + } + } + 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.pm b/lib/Youri/Submit/Pre.pm new file mode 100644 index 0000000..2d5b5c8 --- /dev/null +++ b/lib/Youri/Submit/Pre.pm @@ -0,0 +1,27 @@ +# $Id: Pre.pm 4746 2007-01-30 10:01:14Z pixel $ +package Youri::Submit::Pre; + +=head1 NAME + +Youri::Submit::Pre - Abstract pre plugin + +=head1 DESCRIPTION + +This abstract class defines pre plugin interface. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Plugin/; + +=head1 COPYRIGHT AND LICENSE + +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/Pre/Rsync.pm b/lib/Youri/Submit/Pre/Rsync.pm new file mode 100644 index 0000000..accaace --- /dev/null +++ b/lib/Youri/Submit/Pre/Rsync.pm @@ -0,0 +1,87 @@ +# $Id: Rsync.pm 267280 2010-04-01 19:57:53Z bogdano $ +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 --exclude '*.new' --exclude '.*' --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/Reject.pm b/lib/Youri/Submit/Reject.pm new file mode 100644 index 0000000..7d70e22 --- /dev/null +++ b/lib/Youri/Submit/Reject.pm @@ -0,0 +1,27 @@ +# $Id: Reject.pm 4746 2007-01-30 10:01:14Z pixel $ +package Youri::Submit::Reject; + +=head1 NAME + +Youri::Submit::Reject - Abstract reject plugin + +=head1 DESCRIPTION + +This abstract class defines reject plugin interface. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Plugin/; + +=head1 COPYRIGHT AND LICENSE + +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/Reject/Archive.pm b/lib/Youri/Submit/Reject/Archive.pm new file mode 100644 index 0000000..e90bc19 --- /dev/null +++ b/lib/Youri/Submit/Reject/Archive.pm @@ -0,0 +1,61 @@ +# $Id: Archive.pm 4747 2007-01-30 10:02:41Z pixel $ +package Youri::Submit::Reject::Install; + +=head1 NAME + +Youri::Submit::Action::Archive - 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::Reject/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + @_ + ); + + $self->{_perms} = $options{perms}; + + return $self; +} + +sub run { + my ($self, $package, $errors, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->get_file(); + my $rpm = $package->get_file_name(); + my $dest = $repository->get_reject_dir($package, $target, $define); + + # FIXME remove prefix this should be done by a function + $rpm =~ s/^\d{14}\.\w+\.\w+\.\d+_//; + print "installing file $file to $dest/$rpm\n" ;#if $self->{_verbose}; + + unless ($self->{_test}) { + # create destination dir if needed + system("install -d -m " . ($self->{_perms} + 111) . " $dest/") + unless -d $dest; + + # install file to new location + system("install -m $self->{_perms} $file $dest/$rpm"); + } +} + +=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/Reject/Clean.pm b/lib/Youri/Submit/Reject/Clean.pm new file mode 100644 index 0000000..9d6d003 --- /dev/null +++ b/lib/Youri/Submit/Reject/Clean.pm @@ -0,0 +1,36 @@ +# $Id: Clean.pm 4747 2007-01-30 10:02:41Z pixel $ +package Youri::Submit::Reject::Clean; + +=head1 NAME + +Youri::Submit::Action::Clean - Old revisions cleanup + +=head1 DESCRIPTION + +This action plugin ensures cleanup of old package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Reject/; + +sub run { + my ($self, $package, $errors, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->get_file(); + print "deleting file $file\n" if $self->{_verbose}; + unlink $file unless $self->{_test}; +} + +=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/Reject/Install.pm b/lib/Youri/Submit/Reject/Install.pm new file mode 100644 index 0000000..f5215d1 --- /dev/null +++ b/lib/Youri/Submit/Reject/Install.pm @@ -0,0 +1,63 @@ +# $Id: Install.pm 4747 2007-01-30 10:02:41Z pixel $ +package Youri::Submit::Reject::Install; + +=head1 NAME + +Youri::Submit::Action::Archive - 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::Reject/; + +sub _init { + my $self = shift; + my %options = ( + perms => 644, + @_ + ); + + $self->{_perms} = $options{perms}; + $self->{_verbose} = $options{verbose}; +} + +sub run { + my ($self, $package, $errors, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->get_file(); + my $rpm = $package->get_file_name(); + my $dest = $repository->get_reject_path($package, $target, $define); + + # FIXME remove prefix this should be done by a function + $rpm =~ s/^\d{14}\.\w+\.\w+\.\d+_//; + print "installing file $file to $dest/$rpm\n" if $self->{_verbose}; + + unless ($self->{_test}) { + # create destination dir if needed + system("install -d -m " . ($self->{_perms} + 111) . " $dest/") + unless -d $dest; + + # install file to new location + system("install -m $self->{_perms} $file $dest/$rpm"); + } + $package->{_file} = "$dest/$rpm"; + print "deleting file $file\n" if $self->{_verbose}; + unlink $file unless $self->{_test}; +} + +=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/Reject/Mail.pm b/lib/Youri/Submit/Reject/Mail.pm new file mode 100644 index 0000000..6fa50f7 --- /dev/null +++ b/lib/Youri/Submit/Reject/Mail.pm @@ -0,0 +1,112 @@ +# $Id: Mail.pm 223952 2007-06-23 13:54:13Z pixel $ +package Youri::Submit::Reject::Mail; + +=head1 NAME + +Youri::Submit::Action::Mail - Mail notification + +=head1 DESCRIPTION + +This action plugin ensures mail notification of new package revisions. + +=cut + +use warnings; +use strict; +use MIME::Entity; +use Encode qw/from_to/; +use Carp; +use Youri::Package; +use base qw/Youri::Submit::Reject/; + +sub _init { + my $self = shift; + my %options = ( + mta => '/usr/sbin/sendmail', + to => '', + from => '', + cc => '', + prefix => '', + encoding => 'quoted-printable', + charset => 'iso-8859-1', + @_ + ); + + croak "undefined mail MTA" unless $options{mta}; + croak "invalid mail MTA $options{mta}" unless -x $options{mta}; + croak "undefined to" unless $options{to}; + if ($options{cc}) { + croak "cc should be an hashref" unless ref $options{cc} eq 'HASH'; + } + croak "invalid charset $options{charset}" + unless Encode::resolve_alias($options{charset}); + + $self->{_mta} = $options{mta}; + $self->{_to} = $options{to}; + $self->{_from} = $options{from}; + $self->{_cc} = $options{cc}; + $self->{_prefix} = $options{prefix}; + $self->{_encoding} = $options{encoding}; + $self->{_charset} = $options{charset}; +} + +sub run { + my ($self, $package, $errors, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $section = $repository->_get_section($package, $target, $define); + + my $subject = + ($self->{_prefix} ? '[' . $self->{_prefix} . '] ' : '' ) . ($section ? "$section " : '') . + $package->get_revision_name(); + my $information = $package->get_information(); + my $last_change = $package->get_last_change(); + my $author = $last_change->[Youri::Package::CHANGE_AUTHOR] if $last_change; + my $list = $last_change->[Youri::Package::CHANGE_TEXT] if $last_change; + my $content = + "Errors: \n\n" . join("\n", map { + ( "* $_", (map { " - $_" } @{$errors->{$_}}), "\n"); + } sort(keys %$errors)) . "\n" . + $information . "\n" . + $author . ":\n$list"; + + # ensure proper codeset conversion + # for informations coming from package + my $charset = $repository->get_package_charset(); + from_to($content, $charset, $self->{_charset}); + from_to($subject, $charset, $self->{_charset}); + + my $mail = MIME::Entity->build( + Type => 'text/plain', + Charset => $self->{_charset}, + Encoding => $self->{_encoding}, + From => $self->{_from}, + To => $self->{_to}, + Subject => $subject, + Data => $content, + ); + + if ($self->{_cc}) { + my $cc = $self->{_cc}->{$package->get_name()}; + $mail->head()->add('cc', $cc) if $cc; + } + + if ($self->{_test}) { + $mail->print(\*STDOUT); + } else { + open(MAIL, "| $self->{_mta} -t -oi -oem") or die "Can't open MTA program: $!"; + $mail->print(\*MAIL); + close MAIL; + } + +} + +=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; -- cgit v1.2.1 From 070375858115c58bacd63ec880236f1ddac33612 Mon Sep 17 00:00:00 2001 From: Nicolas Vigier Date: Thu, 20 Jan 2011 17:10:16 +0000 Subject: use mga-signpackage script with sudo to sign packages --- lib/Youri/Submit/Action/Sign.pm | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Action/Sign.pm b/lib/Youri/Submit/Action/Sign.pm index f016351..d9580b8 100644 --- a/lib/Youri/Submit/Action/Sign.pm +++ b/lib/Youri/Submit/Action/Sign.pm @@ -19,6 +19,8 @@ use base qw/Youri::Submit::Action/; sub _init { my $self = shift; my %options = ( + signuser => 'signbot', + signscript => '/usr/bin/mga-signpackage', name => '', path => $ENV{HOME} . '/.gnupg', passphrase => '', @@ -32,17 +34,17 @@ sub _init { $self->{_name} = $options{name}; $self->{_path} = $options{path}; $self->{_passphrase} = $options{passphrase}; + $self->{_signuser} = $options{signuser}; + $self->{_signscript} = $options{signscript}; } sub run { my ($self, $package, $repository, $target, $define) = @_; croak "Not a class method" unless ref $self; - $package->sign( - $self->{_name}, - $self->{_path}, - $self->{_passphrase} - ) unless $self->{_test}; + if (! $self->{_test}) { + system('/usr/bin/sudo', '-u', $self->{_signuser}, $self->{_signscript}, $package->{_file}, $self->{_name}, $self->{_path}) == 0; + } } =head1 COPYRIGHT AND LICENSE -- cgit v1.2.1 From 9b8e206898849b530b72f9ca803eab9b711f1a4a Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Sat, 22 Jan 2011 14:49:03 +0000 Subject: Ugly code rejecting submit when buildrequires are missing --- lib/Youri/Submit/Check/Deps.pm | 87 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) create mode 100644 lib/Youri/Submit/Check/Deps.pm (limited to 'lib') diff --git a/lib/Youri/Submit/Check/Deps.pm b/lib/Youri/Submit/Check/Deps.pm new file mode 100644 index 0000000..6812d38 --- /dev/null +++ b/lib/Youri/Submit/Check/Deps.pm @@ -0,0 +1,87 @@ +package Youri::Submit::Check::Deps; + +=head1 NAME + +Youri::Submit::Check::Deps - Check dependencies + +=head1 DESCRIPTION + +This check plugin rejects packages with unresolved dependencies. + +=cut + +use warnings; +use strict; +use Carp; +use Youri::Media::URPM; +use base qw/Youri::Submit::Check/; + +sub resolvedep { + my ($media, @requires) = @_; + + my @errors; + my $index = sub { + my ($package) = @_; + + my @provides = $package->get_provides(); + + @requires = grep { + my $require = $_; + my $notfound = 1; + foreach my $provide (@provides) { + next unless $provide->[Youri::Package::DEPENDENCY_NAME] eq $require->[Youri::Package::DEPENDENCY_NAME]; + if ($require->[Youri::Package::DEPENDENCY_RANGE]) { + next unless $package->check_ranges_compatibility($provide->[Youri::Package::DEPENDENCY_RANGE], $require->[Youri::Package::DEPENDENCY_RANGE]); + } + $notfound = 0; + } + + if ($notfound && $require->[Youri::Package::DEPENDENCY_NAME] =~ m|/|) { + foreach my $file ($package->get_files()) { + next unless $file eq $require->[Youri::Package::DEPENDENCY_NAME]; + $notfound = 0; + last; + } + } + $notfound; + } @requires; + }; + $media->traverse_headers($index); + foreach my $require (@requires) { + push (@errors, "Unresolved dep on " . $require->[Youri::Package::DEPENDENCY_NAME]); + } + return @errors; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + # FIXME Define some Youri::Media with allowed_deps in the config and + # match target + section to a media + my $section = $repository->_get_section($package, $target, $define); + return unless $target eq "cauldron" && $section eq 'core/release'; + + my @requires = $package->get_requires(); + + my $path = $repository->get_install_root() . "/" . $target; + # FIXME we need dependencies on all archs except for ExclusiveArch + my $arch = 'i586'; +# foreach my $arch ($repository->get_extra_arches()) { + my $media = new Youri::Media::URPM(name => "core.".$arch, + type => "binary", + hdlist => "$path/$arch/media/$section/media_info/hdlist.cz"); + return resolvedep($media, @requires); +# } + +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2011, YOURI project + +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 From ca35aed375324b08a53226f2db2a897d9be893b0 Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Tue, 25 Jan 2011 11:03:14 +0000 Subject: Check dependencies on x86_64 as this is where the src.rpm is generated --- lib/Youri/Submit/Check/Deps.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Check/Deps.pm b/lib/Youri/Submit/Check/Deps.pm index 6812d38..fa239df 100644 --- a/lib/Youri/Submit/Check/Deps.pm +++ b/lib/Youri/Submit/Check/Deps.pm @@ -66,7 +66,9 @@ sub run { my $path = $repository->get_install_root() . "/" . $target; # FIXME we need dependencies on all archs except for ExclusiveArch - my $arch = 'i586'; + # Unfortunately some dependencies depend on the arch were the src.rpm was geenrated + # Currently src.rpm is generated on x86_64, so we need to check on that one + my $arch = 'x86_64'; # foreach my $arch ($repository->get_extra_arches()) { my $media = new Youri::Media::URPM(name => "core.".$arch, type => "binary", -- cgit v1.2.1 From 0a086e6f377ee200265c1ac8be9b0556f76bfe85 Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Thu, 27 Jan 2011 21:26:04 +0000 Subject: Display the required version of missing dep --- lib/Youri/Submit/Check/Deps.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Check/Deps.pm b/lib/Youri/Submit/Check/Deps.pm index fa239df..06567d4 100644 --- a/lib/Youri/Submit/Check/Deps.pm +++ b/lib/Youri/Submit/Check/Deps.pm @@ -48,7 +48,7 @@ sub resolvedep { }; $media->traverse_headers($index); foreach my $require (@requires) { - push (@errors, "Unresolved dep on " . $require->[Youri::Package::DEPENDENCY_NAME]); + push (@errors, "Unresolved dep on " . $require->[Youri::Package::DEPENDENCY_NAME] . " " . $require->[Youri::Package::DEPENDENCY_RANGE]); } return @errors; } -- cgit v1.2.1 From 3760bb5c7f6b2cc24cc263d7c3e8b7348b8ed5bf Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Tue, 8 Feb 2011 13:13:52 +0000 Subject: Allow submitting drakx-installer-images where BuildRequires version is in the name --- lib/Youri/Submit/Check/Deps.pm | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Check/Deps.pm b/lib/Youri/Submit/Check/Deps.pm index 06567d4..463d29a 100644 --- a/lib/Youri/Submit/Check/Deps.pm +++ b/lib/Youri/Submit/Check/Deps.pm @@ -45,10 +45,23 @@ sub resolvedep { } $notfound; } @requires; + # Try to handle BuildRequires: kernel-server-2.6.37-3.mga-1-1.mga1 + @requires = grep { + my $require = $_; + my $notfound = 1; + if (!$require->[Youri::Package::DEPENDENCY_RANGE] && + $require->[Youri::Package::DEPENDENCY_NAME] =~ /-/) { + foreach my $provide (@provides) { + next unless $require->[Youri::Package::DEPENDENCY_NAME] =~ /^$provide->[Youri::Package::DEPENDENCY_NAME]-/; + $notfound = 0; + } + } + $notfound; + } @requires; }; $media->traverse_headers($index); foreach my $require (@requires) { - push (@errors, "Unresolved dep on " . $require->[Youri::Package::DEPENDENCY_NAME] . " " . $require->[Youri::Package::DEPENDENCY_RANGE]); + push (@errors, "Unresolved dep on " . $require->[Youri::Package::DEPENDENCY_NAME] . " " . $require->[Youri::Package::DEPENDENCY_RANGE]); } return @errors; } -- cgit v1.2.1 From 106a77fcd243501b4f4eb435fa5453953df79dd1 Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Tue, 8 Feb 2011 13:30:15 +0000 Subject: Revert, the package was actually wrong --- lib/Youri/Submit/Check/Deps.pm | 15 +-------------- 1 file changed, 1 insertion(+), 14 deletions(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Check/Deps.pm b/lib/Youri/Submit/Check/Deps.pm index 463d29a..fa239df 100644 --- a/lib/Youri/Submit/Check/Deps.pm +++ b/lib/Youri/Submit/Check/Deps.pm @@ -45,23 +45,10 @@ sub resolvedep { } $notfound; } @requires; - # Try to handle BuildRequires: kernel-server-2.6.37-3.mga-1-1.mga1 - @requires = grep { - my $require = $_; - my $notfound = 1; - if (!$require->[Youri::Package::DEPENDENCY_RANGE] && - $require->[Youri::Package::DEPENDENCY_NAME] =~ /-/) { - foreach my $provide (@provides) { - next unless $require->[Youri::Package::DEPENDENCY_NAME] =~ /^$provide->[Youri::Package::DEPENDENCY_NAME]-/; - $notfound = 0; - } - } - $notfound; - } @requires; }; $media->traverse_headers($index); foreach my $require (@requires) { - push (@errors, "Unresolved dep on " . $require->[Youri::Package::DEPENDENCY_NAME] . " " . $require->[Youri::Package::DEPENDENCY_RANGE]); + push (@errors, "Unresolved dep on " . $require->[Youri::Package::DEPENDENCY_NAME]); } return @errors; } -- cgit v1.2.1 From 71ae16047f87cfa6b065f5e1a7c72b3f8bfd7e23 Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Mon, 14 Feb 2011 20:42:47 +0000 Subject: Add a mirror action --- lib/Youri/Submit/Post/Mirror.pm | 55 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 lib/Youri/Submit/Post/Mirror.pm (limited to 'lib') diff --git a/lib/Youri/Submit/Post/Mirror.pm b/lib/Youri/Submit/Post/Mirror.pm new file mode 100644 index 0000000..387fe90 --- /dev/null +++ b/lib/Youri/Submit/Post/Mirror.pm @@ -0,0 +1,55 @@ +# $Id: Gendistrib.pm 115367 2007-01-30 09:47:04Z pixel $ +package Youri::Submit::Post::Mirror; + +=head1 NAME + +Youri::Submit::Post::Mirror - synchronizes repository to mirror + +=head1 DESCRIPTION + +Calls genhdlist2 + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Post/; + +sub _init { + my $self = shift; + my %options = ( + destination => '', + @_ + ); + + foreach my $var ('destination') { + $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(); + + croak "Missing destination" unless $self->{'_destination'}; + + + if (system("rsync -alH $root/$target/ $self->{_destination}/$target/")) { + $self->{_error} = "Rsync command failed ($!)"; + } + + return; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2010, Mageia + +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 From bd429c24a4e5d9a5011813c7d3015f8cdcc392d6 Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Mon, 14 Feb 2011 22:49:17 +0000 Subject: Delete old rpms --- lib/Youri/Submit/Post/Mirror.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Post/Mirror.pm b/lib/Youri/Submit/Post/Mirror.pm index 387fe90..961cc1e 100644 --- a/lib/Youri/Submit/Post/Mirror.pm +++ b/lib/Youri/Submit/Post/Mirror.pm @@ -36,7 +36,7 @@ sub run { croak "Missing destination" unless $self->{'_destination'}; - if (system("rsync -alH $root/$target/ $self->{_destination}/$target/")) { + if (system("rsync -alH --delete $root/$target/ $self->{_destination}/$target/")) { $self->{_error} = "Rsync command failed ($!)"; } -- cgit v1.2.1 From 9be47f7f05f307e346fd549f219f1db21610d067 Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Sun, 20 Feb 2011 20:49:53 +0000 Subject: Display full dependency --- lib/Youri/Submit/Check/Deps.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Check/Deps.pm b/lib/Youri/Submit/Check/Deps.pm index fa239df..69cd1f9 100644 --- a/lib/Youri/Submit/Check/Deps.pm +++ b/lib/Youri/Submit/Check/Deps.pm @@ -48,7 +48,7 @@ sub resolvedep { }; $media->traverse_headers($index); foreach my $require (@requires) { - push (@errors, "Unresolved dep on " . $require->[Youri::Package::DEPENDENCY_NAME]); + push (@errors, "Unresolved dep on " . $require->[Youri::Package::DEPENDENCY_NAME] . " " . $require->[Youri::Package::DEPENDENCY_RANGE]); } return @errors; } -- cgit v1.2.1 From e76d2721b2f2a42c4dd03f592ff3c0669e2cfdc7 Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Sun, 20 Feb 2011 20:50:18 +0000 Subject: Only check deps for packages buildable on x86_64 --- lib/Youri/Submit/Check/Deps.pm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lib') diff --git a/lib/Youri/Submit/Check/Deps.pm b/lib/Youri/Submit/Check/Deps.pm index 69cd1f9..3d5d235 100644 --- a/lib/Youri/Submit/Check/Deps.pm +++ b/lib/Youri/Submit/Check/Deps.pm @@ -68,7 +68,10 @@ sub run { # FIXME we need dependencies on all archs except for ExclusiveArch # Unfortunately some dependencies depend on the arch were the src.rpm was geenrated # Currently src.rpm is generated on x86_64, so we need to check on that one + # If the package is not buildable on x86_64 we just don't test anything my $arch = 'x86_64'; + my @exclusivearchs = $package->get_tag("exclusivearchs"); + return if @exclusivearchs && ! (grep {$_ eq $arch} @exclusivearchs); # foreach my $arch ($repository->get_extra_arches()) { my $media = new Youri::Media::URPM(name => "core.".$arch, type => "binary", -- cgit v1.2.1 From 5e724f8dedbe5e956ebe3eab9be9517ada3bb08f Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Sat, 26 Feb 2011 23:18:54 +0000 Subject: Drop some MDV specific debugging code --- lib/Youri/Submit/Action/Archive.pm | 11 ----------- 1 file changed, 11 deletions(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Action/Archive.pm b/lib/Youri/Submit/Action/Archive.pm index 98ff37c..41a8b8f 100644 --- a/lib/Youri/Submit/Action/Archive.pm +++ b/lib/Youri/Submit/Action/Archive.pm @@ -46,17 +46,6 @@ sub run { ) { my $file = $replaced_package->get_file(); - # trap for debugging bug 34999 - if ($file =~ /\/[\d.]+\/(main\/updates|.*\/release)/) { - my $bugmsg = "BUG#34999 WARNING: trying to remove from a release: $file\n"; - open(BUG34999LOG, '>>', "/home/mandrake/bug34999.log"); - print $bugmsg; - print BUG34999LOG localtime().": ".$bugmsg; - close BUG34999LOG; - - next; - } - my ($rep_section, $rep_main_section) = $file =~ m,$path/(([^/]+)/.*)/[^/]+.rpm,; # We do accept duplicate version for other submedia of the same main media section print "(path '$path') file '$file' section '$rep_section' main_section '$rep_main_section'\n" if $self->{_verbose}; -- cgit v1.2.1 From 7f23105fffc1c5f0149ff44b6560d089dfaa47ea Mon Sep 17 00:00:00 2001 From: Romain d'Alverny Date: Thu, 24 Mar 2011 16:25:37 +0000 Subject: Add action to notify maintainers database of a package upload --- lib/Youri/Submit/Action/UpdateMaintDb.pm | 81 ++++++++++++++++++++++++++++++++ 1 file changed, 81 insertions(+) create mode 100644 lib/Youri/Submit/Action/UpdateMaintDb.pm (limited to 'lib') diff --git a/lib/Youri/Submit/Action/UpdateMaintDb.pm b/lib/Youri/Submit/Action/UpdateMaintDb.pm new file mode 100644 index 0000000..3af27f6 --- /dev/null +++ b/lib/Youri/Submit/Action/UpdateMaintDb.pm @@ -0,0 +1,81 @@ +# $Id$ +package Youri::Submit::Action::UpdateMaintDb; + +=head1 NAME + +Youri::Submit::Action::UpdateMaintDb - Mageia maintainers database updater + +=head1 DESCRIPTION + +This action plugin HTTP POSTs to package maintainers database to notify +of the action. See . + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Submit::Action/; + +use HTTP::Request::Common qw(POST); +use LWP::UserAgent; + +sub _init { + my $self = shift; + my %options = ( + maintdb_url => '', + maintdb_key => '', + @_ + ); + + $self->{_maintdb_url} = $options{maintdb_url}; + $self->{_maintdb_key} = $options{maintdb_key}; + + return $self; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + # only SRPMs matter + return unless $package->is_source(); + + unless ($self->{_test}) { + my $pkg_name = $package->get_name(); + my $pkg_media = $repository->_get_main_section($package, $target, $define); + $package->get_packager() =~ m/(\w[-_.\w]+\@[-_.\w]+)\W/; + my $pkg_commiter = $1; + + $ua = LWP::UserAgent->new; + $ua->agent('Youri/0.1 ' . $ua->agent); + + my $req = POST $self->{_maintdb_url}, + [ + key => $self->{_maintdb_key}, + from => "youri", + package => $pkg_name, + media => $pkg_media, + uid => $pkg_commiter + ]; + + my $res = $ua->request($req); + + if ($res->is_success) { + print "Updated package maintainers DB for '$pkg_name', '$pkg_media', '$pkg_commiter'.\n" if $self->{_verbose}; + } else { + print "ERROR: POST failed to ".$self->{_maintdb_url}." for '$pkg_name', '$pkg_media', '$pkg_commiter'.\n"; + } + } +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2007, Mandriva +Copyright (C) 2011, Mageia.Org + +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 From 11bc968a2b89d5b0d147c2948123a0c9cc0e5b68 Mon Sep 17 00:00:00 2001 From: Nicolas Vigier Date: Thu, 24 Mar 2011 17:36:02 +0000 Subject: fix syntax --- lib/Youri/Submit/Action/UpdateMaintDb.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Action/UpdateMaintDb.pm b/lib/Youri/Submit/Action/UpdateMaintDb.pm index 3af27f6..e9fe49a 100644 --- a/lib/Youri/Submit/Action/UpdateMaintDb.pm +++ b/lib/Youri/Submit/Action/UpdateMaintDb.pm @@ -47,7 +47,7 @@ sub run { $package->get_packager() =~ m/(\w[-_.\w]+\@[-_.\w]+)\W/; my $pkg_commiter = $1; - $ua = LWP::UserAgent->new; + my $ua = LWP::UserAgent->new; $ua->agent('Youri/0.1 ' . $ua->agent); my $req = POST $self->{_maintdb_url}, -- cgit v1.2.1 From 3264befbb510b7ba72e516c404ad54d6361c2973 Mon Sep 17 00:00:00 2001 From: Nicolas Vigier Date: Thu, 24 Mar 2011 18:40:42 +0000 Subject: fix username of submitter (thanks to pterjan) --- lib/Youri/Submit/Action/UpdateMaintDb.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Action/UpdateMaintDb.pm b/lib/Youri/Submit/Action/UpdateMaintDb.pm index e9fe49a..10eed21 100644 --- a/lib/Youri/Submit/Action/UpdateMaintDb.pm +++ b/lib/Youri/Submit/Action/UpdateMaintDb.pm @@ -44,8 +44,7 @@ sub run { unless ($self->{_test}) { my $pkg_name = $package->get_name(); my $pkg_media = $repository->_get_main_section($package, $target, $define); - $package->get_packager() =~ m/(\w[-_.\w]+\@[-_.\w]+)\W/; - my $pkg_commiter = $1; + my $pkg_commiter = $define->{user}; my $ua = LWP::UserAgent->new; $ua->agent('Youri/0.1 ' . $ua->agent); -- cgit v1.2.1 From ed6a9183e6c78942dc11377c15366323ac08714f Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Thu, 24 Mar 2011 23:20:57 +0000 Subject: Port to new Youri API --- lib/Youri/Submit/Check/Deps.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Check/Deps.pm b/lib/Youri/Submit/Check/Deps.pm index 3d5d235..0adcf37 100644 --- a/lib/Youri/Submit/Check/Deps.pm +++ b/lib/Youri/Submit/Check/Deps.pm @@ -29,16 +29,16 @@ sub resolvedep { my $require = $_; my $notfound = 1; foreach my $provide (@provides) { - next unless $provide->[Youri::Package::DEPENDENCY_NAME] eq $require->[Youri::Package::DEPENDENCY_NAME]; - if ($require->[Youri::Package::DEPENDENCY_RANGE]) { - next unless $package->check_ranges_compatibility($provide->[Youri::Package::DEPENDENCY_RANGE], $require->[Youri::Package::DEPENDENCY_RANGE]); + next unless $provide->[Youri::Package::Relationship::NAME] eq $require->[Youri::Package::Relationship::NAME]; + if ($require->[Youri::Package::Relationship::RANGE]) { + next unless $package->check_ranges_compatibility($provide->[Youri::Package::Relationship::RANGE], $require->[Youri::Package::Relationship::RANGE]); } $notfound = 0; } - if ($notfound && $require->[Youri::Package::DEPENDENCY_NAME] =~ m|/|) { + if ($notfound && $require->[Youri::Package::Relationship::NAME] =~ m|/|) { foreach my $file ($package->get_files()) { - next unless $file eq $require->[Youri::Package::DEPENDENCY_NAME]; + next unless $file eq $require->[Youri::Package::Relationship::NAME]; $notfound = 0; last; } @@ -48,7 +48,7 @@ sub resolvedep { }; $media->traverse_headers($index); foreach my $require (@requires) { - push (@errors, "Unresolved dep on " . $require->[Youri::Package::DEPENDENCY_NAME] . " " . $require->[Youri::Package::DEPENDENCY_RANGE]); + push (@errors, "Unresolved dep on " . $require->[Youri::Package::Relationship::NAME] . " " . $require->[Youri::Package::Relationship::RANGE]); } return @errors; } -- cgit v1.2.1 From 329303a9e34dcc3b9d44902b712821b738edc48d Mon Sep 17 00:00:00 2001 From: Pascal Terjan Date: Fri, 25 Mar 2011 10:33:42 +0000 Subject: Fix changelog mail content for new youri --- lib/Youri/Submit/Action/Mail.pm | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Action/Mail.pm b/lib/Youri/Submit/Action/Mail.pm index c9bbcbe..02e36cd 100644 --- a/lib/Youri/Submit/Action/Mail.pm +++ b/lib/Youri/Submit/Action/Mail.pm @@ -110,13 +110,24 @@ sub get_content { my ($self, $package, $repository, $target, $define) = @_; croak "Not a class method" unless ref $self; - my $information = $package->get_information(); + my $information = $package->as_formated_string(<get_last_change(); return $information . "\n" . - $last_change->[Youri::Package::CHANGE_AUTHOR] . ":\n" . - $last_change->[Youri::Package::CHANGE_TEXT]; + $last_change->get_author() . ":\n" . + $last_change->get_raw_text(); } -- cgit v1.2.1 From 51d5d4e7a0d1d1cca9a5214782575b5f8aa7aa8b Mon Sep 17 00:00:00 2001 From: Olivier Blin Date: Mon, 28 Mar 2011 11:23:58 +0000 Subject: fix clean-rpmsrate to use core/release --- lib/Youri/Submit/Post/CleanRpmsrate.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/Youri/Submit/Post/CleanRpmsrate.pm b/lib/Youri/Submit/Post/CleanRpmsrate.pm index 977e2a0..899c80f 100644 --- a/lib/Youri/Submit/Post/CleanRpmsrate.pm +++ b/lib/Youri/Submit/Post/CleanRpmsrate.pm @@ -33,7 +33,8 @@ sub run { } foreach my $arch (@changed) { my $rpmsrate = "$root/$target/$arch/media/media_info/rpmsrate"; - my @media = "$root/$target/$arch/media/main/release"; + # FIXME: have a method to get core/release instead of hardcoding it + my @media = "$root/$target/$arch/media/core/release"; system("cp", "$rpmsrate-raw", "$rpmsrate-new"); system("clean-rpmsrate", "$rpmsrate-new", @media); system("mv", "-f", "$rpmsrate-new", $rpmsrate); -- cgit v1.2.1