scripts/commit-email.pl

   1 #!/usr/bin/env perl
   2
   3 # ====================================================================
   4 # commit-email.pl: send a commit email for commit REVISION in
   5 # repository REPOS to some email addresses.
   6 #
   7 # For usage, see the usage subroutine or run the script with no
   8 # command line arguments.
   9 #
  10 # $HeadURL: http://svn.collab.net/repos/svn/branches/1.2.x/tools/hook-scripts/commit-email.pl.in $
  11 # $LastChangedDate: 2005-02-22 04:24:08 -0500 (Tue, 22 Feb 2005) $
  12 # $LastChangedBy: maxb $
  13 # $LastChangedRevision: 13107 $
  14 #
  15 # ====================================================================
  16 # Copyright (c) 2000-2004 CollabNet.  All rights reserved.
  17 #
  18 # This software is licensed as described in the file COPYING, which
  19 # you should have received as part of this distribution.  The terms
  20 # are also available at http://subversion.tigris.org/license-1.html.
  21 # If newer versions of this license are posted there, you may use a
  22 # newer version instead, at your option.
  23 #
  24 # This software consists of voluntary contributions made by many
  25 # individuals.  For exact contribution history, see the revision
  26 # history and logs, available at http://subversion.tigris.org/.
  27 # ====================================================================
  28
  29 # Modified by Branden Robinson, Peter Samuelson, and Mark Hymers
  30 # September 2004 to add $size_limit support.
  31
  32 # Turn on warnings the best way depending on the Perl version.
  33 BEGIN {
  34   if ( $] >= 5.006_000)
  35     { require warnings; import warnings; }
  36   else
  37     { $^W = 1; }
  38 }
  39
  40 use strict;
  41 use Carp;
  42
  43 ######################################################################
  44 # Configuration section.
  45
  46 # Body of the message to be sent
  47 my @body;
  48
  49 # Sendmail path.
  50 my $sendmail = "/usr/sbin/sendmail";
  51
  52 # Svnlook path.
  53 my $svnlook = "/usr/bin/svnlook";
  54
  55 # By default, when a file is deleted from the repository, svnlook diff
  56 # prints the entire contents of the file.  If you want to save space
  57 # in the log and email messages by not printing the file, then set
  58 # $no_diff_deleted to 1.
  59 my $no_diff_deleted = 1;
  60 # By default, when a file is added to the repository, svnlook diff
  61 # prints the entire contents of the file.  If you want to save space
  62 # in the log and email messages by not printing the file, then set
  63 # $no_diff_added to 1.
  64 my $no_diff_added = 1;
  65
  66 # End of Configuration section.
  67 ######################################################################
  68
  69 # Since the path to svnlook depends upon the local installation
  70 # preferences, check that the required programs exist to insure that
  71 # the administrator has set up the script properly.
  72 {
  73   my $ok = 1;
  74   foreach my $program ($sendmail, $svnlook)
  75     {
  76       if (-e $program)
  77         {
  78           unless (-x $program)
  79             {
  80               warn "$0: required program `$program' is not executable, ",
  81                    "edit $0.\n";
  82               $ok = 0;
  83             }
  84         }
  85       else
  86         {
  87           warn "$0: required program `$program' does not exist, edit $0.\n";
  88           $ok = 0;
  89         }
  90     }
  91   exit 1 unless $ok;
  92 }
  93
  94
  95 ######################################################################
  96 # Initial setup/command-line handling.
  97
  98 # Each value in this array holds a hash reference which contains the
  99 # associated email information for one project.  Start with an
 100 # implicit rule that matches all paths.
 101 my @project_settings_list = (&new_project);
 102
 103 # Process the command line arguments till there are none left.  The
 104 # first two arguments that are not used by a command line option are
 105 # the repository path and the revision number.
 106 my $repos;
 107 my $rev;
 108
 109 # Use the reference to the first project to populate.
 110 my $current_project = $project_settings_list[0];
 111 my $size_limit = 0;
 112
 113 # This hash matches the command line option to the hash key in the
 114 # project.  If a key exists but has a false value (''), then the
 115 # command line option is allowed but requires special handling.
 116 my %opt_to_hash_key = ('--from' => 'from_address',
 117                        '-h'     => 'hostname',
 118                        '-l'     => 'log_file',
 119                        '-m'     => '',
 120                        '-r'     => 'reply_to',
 121                        '-s'     => 'subject_prefix',
 122                  '--size-limit' => '');
 123
 124 while (@ARGV)
 125   {
 126     my $arg = shift @ARGV;
 127     if ($arg =~ /^-/)
 128       {
 129         my $hash_key = $opt_to_hash_key{$arg};
 130         unless (defined $hash_key)
 131           {
 132             die "$0: command line option `$arg' is not recognized.\n";
 133           }
 134
 135         unless (@ARGV)
 136           {
 137             die "$0: command line option `$arg' is missing a value.\n";
 138           }
 139         my $value = shift @ARGV;
 140
 141         if ($hash_key)
 142           {
 143             $current_project->{$hash_key} = $value;
 144           }
 145         else
 146           {
 147             # Handle -m and --size-limit here.
 148             if ($arg eq '-m')
 149               {
 150                 $current_project                = &new_project;
 151                 $current_project->{match_regex} = $value;
 152                 push(@project_settings_list, $current_project);
 153               }
 154             elsif ($arg eq '--size-limit')
 155               {
 156                 $size_limit = $value;
 157                 # Validate the specified diff size limit.
 158                 if ($size_limit ne '' and $size_limit ne -1 and $size_limit !~ /^\d+$/)
 159                   {
 160                     die "$0: --size-limit takes only a positive integer or -1"
 161                         . " argument; \"$size_limit\" is neither\n";
 162                   }
 163               }
 164             else
 165               {
 166                 die "$0: internal error: should only handle -m and --size-limit"
 167                     . "here.\n";
 168               }
 169           }
 170       }
 171     elsif ($arg =~ /^-/)
 172       {
 173         die "$0: command line option `$arg' is not recognized.\n";
 174       }
 175     else
 176       {
 177         if (! defined $repos)
 178           {
 179             $repos = $arg;
 180           }
 181         elsif (! defined $rev)
 182           {
 183             $rev = $arg;
 184           }
 185         else
 186           {
 187             push(@{$current_project->{email_addresses}}, $arg);
 188           }
 189       }
 190   }
 191
 192 # If the revision number is undefined, then there were not enough
 193 # command line arguments.
 194 &usage("$0: too few arguments.") unless defined $rev;
 195
 196 # Check the validity of the command line arguments.  Check that the
 197 # revision is an integer greater than 0 and that the repository
 198 # directory exists.
 199 unless ($rev =~ /^\d+/ and $rev > 0)
 200   {
 201     &usage("$0: revision number `$rev' must be an integer > 0.");
 202   }
 203 unless (-e $repos)
 204   {
 205     &usage("$0: repos directory `$repos' does not exist.");
 206   }
 207 unless (-d _)
 208   {
 209     &usage("$0: repos directory `$repos' is not a directory.");
 210   }
 211
 212 # Check that all of the regular expressions can be compiled and
 213 # compile them.
 214 {
 215   my $ok = 1;
 216   for (my $i=0; $i<@project_settings_list; ++$i)
 217     {
 218       my $match_regex = $project_settings_list[$i]->{match_regex};
 219
 220       # To help users that automatically write regular expressions
 221       # that match the root directory using ^/, remove the / character
 222       # because subversion paths, while they start at the root level,
 223       # do not begin with a /.
 224       $match_regex =~ s#^\^/#^#;
 225
 226       my $match_re;
 227       eval { $match_re = qr/$match_regex/ };
 228       if ($@)
 229         {
 230           warn "$0: -m regex #$i `$match_regex' does not compile:\n$@\n";
 231           $ok = 0;
 232           next;
 233         }
 234       $project_settings_list[$i]->{match_re} = $match_re;
 235     }
 236   exit 1 unless $ok;
 237 }
 238
 239 ######################################################################
 240 # Harvest data using svnlook.
 241
 242 # Change into suitable directory so that svnlook diff can create its .svnlook
 243 # directory. This could be removed - it's only for compatibility with
 244 # 1.0.x svnlook - from 1.1.0, svnlook will be sensible about choosing a
 245 # temporary directory all by itself.
 246 #my $tmp_dir = ( -d $ENV{'TEMP'} ? $ENV{'TEMP'} : '/tmp' );
 247 #chdir($tmp_dir)
 248 #  or die "$0: cannot chdir `$tmp_dir': $!\n";
 249
 250 # Get the author, date, and log from svnlook.
 251 my ($lines_size, @svnlooklines) = &read_from_process(0, $svnlook, 'info',
 252                                                      $repos, '-r', $rev);
 253 my $author = shift @svnlooklines;
 254 my $date = shift @svnlooklines;
 255 shift @svnlooklines;
 256 my @log = map { "$_\n" } @svnlooklines;
 257
 258 # Add header to body
 259 push(@body, "Author: $author\n");
 260 push(@body, "Date: $date\n");
 261 push(@body, "New Revision: $rev\n");
 262 push(@body, "\n");
 263
 264 # Figure out what directories have changed using svnlook.
 265 my ($dirs_size, @dirschanged) = &read_from_process(0, $svnlook, 'dirs-changed',
 266                                                    $repos, '-r', $rev);
 267
 268 # Lose the trailing slash in the directory names if one exists, except
 269 # in the case of '/'.
 270 my $rootchanged = 0;
 271 for (my $i=0; $i<@dirschanged; ++$i)
 272   {
 273     if ($dirschanged[$i] eq '/')
 274       {
 275         $rootchanged = 1;
 276       }
 277     else
 278       {
 279         $dirschanged[$i] =~ s#^(.+)[/\\]$#$1#;
 280       }
 281   }
 282
 283 # Figure out what files have changed using svnlook.
 284 my $look_size;
 285 ($look_size, @svnlooklines) = &read_from_process(0, $svnlook, 'changed', $repos,
 286                                                  '-r', $rev);
 287
 288 # Parse the changed nodes.
 289 my @adds;
 290 my @dels;
 291 my @mods;
 292 foreach my $line (@svnlooklines)
 293   {
 294     my $path = '';
 295     my $code = '';
 296
 297     # Split the line up into the modification code and path, ignoring
 298     # property modifications.
 299     if ($line =~ /^(.).  (.*)$/)
 300       {
 301         $code = $1;
 302         $path = $2;
 303       }
 304
 305     if ($code eq 'A')
 306       {
 307         push(@adds, $path);
 308       }
 309     elsif ($code eq 'D')
 310       {
 311         push(@dels, $path);
 312       }
 313     else
 314       {
 315         push(@mods, $path);
 316       }
 317   }
 318
 319 # Add the adds, dels and mods to the body of the message.
 320 if (@adds)
 321   {
 322     @adds = sort @adds;
 323     push(@body, "Added:\n");
 324     push(@body, map { "   $_\n" } @adds);
 325   }
 326 if (@dels)
 327   {
 328     @dels = sort @dels;
 329     push(@body, "Removed:\n");
 330     push(@body, map { "   $_\n" } @dels);
 331   }
 332 if (@mods)
 333   {
 334     @mods = sort @mods;
 335     push(@body, "Modified:\n");
 336     push(@body, map { "   $_\n" } @mods);
 337   }
 338
 339 my @difflines;
 340 my $diff_howto = "Use \"svn diff" . " -r " . ($rev - 1) . ":$rev\" to view"
 341                  . " diff.\n";
 342
 343 # Work out how many bytes we have available for the diff.
 344 my $size_avail = 0;
 345 if ($size_limit > 0)
 346   {
 347     my $bodylen = 0;
 348     for (@body) { $bodylen += length($_); }
 349     $size_avail = $size_limit - $bodylen;
 350
 351 #    warn "sl= $size_limit -- sa = $size_avail";
 352
 353     if ($size_avail <= 0)
 354       {
 355         @difflines = ( "Diff skipped; message reached limit of $size_limit"
 356                        . " bytes with list of changed paths.\n$diff_howto" );
 357       }
 358 }
 359
 360 # A $size_limit of -1 means we do not include a diff.
 361 if ($size_limit ne -1)
 362   {
 363     # Get the diff from svnlook.
 364     my @no_diff_deleted = $no_diff_deleted ? ('--no-diff-deleted') : ();
 365     my @no_diff_added = $no_diff_added ? ('--no-diff-added') : ();
 366     my $numbytes;
 367     ($numbytes, @difflines) = &read_from_process($size_avail, $svnlook, 'diff',
 368                                                  $repos, '-r', $rev,
 369                                                  @no_diff_deleted, @no_diff_added);
 370     # If the diff is larger than the remaining size limit, we must discard
 371     # it.
 372     if ($numbytes == -1) {
 373       @difflines = ( "Including diff would make mail exceed size limit of"
 374                      . " $size_limit bytes.\n$diff_howto" );
 375       }
 376   }
 377 else
 378   {
 379     @difflines = ( $diff_howto );
 380   }
 381
 382 ######################################################################
 383 # Modified directory name collapsing.
 384
 385 # Collapse the list of changed directories only if the root directory
 386 # was not modified, because otherwise everything is under root and
 387 # there's no point in collapsing the directories, and only if more
 388 # than one directory was modified.
 389 my $commondir = '';
 390 my @dirschanged_orig = @dirschanged;
 391 if (!$rootchanged and @dirschanged > 1)
 392   {
 393     my $firstline    = shift @dirschanged;
 394     my @commonpieces = split('/', $firstline);
 395     foreach my $line (@dirschanged)
 396       {
 397         my @pieces = split('/', $line);
 398         my $i = 0;
 399         while ($i < @pieces and $i < @commonpieces)
 400           {
 401             if ($pieces[$i] ne $commonpieces[$i])
 402               {
 403                 splice(@commonpieces, $i, @commonpieces - $i);
 404                 last;
 405               }
 406             $i++;
 407           }
 408       }
 409     unshift(@dirschanged, $firstline);
 410
 411     if (@commonpieces)
 412       {
 413         $commondir = join('/', @commonpieces);
 414         my @new_dirschanged;
 415         foreach my $dir (@dirschanged)
 416           {
 417             if ($dir eq $commondir)
 418               {
 419                 $dir = '.';
 420               }
 421             else
 422               {
 423                 $dir =~ s#^\Q$commondir/\E##;
 424               }
 425             push(@new_dirschanged, $dir);
 426           }
 427         @dirschanged = @new_dirschanged;
 428       }
 429   }
 430 my $dirlist = join(' ', @dirschanged);
 431
 432 push(@body, "Log:\n");
 433 push(@body, @log);
 434 push(@body, "\n");
 435 push(@body, map { /[\r\n]+$/ ? $_ : "$_\n" } @difflines);
 436
 437 # Go through each project and see if there are any matches for this
 438 # project.  If so, send the log out.
 439 foreach my $project (@project_settings_list)
 440   {
 441     my $match_re = $project->{match_re};
 442     my $match    = 0;
 443     foreach my $path (@dirschanged_orig, @adds, @dels, @mods)
 444       {
 445         if ($path =~ $match_re)
 446           {
 447             $match = 1;
 448             last;
 449           }
 450       }
 451
 452     next unless $match;
 453
 454     my @email_addresses = @{$project->{email_addresses}};
 455     my $userlist        = join(' ', @email_addresses);
 456     my $from_address    = $project->{from_address};
 457     my $hostname        = $project->{hostname};
 458     my $log_file        = $project->{log_file};
 459     my $reply_to        = $project->{reply_to};
 460     my $subject_prefix  = $project->{subject_prefix};
 461     my $subject;
 462
 463     if ($commondir ne '')
 464       {
 465         $subject = "r$rev - in $commondir: $dirlist";
 466       }
 467     else
 468       {
 469         $subject = "r$rev - $dirlist";
 470       }
 471     if ($subject_prefix =~ /\w/)
 472       {
 473         $subject = "$subject_prefix $subject";
 474       }
 475     my $mail_from = $author;
 476
 477     if ($from_address =~ /\w/)
 478       {
 479         $mail_from = $from_address;
 480       }
 481     elsif ($hostname =~ /\w/)
 482       {
 483         $mail_from = "$mail_from\@$hostname";
 484       }
 485
 486     my @head;
 487     push(@head, "To: $userlist\n");
 488     push(@head, "From: $mail_from\n");
 489     push(@head, "Subject: $subject\n");
 490     push(@head, "Reply-to: $reply_to\n") if $reply_to;
 491
 492     ### Below, we set the content-type etc, but see these comments
 493     ### from Greg Stein on why this is not a full solution.
 494     #
 495     # From: Greg Stein <gstein@lyra.org>
 496     # Subject: Re: svn commit: rev 2599 - trunk/tools/cgi
 497     # To: dev@subversion.tigris.org
 498     # Date: Fri, 19 Jul 2002 23:42:32 -0700
 499     #
 500     # Well... that isn't strictly true. The contents of the files
 501     # might not be UTF-8, so the "diff" portion will be hosed.
 502     #
 503     # If you want a truly "proper" commit message, then you'd use
 504     # multipart MIME messages, with each file going into its own part,
 505     # and labeled with an appropriate MIME type and charset. Of
 506     # course, we haven't defined a charset property yet, but no biggy.
 507     #
 508     # Going with multipart will surely throw out the notion of "cut
 509     # out the patch from the email and apply." But then again: the
 510     # commit emailer could see that all portions are in the same
 511     # charset and skip the multipart thang.
 512     #
 513     # etc etc
 514     #
 515     # Basically: adding/tweaking the content-type is nice, but don't
 516     # think that is the proper solution.
 517     push(@head, "Content-Type: text/plain; charset=UTF-8\n");
 518     push(@head, "Content-Transfer-Encoding: 8bit\n");
 519
 520     push(@head, "\n");
 521
 522     if ($sendmail =~ /\w/ and @email_addresses)
 523       {
 524         # Open a pipe to sendmail.
 525         my $command = "$sendmail -f$mail_from $userlist";
 526         if (open(SENDMAIL, "| $command"))
 527           {
 528             print SENDMAIL @head, @body;
 529             close SENDMAIL
 530               or warn "$0: error in closing `$command' for writing: $!\n";
 531           }
 532         else
 533           {
 534             warn "$0: cannot open `| $command' for writing: $!\n";
 535           }
 536       }
 537
 538     # Dump the output to logfile (if its name is not empty).
 539     if ($log_file =~ /\w/)
 540       {
 541         if (open(LOGFILE, ">> $log_file"))
 542           {
 543             print LOGFILE @head, @body;
 544             close LOGFILE
 545               or warn "$0: error in closing `$log_file' for appending: $!\n";
 546           }
 547         else
 548           {
 549             warn "$0: cannot open `$log_file' for appending: $!\n";
 550           }
 551       }
 552   }
 553
 554 exit 0;
 555
 556 sub usage
 557 {
 558   warn "@_\n" if @_;
 559   die "usage: $0 REPOS REVNUM [[-m regex] [options] [email_addr ...]] ...\n",
 560       "options are\n",
 561       "  --from email_address  Email address for 'From:' (overrides -h)\n",
 562       "  -h hostname           Hostname to append to author for 'From:'\n",
 563       "  -l logfile            Append mail contents to this log file\n",
 564       "  -m regex              Regular expression to match committed path\n",
 565       "  -r email_address      Email address for 'Reply-To:'\n",
 566       "  -s subject_prefix     Subject line prefix\n",
 567       "  --size-limit limit    Message size limit in bytes (positive\n",
 568       "                        integer); if message exceeds limit, diff is\n",
 569       "                        omitted; if set to -1, diff is never sent\n",
 570       "\n",
 571       "This script supports a single repository with multiple projects,\n",
 572       "where each project receives email only for commits that modify that\n",
 573       "project.  A project is identified by using the -m command line\n",
 574       "with a regular expression argument.  If a commit has a path that\n",
 575       "matches the regular expression, then the entire commit matches.\n",
 576       "Any of the following -h, -l, -r and -s command line options and\n",
 577       "following email addresses are associated with this project.  The\n",
 578       "next -m resets the -h, -l, -r and -s command line options and the\n",
 579       "list of email addresses.\n",
 580       "\n",
 581       "To support a single project conveniently, the script initializes\n",
 582       "itself with an implicit -m . rule that matches any modifications\n",
 583       "to the repository.  Therefore, to use the script for a single\n",
 584       "project repository, just use the other comand line options and\n",
 585       "a list of email addresses on the command line.  If you do not want\n",
 586       "a project that matches the entire repository, then use a -m with a\n",
 587       "regular expression before any other command line options or email\n",
 588       "addresses.\n";
 589 }
 590
 591 # Return a new hash data structure for a new empty project that
 592 # matches any modifications to the repository.
 593 sub new_project
 594 {
 595   return {email_addresses => [],
 596           from_address    => '',
 597           hostname        => '',
 598           log_file        => '',
 599           match_regex     => '.',
 600           reply_to        => '',
 601           subject_prefix  => ''};
 602 }
 603
 604 # Start a child process safely without using /bin/sh.
 605 #
 606 # We take a parameter, $limit, which if greater than zero will limit the
 607 # amount we read -- this is a hack to avoid OOM errors.   If we return
 608 # $read_size == -1, we exceeded the limit.
 609 sub safe_read_from_pipe
 610 {
 611   unless (@_)
 612     {
 613       croak "$0: safe_read_from_pipe passed no arguments.\n";
 614     }
 615
 616   my $limit = shift @_;
 617   my $pid = open(SAFE_READ, '-|');
 618   unless (defined $pid)
 619     {
 620       die "$0: cannot fork: $!\n";
 621     }
 622   unless ($pid)
 623     {
 624       open(STDERR, ">&STDOUT")
 625         or die "$0: cannot dup STDOUT: $!\n";
 626       exec(@_)
 627         or die "$0: cannot exec `@_': $!\n";
 628     }
 629   my @output;
 630   my $read_size = 0;
 631   while (<SAFE_READ>)
 632     {
 633       s/[\r\n]+$//;
 634       $read_size += length;
 635       if (($limit > 0) and ($read_size > $limit))
 636       {
 637         $read_size = -1;
 638         @output = ("output size exceeds specified limit of " . $limit);
 639         last;
 640       }
 641       push(@output, $_);
 642     }
 643   close(SAFE_READ);
 644   my $result = $?;
 645   my $exit   = $result >> 8;
 646   my $signal = $result & 127;
 647   my $cd     = $result & 128 ? "with core dump" : "";
 648   if ($signal or $cd)
 649     {
 650       warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
 651     }
 652   if (wantarray)
 653     {
 654       return ($result, $read_size, @output);
 655     }
 656   else
 657     {
 658       return $result;
 659     }
 660 }
 661
 662 # Use safe_read_from_pipe to start a child process safely and return
 663 # the output if it succeeded or an error message followed by the output
 664 # if it failed.  Returns number of bytes read and the output.
 665 sub read_from_process
 666 {
 667   unless (@_)
 668     {
 669       croak "$0: read_from_process passed no arguments.\n";
 670     }
 671   my ($status, $read_size, @output) = &safe_read_from_pipe(@_);
 672   if ($read_size >= 0 and $status)
 673     {
 674       return ("$0: `@_' failed with this output:", @output);
 675     }
 676   else
 677     {
 678       return ($read_size, @output);
 679     }
 680 }