prepare mergeupstream

4 files changed, 490 insertions, 0 deletions

diff --git a/bin/Makefile.am b/bin/Makefile.am
new file mode 100644
index 0000000..41dcd32
--- /dev/null
+++ b/bin/Makefile.am
@@ -0,0 +1,38 @@
+bin_SCRIPTS = youri-submit youri-submit-restricted youri-submit-proxy
+man1_MANS   = youri-submit.1 youri-submit-restricted.1 youri-submit-proxy.1
+
+CLEANFILES = $(bin_SCRIPTS) $(man1_MANS)
+EXTRA_DIST = youri-submit.in youri-submit-restricted.in youri-submit-proxy.in
+
+youri-submit: youri-submit.in
+	$(PERL) -pi \
+		-e 's|\@sysconfdir\@|$(sysconfdir)|;' \
+		-e 's|\@bindir\@|$(bindir)|;' \
+		-e 's|\@perllibdir\@|$(perllibdir)|;' \
+		< $< > $@
+
+youri-submit-restricted: youri-submit-restricted.in
+	$(PERL) -pi \
+		-e 's|\@sysconfdir\@|$(sysconfdir)|;' \
+		-e 's|\@bindir\@|$(bindir)|;' \
+		-e 's|\@perllibdir\@|$(perllibdir)|;' \
+		< $< > $@
+
+youri-submit-proxy: youri-submit-proxy.in
+	$(PERL) -pi \
+		-e 's|\@sysconfdir\@|$(sysconfdir)|;' \
+		-e 's|\@bindir\@|$(bindir)|;' \
+		-e 's|\@perllibdir\@|$(perllibdir)|;' \
+		< $< > $@
+
+youri-submit.1: youri-submit
+	$(POD2MAN) $< $@
+
+youri-submit-restricted.1: youri-submit-restricted
+	$(POD2MAN) $< $@
+
+youri-submit-proxy.1: youri-submit-proxy
+	$(POD2MAN) $< $@
+
+
+
diff --git a/bin/youri-submit-proxy.in b/bin/youri-submit-proxy.in
new file mode 100755
index 0000000..e563044
--- /dev/null
+++ b/bin/youri-submit-proxy.in
@@ -0,0 +1,82 @@
+#!/usr/bin/perl
+# $Id: youri-submit-proxy.in 1530 2007-03-08 20:42:13Z guillomovitch $
+
+=head1 NAME
+
+youri-submit-proxy - proxy wrapper over youri-submit-restricted
+
+=head1 VERSION
+
+Version 1.0
+
+=head1 SYNOPSIS
+
+youri-submit-proxy [options] <target> <files>
+
+=head1 DESCRIPTION
+
+youri-submit-proxy is a proxy wrapper over youri-submit-restricted, intended to
+be used in collaborative work to change uid before calling it through sudo.
+
+=head1 SEE ALSO
+
+youri-submit-restricted(1), youri-submit(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
+
+use strict;
+use warnings;
+use lib '@perllibdir@';
+
+use Fcntl ':mode';
+use File::Basename;
+
+my ($uid, $gid);
+if (-l $0) {
+    # this is a symlink, get uid and gid from it
+    ($uid, $gid) = (lstat($0))[4, 5];
+} else {
+    ($uid, $gid) = (stat($0))[4, 5];
+}
+my $user = getpwuid($uid) or die "unknown uid $uid\n";
+my $prog = '@bindir@/youri-submit-restricted';
+
+my %dirs;
+my @options;
+foreach my $arg (@ARGV) {
+    if (-f $arg) {
+        # push parent dir in list
+        my $parent = dirname($arg);
+        $dirs{$parent}++;
+    }
+    push(@options, $arg);
+}
+
+foreach my $dir (keys %dirs) {
+    # save original perms and gid
+    my ($orig_mode, $orig_gid) = (stat($dir))[2,5];
+    $dirs{$dir} = {
+        mode => $orig_mode,
+        gid => $orig_gid
+    };
+    # ensure correct perms and gid
+    chown -1, $gid, $dir;
+    chmod $orig_mode|S_IRGRP|S_IWGRP, $dir;
+}
+
+# call wrapped program
+my $status = system('sudo', '-H', '-u', $user, $prog, @options);
+
+foreach my $dir (keys %dirs) {
+    # restore original perms and gid
+    chown -1, $dirs{$dir}->{gid}, $dir;
+    chmod $dirs{$dir}->{mode}, $dir;
+}
+
+exit($status >> 8);
diff --git a/bin/youri-submit-restricted.in b/bin/youri-submit-restricted.in
new file mode 100755
index 0000000..360faf8
--- /dev/null
+++ b/bin/youri-submit-restricted.in
@@ -0,0 +1,69 @@
+#!/usr/bin/perl -T
+# $Id: youri-submit-restricted.in 1530 2007-03-08 20:42:13Z guillomovitch $
+
+=head1 NAME
+
+youri-submit-restricted - filtering wrapper over youri-submit
+
+=head1 VERSION
+
+Version 1.0
+
+=head1 SYNOPSIS
+
+youri-submit-restricted [options] <target> <files>
+
+=head1 DESCRIPTION
+
+youri-submit-restricted is just a filtering wrapper over youri-submit, intended
+to be used in collaborative work to sanitize environment and options before
+calling it.
+
+=head1 SEE ALSO
+
+youri-submit(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
+
+use strict;
+use warnings;
+use lib '@perllibdir@';
+
+my $prog = '@bindir@/youri-submit';
+my @prohibited_options = qw/--config --skip-check --skip-action/;
+my %prohibited_options = map { $_ => 1 } @prohibited_options;
+my @prohibited_envvars = qw/
+    ENV BASH_ENV IFS CDPATH
+    PERLLIB PERL5LIB PERL5OPT PERLIO
+    PERLIO_DEBUG PERL5DB PERL_ENCODING
+    PERL_HASH_SEED PERL_SIGNALS PERL_UNICODE
+/;
+
+my @options;
+while (my $arg = shift @ARGV) {
+    if ($prohibited_options{$arg}) {
+        # drop prohibited options
+        print STDERR "prohibited option $arg, skipping\n";
+        shift @ARGV;
+    } else {
+        # untaint everything else
+        $arg =~ /(.*)/;
+        push(@options, $1);
+    }
+}
+
+# secure ENV
+$ENV{PATH} = "/sbin:/usr/sbin:/bin:/usr/bin:/usr/X11R6/bin";
+delete $ENV{$_} foreach @prohibited_envvars;
+
+# call wrapped program
+my $status = system($prog, @options);
+
+# return wrapped program original exit status
+exit($status >> 8);
diff --git a/bin/youri-submit.in b/bin/youri-submit.in
new file mode 100755
index 0000000..70e6fb8
--- /dev/null
+++ b/bin/youri-submit.in
@@ -0,0 +1,301 @@
+#!/usr/bin/perl
+# $Id: youri-submit.in 1687 2007-06-28 22:44:07Z guillomovitch $
+
+=head1 NAME
+
+youri-submit - package submission tool
+
+=head1 VERSION
+
+Version 2.0
+
+=head1 SYNOPSIS
+
+youri-submit [options] <target> <files>
+
+youri-submit --list <category> [target]
+
+youri-submit --help [category] [item]
+
+Options:
+
+    --config <file>        use file <file> as config file
+    --skip-step <step>     skip step <step>
+    --define <key>=<value> pass additional values
+    --clean                delete package after success
+    --verbose              verbose run
+    --test                 test run
+    --list <category>      list items from given category
+    --help [category]      display contextual help
+
+=head1 DESCRIPTION
+
+B<youri-submit> allows to submit packages to a repository.
+
+All packages given on command lines are passed to a list of test 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-step> I<id>
+
+Skip step with given identity.
+
+=item B<--define> <key>=<value>
+
+Define additional parameters, to be used by plugins.
+
+=item B<--clean>
+
+Delete submited packages upon successfull submission.
+
+=item B<--verbose>
+
+Produce more verbose output (can be used more than once)
+
+=item B<--test>
+
+Don't perform any modification.
+
+=item B<--list> I<category>
+
+List available items from given category and exits. Category must be either
+B<targets>, B<actions> or B<tests>. A target is needed for the two last ones.
+
+=item B<--help> I<category>
+
+Display help for given category and exits. Category must be either
+B<repository>, B<action> or B<test>. An item is needed for the two last ones.
+If no category given, display standard help.
+
+=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/submit.conf
+
+=item * @sysconfdir@/youri/submit.conf
+
+=back
+
+The configuration file should be a YAML-format files, with the following
+mandatory top-level directives:
+
+=over
+
+=item B<repository>
+
+The definition of repository plugin to be used.
+
+=item B<targets>
+
+The list of available submission targets, each one being composed from the
+following keys:
+
+=over
+
+=item B<steps>
+
+The list of steps to use for this target.
+
+=back
+
+=item B<steps>
+
+The definitions of steps, indexed by their identity.
+
+=back
+
+=head1 SEE ALSO
+
+Youri::Config, for additional details about 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 lib '@perllibdir@';
+
+use Youri::Config;
+use Youri::Utils 0.002;
+use Pod::Usage;
+
+my $config = Youri::Config->new(
+    args => {
+        'skip-step' => '=s@',
+        'define'    => '=s%',
+        'timestamp' => '!',
+        'clean'     => '!',
+        'test'      => '|t!',
+        'list'      => '|l!'
+    },
+    directories => [ "$ENV{HOME}/.youri", '@sysconfdir@/youri' ],
+    file => 'submit.conf',
+);
+
+if ($config->get_arg('list')) {
+    my $category = $ARGV[0];
+    pod2usage(-verbose => 0, -message => "No category specified, aborting\n")
+        unless $category;
+    if ($category eq 'targets') { 
+        print join(' ', keys %{$config->get_param('targets')});
+    } elsif ($category eq 'steps') {
+        my $target = $ARGV[1];
+        pod2usage(-verbose => 0, -message => "No target specified, aborting\n")
+            unless $target;
+        my $steps = $config->get_param('targets')->{$target}->{steps};
+        print join(' ', @{$steps}) if $steps;
+    } else {
+        pod2usage(-verbose => 0, -message => "Invalid category $category, aborting\n")
+    }
+    print "\n";
+    exit 0;
+}
+
+if ($config->get_arg('help')) {
+    my $category = $ARGV[0];
+    my ($item, $section);
+    if ($category eq 'repository') { 
+        $section = $config->get_param('repository');
+        pod2usage(
+            -verbose => 0,
+            -message => "No repository defined, aborting\n"
+        ) unless $section;
+    } elsif ($category eq 'step') {
+        $item = $ARGV[1];
+        pod2usage(
+            -verbose => 0,
+            -message => "No item specified, aborting\n"
+        ) unless $item;
+        $section = $config->get_param('steps')->{$item};
+        pod2usage(
+            -verbose => 0,
+            -message => "No such step $item defined, aborting\n"
+        ) unless $section;
+    } else {
+        pod2usage(-verbose => 0, -message => "Invalid category $category, aborting\n")
+    }
+    my $file = $section->{class} . '.pm';
+    $file =~ s/::/\//g;
+    pod2usage(
+        -verbose  => 99,
+        -sections => 'NAME|DESCRIPTION',
+        -input    => $file,
+        -pathlist => \@INC
+    );
+}
+
+
+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_arg('test');
+my $verbose = $config->get_arg('verbose');
+my $timestamp = $config->get_arg('timestamp');
+
+# test target
+my $target = shift @ARGV;
+my $target_conf = $config->get_param('targets')->{$target};
+
+# create repository
+my $repository;
+my $repository_conf = $config->get_param('repository');
+die "No repository declared\n" unless $repository_conf;
+log_message("Creating repository", $timestamp) if $verbose;
+eval {
+    $repository = create_instance(
+        'Youri::Repository',
+        $repository_conf,
+        {
+            test    => $test,
+            verbose => $verbose > 0 ? $verbose - 1 : 0,
+            targets => [ keys %{$config->get_param('targets')} ],
+        }
+    );
+};
+die "Failed to create repository: $@\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 %errors;
+my $skip_step = $config->get_arg('skip-step');
+my %skip_step = $skip_step ?  map { $_ => 1 } @{$skip_step} : ();
+eval {
+    foreach my $id (@{$target_conf->{steps}}) {
+        next if $skip_step{$id};
+        my $step_conf = $config->get_param('steps')->{$id};
+
+        die "Invalid configuration, step $id is not defined\n"
+            unless $step_conf;
+
+        log_message("Creating step $id", $timestamp) if $verbose;
+        my $step;
+        $test = create_instance(
+            'Youri::Submit::Step',
+            $step_conf,
+            {
+                id       => $id,
+                test     => $test,
+                verbose  => $verbose > 0 ? $verbose - 1 : 0,
+            }
+        );
+
+        log_message("Running step $id", $timestamp) if $verbose;
+        $step->run(
+            \@packages
+            $repository,
+            $target,
+            $config->get_arg('define'),
+        );
+    }
+};
+if ($@) {
+    die "Error during submission: $@\n";
+}
+
+if ($config->get_arg('clean')) {
+    foreach my $package (@packages) {
+        log_message("cleaning file $package", $timestamp) if $verbose;
+        unlink $package->as_file();
+    }
+}