Ned Ludd
parent
412a7e4b2f
commit
20f8846419
|
|
@ -0,0 +1,327 @@
|
|||
#!/usr/bin/perl -w
|
||||
#
|
||||
# ciabot -- Mail a CVS log message to a given address, for the purposes of CIA
|
||||
#
|
||||
# Loosely based on cvslog by Russ Allbery <rra@stanford.edu>
|
||||
# Copyright 1998 Board of Trustees, Leland Stanford Jr. University
|
||||
#
|
||||
# Copyright 2001, 2003, 2004 Petr Baudis <pasky@ucw.cz>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License version 2, as published by the
|
||||
# Free Software Foundation.
|
||||
#
|
||||
# The master location of this file is
|
||||
# http://pasky.or.cz/~pasky/dev/cvs/ciabot.pl.
|
||||
#
|
||||
# This program is designed to run from the loginfo CVS administration file. It
|
||||
# takes a log message, massaging it and mailing it to the address given below.
|
||||
#
|
||||
# Its record in the loginfo file should look like:
|
||||
#
|
||||
# ALL $CVSROOT/CVSROOT/ciabot.pl %s $USER project from_email dest_email ignore_regexp
|
||||
#
|
||||
# Note that the last four parameters are optional, you can alternatively change
|
||||
# the defaults below in the configuration section.
|
||||
#
|
||||
# If it does not work, try to disable $xml_rpc in the configuration section
|
||||
# below.
|
||||
#
|
||||
# ciabot.pl,v 1.110 2004/01/09 17:40:13 pasky
|
||||
# $Id$
|
||||
|
||||
use strict;
|
||||
use vars qw ($project $from_email $dest_email $rpc_uri $sendmail $sync_delay
|
||||
$xml_rpc $ignore_regexp $alt_local_message_target);
|
||||
|
||||
|
||||
|
||||
|
||||
### Configuration
|
||||
|
||||
# Project name (as known to CIA).
|
||||
$project = 'ELinks';
|
||||
|
||||
# The from address in generated mails.
|
||||
$from_email = 'pasky@ucw.cz';
|
||||
|
||||
# Mail all reports to this address.
|
||||
$dest_email = 'cia@navi.cx';
|
||||
|
||||
# If using XML-RPC, connect to this URI.
|
||||
$rpc_uri = 'http://cia.navi.cx/RPC2';
|
||||
|
||||
# Path to your USCD sendmail compatible binary (your mailer daemon created this
|
||||
# program somewhere).
|
||||
$sendmail = '/usr/sbin/sendmail';
|
||||
|
||||
# Number of seconds to wait for possible concurrent instances. CVS calls up
|
||||
# this script for each involved directory separately and this is the sync
|
||||
# delay. 5s looks as a safe value, but feel free to increase if you are running
|
||||
# this on a slower (or overloaded) machine or if you have really a lot of
|
||||
# directories.
|
||||
$sync_delay = 5;
|
||||
|
||||
# This script can communicate with CIA either by mail or by an XML-RPC
|
||||
# interface. The XML-RPC interface is faster and more efficient, however you
|
||||
# need to have RPC::XML perl module installed, and some large CVS hosting sites
|
||||
# (like Savannah or Sourceforge) might not allow outgoing HTTP connections
|
||||
# while they allow outgoing mail. Also, this script will hang and eventually
|
||||
# not deliver the event at all if CIA server happens to be down, which is
|
||||
# unfortunately not an uncommon condition.
|
||||
$xml_rpc = 0;
|
||||
|
||||
# You can make this bot to totally ignore events concerning the objects
|
||||
# specified below. Each object is composed of <module>/<path>/<filename>,
|
||||
# therefore file Manifest in root directory of module gentoo will be called
|
||||
# "gentoo/Manifest", while file src/bfu/inphist.c of module elinks will be
|
||||
# called "elinks/src/bfu/inphist.c". Easy, isn't it?
|
||||
#
|
||||
# This variable should contain regexp, against which will each object be
|
||||
# checked, and if the regexp is matched, the file is ignored. Therefore ie. to
|
||||
# ignore all changes in the two files above and everything concerning module
|
||||
# 'admin', use:
|
||||
#
|
||||
#$ignore_regexp = "^(gentoo/Manifest|elinks/src/bfu/inphist.c|admin/)";
|
||||
$ignore_regexp = "/Manifest\$";
|
||||
|
||||
# It can be useful to also grab the generated XML message by some other
|
||||
# programs and ie. autogenerate some content based on it. Here you can specify
|
||||
# a file to which it will be appended.
|
||||
$alt_local_message_target = "";
|
||||
|
||||
|
||||
|
||||
|
||||
### The code itself
|
||||
|
||||
use vars qw ($user $module $tag @files $logmsg $message);
|
||||
|
||||
my @dir; # This array stores all the affected directories
|
||||
my @dirfiles; # This array is mapped to the @dir array and contains files
|
||||
# affected in each directory
|
||||
|
||||
|
||||
|
||||
### Input data loading
|
||||
|
||||
|
||||
# These arguments are from %s; first the relative path in the repository
|
||||
# and then the list of files modified.
|
||||
|
||||
@files = split (' ', ($ARGV[0] or ''));
|
||||
$dir[0] = shift @files or die "$0: no directory specified\n";
|
||||
$dirfiles[0] = "@files" or die "$0: no files specified\n";
|
||||
|
||||
|
||||
# Guess module name.
|
||||
|
||||
$module = $dir[0]; $module =~ s#/.*##;
|
||||
|
||||
|
||||
# Figure out who is doing the update.
|
||||
|
||||
$user = $ARGV[1];
|
||||
|
||||
|
||||
# Use the optional parameters, if supplied.
|
||||
|
||||
$project = $ARGV[2] if $ARGV[2];
|
||||
$from_email = $ARGV[3] if $ARGV[3];
|
||||
$dest_email = $ARGV[4] if $ARGV[4];
|
||||
$ignore_regexp = $ARGV[5] if $ARGV[5];
|
||||
|
||||
|
||||
# Parse stdin (what's interesting is the tag and log message)
|
||||
|
||||
while (<STDIN>) {
|
||||
$tag = $1 if /^\s*Tag: ([a-zA-Z0-9_-]+)/;
|
||||
last if /^Log Message/;
|
||||
}
|
||||
|
||||
while (<STDIN>) {
|
||||
next unless ($_ and $_ ne "\n" and $_ ne "\r\n");
|
||||
s/&/&/g;
|
||||
s/</</g;
|
||||
s/>/>/g;
|
||||
$logmsg .= $_;
|
||||
}
|
||||
|
||||
|
||||
|
||||
### Remove to-be-ignored files
|
||||
|
||||
$dirfiles[0] = join (' ',
|
||||
grep {
|
||||
my $f = "$module/$dir[0]/$_";
|
||||
$f !~ m/$ignore_regexp/;
|
||||
} split (/\s+/, $dirfiles[0])
|
||||
) if ($ignore_regexp);
|
||||
exit unless $dirfiles[0];
|
||||
|
||||
|
||||
|
||||
### Sync between the multiple instances potentially being ran simultanously
|
||||
|
||||
my $sum; # _VERY_ simple hash of the log message. It is really weak, but I'm
|
||||
# lazy and it's really sorta exceptional to even get more commits
|
||||
# running simultanously anyway.
|
||||
map { $sum += ord $_ } split(//, $logmsg);
|
||||
|
||||
my $syncfile; # Name of the file used for syncing
|
||||
$syncfile = "/tmp/cvscia.$project.$module.$sum";
|
||||
|
||||
|
||||
if (-f $syncfile and -w $syncfile) {
|
||||
# The synchronization file for this file already exists, so we are not the
|
||||
# first ones. So let's just dump what we know and exit.
|
||||
|
||||
open(FF, ">>$syncfile") or die "aieee... can't log, can't log! $syncfile blocked!";
|
||||
print FF "$dirfiles[0]!@!$dir[0]\n";
|
||||
close(FF);
|
||||
exit;
|
||||
|
||||
} else {
|
||||
# We are the first one! Thus, we'll fork, exit the original instance, and
|
||||
# wait a bit with the new one. Then we'll grab what the others collected and
|
||||
# go on.
|
||||
|
||||
# We don't need to care about permissions since all the instances of the one
|
||||
# commit will obviously live as the same user.
|
||||
|
||||
# system("touch") in a different way
|
||||
open(FF, ">>$syncfile") or die "aieee... can't log, can't log! $syncfile blocked!";
|
||||
close(FF);
|
||||
|
||||
exit if (fork);
|
||||
sleep($sync_delay);
|
||||
|
||||
open(FF, $syncfile);
|
||||
my ($dirnum) = 1; # 0 is the one we got triggerred for
|
||||
while (<FF>) {
|
||||
chomp;
|
||||
($dirfiles[$dirnum], $dir[$dirnum]) = split(/!@!/);
|
||||
$dirnum++;
|
||||
}
|
||||
close(FF);
|
||||
|
||||
unlink($syncfile);
|
||||
}
|
||||
|
||||
|
||||
|
||||
### Compose the mail message
|
||||
|
||||
|
||||
my ($VERSION) = '$Revision$' =~ / (\d+\.\d+) /;
|
||||
my $ts = time;
|
||||
|
||||
$message = <<EM
|
||||
<message>
|
||||
<generator>
|
||||
<name>CIA Perl client for CVS</name>
|
||||
<version>$VERSION</version>
|
||||
<url>http://pasky.or.cz/~pasky/dev/cvs/ciabot.pl</url>
|
||||
</generator>
|
||||
<source>
|
||||
<project>$project</project>
|
||||
<module>$module</module>
|
||||
EM
|
||||
;
|
||||
$message .= " <branch>$tag</branch>" if ($tag);
|
||||
$message .= <<EM
|
||||
</source>
|
||||
<timestamp>
|
||||
$ts
|
||||
</timestamp>
|
||||
<body>
|
||||
<commit>
|
||||
<author>$user</author>
|
||||
<files>
|
||||
EM
|
||||
;
|
||||
|
||||
for (my $dirnum = 0; $dirnum < @dir; $dirnum++) {
|
||||
map {
|
||||
$_ = $dir[$dirnum] . '/' . $_;
|
||||
s#^.*?/##; # weed out the module name
|
||||
s/&/&/g;
|
||||
s/</</g;
|
||||
s/>/>/g;
|
||||
$message .= " <file>$_</file>\n";
|
||||
} split(/ /, $dirfiles[$dirnum]);
|
||||
}
|
||||
|
||||
$message .= <<EM
|
||||
</files>
|
||||
<log>
|
||||
$logmsg
|
||||
</log>
|
||||
</commit>
|
||||
</body>
|
||||
</message>
|
||||
EM
|
||||
;
|
||||
|
||||
|
||||
|
||||
### Write the message to an alt-target
|
||||
|
||||
if ($alt_local_message_target and open (ALT, ">>$alt_local_message_target")) {
|
||||
print ALT $message;
|
||||
close ALT;
|
||||
}
|
||||
|
||||
|
||||
|
||||
### Send out the XML-RPC message
|
||||
|
||||
|
||||
if ($xml_rpc) {
|
||||
# We gotta be careful from now on. We silence all the warnings because
|
||||
# RPC::XML code is crappy and works with undefs etc.
|
||||
$^W = 0;
|
||||
$RPC::XML::ERROR if (0); # silence perl's compile-time warning
|
||||
|
||||
require RPC::XML;
|
||||
require RPC::XML::Client;
|
||||
|
||||
my $rpc_client = new RPC::XML::Client $rpc_uri;
|
||||
my $rpc_request = RPC::XML::request->new('hub.deliver', $message);
|
||||
my $rpc_response = $rpc_client->send_request($rpc_request);
|
||||
|
||||
unless (ref $rpc_response) {
|
||||
die "XML-RPC Error: $RPC::XML::ERROR\n";
|
||||
}
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
|
||||
### Send out the mail
|
||||
|
||||
|
||||
# Open our mail program
|
||||
|
||||
open (MAIL, "| $sendmail -t -oi -oem") or die "Cannot execute $sendmail : " . ($?>>8);
|
||||
|
||||
|
||||
# The mail header
|
||||
|
||||
print MAIL <<EOM;
|
||||
From: $from_email
|
||||
To: $dest_email
|
||||
Content-type: text/xml
|
||||
Subject: DeliverXML
|
||||
|
||||
EOM
|
||||
|
||||
print MAIL $message;
|
||||
|
||||
|
||||
# Close the mail
|
||||
|
||||
close MAIL;
|
||||
die "$0: sendmail exit status " . ($? >> 8) . "\n" unless ($? == 0);
|
||||
|
||||
# vi: set sw=2:
|
||||
|
|
@ -24,3 +24,6 @@
|
|||
#DEFAULT (echo ""; id; echo %s; date; cat) >> $CVSROOT/CVSROOT/commitlog
|
||||
# or
|
||||
#DEFAULT (echo ""; id; echo %{sVv}; date; cat) >> $CVSROOT/CVSROOT/commitlog
|
||||
|
||||
#^buildroot ( $CVSROOT/CVSROOT/ciabot.pl %s $USER openwrt cvs-commits@openwrt.ksilebo.net cia@navi.cx )
|
||||
#^root ( $CVSROOT/CVSROOT/ciabot.pl %s $USER openwrt cvs-commits@openwrt.ksilebo.net cia@navi.cx )
|
||||
|
|
|
|||
Loading…
Reference in New Issue