CVSROOT/scripts/loginfo2mail.pl

#!/usr/bin/perl -w
#
# CVS loginfo 2 mail
# Copyright (c) 2001-2002 SATOH Fumiyasu. All rights reserved.
# Customizer Copyright (c) 2004-2005 MATSUDA Masaaki as TigerCat.
#
# Date: 2004-11-16, since 2001-10-29
# License: GNU General Public License ver.2
#
# Required external commands:
#       sendmail
#       rcsdiff
#
# $Id: loginfo2mail.pl,v 1.1 2007/01/09 12:56:04 tigercat Exp $

# FIXME: Read configurations from external file
# FIXME: Print `cvs rdiff' command line to generate diff output
#        [namazu-devel-ja 2164] [namazu-devel-ja 2166]
# FIXME: Support to customize sender address
# FIXME: Support diff(1) options for rcsdiff(1)
# FIXME: Support chroot(2)-ed environment

# Customization change log by TigerCat
# 2004-11-16 Customzed version 0.1.7-custom01 based on original 0.1.7.
# 2004-11-16 Implemented mail-from feature.
# 2004-11-16 Added mail-header: Return-path.
# 2004-11-16 Changed mail-header: Return-path to Errors-To.
# 2005-12-26 Fixed %{sVv} receiving issue.
# 2005-12-26 New feature: mail_from is set @domain, convert to $CVS_USER@domain.
# 2007-01-10 New feature: The account full name added into sender address.


use strict;
use English;
use FindBin;
use Getopt::Std;
use IO::File;

$ENV{'PATH'} = "/usr/bin:/usr/sbin:/usr/lib:$ENV{'PATH'}";

my $CMD_NAME ="cvs-$FindBin::Script";
my $CMD_VERSION = "0.1.7.custom02";

# Options
# ======================================================================

# CVS root
my $cvs_root = $ENV{'CVSROOT'};

# URL for CVS web interface by cvsweb or ViewCVS
my $cvsweb_url = 'http://cvs.sourceforge.jp/cgi-bin/viewcvs.cgi';
# Type of CVS web interface: 'cvsweb' or 'viewcvs'
my $cvsweb_type = 'viewcvs';

# Maximum line number of rcsdiff(1) output (0< mean `no limit')
my $diff_maxline = -1;

# Content language
my $lang = 'NONE';

# Mail return address : In case commented out, OS user will be used.
my $mail_return = '';

# Mail from address
my $mail_from = '';

my $usage = <<EOF_USAGE;
Usage: in \$CVSROOT/CVSROOT/loginfo
    ^module \$CVSROOT/CVSROOT/$CMD_NAME [options] %{sVv} address ...
  or, newer CVS server must set following,
    ^module \$CVSROOT/CVSROOT/$CMD_NAME [options] %p %{sVv} address ...

Options:
    -d cvsroot  CVS root directory [\$CVSROOT]
    -w webtype  Type of web interface [$cvsweb_type]
    -W url      URL for CVS web interface [$cvsweb_url]
    -f address  Envelope sender address [$mail_from]
                if set only \@somewhere.domain.net ,it will be converted
                \$CVS_USER\@somewhere.domain.net
    -r address  Return mail address [$mail_return]
    -D number   Max line number of rcsdiff(1) output [$diff_maxline]
    -L language Content language [$lang]

    %{sVv}      CVS loginfo
    address     Mail CVS loginfo to this address(es)

Type of web interface:
    viewcvs     ViewCVS - http://viewcvs.sourceforge.net/
    cvsweb      cvsweb - http://stud.fh-heilbronn.de/~zeller/cgi/cvsweb.cgi/

Content Language:
    ja          Japanese (ISO-2022-JP)
EOF_USAGE

# Command-line options
# ----------------------------------------------------------------------

use vars qw($opt_d $opt_w $opt_W $opt_f $opt_r $opt_D $opt_L);
if (!getopts('d:w:W:f:r:D:L:') || @ARGV < 2) {
    print($usage);
    exit(1);
}

