CVSROOT ciabot.pl,1.1,1.2
Joerg Delker <[email protected]>
| Newsgroups | gmane.comp.isp.ispman.cvs |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/ispman/CVSROOT In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9030 Modified Files: ciabot.pl Log Message: deploying new CIA bot Index: ciabot.pl =================================================================== RCS file: /cvsroot/ispman/CVSROOT/ciabot.pl,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- ciabot.pl 16 Jul 2003 21:32:54 -0000 1.1 +++ ciabot.pl 8 Jun 2005 19:07:03 -0000 1.2 @@ -1,87 +1,129 @@ -#!/usr/bin/perl +#!/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-FGKo4X94FMn2fBVCVOL8/[email protected]> # Copyright 1998 Board of Trustees, Leland Stanford Jr. University # -# Copyright 2001, 2003 Petr Baudis <[email protected]> +# Copyright 2001, 2003, 2004 Petr Baudis <[email protected]> # # 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 version has been modified a bit, and is available on CIA's web site: +# http://cia.navi.cx/clients/cvs/ciabot_cvs.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 +# ALL /usr/bin/perl $CVSROOT/CVSROOT/ciabot_cvs.pl %{,,,s} $USER project from_email dest_email ignore_regexp +# +# IMPORTANT: The %{,,,s} in loginfo is new, and is required for proper operation. +# +# Make sure that you add the script to 'checkoutlist' before +# committing it. You may need to change /usr/bin/perl to point to your +# system's perl binary. +# +# Note that the last four parameters are optional, you can alternatively +# change the defaults below in the configuration section. # use strict; -use vars qw ($project $from_email $dest_email $max_lines $sync_delay - $commit_template $branch_template $trimmed_template); - +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). +# +# NOTE: This shouldn't be a long description of your project. Ideally +# it is a short identifier with no spaces, punctuation, or +# unnecessary capitalization. This will be used in URLs related +# to your project, as an internal identifier, and in IRC messages. +# If you want a longer name shown for your project on the web +# interface, please use the "title" metadata key rather than +# putting that here. +# $project = 'ispman'; -# The from address in the generated mails. +# The from address in generated mails. $from_email = 'ispman-commits-TtF/[email protected]'; # Mail all reports to this address. -$dest_email = '[email protected]'; +$dest_email = '[email protected]'; -# The maximal number of lines the log message should have. -$max_lines = 6; +# 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. +# Increasing this could be a very good idea if you're on Sourceforge ;) $sync_delay = 5; -# The template string describing how the commit message should look like. -# Expansions: -# %user% - who committed it -# %tag% - expands to the branch tag template ($branch_template), if the -# commit hapenned in a branch -# %module% - the module where the commit happenned -# %path% - the longest common path of all the committed files -# %file% - the file name or number of files (and possibly number of dirs) -# %trimmed%- a notice about the log message being trimmed, if it is -# ($trimmed_template) -# %logmsg% - the log message -$commit_template = '{green}%user%{normal}%tag% * {light blue}%module%{normal}/%path% (%file%): %trimmed%%logmsg%'; +# 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; -# The template string describing how the branch tag name should look like. -# Expansions: -# %tag% - the tag name -$branch_template = ' {yellow}%tag%{normal}'; +# 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 = ""; -# The template string describing how the trimming notice should look like. -# Expansions: -# none -$trimmed_template = '(log message trimmed)'; +# 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); +use vars qw ($user $module $tag @files $logmsg $message); my @dir; # This array stores all the affected directories -my @ci; # This array is mapped to the @dir array and contains files affected - # in each directory -my $logmsg_lines; +my @dirfiles; # This array is mapped to the @dir array and contains files + # affected in each directory +# A nice nonprinting character we can use as a separator relatively safely. +# The commas in loginfo above give us 4 commas and a space between file +# names given to us on the command line. This is the separator used internally. +# Now we can handle filenames containing spaces, and probably anything except +# strings of 4 commas or the ASCII bell character. +# +# This was inspired by the suggestion in: +# http://mail.gnu.org/archive/html/info-cvs/2003-04/msg00267.html +# +$" = "\7"; ### Input data loading @@ -89,9 +131,12 @@ # These arguments are from %s; first the relative path in the repository # and then the list of files modified. -@files = split (' ', $ARGV[0]); +@files = split (' ,,,', ($ARGV[0] or '')); $dir[0] = shift @files or die "$0: no directory specified\n"; -$ci[0] = "@files" or die "$0: no files specified\n"; +$dirfiles[0] = "@files" or die "$0: no files specified\n"; + + +# Guess module name. $module = $dir[0]; $module =~ s#/.*##; @@ -101,6 +146,14 @@ $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>) { @@ -108,14 +161,25 @@ last if /^Log Message/; } -$logmsg_lines = 0; +$logmsg = ""; while (<STDIN>) { next unless ($_ and $_ ne "\n" and $_ ne "\r\n"); - $logmsg_lines++; - last if ($logmsg_lines > $max_lines); + 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 @@ -123,18 +187,19 @@ 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. +$sum = 0; map { $sum += ord $_ } split(//, $logmsg); my $syncfile; # Name of the file used for syncing $syncfile = "/tmp/cvscia.$project.$module.$sum"; -if (-f $syncfile) { +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 "$ci[0]!@!$dir[0]\n"; + print FF "$dirfiles[0]!@!$dir[0]\n"; close(FF); exit; @@ -146,17 +211,19 @@ # 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 $syncfile"); + # 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 ($i) = 1; + my ($dirnum) = 1; # 0 is the one we got triggerred for while (<FF>) { chomp; - ($ci[$i], $dir[$i]) = split(/!@!/); - $i++; + ($dirfiles[$dirnum], $dir[$dirnum]) = split(/!@!/); + $dirnum++; } close(FF); @@ -165,105 +232,119 @@ -### Send out the mail - - -# Open our mail program - -open (MAIL, '| /usr/lib/sendmail -t -oi -oem') - or die "$0: cannot fork sendmail: $!\n"; +### Compose the mail message -# The mail header +my ($VERSION) = '2.3'; +my ($URL) = 'http://cia.navi.cx/clients/cvs/ciabot_cvs.pl'; +my $ts = time; -print MAIL <<EOM; -From: $from_email -To: $dest_email -Content-type: text/plain -Subject: Announce $project +$message = <<EM +<message> + <generator> + <name>CIA Perl client for CVS</name> + <version>$VERSION</version> + <url>$URL</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 +; -EOM +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 +; -# Compute the longest common path, plus make up the file and directory count -my (@commondir, @filelist, $files, $file, $i); -for ($i = 0; $i < @dir; $i++) { - my ($dir) = $dir[$i]; - my (@cd) = split(/\//, $dir); - for (my $j = 0; $j < @cd; $j++) { - if (defined $commondir[$j] and $commondir[$j] ne $cd[$j]) { - splice(@commondir, $j); - last; - } - if ($i == 0) { - $commondir[$j] = $cd[$j]; - } elsif (not defined $commondir[$j]) { - last; - } - } +### Write the message to an alt-target - my (@cii) = split(/ /, $ci[$i]); - @cii = map { $dir . "/" . $_ } @cii; - push(@filelist, @cii); - $files += @cii; - $file = $ci[0] if ($files == 1); +if ($alt_local_message_target and open (ALT, ">>$alt_local_message_target")) { + print ALT $message; + close ALT; } -die "No files!" unless ($files > 0); -my ($module) = shift(@commondir); # Strip away the module name. +### Send out the XML-RPC message -# Send out the mail body +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 -my ($path) = join('/', @commondir); + require RPC::XML; + require RPC::XML::Client; -my ($filestr); # the file name or file count or whatever -if ($files > 1) { - $filestr = $files . ' files'; - if ($i > 1) { - map { s#^$module/($path/)?##g } @filelist; - $filestr .= ' in ' . $i . ' dirs: '; - $filestr .= join(', ', @filelist); + 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"; } -} else { - $filestr = $file; + exit; } -my ($trimmedstr); # the trimmed string, if any at all -if ($logmsg_lines > $max_lines) { - $trimmedstr = $trimmed_template; -} else { - $trimmedstr = ''; -} -my ($tagstr); # the branch name, if any at all -if ($tag) { - $tagstr = $branch_template; - $tagstr =~ s/\%tag\%/$tag/g; -} else { - $tagstr = ''; -} +### Send out the mail -$logmsg = "\n" . $logmsg if ($logmsg_lines > 1); -my ($bodystr) = $commit_template; # the message to be sent -$bodystr =~ s/\%user\%/$user/g; -$bodystr =~ s/\%tag\%/$tagstr/g; -$bodystr =~ s/\%module\%/$module/g; -$bodystr =~ s/\%path\%/$path/g; -$bodystr =~ s/\%file\%/$filestr/g; -$bodystr =~ s/\%trimmed\%/$trimmedstr/g; -$bodystr =~ s/\%logmsg\%/$logmsg/g; +# Open our mail program -print MAIL $bodystr."\n"; +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); +die "$0: sendmail exit status " . ($? >> 8) . "\n" unless ($? == 0); + +# vi: set sw=2: ------------------------------------------------------- This SF.Net email is sponsored by: NEC IT Guy Games. How far can you shotput a projector? How fast can you ride your desk chair down the office luge track? If you want to score the big prize, get to know the little guy. Play to win an NEC 61" plasma display: http://www.necitguy.com/?r=20