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