$cvs_root = $opt_d if (defined($opt_d));
$cvsweb_type = $opt_w if (defined($opt_w));
$cvsweb_url = $opt_W if (defined($opt_W));
$diff_maxline = $opt_D if (defined($opt_D));
$lang = $opt_L if (defined($opt_L));
$mail_from = $opt_f if (defined($opt_f));
$mail_return = $opt_r if (defined($opt_r));

my $cvs_info = shift(@ARGV);
my @cvs_infos = grep !/\@/, @ARGV;
for (my $i=0; $i<@cvs_infos; $i++) {
    if ($cvs_infos[$i] =~ m/,/) {
        $cvs_info .= " $cvs_infos[$i]";
    }
    else {
        $cvs_info .= " $cvs_infos[$i],$cvs_infos[$i+1],$cvs_infos[$i+2]";
        $i = $i + 2;
    }
}
my @recip = grep /\@/, @ARGV;

# Check options
# ----------------------------------------------------------------------

if (!defined($cvs_root)) {
    die "\$CVSROOT not defined.\n";
}

# Language specific?
# ======================================================================

my $ja_convert = undef;
if ($lang eq 'ja') {
    eval('use Jcode');
    if ($@) {
        eval('require "$cvs_root/CVSROOT/scripts/jcode.pl"');
        if ($@) {
            die "Jcode.pm or jcode.pl required to process Japanese.\n";
        }
        $ja_convert = sub {
            jcode::convert($_[0], 'jis');
        };
    } else {
        $ja_convert = sub {
            Jcode::convert($_[0], 'jis');
        };
    }
}

# Parse %{sVv}
# ======================================================================

$cvs_info =~ s/ - (New directory|Imported sources)//g;
my ($cvs_module, @cvs_fileinfo) = split(/ /, $cvs_info);

my @cvs_file = my %cvs_rev_old = my %cvs_rev_new = ();
foreach my $cvs_fileinfo (@cvs_fileinfo) {
    my ($file, $rev_old, $rev_new) = split(/,/, $cvs_fileinfo);
    push(@cvs_file, $file);
    $cvs_rev_old{$file} = $rev_old;
    $cvs_rev_new{$file} = $rev_new;
}

# Get CVS username
# ======================================================================

my $cvs_user = $ENV{'CVS_USER'};
$cvs_user = getpwuid($EUID) if (!defined($cvs_user));
my $cvs_user_alias = (getpwnam($cvs_user))[6];
$cvs_user = $EUID if (!defined($cvs_user));

# Make mail header
# ======================================================================

$cvs_module =~ tr/\f\t\r\n//d;
my $header = <<EOF_HEADER;
Subject: CVS-Update: $cvs_module committed by $cvs_user
X-CVS-LogInfo: $CMD_NAME/$CMD_VERSION
X-CVS-Root: $cvs_root
X-CVS-User: $cvs_user
EOF_HEADER

if (defined($mail_return)) {
    $header .= "Errors-To: $mail_return\n";
}
if (defined($mail_from)) {
    if ($mail_from =~ m/^@/) {
        $header .= "From: $cvs_user_alias<$cvs_user$mail_from>\n";
    }
    else {
        $header .= "From: $mail_from\n";
    }
}
$header .= "To: ";
$header .= join(",\n ", @recip) . "\n";
$header .= 'Content-Type: text/plain';
$header .= '; charset=ISO-2022-JP' if ($opt_L eq 'ja');
$header .= "\n";
$header .= "MIME-Version: 1.0\n" if ($opt_L ne 'NONE');

foreach my $cvs_file (@cvs_file) {
    my $file = "$cvs_module/$cvs_file";
    my $rev_old = $cvs_rev_old{$cvs_file};
    my $rev_new = $cvs_rev_new{$cvs_file};

    if ($rev_old eq 'NONE') {
        $header .= "X-CVS-Added";
    } elsif ($rev_new eq 'NONE') {
        $header .= "X-CVS-Removed";
    } else {
        $header .= "X-CVS-Modified";
    }
    $header .= ": $file $rev_old->$rev_new\n";
}

