aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Youri
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Youri')
-rw-r--r--lib/Youri/Upload/Post.pm94
-rw-r--r--lib/Youri/Upload/Post/Gendistrib.pm50
-rw-r--r--lib/Youri/Upload/Pre.pm108
-rw-r--r--lib/Youri/Upload/Pre/Rsync.pm87
-rw-r--r--lib/Youri/Upload/Reject.pm94
-rw-r--r--lib/Youri/Upload/Reject/Archive.pm61
-rw-r--r--lib/Youri/Upload/Reject/Clean.pm40
-rw-r--r--lib/Youri/Upload/Reject/Install.pm59
-rw-r--r--lib/Youri/Upload/Reject/Mail.pm115
9 files changed, 708 insertions, 0 deletions
diff --git a/lib/Youri/Upload/Post.pm b/lib/Youri/Upload/Post.pm
new file mode 100644
index 0000000..b6e1fc7
--- /dev/null
+++ b/lib/Youri/Upload/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/Upload/Post/Gendistrib.pm b/lib/Youri/Upload/Post/Gendistrib.pm
new file mode 100644
index 0000000..9a26474
--- /dev/null
+++ b/lib/Youri/Upload/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/Upload/Pre.pm b/lib/Youri/Upload/Pre.pm
new file mode 100644
index 0000000..0e603db
--- /dev/null
+++ b/lib/Youri/Upload/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/Upload/Pre/Rsync.pm b/lib/Youri/Upload/Pre/Rsync.pm
new file mode 100644
index 0000000..74167c1
--- /dev/null
+++ b/lib/Youri/Upload/Pre/Rsync.pm
@@ -0,0 +1,87 @@
+# $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/) {
+ $packages{$1}{options}{section} = "$media/$submedia";
+ push @{$packages{$1}{rpms}}, "$queue/$media/$submedia/$rpm";
+ } elsif ($rpm =~ /\.rpm$/) {
+ $idx++;
+ $packages{"independant_$idx"}{options}{section} = "$media/$submedia";
+ push @{$packages{"independant_$idx"}{rpms}}, "$queue/$media/$submedia/$rpm";
+ }
+ }
+ }
+ }
+ }
+ foreach my $key (keys %packages) {
+ push @$pre_packages, [ $packages{$key}{options}, $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/Upload/Reject.pm b/lib/Youri/Upload/Reject.pm
new file mode 100644
index 0000000..f3b9417
--- /dev/null
+++ b/lib/Youri/Upload/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/Upload/Reject/Archive.pm b/lib/Youri/Upload/Reject/Archive.pm
new file mode 100644
index 0000000..4621eee
--- /dev/null
+++ b/lib/Youri/Upload/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/Upload/Reject/Clean.pm b/lib/Youri/Upload/Reject/Clean.pm
new file mode 100644
index 0000000..7902472
--- /dev/null
+++ b/lib/Youri/Upload/Reject/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::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;
+
+ 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/Upload/Reject/Install.pm b/lib/Youri/Upload/Reject/Install.pm
new file mode 100644
index 0000000..ae778ce
--- /dev/null
+++ b/lib/Youri/Upload/Reject/Install.pm
@@ -0,0 +1,59 @@
+# $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};
+}
+
+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/Upload/Reject/Mail.pm b/lib/Youri/Upload/Reject/Mail.pm
new file mode 100644
index 0000000..32872fb
--- /dev/null
+++ b/lib/Youri/Upload/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;
generated by cgit v1.2.1 (git 2.21.0) at 2025-02-20 15:19:09 +0000