added mandriva modules

7 files changed, 359 insertions, 0 deletions

diff --git a/lib/Youri/Upload/Check/ACL.pm b/lib/Youri/Upload/Check/ACL.pm
new file mode 100644
index 0000000..e231500
--- /dev/null
+++ b/lib/Youri/Upload/Check/ACL.pm
@@ -0,0 +1,74 @@
+# $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 => '',
+	user => '',
+        @_
+    );
+    $self->{_user} = $options{user};
+    $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 = $self->{_user};
+    foreach my $t (keys %$acl) {
+	next if $target !~ /$t/;
+	foreach my $acl (@{$acl->{$t}}) {
+	    my ($arch, $media, $r, $users) = @$acl;
+	    next if $arch !~ $a || $srpm !~ $r || $media !~ $media;
+	    if ($user =~ /$users/) {
+		return 1
+	    } else { 
+		$self->{_error} = "$user is not authorized to upload packages belonging to $srpm (authorized persons: " . join(', ', split '\|',  $users) . ")";
+		return 0
+	    }
+	}
+    }
+    1
+}
+
+sub get_acl {
+    my ($file) = @_;
+    my %acl;
+    open my $f, $file;
+    while (<$f>) { 
+	my ($dis, $arch, $media, $regexp, $users) = split ' ';
+	push @{$acl{$dis}}, [ $arch , $media, $regexp, $users ]
+    }
+    \%acl
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Upload/Check/Host.pm b/lib/Youri/Upload/Check/Host.pm
new file mode 100644
index 0000000..d6cae8d
--- /dev/null
+++ b/lib/Youri/Upload/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/Upload/Check/Queue_recency.pm b/lib/Youri/Upload/Check/Queue_recency.pm
new file mode 100644
index 0000000..f7f5940
--- /dev/null
+++ b/lib/Youri/Upload/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/Upload/Check/Recency.pm b/lib/Youri/Upload/Check/Recency.pm
index d6fc920..0cf4a85 100644
--- a/lib/Youri/Upload/Check/Recency.pm
+++ b/lib/Youri/Upload/Check/Recency.pm
@@ -22,6 +22,7 @@ sub run {
     croak "Not a class method" unless ref $self;
 
     my $file = $repository->get_install_file($package, $target, $define);
+    print "Recency: looking for $file\n" if $self->{_verbose};
     if (-f $file) {
         $self->{_error} = "Current revision already exists for $target";
         return 0;
diff --git a/lib/Youri/Upload/Check/Rpmlint.pm b/lib/Youri/Upload/Check/Rpmlint.pm
new file mode 100644
index 0000000..08d5e56
--- /dev/null
+++ b/lib/Youri/Upload/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, "rpmlint $file |";
+    my $fatal;
+    my $error = "fatal errors detected, upload rejected:\n";
+    while (<$rpmlint>) {
+	if (/$self->{_fatal_error}/) {
+	    $fatal = 1;
+	    $error .= "- $_"	
+    	}
+    }
+    if ($fatal) {
+	$self->{_error} = $error;
+	return 0
+    }
+    1
+}
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Upload/Check/SVN.pm b/lib/Youri/Upload/Check/SVN.pm
new file mode 100644
index 0000000..5533dde
--- /dev/null
+++ b/lib/Youri/Upload/Check/SVN.pm
@@ -0,0 +1,74 @@
+# $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;
+
+    $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 !~ /^@\d+:\Q$srpm_name/)  {
+	    $self->{_error} = "package $srpm_name is in the SVN, the uploaded SRPM must look like @<svn rev>:$srpm_name-<version>-<release>.src.rpm (created with getsrpm-mdk $srpm_name)";
+	    return 0
+	} else  {
+	    print "Package $file is correct\n";
+	    return 1
+	}
+    }
+    1
+}
+
+sub simple_prompt {
+    my $cred = shift;
+    my $realm = shift;
+    my $default_username = shift;
+    my $may_save = shift;
+    my $pool = shift;
+
+    print "Enter authentication info for realm: $realm\n";
+    print "Username: ";
+    my $username = <>;
+    chomp($username);
+    $cred->username($username);
+    print "Password: ";
+    my $password = <>;
+    chomp($password);
+    $cred->password($password);
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Youri/Upload/Check/Source.pm b/lib/Youri/Upload/Check/Source.pm
new file mode 100644
index 0000000..7d8ea03
--- /dev/null
+++ b/lib/Youri/Upload/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;