##---------------------------------------------------------------------------##
##  File:
##	$Id: mhmsgextbody.pl,v 1.5 2005/04/27 18:23:57 ehood Exp $
##  Author:
##      Earl Hood       mhonarc@mhonarc.org
##  Description:
##	Library defines routine to filter message/external-body parts to
##	HTML for MHonArc.
##	Filter routine can be registered with the following:
##          <MIMEFILTERS>
##          message/external-body;m2h_msg_extbody::filter;mhmsgextbody.pl
##          </MIMEFILTERS>
##---------------------------------------------------------------------------##
##    MHonArc -- Internet mail-to-HTML converter
##    Copyright (C) 1999-2001,2005	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_msg_extbody;

##---------------------------------------------------------------------------##
##	message/external-body filter for MHonArc.
##	The following filter arguments are recognized ($args):
##
##	local-file	Support local-file access-type.  This option
##			is best used for internal local mail archives
##			where it is known that readers will have
##			direct access to the file.
##
sub filter {
    my ($fields, $data, $isdecode, $args) = @_;
    $args = '' unless defined $args;

    # grab content-type
    my $ctype = $fields->{'content-type'}[0];
    return '' unless $ctype =~ /\S/;

    # parse argument string
    my $b_lfile = $args =~ /\blocal-file\b/i;

    my $ret         = '';
    my $parms       = readmail::MAILparse_parameter_str($ctype, 1);
    my $access_type = lc $parms->{'access-type'}{'value'};
    $access_type =~ s/\s//g;
    my $cdesc = mhonarc::htmlize($fields->{'content-description'}[0]) || '';

    $$data =~ s/\A\s+//;
    my $dfields = readmail::MAILread_header($data);
    my $dctype  = mhonarc::htmlize($dfields->{'content-type'}[0]) || '';
    my $dmd5    = mhonarc::htmlize($dfields->{'content-md5'}[0]) || '';
    my $size    = mhonarc::htmlize($parms->{'size'}{'value'}) || '';
    my $expires = mhonarc::htmlize($parms->{'expiration'}{'value'}) || '';
    my $name    = $parms->{'name'}{'value'} || '';

ATYPE: {
        ## FTP, TFTP, ANON-FTP
        if (   $access_type eq 'ftp'
            || $access_type eq 'anon-ftp'
            || $access_type eq 'tftp'
            || $access_type eq 'http'
            || $access_type eq 'x-http') {

            my $site =
                   $parms->{'site'}{'value'}
                || $parms->{'host'}{'value'}
                || '';

            my $port = $parms->{'port'}{'value'} || '';
            $port = ':' . $port if $port ne '';

            my $dir =
                   $parms->{'directory'}{'value'}
                || $parms->{'path'}{'value'}
                || '';
            $dir = '/' . $dir unless $dir =~ m|^/| || $dir eq '';

            my $mode = $parms->{'mode'}{'value'} || '';

            my $proto =
                ($access_type eq 'x-http' || $access_type eq 'http') ? 'http'
                : ($access_type eq 'tftp') ? 'tftp'
                :                            'ftp';
            my $url =
                  $proto . '://'
                . mhonarc::urlize($site . $port)
                . $dir . '/'
                . mhonarc::urlize_path($name);
            $ret = '<dl><dt>';
            $ret .= qq|<em>$cdesc</em><br>\n| if $cdesc;
            $ret .=
                qq|<a rel="nofollow" href="$url">&lt;$url&gt;</a></dt><dd>\n|;
            $ret .= qq|Content-type: <tt>$dctype</tt><br>\n|
                if $dctype;
            $ret .= qq|MD5: <tt>$dmd5</tt><br>\n|
                if $dmd5;
            $ret .= qq|Size: $size bytes<br>\n|
                if $size;
            $ret .= qq|Transfer-mode: <tt>$mode</tt><br>\n|
                if $mode;
            $ret .= qq|Expires: <tt>$expires</tt><br>\n|
                if $expires;
            $ret .= qq|Username/password may be required.<br>\n|
                if $access_type eq 'ftp';
            $ret .= "</dd></dl>\n";
            last ATYPE;
        }

        ## Local file
        if ($access_type eq 'local-file') {
            last ATYPE unless $b_lfile;
            my $site = $parms->{'site'}{'value'} || '';
            my $url = 'file://' . mhonarc::urlize_path($name);
            $ret = '<dl><dt>';
            $ret .= qq|<em>$cdesc</em><br>\n| if $cdesc;
            $ret .=
                qq|<a rel="nofollow" href="$url">&lt;$url&gt;</a></dt><dd>\n|;
            $ret .= qq|Content-type: <tt>$dctype</tt><br>\n|
                if $dctype;
            $ret .= qq|MD5: <tt>$dmd5</tt><br>\n|
                if $dmd5;
            $ret .= qq|Size: $size bytes<br>\n| if $size;
            $ret .= qq|Expires: <tt>$expires</tt><br>\n|
                if $expires;
            $ret .=
                  qq|File accessible from the following domain: |
                . qq|$site<br>\n|
                if $site;
            $ret .= "</dd></dl>\n";
            last ATYPE;
        }

        ## Mail server
        if ($access_type eq 'mail-server') {
            # not supported
            last ATYPE;
        }

        ## URL
        if ($access_type eq 'url') {
            my $url = $parms->{'url'}{'value'};
            $url =~ s/[\s<>]+//g;
            $url =~ s/javascript/_javascript_/ig;
            $ret = '<dl><dt>';
            $ret .= qq|<em>$cdesc</em><br>\n| if $cdesc;
            $ret .=
                qq|<a rel="nofollow" href="$url">&lt;$url&gt;</a></dt><dd>\n|;
            $ret .= qq|Content-type: <tt>$dctype</tt><br>\n|
                if $dctype;
            $ret .= qq|MD5: <tt>$dmd5</tt><br>\n|
                if $dmd5;
            $ret .= qq|Size: $size bytes<br>\n|
                if $size;
            $ret .= qq|Expires: <tt>$expires</tt><br>\n|
                if $expires;
            $ret .= "</dd></dl>\n";
            last ATYPE;
        }

        last ATYPE;
    }

    ($ret);
}

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