4 # Copyright (C) 1994-2005 The Free Software Foundation, Inc.
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2, or (at your option)
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 ###############################################################################
17 ###############################################################################
18 ###############################################################################
20 # THIS SCRIPT IS PROBABLY BROKEN. REMOVING THE -T SWITCH ON THE #! LINE ABOVE
21 # WOULD FIX IT, BUT THIS IS INSECURE. WE RECOMMEND FIXING THE ERRORS WHICH THE
22 # -T SWITCH WILL CAUSE PERL TO REPORT BEFORE RUNNING THIS SCRIPT FROM A CVS
23 # SERVER TRIGGER. PLEASE SEND PATCHES CONTAINING THE CHANGES YOU FIND
24 # NECESSARY TO RUN THIS SCRIPT WITH THE TAINT-CHECKING ENABLED BACK TO THE
25 # <@PACKAGE_BUGREPORT@> MAILING LIST.
27 # For more on general Perl security and taint-checking, please try running the
28 # `perldoc perlsec' command.
30 ###############################################################################
31 ###############################################################################
32 ###############################################################################
34 # Perl filter to handle the log messages from the checkin of files in
35 # a directory. This script will group the lists of files by log
36 # message, and mail a single consolidated log message at the end of
39 # This file assumes a pre-commit checking program that leaves the
40 # names of the first and last commit directories in a temporary file.
42 # IMPORTANT: what the above means is, this script interacts with
43 # commit_prep, in that they have to agree on the tmpfile name to use.
44 # See $LAST_FILE below.
46 # How this works: CVS triggers this script once for each directory
47 # involved in the commit -- in other words, a single commit can invoke
48 # this script N times. It knows when it's on the last invocation by
49 # examining the contents of $LAST_FILE. Between invocations, it
50 # caches information for its future incarnations in various temporary
51 # files in /tmp, which are named according to the process group and
52 # the committer (by themselves, neither of these are unique, but
53 # together they almost always are, unless the same user is doing two
54 # commits simultaneously). The final invocation is the one that
55 # actually sends the mail -- it gathers up the cached information,
56 # combines that with what it found out on this pass, and sends a
57 # commit message to the appropriate mailing list.
59 # (Ask Karl Fogel <kfogel@collab.net> if questions.)
61 # Contributed by David Hampton <hampton@cisco.com>
62 # Roy Fielding removed useless code and added log/mail of new files
63 # Ken Coar added special processing (i.e., no diffs) for binary files
66 ############################################################
68 # Configurable options
70 ############################################################
72 # The newest versions of CVS have UseNewInfoFmtStrings=yes
73 # to change the arguments being passed on the command line.
74 # If you are using %1s on the command line, then set this
76 # 0 = old-style %1s format. use split(' ') to separate ARGV into filesnames.
77 # 1 = new-style %s format. Note: allows spaces in filenames.
78 my $UseNewInfoFmtStrings = 0;
81 # Where do you want the RCS ID and delta info?
84 # 2 = in both mail and logs.
88 #if you are using CVS web then set this to some value... if not set it to ""
90 # When set properly, this will cause links to aspects of the project to
91 # print in the commit emails.
92 #$CVSWEB_SCHEME = "http";
93 #$CVSWEB_DOMAIN = "nongnu.org";
95 #$CVSWEB_URI = "source/browse/";
100 # Set this to a domain to have CVS pretend that all users who make
101 # commits have mail accounts within that domain.
102 #$EMULATE_LOCAL_MAIL_USER="nongnu.org";
104 # Set this to '-c' for context diffs; defaults to '-u' for unidiff format.
107 ############################################################
111 ############################################################
118 $TMPDIR = $ENV{'TMPDIR'} || '/tmp';
119 $FILE_PREFIX = '#cvs.';
121 $LAST_FILE = "$TMPDIR/${FILE_PREFIX}lastdir"; # Created by commit_prep!
122 $ADDED_FILE = "$TMPDIR/${FILE_PREFIX}files.added";
123 $REMOVED_FILE = "$TMPDIR/${FILE_PREFIX}files.removed";
124 $LOG_FILE = "$TMPDIR/${FILE_PREFIX}files.log";
125 $BRANCH_FILE = "$TMPDIR/${FILE_PREFIX}files.branch";
126 $MLIST_FILE = "$TMPDIR/${FILE_PREFIX}files.mlist";
127 $SUMMARY_FILE = "$TMPDIR/${FILE_PREFIX}files.summary";
129 $CVSROOT = $ENV{'CVSROOT'};
131 $MAIL_CMD = "| /usr/lib/sendmail -i -t";
132 #$MAIL_CMD = "| /var/qmail/bin/qmail-inject";
133 $MAIL_FROM = 'commitlogger'; #not needed if EMULATE_LOCAL_MAIL_USER
134 $SUBJECT_PRE = 'CVS update:';
137 ############################################################
141 ############################################################
144 local($dir, @files) = @_;
147 $lines[0] = sprintf(" %-08s", $dir);
148 foreach $file (@files) {
149 if (length($lines[$#lines]) + length($file) > 60) {
150 $lines[++$#lines] = sprintf(" %8s", " ");
152 $lines[$#lines] .= " ".$file;
157 sub cleanup_tmpfiles {
160 opendir(DIR, $TMPDIR);
161 push(@files, grep(/^${FILE_PREFIX}.*\.${id}\.${cvs_user}$/, readdir(DIR)));
169 local($filename, @lines) = @_;
171 open(FILE, ">$filename") || die ("Cannot open log file $filename: $!\n");
172 print(FILE join("\n", @lines), "\n");
177 local($filename, $dir, @files) = @_;
180 local(@lines) = &format_names($dir, @files);
181 open(FILE, ">>$filename") || die ("Cannot open file $filename: $!\n");
182 print(FILE join("\n", @lines), "\n");
188 local($filename, $line) = @_;
190 open(FILE, ">$filename") || die("Cannot open file $filename: $!\n");
191 print(FILE $line, "\n");
196 local($filename, $line) = @_;
198 open(FILE, ">>$filename") || die("Cannot open file $filename: $!\n");
199 print(FILE $line, "\n");
204 local($filename) = @_;
207 open(FILE, "<$filename") || die("Cannot open file $filename: $!\n");
214 sub read_line_nodie {
215 local($filename) = @_;
217 open(FILE, "<$filename") || return ("");
225 sub read_file_lines {
226 local($filename) = @_;
229 open(FILE, "<$filename") || return ();
239 local($filename, $leader) = @_;
242 open(FILE, "<$filename") || return ();
245 push(@text, sprintf(" %-10s %s", $leader, $_));
253 local($filename, $leader) = @_;
256 open(FILE, "<$filename") || die ("Cannot open log file $filename: $!\n");
259 push(@text, $leader.$_);
266 # do an 'cvs -Qn status' on each file in the arguments, and extract info.
269 local($out, @filenames) = @_;
271 local($file, $rev, $rcsfile, $line, $vhost, $cvsweb_base);
274 $file = shift @filenames;
280 open(RCS, "-|") || exec "$cvsbin/cvs", '-Qn', 'status', '--', $file;
288 if (/^[ \t]*Repository revision/) {
290 @revline = split(' ', $_);
292 $rcsfile = $revline[3];
293 $rcsfile =~ s,^$CVSROOT/,,;
300 if ($rev ne '' && $rcsfile ne '') {
301 open(RCS, "-|") || exec "$cvsbin/cvs", '-Qn', 'log', "-r$rev",
304 if (/^date:.*lines:([^;]+);.*/) {
314 if ($CVSWEB_PORT eq "80") {
315 $cvsweb_base = "$CVSWEB_SCHEME://$vhost.$CVSWEB_DOMAIN/$CVSWEB_URI";
318 $cvsweb_base = "$CVSWEB_SCHEME://$vhost.$CVSWEB_DOMAIN:$CVSWEB_PORT/$CVSWEB_URI";
320 if ($SEND_URL eq "true") {
321 $diff .= $cvsweb_base . join("/", @path) . "/$file";
325 # If this is a binary file, don't try to report a diff; not only is
326 # it meaningless, but it also screws up some mailers. We rely on
327 # Perl's 'is this binary' algorithm; it's pretty good. But not
330 if (($file =~ /\.(?:pdf|gif|jpg|mpg)$/i) || (-B $file)) {
331 if ($SEND_URL eq "true") {
332 $diff .= "?rev=$rev&content-type=text/x-cvsweb-markup\n\n";
334 if ($SEND_DIFF eq "true") {
335 $diff .= "\t<<Binary file>>\n\n";
340 # Get the differences between this and the previous revision,
341 # being aware that new files always have revision '1.1' and
342 # new branches always end in '.n.1'.
344 if ($rev =~ /^(.*)\.([0-9]+)$/) {
346 $prev_rev = $1 . '.' . $prev;
348 $prev_rev =~ s/\.[0-9]+\.0$//;# Truncate if first rev on branch
351 if ($SEND_URL eq "true") {
352 $diff .= "?rev=$rev&content-type=text/x-cvsweb-markup\n\n";
354 if ($SEND_DIFF eq "true") {
356 || exec "$cvsbin/cvs", '-Qn', 'update', '-p', '-r1.1',
358 $diff .= "Index: $file\n=================================="
359 . "=================================\n";
363 if ($SEND_URL eq "true") {
364 $diff .= ".diff?r1=$prev_rev&r2=$rev\n\n";
366 if ($SEND_DIFF eq "true") {
367 $diff .= "(In the diff below, changes in quantity "
368 . "of whitespace are not shown.)\n\n";
370 || exec "$cvsbin/cvs", '-Qn', 'diff', "$difftype",
371 '-b', "-r$prev_rev", "-r$rev", '--', $file;
375 if ($SEND_DIFF eq "true") {
385 &append_line($out, sprintf("%-9s%-12s%s%s", $rev, $delta,
394 local($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
396 $header = sprintf(" User: %-8s\n Date: %02d/%02d/%02d %02d:%02d:%02d",
397 $cvs_user, $year%100, $mon+1, $mday,
399 # $header = sprintf("%-8s %02d/%02d/%02d %02d:%02d:%02d",
400 # $login, $year%100, $mon+1, $mday,
401 # $hour, $min, $sec);
404 # !!! Destination Mailing-list and history file mappings here !!!
409 # my $domain = "nongnu.org";
411 # if ($path =~ /^([^\/]+)/) {
412 # return "cvs\@$1.$domain";
414 # return "cvs\@$domain";
418 sub derive_subject_from_changes_file ()
424 open (CH, "<$CHANGED_FILE.$i.$id.$cvs_user") or last;
426 while (my $change = <CH>)
428 # A changes file looks like this:
430 # src foo.c newfile.html
431 # www index.html project_nav.html
433 # Each line is " Dir File1 File2 ..."
434 # We only care about Dir, since the subject line should
437 $change =~ s/^[ \t]*//;
438 $change =~ /^([^ \t]+)[ \t]*/;
440 # Fold to rightmost directory component
453 $subj = "MODIFIED: $subj ...";
456 # NPM: See if there's any file-addition notifications.
457 my $added = &read_line_nodie("$ADDED_FILE.$i.$id.$cvs_user");
459 $subj .= "ADDED: $added ";
462 # print "derive_subject_from_changes_file().. added== $added \n";
464 ## NPM: See if there's any file-removal notications.
465 my $removed = &read_line_nodie("$REMOVED_FILE.$i.$id.$cvs_user");
466 if ($removed ne "") {
467 $subj .= "REMOVED: $removed ";
470 # print "derive_subject_from_changes_file().. removed== $removed \n";
472 ## NPM: See if there's any branch notifications.
473 my $branched = &read_line_nodie("$BRANCH_FILE.$i.$id.$cvs_user");
474 if ($branched ne "") {
475 $subj .= "BRANCHED: $branched";
478 # print "derive_subject_from_changes_file().. branched== $branched \n";
480 ## NPM: DEFAULT: DIRECTORY CREATION (c.f. "Check for a new directory first" in main mody)
482 my $subject = join("/", @path);
483 $subj = "NEW: $subject";
490 sub mail_notification
492 local($addr_list, @text) = @_;
495 my $subj = &derive_subject_from_changes_file ();
497 if ($EMULATE_LOCAL_MAIL_USER ne "") {
498 $MAIL_FROM = "$cvs_user\@$EMULATE_LOCAL_MAIL_USER";
501 $mail_to = join(", ", @{$addr_list});
503 print "Mailing the commit message to $mail_to (from $MAIL_FROM)\n";
505 $ENV{'MAILUSER'} = $MAIL_FROM;
506 # Commented out on hocus, so comment it out here. -kff
507 # $ENV{'QMAILINJECT'} = 'f';
509 open(MAIL, "$MAIL_CMD -f$MAIL_FROM");
510 print MAIL "From: $MAIL_FROM\n";
511 print MAIL "To: $mail_to\n";
512 print MAIL "Subject: $SUBJECT_PRE $subj\n\n";
513 print(MAIL join("\n", @text));
515 # print "Mailing the commit message to $MAIL_TO...\n";
517 # #added by jrobbins@collab.net 1999/12/15
518 # # attempt to get rid of anonymous
519 # $ENV{'MAILUSER'} = 'commitlogger';
520 # $ENV{'QMAILINJECT'} = 'f';
522 # open(MAIL, "| /var/qmail/bin/qmail-inject");
523 # print(MAIL "To: $MAIL_TO\n");
524 # print(MAIL "Subject: cvs commit: $ARGV[0]\n");
525 # print(MAIL join("\n", @text));
529 ## process the command line arguments sent to this script
530 ## it returns an array of files, %s, sent from the loginfo
537 print "Processing log script arguments...\n";
539 if ($UseNewInfoFmtStrings) {
543 if ($arg eq '-u' && !defined($cvs_user)) {
544 $cvs_user = shift @argv;
546 if ($arg eq '- New directory') {
548 } elsif ($arg eq '- Imported sources') {
549 $imported_sources = 1;
559 $cvs_user = shift @argv;
561 ($donefiles) && die "Too many arguments!\n";
564 if ($arg =~ s/ - New directory//) {
566 } elsif ($arg =~ s/ - Imported sources//) {
567 $imported_sources = 1;
569 @files = split(' ', $arg);
577 #############################################################
581 ############################################################
587 # Connect to the database
588 $cvsbin = "/usr/bin";
591 # Initialize basic variables
594 $state = $STATE_NONE;
595 $cvs_user = $ENV{'USER'} || getlogin || (getpwuid($<))[0] || sprintf("uid#%d",$<);
596 $new_directory = 0; # Is this a 'cvs add directory' command?
597 $imported_sources = 0; # Is this a 'cvs import' command?
598 @files = process_argv(@ARGV);
599 @path = split('/', $files[0]);
603 $dir = join('/', @path[1..$#path]);
605 #print("ARGV - ", join(":", @ARGV), "\n");
606 #print("files - ", join(":", @files), "\n");
607 #print("path - ", join(":", @path), "\n");
608 #print("dir - ", $dir, "\n");
609 #print("id - ", $id, "\n");
612 # Map the repository directory to an email address for commitlogs to be sent
615 #$mlist = &mlist_map($files[0]);
617 ##########################
619 # Check for a new directory first. This will always appear as a
620 # single item in the argument list, and an empty log message.
622 if ($new_directory) {
623 $header = &build_header;
625 push(@text, $header);
627 push(@text, " ".$files[0]." - New directory");
628 &mail_notification([ $mlist ], @text);
633 # Iterate over the body of the message collecting information.
636 chomp; # Drop the newline
637 if (/^Revision\/Branch:/) {
638 s,^Revision/Branch:,,;
639 push (@branch_lines, split);
642 # next if (/^[ \t]+Tag:/ && $state != $STATE_LOG);
643 if (/^Modified Files/) { $state = $STATE_CHANGED; next; }
644 if (/^Added Files/) { $state = $STATE_ADDED; next; }
645 if (/^Removed Files/) { $state = $STATE_REMOVED; next; }
646 if (/^Log Message/) { $state = $STATE_LOG; last; }
647 s/[ \t\n]+$//; # delete trailing space
649 push (@changed_files, split) if ($state == $STATE_CHANGED);
650 push (@added_files, split) if ($state == $STATE_ADDED);
651 push (@removed_files, split) if ($state == $STATE_REMOVED);
653 # Proces the /Log Message/ section now, if it exists.
654 # Do this here rather than above to deal with Log messages
655 # that include lines that confuse the state machine.
658 next unless ($state == $STATE_LOG); # eat all STDIN
660 if ($state == $STATE_LOG) {
663 /^Submitted by:$/i ||
664 /^Obtained from:$/i) {
667 push (@log_lines, $_);
673 # Strip leading and trailing blank lines from the log message. Also
674 # compress multiple blank lines in the body of the message down to a
676 # (Note, this only does the mail and changes log, not the rcs log).
678 while ($#log_lines > -1) {
679 last if ($log_lines[0] ne "");
682 while ($#log_lines > -1) {
683 last if ($log_lines[$#log_lines] ne "");
686 for ($i = $#log_lines; $i > 0; $i--) {
687 if (($log_lines[$i - 1] eq "") && ($log_lines[$i] eq "")) {
688 splice(@log_lines, $i, 1);
693 # Find the log file that matches this log message
695 for ($i = 0; ; $i++) {
696 last if (! -e "$LOG_FILE.$i.$id.$cvs_user");
697 @text = &read_logfile("$LOG_FILE.$i.$id.$cvs_user", "");
698 last if ($#text == -1);
699 last if (join(" ", @log_lines) eq join(" ", @text));
703 # Spit out the information gathered in this pass.
705 &write_logfile("$LOG_FILE.$i.$id.$cvs_user", @log_lines);
706 &append_to_file("$BRANCH_FILE.$i.$id.$cvs_user", $dir, @branch_lines);
707 &append_to_file("$ADDED_FILE.$i.$id.$cvs_user", $dir, @added_files);
708 &append_to_file("$CHANGED_FILE.$i.$id.$cvs_user", $dir, @changed_files);
709 &append_to_file("$REMOVED_FILE.$i.$id.$cvs_user", $dir, @removed_files);
710 &append_line("$MLIST_FILE.$i.$id.$cvs_user", $mlist);
712 &change_summary("$SUMMARY_FILE.$i.$id.$cvs_user", (@changed_files, @added_files));
716 # Check whether this is the last directory. If not, quit.
718 if (-e "$LAST_FILE.$id.$cvs_user") {
719 $_ = &read_line("$LAST_FILE.$id.$cvs_user");
720 $tmpfiles = $files[0];
721 $tmpfiles =~ s,([^a-zA-Z0-9_/]),\\$1,g;
722 if (! grep(/$tmpfiles$/, $_)) {
723 print "More commits to come...\n";
729 # This is it. The commits are all finished. Lump everything together
730 # into a single message, fire a copy off to the mailing list, and drop
731 # it on the end of the Changes file.
733 $header = &build_header;
736 # Produce the final compilation of the log messages
740 push(@text, $header);
742 for ($i = 0; ; $i++) {
743 last if (! -e "$LOG_FILE.$i.$id.$cvs_user");
744 push(@text, &read_file("$BRANCH_FILE.$i.$id.$cvs_user", "Branch:"));
745 push(@text, &read_file("$CHANGED_FILE.$i.$id.$cvs_user", "Modified:"));
746 push(@text, &read_file("$ADDED_FILE.$i.$id.$cvs_user", "Added:"));
747 push(@text, &read_file("$REMOVED_FILE.$i.$id.$cvs_user", "Removed:"));
748 push(@text, " Log:");
749 push(@text, &read_logfile("$LOG_FILE.$i.$id.$cvs_user", " "));
750 push(@mlist_list, &read_file_lines("$MLIST_FILE.$i.$id.$cvs_user"));
751 if ($rcsidinfo == 2) {
752 if (-e "$SUMMARY_FILE.$i.$id.$cvs_user") {
754 push(@text, " Revision Changes Path");
755 push(@text, &read_logfile("$SUMMARY_FILE.$i.$id.$cvs_user", " "));
762 # Now generate the extra info for the mail message..
764 if ($rcsidinfo == 1) {
766 for ($i = 0; ; $i++) {
767 last if (! -e "$LOG_FILE.$i.$id.$cvs_user");
768 if (-e "$SUMMARY_FILE.$i.$id.$cvs_user") {
770 push(@text, "Revision Changes Path");
772 push(@text, &read_logfile("$SUMMARY_FILE.$i.$id.$cvs_user", ""));
776 push(@text, ""); # consistancy...
782 foreach (@mlist_list) { $mlist_hash{ $_ } = 1; }
785 # Mail out the notification.
787 &mail_notification([ keys(%mlist_hash) ], @text);