Quick Search:

View

Revision:
Expand:  
Changeset: MAIN:root:20071002120732

Diff

Diff from 1.1 to:

Annotations

Annotate by Age | Author | Mixed | None
/fisheye/browse/pcc/CVSROOT/log_accum

Annotated File View

root
1.1
1 #! /usr/bin/perl
2 # -*-Perl-*-
3 #
4 # Copyright (c) 2006 The NetBSD Foundation, Inc.
5 # All rights reserved.
6 #
7 # Redistribution and use in source and binary forms, with or without
8 # modification, are permitted provided that the following conditions
9 # are met:
10 # 1. Redistributions of source code must retain the above copyright
11 #    notice, this list of conditions and the following disclaimer.
12 # 2. Redistributions in binary form must reproduce the above copyright
13 #    notice, this list of conditions and the following disclaimer in the
14 #    documentation and/or other materials provided with the distribution.
15 # 3. All advertising materials mentioning features or use of this software
16 #    must display the following acknowledgement:
17 #        This product includes software developed by the NetBSD
18 #        Foundation, Inc. and its contributors.
19 # 4. Neither the name of The NetBSD Foundation nor the names of its
20 #    contributors may be used to endorse or promote products derived
21 #    from this software without specific prior written permission.
22 #
23 # THIS SOFTWARE IS PROVIDED BY THE NETBSD FOUNDATION, INC. AND CONTRIBUTORS
24 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
25 # TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
26 # PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE FOUNDATION OR CONTRIBUTORS
27 # BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
28 # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
29 # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
30 # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
31 # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
32 # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33 # POSSIBILITY OF SUCH DAMAGE.
34 #
35 #ident  "@(#)ccvs/contrib:$NetBSD: log_accum,v 1.85 2006/04/20 11:11:41 soda Exp $"
36 #
37 # Perl filter to handle the log messages from the checkin of files in multiple
38 # directories.  This script will group the lists of files by log message, and
39 # send one piece of mail per unique message, no matter how many files are
40 # committed.
41 #
42 # This implementation requires:
43 # 1) a pre-commit checking program that leaves a #cvs.lastdir file containing
44 #    the name of the last directory,
45 # 2) the `%{Vvts}' output format in the loginfo file (so that the version
46 #    numbers and tags are all passed in, and in the right order), and
47 # 3) perl5-MD5.
48 #
49 # Contributed by David Hampton <hampton@cisco.com>
50 # Hacked greatly by Greg A. Woods <woods@planix.com>
51 # Rewritten by Charles M. Hannum <mycroft@netbsd.org>
52 # Least common path routine by Hubert Feyrer <hubertf@netbsd.org>
53 # rdiff & bugsto support by Darrin B. Jewell <dbj@netbsd.org>
54
55 # Usage: log_accum.pl [-d] [-D] [-S] [-M module] [[-m mailto] ...] [[-R replyto] ...] [-T title] [[-b bugsto] ...] [-f logfile]
56 #       -d              - turn on debugging
57 #       -m mailto       - send mail to "mailto" (multiple)
58 #       -R replyto      - set the "Reply-To:" to "replyto" (multiple)
59 #       -M modulename   - set module name to "modulename"
60 #       -f logfile      - write commit messages to logfile too
61 #       -D              - generate diff commands
62 #       -S              - write to "syncer" file in /tmp used by push script
63 #       -T              - use "title" instead of "CVS commit: "
64 #       -W              - write to "www syncer" file in /tmp for www push
65 #       -b bugsto       - send mail referencing problem reports to this address
66
67
68 # First things first: we don't want to be interrupted, the commit will
69 # have happened but the logging/mailing/syncing won't, which would be Bad.
70
71 $SIG{INT}       = 'IGNORE';
72 $SIG{QUIT}      = 'IGNORE';
73 $SIG{HUP}       = 'IGNORE';
74
75 use Digest::MD5;
76
77 #
78 #       Configurable options
79 #
80 $title = "CVS commit: ";
81
82 # set this to something that takes a whole message on stdin
83 @MAILER        = ("/usr/sbin/sendmail", "-ti");
84
85 # to avoid - Insecure $ENV{PATH} while running setuid at log_accum
86 $ENV{PATH}="/bin:/usr/bin:/usr/pkg/bin:/usr/local/bin";
87
88 #
89 #       End user configurable options.
90 #
91
92 $LASTDIR_FILE = "/tmp/#cvs.lastdir";
93 $HASH_FILE = "/tmp/#cvs.hash";
94 $VERSION_FILE = "/tmp/#cvs.version";
95 $MESSAGE_FILE = "/tmp/#cvs.message";
96 $MAIL_FILE = "/tmp/#cvs.mail";
97 $SYNCER_FILE= "/tmp/cvs_commits";
98 $WWWSYNCER_FILE= "/tmp/wwwcvs_commits";
99
100 #
101 #       Subroutines
102 #
103
104 #
105 # An O(n) routine to find the least common directory in a number
106 # of paths  - Hubert Feyrer <hubertf@netbsd.org>
107 #
108 # Beware: paths are anon-arrays of [0, 1, 2, 3, "path"] !
109 #
110 sub lcpath
111 {
112     local(@paths) = @_;
113     local($lcpathlen, @lcpath, $i, @c, $dir, $ref, $firstpath);
114     
115     $lcpathlen=0;
116     @lcpath[0..999] = "/";              # "/" => never set, "" => truncated
117     $firstpath = 1;
118
119     for($i=0; $i<100; $i++) { $lcpath[$i] = "/"; }
120     
121     foreach $ref (@paths){
122         $dir = $$ref[4];
123         print("HF: dir=$dir lcpath=",
124               join("/", @lcpath[0..$lcpathlen]), " ($lcpathlen)\n")
125             if $debug;
126         
127         @c = split(/\//, $dir);
128       component:
129         for($i=0; $i <= $#c; $i++) {
130             print("$i: $c[$i]   lc=$lcpath[$i]" .
131                   "      lcpath=", join("/", @lcpath[0..$lcpathlen-1]),"\n")
132                 if $debug;
133             
134             if ($lcpath[$i] eq "/") {
135                 if ($firstpath) {
136                     # never been there
137                     $lcpath[$i] = $c[$i];
138                     $lcpathlen = $i;
139                     print "-> $c[$i] added at $i\n"
140                         if $debug;
141                 } else {
142                     # Something was here before - stop!
143                     print "-> stopped by earlier shorter path\n"
144                         if $debug;
145                     last component;
146                 }
147             } else {
148                 if ($c[$i] ne $lcpath[$i]) {
149                     # different names 
150                     $lcpath[$i] = "";
151                     $lcpathlen = $i-1;
152                     print "-> truncated at $lcpathlen ($c[$i])\n"
153                         if $debug;
154                     last component;
155                 }
156             }
157         }
158         
159         if ($lcpathlen > $#c and $lcpathlen > 0) {
160             $lcpathlen = $#c;
161             $lcpath[$#c + 1] = "";
162             print "-> truncated at $#c\n"
163                 if $debug;
164         }
165
166         $firstpath = 0
167             if $firstpath;
168         
169         print "\n"
170             if $debug;
171     }   
172     
173     print "lcpath = ", join("/", @lcpath[0..$lcpathlen]), " ($lcpathlen)\n"
174         if $debug;
175     
176     return join("/", @lcpath[0..$lcpathlen]);
177 }
178
179 sub append_logfile {
180     local($filename, @lines) = @_;
181     local($_);
182
183     open(FILE, ">>$filename") || die("Cannot open file $filename for append.\n");
184     foreach (@lines) {
185         print FILE $_."\n";
186     }
187     close(FILE);
188 }
189
190 sub write_logfile {
191     local($filename, @lines) = @_;
192     local($_);
193
194     open(FILE, ">$filename") || die("Cannot open file $filename for write.\n");
195     foreach (@lines) {
196         print FILE $_."\n";
197     }
198     close(FILE);
199 }
200
201 sub read_logfile {
202     local($filename) = @_;
203     local(@lines);
204
205     open(FILE, "<$filename") || die("Cannot open file $filename for read.\n");
206     while (<FILE>) {
207         chop;
208         push @lines, $_;
209     }
210     close(FILE);
211
212     @lines;
213 }
214
215 sub format_lists {
216     local(@lines, $line, $_, $last, $f);
217
218     if ($debug) {
219         print STDERR "format_lists(): files = ", join(" ", @_), ".\n";
220     }
221
222     # Sort by tag, dir, file.
223     @_ = sort {
224         $$a[2] cmp $$b[2] ||
225         $$a[4] cmp $$b[4] ||
226         $$a[3] cmp $$b[3];
227     } @_;
228
229     # Combine adjacent rows that are the same modulo the file name.
230     @_ = map {
231         if (!$last || $$_[2] ne $$last[2] || $$_[4] ne $$last[4]) {
232             $last = [@$_[0..2], [$$_[3]], @$_[4]];
233             $last;
234         } else {
235             push @{$$last[3]}, $$_[3];
236             ();
237         }
238     } @_;
239
240     foreach (@_) {
241         $line = "\t".$$_[4];
242         $line .= " [".$$_[2]."]" if $$_[2];
243         $branches{$$_[2] ne ""? $$_[2] : "trunk" } = 1;
244         $line .= ":";
245         foreach $f (@{$$_[3]}) {
246             if (length($line) + length($f) > 71) {
247                 push(@lines, $line);
248                 $line = "\t   ";
249             }
250             $line .= " ".$f;
251         }
252         push @lines, $line;
253     }
254
255     @lines;
256 }
257
258 sub format_diffs {
259     local(@lines, $line, $_, $last, $f);
260
261     if ($debug) {
262         print STDERR "format_diffs(): files = ", join(" ", @_), ".\n";
263     }
264
265     # Sort by dir, old, new, file.
266     @_ = sort {
267         $$a[4] cmp $$b[4] ||
268         $$a[0] cmp $$b[0] ||
269         $$a[1] cmp $$b[1] ||
270         $$a[3] cmp $$b[3];
271     } @_;
272
273     # Combine adjacent rows that are the same modulo the file name.
274     @_ = map {
275         if (!$last || $$_[4] ne $$last[4] || $$_[0] ne $$last[0] ||
276                       $$_[1] ne $$last[1]) {
277             $last = [@$_[0..2], [$$_[3]], @$_[4]];
278             $last;
279         } else {
280             push @{$$last[3]}, $$_[3];
281             ();
282         }
283     } @_;
284
285     # Sort by dir, file.
286     @_ = sort {
287         $$a[4] cmp $$b[4] ||
288         $$a[3][0] cmp $$b[3][0];
289     } @_;
290
291     foreach (@_) {
292         $line = "cvs rdiff -u -r$$_[0] -r$$_[1]";
293         foreach $f (@{$$_[3]}) {
294             if (length($line) + length($$_[4]."/".$f) > 76) {
295                 push @lines, $line." \\";
296                 $line = "   ";
297             }
298             $line .= " ".$$_[4]."/".$f;
299         }
300         push @lines, $line;
301     }
302
303     @lines;
304 }
305
306 sub build_header {
307     local($header, $now);
308     $now = gmtime;
309     $header = sprintf("Module Name:\t%s\nCommitted By:\t%s\nDate:\t\t%s %s %s",
310                       $modulename,
311                       $login,
312                       substr($now, 0, 19), "UTC", substr($now, 20, 4));
313 }
314
315 # Search text for possible references to gnats prs
316 sub search_for_prs {
317     local(@text) = @_;
318     local(@prs);
319     local($last);
320     @prs = ();
321     foreach $_ (@text) {
322         while (m/(?:^|[ \t])P(?:roblem)?\s*?R(?:eport)?\s*\/?\#?\s*(?:\b[\w-]+\/)?(\d+)\b/igo) {
323             push @prs,$1;
324         }
325     }
326     @prs = map { if (!$last || $last ne $_) { $last = $_ ; } else { () } } sort @prs;
327
328     @prs;
329 }
330
331 sub mail_notification {
332     local(@text) = @_;
333     local($branches, $s, $_, $name);
334     local($subject, $lcpath);
335
336     # prepend any branches that we might have ...
337     #
338     $branches = join(", ", sort(keys(%branches)));
339     if ($branches ne "" and $branches ne "trunk") {     # branch commit!
340         $subject = "[$branches] ";
341     } else {
342         $subject = "";
343     }
344
345     # ... and add least common path component of all dirs
346     #
347     $lcpath = lcpath(@added_files, @removed_files, @modified_files);
348     if ($lcpath ne "/" and $lcpath ne "") {
349         $subject .= $lcpath;            # cvs commit
350         if ($do_syncer) {
351                 &append_logfile($SYNCER_FILE, $lcpath);
352         }
353         if ($do_wwwsyncer) {
354                 &append_logfile($WWWSYNCER_FILE, $lcpath);
355         }
356     } else {
357         $subject .= "$dir";             # cvs import
358         if ($do_syncer) {
359                 &append_logfile($SYNCER_FILE, "$dir");
360         }
361         if ($do_wwwsyncer) {
362                 &append_logfile($WWWSYNCER_FILE, "$dir");
363         }
364     }
365         
366     # Fetch the user's full name from the GECOS field.  We have to do the
367     # magic & substitution, and possibly quote it for RFC822 as well.
368     #
369     $_ = (split(",", (getpwnam($login))[6]))[0];
370     s,&,\u$login,g;
371     if (m,[^- !#-'*+/-9=?A-Z^-~],) {
372         s,[\"\\],\\$&,;
373         $_ = "\"$_\"";
374     }
375     $name = $_;
376
377     &write_logfile("$MAIL_FILE.$id",
378         "From: " . ($name ? $name." <".$login.">" : $login),
379         "Subject: $title$subject",
380         "To: " . $mailto,
381         "Reply-To: " . $replyto,
382         "",
383         "",
384         @text);
385     unless ($pid = fork) {
386         open(STDIN, "<$MAIL_FILE.$id") || die("Cannot open file $filename for read.\n");
387         exec(@MAILER) || die("Cannot exec @MAILER.\n");
388     }
389     waitpid($pid, 0);
390
391
392     if ($bugsto) {
393         local(@prs);
394         @prs = &search_for_prs(@text);
395         foreach $pr (@prs) {
396             &write_logfile("$MAIL_FILE.$id",
397                            "From: " . ($name ? $name." <".$login.">" : $login),
398                            "Subject: PR/$pr CVS commit: $subject",
399                            "To: " . $bugsto,
400                            "Reply-To: " . $replyto,
401                            "",
402                            @text);
403             unless ($pid = fork) {
404                 open(STDIN, "<$MAIL_FILE.$id") || die("Cannot open file $filename for read.\n");
405                 exec(@MAILER) || die("Cannot exec @MAILER.\n");
406             }
407             waitpid($pid, 0);
408         }
409     }
410 }
411
412 #
413 #       Main Body
414 #
415
416 # Initialize basic variables
417 #
418 $debug = 0;
419 $id = getpgrp();        # note, you *must* use a shell which does setpgrp()
420 ($login) = getpwuid($<);
421 $login || die "*** Who are you?";
422 $do_diff = 0;
423
424 # parse command line arguments (file list is seen as one arg)
425 #
426 while (@ARGV) {
427     $_ = shift @ARGV;
428     if ($_ eq '-d') {
429         $debug = 1;
430         print STDERR "Debug turned on...\n";
431     } elsif ($_ eq '-m') {
432         $mailto .= ", " if $mailto;
433         $mailto .= shift @ARGV;
434     } elsif ($_ eq '-b') {
435         $bugsto .= ", " if $bugsto;
436         $bugsto .= shift @ARGV;
437     } elsif ($_ eq '-R') {
438         $replyto .= ", " if $replyto;
439         $replyto .= shift @ARGV;
440     } elsif ($_ eq '-M') {
441         die("too many '-M' args\n") if $modulename;
442         $modulename = shift @ARGV;
443     } elsif ($_ eq '-f') {
444         die("too many '-f' args\n") if $commitlog;
445         $commitlog = shift @ARGV;
446         # This is a disgusting hack to untaint $commitlog if we're running from
447         # setgid cvs.
448         $commitlog =~ m/(.*)/;
449         $commitlog = $1;
450     } elsif ($_ eq '-D') {
451         $do_diff = 1;
452     } elsif ($_ eq '-S') {
453         $do_syncer = 1;
454     } elsif ($_ eq '-T') {
455         $title = shift @ARGV;
456     } elsif ($_ eq '-W') {
457         $do_wwwsyncer = 1;
458     } else {
459         @files = split;
460         last;
461     }
462 }
463 if (@ARGV) {
464     die("Too many arguments!  Check usage.\n");
465 }
466
467 if (! $mailto) {
468     die("No mail recipient specified (use -m)\n");
469 }
470 if (! $replyto) {
471     $replyto = $login;
472 }
473
474 # for now, the first "file" is the repository directory being committed,
475 # relative to the $CVSROOT location
476 #
477 $dir = shift @files;
478
479 # XXX there are some ugly assumptions in here about module names and
480 # XXX directories relative to the $CVSROOT location -- really should
481 # XXX read $CVSROOT/CVSROOT/modules, but that's not so easy to do, since
482 # XXX we have to parse it backwards.
483 #
484 # XXX For now we set the `module' name to the top-level directory name.
485 #
486 if (! $modulename) {
487     ($modulename) = split('/', $dir, 2);
488 }
489
490 if ($debug) {
491     print STDERR "module - ", $modulename, "\n";
492     print STDERR "dir    - ", $dir, "\n";
493     print STDERR "files  - ", join(" ", @files), "\n";
494     print STDERR "id     - ", $id, "\n";
495 }
496
497 # Check for a new directory or an import command.
498 #
499 #    files[0] - "-"
500 #    files[1] - "New"
501 #    files[2] - "directory"
502 #
503 #    files[0] - "-"
504 #    files[1] - "Imported"
505 #    files[2] - "sources"
506 #
507 if ($files[0] eq "-") {
508     if ($files[1] eq "New" && $files[2] eq "directory") {
509         # Forget about it
510     } else {
511         local(@text);
512
513         @text = ();
514         push @text, &build_header();
515         push @text, "";
516
517         while (<STDIN>) {
518             chop;                       # Drop the newline
519             push @text, $_;
520         }
521
522         # Write to the commitlog file
523         #
524         if ($commitlog) {
525             &append_logfile($commitlog, @text);
526         }
527
528         # Mail out the notification.
529         #
530         &mail_notification(@text);
531     }
532
533     exit 0;
534 }
535
536 if ($debug) {
537     print STDERR "files  - ", join(" ", @files), "\n";
538 }
539
540 # Collect just the log message from stdin.
541 #
542 while (<STDIN>) {
543     chop;                       # strip the newline
544     last if (/^Log Message:$/);
545 }
546 while (<STDIN>) {
547     chop;                       # strip the newline
548     s/\s+$//;                   # strip trailing white space
549     push @log_lines, $_;
550 }
551
552 $md5 = Digest::MD5->new();
553 foreach (@log_lines) {
554     $md5->add($_."\n");
555 }
556 $hash = $md5->hexdigest();
557 undef $md5;
558
559 if ($debug) {
560     print STDERR "hash = $hash\n";
561 }
562 if (! -e "$MESSAGE_FILE.$id.$hash") {
563     &append_logfile("$HASH_FILE.$id", $hash);
564     &write_logfile("$MESSAGE_FILE.$id.$hash", @log_lines);
565 }
566     
567 # Spit out the information gathered in this pass.
568 #
569 &append_logfile("$VERSION_FILE.$id.$hash", $dir.'/', @files);
570
571 # Check whether this is the last directory.  If not, quit.
572 #
573 if ($debug) {
574     print STDERR "Checking current dir against last dir.\n";
575 }
576 ($_) = &read_logfile("$LASTDIR_FILE.$id");
577
578 if ($_ ne $dir) {
579     if ($debug) {
580         print STDERR sprintf("Current directory %s is not last directory %s.\n", $dir, $_);
581     }
582     exit 0;
583 }
584 if ($debug) {
585     print STDERR sprintf("Current directory %s is last directory %s -- all commits done.\n", $dir, $_);
586 }
587
588 #
589 #       End Of Commits!
590 #
591
592 # This is it.  The commits are all finished.  Lump everything together
593 # into a single message, fire a copy off to the mailing list, and drop
594 # it on the end of the Changes file.
595 #
596
597 #
598 # Produce the final compilation of the log messages
599 #
600
601 @hashes = &read_logfile("$HASH_FILE.$id");
602 foreach $hash (@hashes) {
603     # In case we're running setgid, make sure the hash file hasn't been hacked.
604     $hash =~ m/([a-z0-9]*)/ || die "*** Hacking attempt detected\n";
605     $hash = $1;
606
607     @text = ();
608     push @text, &build_header();
609     push @text, "";
610
611     @files = &read_logfile("$VERSION_FILE.$id.$hash");
612     @log_lines = &read_logfile("$MESSAGE_FILE.$id.$hash");
613
614     foreach (@files) {
615         if (s/\/$//) {
616             $dir = $_;
617             next;
618         }
619         $_ = [split(',', $_, 4), $dir];
620         if ($$_[0] eq 'NONE') {
621             $$_[0] = '0';
622             push @added_files, $_;
623         } elsif ($$_[1] eq 'NONE') {
624             $$_[1] = '0';
625             push @removed_files, $_;
626         } else {
627             push @modified_files, $_;
628         }
629     }
630
631     # Strip leading and trailing blank lines from the log message.  Also
632     # compress multiple blank lines in the body of the message down to a
633     # single blank line.
634     #
635     $blank = 1;
636     @log_lines = map {local $wasblank = $blank;
637                       $blank = $_ eq '';
638                       $blank && $wasblank ? () : $_;} @log_lines;
639     pop @log_lines if $blank;
640
641     if (@modified_files) {
642         push @text, "Modified Files:";
643         push @text, &format_lists(@modified_files);
644     }
645     if (@added_files) {
646         push @text, "Added Files:";
647         push @text, &format_lists(@added_files);
648     }
649     if (@removed_files) {
650         push @text, "Removed Files:";
651         push @text, &format_lists(@removed_files);
652     }
653     if (@log_lines) {
654         push @text, "";
655         push @text, "Log Message:";
656         push @text, @log_lines;
657     }
658     push @text, "";
659
660     # Write to the commitlog file
661     #
662     if ($commitlog) {
663         &append_logfile($commitlog, @text);
664     }
665
666     if ($do_diff) {
667         push @text, "";
668         push @text, "To generate a diff of this commit:";
669         push @text, &format_diffs(@modified_files, @added_files,
670                                   @removed_files);
671         push @text, "";
672         push @text, "Please note that diffs are not public domain; they are subject to the";
673         push @text, "copyright notices on the relevant files.";
674         push @text, "";
675     }
676
677     # Mail out the notification.
678     #
679     &mail_notification(@text);
680
681     if (! $debug) {
682         unlink "$VERSION_FILE.$id.$hash";
683         unlink "$MESSAGE_FILE.$id.$hash";
684         unlink "$MAIL_FILE.$id";
685     }
686 }
687
688 if (! $debug) {
689     unlink "$LASTDIR_FILE.$id";
690     unlink "$HASH_FILE.$id";
691 }
692
693 exit 0;
FishEye: Open Source License registered to PCC.
Your maintenance has expired. You can renew your license at http://www.atlassian.com/fisheye/renew
Atlassian FishEye, CVS analysis. (Version:1.6.3 Build:build-336 2008-11-04) - Administration - Page generated 2014-09-02 23:22 +0200