File:  [LON-CAPA] / CVSROOT / loginfo.pl
Revision 1.4: download - view: text, annotated - select for diffs
Thu Apr 8 20:20:01 2004 UTC (20 years ago) by albertel
Branches: MAIN
CVS tags: HEAD
- hide commits to foxr/londtest

    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";
   28: 
   29: # get the id of this process group for use in figuring out
   30: # whether this is the last directory with checkins or not
   31: my $id = getpgrp();
   32: 
   33: # the command line looks something like this for a normal commit:
   34: #  ("user@example.com", "cvsuser",
   35: #   "module changedfile,1.1,1.2 addedfile,NONE,1.1 removedfile,1.1,NONE")
   36: my $mailfrom = shift;
   37: my $mailto = $mailfrom;
   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;
  122:         if ($file =~ m|TexConvert/tt.dynamic|  ||
  123: 	    $file =~ m|foxr/londtest| ) {
  124: 		$diffmsg='Diffs for '.$file.' not shown.'."\n";
  125: 		next;
  126: 	}
  127: 	open(LOG, "$cvs -Qn rdiff -r $old -r $new -u $file|") || die;
  128: 	while(<LOG>) { s/\r\n/\n/; $diffmsg .= $_; }
  129: 	close(LOG);
  130: }
  131: 
  132: # add the added files
  133: 
  134: foreach my $file (@added_files) {
  135: 	next if $file =~ /\.(gif|jpe|jpe?g|pdf|png|exe|class|tgz|tar.gz|jar)$/i
  136: 		or $file !~ /\./;
  137: 	$diffmsg .= "\nIndex: $file\n+++ $file\n";
  138: 	open(LOG, "$cvs -Qn checkout -p -r1.1 $file |") || die;
  139: 	while(<LOG>) { s/\r\n/\n/; $diffmsg .= $_; }
  140: 	close(LOG);
  141: }
  142: 
  143: #print "Building commit email\n";
  144: 
  145: my $subj_tag = $tag ? "($tag)" : '';
  146: my $body_tag = $tag ? "(Branch: $tag)" : '';
  147: 
  148: # build our email
  149: my $msg = "";
  150: if($#added_files ne -1) {
  151: 	$msg .= "\n  Added files:                 $body_tag";
  152: 	$msg .= &build_list(@added_files);
  153: 	$body_tag = '';
  154: }
  155: if($#removed_files ne -1) {
  156: 	$msg .= "\n  Removed files:               $body_tag";
  157: 	$msg .= &build_list(@removed_files);
  158: 	$body_tag = '';
  159: }
  160: if($#modified_files ne -1) {
  161: 	$msg .= "\n  Modified files:              $body_tag";
  162: 	$msg .= &build_list(@modified_files);
  163: 	$body_tag = '';
  164: }
  165: 
  166: my $subj = "";
  167: my %dirfiles;
  168: my @dirs = &get_dirs(@added_files, @removed_files, @modified_files);
  169: 
  170: foreach my $dir (@dirs) {
  171:     $subj .= "$dir @{ $dirfiles{$dir} }  ";
  172: }
  173: 
  174: my $msgid = "Message-ID: <cvs$cvsuser".time()."\@cvsserver>\n";
  175: 
  176: my $from;
  177: if (open FD, $cvsusers) {
  178: 	while(<FD>) {
  179: 		chop;
  180: 		if (m/^$cvsuser:(.+?):(.+)$/) {
  181: 			$from = "\"$1\" <$2>";
  182: 		}
  183: 	}
  184: 	close(FD);
  185: }
  186: 
  187: $from ||= "$cvsuser <$mailfrom>";
  188: 
  189: # "Reply-to: $mailto\n".
  190: # "Date: ".localtime()."\n".
  191: my (@DAYABBR) = qw(Sun Mon Tue Wed Thu Fri Sat);
  192: my (@MONABBR) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  193: 
  194: my (@gmtime) = gmtime();
  195: my $rfc822date = sprintf("Date: %s, %02d %s %d %02d:%02d:%02d -0000\n",
  196:         $DAYABBR[$gmtime[6]], $gmtime[3], $MONABBR[$gmtime[4]],
  197:         $gmtime[5] + 1900, $gmtime[2], $gmtime[1], $gmtime[0]);
  198: 
  199: no strict; # quiet warnings after here
  200: 
  201: my $email;
  202: my $common_header = "".
  203: 	"From: $from\n".
  204: 	"To: $mailto\n".
  205: 	$msgid.
  206: 	$rfc822date.
  207: 	"Subject: cvs: $module$subj_tag $subj\n";
  208: 
  209: my $common_body = "".
  210: 	"$cvsuser\t\t".localtime()." EDT\n".
  211: 	"$msg".
  212: 	"  Log:\n".
  213: 	&indent($logmsg,2)."\n";
  214: 
  215: my $boundary = $cvsuser.time();
  216: 
  217: if (length($diffmsg) > 8000) {
  218: 	my $now = POSIX::strftime("%Y%m%d%H%M%S", localtime);
  219: 	$email = $common_header.
  220: 		"MIME-Version: 1.0\n".
  221: 		"Content-Type: multipart/mixed; boundary=\"$boundary\"\n".
  222: 		"\n".
  223: 		"This is a MIME encoded message\n\n".
  224: 		"--$boundary\n".
  225: 		"Content-Type: text/plain\n".
  226: 		"\n".
  227: 		$common_body.
  228: 		"--$boundary\n".
  229: 		"Content-Type: text/plain\n".
  230: 		"Content-Disposition: attachment; filename=\"$cvsuser-$now.txt\"\n".
  231: 		"\n".
  232: 		"$diffmsg\n".
  233: 		"--$boundary--\n";
  234: } else {
  235: 	$email = $common_header.
  236: 		"\n".
  237: 		$common_body.
  238: 		"$diffmsg\n";
  239: }
  240: 
  241: $email =~ s/\r//g;
  242: $email =~ s/\n/\r\n/g;
  243: 
  244: # send our email
  245: 
  246: print "Mailing the commit email to $mailto\n";
  247: 
  248: #print $email;
  249: 
  250: my $paddr = sockaddr_in($smtpport, inet_aton($smtpserver));
  251: socket(SOCK, PF_INET, SOCK_STREAM, 0) || die "socket failed";
  252: connect(SOCK, $paddr) || die "connect $smtpserver:$smtpport failed";
  253: select(SOCK);
  254: $|=1;
  255: 
  256: print "HELO cvsserver\r\n".
  257: "MAIL FROM:<this-will-bounce\@php.net>\r\n" . 
  258: "RCPT TO:<$envaddr>\r\n" .
  259: "DATA\r\n".
  260: "$email\r\n".
  261: ".\r\n".
  262: "QUIT\r\n";
  263: 
  264: while(<SOCK>) { alarm(20); };
  265: 
  266: close(SOCK);
  267: exit 0;
  268: 
  269: sub get_log_message {
  270:   my ($logmsg, $tag);
  271:   while (<STDIN>) {
  272:     $logmsg .= $_ if defined $logmsg;
  273:     if (/^Log Message/) { $logmsg = ""; }
  274:     if (/^\s+Tag:\s+(\w+)/) { $tag = $1; }
  275:   }
  276:   return ($logmsg, $tag);
  277: }
  278: 
  279: sub build_list {
  280:   my(@arr) = @_;
  281:   my($curdir, $curlen, $msg);
  282: 
  283:   $msg = "";
  284:   $curdir = "";
  285:   foreach (@arr) {
  286:     /^(.*)\/([^\/]+)$/;
  287:     my $dir = $1;
  288:     my $file = $2;
  289:     if($dir ne $curdir) {
  290:       $curdir = $dir;
  291:       $msg .= "\n    /$curdir\t";
  292:       $curlen = length($curdir) + 5;
  293:     }
  294:     if(($curlen + length($file)) > 70) {
  295:       $msg .= "\n     ".sprintf("%-".length($curdir)."s", "")."\t";
  296:       $curlen = length($curdir) + 5;
  297:     }
  298:     $msg .= $file." ";
  299:     $curlen += length($file) + 1;
  300:   }
  301: 
  302:   $msg .= "\n";
  303: 
  304:   return $msg;
  305: }
  306: 
  307: sub get_dirs {
  308:   my @files = sort @_;
  309:   foreach my $file (@files) {
  310:     (my $dir = $file) =~ s#[^/]+$##;
  311:     $dir =~ s/^$module//;
  312:     $dir =~ s/(.+)\//$1/;
  313:     $file =~ s#^.+/(.+)$#$1#;
  314:     push @{ $dirfiles{$dir} }, $file;
  315:   } 
  316:   return sort keys %dirfiles;
  317: } 
  318: 
  319: sub indent {
  320:   my ($msg,$nr) = @_;
  321:   my $s = " " x $nr;
  322:   $msg =~ s/\n/\n$s/g;
  323:   return $s.$msg;
  324: }
  325: 
  326: sub trim {
  327:   my ($x) = @_;
  328:   $x =~ s/^\s+//;
  329:   $x =~ s/\s+$//;
  330:   return $x;
  331: }
  332: 
  333: # eat STDIN (to avoid parent getting SIGPIPE) and exit with supplied exit code
  334: sub bail {
  335:   my @toss = <STDIN>;
  336:   exit @_;
  337: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>