#! /usr/bin/perl -w

# vim:syntax=perl

use strict;

use lib '/usr/local/share/perl5';

use vars qw/ $tmpdir /;
use Getopt::Long;
use Lire::Config;
use Lire::Program qw( :msg tempfile tempdir $PROG $LR_ID );
use MIME::Entity;
use Cwd qw/getcwd/;
use File::Path qw/rmtree/;
use File::Basename qw/ basename /;

sub tar2htmlmail {
    my ( $msg, $tarfile ) = @_;

    my $or_dir = getcwd();

    lr_err( "tar isn't available" ) 
      unless $Lire::Config::tar || $Lire::Config::tar eq 'no';
    lr_err( "tar isn't executable" ) 
      unless -x $Lire::Config::tar;

    $tmpdir = tempdir( "$PROG.$LR_ID.XXXXXX");
    chdir $tmpdir
      or die "can't chdir to $tmpdir: $!\n";

    $tarfile = $or_dir . "/" . $tarfile 
      unless substr($tarfile, 0, 1) eq '/';
    system( "tar", "xf", $tarfile );
    die "tar exited with non-zero status: $?\n"
      if $?;
    chdir $or_dir
      or die "can't chdir back to $or_dir: $!\n";

    die "tar file doesn't contains a report directory\n"
      unless -d "$tmpdir/report";
    die "report directory doesn't contains a index.html or index.xhtm file\n"
      unless -e "$tmpdir/report/index.html" || -e "$tmpdir/report/index.xhtm";


    my @files = (-e "$tmpdir/report/index.html" ? "index.html" : "index.xhtm");
    opendir REPORTDIR, "$tmpdir/report"
      or die "can't opendir report directory: $!\n";
    push @files, grep { ! /^(index.x?html?|\.|\.\.)$/ } readdir REPORTDIR;
    closedir REPORTDIR;

    # Make all files absolute
    @files = map { $tmpdir . "/report/" . $_ } @files;

    setcidurl( grep { /\.x?html?$/ } @files );

    # Add the files to the MIME message
    foreach my $file ( @files ) {
	my $type;
	if ( $file =~ /\.html?$/ ) {
	    $type = "text/html";
	} elsif ( $file =~ /\.png$/ ) {
	    $type = "image/png";
	} elsif ( $file =~ /\.css$/ ) {
	    $type = "text/css";
	} elsif ( $file =~ /\.xhtm$/ ) {
	    $type = "text/xml";
	} else {
	    $type = "application/octet-stream";
	}

	my $id = basename( $file );
	$msg->attach( Path  => $file,
		      Id    => "<" . $id . ">",
		      Type  => $type,
		    );
    }
}

END {
    if ( defined $tmpdir && -d $tmpdir) {
	if ( $Lire::Config::LR_KEEP ) {
	    lr_info( "keeping temporary files in $tmpdir on your request. remove manually" );
	} else {
	    rmtree( $tmpdir, 0, 1);
	}
    }
}

