Annotation of CVSROOT/loginfo.pl, revision 1.10
1.1 albertel 1: #!/usr/bin/perl -w
2: # include this script in your loginfo as:
3: # <modulename> /path/to/loginfo.pl sender@domain recipient@domain %{sVv}
4: #
5: # Copyright (c) 1999, 2000 Sascha Schumann <sascha@schumann.cx>
6:
7: # This makes some basic assumptions -- you are only checking
8: # in to a single CVS module.
9:
10: # This also doesn't like files or directories with spaces in them.
11:
12: use strict;
13:
14: use Socket;
15: use POSIX;
16:
17: $SIG{PIPE} = 'IGNORE';
18:
19: my $last_file = "/var/cvs/lastdir";
20: my $summary = "/var/cvs/summary";
21: my $smtpserver = "127.0.0.1";
22: my $smtpport = 25;
23: my $cvs = "/usr/bin/cvs";
24: my $cvsroot = $ENV{CVSROOT}."/";
25: # remove double trailing slash
26: $cvsroot =~ s/\/\/$/\//;
27: my $cvsusers = "/repository/CVSROOT/cvsusers";
1.9 raeburn 28: my $cvshost = "source.lon-capa.org";
1.1 albertel 29:
30: # get the id of this process group for use in figuring out
31: # whether this is the last directory with checkins or not
32: my $id = getpgrp();
33:
34: # the command line looks something like this for a normal commit:
35: # ("user@example.com", "cvsuser",
36: # "module changedfile,1.1,1.2 addedfile,NONE,1.1 removedfile,1.1,NONE")
1.9 raeburn 37: my $mailto = shift;
1.1 albertel 38: my $envaddr = $mailto;
39:
40: my $cvsuser = shift;
41: my @args = split(" ", $ARGV[0]);
42: my $directory = shift @args;
43:
44: # extract just the module name from the directory
45: my $module = $directory;
46: $module =~ s/\/.+$//;
47:
48: if ($cvsuser eq "changelog" && $module ne "php-gtk") {
49: $envaddr = "php-cvs-daily-private\@lists.php.net";
50: $mailto = "php-cvs-daily\@lists.php.net";
51: }
52:
53: # bail when this is a new directory
54: &bail if $args[0] eq '-' && "$args[1] $args[2]" eq 'New directory';
55:
56: # bail if this is an import
57: &bail if $args[0] eq '-' && $args[1] eq 'Imported';
58:
59: # find out the last directory being processed
60: open FC, "$last_file.$id"
61: or die "last file does not exist";
62: my $last_directory = <FC>;
63: chop $last_directory;
64: close FC;
65: # remove the cvsroot from the front
66: $last_directory =~ s/^$cvsroot//;
67:
68: # add our changed files to the summary
69: open(FC, ">>$summary.$id") || die "cannot open summary file";
70: foreach my $arg (@args) {
71: print FC "$directory/$arg\n";
72: }
73: close(FC);
74:
75: # is this script already in the last changed directory?
76:
77: # exit if this isn't the last directory
78: &bail if($last_directory ne $directory);
79:
80: # get the log message and tag -- we throw away everything from STDIN
81: # before a line that begins with "Log Message"
82: my ($logmsg,$tag) = &get_log_message();
83:
84: # now we fork off into the background and generate the email
85: exit 0 if(fork() != 0);
86:
87: $| = 1;
88:
89: #print "Reading summary file\n";
90:
91: open(FC, "<$summary.$id");
92:
93: my (@added_files, @removed_files, @modified_files, @modified_files_info);
94: while (<FC>) {
95: chop;
96: my ($file, $old, $new) = split(",");
97: if($old eq "NONE") {
98: push @added_files, $file;
99: } elsif($new eq "NONE") {
100: push @removed_files, $file;
101: } else {
102: push @modified_files, $file;
103: push @modified_files_info, [ $file, $old, $new ];
104: }
105: }
106: close FC;
107:
108: #print "Unlinking helper files\n";
109:
110: # clean up a little bit
111:
112: unlink("$summary.$id");
113: unlink("$last_file.$id");
114:
115: #print "Running rdiff\n";
116:
117: # build a diff (and new files) if necessary
118: my $diffmsg = '';
119:
120: foreach my $info (@modified_files_info) {
121: my ($file, $old, $new) = @$info;
1.4 albertel 122: if ($file =~ m|TexConvert/tt.dynamic| ||
1.5 albertel 123: $file =~ m|foxr/londtest| ||
1.6 raeburn 124: $file =~ m|purdue| ||
1.7 raeburn 125: $file =~ m|vcu/| ||
1.8 raeburn 126: $file =~ m|modules/[^/]+/private/| ) {
1.4 albertel 127: $diffmsg='Diffs for '.$file.' not shown.'."\n";
128: next;
129: }
1.1 albertel 130: open(LOG, "$cvs -Qn rdiff -r $old -r $new -u $file|") || die;
131: while(<LOG>) { s/\r\n/\n/; $diffmsg .= $_; }
132: close(LOG);
133: }
134:
135: # add the added files
136:
137: foreach my $file (@added_files) {
138: next if $file =~ /\.(gif|jpe|jpe?g|pdf|png|exe|class|tgz|tar.gz|jar)$/i
139: or $file !~ /\./;
1.8 raeburn 140: if ($file =~ m|TexConvert/tt.dynamic| ||
141: $file =~ m|foxr/londtest| ||
142: $file =~ m|purdue| ||
143: $file =~ m|vcu/| ||
144: $file =~ m|modules/[^/]+/private/| ) {
145: $diffmsg='Contents of added file: '.$file.' not shown.'."\n";
146: next;
147: }
1.1 albertel 148: $diffmsg .= "\nIndex: $file\n+++ $file\n";
149: open(LOG, "$cvs -Qn checkout -p -r1.1 $file |") || die;
150: while(<LOG>) { s/\r\n/\n/; $diffmsg .= $_; }
151: close(LOG);
152: }
153:
154: #print "Building commit email\n";
155:
156: my $subj_tag = $tag ? "($tag)" : '';
157: my $body_tag = $tag ? "(Branch: $tag)" : '';
158:
159: # build our email
160: my $msg = "";
161: if($#added_files ne -1) {
162: $msg .= "\n Added files: $body_tag";
163: $msg .= &build_list(@added_files);
164: $body_tag = '';
165: }
166: if($#removed_files ne -1) {
167: $msg .= "\n Removed files: $body_tag";
168: $msg .= &build_list(@removed_files);
169: $body_tag = '';
170: }
171: if($#modified_files ne -1) {
172: $msg .= "\n Modified files: $body_tag";
173: $msg .= &build_list(@modified_files);
174: $body_tag = '';
175: }
176:
177: my $subj = "";
178: my %dirfiles;
179: my @dirs = &get_dirs(@added_files, @removed_files, @modified_files);
180:
181: foreach my $dir (@dirs) {
182: $subj .= "$dir @{ $dirfiles{$dir} } ";
183: }
184:
185: my $msgid = "Message-ID: <cvs$cvsuser".time()."\@cvsserver>\n";
186:
187: my $from;
188: if (open FD, $cvsusers) {
189: while(<FD>) {
190: chop;
191: if (m/^$cvsuser:(.+?):(.+)$/) {
192: $from = "\"$1\" <$2>";
193: }
194: }
195: close(FD);
196: }
197:
1.9 raeburn 198: $from ||= "$cvsuser <$cvsuser\@$cvshost>";
1.1 albertel 199:
200: # "Reply-to: $mailto\n".
201: # "Date: ".localtime()."\n".
202: my (@DAYABBR) = qw(Sun Mon Tue Wed Thu Fri Sat);
203: my (@MONABBR) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
204:
205: my (@gmtime) = gmtime();
206: my $rfc822date = sprintf("Date: %s, %02d %s %d %02d:%02d:%02d -0000\n",
207: $DAYABBR[$gmtime[6]], $gmtime[3], $MONABBR[$gmtime[4]],
208: $gmtime[5] + 1900, $gmtime[2], $gmtime[1], $gmtime[0]);
209:
210: no strict; # quiet warnings after here
211:
212: my $email;
213: my $common_header = "".
214: "From: $from\n".
215: "To: $mailto\n".
216: $msgid.
217: $rfc822date.
218: "Subject: cvs: $module$subj_tag $subj\n";
219:
220: my $common_body = "".
221: "$cvsuser\t\t".localtime()." EDT\n".
222: "$msg".
223: " Log:\n".
224: &indent($logmsg,2)."\n";
225:
226: my $boundary = $cvsuser.time();
227:
228: if (length($diffmsg) > 8000) {
229: my $now = POSIX::strftime("%Y%m%d%H%M%S", localtime);
230: $email = $common_header.
231: "MIME-Version: 1.0\n".
232: "Content-Type: multipart/mixed; boundary=\"$boundary\"\n".
233: "\n".
234: "This is a MIME encoded message\n\n".
235: "--$boundary\n".
1.10 ! raeburn 236: 'Content-Type: text/plain; charset="us-ascii"'."\n".
1.1 albertel 237: "\n".
238: $common_body.
239: "--$boundary\n".
1.10 ! raeburn 240: 'Content-Type: text/plain; charset="us-ascii"'."\n".
1.1 albertel 241: "Content-Disposition: attachment; filename=\"$cvsuser-$now.txt\"\n".
242: "\n".
243: "$diffmsg\n".
244: "--$boundary--\n";
245: } else {
246: $email = $common_header.
1.10 ! raeburn 247: 'Content-Type: text/plain; charset="us-ascii"'."\n".
1.1 albertel 248: "\n".
249: $common_body.
250: "$diffmsg\n";
251: }
252:
253: $email =~ s/\r//g;
254: $email =~ s/\n/\r\n/g;
255:
256: # send our email
257:
258: print "Mailing the commit email to $mailto\n";
259:
260: #print $email;
261:
262: my $paddr = sockaddr_in($smtpport, inet_aton($smtpserver));
263: socket(SOCK, PF_INET, SOCK_STREAM, 0) || die "socket failed";
264: connect(SOCK, $paddr) || die "connect $smtpserver:$smtpport failed";
265: select(SOCK);
266: $|=1;
267:
268: print "HELO cvsserver\r\n".
269: "MAIL FROM:<this-will-bounce\@php.net>\r\n" .
270: "RCPT TO:<$envaddr>\r\n" .
271: "DATA\r\n".
272: "$email\r\n".
273: ".\r\n".
274: "QUIT\r\n";
275:
276: while(<SOCK>) { alarm(20); };
277:
278: close(SOCK);
279: exit 0;
280:
281: sub get_log_message {
282: my ($logmsg, $tag);
283: while (<STDIN>) {
284: $logmsg .= $_ if defined $logmsg;
285: if (/^Log Message/) { $logmsg = ""; }
286: if (/^\s+Tag:\s+(\w+)/) { $tag = $1; }
287: }
288: return ($logmsg, $tag);
289: }
290:
291: sub build_list {
292: my(@arr) = @_;
293: my($curdir, $curlen, $msg);
294:
295: $msg = "";
296: $curdir = "";
297: foreach (@arr) {
298: /^(.*)\/([^\/]+)$/;
299: my $dir = $1;
300: my $file = $2;
301: if($dir ne $curdir) {
302: $curdir = $dir;
303: $msg .= "\n /$curdir\t";
304: $curlen = length($curdir) + 5;
305: }
306: if(($curlen + length($file)) > 70) {
307: $msg .= "\n ".sprintf("%-".length($curdir)."s", "")."\t";
308: $curlen = length($curdir) + 5;
309: }
310: $msg .= $file." ";
311: $curlen += length($file) + 1;
312: }
313:
314: $msg .= "\n";
315:
316: return $msg;
317: }
318:
319: sub get_dirs {
320: my @files = sort @_;
321: foreach my $file (@files) {
322: (my $dir = $file) =~ s#[^/]+$##;
323: $dir =~ s/^$module//;
324: $dir =~ s/(.+)\//$1/;
325: $file =~ s#^.+/(.+)$#$1#;
326: push @{ $dirfiles{$dir} }, $file;
327: }
328: return sort keys %dirfiles;
329: }
330:
331: sub indent {
332: my ($msg,$nr) = @_;
333: my $s = " " x $nr;
334: $msg =~ s/\n/\n$s/g;
335: return $s.$msg;
336: }
337:
338: sub trim {
339: my ($x) = @_;
340: $x =~ s/^\s+//;
341: $x =~ s/\s+$//;
342: return $x;
343: }
344:
345: # eat STDIN (to avoid parent getting SIGPIPE) and exit with supplied exit code
346: sub bail {
347: my @toss = <STDIN>;
348: exit @_;
349: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loginfo.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / CVSROOT