<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">##---------------------------------------------------------------------------##
##  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:
##          &lt;MIMEFILTERS&gt;
##          message/external-body;m2h_msg_extbody::filter;mhmsgextbody.pl
##          &lt;/MIMEFILTERS&gt;
##---------------------------------------------------------------------------##
##    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-&gt;{'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-&gt;{'access-type'}{'value'};
       $access_type =~ s/\s//g;
    my $cdesc = mhonarc::htmlize($fields-&gt;{'content-description'}[0]) || '';

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

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

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

	    my $mode 	 = $parms-&gt;{'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	 = '&lt;dl&gt;&lt;dt&gt;';
	    $ret	.= qq|&lt;em&gt;$cdesc&lt;/em&gt;&lt;br&gt;\n| if $cdesc;
	    $ret	.= qq|&lt;a rel="nofollow" href="$url"&gt;&amp;lt;$url&amp;gt;&lt;/a&gt;&lt;/dt&gt;&lt;dd&gt;\n|;
	    $ret	.= qq|Content-type: &lt;tt&gt;$dctype&lt;/tt&gt;&lt;br&gt;\n|
			    if $dctype;
	    $ret	.= qq|MD5: &lt;tt&gt;$dmd5&lt;/tt&gt;&lt;br&gt;\n|
			    if $dmd5;
	    $ret	.= qq|Size: $size bytes&lt;br&gt;\n|
			    if $size;
	    $ret	.= qq|Transfer-mode: &lt;tt&gt;$mode&lt;/tt&gt;&lt;br&gt;\n|
			    if $mode;
	    $ret	.= qq|Expires: &lt;tt&gt;$expires&lt;/tt&gt;&lt;br&gt;\n|
			    if $expires;
	    $ret	.= qq|Username/password may be required.&lt;br&gt;\n|
			    if $access_type eq 'ftp';
	    $ret	.= "&lt;/dd&gt;&lt;/dl&gt;\n";
	    last ATYPE;
	}

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

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

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

	last ATYPE;
    }

    ($ret);
}

##---------------------------------------------------------------------------##
1;
</pre></body></html>