sub url2cid {
    my ( $attr, $url ) = @_;
    
    if ( $url =~ /^([-a-z.0-9]+)(#.*)?$/ ) {
	$url = "cid:$1";
	$url .= $2 if defined $2;
    }
    return qq{$attr="$url"};
}

sub setcidurl {
    my @files = @_;

    foreach my $file ( @files ) {
	my ($fh, $tmpfile ) = tempfile( "fileXXXXXX", SUFFIX => ".html" );
	open FILE, $file 
	  or die "can't open $file: $!\n";

	my $line;
	while (defined ( $line = <FILE> )) {
	    # Transfrom relative URL to cid: URLs
	    $line =~ s/(href|src)="(.*?)"/url2cid( $1, $2 )/eg;
	    print $fh $line;
	}
	close $fh;
	close FILE;
	rename $tmpfile, $file
	  or die "failed to rename $tmpfile to $file: $!\n";
    }
}

my $usage =<<EOU;
Usage: $PROG [-f from] [-r reply-to] [-c type -a attach]* [-s subject] content-type reportfile to...
EOU
my %opts=(
	  'reply-to' => $ENV{LR_REPLYTO},
	  'from'     => $ENV{LR_FROM},
	 );
GetOptions( \%opts, "from=s", "reply-to=s", 'content-type=s@',
	    'attach=s@', "subject=s" )
  or lr_err( $usage );
@ARGV >= 3 or lr_err( $usage );

my ( $type, $file, @to ) = @ARGV;

if ( $opts{'content-type'} || $opts{'attach'} ) {
    lr_err( "the number of -c options must match the number of -a options" )
      unless $opts{'content-type'} && $opts{'attach'} &&
	@{$opts{'content-type'}} eq @{$opts{'attach'}};
}

# Check for prerequisite
lr_err( "sendmail isn't available" ) 
  unless $Lire::Config::sendmail || $Lire::Config::sendmail eq 'no';
lr_err( "sendmail isn't executable" ) 
  unless -x $Lire::Config::sendmail;


my @headers = ( 'To', join( ", ", @to) );
push @headers, "From", $opts{from}		if $opts{from};
push @headers, "Subject", $opts{subject}	if $opts{subject};
push @headers, "Reply-To", $opts{'reply-to'}	if $opts{'reply-to'};

eval {
    my $msg;
    if ( $type eq 'application/x-lire-html-report' ||
         $type eq 'application/x-lire-xhtml-report' )
    {
	$msg = MIME::Entity->build( @headers,
				    Type => "multipart/related",
				  );
	tar2htmlmail( $msg, $file );
    } else {
	$msg = MIME::Entity->build( @headers, 
				    Type => $type, 
				    Path => $file,
				  );
    }

    if ( $opts{'attach'} ) {
	for ( my $i=0; $i < @{$opts{'attach'}}; $i++ ) {
	    $msg->attach( Path => $opts{'attach'}[$i],
			  Type => $opts{'content-type'}[$i],
			);
	}
    }

    my $pid = open( SENDMAIL, "|-" );
    lr_err( "can't fork: $!\n" ) unless defined $pid;
    if ( $pid ) {
	# Parent
	$msg->print( \*SENDMAIL );
	close SENDMAIL
	  or lr_err( "error: sendmail exited with non zero status: $?" );
    } else {
	# Children, execute sendmail
	# We use this form of exec so that @to can't be used to trick 
	# a shell.
	exec( $Lire::Config::sendmail, @to )
	  or lr_err( "error executing sendmail: $!\n" );
    }
};
lr_err( $@ ) if $@;

exit 0;

# Local Variables:
# mode: cperl
# End:

__END__

=pod

=head1 NAME

lr_mail - Lire MIME mailer

=head1 SYNOPSIS 

B<lr_mail> [options] content-type file sendto...

=head1 DESCRIPTION

B<lr_mail> is a command line MIME mailer using MIME::Tools.

=head1 OPTIONS

=over 4

=item B<-f> I<email>

Sets the from address. Defaults to the value of the I<LR_FROM>
environment variable.

=item B<-r> I<email>

Sets the reply-to address. Defaults to the value of the I<LR_REPLYTO>
environment variable.

=item B<-s> I<subject>

Sets the subject of the email.

=item B<-c> I<content-type>

Sets the content-type for the next attachment.

=item B<-a> I<file>

Attach another file to the email.

=back

=head1 HTML MAIL

If the content-type of the file to send is
application/x-lire-html-report or application/x-lire-xhtml-report,
this script will extract the reports from the tar file and encode the
email so that it will display directly in an HTML mailer.

=head1 SEE ALSO

lr_xml2mail(1)

=head1 VERSION

$Id: lr_mail.in,v 1.8 2002/04/14 15:18:11 flacoste Exp $

=head1 COPYRIGHT

Copyright (C) 2002 Stichting LogReport Foundation LogReport@LogReport.org
 
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
 
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
 
You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html or write to the Free Software 
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111, USA.

=head1 AUTHOR

Francis J. Lacoste <flacoste@logreport.org>

=cut


