Home | History | Annotate | Line # | Download | only in contrib
log_accum.in revision 1.1
      1  1.1  christos #! @PERL@ -T
      2  1.1  christos # -*-Perl-*-
      3  1.1  christos 
      4  1.1  christos # Copyright (C) 1994-2005 The Free Software Foundation, Inc.
      5  1.1  christos 
      6  1.1  christos # This program is free software; you can redistribute it and/or modify
      7  1.1  christos # it under the terms of the GNU General Public License as published by
      8  1.1  christos # the Free Software Foundation; either version 2, or (at your option)
      9  1.1  christos # any later version.
     10  1.1  christos #
     11  1.1  christos # This program is distributed in the hope that it will be useful,
     12  1.1  christos # but WITHOUT ANY WARRANTY; without even the implied warranty of
     13  1.1  christos # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     14  1.1  christos # GNU General Public License for more details.
     15  1.1  christos 
     16  1.1  christos ###############################################################################
     17  1.1  christos ###############################################################################
     18  1.1  christos ###############################################################################
     19  1.1  christos #
     20  1.1  christos # THIS SCRIPT IS PROBABLY BROKEN.  REMOVING THE -T SWITCH ON THE #! LINE ABOVE
     21  1.1  christos # WOULD FIX IT, BUT THIS IS INSECURE.  WE RECOMMEND FIXING THE ERRORS WHICH THE
     22  1.1  christos # -T SWITCH WILL CAUSE PERL TO REPORT BEFORE RUNNING THIS SCRIPT FROM A CVS
     23  1.1  christos # SERVER TRIGGER.  PLEASE SEND PATCHES CONTAINING THE CHANGES YOU FIND
     24  1.1  christos # NECESSARY TO RUN THIS SCRIPT WITH THE TAINT-CHECKING ENABLED BACK TO THE
     25  1.1  christos # <@PACKAGE_BUGREPORT@> MAILING LIST.
     26  1.1  christos #
     27  1.1  christos # For more on general Perl security and taint-checking, please try running the
     28  1.1  christos # `perldoc perlsec' command.
     29  1.1  christos #
     30  1.1  christos ###############################################################################
     31  1.1  christos ###############################################################################
     32  1.1  christos ###############################################################################
     33  1.1  christos 
     34  1.1  christos # Perl filter to handle the log messages from the checkin of files in
     35  1.1  christos # a directory.  This script will group the lists of files by log
     36  1.1  christos # message, and mail a single consolidated log message at the end of
     37  1.1  christos # the commit.
     38  1.1  christos #
     39  1.1  christos # This file assumes a pre-commit checking program that leaves the
     40  1.1  christos # names of the first and last commit directories in a temporary file.
     41  1.1  christos #
     42  1.1  christos # IMPORTANT: what the above means is, this script interacts with
     43  1.1  christos # commit_prep, in that they have to agree on the tmpfile name to use.
     44  1.1  christos # See $LAST_FILE below. 
     45  1.1  christos #
     46  1.1  christos # How this works: CVS triggers this script once for each directory
     47  1.1  christos # involved in the commit -- in other words, a single commit can invoke
     48  1.1  christos # this script N times.  It knows when it's on the last invocation by
     49  1.1  christos # examining the contents of $LAST_FILE.  Between invocations, it
     50  1.1  christos # caches information for its future incarnations in various temporary
     51  1.1  christos # files in /tmp, which are named according to the process group and
     52  1.1  christos # the committer (by themselves, neither of these are unique, but
     53  1.1  christos # together they almost always are, unless the same user is doing two
     54  1.1  christos # commits simultaneously).  The final invocation is the one that
     55  1.1  christos # actually sends the mail -- it gathers up the cached information,
     56  1.1  christos # combines that with what it found out on this pass, and sends a
     57  1.1  christos # commit message to the appropriate mailing list.
     58  1.1  christos #
     59  1.1  christos # (Ask Karl Fogel <kfogel (at] collab.net> if questions.)
     60  1.1  christos #
     61  1.1  christos # Contributed by David Hampton <hampton (at] cisco.com>
     62  1.1  christos # Roy Fielding removed useless code and added log/mail of new files
     63  1.1  christos # Ken Coar added special processing (i.e., no diffs) for binary files
     64  1.1  christos #
     65  1.1  christos 
     66  1.1  christos ############################################################
     67  1.1  christos #
     68  1.1  christos # Configurable options
     69  1.1  christos #
     70  1.1  christos ############################################################
     71  1.1  christos #
     72  1.1  christos # The newest versions of CVS have UseNewInfoFmtStrings=yes
     73  1.1  christos # to change the arguments being passed on the command line.
     74  1.1  christos # If you are using %1s on the command line, then set this
     75  1.1  christos # value to 0.
     76  1.1  christos # 0 = old-style %1s format. use split(' ') to separate ARGV into filesnames.
     77  1.1  christos # 1 = new-style %s format. Note: allows spaces in filenames.
     78  1.1  christos my $UseNewInfoFmtStrings = 0;
     79  1.1  christos 
     80  1.1  christos #
     81  1.1  christos # Where do you want the RCS ID and delta info?
     82  1.1  christos # 0 = none,
     83  1.1  christos # 1 = in mail only,
     84  1.1  christos # 2 = in both mail and logs.
     85  1.1  christos #
     86  1.1  christos $rcsidinfo = 2;
     87  1.1  christos 
     88  1.1  christos #if you are using CVS web then set this to some value... if not set it to ""
     89  1.1  christos #
     90  1.1  christos # When set properly, this will cause links to aspects of the project to
     91  1.1  christos # print in the commit emails.
     92  1.1  christos #$CVSWEB_SCHEME = "http";
     93  1.1  christos #$CVSWEB_DOMAIN = "nongnu.org";
     94  1.1  christos #$CVSWEB_PORT = "80";
     95  1.1  christos #$CVSWEB_URI = "source/browse/";
     96  1.1  christos #$SEND_URL = "true";
     97  1.1  christos $SEND_DIFF = "true";
     98  1.1  christos 
     99  1.1  christos 
    100  1.1  christos # Set this to a domain to have CVS pretend that all users who make
    101  1.1  christos # commits have mail accounts within that domain.
    102  1.1  christos #$EMULATE_LOCAL_MAIL_USER="nongnu.org"; 
    103  1.1  christos 
    104  1.1  christos # Set this to '-c' for context diffs; defaults to '-u' for unidiff format.
    105  1.1  christos $difftype = '-uN';
    106  1.1  christos 
    107  1.1  christos ############################################################
    108  1.1  christos #
    109  1.1  christos # Constants
    110  1.1  christos #
    111  1.1  christos ############################################################
    112  1.1  christos $STATE_NONE    = 0;
    113  1.1  christos $STATE_CHANGED = 1;
    114  1.1  christos $STATE_ADDED   = 2;
    115  1.1  christos $STATE_REMOVED = 3;
    116  1.1  christos $STATE_LOG     = 4;
    117  1.1  christos 
    118  1.1  christos $TMPDIR        = $ENV{'TMPDIR'} || '/tmp';
    119  1.1  christos $FILE_PREFIX   = '#cvs.';
    120  1.1  christos 
    121  1.1  christos $LAST_FILE     = "$TMPDIR/${FILE_PREFIX}lastdir";  # Created by commit_prep!
    122  1.1  christos $ADDED_FILE    = "$TMPDIR/${FILE_PREFIX}files.added";
    123  1.1  christos $REMOVED_FILE  = "$TMPDIR/${FILE_PREFIX}files.removed";
    124  1.1  christos $LOG_FILE      = "$TMPDIR/${FILE_PREFIX}files.log";
    125  1.1  christos $BRANCH_FILE   = "$TMPDIR/${FILE_PREFIX}files.branch";
    126  1.1  christos $MLIST_FILE    = "$TMPDIR/${FILE_PREFIX}files.mlist";
    127  1.1  christos $SUMMARY_FILE  = "$TMPDIR/${FILE_PREFIX}files.summary";
    128  1.1  christos 
    129  1.1  christos $CVSROOT       = $ENV{'CVSROOT'};
    130  1.1  christos 
    131  1.1  christos $MAIL_CMD      = "| /usr/lib/sendmail -i -t";
    132  1.1  christos #$MAIL_CMD      = "| /var/qmail/bin/qmail-inject";
    133  1.1  christos $MAIL_FROM     = 'commitlogger';  #not needed if EMULATE_LOCAL_MAIL_USER
    134  1.1  christos $SUBJECT_PRE   = 'CVS update:';
    135  1.1  christos 
    136  1.1  christos 
    137  1.1  christos ############################################################
    138  1.1  christos #
    139  1.1  christos # Subroutines
    140  1.1  christos #
    141  1.1  christos ############################################################
    142  1.1  christos 
    143  1.1  christos sub format_names {
    144  1.1  christos     local($dir, @files) = @_;
    145  1.1  christos     local(@lines);
    146  1.1  christos 
    147  1.1  christos     $lines[0] = sprintf(" %-08s", $dir);
    148  1.1  christos     foreach $file (@files) {
    149  1.1  christos         if (length($lines[$#lines]) + length($file) > 60) {
    150  1.1  christos             $lines[++$#lines] = sprintf(" %8s", " ");
    151  1.1  christos         }
    152  1.1  christos         $lines[$#lines] .= " ".$file;
    153  1.1  christos     }
    154  1.1  christos     @lines;
    155  1.1  christos }
    156  1.1  christos 
    157  1.1  christos sub cleanup_tmpfiles {
    158  1.1  christos     local(@files);
    159  1.1  christos 
    160  1.1  christos     opendir(DIR, $TMPDIR);
    161  1.1  christos     push(@files, grep(/^${FILE_PREFIX}.*\.${id}\.${cvs_user}$/, readdir(DIR)));
    162  1.1  christos     closedir(DIR);
    163  1.1  christos     foreach (@files) {
    164  1.1  christos         unlink "$TMPDIR/$_";
    165  1.1  christos     }
    166  1.1  christos }
    167  1.1  christos 
    168  1.1  christos sub write_logfile {
    169  1.1  christos     local($filename, @lines) = @_;
    170  1.1  christos 
    171  1.1  christos     open(FILE, ">$filename") || die ("Cannot open log file $filename: $!\n");
    172  1.1  christos     print(FILE join("\n", @lines), "\n");
    173  1.1  christos     close(FILE);
    174  1.1  christos }
    175  1.1  christos 
    176  1.1  christos sub append_to_file {
    177  1.1  christos     local($filename, $dir, @files) = @_;
    178  1.1  christos 
    179  1.1  christos     if (@files) {
    180  1.1  christos         local(@lines) = &format_names($dir, @files);
    181  1.1  christos         open(FILE, ">>$filename") || die ("Cannot open file $filename: $!\n");
    182  1.1  christos         print(FILE join("\n", @lines), "\n");
    183  1.1  christos         close(FILE);
    184  1.1  christos     }
    185  1.1  christos }
    186  1.1  christos 
    187  1.1  christos sub write_line {
    188  1.1  christos     local($filename, $line) = @_;
    189  1.1  christos 
    190  1.1  christos     open(FILE, ">$filename") || die("Cannot open file $filename: $!\n");
    191  1.1  christos     print(FILE $line, "\n");
    192  1.1  christos     close(FILE);
    193  1.1  christos }
    194  1.1  christos 
    195  1.1  christos sub append_line {
    196  1.1  christos     local($filename, $line) = @_;
    197  1.1  christos 
    198  1.1  christos     open(FILE, ">>$filename") || die("Cannot open file $filename: $!\n");
    199  1.1  christos     print(FILE $line, "\n");
    200  1.1  christos     close(FILE);
    201  1.1  christos }
    202  1.1  christos 
    203  1.1  christos sub read_line {
    204  1.1  christos     local($filename) = @_;
    205  1.1  christos     local($line);
    206  1.1  christos 
    207  1.1  christos     open(FILE, "<$filename") || die("Cannot open file $filename: $!\n");
    208  1.1  christos     $line = <FILE>;
    209  1.1  christos     close(FILE);
    210  1.1  christos     chomp($line);
    211  1.1  christos     $line;
    212  1.1  christos }
    213  1.1  christos 
    214  1.1  christos sub read_line_nodie {
    215  1.1  christos     local($filename) = @_;
    216  1.1  christos     local($line);
    217  1.1  christos     open(FILE, "<$filename") || return ("");
    218  1.1  christos 
    219  1.1  christos     $line = <FILE>;
    220  1.1  christos     close(FILE);
    221  1.1  christos     chomp($line);
    222  1.1  christos     $line;
    223  1.1  christos }
    224  1.1  christos 
    225  1.1  christos sub read_file_lines {
    226  1.1  christos     local($filename) = @_;
    227  1.1  christos     local(@text) = ();
    228  1.1  christos 
    229  1.1  christos     open(FILE, "<$filename") || return ();
    230  1.1  christos     while (<FILE>) {
    231  1.1  christos         chomp;
    232  1.1  christos         push(@text, $_);
    233  1.1  christos     }
    234  1.1  christos     close(FILE);
    235  1.1  christos     @text;
    236  1.1  christos }
    237  1.1  christos 
    238  1.1  christos sub read_file {
    239  1.1  christos     local($filename, $leader) = @_;
    240  1.1  christos     local(@text) = ();
    241  1.1  christos 
    242  1.1  christos     open(FILE, "<$filename") || return ();
    243  1.1  christos     while (<FILE>) {
    244  1.1  christos         chomp;
    245  1.1  christos         push(@text, sprintf("  %-10s  %s", $leader, $_));
    246  1.1  christos         $leader = "";
    247  1.1  christos     }
    248  1.1  christos     close(FILE);
    249  1.1  christos     @text;
    250  1.1  christos }
    251  1.1  christos 
    252  1.1  christos sub read_logfile {
    253  1.1  christos     local($filename, $leader) = @_;
    254  1.1  christos     local(@text) = ();
    255  1.1  christos 
    256  1.1  christos     open(FILE, "<$filename") || die ("Cannot open log file $filename: $!\n");
    257  1.1  christos     while (<FILE>) {
    258  1.1  christos         chomp;
    259  1.1  christos         push(@text, $leader.$_);
    260  1.1  christos     }
    261  1.1  christos     close(FILE);
    262  1.1  christos     @text;
    263  1.1  christos }
    264  1.1  christos 
    265  1.1  christos #
    266  1.1  christos # do an 'cvs -Qn status' on each file in the arguments, and extract info.
    267  1.1  christos #
    268  1.1  christos sub change_summary {
    269  1.1  christos     local($out, @filenames) = @_;
    270  1.1  christos     local(@revline);
    271  1.1  christos     local($file, $rev, $rcsfile, $line, $vhost, $cvsweb_base);
    272  1.1  christos 
    273  1.1  christos     while (@filenames) {
    274  1.1  christos         $file = shift @filenames;
    275  1.1  christos 
    276  1.1  christos         if ("$file" eq "") {
    277  1.1  christos             next;
    278  1.1  christos         }
    279  1.1  christos 
    280  1.1  christos         open(RCS, "-|") || exec "$cvsbin/cvs", '-Qn', 'status', '--', $file;
    281  1.1  christos 
    282  1.1  christos         $rev = "";
    283  1.1  christos         $delta = "";
    284  1.1  christos         $rcsfile = "";
    285  1.1  christos 
    286  1.1  christos 
    287  1.1  christos         while (<RCS>) {
    288  1.1  christos             if (/^[ \t]*Repository revision/) {
    289  1.1  christos                 chomp;
    290  1.1  christos                 @revline = split(' ', $_);
    291  1.1  christos                 $rev = $revline[2];
    292  1.1  christos                 $rcsfile = $revline[3];
    293  1.1  christos                 $rcsfile =~ s,^$CVSROOT/,,;
    294  1.1  christos                 $rcsfile =~ s/,v$//;
    295  1.1  christos             }
    296  1.1  christos         }
    297  1.1  christos         close(RCS);
    298  1.1  christos 
    299  1.1  christos 
    300  1.1  christos         if ($rev ne '' && $rcsfile ne '') {
    301  1.1  christos             open(RCS, "-|") || exec "$cvsbin/cvs", '-Qn', 'log', "-r$rev",
    302  1.1  christos 				    '--', $file;
    303  1.1  christos             while (<RCS>) {
    304  1.1  christos                 if (/^date:.*lines:([^;]+);.*/) {
    305  1.1  christos                     $delta = $1;
    306  1.1  christos                     last;
    307  1.1  christos                 }
    308  1.1  christos             }
    309  1.1  christos             close(RCS);
    310  1.1  christos         }
    311  1.1  christos 
    312  1.1  christos         $diff = "\n\n";
    313  1.1  christos         $vhost = $path[0];
    314  1.1  christos         if ($CVSWEB_PORT eq "80") {
    315  1.1  christos           $cvsweb_base = "$CVSWEB_SCHEME://$vhost.$CVSWEB_DOMAIN/$CVSWEB_URI";
    316  1.1  christos         }
    317  1.1  christos         else {
    318  1.1  christos           $cvsweb_base = "$CVSWEB_SCHEME://$vhost.$CVSWEB_DOMAIN:$CVSWEB_PORT/$CVSWEB_URI";
    319  1.1  christos         }
    320  1.1  christos         if ($SEND_URL eq "true") {
    321  1.1  christos           $diff .= $cvsweb_base . join("/", @path) . "/$file";
    322  1.1  christos         }
    323  1.1  christos 
    324  1.1  christos         #
    325  1.1  christos         # If this is a binary file, don't try to report a diff; not only is
    326  1.1  christos         # it meaningless, but it also screws up some mailers.  We rely on
    327  1.1  christos         # Perl's 'is this binary' algorithm; it's pretty good.  But not
    328  1.1  christos         # perfect.
    329  1.1  christos         #
    330  1.1  christos         if (($file =~ /\.(?:pdf|gif|jpg|mpg)$/i) || (-B $file)) {
    331  1.1  christos           if ($SEND_URL eq "true") {
    332  1.1  christos             $diff .= "?rev=$rev&content-type=text/x-cvsweb-markup\n\n";
    333  1.1  christos           }
    334  1.1  christos           if ($SEND_DIFF eq "true") {
    335  1.1  christos             $diff .= "\t<<Binary file>>\n\n";
    336  1.1  christos           }
    337  1.1  christos         }
    338  1.1  christos         else {
    339  1.1  christos             #
    340  1.1  christos             # Get the differences between this and the previous revision,
    341  1.1  christos             # being aware that new files always have revision '1.1' and
    342  1.1  christos             # new branches always end in '.n.1'.
    343  1.1  christos             #
    344  1.1  christos             if ($rev =~ /^(.*)\.([0-9]+)$/) {
    345  1.1  christos                 $prev = $2 - 1;
    346  1.1  christos                 $prev_rev = $1 . '.' .  $prev;
    347  1.1  christos 
    348  1.1  christos                 $prev_rev =~ s/\.[0-9]+\.0$//;# Truncate if first rev on branch
    349  1.1  christos 
    350  1.1  christos                 if ($rev eq '1.1') {
    351  1.1  christos                   if ($SEND_URL eq "true") {
    352  1.1  christos                     $diff .= "?rev=$rev&content-type=text/x-cvsweb-markup\n\n";
    353  1.1  christos                   }
    354  1.1  christos                   if ($SEND_DIFF eq "true") {
    355  1.1  christos                     open(DIFF, "-|")
    356  1.1  christos                       || exec "$cvsbin/cvs", '-Qn', 'update', '-p', '-r1.1',
    357  1.1  christos 			      '--', $file;
    358  1.1  christos                     $diff .= "Index: $file\n=================================="
    359  1.1  christos                       . "=================================\n";
    360  1.1  christos                   }
    361  1.1  christos                 }
    362  1.1  christos                 else {
    363  1.1  christos                   if ($SEND_URL eq "true") {
    364  1.1  christos                     $diff .= ".diff?r1=$prev_rev&r2=$rev\n\n";
    365  1.1  christos                   }
    366  1.1  christos                   if ($SEND_DIFF eq "true") {
    367  1.1  christos                     $diff .= "(In the diff below, changes in quantity "
    368  1.1  christos                       . "of whitespace are not shown.)\n\n";
    369  1.1  christos                     open(DIFF, "-|")
    370  1.1  christos                       || exec "$cvsbin/cvs", '-Qn', 'diff', "$difftype",
    371  1.1  christos                       '-b', "-r$prev_rev", "-r$rev", '--', $file;
    372  1.1  christos                   }
    373  1.1  christos                 }
    374  1.1  christos 
    375  1.1  christos                 if ($SEND_DIFF eq "true") {
    376  1.1  christos                   while (<DIFF>) {
    377  1.1  christos                     $diff .= $_;
    378  1.1  christos                   }
    379  1.1  christos                   close(DIFF);
    380  1.1  christos                 }
    381  1.1  christos                 $diff .= "\n\n";
    382  1.1  christos             }
    383  1.1  christos         }
    384  1.1  christos 
    385  1.1  christos         &append_line($out, sprintf("%-9s%-12s%s%s", $rev, $delta,
    386  1.1  christos                                    $rcsfile, $diff));
    387  1.1  christos     }
    388  1.1  christos }
    389  1.1  christos 
    390  1.1  christos 
    391  1.1  christos sub build_header {
    392  1.1  christos     local($header);
    393  1.1  christos     delete $ENV{'TZ'};
    394  1.1  christos     local($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
    395  1.1  christos 
    396  1.1  christos     $header = sprintf("  User: %-8s\n  Date: %02d/%02d/%02d %02d:%02d:%02d",
    397  1.1  christos                        $cvs_user, $year%100, $mon+1, $mday,
    398  1.1  christos                        $hour, $min, $sec);
    399  1.1  christos #    $header = sprintf("%-8s    %02d/%02d/%02d %02d:%02d:%02d",
    400  1.1  christos #                       $login, $year%100, $mon+1, $mday,
    401  1.1  christos #                       $hour, $min, $sec);
    402  1.1  christos }
    403  1.1  christos 
    404  1.1  christos # !!! Destination Mailing-list and history file mappings here !!!
    405  1.1  christos 
    406  1.1  christos #sub mlist_map
    407  1.1  christos #{
    408  1.1  christos #    local($path) = @_;
    409  1.1  christos #    my $domain = "nongnu.org";
    410  1.1  christos #    
    411  1.1  christos #    if ($path =~ /^([^\/]+)/) {
    412  1.1  christos #        return "cvs\@$1.$domain";
    413  1.1  christos #    } else {
    414  1.1  christos #        return "cvs\@$domain";
    415  1.1  christos #    }
    416  1.1  christos #}    
    417  1.1  christos 
    418  1.1  christos sub derive_subject_from_changes_file ()
    419  1.1  christos {
    420  1.1  christos   my $subj = "";
    421  1.1  christos 
    422  1.1  christos   for ($i = 0; ; $i++)
    423  1.1  christos   {
    424  1.1  christos     open (CH, "<$CHANGED_FILE.$i.$id.$cvs_user") or last;
    425  1.1  christos 
    426  1.1  christos     while (my $change = <CH>)
    427  1.1  christos     {
    428  1.1  christos       # A changes file looks like this:
    429  1.1  christos       #
    430  1.1  christos       #  src      foo.c newfile.html
    431  1.1  christos       #  www      index.html project_nav.html
    432  1.1  christos       #
    433  1.1  christos       # Each line is " Dir File1 File2 ..."
    434  1.1  christos       # We only care about Dir, since the subject line should
    435  1.1  christos       # summarize. 
    436  1.1  christos       
    437  1.1  christos       $change =~ s/^[ \t]*//;
    438  1.1  christos       $change =~ /^([^ \t]+)[ \t]*/;
    439  1.1  christos       my $dir = $1;
    440  1.1  christos       # Fold to rightmost directory component
    441  1.1  christos       $dir =~ /([^\/]+)$/;
    442  1.1  christos       $dir = $1;
    443  1.1  christos       if ($subj eq "") {
    444  1.1  christos         $subj = $dir;
    445  1.1  christos       } else {
    446  1.1  christos         $subj .= ", $dir"; 
    447  1.1  christos       }
    448  1.1  christos     }
    449  1.1  christos     close (CH);
    450  1.1  christos   }
    451  1.1  christos 
    452  1.1  christos   if ($subj ne "") {
    453  1.1  christos       $subj = "MODIFIED: $subj ..."; 
    454  1.1  christos   }
    455  1.1  christos   else {
    456  1.1  christos       # NPM: See if there's any file-addition notifications.
    457  1.1  christos       my $added = &read_line_nodie("$ADDED_FILE.$i.$id.$cvs_user");
    458  1.1  christos       if ($added ne "") {
    459  1.1  christos           $subj .= "ADDED: $added "; 
    460  1.1  christos       }
    461  1.1  christos     
    462  1.1  christos #    print "derive_subject_from_changes_file().. added== $added \n";
    463  1.1  christos     
    464  1.1  christos        ## NPM: See if there's any file-removal notications.
    465  1.1  christos       my $removed = &read_line_nodie("$REMOVED_FILE.$i.$id.$cvs_user");
    466  1.1  christos       if ($removed ne "") {
    467  1.1  christos           $subj .= "REMOVED: $removed "; 
    468  1.1  christos       }
    469  1.1  christos     
    470  1.1  christos #    print "derive_subject_from_changes_file().. removed== $removed \n";
    471  1.1  christos     
    472  1.1  christos       ## NPM: See if there's any branch notifications.
    473  1.1  christos       my $branched = &read_line_nodie("$BRANCH_FILE.$i.$id.$cvs_user");
    474  1.1  christos       if ($branched ne "") {
    475  1.1  christos           $subj .= "BRANCHED: $branched"; 
    476  1.1  christos       }
    477  1.1  christos     
    478  1.1  christos #    print "derive_subject_from_changes_file().. branched== $branched \n";
    479  1.1  christos     
    480  1.1  christos       ## NPM: DEFAULT: DIRECTORY CREATION (c.f. "Check for a new directory first" in main mody)
    481  1.1  christos       if ($subj eq "") {
    482  1.1  christos           my $subject = join("/", @path);
    483  1.1  christos           $subj = "NEW: $subject"; 
    484  1.1  christos       }    
    485  1.1  christos   }
    486  1.1  christos 
    487  1.1  christos   return $subj;
    488  1.1  christos }
    489  1.1  christos 
    490  1.1  christos sub mail_notification
    491  1.1  christos {
    492  1.1  christos     local($addr_list, @text) = @_;
    493  1.1  christos     local($mail_to);
    494  1.1  christos 
    495  1.1  christos     my $subj = &derive_subject_from_changes_file ();
    496  1.1  christos 
    497  1.1  christos     if ($EMULATE_LOCAL_MAIL_USER ne "") {
    498  1.1  christos         $MAIL_FROM = "$cvs_user\@$EMULATE_LOCAL_MAIL_USER";
    499  1.1  christos     }
    500  1.1  christos 
    501  1.1  christos     $mail_to = join(", ", @{$addr_list});
    502  1.1  christos 
    503  1.1  christos     print "Mailing the commit message to $mail_to (from $MAIL_FROM)\n";
    504  1.1  christos 
    505  1.1  christos     $ENV{'MAILUSER'} = $MAIL_FROM;
    506  1.1  christos     # Commented out on hocus, so comment it out here.  -kff
    507  1.1  christos     # $ENV{'QMAILINJECT'} = 'f';
    508  1.1  christos 
    509  1.1  christos     open(MAIL, "$MAIL_CMD -f$MAIL_FROM");
    510  1.1  christos     print MAIL "From: $MAIL_FROM\n";
    511  1.1  christos     print MAIL "To: $mail_to\n";
    512  1.1  christos     print MAIL "Subject: $SUBJECT_PRE $subj\n\n";
    513  1.1  christos     print(MAIL join("\n", @text));
    514  1.1  christos     close(MAIL);
    515  1.1  christos #    print "Mailing the commit message to $MAIL_TO...\n";
    516  1.1  christos #
    517  1.1  christos #    #added by jrobbins (at] collab.net 1999/12/15
    518  1.1  christos #    # attempt to get rid of anonymous
    519  1.1  christos #    $ENV{'MAILUSER'} = 'commitlogger';
    520  1.1  christos #    $ENV{'QMAILINJECT'} = 'f';
    521  1.1  christos #
    522  1.1  christos #    open(MAIL, "| /var/qmail/bin/qmail-inject");
    523  1.1  christos #    print(MAIL "To: $MAIL_TO\n"); 
    524  1.1  christos #    print(MAIL "Subject: cvs commit: $ARGV[0]\n"); 
    525  1.1  christos #    print(MAIL join("\n", @text));
    526  1.1  christos #    close(MAIL);
    527  1.1  christos }
    528  1.1  christos 
    529  1.1  christos ## process the command line arguments sent to this script
    530  1.1  christos ## it returns an array of files, %s, sent from the loginfo
    531  1.1  christos ## command
    532  1.1  christos sub process_argv
    533  1.1  christos {
    534  1.1  christos     local(@argv) = @_;
    535  1.1  christos     local(@files);
    536  1.1  christos     local($arg);
    537  1.1  christos     print "Processing log script arguments...\n";
    538  1.1  christos 
    539  1.1  christos     if ($UseNewInfoFmtStrings) {
    540  1.1  christos         while (@argv) {
    541  1.1  christos             $arg = shift @argv;
    542  1.1  christos 
    543  1.1  christos             if ($arg eq '-u' && !defined($cvs_user)) {
    544  1.1  christos                 $cvs_user = shift @argv;
    545  1.1  christos             }
    546  1.1  christos             if ($arg eq '- New directory') {
    547  1.1  christos                 $new_directory = 1;
    548  1.1  christos             } elsif ($arg eq '- Imported sources') {
    549  1.1  christos                 $imported_sources = 1;
    550  1.1  christos             } else {
    551  1.1  christos                 push(@files, $arg);
    552  1.1  christos             }
    553  1.1  christos         }
    554  1.1  christos     } else {
    555  1.1  christos         while (@argv) {
    556  1.1  christos             $arg = shift @argv;
    557  1.1  christos 
    558  1.1  christos             if ($arg eq '-u') {
    559  1.1  christos                 $cvs_user = shift @argv;
    560  1.1  christos             } else {
    561  1.1  christos                 ($donefiles) && die "Too many arguments!\n";
    562  1.1  christos                 $donefiles = 1;
    563  1.1  christos                 $ARGV[0] = $arg;
    564  1.1  christos                 if ($arg =~ s/ - New directory//) {
    565  1.1  christos                     $new_directory = 1;
    566  1.1  christos                 } elsif ($arg =~ s/ - Imported sources//) {
    567  1.1  christos                     $imported_sources = 1;
    568  1.1  christos                 }
    569  1.1  christos                 @files = split(' ', $arg);
    570  1.1  christos             }
    571  1.1  christos         }
    572  1.1  christos     }
    573  1.1  christos     return @files;
    574  1.1  christos }
    575  1.1  christos 
    576  1.1  christos 
    577  1.1  christos #############################################################
    578  1.1  christos #
    579  1.1  christos # Main Body
    580  1.1  christos #
    581  1.1  christos ############################################################
    582  1.1  christos #
    583  1.1  christos # Setup environment
    584  1.1  christos #
    585  1.1  christos umask (002);
    586  1.1  christos 
    587  1.1  christos # Connect to the database
    588  1.1  christos $cvsbin = "/usr/bin";
    589  1.1  christos 
    590  1.1  christos #
    591  1.1  christos # Initialize basic variables
    592  1.1  christos #
    593  1.1  christos $id = getpgrp();
    594  1.1  christos $state = $STATE_NONE;
    595  1.1  christos $cvs_user = $ENV{'USER'} || getlogin || (getpwuid($<))[0] || sprintf("uid#%d",$<);
    596  1.1  christos $new_directory = 0;             # Is this a 'cvs add directory' command?
    597  1.1  christos $imported_sources = 0;          # Is this a 'cvs import' command?
    598  1.1  christos @files = process_argv(@ARGV);
    599  1.1  christos @path = split('/', $files[0]);
    600  1.1  christos if ($#path == 0) {
    601  1.1  christos     $dir = ".";
    602  1.1  christos } else {
    603  1.1  christos     $dir = join('/', @path[1..$#path]);
    604  1.1  christos }
    605  1.1  christos #print("ARGV  - ", join(":", @ARGV), "\n");
    606  1.1  christos #print("files - ", join(":", @files), "\n");
    607  1.1  christos #print("path  - ", join(":", @path), "\n");
    608  1.1  christos #print("dir   - ", $dir, "\n");
    609  1.1  christos #print("id    - ", $id, "\n");
    610  1.1  christos 
    611  1.1  christos #
    612  1.1  christos # Map the repository directory to an email address for commitlogs to be sent
    613  1.1  christos # to.
    614  1.1  christos #
    615  1.1  christos #$mlist = &mlist_map($files[0]);
    616  1.1  christos 
    617  1.1  christos ##########################
    618  1.1  christos #
    619  1.1  christos # Check for a new directory first.  This will always appear as a
    620  1.1  christos # single item in the argument list, and an empty log message.
    621  1.1  christos #
    622  1.1  christos if ($new_directory) {
    623  1.1  christos     $header = &build_header;
    624  1.1  christos     @text = ();
    625  1.1  christos     push(@text, $header);
    626  1.1  christos     push(@text, "");
    627  1.1  christos     push(@text, "  ".$files[0]." - New directory");
    628  1.1  christos     &mail_notification([ $mlist ], @text);
    629  1.1  christos     exit 0;
    630  1.1  christos }
    631  1.1  christos 
    632  1.1  christos #
    633  1.1  christos # Iterate over the body of the message collecting information.
    634  1.1  christos #
    635  1.1  christos while (<STDIN>) {
    636  1.1  christos     chomp;                      # Drop the newline
    637  1.1  christos     if (/^Revision\/Branch:/) {
    638  1.1  christos         s,^Revision/Branch:,,;
    639  1.1  christos         push (@branch_lines, split);
    640  1.1  christos         next;
    641  1.1  christos     }
    642  1.1  christos #    next if (/^[ \t]+Tag:/ && $state != $STATE_LOG);
    643  1.1  christos     if (/^Modified Files/) { $state = $STATE_CHANGED; next; }
    644  1.1  christos     if (/^Added Files/)    { $state = $STATE_ADDED;   next; }
    645  1.1  christos     if (/^Removed Files/)  { $state = $STATE_REMOVED; next; }
    646  1.1  christos     if (/^Log Message/)    { $state = $STATE_LOG;     last; }
    647  1.1  christos     s/[ \t\n]+$//;              # delete trailing space
    648  1.1  christos     
    649  1.1  christos     push (@changed_files, split) if ($state == $STATE_CHANGED);
    650  1.1  christos     push (@added_files,   split) if ($state == $STATE_ADDED);
    651  1.1  christos     push (@removed_files, split) if ($state == $STATE_REMOVED);
    652  1.1  christos }
    653  1.1  christos # Proces the /Log Message/ section now, if it exists.
    654  1.1  christos # Do this here rather than above to deal with Log messages
    655  1.1  christos # that include lines that confuse the state machine.
    656  1.1  christos if (!eof(STDIN)) {
    657  1.1  christos     while (<STDIN>) {
    658  1.1  christos         next unless ($state == $STATE_LOG); # eat all STDIN
    659  1.1  christos 
    660  1.1  christos         if ($state == $STATE_LOG) {
    661  1.1  christos             if (/^PR:$/i ||
    662  1.1  christos                 /^Reviewed by:$/i ||
    663  1.1  christos                 /^Submitted by:$/i ||
    664  1.1  christos                 /^Obtained from:$/i) {
    665  1.1  christos                 next;
    666  1.1  christos             }
    667  1.1  christos             push (@log_lines,     $_);
    668  1.1  christos         }
    669  1.1  christos     }
    670  1.1  christos }
    671  1.1  christos 
    672  1.1  christos #
    673  1.1  christos # Strip leading and trailing blank lines from the log message.  Also
    674  1.1  christos # compress multiple blank lines in the body of the message down to a
    675  1.1  christos # single blank line.
    676  1.1  christos # (Note, this only does the mail and changes log, not the rcs log).
    677  1.1  christos #
    678  1.1  christos while ($#log_lines > -1) {
    679  1.1  christos     last if ($log_lines[0] ne "");
    680  1.1  christos     shift(@log_lines);
    681  1.1  christos }
    682  1.1  christos while ($#log_lines > -1) {
    683  1.1  christos     last if ($log_lines[$#log_lines] ne "");
    684  1.1  christos     pop(@log_lines);
    685  1.1  christos }
    686  1.1  christos for ($i = $#log_lines; $i > 0; $i--) {
    687  1.1  christos     if (($log_lines[$i - 1] eq "") && ($log_lines[$i] eq "")) {
    688  1.1  christos         splice(@log_lines, $i, 1);
    689  1.1  christos     }
    690  1.1  christos }
    691  1.1  christos 
    692  1.1  christos #
    693  1.1  christos # Find the log file that matches this log message
    694  1.1  christos #
    695  1.1  christos for ($i = 0; ; $i++) {
    696  1.1  christos     last if (! -e "$LOG_FILE.$i.$id.$cvs_user");
    697  1.1  christos     @text = &read_logfile("$LOG_FILE.$i.$id.$cvs_user", "");
    698  1.1  christos     last if ($#text == -1);
    699  1.1  christos     last if (join(" ", @log_lines) eq join(" ", @text));
    700  1.1  christos }
    701  1.1  christos 
    702  1.1  christos #
    703  1.1  christos # Spit out the information gathered in this pass.
    704  1.1  christos #
    705  1.1  christos &write_logfile("$LOG_FILE.$i.$id.$cvs_user", @log_lines);
    706  1.1  christos &append_to_file("$BRANCH_FILE.$i.$id.$cvs_user",  $dir, @branch_lines);
    707  1.1  christos &append_to_file("$ADDED_FILE.$i.$id.$cvs_user",   $dir, @added_files);
    708  1.1  christos &append_to_file("$CHANGED_FILE.$i.$id.$cvs_user", $dir, @changed_files);
    709  1.1  christos &append_to_file("$REMOVED_FILE.$i.$id.$cvs_user", $dir, @removed_files);
    710  1.1  christos &append_line("$MLIST_FILE.$i.$id.$cvs_user", $mlist);
    711  1.1  christos if ($rcsidinfo) {
    712  1.1  christos     &change_summary("$SUMMARY_FILE.$i.$id.$cvs_user", (@changed_files, @added_files));
    713  1.1  christos }
    714  1.1  christos 
    715  1.1  christos #
    716  1.1  christos # Check whether this is the last directory.  If not, quit.
    717  1.1  christos #
    718  1.1  christos if (-e "$LAST_FILE.$id.$cvs_user") {
    719  1.1  christos    $_ = &read_line("$LAST_FILE.$id.$cvs_user");
    720  1.1  christos    $tmpfiles = $files[0];
    721  1.1  christos    $tmpfiles =~ s,([^a-zA-Z0-9_/]),\\$1,g;
    722  1.1  christos    if (! grep(/$tmpfiles$/, $_)) {
    723  1.1  christos         print "More commits to come...\n";
    724  1.1  christos         exit 0
    725  1.1  christos    }
    726  1.1  christos }
    727  1.1  christos 
    728  1.1  christos #
    729  1.1  christos # This is it.  The commits are all finished.  Lump everything together
    730  1.1  christos # into a single message, fire a copy off to the mailing list, and drop
    731  1.1  christos # it on the end of the Changes file.
    732  1.1  christos #
    733  1.1  christos $header = &build_header;
    734  1.1  christos 
    735  1.1  christos #
    736  1.1  christos # Produce the final compilation of the log messages
    737  1.1  christos #
    738  1.1  christos @text = ();
    739  1.1  christos @mlist_list = ();
    740  1.1  christos push(@text, $header);
    741  1.1  christos push(@text, "");
    742  1.1  christos for ($i = 0; ; $i++) {
    743  1.1  christos     last if (! -e "$LOG_FILE.$i.$id.$cvs_user");
    744  1.1  christos     push(@text, &read_file("$BRANCH_FILE.$i.$id.$cvs_user", "Branch:"));
    745  1.1  christos     push(@text, &read_file("$CHANGED_FILE.$i.$id.$cvs_user", "Modified:"));
    746  1.1  christos     push(@text, &read_file("$ADDED_FILE.$i.$id.$cvs_user", "Added:"));
    747  1.1  christos     push(@text, &read_file("$REMOVED_FILE.$i.$id.$cvs_user", "Removed:"));
    748  1.1  christos     push(@text, "  Log:");
    749  1.1  christos     push(@text, &read_logfile("$LOG_FILE.$i.$id.$cvs_user", "  "));
    750  1.1  christos     push(@mlist_list, &read_file_lines("$MLIST_FILE.$i.$id.$cvs_user"));
    751  1.1  christos     if ($rcsidinfo == 2) {
    752  1.1  christos         if (-e "$SUMMARY_FILE.$i.$id.$cvs_user") {
    753  1.1  christos             push(@text, "  ");
    754  1.1  christos             push(@text, "  Revision  Changes    Path");
    755  1.1  christos             push(@text, &read_logfile("$SUMMARY_FILE.$i.$id.$cvs_user", "  "));
    756  1.1  christos         }
    757  1.1  christos     }
    758  1.1  christos     push(@text, "");
    759  1.1  christos }
    760  1.1  christos 
    761  1.1  christos #
    762  1.1  christos # Now generate the extra info for the mail message..
    763  1.1  christos #
    764  1.1  christos if ($rcsidinfo == 1) {
    765  1.1  christos     $revhdr = 0;
    766  1.1  christos     for ($i = 0; ; $i++) {
    767  1.1  christos         last if (! -e "$LOG_FILE.$i.$id.$cvs_user");
    768  1.1  christos         if (-e "$SUMMARY_FILE.$i.$id.$cvs_user") {
    769  1.1  christos             if (!$revhdr++) {
    770  1.1  christos                 push(@text, "Revision  Changes    Path");
    771  1.1  christos             }
    772  1.1  christos             push(@text, &read_logfile("$SUMMARY_FILE.$i.$id.$cvs_user", ""));
    773  1.1  christos         }
    774  1.1  christos     }
    775  1.1  christos     if ($revhdr) {
    776  1.1  christos         push(@text, "");        # consistancy...
    777  1.1  christos     }
    778  1.1  christos }
    779  1.1  christos 
    780  1.1  christos %mlist_hash = ();
    781  1.1  christos 
    782  1.1  christos foreach (@mlist_list) { $mlist_hash{ $_ } = 1; }
    783  1.1  christos 
    784  1.1  christos #
    785  1.1  christos # Mail out the notification.
    786  1.1  christos #
    787  1.1  christos &mail_notification([ keys(%mlist_hash) ], @text);
    788  1.1  christos &cleanup_tmpfiles;
    789  1.1  christos exit 0;
    790