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>