tools/hook-scripts/commit-email.pl.in

   1 #!/usr/bin/env perl
   2
   3 # ====================================================================
   4 # commit-email.pl: send a notification email describing either a
   5 # commit or a revprop-change action on a Subversion repository.
   6 #
   7 # For usage, see the usage subroutine or run the script with no
   8 # command line arguments.
   9 #
  10 # This script requires Subversion 1.2.0 or later.
  11 #
  12 # $HeadURL$
  13 # $LastChangedDate$
  14 # $LastChangedBy$
  15 # $LastChangedRevision$
  16 #
  17 # ====================================================================
  18 # Copyright (c) 2000-2006 CollabNet.  All rights reserved.
  19 #
  20 # This software is licensed as described in the file COPYING, which
  21 # you should have received as part of this distribution.  The terms
  22 # are also available at http://subversion.tigris.org/license-1.html.
  23 # If newer versions of this license are posted there, you may use a
  24 # newer version instead, at your option.
  25 #
  26 # This software consists of voluntary contributions made by many
  27 # individuals.  For exact contribution history, see the revision
  28 # history and logs, available at http://subversion.tigris.org/.
  29 # ====================================================================
  30
  31 # Turn on warnings the best way depending on the Perl version.
  32 BEGIN {
  33   if ( $] >= 5.006_000)
  34     { require warnings; import warnings; }
  35   else
  36     { $^W = 1; }
  37 }
  38
  39 use strict;
  40 use Carp;
  41 use POSIX qw(strftime);
  42 my ($sendmail, $smtp_server);
  43
  44 ######################################################################
  45 # Configuration section.
  46
  47 # Sendmail path, or SMTP server address.
  48 # You should define exactly one of these two configuration variables,
  49 # leaving the other commented out, to select which method of sending
  50 # email should be used.
  51 # Using --stdout on the command line overrides both.
  52 #$sendmail = "/usr/sbin/sendmail";
  53 $smtp_server = "127.0.0.1";
  54
  55 # Svnlook path.
  56 my $svnlook = "@SVN_BINDIR@/svnlook";
  57
  58 # By default, when a file is deleted from the repository, svnlook diff
  59 # prints the entire contents of the file.  If you want to save space
  60 # in the log and email messages by not printing the file, then set
  61 # $no_diff_deleted to 1.
  62 my $no_diff_deleted = 0;
  63 # By default, when a file is added to the repository, svnlook diff
  64 # prints the entire contents of the file.  If you want to save space
  65 # in the log and email messages by not printing the file, then set
  66 # $no_diff_added to 1.
  67 my $no_diff_added = 0;
  68
  69 # End of Configuration section.
  70 ######################################################################
  71
  72 # Check that the required programs exist, and the email sending method
  73 # configuration is sane, to ensure that the administrator has set up
  74 # the script properly.
  75 {
  76   my $ok = 1;
  77   foreach my $program ($sendmail, $svnlook)
  78     {
  79       next if not defined $program;
  80       if (-e $program)
  81         {
  82           unless (-x $program)
  83             {
  84               warn "$0: required program `$program' is not executable, ",
  85                    "edit $0.\n";
  86               $ok = 0;
  87             }
  88         }
  89       else
  90         {
  91           warn "$0: required program `$program' does not exist, edit $0.\n";
  92           $ok = 0;
  93         }
  94     }
  95   if (not (defined $sendmail xor defined $smtp_server))
  96     {
  97       warn "$0: exactly one of \$sendmail or \$smtp_server must be ",
  98            "set, edit $0.\n";
  99       $ok = 0;
 100     }
 101   exit 1 unless $ok;
 102 }
 103
 104 require Net::SMTP if defined $smtp_server;
 105
 106 ######################################################################
 107 # Initial setup/command-line handling.
 108
 109 # Each value in this array holds a hash reference which contains the
 110 # associated email information for one project.  Start with an
 111 # implicit rule that matches all paths.
 112 my @project_settings_list = (&new_project);
 113
 114 # Process the command line arguments till there are none left.
 115 # In commit mode: The first two arguments that are not used by a command line
 116 # option are the repository path and the revision number.
 117 # In revprop-change mode: The first four arguments that are not used by a
 118 # command line option are the repository path, the revision number, the
 119 # author, and the property name. This script has no support for the fifth
 120 # argument (action) added to the post-revprop-change hook in Subversion
 121 # 1.2.0 yet - patches welcome!
 122 my $repos;
 123 my $rev;
 124 my $author;
 125 my $propname;
 126
 127 my $mode = 'commit';
 128 my $date;
 129 my $diff_file;
 130
 131 # Use the reference to the first project to populate.
 132 my $current_project = $project_settings_list[0];
 133
 134 # This hash matches the command line option to the hash key in the
 135 # project.  If a key exists but has a false value (''), then the
 136 # command line option is allowed but requires special handling.
 137 my %opt_to_hash_key = ('--from' => 'from_address',
 138                        '--revprop-change' => '',
 139                        '-d'     => '',
 140                        '-h'     => 'hostname',
 141                        '-l'     => 'log_file',
 142                        '-m'     => '',
 143                        '-r'     => 'reply_to',
 144                        '-s'     => 'subject_prefix',
 145                        '--summary' => '',
 146                        '--diff' => '',
 147                        '--stdout' => '');
 148
 149 while (@ARGV)
 150   {
 151     my $arg = shift @ARGV;
 152     if ($arg =~ /^-/)
 153       {
 154         my $hash_key = $opt_to_hash_key{$arg};
 155         unless (defined $hash_key)
 156           {
 157             die "$0: command line option `$arg' is not recognized.\n";
 158           }
 159
 160         my $value;
 161         if ($arg ne '--revprop-change' and $arg ne '--stdout' and $arg ne '--summary')
 162           {
 163             unless (@ARGV)
 164               {
 165                 die "$0: command line option `$arg' is missing a value.\n";
 166               }
 167             $value = shift @ARGV;
 168           }
 169
 170         if ($hash_key)
 171           {
 172             $current_project->{$hash_key} = $value;
 173           }
 174         else
 175           {
 176             if ($arg eq '-m')
 177               {
 178                 $current_project                = &new_project;
 179                 $current_project->{match_regex} = $value;
 180                 push(@project_settings_list, $current_project);
 181               }
 182             elsif ($arg eq '-d')
 183               {
 184                 if ($mode ne 'revprop-change')
 185                   {
 186                     die "$0: `-d' is valid only when used after"
 187                       . " `--revprop-change'.\n";
 188                   }
 189                 if ($diff_file)
 190                   {
 191                     die "$0: command line option `$arg'"
 192                       . " can only be used once.\n";
 193                   }
 194                 $diff_file = $value;
 195               }
 196             elsif ($arg eq '--revprop-change')
 197               {
 198                 if (defined $repos)
 199                   {
 200                     die "$0: `--revprop-change' must be specified before"
 201                       . " the first non-option argument.\n";
 202                   }
 203                 $mode = 'revprop-change';
 204               }
 205             elsif ($arg eq '--diff')
 206               {
 207                 $current_project->{show_diff} = parse_boolean($value);
 208               }
 209             elsif ($arg eq '--stdout')
 210               {
 211                 $current_project->{stdout} = 1;
 212               }
 213             elsif ($arg eq '--summary')
 214               {
 215                 $current_project->{summary} = 1;
 216               }
 217             else
 218               {
 219                 die "$0: internal error:"
 220                   . " should not be handling `$arg' here.\n";
 221               }
 222           }
 223       }
 224     else
 225       {
 226         if (! defined $repos)
 227           {
 228             $repos = $arg;
 229           }
 230         elsif (! defined $rev)
 231           {
 232             $rev = $arg;
 233           }
 234         elsif (! defined $author && $mode eq 'revprop-change')
 235           {
 236             $author = $arg;
 237           }
 238         elsif (! defined $propname && $mode eq 'revprop-change')
 239           {
 240             $propname = $arg;
 241           }
 242         else
 243           {
 244             push(@{$current_project->{email_addresses}}, $arg);
 245           }
 246       }
 247   }
 248
 249 if ($mode eq 'commit')
 250   {
 251     &usage("$0: too few arguments.") unless defined $rev;
 252   }
 253 elsif ($mode eq 'revprop-change')
 254   {
 255     &usage("$0: too few arguments.") unless defined $propname;
 256   }
 257
 258 # Check the validity of the command line arguments.  Check that the
 259 # revision is an integer greater than 0 and that the repository
 260 # directory exists.
 261 unless ($rev =~ /^\d+/ and $rev > 0)
 262   {
 263     &usage("$0: revision number `$rev' must be an integer > 0.");
 264   }
 265 unless (-e $repos)
 266   {
 267     &usage("$0: repos directory `$repos' does not exist.");
 268   }
 269 unless (-d _)
 270   {
 271     &usage("$0: repos directory `$repos' is not a directory.");
 272   }
 273
 274 # Check that all of the regular expressions can be compiled and
 275 # compile them.
 276 {
 277   my $ok = 1;
 278   for (my $i=0; $i<@project_settings_list; ++$i)
 279     {
 280       my $match_regex = $project_settings_list[$i]->{match_regex};
 281
 282       # To help users that automatically write regular expressions
 283       # that match the root directory using ^/, remove the / character
 284       # because subversion paths, while they start at the root level,
 285       # do not begin with a /.
 286       $match_regex =~ s#^\^/#^#;
 287
 288       my $match_re;
 289       eval { $match_re = qr/$match_regex/ };
 290       if ($@)
 291         {
 292           warn "$0: -m regex #$i `$match_regex' does not compile:\n$@\n";
 293           $ok = 0;
 294           next;
 295         }
 296       $project_settings_list[$i]->{match_re} = $match_re;
 297     }
 298   exit 1 unless $ok;
 299 }
 300
 301 # Harvest common data needed for both commit or revprop-change.
 302
 303 # Figure out what directories have changed using svnlook.
 304 my @dirschanged = &read_from_process($svnlook, 'dirs-changed', $repos,
 305                                      '-r', $rev);
 306
 307 # Lose the trailing slash in the directory names if one exists, except
 308 # in the case of '/'.
 309 my $rootchanged = 0;
 310 for (my $i=0; $i<@dirschanged; ++$i)
 311   {
 312     if ($dirschanged[$i] eq '/')
 313       {
 314         $rootchanged = 1;
 315       }
 316     else
 317       {
 318         $dirschanged[$i] =~ s#^(.+)[/\\]$#$1#;
 319       }
 320   }
 321
 322 # Figure out what files have changed using svnlook.
 323 my @svnlooklines = &read_from_process($svnlook, 'changed', $repos, '-r', $rev);
 324
 325 # Parse the changed nodes.
 326 my @adds;
 327 my @dels;
 328 my @mods;
 329 foreach my $line (@svnlooklines)
 330   {
 331     my $path = '';
 332     my $code = '';
 333
 334     # Split the line up into the modification code and path, ignoring
 335     # property modifications.
 336     if ($line =~ /^(.).  (.*)$/)
 337       {
 338         $code = $1;
 339         $path = $2;
 340       }
 341
 342     if ($code eq 'A')
 343       {
 344         push(@adds, $path);
 345       }
 346     elsif ($code eq 'D')
 347       {
 348         push(@dels, $path);
 349       }
 350     else
 351       {
 352         push(@mods, $path);
 353       }
 354   }
 355
 356 # Declare variables which carry information out of the inner scope of
 357 # the conditional blocks below.
 358 my $subject_base;
 359 my $subject_logbase;
 360 my @body;
 361 # $author - declared above for use as a command line parameter in
 362 #   revprop-change mode.  In commit mode, gets filled in below.
 363
 364 if ($mode eq 'commit')
 365   {
 366     ######################################################################
 367     # Harvest data using svnlook.
 368
 369     # Get the author, date, and log from svnlook.
 370     my @infolines = &read_from_process($svnlook, 'info', $repos, '-r', $rev);
 371     $author = shift @infolines;
 372     $date = shift @infolines;
 373     shift @infolines;
 374     my @log = map { "$_\n" } @infolines;
 375
 376     ######################################################################
 377     # Modified directory name collapsing.
 378
 379     # Collapse the list of changed directories only if the root directory
 380     # was not modified, because otherwise everything is under root and
 381     # there's no point in collapsing the directories, and only if more
 382     # than one directory was modified.
 383     my $commondir = '';
 384     my @edited_dirschanged = @dirschanged;
 385     if (!$rootchanged and @edited_dirschanged > 1)
 386       {
 387         my $firstline    = shift @edited_dirschanged;
 388         my @commonpieces = split('/', $firstline);
 389         foreach my $line (@edited_dirschanged)
 390           {
 391             my @pieces = split('/', $line);
 392             my $i = 0;
 393             while ($i < @pieces and $i < @commonpieces)
 394               {
 395                 if ($pieces[$i] ne $commonpieces[$i])
 396                   {
 397                     splice(@commonpieces, $i, @commonpieces - $i);
 398                     last;
 399                   }
 400                 $i++;
 401               }
 402           }
 403         unshift(@edited_dirschanged, $firstline);
 404
 405         if (@commonpieces)
 406           {
 407             $commondir = join('/', @commonpieces);
 408             my @new_dirschanged;
 409             foreach my $dir (@edited_dirschanged)
 410               {
 411                 if ($dir eq $commondir)
 412                   {
 413                     $dir = '.';
 414                   }
 415                 else
 416                   {
 417                     $dir =~ s#^\Q$commondir/\E##;
 418                   }
 419                 push(@new_dirschanged, $dir);
 420               }
 421             @edited_dirschanged = @new_dirschanged;
 422           }
 423       }
 424     my $dirlist = join(' ', @edited_dirschanged);
 425
 426     ######################################################################
 427     # Assembly of log message.
 428
 429     if ($commondir ne '')
 430       {
 431         $subject_base = "r$rev - in $commondir: $dirlist";
 432       }
 433     else
 434       {
 435         $subject_base = "r$rev - $dirlist";
 436       }
 437     my $summary = @log ? $log[0] : '';
 438     chomp($summary);
 439     $subject_logbase = "r$rev - $summary";
 440
 441     # Put together the body of the log message.
 442     push(@body, "Author: $author\n");
 443     push(@body, "Date: $date\n");
 444     push(@body, "New Revision: $rev\n");
 445     push(@body, "\n");
 446     if (@adds)
 447       {
 448         @adds = sort @adds;
 449         push(@body, "Added:\n");
 450         push(@body, map { "   $_\n" } @adds);
 451       }
 452     if (@dels)
 453       {
 454         @dels = sort @dels;
 455         push(@body, "Removed:\n");
 456         push(@body, map { "   $_\n" } @dels);
 457       }
 458     if (@mods)
 459       {
 460         @mods = sort @mods;
 461         push(@body, "Modified:\n");
 462         push(@body, map { "   $_\n" } @mods);
 463       }
 464     push(@body, "Log:\n");
 465     push(@body, @log);
 466     push(@body, "\n");
 467   }
 468 elsif ($mode eq 'revprop-change')
 469   {
 470     ######################################################################
 471     # Harvest data.
 472
 473     my @svnlines;
 474     # Get the diff file if it was provided, otherwise the property value.
 475     if ($diff_file)
 476       {
 477         open(DIFF_FILE, $diff_file) or die "$0: cannot read `$diff_file': $!\n";
 478         @svnlines = <DIFF_FILE>;
 479         close DIFF_FILE;
 480       }
 481     else
 482       {
 483         @svnlines = &read_from_process($svnlook, 'propget', '--revprop', '-r',
 484                                        $rev, $repos, $propname);
 485       }
 486
 487     ######################################################################
 488     # Assembly of log message.
 489
 490     $subject_base = "propchange - r$rev $propname";
 491
 492     # Put together the body of the log message.
 493     push(@body, "Author: $author\n");
 494     push(@body, "Revision: $rev\n");
 495     push(@body, "Property Name: $propname\n");
 496     push(@body, "\n");
 497     unless ($diff_file)
 498       {
 499         push(@body, "New Property Value:\n");
 500       }
 501     push(@body, map { /[\r\n]+$/ ? $_ : "$_\n" } @svnlines);
 502     push(@body, "\n");
 503   }
 504
 505 # Cached information - calculated when first needed.
 506 my @difflines;
 507
 508 # Go through each project and see if there are any matches for this
 509 # project.  If so, send the log out.
 510 foreach my $project (@project_settings_list)
 511   {
 512     my $match_re = $project->{match_re};
 513     my $match    = 0;
 514     foreach my $path (@dirschanged, @adds, @dels, @mods)
 515       {
 516         if ($path =~ $match_re)
 517           {
 518             $match = 1;
 519             last;
 520           }
 521       }
 522
 523     next unless $match;
 524
 525     my @email_addresses = @{$project->{email_addresses}};
 526     my $userlist        = join(' ', @email_addresses);
 527     my $to              = join(', ', @email_addresses);
 528     my $from_address    = $project->{from_address};
 529     my $hostname        = $project->{hostname};
 530     my $log_file        = $project->{log_file};
 531     my $reply_to        = $project->{reply_to};
 532     my $subject_prefix  = $project->{subject_prefix};
 533     my $summary         = $project->{summary};
 534     my $diff_wanted     = ($project->{show_diff} and $mode eq 'commit');
 535     my $stdout          = $project->{stdout};
 536
 537     my $subject         = $summary ? $subject_logbase : $subject_base;
 538     if ($subject_prefix =~ /\w/)
 539       {
 540         $subject = "$subject_prefix $subject";
 541       }
 542     my $mail_from = $author;
 543
 544     if ($from_address =~ /\w/)
 545       {
 546         $mail_from = $from_address;
 547       }
 548     elsif ($hostname =~ /\w/)
 549       {
 550         $mail_from = "$mail_from\@$hostname";
 551       }
 552     elsif (defined $smtp_server and ! $stdout)
 553       {
 554         die "$0: use of either `-h' or `--from' is mandatory when ",
 555             "sending email using direct SMTP.\n";
 556       }
 557
 558     my @head;
 559     my $formatted_date;
 560     if (defined $stdout)
 561       {
 562         $formatted_date = strftime('%a %b %e %X %Y', localtime());
 563         push(@head, "From $mail_from $formatted_date\n");
 564       }
 565     $formatted_date = strftime('%a, %e %b %Y %X %z', localtime());
 566     push(@head, "Date: $formatted_date\n");
 567     push(@head, "To: $to\n");
 568     push(@head, "From: $mail_from\n");
 569     push(@head, "Subject: $subject\n");
 570     push(@head, "Reply-to: $reply_to\n") if $reply_to;
 571
 572     ### Below, we set the content-type etc, but see these comments
 573     ### from Greg Stein on why this is not a full solution.
 574     #
 575     # From: Greg Stein <gstein@lyra.org>
 576     # Subject: Re: svn commit: rev 2599 - trunk/tools/cgi
 577     # To: dev@subversion.tigris.org
 578     # Date: Fri, 19 Jul 2002 23:42:32 -0700
 579     #
 580     # Well... that isn't strictly true. The contents of the files
 581     # might not be UTF-8, so the "diff" portion will be hosed.
 582     #
 583     # If you want a truly "proper" commit message, then you'd use
 584     # multipart MIME messages, with each file going into its own part,
 585     # and labeled with an appropriate MIME type and charset. Of
 586     # course, we haven't defined a charset property yet, but no biggy.
 587     #
 588     # Going with multipart will surely throw out the notion of "cut
 589     # out the patch from the email and apply." But then again: the
 590     # commit emailer could see that all portions are in the same
 591     # charset and skip the multipart thang.
 592     #
 593     # etc etc
 594     #
 595     # Basically: adding/tweaking the content-type is nice, but don't
 596     # think that is the proper solution.
 597     push(@head, "Content-Type: text/plain; charset=UTF-8\n");
 598     push(@head, "Content-Transfer-Encoding: 8bit\n");
 599
 600     push(@head, "\n");
 601
 602     if ($diff_wanted and not @difflines)
 603       {
 604         # Get the diff from svnlook.
 605         my @no_diff_deleted = $no_diff_deleted ? ('--no-diff-deleted') : ();
 606         my @no_diff_added = $no_diff_added ? ('--no-diff-added') : ();
 607         @difflines = &read_from_process($svnlook, 'diff', $repos,
 608                                         '-r', $rev, @no_diff_deleted,
 609                                         @no_diff_added);
 610         @difflines = map { /[\r\n]+$/ ? $_ : "$_\n" } @difflines;
 611       }
 612
 613     if ($stdout)
 614       {
 615         print @head, @body;
 616         print @difflines if $diff_wanted;
 617       }
 618     elsif (defined $sendmail and @email_addresses)
 619       {
 620         # Open a pipe to sendmail.
 621         my $command = "$sendmail -f'$mail_from' $userlist";
 622         if (open(SENDMAIL, "| $command"))
 623           {
 624             print SENDMAIL @head, @body;
 625             print SENDMAIL @difflines if $diff_wanted;
 626             close SENDMAIL
 627               or warn "$0: error in closing `$command' for writing: $!\n";
 628           }
 629         else
 630           {
 631             warn "$0: cannot open `| $command' for writing: $!\n";
 632           }
 633       }
 634     elsif (defined $smtp_server and @email_addresses)
 635       {
 636         my $smtp = Net::SMTP->new($smtp_server)
 637           or die "$0: error opening SMTP session to `$smtp_server': $!\n";
 638         handle_smtp_error($smtp, $smtp->mail($mail_from));
 639         handle_smtp_error($smtp, $smtp->recipient(@email_addresses));
 640         handle_smtp_error($smtp, $smtp->data());
 641         handle_smtp_error($smtp, $smtp->datasend(@head, @body));
 642         if ($diff_wanted)
 643           {
 644             handle_smtp_error($smtp, $smtp->datasend(@difflines));
 645           }
 646         handle_smtp_error($smtp, $smtp->dataend());
 647         handle_smtp_error($smtp, $smtp->quit());
 648       }
 649
 650     # Dump the output to logfile (if its name is not empty).
 651     if ($log_file =~ /\w/)
 652       {
 653         if (open(LOGFILE, ">> $log_file"))
 654           {
 655             print LOGFILE @head, @body;
 656             print LOGFILE @difflines if $diff_wanted;
 657             close LOGFILE
 658               or warn "$0: error in closing `$log_file' for appending: $!\n";
 659           }
 660         else
 661           {
 662             warn "$0: cannot open `$log_file' for appending: $!\n";
 663           }
 664       }
 665   }
 666
 667 exit 0;
 668
 669 sub handle_smtp_error
 670 {
 671   my ($smtp, $retval) = @_;
 672   if (not $retval)
 673     {
 674       die "$0: SMTP Error: " . $smtp->message() . "\n";
 675     }
 676 }
 677
 678 sub usage
 679 {
 680   warn "@_\n" if @_;
 681   die "usage (commit mode):\n",
 682       "  $0 REPOS REVNUM [[-m regex] [options] [email_addr ...]] ...\n",
 683       "usage: (revprop-change mode):\n",
 684       "  $0 --revprop-change REPOS REVNUM USER PROPNAME [-d diff_file] \\\n",
 685       "    [[-m regex] [options] [email_addr ...]] ...\n",
 686       "options are:\n",
 687       "  -m regex              Regular expression to match committed path\n",
 688       "  --from email_address  Email address for 'From:' (overrides -h)\n",
 689       "  -h hostname           Hostname to append to author for 'From:'\n",
 690       "  -l logfile            Append mail contents to this log file\n",
 691       "  -r email_address      Email address for 'Reply-To:'\n",
 692       "  -s subject_prefix     Subject line prefix\n",
 693       "  --summary             Use first line of commit log in subject\n",
 694       "  --diff y|n            Include diff in message (default: y)\n",
 695       "                        (applies to commit mode only)\n",
 696       "  --stdout              Spit the message in mbox format to stdout.\n",
 697       "\n",
 698       "This script supports a single repository with multiple projects,\n",
 699       "where each project receives email only for actions that affect that\n",
 700       "project.  A project is identified by using the -m command line\n".
 701       "option with a regular expression argument.  If the given revision\n",
 702       "contains modifications to a path that matches the regular\n",
 703       "expression, then the action applies to the project.\n",
 704       "\n",
 705       "Any of the following email addresses and command line options\n",
 706       "(other than -d) are associated with this project, until the next -m,\n",
 707       "which resets the options and the list of email addresses.\n",
 708       "\n",
 709       "To support a single project conveniently, the script initializes\n",
 710       "itself with an implicit -m . rule that matches any modifications\n",
 711       "to the repository.  Therefore, to use the script for a single-\n",
 712       "project repository, just use the other command line options and\n",
 713       "a list of email addresses on the command line.  If you do not want\n",
 714       "a rule that matches the entire repository, then use -m with a\n",
 715       "regular expression before any other command line options or email\n",
 716       "addresses.\n",
 717       "\n",
 718       "'revprop-change' mode:\n",
 719       "The message will contain a copy of the diff_file if it is provided,\n",
 720       "otherwise a copy of the (assumed to be new) property value.\n",
 721       "\n";
 722 }
 723
 724 # Return a new hash data structure for a new empty project that
 725 # matches any modifications to the repository.
 726 sub new_project
 727 {
 728   return {email_addresses => [],
 729           from_address    => '',
 730           hostname        => '',
 731           log_file        => '',
 732           match_regex     => '.',
 733           reply_to        => '',
 734           subject_prefix  => '',
 735           show_diff       => 1,
 736           stdout          => 0};
 737 }
 738
 739 sub parse_boolean
 740 {
 741   if ($_[0] eq 'y') { return 1; };
 742   if ($_[0] eq 'n') { return 0; };
 743
 744   die "$0: valid boolean options are 'y' or 'n', not '$_[0]'\n";
 745 }
 746
 747 # Start a child process safely without using /bin/sh.
 748 sub safe_read_from_pipe
 749 {
 750   unless (@_)
 751     {
 752       croak "$0: safe_read_from_pipe passed no arguments.\n";
 753     }
 754
 755   my $openfork_available = $^O ne "MSWin32";
 756   if ($openfork_available) # We can fork on this system.
 757     {
 758       my $pid = open(SAFE_READ, '-|');
 759       unless (defined $pid)
 760         {
 761           die "$0: cannot fork: $!\n";
 762         }
 763       unless ($pid)
 764         {
 765           open(STDERR, ">&STDOUT")
 766             or die "$0: cannot dup STDOUT: $!\n";
 767           exec(@_)
 768             or die "$0: cannot exec `@_': $!\n";
 769         }
 770     }
 771   else  # Running on Windows.  No fork.
 772     {
 773       my @commandline = ();
 774       my $arg;
 775
 776       while ($arg = shift)
 777         {
 778           $arg =~ s/\"/\\\"/g;
 779           if ($arg eq "" or $arg =~ /\s/) { $arg = "\"$arg\""; }
 780           push(@commandline, $arg);
 781         }
 782
 783       # Now do the pipe.
 784       open(SAFE_READ, "@commandline |")
 785         or die "$0: cannot pipe to command: $!\n";
 786     }
 787   my @output;
 788   while (<SAFE_READ>)
 789     {
 790       s/[\r\n]+$//;
 791       push(@output, $_);
 792     }
 793   close(SAFE_READ);
 794   my $result = $?;
 795   my $exit   = $result >> 8;
 796   my $signal = $result & 127;
 797   my $cd     = $result & 128 ? "with core dump" : "";
 798   if ($signal or $cd)
 799     {
 800       warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
 801     }
 802   if (wantarray)
 803     {
 804       return ($result, @output);
 805     }
 806   else
 807     {
 808       return $result;
 809     }
 810 }
 811
 812 # Use safe_read_from_pipe to start a child process safely and return
 813 # the output if it succeeded or an error message followed by the output
 814 # if it failed.
 815 sub read_from_process
 816 {
 817   unless (@_)
 818     {
 819       croak "$0: read_from_process passed no arguments.\n";
 820     }
 821   my ($status, @output) = &safe_read_from_pipe(@_);
 822   if ($status)
 823     {
 824       return ("$0: `@_' failed with this output:", @output);
 825     }
 826   else
 827     {
 828       return @output;
 829     }
 830 }