# Send mail
# ======================================================================

my $fh_sendmail = new IO::File;
my $pid_sendmail = $fh_sendmail->open('|-');
if (!defined($pid_sendmail)) {   # fork failed
    print "Cannot fork child or open pipe: $!\n";
    exit(1);
} elsif ($pid_sendmail == 0) {   # child process
    if (!exec('sendmail', '-t', '-oi')) {
        print "Cannot exec sendmail: $!\n";
        exit(1);
    }
}

# Print header fields and log from cvs command
# ----------------------------------------------------------------------

$fh_sendmail->print($header);
$fh_sendmail->print("\n");
while (defined(my $line = STDIN->getline())) {
    if ($opt_L eq 'ja') {
        $ja_convert->(\$line);
    }
    $fh_sendmail->print($line);
}
$fh_sendmail->print("\n");

# Print commitment type and URL for web interface
# ----------------------------------------------------------------------

foreach my $cvs_file (@cvs_file) {
    my $file = "$cvs_module/$cvs_file";
    my $rev_old = $cvs_rev_old{$cvs_file};
    my $rev_new = $cvs_rev_new{$cvs_file};

    $fh_sendmail->print("$file $rev_old -> $rev_new (");
    if ($rev_old eq 'NONE') {
        $fh_sendmail->print('added');
    } elsif ($rev_new eq 'NONE') {
        $fh_sendmail->print('removed');
    } else {
        $fh_sendmail->print('modified');
    }
    $fh_sendmail->print(")\n");
    $fh_sendmail->print("$cvsweb_url/$file");

    if ($rev_old eq 'NONE' || $rev_new eq 'NONE') {
        $fh_sendmail->print("?rev=");
        $fh_sendmail->print($rev_old eq 'NONE' ? $rev_new : $rev_old);
        $fh_sendmail->print('&content-type=text/');
        if ($cvsweb_type eq 'cvsweb') {
            $fh_sendmail->print('x-cvsweb-markup');
        } else {
            $fh_sendmail->print('vnd.viewcvs-markup');
        }
        $fh_sendmail->print("\n");
    } else {
        $fh_sendmail->print(".diff?r1=$rev_old&r2=$rev_new\n");
    }
}

# Print diff by rcsdiff
# ----------------------------------------------------------------------

if ($diff_maxline == 0) {
    exit(0);
}

chdir($cvs_root) || die "Cannot change working directory: $!\n";
my $diff_line = 0;
foreach my $cvs_file (@cvs_file) {
    if ($diff_line == $diff_maxline) {
        $fh_sendmail->print("\n\n---------- Diff output was snipped here.\n");
        last;
    }

    my $file = "$cvs_module/$cvs_file,v";
    my $rev_old = $cvs_rev_old{$cvs_file};
    my $rev_new = $cvs_rev_new{$cvs_file};
    next if ($rev_new eq 'NONE' || $rev_old eq 'NONE');

    $fh_sendmail->print("\n");

    my $fh_rcsdiff = new IO::File;
    my $pid_rcsdiff = $fh_rcsdiff->open('-|');
    if (!defined($pid_rcsdiff)) {   # fork failed
        print "Cannot fork child or open pipe: $!\n";
        exit(1);
    } elsif ($pid_rcsdiff == 0) {   # child process
        open(STDERR, '>&STDOUT') || warn "Cannot duplicate stdout: $!\n";
        if (!exec('rcsdiff', '-u', '-kk', "-r$rev_old", "-r$rev_new", $file)) {
            print "Cannot exec rcsdiff: $!\n";
            exit(1);
        }
    }

    while (defined(my $line = $fh_rcsdiff->getline())) {
        if ($opt_L eq 'ja') {
            $ja_convert->(\$line);
        }
        $fh_sendmail->print($line);

        if ($diff_maxline > 0 && ++$diff_line == $diff_maxline) {
            last;
        }
    }
    # FIXME: Need close and wait for child?
}

# FIXME: Check sendmail exit code.

# Done
# ======================================================================

exit(0);
