##---------------------------------------------------------------------------##
##  File:
##	$Id: mhexternal.pl,v 2.19 2004/12/03 20:33:18 ehood Exp $
##  Author:
##      Earl Hood       mhonarc@mhonarc.org
##  Description:
##	Library defines a routine for MHonArc to filter content-types
##	that cannot be directly filtered into HTML, but a linked to an
##	external file.
##
##	Filter routine can be registered with the following:
##
##		<MIMEFILTERS>
##		*/*:m2h_external'filter:mhexternal.pl
##		</MIMEFILTERS>
##
##	Where '*/*' represents various content-types.  See code below for
##	all types supported.
##
##---------------------------------------------------------------------------##
##    MHonArc -- Internet mail-to-HTML converter
##    Copyright (C) 1995-2001	Earl Hood, mhonarc@mhonarc.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; if not, write to the Free Software
##    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
##    02111-1307, USA
##---------------------------------------------------------------------------##

package m2h_external;

##---------------------------------------------------------------------------
##	Filter routine.
##
##	Argument string may contain the following values.  Each value
##	should be separated by a space:
##
##	excludeexts="ext1,ext2,..."
##			A comma separated list of message specified filename
##			extensions to exclude.  I.e.  If the filename
##			extension matches an extension in excludeexts,
##			the content will not be written.  The return
##			markup will contain the name of the attachment,
##			but no link to the data.  This option is best
##			used with application/octet-stream to exclude
##			unwanted data that is not tagged with the proper
##			content-type.  The m2h_null::filter can be used
##			to exclude content by content-type.
##
##			Applicable when content-type not image/* and
##			usename or usenameext is in effect.
##
##	ext=ext 	Use `ext' as the filename extension.
##
##	forceattach 	Never inline image data.
##
##	forceinline 	Inline image data, always
##
##	frame		Draw a frame around the attachment link.
##
##	iconurl="url"	Use "url" for location of icon to use.
##			The quotes are required around the url.
##
##	inline  	Inline image data by default if
##			content-disposition not defined.
##
##	inlineexts="ext1,ext2,..."
##			A comma separated list of message specified filename
##			extensions to treat as possible inline data.
##			Applicable when content-type not image/* and
##			usename or usenameext is in effect.
##
##	subdir		Place derived files in a subdirectory
##
##      target=name     Set TARGET attribute for anchor link to file.
##			Defaults to not defined.
##
##	type="description"
##			Use "description" as type description of the
##			data.  The double quotes are required.
##
##	useicon		Include an icon as part of the link to the
##			extracted file.  Url for icon is obtained
##			ICONS resource or from the iconurl option.
##
##	usename 	Use (file)name attribute for determining name
##			of derived file.  Use this option with caution
##			since it can lead to filename conflicts and
##			security problems.
##
##	usenameext 	Use (file)name attribute for determining the
##			extension for the derived file.  Use this option
##			with caution since it can lead to security
##			problems.
##
sub filter {
    my ($fields, $data, $isdecode, $args) = @_;
    my ($ret, $filename, $urlfile);
    require 'mhmimetypes.pl';

    ## Init variables
    $args = '' unless defined($args);
    my $name       = '';
    my $ctype      = '';
    my $type       = '';
    my $inline     = 0;
    my $inext      = '';
    my $intype     = '';
    my $target     = '';
    my $path       = '';
    my $subdir     = $args =~ /\bsubdir\b/i;
    my $usename    = $args =~ /\busename\b/i;
    my $usenameext = $args =~ /\busenameext\b/i;
    my $debug      = $args =~ /\bdebug\b/i;
    my $inlineexts = '';
    my $excexts    = '';
    if ($args =~ /\binlineexts=(\S+)/) {
        $inlineexts = join("", ',', lc($1), ',');
        $inlineexts =~ s/['"]//g;
    }
    if ($args =~ /\bexcludeexts=(\S+)/) {
        $excexts = join("", ',', lc($1), ',');
        $excexts =~ s/['"]//g;
        &debug("Exclude extensions: $excexts") if $debug;
    }

    ## Get content-type
    if (!defined($ctype = $fields->{'x-mha-content-type'})) {
        ($ctype) = $fields->{'content-type'}[0] =~ m%^\s*([\w\-\./]+)%;
        $ctype =~ tr/A-Z/a-z/;
    }
    $type = (mhonarc::get_mime_ext($ctype))[1];

    ## Get disposition
    my ($disp, $nameparm, $raw_name, $html_name) =
        readmail::MAILhead_get_disposition($fields, 1);
    $name = $nameparm if $usename;
    &debug(
        "Content-type: $ctype",
        "Disposition: $disp; filename=$nameparm",
        "Arg-string: $args"
    ) if $debug;

    ## Get filename extension in disposition
    my $dispext = '';
    if ($nameparm && ($nameparm !~ /^\./) && ($nameparm =~ /\.(\w+)$/)) {
        $dispext = lc $1;
        &debug("Disposition filename extension: $dispext") if $debug;
    }

    ## Check if content is excluded based on filename extension
    if ($excexts && index($excexts, ",$dispext,") >= $[) {
        return (  qq|<p><tt>&lt;&lt;attachment: |
                . mhonarc::htmlize($nameparm)
                . qq|&gt;&gt;</tt></p>\n|);
    }

    ## Check if file goes in a subdirectory
    $path = join('', $mhonarc::MsgPrefix, $mhonarc::MHAmsgnum)
        if $subdir;

    ## Check if extension and type description passed in
    if ($args =~ /\bext=(\S+)/i) { $inext = $1; $inext =~ s/['"]//g; }
    if ($args =~ /\btype="([^"]+)"/i) { $intype = $1; }

    ## Check if utilizing extension from mail header defined filename
    if ($dispext && $usenameext) {
        $inext = $dispext;
    }

    ## Check if inlining (images only)
INLINESW: {
        if ($args =~ /\bforceattach\b/i) {
            $inline = 0;
            last INLINESW;
        }
        if ($args =~ /\bforceinline\b/i) {
            $inline = 1;
            last INLINESW;
        }
        if ($disp) {
            $inline = ($disp =~ /\binline\b/i);
            last INLINESW;
        }
        $inline = ($args =~ /\binline\b/i);
    }

    ## Check if target specified
    if    ($args =~ /target="([^"]+)"/i) { $target = $1; }
    elsif ($args =~ /target=(\S+)/i)     { $target = $1; }
    $target =~ s/['"]//g;
    $target = qq/ TARGET="$target"/ if $target;

    ## Write file
    ($filename, $urlfile) = mhonarc::write_attachment(
        $ctype, $data,
        {   '-dirpath'  => $path,
            '-filename' => $name,
            '-ext'      => $inext,
        }
    );
    &debug("File-written: $filename") if $debug;

    ## Check if inlining when CT not image/*
    if ($inline && ($ctype !~ /\bimage/i)) {
        if (   $inlineexts
            && ($usename || $usenameext)
            && ($filename =~ /\.(\w+)$/)) {
            my $fext = lc($1);
            $inline = 0 if (index($inlineexts, ",$fext,") < $[);
        } else {
            $inline = 0;
        }
    }

    ## Create HTML markup
    if ($inline) {
        $ret = '<p>'
            . mhonarc::htmlize($fields->{'content-description'}[0])
            . "</p>\n"
            if (defined $fields{'content-description'});
        $ret .= qq|<p><a href="$urlfile" $target><img src="$urlfile" |
            . qq|alt="$type"></a></p>\n|;

    } else {
        my $is_mesg = $ctype =~ /^message\//;
        my $desc    = '<em>Description:</em> ';
        my $namelabel;

        if ($is_mesg && ($$data =~ /^subject:\s(.+)$/mi)) {
            #$namelabel = mhonarc::htmlize($1);
            $namelabel = readmail::MAILdecode_1522_str($1);
            $desc .= 'Message attachment';
        } else {
            $desc .= mhonarc::htmlize($fields->{'content-description'}[0])
                || $type;
            if ($nameparm) {
                #$namelabel = mhonarc::htmlize($nameparm);
                $namelabel = $html_name;
            } elsif ($filename) {
                $namelabel = $filename;
                $namelabel =~ s/^.*$mhonarc::DIRSEPREX//o;
                mhonarc::htmlize(\$namelabel);
            } else {
                $namelabel = $ctype;
            }
        }

        # check if using icon
        my ($icon_mu, $iconurl, $iw, $ih);
        if ($args =~ /\buseicon\b/i) {
            if ($args =~ /\biconurl="([^"]+)"/i) {
                $iconurl = $1;
                if ($iconurl =~ s/\[(\d+)x(\d+)\]//) {
                    ($iw, $ih) = ($1, $2);
                }
            } else {
                ($iconurl, $iw, $ih) = mhonarc::get_icon_url($ctype);
            }
            if ($iconurl) {
                $icon_mu = join('',
                    '<img src="', $iconurl,
                    '" align="left" border=0 alt="Attachment:"');
                $icon_mu .= join('', ' width="',  $iw, '"') if $iw;
                $icon_mu .= join('', ' height="', $ih, '"') if $ih;
                $icon_mu .= '>';
            }
        }
        my $frame = $args =~ /\bframe\b/;
        if (!$frame) {
            if ($icon_mu) {
                $ret = <<EOT;

<p><strong><a href="$urlfile" $target>$icon_mu</a>
<a href="$urlfile" $target><tt>$namelabel</tt></a></strong><br>
$desc</p>
EOT
            } else {
                $ret = <<EOT;
<p><strong>Attachment:
<a href="$urlfile" $target><tt>$namelabel</tt></a></strong><br>
$desc</p>
EOT
            }
        } else {
            if ($icon_mu) {
                $ret = <<EOT;
<table border="1" cellspacing="0" cellpadding="4">
<tr valign="top"><td><strong><a href="$urlfile" $target>$icon_mu</a>
<a href="$urlfile" $target><tt>$namelabel</tt></a></strong><br>
$desc</td></tr></table>
EOT
            } else {
                $ret = <<EOT;
<table border="1" cellspacing="0" cellpadding="4">
<tr><td><strong>Attachment:
<a href="$urlfile" $target><tt>$namelabel</tt></a></strong><br>
$desc</td></tr></table>
EOT
            }
        }
    }

    # Mark part filtered
    my $cid = $fields->{'content-id'}[0]
        if (defined($fields->{'content-id'}));
    if (defined($cid)) {
        $cid =~ s/[\s<>]//g;
        $cid = 'cid:' . $cid;
    } elsif (defined($fields->{'content-location'})) {
        $cid = $fields->{'content-location'}[0];
        $cid =~ s/['"\s]//g;
    }
    if (defined($cid) && defined($readmail::Cid{$cid})) {
        $readmail::Cid{$cid}->{'filtered'} = 1;
        $readmail::Cid{$cid}->{'uri'}      = $filename;
    }

    ($ret, $path || $filename);
}

##---------------------------------------------------------------------------

sub debug {
    local ($_);
    foreach (@_) {
        print STDERR "m2h_external: ", $_;
        print STDERR "\n" unless /\n$/;
    }
}

##---------------------------------------------------------------------------
1;
