diff options
author | Florent Villard <warly@mandriva.com> | 2006-10-16 11:30:28 +0000 |
---|---|---|
committer | Florent Villard <warly@mandriva.com> | 2006-10-16 11:30:28 +0000 |
commit | 02381cd87e37dc5d6df37e56eef5f1e222a794cd (patch) | |
tree | fec5b8db1aba238ca91f5506239dec3ac37d3929 /lib | |
parent | 597e5f1d49cb0cc96a5655aeaa84a6fc4a83b041 (diff) | |
download | mga-youri-submit-02381cd87e37dc5d6df37e56eef5f1e222a794cd.tar mga-youri-submit-02381cd87e37dc5d6df37e56eef5f1e222a794cd.tar.gz mga-youri-submit-02381cd87e37dc5d6df37e56eef5f1e222a794cd.tar.bz2 mga-youri-submit-02381cd87e37dc5d6df37e56eef5f1e222a794cd.tar.xz mga-youri-submit-02381cd87e37dc5d6df37e56eef5f1e222a794cd.zip |
add new youri subsections (from upstream)
Diffstat (limited to 'lib')
35 files changed, 2545 insertions, 0 deletions
diff --git a/lib/Youri/Submit/Action.pm b/lib/Youri/Submit/Action.pm new file mode 100644 index 0000000..e7908c4 --- /dev/null +++ b/lib/Youri/Submit/Action.pm @@ -0,0 +1,94 @@ +# $Id: Base.pm 631 2006-01-26 22:22:23Z guillomovitch $ +package Youri::Upload::Action; + +=head1 NAME + +Youri::Upload::Action - Abstract action plugin + +=head1 DESCRIPTION + +This abstract class defines action plugin interface. + +=cut + +use warnings; +use strict; +use Carp; + +=head1 CLASS METHODS + +=head2 new(%args) + +Creates and returns a new Youri::Upload::Action 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<Youri::Package> 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/Action/Archive.pm b/lib/Youri/Submit/Action/Archive.pm new file mode 100644 index 0000000..d16deeb --- /dev/null +++ b/lib/Youri/Submit/Action/Archive.pm @@ -0,0 +1,73 @@ +# $Id$ +package Youri::Upload::Action::Archive; + +=head1 NAME + +Youri::Upload::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::Upload::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; + + 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; + $self->{_verbose} = 1; + foreach my $replaced_package ( + $repository->get_replaced_packages($package, $target, $define) + ) { + my $file = $replaced_package->get_file(); + 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 ($path)\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"); + } + } +} + +=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..17d6b1c --- /dev/null +++ b/lib/Youri/Submit/Action/Bugzilla.pm @@ -0,0 +1,81 @@ +# $Id$ +package Youri::Upload::Action::Bugzilla; + +=head1 NAME + +Youri::Upload::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::Upload::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..c0488ea --- /dev/null +++ b/lib/Youri/Submit/Action/CVS.pm @@ -0,0 +1,135 @@ +# $Id$ +package Youri::Upload::Action::CVS; + +=head1 NAME + +Youri::Upload::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::Upload::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..8564756 --- /dev/null +++ b/lib/Youri/Submit/Action/Clean.pm @@ -0,0 +1,40 @@ +# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Action/Backup.pm 867 2006-01-29T20:47:27.830648Z guillaume $ +package Youri::Upload::Action::Clean; + +=head1 NAME + +Youri::Upload::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::Upload::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->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/Action/Install.pm b/lib/Youri/Submit/Action/Install.pm new file mode 100644 index 0000000..df65991 --- /dev/null +++ b/lib/Youri/Submit/Action/Install.pm @@ -0,0 +1,65 @@ +# $Id$ +package Youri::Upload::Action::Install; + +=head1 NAME + +Youri::Upload::Action::Install - Package installation + +=head1 DESCRIPTION + +This action plugin ensures installation of new package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Upload::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->get_file(); + my $rpm = $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 + 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/Action/Link.pm b/lib/Youri/Submit/Action/Link.pm new file mode 100644 index 0000000..eaadec1 --- /dev/null +++ b/lib/Youri/Submit/Action/Link.pm @@ -0,0 +1,63 @@ +# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Action/Sign.pm 1543 2006-03-21T20:22:54.334939Z guillaume $ +package Youri::Upload::Action::Link; + +=head1 NAME + +Youri::Upload::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 File::Spec; +use base qw/Youri::Upload::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 $dest_dir = $repository->get_install_dir($package, $target, $define); + my (undef, $parent_dir, $relative_dir) = File::Spec->splitpath($dest_dir); + my $file = $package->get_file_name(); + + foreach my $other_dir (grep { -d } <$parent_dir/*>) { + next if $other_dir eq $dest_dir; + chdir $other_dir; + my $source_file = "../$relative_dir/$file"; + if ($self->{_symbolic}) { + symlink $source_file, $file unless $self->{_test}; + } else { + link $source_file, $file unless $self->{_test}; + } + chdir '..'; + } +} + +=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..7ef8380 --- /dev/null +++ b/lib/Youri/Submit/Action/Mail.pm @@ -0,0 +1,116 @@ +# $Id$ +package Youri::Upload::Action::Mail; + +=head1 NAME + +Youri::Upload::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::Upload::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(); + my $section = $repository->_get_section($package, $target, $define); + + # force from adress if defined + $from =~ s/<.*>/<$self->{_from}>/ if $self->{_from}; + + my $subject = + ($self->{_prefix} ? '[' . $self->{_prefix} . '] ' : '' ) . "$target " . ($section ? "$section " : '') . + $package->get_revision_name(); + my $information = $package->get_information(); + my $last_change = $package->get_last_change(); + my $content = + $information . "\n" . + $last_change->[Youri::Package::CHANGE_AUTHOR] . ":\n" . + join( + '', map { "- $_\n" } @{$last_change->[Youri::Package::CHANGE_TEXT]} + ); + + # 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; + } + +} + +=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..c8049db --- /dev/null +++ b/lib/Youri/Submit/Action/Markrelease.pm @@ -0,0 +1,56 @@ +# $Id: Install.pm 867 2006-04-11 20:34:56Z guillomovitch $ +package Youri::Upload::Action::Markrelease; + +=head1 NAME + +Youri::Upload::Action::Install - Package installation + +=head1 DESCRIPTION + +This action plugin ensures installation of new package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Upload::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..b1f484f --- /dev/null +++ b/lib/Youri/Submit/Action/RSS.pm @@ -0,0 +1,102 @@ +# $Id$ +package Youri::Upload::Action::RSS; + +=head1 NAME + +Youri::Upload::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::Upload::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->get_revision_name(); + my $content = $package->get_information(); + + $content =~ s/$/<br\/>/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/Scp.pm b/lib/Youri/Submit/Action/Scp.pm new file mode 100644 index 0000000..d78fd5f --- /dev/null +++ b/lib/Youri/Submit/Action/Scp.pm @@ -0,0 +1,72 @@ +# $Id: Install.pm 867 2006-04-11 20:34:56Z guillomovitch $ +package Youri::Upload::Action::Scp; + +=head1 NAME + +Youri::Upload::Action::Install - Package installation + +=head1 DESCRIPTION + +This action plugin ensures installation of new package revisions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Upload::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}; + + $self->{_perms} = $options{perms}; + $self->{_user} = $options{user}; + $self->{_uphost} = $options{uphost}; + $self->{_ssh_key} = $options{ssh_key}; + $self->{_verbose} = $options{verbose}; + + 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 "Scping file $file to $dest\n" if $self->{_verbose}; + my $base = basename($file); + + 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 "Upload::Action::Scp: doing $cmd\n$cmd2\n" if 1 || $self->{_verbose}; + if (!$self->{_test}) { + if (!system($cmd)) { + if (!system($cmd2)) { + print "Upload::Action::Scp: upload succeeded!\n"; + return 1 + } + } + print "Upload::Action::Scp: 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/Send.pm b/lib/Youri/Submit/Action/Send.pm new file mode 100644 index 0000000..0f18766 --- /dev/null +++ b/lib/Youri/Submit/Action/Send.pm @@ -0,0 +1,77 @@ +# $Id: Install.pm 867 2006-04-11 20:34:56Z guillomovitch $ +package Youri::Upload::Action::Send; + +=head1 NAME + +Youri::Upload::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::Upload::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 "Upload::Action::Send: doing $cmd\n$cmd2\n" if 1 || $self->{_verbose}; + if (!$self->{_test}) { + if (!system($cmd)) { + if (!system($cmd2)) { + print "Upload::Action::Send: upload succeeded!\n"; + return 1 + } + } + print "Upload::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/Sign.pm b/lib/Youri/Submit/Action/Sign.pm new file mode 100644 index 0000000..4a92fa5 --- /dev/null +++ b/lib/Youri/Submit/Action/Sign.pm @@ -0,0 +1,56 @@ +# $Id$ +package Youri::Upload::Action::Sign; + +=head1 NAME + +Youri::Upload::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::Upload::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/Check.pm b/lib/Youri/Submit/Check.pm new file mode 100644 index 0000000..312c4a6 --- /dev/null +++ b/lib/Youri/Submit/Check.pm @@ -0,0 +1,107 @@ +# $Id: Base.pm 631 2006-01-26 22:22:23Z guillomovitch $ +package Youri::Upload::Check; + +=head1 NAME + +Youri::Upload::Check - Abstract check plugin + +=head1 DESCRIPTION + +This abstract class defines check plugin interface. + +=cut + +use warnings; +use strict; +use Carp; + +=head1 CLASS METHODS + +=head2 new(%args) + +Creates and returns a new Youri::Upload::Check 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) + +Check given L<Youri::Package> object, and returns success as a boolean. + +=head2 get_error() + +Returns exact error message if check failed. + +=cut + +sub get_error { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_error}; +} + +=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/Check/ACL.pm b/lib/Youri/Submit/Check/ACL.pm new file mode 100644 index 0000000..9e19e35 --- /dev/null +++ b/lib/Youri/Submit/Check/ACL.pm @@ -0,0 +1,72 @@ +# $Id: Tag.pm 867 2006-04-11 20:34:56Z guillomovitch $ +package Youri::Upload::Check::ACL; + +=head1 NAME + +Youri::Upload::Check::Tag - Incorrect tag values check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect tag values, based on regular +expressions. + +=cut + +use strict; +use Carp; +use base qw/Youri::Upload::Check/; +my $acl; + +sub _init { + my $self = shift; + my %options = ( + acl_file => '', + @_ + ); + $acl = get_acl($options{acl_file}); +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $file = $package->get_full_name(); + my $arch = $package->get_arch(); + my $srpm = $package->get_canonical_name; + my $section = $repository->_get_section($package, $target, $define); + my $user = $define->{user}; + foreach my $t (keys %$acl) { + next if $target !~ /$t/; + foreach my $acl (@{$acl->{$t}}) { + my ($arch, $media, $r, $users) = @$acl; + next if $arch !~ $a || $srpm !~ $r || $media !~ $media; + if ($user =~ /$users/) { + return 1 + } else { + $self->{_error} = "$user is not authorized to upload packages belonging to $srpm (authorized persons: " . join(', ', split '\|', $users) . ")"; + return 0 + } + } + } + 1 +} + +sub get_acl { + my ($file) = @_; + my %acl; + open my $f, $file; + while (<$f>) { + my ($dis, $arch, $media, $regexp, $users) = split ' '; + push @{$acl{$dis}}, [ $arch , $media, $regexp, $users ] + } + \%acl +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/History.pm b/lib/Youri/Submit/Check/History.pm new file mode 100644 index 0000000..82a1b05 --- /dev/null +++ b/lib/Youri/Submit/Check/History.pm @@ -0,0 +1,56 @@ +# $Id$ +package Youri::Upload::Check::History; + +=head1 NAME + +Youri::Upload::Check::History - Non-linear history check + +=head1 DESCRIPTION + +This check plugin rejects packages whose history does not include last +available revision one. + +=cut + +use warnings; +use strict; +use Carp; +use Youri::Package; +use base qw/Youri::Upload::Check/; + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $last_revision = + $repository->get_last_older_revision($package, $target, $define); + + if ($last_revision) { + # skip the test if last revision has been produced from another source package, as it occurs during package split/merges + return 1 + if $last_revision->get_canonical_name() ne $package->get_canonical_name(); + + my ($last_revision_number) = $last_revision->get_last_change()->[Youri::Package::CHANGE_AUTHOR] =~ /(\S+)\s*$/; + my %entries = + map { $_ => 1 } + map { /(\S+)\s*$/ } + map { $_->[Youri::Package::CHANGE_AUTHOR] } + $package->get_changes(); + unless ($entries{$last_revision_number}) { + $self->{_error} = "Last changelog entry $last_revision_number from last revision " . $last_revision->get_full_name() . " missing from current changelog"; + return 0; + } + } + + return 1; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Host.pm b/lib/Youri/Submit/Check/Host.pm new file mode 100644 index 0000000..d6cae8d --- /dev/null +++ b/lib/Youri/Submit/Check/Host.pm @@ -0,0 +1,64 @@ +# $Id: Tag.pm 867 2006-04-11 20:34:56Z guillomovitch $ +package Youri::Upload::Check::Host; + +=head1 NAME + +Youri::Upload::Check::Tag - Incorrect tag values check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect tag values, based on regular +expressions. + +=cut + +use strict; +use Carp; +use base qw/Youri::Upload::Check/; +my $host; + +sub _init { + my $self = shift; + my %options = ( + host_file => '', + @_ + ); + $host = get_host($options{host_file}) +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $file = $package->get_file; + my $arch = $package->get_arch; + my $buildhost = $package->get_buildhost; + foreach my $h (keys %$host) { + next if $buildhost !~ $h; + if ($arch =~ $host->{$h}) { + return 1 + } + } + $self->{_error} = "Packages build on host $buildhost are not authorized"; + 0 +} + +sub get_host { + my ($file) = @_; + my %host; + open my $f, $file; + while (<$f>) { + my ($host, $arch) = split ' '; + $host{$host} = $arch + } + \%host +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Precedence.pm b/lib/Youri/Submit/Check/Precedence.pm new file mode 100644 index 0000000..296c154 --- /dev/null +++ b/lib/Youri/Submit/Check/Precedence.pm @@ -0,0 +1,54 @@ +# $Id$ +package Youri::Upload::Check::Precedence; + +=head1 NAME + +Youri::Upload::Check::Precedence - Release check against another check + +=head1 DESCRIPTION + +This check plugin rejects packages whose an older revision already exists for +another upload target. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Upload::Check/; + +sub _init { + my $self = shift; + my %options = ( + _target => undef, # mandatory targets + @_ + ); + + die "undefined target" unless $options{target}; + + $self->{_target} = $options{target}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my @older_revisions = + $repository->get_older_revisions($package, $self->{_target}, $define); + if (@older_revisions) { + $self->{_error} = "Older revisions still exists for $self->{_target}: " . join(', ', @older_revisions); + return 0; + } + + return 1; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Queue_recency.pm b/lib/Youri/Submit/Check/Queue_recency.pm new file mode 100644 index 0000000..f7f5940 --- /dev/null +++ b/lib/Youri/Submit/Check/Queue_recency.pm @@ -0,0 +1,42 @@ +# $Id: Recency.pm 873 2006-04-15 17:04:27Z guillomovitch $ +package Youri::Upload::Check::Queue_recency; + +=head1 NAME + +Youri::Upload::Check::Recency - Release check against current target + +=head1 DESCRIPTION + +This check plugin rejects packages whose a current or newer revision already +exists for current upload target. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Upload::Check/; + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my @newer_revisions = + $repository->get_upload_newer_revisions($package, $target, $define); + if (@newer_revisions) { + $self->{_error} = "Newer revisions already exists for $target in upload queue: " . join(', ', @newer_revisions); + return 0; + } + + return 1; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Recency.pm b/lib/Youri/Submit/Check/Recency.pm new file mode 100644 index 0000000..58452a6 --- /dev/null +++ b/lib/Youri/Submit/Check/Recency.pm @@ -0,0 +1,48 @@ +# $Id$ +package Youri::Upload::Check::Recency; + +=head1 NAME + +Youri::Upload::Check::Recency - Release check against current target + +=head1 DESCRIPTION + +This check plugin rejects packages whose a current or newer revision already +exists for current upload target. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Upload::Check/; + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $repository->get_install_file($package, $target, $define); + if (-f $file) { + $self->{_error} = "Current revision of package $file already exists for $target"; + return 0; + } + + my @newer_revisions = + $repository->get_newer_revisions($package, $target, $define); + if (@newer_revisions) { + $self->{_error} = "Newer revisions of package $package already exists for $target: " . join(', ', @newer_revisions); + return 0; + } + + return 1; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Rpmlint.pm b/lib/Youri/Submit/Check/Rpmlint.pm new file mode 100644 index 0000000..20e478b --- /dev/null +++ b/lib/Youri/Submit/Check/Rpmlint.pm @@ -0,0 +1,57 @@ +# $Id: Tag.pm 867 2006-04-11 20:34:56Z guillomovitch $ +package Youri::Upload::Check::Rpmlint; + +=head1 NAME + +Youri::Upload::Check::Tag - Incorrect tag values check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect tag values, based on regular +expressions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Upload::Check/; + +sub _init { + my $self = shift; + my %options = ( + fatal_error => '', + @_ + ); + $self->{_fatal_error} = $options{fatal_error}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $file = $package->get_file; + open my $rpmlint, "/usr/bin/rpmlint $file |"; + my $fatal; + my $error = "fatal errors detected, upload rejected:\n"; + while (<$rpmlint>) { + if (/$self->{_fatal_error}/) { + $fatal = 1; + $error .= "- $_" + } + } + if ($fatal) { + $self->{_error} = $error; + return 0 + } + 1 +} +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/SVN.pm b/lib/Youri/Submit/Check/SVN.pm new file mode 100644 index 0000000..f824f4a --- /dev/null +++ b/lib/Youri/Submit/Check/SVN.pm @@ -0,0 +1,81 @@ +# $Id: Tag.pm 867 2006-04-11 20:34:56Z guillomovitch $ +package Youri::Upload::Check::SVN; + +=head1 NAME + +Youri::Upload::Check::Tag - Incorrect tag values check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect tag values, based on regular +expressions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Upload::Check/; + +sub _init { + my $self = shift; + my %options = ( + svn => '', + @_ + ); + $self->{_svn} = $options{svn}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $section = $repository->_get_section($package, $target, $define); + if ($section =~ /\/(testing|backport)$/) { + # FIXME, right now ignore packages in SVN for testing and backports + # we need to find a clean way to handle them + return 1 + } + + $package->is_source or return 1; + my $file = $package->get_file_name; + my $srpm_name = $package->get_canonical_name; + if ($repository->package_in_svn($srpm_name)) { + if ($file !~ /(^|\/|$define->{prefix}_)@\d+:\Q$srpm_name/) { + $self->{_error} = "package $srpm_name is in the SVN, the uploaded SRPM must look like @<svn rev>:$srpm_name-<version>-<release>.src.rpm (created with getsrpm-mdk $srpm_name)"; + return 0 + } else { + print "Package $file is correct\n"; + return 1 + } + } + 1 +} + +sub simple_prompt { + my $cred = shift; + my $realm = shift; + my $default_username = shift; + my $may_save = shift; + my $pool = shift; + + print "Enter authentication info for realm: $realm\n"; + print "Username: "; + my $username = <>; + chomp($username); + $cred->username($username); + print "Password: "; + my $password = <>; + chomp($password); + $cred->password($password); +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Source.pm b/lib/Youri/Submit/Check/Source.pm new file mode 100644 index 0000000..7d8ea03 --- /dev/null +++ b/lib/Youri/Submit/Check/Source.pm @@ -0,0 +1,47 @@ +# $Id: Tag.pm 867 2006-04-11 20:34:56Z guillomovitch $ +package Youri::Upload::Check::Source; + +=head1 NAME + +Youri::Upload::Check::Tag - Incorrect tag values check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect tag values, based on regular +expressions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Upload::Check/; + +sub _init { + my $self = shift; + my %options = ( + @_ + ); +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $file = $package->get_file(); + if (!$package->is_source()) { + print + $self->{_error} = "Package $file is not a source rpm"; + return 0 + } + return 1; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Tag.pm b/lib/Youri/Submit/Check/Tag.pm new file mode 100644 index 0000000..453534c --- /dev/null +++ b/lib/Youri/Submit/Check/Tag.pm @@ -0,0 +1,56 @@ +# $Id$ +package Youri::Upload::Check::Tag; + +=head1 NAME + +Youri::Upload::Check::Tag - Incorrect tag values check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect tag values, based on regular +expressions. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Upload::Check/; + +sub _init { + my $self = shift; + my %options = ( + tags => undef, # expected tag values + @_ + ); + + croak "no tags to check" unless $options{tags}; + croak "tag should be an hashref" unless ref $options{tags} eq 'HASH'; + + $self->{_tags} = $options{tags}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + foreach my $tag (keys %{$self->{_tags}}) { + my $value = $package->get_tag($tag); + if ($value !~ /$self->{_tags}->{$tag}/) { + $self->{_error} = "invalid value $value for tag $tag"; + return 0; + } + } + + return 1; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Type.pm b/lib/Youri/Submit/Check/Type.pm new file mode 100644 index 0000000..e03fa80 --- /dev/null +++ b/lib/Youri/Submit/Check/Type.pm @@ -0,0 +1,53 @@ +# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Check/Tag.pm 1642 2006-03-29T06:49:43.840267Z guillaume $ +package Youri::Upload::Check::Type; + +=head1 NAME + +Youri::Upload::Check::Type - Type check + +=head1 DESCRIPTION + +This check plugin rejects packages with incorrect type. + +=cut + +use warnings; +use strict; +use Carp; +use base qw/Youri::Upload::Check/; + +sub _init { + my $self = shift; + my %options = ( + type => undef, # expected type + @_ + ); + + croak "no type to check" unless $options{type}; + croak "invalid type value" unless $options{type} =~ /^(?:source|binary)$/; + + $self->{_type} = $options{type}; +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + my $type = $package->get_type(); + if ($type ne $self->{_type}) { + $self->{_error} = "invalid type $type"; + return 0; + } + + return 1; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Youri/Submit/Check/Version.pm b/lib/Youri/Submit/Check/Version.pm new file mode 100644 index 0000000..fe9f42b --- /dev/null +++ b/lib/Youri/Submit/Check/Version.pm @@ -0,0 +1,72 @@ +# $Id: /youri.mdv/trunk/lib/Youri/Upload/Check/Recency.pm 975 2006-08-05T08:30:57.188281Z warly $ +package Youri::Upload::Check::Version; + +=head1 NAME + +Youri::Upload::Check::Version - Check if older version already exist in cooker (used in freeze period) + +=head1 DESCRIPTION + +This check plugin rejects new version of packages if they are not mentioned as authorized +in the configuration file or in a non frozen section. + +=cut + +use warnings; +use strict; +use Carp; +use URPM; +use base qw/Youri::Upload::Check/; + +sub _init { + my $self = shift; + my %options = ( + @_ + ); + + foreach my $target (keys %options) { + $self->{$target} = $options{$target} + } +} + +sub run { + my ($self, $package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + my $opt = $self->{$target}; + return 1 if $opt->{mode} eq 'normal'; + my $section = $repository->_get_section($package, $target, $define); + my $name = $package->get_canonical_name; + return 1 if $name =~ /$opt->{authorized_packages}/; + my $arch = $repository->get_arch($package, $target, $define); + return 1 if $arch =~ /$opt->{authorized_arches}/; + if ($opt->{mode} eq 'version_freeze') { + return 1 if $section =~ /$opt->{authorized_sections}/ + } elsif ($opt->{mode} eq 'freeze') { + if ($section !~ /$opt->{authorized_sections}/) { + $self->{_error} = "FREEZE: repository $target section $section is frozen, you can still submit your packages in testing\nTo do so use your.devel --define section=<section> $target <package 1> <package 2> ... <package n>"; + return 0 + } + } + my $source = $package->get_source_package; + my ($package_version) = $source =~ /-([^-]+)-[^-]+\.src\.rpm$/; + $define->{arch} = 'src'; + my @revisions = $repository->get_revisions($package, $target, $define, sub { my $source_package = $_[0]->get_source_package; my ($version) = $source_package =~ /-([^-]+)-[^-]+\.src\.rpm$/; print STDERR "Found version $version\n"; URPM::ranges_overlap("== $version", "< $package_version") }); + $define->{arch} = ''; + if (@revisions) { + $self->{_error} = "VERSION FREEZE, package @revisions of different versions exist in cooker\n"; + return 0 + } + return 1 +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2006, YOURI project +Copyright (C) 2006, Mandriva + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; + diff --git a/lib/Youri/Submit/Post.pm b/lib/Youri/Submit/Post.pm new file mode 100644 index 0000000..b6e1fc7 --- /dev/null +++ b/lib/Youri/Submit/Post.pm @@ -0,0 +1,94 @@ +# $Id: Base.pm 631 2006-01-26 22:22:23Z guillomovitch $ +package Youri::Upload::Post; + +=head1 NAME + +Youri::Upload::Pre - Abstract post plugin + +=head1 DESCRIPTION + +This abstract class defines post plugin interface. + +=cut + +use warnings; +use strict; +use Carp; + +=head1 CLASS METHODS + +=head2 new(%args) + +Creates and returns a new Youri::Upload::Pre 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($repository, $target, $define) + +Execute post on given L<Youri::Package> 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/Gendistrib.pm b/lib/Youri/Submit/Post/Gendistrib.pm new file mode 100644 index 0000000..9a26474 --- /dev/null +++ b/lib/Youri/Submit/Post/Gendistrib.pm @@ -0,0 +1,50 @@ +# $Id: /youri.mdv/trunk/lib/Youri/Upload/Action/Archive.pm 975 2006-08-05T08:30:57.188281Z warly $ +package Youri::Upload::Post::Gendistrib; + +=head1 NAME + +Youri::Upload::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::Upload::Post/; + +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_package, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + 1 +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, Mandriva <warly@mandriva.com> + +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..0e603db --- /dev/null +++ b/lib/Youri/Submit/Pre.pm @@ -0,0 +1,108 @@ +# $Id: Base.pm 631 2006-01-26 22:22:23Z guillomovitch $ +package Youri::Upload::Pre; + +=head1 NAME + +Youri::Upload::Pre - Abstract pre plugin + +=head1 DESCRIPTION + +This abstract class defines pre plugin interface. + +=cut + +use warnings; +use strict; +use Carp; + +=head1 CLASS METHODS + +=head2 new(%args) + +Creates and returns a new Youri::Upload::Pre 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_error() + +Returns exact error message if check failed. + +=cut + +sub get_error { + my ($self) = @_; + croak "Not a class method" unless ref $self; + + return $self->{_error}; +} + + +=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($pre_package, $repository, $target, $define) + +Execute pre on given L<Youri::Package> 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/Pre/Rsync.pm b/lib/Youri/Submit/Pre/Rsync.pm new file mode 100644 index 0000000..991e657 --- /dev/null +++ b/lib/Youri/Submit/Pre/Rsync.pm @@ -0,0 +1,85 @@ +# $Id: /youri.mdv/trunk/lib/Youri/Upload/Action/Archive.pm 975 2006-08-05T08:30:57.188281Z warly $ +package Youri::Upload::Pre::Rsync; + +=head1 NAME + +Youri::Upload::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::Upload::Pre/; + +sub _init { + my $self = shift; + my %options = ( + user => '', + host => '', + source => '', + destination => '', + @_ + ); + + foreach my $var ('user', 'host', 'source', 'destination') { + $self->{"_$var"} = $options{$var}; + } +} + +sub run { + my ($self, $pre_packages, $repository, $target, $define) = @_; + croak "Not a class method" unless ref $self; + + if (system("rsync --remove-sent-files -avlPHe 'ssh -xc arcfour' $self->{_user}\@$self->{_host}:$self->{_source}/$target/ $self->{_destination}/$target/")) { + $self->{_error} = "Rsync command failed ($!)"; + return + } + my $queue = "$self->{_destination}/$target"; + $self->{_error} = "Reading queue directory failed"; + # now get the packages downloaded + my %packages; + opendir my $queuedh, "$self->{_destination}/$target/" or return; + opendir my $targetdh, $queue or return; + 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; + foreach my $submedia (readdir $submediadh) { + $submedia =~ /^\.{1,2}$/ and next; + print "$target - $media - $submedia\n"; + opendir my $rpmdh, "$queue/$media/$submedia" or return; + foreach my $rpm (readdir $rpmdh) { + $rpm =~ /^\.{1,2}$/ and next; + print "$target - $media - $submedia : $rpm\n"; + if ($rpm =~ /^(\d{14}\.\w+\.\w+\.\d+)_.*\.\.rpm$/) { + push @{$packages{$1}{rpms}}, { section => "$media/$submedia", file => "$queue/$media/$submedia/$rpm" }; + } elsif ($rpm =~ /\.rpm$/) { + $idx++; + push @{$packages{"independant_$idx"}{rpms}}, { section => "$media/$submedia", file => "$queue/$media/$submedia/$rpm" } + } + } + } + } + } + foreach my $key (keys %packages) { + push @$pre_packages, $packages{$key}{rpms} + } + 1 +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, Mandriva <warly@mandriva.com> + +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..f3b9417 --- /dev/null +++ b/lib/Youri/Submit/Reject.pm @@ -0,0 +1,94 @@ +# $Id: Base.pm 631 2006-01-26 22:22:23Z guillomovitch $ +package Youri::Upload::Reject; + +=head1 NAME + +Youri::Upload::Pre - Abstract post plugin + +=head1 DESCRIPTION + +This abstract class defines post plugin interface. + +=cut + +use warnings; +use strict; +use Carp; + +=head1 CLASS METHODS + +=head2 new(%args) + +Creates and returns a new Youri::Upload::Pre 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($repository, $target, $define) + +Execute post on given L<Youri::Package> 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/Reject/Archive.pm b/lib/Youri/Submit/Reject/Archive.pm new file mode 100644 index 0000000..4621eee --- /dev/null +++ b/lib/Youri/Submit/Reject/Archive.pm @@ -0,0 +1,61 @@ +# $Id: /youri.mdv/trunk/lib/Youri/Upload/Action/Archive.pm 975 2006-08-05T08:30:57.188281Z warly $ +package Youri::Upload::Reject::Install; + +=head1 NAME + +Youri::Upload::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::Upload::Reject/; + +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->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..ed2b99d --- /dev/null +++ b/lib/Youri/Submit/Reject/Clean.pm @@ -0,0 +1,36 @@ +# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Action/Backup.pm 867 2006-01-29T20:47:27.830648Z guillaume $ +package Youri::Upload::Reject::Clean; + +=head1 NAME + +Youri::Upload::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::Upload::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..d35fe9d --- /dev/null +++ b/lib/Youri/Submit/Reject/Install.pm @@ -0,0 +1,63 @@ +# $Id: /youri.mdv/trunk/lib/Youri/Upload/Action/Archive.pm 975 2006-08-05T08:30:57.188281Z warly $ +package Youri::Upload::Reject::Install; + +=head1 NAME + +Youri::Upload::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::Upload::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_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"); + } + $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..32872fb --- /dev/null +++ b/lib/Youri/Submit/Reject/Mail.pm @@ -0,0 +1,115 @@ +# $Id: /youri.mdv/trunk/lib/Youri/Upload/Action/Mail.pm 975 2006-08-05T08:30:57.188281Z warly $ +package Youri::Upload::Reject::Mail; + +=head1 NAME + +Youri::Upload::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::Upload::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 $from = $package->get_packager(); + my $section = $repository->_get_section($package, $target, $define); + + # force from adress if defined + $from =~ s/<.*>/<$self->{_from}>/ if $self->{_from}; + + 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 $content = + "Errors: \n\n" . join("\n- ", @$errors) . "\n\n" . + $information . "\n" . + $last_change->[Youri::Package::CHANGE_AUTHOR] . ":\n" . + join( + '', map { "- $_\n" } @{$last_change->[Youri::Package::CHANGE_TEXT]} + ); + + # 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; + } + +} + +=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; |