Changes needed to support smartcards. Well, only _support_. There is
[gnupg.git] / scripts / log_accum
1 #! /usr/bin/perl
2 # -*-Perl-*-
3 #
4 # Perl filter to handle the log messages from the checkin of files in
5 # a directory.  This script will group the lists of files by log
6 # message, and mail a single consolidated log message at the end of
7 # the commit.
8 #
9 # This file assumes a pre-commit checking program that leaves the
10 # names of the first and last commit directories in a temporary file.
11 #
12 # Contributed by David Hampton <hampton@cisco.com>
13 #
14 # hacked greatly by Greg A. Woods <woods@planix.com>
15 #
16 # Modified by werner.koch@guug.de to add support for
17 #       automagically extraction of ChangeLog entries           1998-12-29
18
19 # Usage: log_accum.pl [-d] [-s] [-M module] [[-m mailto] ...] [[-R replyto] ...] [-f logfile]
20 #       -d              - turn on debugging
21 #       -m mailto       - send mail to "mailto" (multiple)
22 #       -R replyto      - set the "Reply-To:" to "replyto" (multiple)
23 #       -M modulename   - set module name to "modulename"
24 #       -f logfile      - write commit messages to logfile too
25 #       -s              - *don't* run "cvs status -v" for each file
26 #       -w              - show working directory with log message
27
28 #
29 #       Configurable options
30 #
31
32 # set this to something that takes a whole message on stdin
33 $MAILER        = "/usr/lib/sendmail -t";
34
35 #
36 #       End user configurable options.
37 #
38
39 # Constants (don't change these!)
40 #
41 $STATE_NONE    = 0;
42 $STATE_CHANGED = 1;
43 $STATE_ADDED   = 2;
44 $STATE_REMOVED = 3;
45 $STATE_LOG     = 4;
46
47 $LAST_FILE     = "/tmp/#cvs.lastdir";
48
49 $CHANGED_FILE  = "/tmp/#cvs.files.changed";
50 $ADDED_FILE    = "/tmp/#cvs.files.added";
51 $REMOVED_FILE  = "/tmp/#cvs.files.removed";
52 $LOG_FILE      = "/tmp/#cvs.files.log";
53
54 $FILE_PREFIX   = "#cvs.files";
55
56 #
57 #       Subroutines
58 #
59
60 sub cleanup_tmpfiles {
61     local($wd, @files);
62
63     $wd = `pwd`;
64     chdir("/tmp") || die("Can't chdir('/tmp')\n");
65     opendir(DIR, ".");
66     push(@files, grep(/^$FILE_PREFIX\..*\.$id$/, readdir(DIR)));
67     closedir(DIR);
68     foreach (@files) {
69         unlink $_;
70     }
71     unlink $LAST_FILE . "." . $id;
72
73     chdir($wd);
74 }
75
76 sub write_logfile {
77     local($filename, @lines) = @_;
78
79     open(FILE, ">$filename") || die("Cannot open log file $filename.\n");
80     print FILE join("\n", @lines), "\n";
81     close(FILE);
82 }
83
84 sub append_to_logfile {
85     local($filename, @lines) = @_;
86
87     open(FILE, ">$filename") || die("Cannot open log file $filename.\n");
88     print FILE join("\n", @lines), "\n";
89     close(FILE);
90 }
91
92 sub format_names {
93     local($dir, @files) = @_;
94     local(@lines);
95
96     $format = "\t%-" . sprintf("%d", length($dir)) . "s%s ";
97
98     $lines[0] = sprintf($format, $dir, ":");
99
100     if ($debug) {
101         print STDERR "format_names(): dir = ", $dir, "; files = ", join(":", @files), ".\n";
102     }
103     foreach $file (@files) {
104         if (length($lines[$#lines]) + length($file) > 65) {
105             $lines[++$#lines] = sprintf($format, " ", " ");
106         }
107         $lines[$#lines] .= $file . " ";
108     }
109
110     @lines;
111 }
112
113 sub format_lists {
114     local(@lines) = @_;
115     local(@text, @files, $lastdir);
116
117     if ($debug) {
118         print STDERR "format_lists(): ", join(":", @lines), "\n";
119     }
120     @text = ();
121     @files = ();
122     $lastdir = shift @lines;    # first thing is always a directory
123     if ($lastdir !~ /.*\/$/) {
124         die("Damn, $lastdir doesn't look like a directory!\n");
125     }
126     foreach $line (@lines) {
127         if ($line =~ /.*\/$/) {
128             push(@text, &format_names($lastdir, @files));
129             $lastdir = $line;
130             @files = ();
131         } else {
132             push(@files, $line);
133         }
134     }
135     push(@text, &format_names($lastdir, @files));
136
137     @text;
138 }
139
140 sub append_names_to_file {
141     local($filename, $dir, @files) = @_;
142
143     if (@files) {
144         open(FILE, ">>$filename") || die("Cannot open file $filename.\n");
145         print FILE $dir, "\n";
146         print FILE join("\n", @files), "\n";
147         close(FILE);
148     }
149 }
150
151 sub read_line {
152     local($line);
153     local($filename) = @_;
154
155     open(FILE, "<$filename") || die("Cannot open file $filename.\n");
156     $line = <FILE>;
157     close(FILE);
158     chop($line);
159     $line;
160 }
161
162 sub read_logfile {
163     local(@text);
164     local($filename, $leader) = @_;
165
166     open(FILE, "<$filename");
167     while (<FILE>) {
168         chop;
169         push(@text, $leader.$_);
170     }
171     close(FILE);
172     @text;
173 }
174
175 sub build_header {
176     local($header);
177     local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
178     $header = sprintf("CVSROOT:\t%s\nModule name:\t%s\nRepository:\t%s\nChanges by:\t%s@%s\t%02d/%02d/%02d %02d:%02d:%02d",
179                       $cvsroot,
180                       $modulename,
181                       $dir,
182                       $login, $hostdomain,
183                       $year%100, $mon+1, $mday,
184                       $hour, $min, $sec);
185 }
186
187 sub mail_notification {
188     local(@text) = @_;
189
190     # if only we had strftime()...  stuff stolen from perl's ctime.pl:
191     local($[) = 0;
192
193     @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
194     @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
195             'Jul','Aug','Sep','Oct','Nov','Dec');
196
197     # Determine what time zone is in effect.
198     # Use GMT if TZ is defined as null, local time if TZ undefined.
199     # There's no portable way to find the system default timezone.
200     #
201     $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
202
203     # Hack to deal with 'PST8PDT' format of TZ
204     # Note that this can't deal with all the esoteric forms, but it
205     # does recognize the most common: [:]STDoff[DST[off][,rule]]
206     #
207     if ($TZ =~ /^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/) {
208         $TZ = $isdst ? $4 : $1;
209         $tzoff = sprintf("%05d", -($2) * 100);
210     }
211
212     # perl-4.036 doesn't have the $zone or $gmtoff...
213     ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $zone, $gmtoff) =
214         ($TZ eq 'GMT') ? gmtime(time) : localtime(time);
215
216     $year += ($year < 70) ? 2000 : 1900;
217
218     if ($gmtoff != 0) {
219         $tzoff = sprintf("%05d", ($gmtoff / 60) * 100);
220     }
221     if ($zone ne '') {
222         $TZ = $zone;
223     }
224
225     # ok, let's try....
226     $rfc822date = sprintf("%s, %2d %s %4d %2d:%02d:%02d %s (%s)",
227                           $DoW[$wday], $mday, $MoY[$mon], $year,
228                           $hour, $min, $sec, $tzoff, $TZ);
229
230     open(MAIL, "| $MAILER");
231     print MAIL "Date:     " . $rfc822date . "\n";
232     print MAIL "Subject:  CVS Update: " . $modulename . "\n";
233     print MAIL "To:       " . $mailto . "\n";
234     print MAIL "Reply-To: " . $replyto . "\n";
235     print MAIL "\n";
236     print MAIL join("\n", @text), "\n";
237     close(MAIL);
238 }
239
240 sub write_commitlog {
241     local($logfile, @text) = @_;
242
243     open(FILE, ">>$logfile");
244     print FILE join("\n", @text), "\n";
245     close(FILE);
246 }
247
248 #
249 #       Main Body
250 #
251
252 # Initialize basic variables
253 #
254 $debug = 0;
255 $id = getpgrp();                # note, you *must* use a shell which does setpgrp()
256 $state = $STATE_NONE;
257 $login = getlogin || (getpwuid($<))[0] || "nobody";
258 chop($hostname = `hostname`);
259 chop($domainname = `domainname`);
260 if ($domainname !~ '^\..*') {
261     $domainname = '.' . $domainname;
262 }
263 $hostdomain = $hostname . $domainname;
264 $cvsroot = $ENV{'CVSROOT'};
265 $do_status = 1;                 # moderately useful
266 $show_wd = 0;                   # useless in client/server
267 $modulename = "";
268
269 # parse command line arguments (file list is seen as one arg)
270 #
271 while (@ARGV) {
272     $arg = shift @ARGV;
273
274     if ($arg eq '-d') {
275         $debug = 1;
276         print STDERR "Debug turned on...\n";
277     } elsif ($arg eq '-m') {
278         if ($mailto eq '') {
279             $mailto = shift @ARGV;
280         } else {
281             $mailto = $mailto . ", " . shift @ARGV;
282         }
283     } elsif ($arg eq '-R') {
284         if ($replyto eq '') {
285             $replyto = shift @ARGV;
286         } else {
287             $replyto = $replyto . ", " . shift @ARGV;
288         }
289     } elsif ($arg eq '-M') {
290         $modulename = shift @ARGV;
291     } elsif ($arg eq '-s') {
292         $do_status = 0;
293     } elsif ($arg eq '-w') {
294         $show_wd = 1;
295     } elsif ($arg eq '-f') {
296         ($commitlog) && die("Too many '-f' args\n");
297         $commitlog = shift @ARGV;
298     } else {
299         ($donefiles) && die("Too many arguments!  Check usage.\n");
300         $donefiles = 1;
301         @files = split(/ /, $arg);
302     }
303 }
304 ($mailto) || die("No mail recipient specified (use -m)\n");
305 if ($replyto eq '') {
306     $replyto = $login;
307 }
308
309 # for now, the first "file" is the repository directory being committed,
310 # relative to the $CVSROOT location
311 #
312 @path = split('/', $files[0]);
313
314 # XXX There are some ugly assumptions in here about module names and
315 # XXX directories relative to the $CVSROOT location -- really should
316 # XXX read $CVSROOT/CVSROOT/modules, but that's not so easy to do, since
317 # XXX we have to parse it backwards.
318 # XXX
319 # XXX Fortunately it's relatively easy for the user to specify the
320 # XXX module name as appropriate with a '-M' via the directory
321 # XXX matching in loginfo.
322 #
323 if ($modulename eq "") {
324     $modulename = $path[0];     # I.e. the module name == top-level dir
325 }
326 if ($#path == 0) {
327     $dir = ".";
328 } else {
329     $dir = join('/', @path);
330 }
331 $dir = $dir . "/";
332
333 if ($debug) {
334     print STDERR "module - ", $modulename, "\n";
335     print STDERR "dir    - ", $dir, "\n";
336     print STDERR "path   - ", join(":", @path), "\n";
337     print STDERR "files  - ", join(":", @files), "\n";
338     print STDERR "id     - ", $id, "\n";
339 }
340
341 # Check for a new directory first.  This appears with files set as follows:
342 #
343 #    files[0] - "path/name/newdir"
344 #    files[1] - "-"
345 #    files[2] - "New"
346 #    files[3] - "directory"
347 #
348 if ($files[2] =~ /New/ && $files[3] =~ /directory/) {
349     local(@text);
350
351     @text = ();
352     push(@text, &build_header());
353     push(@text, "");
354     push(@text, $files[0]);
355     push(@text, "");
356
357     while (<STDIN>) {
358         chop;                   # Drop the newline
359         push(@text, $_);
360     }
361
362     &mail_notification($mailto, @text);
363
364     exit 0;
365 }
366
367 # Check for an import command.  This appears with files set as follows:
368 #
369 #    files[0] - "path/name"
370 #    files[1] - "-"
371 #    files[2] - "Imported"
372 #    files[3] - "sources"
373 #
374 if ($files[2] =~ /Imported/ && $files[3] =~ /sources/) {
375     local(@text);
376
377     @text = ();
378     push(@text, &build_header());
379     push(@text, "");
380     push(@text, $files[0]);
381     push(@text, "");
382
383     while (<STDIN>) {
384         chop;                   # Drop the newline
385         push(@text, $_);
386     }
387
388     &mail_notification(@text);
389
390     exit 0;
391 }
392
393 # Iterate over the body of the message collecting information.
394 #
395 while (<STDIN>) {
396     chop;                       # Drop the newline
397
398     if (/^In directory/) {
399         if ($show_wd) {         # useless in client/server mode
400             push(@log_lines, $_);
401             push(@log_lines, "");
402         }
403         next;
404     }
405
406     if (/^Modified Files/) { $state = $STATE_CHANGED; next; }
407     if (/^Added Files/)    { $state = $STATE_ADDED;   next; }
408     if (/^Removed Files/)  { $state = $STATE_REMOVED; next; }
409     if (/^Log Message/)    { $state = $STATE_LOG;     next; }
410
411     s/^[ \t\n]+//;              # delete leading whitespace
412     s/[ \t\n]+$//;              # delete trailing whitespace
413
414     if ($state == $STATE_CHANGED) { push(@changed_files, split); }
415     if ($state == $STATE_ADDED)   { push(@added_files,   split); }
416     if ($state == $STATE_REMOVED) { push(@removed_files, split); }
417     if ($state == $STATE_LOG)     {
418         if( /^See[ ]ChangeLog:[ ](.*)/ ) {
419             $changelog = $1;
420             $okay = false;
421             open(RCS, "-|") || exec 'cvs', '-Qn', 'update', '-p', 'ChangeLog';
422             while (<RCS>) {
423                 if( /^$changelog .*/ ) {
424                     $okay = true;
425                     push(@log_lines,     $_);
426                 }
427                 elsif( $okay ) {
428                     last if( /^[A-Z]+.*/ );
429                     push(@log_lines,     $_);
430                 }
431             }
432             while (<RCS>) { ; }
433             close(RCS);
434         }
435         else {
436             push(@log_lines, $_);
437         }
438     }
439 }
440
441 # Strip leading and trailing blank lines from the log message.  Also
442 # compress multiple blank lines in the body of the message down to a
443 # single blank line.
444 #
445 while ($#log_lines > -1) {
446     last if ($log_lines[0] ne "");
447     shift(@log_lines);
448 }
449 while ($#log_lines > -1) {
450     last if ($log_lines[$#log_lines] ne "");
451     pop(@log_lines);
452 }
453 for ($i = $#log_lines; $i > 0; $i--) {
454     if (($log_lines[$i - 1] eq "") && ($log_lines[$i] eq "")) {
455         splice(@log_lines, $i, 1);
456     }
457 }
458
459 if ($debug) {
460     print STDERR "Searching for log file index...";
461 }
462 # Find an index to a log file that matches this log message
463 #
464 for ($i = 0; ; $i++) {
465     local(@text);
466
467     last if (! -e "$LOG_FILE.$i.$id"); # the next available one
468     @text = &read_logfile("$LOG_FILE.$i.$id", "");
469     last if ($#text == -1);     # nothing in this file, use it
470     last if (join(" ", @log_lines) eq join(" ", @text)); # it's the same log message as another
471 }
472 if ($debug) {
473     print STDERR " found log file at $i.$id, now writing tmp files.\n";
474 }
475
476 # Spit out the information gathered in this pass.
477 #
478 &append_names_to_file("$CHANGED_FILE.$i.$id", $dir, @changed_files);
479 &append_names_to_file("$ADDED_FILE.$i.$id",   $dir, @added_files);
480 &append_names_to_file("$REMOVED_FILE.$i.$id", $dir, @removed_files);
481 &write_logfile("$LOG_FILE.$i.$id", @log_lines);
482
483 # Check whether this is the last directory.  If not, quit.
484 #
485 if ($debug) {
486     print STDERR "Checking current dir against last dir.\n";
487 }
488 $_ = &read_line("$LAST_FILE.$id");
489
490 if ($_ ne $cvsroot . "/" . $files[0]) {
491     if ($debug) {
492         print STDERR sprintf("Current directory %s is not last directory %s.\n", $cvsroot . "/" .$files[0], $_);
493     }
494     exit 0;
495 }
496 if ($debug) {
497     print STDERR sprintf("Current directory %s is last directory %s -- all commits done.\n", $files[0], $_);
498 }
499
500 #
501 #       End Of Commits!
502 #
503
504 # This is it.  The commits are all finished.  Lump everything together
505 # into a single message, fire a copy off to the mailing list, and drop
506 # it on the end of the Changes file.
507 #
508
509 #
510 # Produce the final compilation of the log messages
511 #
512 @text = ();
513 @status_txt = ();
514 push(@text, &build_header());
515 push(@text, "");
516
517 for ($i = 0; ; $i++) {
518     last if (! -e "$LOG_FILE.$i.$id"); # we're done them all!
519     @lines = &read_logfile("$CHANGED_FILE.$i.$id", "");
520     if ($#lines >= 0) {
521         push(@text, "Modified files:");
522         push(@text, &format_lists(@lines));
523     }
524     @lines = &read_logfile("$ADDED_FILE.$i.$id", "");
525     if ($#lines >= 0) {
526         push(@text, "Added files:");
527         push(@text, &format_lists(@lines));
528     }
529     @lines = &read_logfile("$REMOVED_FILE.$i.$id", "");
530     if ($#lines >= 0) {
531         push(@text, "Removed files:");
532         push(@text, &format_lists(@lines));
533     }
534     if ($#text >= 0) {
535         push(@text, "");
536     }
537     @lines = &read_logfile("$LOG_FILE.$i.$id", "\t");
538     if ($#lines >= 0) {
539         push(@text, "Log message:");
540         push(@text, @lines);
541         push(@text, "");
542     }
543     if ($do_status) {
544         local(@changed_files);
545
546         @changed_files = ();
547         push(@changed_files, &read_logfile("$CHANGED_FILE.$i.$id", ""));
548         push(@changed_files, &read_logfile("$ADDED_FILE.$i.$id", ""));
549         push(@changed_files, &read_logfile("$REMOVED_FILE.$i.$id", ""));
550
551         if ($debug) {
552             print STDERR "main: pre-sort changed_files = ", join(":", @changed_files), ".\n";
553         }
554         sort(@changed_files);
555         if ($debug) {
556             print STDERR "main: post-sort changed_files = ", join(":", @changed_files), ".\n";
557         }
558
559         foreach $dofile (@changed_files) {
560             if ($dofile =~ /\/$/) {
561                 next;           # ignore the silly "dir" entries
562             }
563             if ($debug) {
564                 print STDERR "main(): doing 'cvs -nQq status -v $dofile'\n";
565             }
566             open(STATUS, "-|") || exec 'cvs', '-nQq', 'status', '-v', $dofile;
567             while (<STATUS>) {
568                 chop;
569                 push(@status_txt, $_);
570             }
571         }
572     }
573 }
574
575 # Write to the commitlog file
576 #
577 if ($commitlog) {
578     &write_commitlog($commitlog, @text);
579 }
580
581 if ($#status_txt >= 0) {
582     push(@text, @status_txt);
583 }
584
585 # Mailout the notification.
586 #
587 &mail_notification(@text);
588
589 # cleanup
590 #
591 if (! $debug) {
592     &cleanup_tmpfiles();
593 }
594
595 exit 0;