change initscript to use more than one port / device,
[openwrt.git] / CVSROOT / ciabot.pl
1 #!/usr/bin/perl -w
2 #
3 # ciabot -- Mail a CVS log message to a given address, for the purposes of CIA
4 #
5 # Loosely based on cvslog by Russ Allbery <rra@stanford.edu>
6 # Copyright 1998 Board of Trustees, Leland Stanford Jr. University
7 #
8 # Copyright 2001, 2003, 2004 Petr Baudis <pasky@ucw.cz>
9 #
10 # This program is free software; you can redistribute it and/or modify it under
11 # the terms of the GNU General Public License version 2, as published by the
12 # Free Software Foundation.
13 #
14 # The master location of this file is
15 # http://pasky.or.cz/~pasky/dev/cvs/ciabot.pl.
16 #
17 # This program is designed to run from the loginfo CVS administration file. It
18 # takes a log message, massaging it and mailing it to the address given below.
19 #
20 # Its record in the loginfo file should look like:
21 #
22 # ALL $CVSROOT/CVSROOT/ciabot.pl %s $USER project from_email dest_email ignore_regexp
23 #
24 # Note that the last four parameters are optional, you can alternatively change
25 # the defaults below in the configuration section.
26 #
27 # If it does not work, try to disable $xml_rpc in the configuration section
28 # below.
29 #
30 # ciabot.pl,v 1.110 2004/01/09 17:40:13 pasky
31 # $Id$
32
33 use strict;
34 use vars qw ($project $from_email $dest_email $rpc_uri $sendmail $sync_delay
35 $xml_rpc $ignore_regexp $alt_local_message_target);
36
37
38
39
40 ### Configuration
41
42 # Project name (as known to CIA).
43 $project = 'ELinks';
44
45 # The from address in generated mails.
46 $from_email = 'pasky@ucw.cz';
47
48 # Mail all reports to this address.
49 $dest_email = 'cia@navi.cx';
50
51 # If using XML-RPC, connect to this URI.
52 $rpc_uri = 'http://cia.navi.cx/RPC2';
53
54 # Path to your USCD sendmail compatible binary (your mailer daemon created this
55 # program somewhere).
56 $sendmail = '/usr/sbin/sendmail';
57
58 # Number of seconds to wait for possible concurrent instances. CVS calls up
59 # this script for each involved directory separately and this is the sync
60 # delay. 5s looks as a safe value, but feel free to increase if you are running
61 # this on a slower (or overloaded) machine or if you have really a lot of
62 # directories.
63 $sync_delay = 5;
64
65 # This script can communicate with CIA either by mail or by an XML-RPC
66 # interface. The XML-RPC interface is faster and more efficient, however you
67 # need to have RPC::XML perl module installed, and some large CVS hosting sites
68 # (like Savannah or Sourceforge) might not allow outgoing HTTP connections
69 # while they allow outgoing mail. Also, this script will hang and eventually
70 # not deliver the event at all if CIA server happens to be down, which is
71 # unfortunately not an uncommon condition.
72 $xml_rpc = 0;
73
74 # You can make this bot to totally ignore events concerning the objects
75 # specified below. Each object is composed of <module>/<path>/<filename>,
76 # therefore file Manifest in root directory of module gentoo will be called
77 # "gentoo/Manifest", while file src/bfu/inphist.c of module elinks will be
78 # called "elinks/src/bfu/inphist.c". Easy, isn't it?
79 #
80 # This variable should contain regexp, against which will each object be
81 # checked, and if the regexp is matched, the file is ignored. Therefore ie. to
82 # ignore all changes in the two files above and everything concerning module
83 # 'admin', use:
84 #
85 #$ignore_regexp = "^(gentoo/Manifest|elinks/src/bfu/inphist.c|admin/)";
86 $ignore_regexp = "/Manifest\$";
87
88 # It can be useful to also grab the generated XML message by some other
89 # programs and ie. autogenerate some content based on it. Here you can specify
90 # a file to which it will be appended.
91 $alt_local_message_target = "";
92
93
94
95
96 ### The code itself
97
98 use vars qw ($user $module $tag @files $logmsg $message);
99
100 my @dir; # This array stores all the affected directories
101 my @dirfiles; # This array is mapped to the @dir array and contains files
102 # affected in each directory
103
104
105
106 ### Input data loading
107
108
109 # These arguments are from %s; first the relative path in the repository
110 # and then the list of files modified.
111
112 @files = split (' ', ($ARGV[0] or ''));
113 $dir[0] = shift @files or die "$0: no directory specified\n";
114 $dirfiles[0] = "@files" or die "$0: no files specified\n";
115
116
117 # Guess module name.
118
119 $module = $dir[0]; $module =~ s#/.*##;
120
121
122 # Figure out who is doing the update.
123
124 $user = $ARGV[1];
125
126
127 # Use the optional parameters, if supplied.
128
129 $project = $ARGV[2] if $ARGV[2];
130 $from_email = $ARGV[3] if $ARGV[3];
131 $dest_email = $ARGV[4] if $ARGV[4];
132 $ignore_regexp = $ARGV[5] if $ARGV[5];
133
134
135 # Parse stdin (what's interesting is the tag and log message)
136
137 while (<STDIN>) {
138 $tag = $1 if /^\s*Tag: ([a-zA-Z0-9_-]+)/;
139 last if /^Log Message/;
140 }
141
142 while (<STDIN>) {
143 next unless ($_ and $_ ne "\n" and $_ ne "\r\n");
144 s/&/&amp;/g;
145 s/</&lt;/g;
146 s/>/&gt;/g;
147 $logmsg .= $_;
148 }
149
150
151
152 ### Remove to-be-ignored files
153
154 $dirfiles[0] = join (' ',
155 grep {
156 my $f = "$module/$dir[0]/$_";
157 $f !~ m/$ignore_regexp/;
158 } split (/\s+/, $dirfiles[0])
159 ) if ($ignore_regexp);
160 exit unless $dirfiles[0];
161
162
163
164 ### Sync between the multiple instances potentially being ran simultanously
165
166 my $sum; # _VERY_ simple hash of the log message. It is really weak, but I'm
167 # lazy and it's really sorta exceptional to even get more commits
168 # running simultanously anyway.
169 map { $sum += ord $_ } split(//, $logmsg);
170
171 my $syncfile; # Name of the file used for syncing
172 $syncfile = "/tmp/cvscia.$project.$module.$sum";
173
174
175 if (-f $syncfile and -w $syncfile) {
176 # The synchronization file for this file already exists, so we are not the
177 # first ones. So let's just dump what we know and exit.
178
179 open(FF, ">>$syncfile") or die "aieee... can't log, can't log! $syncfile blocked!";
180 print FF "$dirfiles[0]!@!$dir[0]\n";
181 close(FF);
182 exit;
183
184 } else {
185 # We are the first one! Thus, we'll fork, exit the original instance, and
186 # wait a bit with the new one. Then we'll grab what the others collected and
187 # go on.
188
189 # We don't need to care about permissions since all the instances of the one
190 # commit will obviously live as the same user.
191
192 # system("touch") in a different way
193 open(FF, ">>$syncfile") or die "aieee... can't log, can't log! $syncfile blocked!";
194 close(FF);
195
196 exit if (fork);
197 sleep($sync_delay);
198
199 open(FF, $syncfile);
200 my ($dirnum) = 1; # 0 is the one we got triggerred for
201 while (<FF>) {
202 chomp;
203 ($dirfiles[$dirnum], $dir[$dirnum]) = split(/!@!/);
204 $dirnum++;
205 }
206 close(FF);
207
208 unlink($syncfile);
209 }
210
211
212
213 ### Compose the mail message
214
215
216 my ($VERSION) = '$Revision$' =~ / (\d+\.\d+) /;
217 my $ts = time;
218
219 $message = <<EM
220 <message>
221 <generator>
222 <name>CIA Perl client for CVS</name>
223 <version>$VERSION</version>
224 <url>http://pasky.or.cz/~pasky/dev/cvs/ciabot.pl</url>
225 </generator>
226 <source>
227 <project>$project</project>
228 <module>$module</module>
229 EM
230 ;
231 $message .= " <branch>$tag</branch>" if ($tag);
232 $message .= <<EM
233 </source>
234 <timestamp>
235 $ts
236 </timestamp>
237 <body>
238 <commit>
239 <author>$user</author>
240 <files>
241 EM
242 ;
243
244 for (my $dirnum = 0; $dirnum < @dir; $dirnum++) {
245 map {
246 $_ = $dir[$dirnum] . '/' . $_;
247 s#^.*?/##; # weed out the module name
248 s/&/&amp;/g;
249 s/</&lt;/g;
250 s/>/&gt;/g;
251 $message .= " <file>$_</file>\n";
252 } split(/ /, $dirfiles[$dirnum]);
253 }
254
255 $message .= <<EM
256 </files>
257 <log>
258 $logmsg
259 </log>
260 </commit>
261 </body>
262 </message>
263 EM
264 ;
265
266
267
268 ### Write the message to an alt-target
269
270 if ($alt_local_message_target and open (ALT, ">>$alt_local_message_target")) {
271 print ALT $message;
272 close ALT;
273 }
274
275
276
277 ### Send out the XML-RPC message
278
279
280 if ($xml_rpc) {
281 # We gotta be careful from now on. We silence all the warnings because
282 # RPC::XML code is crappy and works with undefs etc.
283 $^W = 0;
284 $RPC::XML::ERROR if (0); # silence perl's compile-time warning
285
286 require RPC::XML;
287 require RPC::XML::Client;
288
289 my $rpc_client = new RPC::XML::Client $rpc_uri;
290 my $rpc_request = RPC::XML::request->new('hub.deliver', $message);
291 my $rpc_response = $rpc_client->send_request($rpc_request);
292
293 unless (ref $rpc_response) {
294 die "XML-RPC Error: $RPC::XML::ERROR\n";
295 }
296 exit;
297 }
298
299
300
301 ### Send out the mail
302
303
304 # Open our mail program
305
306 open (MAIL, "| $sendmail -t -oi -oem") or die "Cannot execute $sendmail : " . ($?>>8);
307
308
309 # The mail header
310
311 print MAIL <<EOM;
312 From: $from_email
313 To: $dest_email
314 Content-type: text/xml
315 Subject: DeliverXML
316
317 EOM
318
319 print MAIL $message;
320
321
322 # Close the mail
323
324 close MAIL;
325 die "$0: sendmail exit status " . ($? >> 8) . "\n" unless ($? == 0);
326
327 # vi: set sw=2:
This page took 0.067461 seconds and 5 git commands to generate.