imported initial version of youri svn

3 files changed, 773 insertions, 0 deletions

diff --git a/bin/fillbugzilla b/bin/fillbugzilla
new file mode 100755
index 0000000..81eb8c5
--- /dev/null
+++ b/bin/fillbugzilla
@@ -0,0 +1,81 @@
+#!/usr/bin/perl
+# fillbugzilla
+# copyright (c) 2002 Guillaume Rousse <guillomovitch@zarb.org>
+# $Id: fillbugzilla 448 2005-07-09 08:49:13Z guillomovitch $
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Bugzilla;
+use Mail::Sendmail;
+
+# constants
+my $name    = "fillbugzilla";
+my $version = "1.0";
+
+# command-line parameters
+my ($base, $user, $pass, $project, $mode, $help);
+GetOptions(
+    "base=s"    => \$base,
+    "user=s"    => \$user,
+    "pass=s"    => \$pass,
+    "mode=s"    => \$mode,
+    "help"      => \$help,
+);
+
+# mandatory argument
+die usage() unless ($base && $user && $pass);
+die usage() unless ($mode eq 'package' || $mode eq 'packager');
+
+usage() && exit 0 if $help;
+
+my $bugzilla = Bugzilla->new('localhost', $base, $user, $pass);
+
+if ($mode eq 'packager') {
+    while (my $packager = <>) {
+            chomp $packager;
+        my ($name, $login) = split(/\t/, $packager);
+
+        # random passwd
+        my @chars = (0..9, 'A'..'Z', 'a'..'z', '-', '_', '!', '@', '#', '$', '%', '^', '&', '*');
+        my $password = join('', map { $chars[rand(scalar @chars)] } 1 .. 8);
+
+        # insert into database
+        $bugzilla->add_packager($name, $login, $password);
+
+        # mail user
+        my %mail = (
+            smtp       => 'localhost',
+            To         => $login,
+            From       => 'bugmaster@zarb.org',
+            Subject    => 'bugzilla password',
+            'X-Mailer' => "$name $version",
+        );
+        $mail{Message} .= "login: $login\n";
+        $mail{Message} .= "password: $password\n";
+        sendmail(%mail) or warn $Mail::Sendmail::error;
+    }
+}
+
+if ($mode eq 'package') {
+    while (my $line = <>) {
+        chomp $line;
+        my ($name, $summary, $version, $maintainer) = split(/\t/, $line);
+        $bugzilla->add_package($name, $summary, $version, $maintainer);
+    }
+}
+
+sub usage {
+    print <<EOF;
+$name $version
+
+Usage:
+$name --base <base> --user <user> --pass <pass> --mode <mode> < $file
+
+Options:
+--base <base> bugzilla base name
+--user <user> bugzilla base user
+--pass <pass> bugzilla base password
+--mode <mode> package or packager
+EOF
+}
diff --git a/bin/youri-check.in b/bin/youri-check.in
new file mode 100755
index 0000000..38d806a
--- /dev/null
+++ b/bin/youri-check.in
@@ -0,0 +1,395 @@
+#!/usr/bin/perl
+# $Id: youri-check.in 943 2006-07-05 09:29:09Z guillomovitch $
+
+=head1 NAME
+
+youri-check - package check agent
+
+=head1 VERSION
+
+Version 1.0
+
+=head1 SYNOPSIS
+
+youri-check [options] <mode>
+
+Options:
+
+    --config <file>        use file <file> as config file
+    --skip-media <media>   skip media <media>
+    --skip-plugin <plugin> skip plugin <plugin>
+    --parallel             parallel run
+    --verbose              verbose run
+    --test                 test run
+    --help                 print this help message
+
+=head1 DESCRIPTION
+
+B<youri-check> allows to check packages in a repository.
+
+In input mode, all medias defined in configuration are passed to a list of
+input plugins, each of them storing their result in a persistent resultset. In
+output mode, this resultset is passed to a list of output plugins, each of them
+producing arbitrary effects.
+
+=head1 OPTIONS
+
+=over
+
+=item B<--config> <file>
+
+Use given file as configuration, instead of normal one.
+
+=item B<--skip-media> <media>
+
+Skip media with given identity.
+
+=item B<--skip-plugin> <plugin>
+
+Skip plugin with given identity.
+
+=item B<--parallel>
+
+Run all plugins parallelously
+
+=item B<--verbose>
+
+Produce more verbose output (can be used more than once)
+
+=item B<--test>
+
+Don't perform any modification.
+
+=item B<--help>
+
+Print a brief help message and exits.
+
+=back
+
+=head1 CONFIGURATION
+
+Configuration is read from the first file found among:
+
+=over
+
+=item * the one specified by B<--config> option on command-line
+
+=item * $HOME/.youri/check.conf
+
+=item * @sysconfdir@/youri/check.conf
+
+=back
+
+All additional configuration files specified by B<includes> directive are then
+processed. Then command line options. Any directive overrides prior definition.
+
+=over
+
+=item B<includes> I<files>
+
+Uses space-separated list I<files> as a list of additional configuration files.
+
+=item B<resolver> I<id>
+
+Declare a maintainer resolver object with identity I<id>.
+
+=item B<preferences> I<id>
+
+Declare a maintainer preferences object with identity I<id>.
+
+=item B<resultset> I<id>
+
+Declare a resultset object with identity I<id>.
+
+=item B<medias> I<ids>
+
+Declares a list of media objects with identity taken in space-separated list
+I<ids>.
+
+=item B<inputs> I<ids>
+
+Declares a list of input plugin objects with identity taken in space-separated
+list I<ids>.
+
+=item B<outputs> I<ids>
+
+Declares a list of output plugin objects with identity taken in space-separated
+list I<ids>.
+
+=back
+
+Each object declared in configuration must be fully defined later, using a
+configuration section, starting with bracketed object identity, followed by at
+least a class directive, then any number of additional object-specific
+directives.
+
+Example:
+
+        objects = foo
+        
+        [foo]
+        class = Foo::Bar
+        key1  = value1
+        key2  = value2
+
+=head1 SEE ALSO
+
+Youri::Config, for configuration file format.
+
+Each used plugin man page, for available options.
+
+=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
+
+use strict;
+use warnings;
+
+use Youri::Config;
+use Youri::Utils;
+use Pod::Usage;
+use Net::Config qw/%NetConfig/;
+use DateTime;
+
+my $config = Youri::Config->new(
+    command_spec => [
+        'config=s',
+        'skip-plugin=s@',
+        'skip-media=s@',
+        'parallel!',
+        'help|h!',
+        'test|t!',
+        'verbose|v!'
+    ],
+    file_spec => [
+        'includes=s',
+        'resolver=s',
+        'preferences=s',
+        'resultset=s',
+        'medias=s',
+        'inputs=s',
+        'outputs=s'
+    ],
+    directories => [ '@sysconfdir@', "$ENV{HOME}/.youri" ],
+    file_name   => 'check.conf',
+    caller => $0,
+);
+
+pod2usage(
+    -verbose => 0,
+    -message => "No mode specified, aborting\n"
+) unless @ARGV;
+
+my $mode = $ARGV[0];
+
+# convenient global flags
+my $test    = $config->get('test');
+my $verbose = $config->get('verbose');
+
+# libnet configuration
+my %netconfig = $config->get_section('netconfig');
+$NetConfig{$_} = $netconfig{$_} foreach keys %netconfig;
+
+# resultset creation
+my $resultset_id = $config->get('resultset');
+die "No resultset defined" unless $resultset_id;
+
+report("Creating resultset $resultset_id");
+my $resultset = create_instance(
+    'Youri::Check::Resultset',
+    test    => $test,
+    verbose => $verbose > 0 ? $verbose - 1 : 0,
+    $config->get_section($resultset_id)
+);
+
+my $children;
+
+my %skip_plugins = map { $_ => 1 } @{$config->get('skip-plugin')};
+
+if ($mode eq 'input') {
+
+    # additional objects
+
+    my $resolver;
+    my $resolver_id = $config->get('resolver');
+    if ($resolver_id) {
+        report("Creating maintainer resolver $resolver_id");
+        eval {
+            $resolver = create_instance(
+                'Youri::Check::Maintainer::Resolver',
+                test    => $test,
+                verbose => $verbose > 1 ? $verbose - 2 : 0,
+                $config->get_section($resolver_id)
+            );
+        };
+        print STDERR "Failed to create maintainer resolver $resolver_id: $@\n" if $@;
+    }
+
+    my $preferences;
+    my $preferences_id = $config->get('preferences');
+    if ($preferences_id) {
+        report("Creating maintainer preferences $preferences_id");
+        eval {
+            $preferences = create_instance(
+                'Youri::Check::Maintainer::Preferences',
+                test      => $test,
+                verbose   => $verbose > 1 ? $verbose - 2 : 0,
+                $config->get_section($preferences_id)
+            );
+        };
+        print STDERR "Failed to create maintainer preferences $preferences_id: $@\n" if $@;
+    }
+
+    my @medias;
+    my %skip_medias = map { $_ => 1 } @{$config->get('skip-media')};
+    foreach my $id (split(/\s+/, $config->get('medias'))) {
+        next if $skip_medias{$id};
+        report("Creating media $id");
+        eval {
+            push(
+                @medias,
+                 create_instance(
+                    'Youri::Media',
+                    id      => $id,
+                    test    => $test,
+                    verbose => $verbose > 0 ? $verbose - 1 : 0,
+                    $config->get_section($id)
+                )
+            );
+        };
+        print STDERR "Failed to create media $id: $@\n" if $@;
+    }
+
+    # prepare resultset
+    $resultset->reset();
+    $resultset->set_resolver($resolver);
+
+
+    foreach my $id (split(/\s+/, $config->get('inputs'))) {
+        next if $skip_plugins{$id};
+        report("Creating input $id");
+        my $input;
+        eval {
+            $input = create_instance(
+                'Youri::Check::Input',
+                id         => $id,
+                test       => $test,
+                verbose    => $verbose > 0 ? $verbose - 1 : 0,
+                resolver   => $resolver,
+                preferences => $preferences,
+                $config->get_section($id)
+            );
+        };
+        if ($@) {
+            print STDERR "Failed to create input $id: $@\n";
+        } else {
+            if ($config->get('parallel')) {
+                # fork
+                my $pid = fork;
+                die "Can't fork: $!" unless defined $pid;
+                if ($pid) {
+                    # parent process
+                    $children++;
+                    next;
+                }
+            }
+            eval {
+                $input->prepare(@medias);
+            };
+            if ($@) {
+                print STDERR "Failed to prepare input $id: $@\n";
+            } else {
+                # clone resultset in child process
+                $resultset = $config->get('parallel') ?
+                    $resultset->clone() :
+                    $resultset;
+
+                foreach my $media (@medias) {
+                    next if $media->skip_input($id);
+                    my $media_id = $media->get_id();
+                    report("running input $id on media $media_id");
+                    eval {
+                        $input->run($media, $resultset);
+                    };
+                    if ($@) {
+                        print STDERR "Failed to run input $id on media $media_id: $@\n";
+                    }
+                }
+            }
+            if ($config->get('parallel')) {
+                # child process
+                exit;
+            }
+        }
+    }
+
+} elsif ($mode eq 'output') {
+
+    foreach my $id (split(/\s+/, $config->get('outputs'))) {
+        next if $skip_plugins{$id};
+        report("Creating output $id");
+        my $output;
+        eval {
+            $output = create_instance(
+                'Youri::Check::Output',
+                id      => $id,
+                test    => $test,
+                verbose => $verbose > 0 ? $verbose - 1 : 0,
+                config  => $config,
+                $config->get_section($id)
+            );
+        };
+        if ($@) {
+            print STDERR "Failed to create output $id: $@\n";
+        } else {
+            if ($config->get('parallel')) {
+                # fork
+                my $pid = fork;
+                die "Can't fork: $!" unless defined $pid;
+                if ($pid) {
+                    # parent process
+                    $children++;
+                    next;
+                }
+            }
+
+            # clone resultset in child process
+            $resultset = $config->get('parallel') ?
+                $resultset->clone() :
+                $resultset;
+
+            report("running output $id");
+            eval {
+                $output->run($resultset);
+            };
+            if ($@) {
+                print STDERR "Failed to run output $id: $@\n";
+            }
+
+            if ($config->get('parallel')) {
+                # child process
+                exit;
+            }
+        }
+    }
+} else {
+    die "Invalid mode $mode";
+}
+
+# wait for all forked processus termination
+while ($children) {
+    wait;
+    $children--;
+}
+
+sub report {
+    my ($message) = @_;
+    print DateTime->now()->strftime('[%H:%M:%S] ')
+        if $verbose > 1;
+    print "$message\n"
+        if $verbose > 0;
+}
diff --git a/bin/youri-upload.in b/bin/youri-upload.in
new file mode 100755
index 0000000..a1f2ee0
--- /dev/null
+++ b/bin/youri-upload.in
@@ -0,0 +1,297 @@
+#!/usr/bin/perl
+# $Id: youri-upload.in 967 2006-08-03 21:23:05Z guillomovitch $
+
+=head1 NAME
+
+youri-upload - package upload agent
+
+=head1 VERSION
+
+Version 2.0
+
+=head1 SYNOPSIS
+
+youri-upload [options] <target> <files>
+
+Options:
+
+    --config <file>        use file <file> as config file
+    --skip-check <check>   skip check <check>
+    --skip-action <action> skip action <action>
+    --define <key>=<value> pass additional values
+    --list-targets         list available targets
+    --list-checks <target> list configured checks for for <target>
+    --list-actions <target> list configured actions for for <target>
+    --verbose              verbose run
+    --test                 test run
+    --help                 print this help message
+
+=head1 DESCRIPTION
+
+B<youri-upload> allows to upload packages in a repository.
+
+All packages given on command lines are passed to a list of check plugins,
+depending on given upload target. If none of them fails, all packages are
+passed to a list of action plugins, depending also on given upload target.
+
+=head1 OPTIONS
+
+=over
+
+=item B<--config> I<file>
+
+Use given file as configuration, instead of normal one.
+
+=item B<--skip-check> I<id>
+
+Skip check plugin with given identity.
+
+=item B<--skip-action> I<id>
+
+Skip action plugin with given identity.
+
+=item B<--define> <key>=<value>
+
+Define additional parameters, to be used by plugins.
+
+=item B<--verbose>
+
+Produce more verbose output (can be used more than once)
+
+=item B<--test>
+
+Don't perform any modification.
+
+=item B<--list-targets>
+
+List available targets
+
+=item B<--list-checks> I<target>
+
+List configured checks for given target 
+
+=item B<--list-actions> I<target>
+
+List configured actions for given target 
+
+=item B<--help>
+
+Print a brief help message and exits.
+
+=back
+
+=head1 CONFIGURATION
+
+Configuration is read from the first file found among:
+
+=over
+
+=item * the one specified by B<--config> option on command-line
+
+=item * $HOME/.youri/upload.conf
+
+=item * @sysconfdir@/youri/upload.conf
+
+=back
+
+All additional configuration files specified by B<includes> directive are then
+processed. Then command line options. Any directive overrides prior definition.
+
+=over
+
+=item B<includes> I<files>
+
+Uses space-separated list I<files> as a list of additional configuration files.
+
+=item B<repository> I<id>
+
+Declares a repository object with identity I<id>.
+
+=item B<targets> I<ids>
+
+Declares a list of upload target objects with identity taken in space-separated list I<ids>.
+
+=back
+
+Each object declared in configuration must be fully defined later, using a
+configuration section, starting with bracketed object identity, followed by at
+least a class directive, then any number of additional object-specific
+directives.
+
+Example:
+
+        objects = foo
+        
+        [foo]
+        class = Foo::Bar
+        key1  = value1
+        key2  = value2
+
+=head1 SEE ALSO
+
+Youri::Config, for configuration file format.
+
+Each used plugin man page, for available options.
+
+=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
+
+use strict;
+use warnings;
+
+use Youri::Config;
+use Youri::Utils;
+use Pod::Usage;
+
+my $config = Youri::Config->new(
+    command_spec => [
+        'config=s',
+        'skip-check=s@',
+        'skip-action=s@',
+        'list-targets!',
+        'list-checks=s',
+        'list-actions=s',
+        'define=s%',
+        'help|h!',
+        'test|t!',
+        'verbose|v!'
+    ],
+    file_spec => [
+        'includes=s',
+        'targets=s',
+        'repository=s',
+    ],
+    directories => [ '@sysconfdir@', "$ENV{HOME}/.youri" ],
+    file_name   => 'upload.conf',
+    caller => $0,
+);
+
+# compute available targets first
+my %targets = map { $_ => 1 } split(/\s+/, $config->get('targets'));
+
+if ($config->get('list-targets')) {
+    print join(' ', keys %targets) . "\n";
+    exit 0;
+} elsif ($config->get('list-checks')) {
+    my %target = get_target_config($config->get('list-checks'));
+    print join(' ', @{$target{checks}}) . "\n";
+    exit 0;
+} elsif ($config->get('list-actions')) {
+    my %target = get_target_config($config->get('list-actions'));
+    print join(' ', @{$target{actions}}) . "\n";
+    exit 0;
+}
+
+pod2usage(-verbose => 0, -message => "No target specified, aborting\n")
+    unless @ARGV > 0;
+pod2usage(-verbose => 0, -message => "No packages specified, aborting\n")
+    unless @ARGV > 1;
+
+# convenient global flags
+my $test    = $config->get('test');
+my $verbose = $config->get('verbose');
+
+# check target
+my $target = shift @ARGV;
+my %target = get_target_config($target);
+
+# create repository
+my $repository;
+my $repository_id = $config->get('repository');
+die "No repository declared" unless $repository_id;
+print "Creating repository $repository_id\n" if $verbose;
+eval {
+    $repository = create_instance(
+        'Youri::Repository',
+        test    => $test,
+        verbose => $verbose > 0 ? $verbose - 1 : 0,
+        targets => [ keys %targets ],
+        $config->get_section($repository_id)
+    );
+};
+die "Failed to create repository $repository_id: $@\n" if $@;
+
+# create packages
+my @packages;
+foreach my $file (@ARGV) {
+    push(
+        @packages,
+        create_instance(
+            'Youri::Package',
+            class => $repository->get_package_class(),
+            file => $file
+        )
+    );
+}
+
+# check all packages pass all tests
+my %skip_checks = map { $_ => 1 } @{$config->get('skip-check')};
+foreach my $id (@{$target{checks}}) {
+    next if $skip_checks{$id};
+    print "Creating check $id\n" if $verbose;
+    my $check;
+    eval {
+        $check = create_instance(
+            'Youri::Upload::Check',
+            id       => $id,
+            test     => $test,
+            verbose  => $verbose > 0 ? $verbose - 1 : 0,
+            $config->get_section($id)
+        );
+    };
+    if ($@) {
+        print STDERR "Failed to create check $id: $@\n";
+    } else {
+        foreach my $package (@packages) {
+            print "running check $id on package $package\n" if $verbose;
+            unless ($check->run($package, $repository, $target, $config->get('define'))) {
+                print STDERR "Error: " . $check->get_error() . ", aborting\n";
+                exit(1);
+            }
+        }
+    }
+}
+
+# proceed further
+my %skip_actions = map { $_ => 1 } @{$config->get('skip-action')};
+foreach my $id (@{$target{actions}}) {
+    next if $skip_actions{$id};
+    print "Creating action $id\n" if $verbose;
+    my $action;
+    eval {
+        $action = create_instance(
+            'Youri::Upload::Action',
+            id       => $id,
+            test     => $test,
+            verbose  => $verbose > 0 ? $verbose - 1 : 0,
+            $config->get_section($id)
+        );
+    };
+    if ($@) {
+        print STDERR "Failed to create action $id: $@\n";
+    } else {
+        foreach my $package (@packages) {
+            print "running action $id on package $package\n" if $verbose;
+            eval {
+                $action->run($package, $repository, $target, $config->get('define'));
+                };
+            if ($@) {
+                print STDERR "Failed to run action $id on package $package: $@\n";
+            }
+        }
+    }
+}
+
+sub get_target_config {
+    my ($id) = @_;
+    die "Unavailable target $target" unless $targets{$id};
+
+    my %target = $config->get_section($id);
+    die "Undefined target $id" unless %target;
+    return %target;
+}