diff options
Diffstat (limited to 'CVSROOT/ciabot.pl')
| -rwxr-xr-x | CVSROOT/ciabot.pl | 327 |
1 files changed, 0 insertions, 327 deletions
diff --git a/CVSROOT/ciabot.pl b/CVSROOT/ciabot.pl deleted file mode 100755 index a4869ed437..0000000000 --- a/CVSROOT/ciabot.pl +++ /dev/null @@ -1,327 +0,0 @@ -#!/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: |