r23204 - in /scripts: KGB/ KGB/KGB KGB/KGB_sendcommit KGB/kgb.conf KGB/post-commit takeover-for-pkg-perl.sh
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Mon Jul 14 19:54:54 UTC 2008
Author: dmn
Date: Mon Jul 14 19:54:52 2008
New Revision: 23204
URL: http://svn.debian.org/wsvn/?sc=1&rev=23204
Log:
Imported KGB dump from Tincho
Added:
scripts/KGB/
scripts/KGB/KGB (with props)
scripts/KGB/KGB_sendcommit (with props)
scripts/KGB/kgb.conf
scripts/KGB/post-commit (with props)
Modified:
scripts/takeover-for-pkg-perl.sh
Added: scripts/KGB/KGB
URL: http://svn.debian.org/wsvn/scripts/KGB/KGB?rev=23204&op=file
==============================================================================
--- scripts/KGB/KGB (added)
+++ scripts/KGB/KGB Mon Jul 14 19:54:52 2008
@@ -1,0 +1,238 @@
+#!/usr/bin/perl
+# vim: ts=4:sw=4:et:ai:sts=4
+
+use strict;
+use warnings;
+
+use POE;
+use POE::Component::Server::SOAP;
+use POE::Component::IRC::State;
+use POE::Component::IRC::Plugin::Connector;
+use Getopt::Long;
+use List::Util qw(max);
+use YAML ();
+
+my $conf = YAML::LoadFile("kgb.conf") or die "Error loading config";
+
+die "Invalid config key: soap" unless(ref $conf->{soap}
+ and ref $conf->{soap} eq "HASH");
+die "Invalid config key: repositories" unless(ref $conf->{repositories}
+ and ref $conf->{repositories} eq "HASH");
+die "Invalid config key: networks" unless(ref $conf->{networks}
+ and ref $conf->{networks} eq "HASH");
+die "Invalid config key: channels" unless(ref $conf->{channels}
+ and ref $conf->{channels} eq "ARRAY");
+
+$conf->{soap}{service_name} ||= "KGB";
+$conf->{soap}{server_port} ||= 9999;
+$conf->{soap}{server_addr} ||= "0.0.0.0";
+foreach(keys %{$conf->{networks}}) {
+ $conf->{networks}{$_}{nick} ||= "KGB";
+ $conf->{networks}{$_}{ircname} ||= "KGB bot";
+ $conf->{networks}{$_}{username} ||= "kgb";
+ $conf->{networks}{$_}{port} ||= 6667;
+ die "Missing server name in network $_\n" unless(
+ $conf->{networks}{$_}{server});
+}
+foreach(@{$conf->{channels}}) {
+ die "Missing channel name at channel\n" unless($_->{name});
+ die "Invalid network at channel ".$_->{name}."\n" unless($_->{network}
+ and $conf->{networks}{$_->{network}});
+ push @{$conf->{networks}{$_->{network}}{channels}}, $_->{name};
+ die "Invalid repos key at channel ".$_->{name}."\n" unless(ref $_->{repos}
+ and ref $_->{repos} eq "ARRAY");
+ warn "Channel ".$_->{name}." doesn't listen on any repository\n" unless(
+ @{$_->{repos}});
+ foreach my $repo (@{$_->{repos}}) {
+ die "Invalid repository $repo at channel ".$_->{name}."\n" unless(
+ $conf->{repositories}{$repo});
+ push @{$conf->{repositories}{$repo}{channels}}, $_->{name};
+ }
+}
+my %chanidx = map ({ $conf->{channels}[$_]{name} => $conf->{channels}[$_] }
+ 0..$#{$conf->{channels}});
+$conf->{chanidx} = \%chanidx;
+
+POE::Component::Server::SOAP->new(
+ ALIAS => "SOAPServer",
+ ADDRESS => $conf->{soap}{server_addr},
+ PORT => $conf->{soap}{server_port},
+);
+
+foreach(keys %{$conf->{networks}}) {
+ POE::Component::IRC::State->spawn(
+ Alias => "irc_$_",
+ Nick => $conf->{networks}{$_}{nick},
+ Ircname => $conf->{networks}{$_}{ircname},
+ Username => $conf->{networks}{$_}{user},
+ Password => $conf->{networks}{$_}{password}
+ );
+}
+POE::Session->create(
+ inline_states => {
+ _start => \&setup_service,
+ _stop => \&shutdown_service,
+ soap_commit => \&do_commit,
+ soap_dump => \&do_dump,
+ irc_registered => \&irc_registered,
+ irc_001 => \&irc_001,
+ irc_public => \&irc_public,
+ _default => \&irc_default,
+ sighandler => \&sighandler,
+ },
+);
+
+$poe_kernel->run;
+exit 0;
+
+sub setup_service {
+ my $kernel = $_[KERNEL];
+ my $session = $_[SESSION];
+ my $heap = $_[HEAP];
+
+ $kernel->sig( INT => 'sighandler' );
+ $kernel->sig( TERM => 'sighandler' );
+
+ $kernel->alias_set($conf->{soap}{service_name});
+ $kernel->post(SOAPServer => 'ADDMETHOD',
+ $conf->{soap}{service_name}, 'soap_commit',
+ $conf->{soap}{service_name}, 'commit',
+ );
+ $kernel->signal($kernel => 'POCOIRC_REGISTER', $session->ID(), 'all');
+ $heap->{connector} = POE::Component::IRC::Plugin::Connector->new();
+
+ warn("Listening on http://", $conf->{soap}{server_addr}, ":",
+ $conf->{soap}{server_port}, "?session=", $conf->{soap}{service_name},
+ "\n");
+ undef;
+}
+sub irc_registered {
+ my ($kernel, $heap, $sender, $irc_object) = @_[KERNEL, HEAP, SENDER, ARG0];
+ my $alias = $irc_object->session_alias();
+
+ $alias =~ s/^irc_//;
+ $irc_object->plugin_add('Connector' => $heap->{connector});
+ $kernel->post($sender => connect => {
+ Server => $conf->{networks}{$alias}{server},
+ Port => $conf->{networks}{$alias}{port},
+ });
+ undef;
+}
+sub shutdown_service {
+ my $kernel = $_[KERNEL];
+ my $session = $_[SESSION]->ID();
+ warn "_stop \@session $session\n";
+ $kernel->post(SOAPServer => 'DELSERVICE', $conf->{soap}{service_name});
+}
+sub sighandler {
+ my($kernel, $sig) = ($_[KERNEL], $_[ARG0]);
+ warn "Deadly signal $sig received, exiting...\n";
+ $kernel->sig_handled();
+ $kernel->signal($kernel => 'POCOIRC_SHUTDOWN', "KGB going to drink vodka");
+ $kernel->post(SOAPServer => 'STOPLISTEN');
+ my $heap = $_[HEAP];
+ delete $heap->{$_} foreach(keys %$heap);
+ undef;
+}
+sub do_commit {
+ my $kernel = $_[KERNEL];
+ my $response = $_[ARG0];
+ my $params = $response->soapbody;
+ warn("commit: " . YAML::Dump($params));
+ unless(ref $params and ref $params eq "HASH"
+ and $params->{Array} and ref $params->{Array}
+ and ref $params->{Array} eq "ARRAY"
+ and scalar @{$params->{Array}} == 6) {
+ $kernel->post(SOAPServer => 'FAULT', $response, 'Client.Arguments',
+ 'commit(string repo_id, string password, int rev, ' .
+ 'string[] paths, string log, string author)');
+ warn("Invalid call\n");
+ return;
+ }
+ my($repo_id, $passwd, $rev, $paths, $log, $author) = @{$params->{Array}};
+ unless($conf->{repositories}{$repo_id}) {
+ $kernel->post(SOAPServer => 'FAULT', $response, 'Client.Arguments',
+ "Repository $repo_id is unknown");
+ warn("Unknown repository\n");
+ return
+ }
+ if($conf->{repositories}{$repo_id}{password} and
+ $conf->{repositories}{$repo_id}{password} ne $passwd) {
+ $kernel->post(SOAPServer => 'FAULT', $response, 'Client.Arguments',
+ "Invalid password for repository $repo_id");
+ warn("Invalid password\n");
+ return
+ }
+ my @log = split(/\n+/, $log);
+ my @string = ("\002$repo_id\017: \00303$author\017 * r\002$rev\017 " .
+ "(files: \00310@$paths\017) $log[0]");
+ foreach(1..$#log) {
+ push @string, "\002$repo_id\017: $log[$_]";
+ }
+ my @tmp;
+ # Standard says 512 (minus \r\n), anyway that's further trimmed when
+ # resending to clients because of prefix.
+ # Let's trim on 400, to be safe
+ my $MAGIC_MAX_LINE = (400 - length("PRIVMSG ") -
+ max(map(length, @{$conf->{repositories}{$repo_id}{channels}})) -
+ length(" :"));
+ while($_ = shift @string) {
+ if(length($_) > $MAGIC_MAX_LINE) {
+ push @tmp, substr($_, 0, $MAGIC_MAX_LINE);
+ unshift @string, "\002$repo_id\017: " . substr($_, $MAGIC_MAX_LINE);
+ } else {
+ push @tmp, $_;
+ }
+ }
+ @string = @tmp;
+ foreach my $chan (@{$conf->{repositories}{$repo_id}{channels}}) {
+ my $alias = "irc_" . $conf->{chanidx}{$chan}{network};
+ $kernel->post($alias => privmsg => $chan => $_) foreach(@string);
+ print "$alias/$chan > $_\n" foreach(@string);
+ }
+ $response->content( "OK" );
+ $kernel->post( SOAPServer => 'DONE', $response );
+}
+sub irc_default {
+ my ($event, $args) = @_[ ARG0 .. $#_ ];
+ my $out = "$event ";
+ foreach (@$args) {
+ if(ref($_) eq 'ARRAY') {
+ $out .= "[" . join (", ", @$_) . "] ";
+ } elsif(ref($_) eq 'HASH') {
+ $out .= "{" . join (", ", %$_) . "} ";
+ } elsif(defined $_) {
+ $out .= "'$_' ";
+ } else {
+ $out .= "undef ";
+ }
+ }
+ print "$out\n";
+ return 0;
+}
+sub irc_public {
+ my ($kernel, $heap, $who, $where, $what) = @_[KERNEL, HEAP, ARG0, ARG1,
+ ARG2];
+ my $nick = (split /!/, $who)[0];
+ my $chan = $where->[0];
+
+ print($chan . ':<' . $nick . '> ' . $what . "\n");
+ undef;
+}
+sub irc_001 {
+ my ($kernel, $sender) = @_[KERNEL, SENDER];
+ my $poco_object = $sender->get_heap();
+ my $alias = $poco_object->session_alias();
+
+ $alias =~ s/^irc_//;
+ # Get the component's object at any time by accessing the heap of
+ # the SENDER
+ print "Connected to $alias (", $poco_object->server_name(), ")\n";
+ my $channels = $conf->{networks}{$alias}{channels};
+ if($channels) {
+ print "Joining @$channels...\n";
+ # In any irc_* events SENDER will be the PoCo-IRC session
+ $kernel->post( $sender => join => $_ ) for @$channels;
+ }
+ undef;
+}
Propchange: scripts/KGB/KGB
------------------------------------------------------------------------------
svn:executable = *
Added: scripts/KGB/KGB_sendcommit
URL: http://svn.debian.org/wsvn/scripts/KGB/KGB_sendcommit?rev=23204&op=file
==============================================================================
--- scripts/KGB/KGB_sendcommit (added)
+++ scripts/KGB/KGB_sendcommit Mon Jul 14 19:54:52 2008
@@ -1,0 +1,60 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use SVN::Fs;
+use SVN::Repos;
+use SVN::Core;
+use SOAP::Lite;
+use utf8;
+
+#my $pool = SVN::Pool->new_default;
+my $uri = "http://asterix.decidir.net:9999/";
+my $proxy = "http://asterix.decidir.net:9999/?session=KGB";
+
+my($repoid, $path, $rev) = @ARGV;
+die "$0 repoid path [revision]\n" unless($repoid and $path);
+
+my $repo = SVN::Repos::open($path);
+my $fs = $repo->fs or die $!;
+
+$rev ||= $fs->youngest_rev;
+my $log = $fs->revision_prop($rev, "svn:log");
+my $aut = $fs->revision_prop($rev, "svn:author");
+
+my $root = $fs->revision_root($rev);
+my $changed = $root->paths_changed();
+my @changed;
+foreach(keys %$changed) {
+ my $k = $changed->{$_}->change_kind();
+ if($k == $SVN::Fs::PathChange::modify) {
+ $k = "M";
+ } elsif($k == $SVN::Fs::PathChange::add) {
+ $k = "A";
+ } elsif($k == $SVN::Fs::PathChange::delete) {
+ $k = "D";
+ }
+ my $pm = $changed->{$_}->prop_mod() ? "+" : " ";
+ my $tm = $changed->{$_}->text_mod() ? "+" : " ";
+ push @changed, "($k$tm$pm) $_";
+}
+#utf8::encode($aut);
+#utf8::encode($log);
+#utf8::encode($_) foreach(@changed);
+
+my $s = SOAP::Lite->new(uri => $uri, proxy => $proxy);
+$s->on_fault(sub {
+ my($soap, $res) = @_;
+ die "SOAP fault: ", ref $res ? $res->faultdetail :
+ $soap->transport->status, "\n";
+ });
+
+my $res = $s->commit([
+ $repoid, undef, SOAP::Data->type(int => $rev),
+ [ map({SOAP::Data->type(string => $_)} @changed) ],
+ SOAP::Data->type(string => $log),
+ SOAP::Data->type(string => $aut)]);
+
+#print $res->result(), "\n";
+
Propchange: scripts/KGB/KGB_sendcommit
------------------------------------------------------------------------------
svn:executable = *
Added: scripts/KGB/kgb.conf
URL: http://svn.debian.org/wsvn/scripts/KGB/kgb.conf?rev=23204&op=file
==============================================================================
--- scripts/KGB/kgb.conf (added)
+++ scripts/KGB/kgb.conf Mon Jul 14 19:54:52 2008
@@ -1,0 +1,21 @@
+# vim: filetype=yaml
+---
+soap:
+ server_addr: 0.0.0.0
+ server_port: 9999
+ service_name: KGB
+repositories:
+ foo: {} # just a name to identify it
+networks:
+ freenode:
+ nick: KGB
+ ircname: KGB bot
+ username: kgb
+ password: ~
+ server: irc.freenode.net
+ port: 6667
+channels:
+ - name: '#foo'
+ network: freenode
+ repos:
+ - foo
Added: scripts/KGB/post-commit
URL: http://svn.debian.org/wsvn/scripts/KGB/post-commit?rev=23204&op=file
==============================================================================
--- scripts/KGB/post-commit (added)
+++ scripts/KGB/post-commit Mon Jul 14 19:54:52 2008
@@ -1,0 +1,55 @@
+#!/bin/sh
+
+# POST-COMMIT HOOK
+#
+# The post-commit hook is invoked after a commit. Subversion runs
+# this hook by invoking a program (script, executable, binary, etc.)
+# named 'post-commit' (for which this file is a template) with the
+# following ordered arguments:
+#
+# [1] REPOS-PATH (the path to this repository)
+# [2] REV (the number of the revision just committed)
+#
+# The default working directory for the invocation is undefined, so
+# the program should set one explicitly if it cares.
+#
+# Because the commit has already completed and cannot be undone,
+# the exit code of the hook program is ignored. The hook program
+# can use the 'svnlook' utility to help it examine the
+# newly-committed tree.
+#
+# On a Unix system, the normal procedure is to have 'post-commit'
+# invoke other programs to do the real work, though it may do the
+# work itself too.
+#
+# Note that 'post-commit' must be executable by the user(s) who will
+# invoke it (typically the user httpd runs as), and that user must
+# have filesystem-level permission to access the repository.
+#
+# On a Windows system, you should name the hook program
+# 'post-commit.bat' or 'post-commit.exe',
+# but the basic idea is the same.
+#
+# The hook program typically does not inherit the environment of
+# its parent process. For example, a common problem is for the
+# PATH environment variable to not be set to its usual value, so
+# that subprograms fail to launch unless invoked via absolute path.
+# If you're having unexpected problems with a hook program, the
+# culprit may be unusual (or missing) environment variables.
+#
+# Here is an example hook script, for a Unix /bin/sh interpreter.
+# For more examples and pre-written hooks, see those in
+# the Subversion repository at
+# http://svn.collab.net/repos/svn/trunk/tools/hook-scripts/ and
+# http://svn.collab.net/repos/svn/trunk/contrib/hook-scripts/
+
+
+REPOS="$1"
+REV="$2"
+
+#/usr/share/subversion/hook-scripts/commit-email.pl "$REPOS" "$REV" commit-watchers at example.org
+
+REPO_ID="`echo "$REPOS" | sed 's/-/_/g; s#^.*\(/var/lib\|/srv\)/svn/\(decidir/\)*\(.\+\)$#\3#; s#/*$##'`"
+
+BOT=/srv/svn/bot/KGB_sendcommit
+"$BOT" "$REPO_ID" "$REPOS" "$REV"
Propchange: scripts/KGB/post-commit
------------------------------------------------------------------------------
svn:executable = *
Modified: scripts/takeover-for-pkg-perl.sh
URL: http://svn.debian.org/wsvn/scripts/takeover-for-pkg-perl.sh?rev=23204&op=diff
==============================================================================
--- scripts/takeover-for-pkg-perl.sh (original)
+++ scripts/takeover-for-pkg-perl.sh Mon Jul 14 19:54:52 2008
@@ -12,6 +12,7 @@
-s URL SVN trunk URL (default $SVN)
-m URL URL to a message in which the previous maintainer requests the
takeover
+ -a # RFA bug number (conflicts with -m)
-h show this text
<package> is the source package name that we take over of. You may list more
@@ -23,16 +24,23 @@
SVN='svn+ssh://svn.debian.org/svn/pkg-perl'
TRUNK=''
MAIL=''
+RFA=''
-while getopts t:s:m:h o; do
+while getopts t:s:m:a:h o; do
case $o in
h) usage;;
m) MAIL=$OPTARG;;
t) TRUNK=$OPTARG;;
s) SVN=$OPTARG;;
+ a) RFA=$OPTARG;;
esac
done
shift `expr $OPTIND - 1`
+
+if [ -n "$RFA" ] && [ -n "$MAIL" ]; then
+ echo "-m and -a cannot be given at the same time"
+ exit 1
+fi
[ -n "$TRUNK" ] || usage
@@ -57,6 +65,9 @@
if [ -n "$MAIL" ]; then
TXT="$TXT on maintainer's request ($MAIL)"
fi
+ if [ -n "$RFA" ]; then
+ TXT="$TXT; Closes: #$RFA -- RFA"
+ fi
dch -i -c $TRUNK/$1/debian/changelog "$TXT"
More information about the Pkg-perl-cvs-commits
mailing list