[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / mhexternal.pl

##---------------------------------------------------------------------------##
##  File:
##	$Id: mhexternal.pl,v 2.12 2002/10/11 01:57:53 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, $disp);
    require 'mhmimetypes.pl';

    ## Init variables
    $args	   = ''  unless defined($args);
    my $name	   = '';
    my $nameparm   = '';
    my $ctype	   = '';
    my $type	   = '';
    my $ext	   = '';
    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
    ($ctype) = $fields->{'content-type'}[0] =~ m%^\s*([\w\-\./]+)%;
    $ctype =~ tr/A-Z/a-z/;
    $type = (mhonarc::get_mime_ext($ctype))[1];

    ## Get disposition
    ($disp, $nameparm) = readmail::MAILhead_get_disposition($fields);
    $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 = $1;
    }

    ## 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 = mhonarc::write_attachment($ctype, $data, $path, $name, $inext);
    ($urlfile = $filename) =~ s/([^\w.\-\/])/sprintf("%%%X",unpack("C",$1))/ge;
    &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);
	    $desc .= 'Message attachment';
	} else {
	    $desc .= mhonarc::htmlize($fields->{'content-description'}[0]) ||
		     $type;
	    $namelabel = mhonarc::htmlize($nameparm || $urlfile);
	}

	# 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;
Commit	Line	Data
86530b38 AT	1	##---------------------------------------------------------------------------##
	2	## File:
	3	## $Id: mhexternal.pl,v 2.12 2002/10/11 01:57:53 ehood Exp $
	4	## Author:
	5	## Earl Hood mhonarc@mhonarc.org
	6	## Description:
	7	## Library defines a routine for MHonArc to filter content-types
	8	## that cannot be directly filtered into HTML, but a linked to an
	9	## external file.
	10	##
	11	## Filter routine can be registered with the following:
	12	##
	13	## <MIMEFILTERS>
	14	## /:m2h_external'filter:mhexternal.pl
	15	## </MIMEFILTERS>
	16	##
	17	## Where '/' represents various content-types. See code below for
	18	## all types supported.
	19	##
	20	##---------------------------------------------------------------------------##
	21	## MHonArc -- Internet mail-to-HTML converter
	22	## Copyright (C) 1995-2001 Earl Hood, mhonarc@mhonarc.org
	23	##
	24	## This program is free software; you can redistribute it and/or modify
	25	## it under the terms of the GNU General Public License as published by
	26	## the Free Software Foundation; either version 2 of the License, or
	27	## (at your option) any later version.
	28	##
	29	## This program is distributed in the hope that it will be useful,
	30	## but WITHOUT ANY WARRANTY; without even the implied warranty of
	31	## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	32	## GNU General Public License for more details.
	33	##
	34	## You should have received a copy of the GNU General Public License
	35	## along with this program; if not, write to the Free Software
	36	## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
	37	## 02111-1307, USA
	38	##---------------------------------------------------------------------------##
	39
	40	package m2h_external;
	41
	42	##---------------------------------------------------------------------------
	43	## Filter routine.
	44	##
	45	## Argument string may contain the following values. Each value
	46	## should be separated by a space:
	47	##
	48	## excludeexts="ext1,ext2,..."
	49	## A comma separated list of message specified filename
	50	## extensions to exclude. I.e. If the filename
	51	## extension matches an extension in excludeexts,
	52	## the content will not be written. The return
	53	## markup will contain the name of the attachment,
	54	## but no link to the data. This option is best
	55	## used with application/octet-stream to exclude
	56	## unwanted data that is not tagged with the proper
	57	## content-type. The m2h_null::filter can be used
	58	## to exclude content by content-type.
	59	##
	60	## Applicable when content-type not image/* and
	61	## usename or usenameext is in effect.
	62	##
	63	## ext=ext Use `ext' as the filename extension.
	64	##
65	## forceattach Never inline image data.
66	##
67	## forceinline Inline image data, always
68	##
69	## frame Draw a frame around the attachment link.
70	##
71	## iconurl="url" Use "url" for location of icon to use.
72	## The quotes are required around the url.
73	##
74	## inline Inline image data by default if
75	## content-disposition not defined.
76	##
77	## inlineexts="ext1,ext2,..."
78	## A comma separated list of message specified filename
79	## extensions to treat as possible inline data.
80	## Applicable when content-type not image/* and
81	## usename or usenameext is in effect.
82	##
83	## subdir Place derived files in a subdirectory
84	##
85	## target=name Set TARGET attribute for anchor link to file.
86	## Defaults to not defined.
87	##
88	## type="description"
89	## Use "description" as type description of the
90	## data. The double quotes are required.
91	##
92	## useicon Include an icon as part of the link to the
93	## extracted file. Url for icon is obtained
94	## ICONS resource or from the iconurl option.
95	##
96	## usename Use (file)name attribute for determining name
97	## of derived file. Use this option with caution
98	## since it can lead to filename conflicts and
99	## security problems.
100	##
101	## usenameext Use (file)name attribute for determining the
102	## extension for the derived file. Use this option
103	## with caution since it can lead to security
104	## problems.
105	##
106	sub filter {
107	my($fields, $data, $isdecode, $args) = @_;
108	my($ret, $filename, $urlfile, $disp);
109	require 'mhmimetypes.pl';
110
111	## Init variables
112	$args = '' unless defined($args);
113	my $name = '';
114	my $nameparm = '';
115	my $ctype = '';
116	my $type = '';
117	my $ext = '';
118	my $inline = 0;
119	my $inext = '';
120	my $intype = '';
121	my $target = '';
122	my $path = '';
123	my $subdir = $args =~ /\bsubdir\b/i;
124	my $usename = $args =~ /\busename\b/i;
125	my $usenameext = $args =~ /\busenameext\b/i;
126	my $debug = $args =~ /\bdebug\b/i;
127	my $inlineexts = '';
128	my $excexts = '';
129	if ($args =~ /\binlineexts=(\S+)/) {
130	$inlineexts = join("", ',', lc($1), ',');
131	$inlineexts =~ s/['"]//g;
132	}
133	if ($args =~ /\bexcludeexts=(\S+)/) {
134	$excexts = join("", ',', lc($1), ',');
135	$excexts =~ s/['"]//g;
136	&debug("Exclude extensions: $excexts") if $debug;
137	}
138
139	## Get content-type
140	($ctype) = $fields->{'content-type'}[0] =~ m%^\s*([\w\-\./]+)%;
141	$ctype =~ tr/A-Z/a-z/;
142	$type = (mhonarc::get_mime_ext($ctype))[1];
143
144	## Get disposition
145	($disp, $nameparm) = readmail::MAILhead_get_disposition($fields);
146	$name = $nameparm if $usename;
147	&debug("Content-type: $ctype",
148	"Disposition: $disp; filename=$nameparm",
149	"Arg-string: $args") if $debug;
150
151	## Get filename extension in disposition
152	my $dispext = '';
153	if ($nameparm && ($nameparm !~ /^\./) && ($nameparm =~ /\.(\w+)$/)) {
154	$dispext = lc $1;
155	&debug("Disposition filename extension: $dispext") if $debug;
156	}
157
158	## Check if content is excluded based on filename extension
159	if ($excexts && index($excexts, ",$dispext,") >= $[) {
160	return (qq\|<p><tt>&lt<attachment: \|.
161	mhonarc::htmlize($nameparm).
162	qq\|>></tt></p>\n\|);
163	}
164
165	## Check if file goes in a subdirectory
166	$path = join('', $mhonarc::MsgPrefix, $mhonarc::MHAmsgnum)
167	if $subdir;
168
169	## Check if extension and type description passed in
170	if ($args =~ /\bext=(\S+)/i) { $inext = $1; $inext =~ s/['"]//g; }
171	if ($args =~ /\btype="([^"]+)"/i) { $intype = $1; }
172
173	## Check if utilizing extension from mail header defined filename
174	if ($dispext && $usenameext) {
175	$inext = $1;
176	}
177
178	## Check if inlining (images only)
179	INLINESW: {
180	if ($args =~ /\bforceattach\b/i) {
181	$inline = 0;
182	last INLINESW;
183	}
184	if ($args =~ /\bforceinline\b/i) {
185	$inline = 1;
186	last INLINESW;
187	}
188	if ($disp) {
189	$inline = ($disp =~ /\binline\b/i);
190	last INLINESW;
191	}
192	$inline = ($args =~ /\binline\b/i);
193	}
194
195	## Check if target specified
196	if ($args =~ /target="([^"]+)"/i) { $target = $1; }
197	elsif ($args =~ /target=(\S+)/i) { $target = $1; }
198	$target =~ s/['"]//g;
199	$target = qq/ TARGET="$target"/ if $target;
200
201	## Write file
202	$filename = mhonarc::write_attachment($ctype, $data, $path, $name, $inext);
203	($urlfile = $filename) =~ s/([^\w.\-\/])/sprintf("%%%X",unpack("C",$1))/ge;
204	&debug("File-written: $filename") if $debug;
205
206	## Check if inlining when CT not image/*
207	if ($inline && ($ctype !~ /\bimage/i)) {
208	if ($inlineexts && ($usename \|\| $usenameext) &&
209	($filename =~ /\.(\w+)$/)) {
210	my $fext = lc($1);
211	$inline = 0 if (index($inlineexts, ",$fext,") < $[);
212	} else {
213	$inline = 0;
214	}
215	}
216
217	## Create HTML markup
218	if ($inline) {
219	$ret = '<p>'.
220	mhonarc::htmlize($fields->{'content-description'}[0]).
221	"</p>\n"
222	if (defined $fields{'content-description'});
223	$ret .= qq\|<p><a href="$urlfile" $target><img src="$urlfile" \| .
224	qq\|alt="$type"></a></p>\n\|;
225
226	} else {
227	my $is_mesg = $ctype =~ /^message\//;
228	my $desc = '<em>Description:</em> ';
229	my $namelabel;
230
231	if ($is_mesg && ($$data =~ /^subject:\s(.+)$/mi)) {
232	$namelabel = mhonarc::htmlize($1);
233	$desc .= 'Message attachment';
234	} else {
235	$desc .= mhonarc::htmlize($fields->{'content-description'}[0]) \|\|
236	$type;
237	$namelabel = mhonarc::htmlize($nameparm \|\| $urlfile);
238	}
239
240	# check if using icon
241	my($icon_mu, $iconurl, $iw, $ih);
242	if ($args =~ /\buseicon\b/i) {
243	if ($args =~ /\biconurl="([^"]+)"/i) {
244	$iconurl = $1;
245	if ($iconurl =~ s/\[(\d+)x(\d+)\]//) {
246	($iw, $ih) = ($1, $2);
247	}
248	} else {
249	($iconurl, $iw, $ih) = mhonarc::get_icon_url($ctype);
250	}
251	if ($iconurl) {
252	$icon_mu = join('', '<img src="', $iconurl,
253	'" align="left" border=0 alt="Attachment:"');
254	$icon_mu .= join('', ' width="', $iw, '"') if $iw;
255	$icon_mu .= join('', ' height="', $ih, '"') if $ih;
256	$icon_mu .= '>';
257	}
258	}
259	my $frame = $args =~ /\bframe\b/;
260	if (!$frame) {
261	if ($icon_mu) {
262	$ret =<<EOT;
263
264	<p><strong><a href="$urlfile" $target>$icon_mu</a>
265	<a href="$urlfile" $target><tt>$namelabel</tt></a></strong><br>
266	$desc</p>
267	EOT
268	} else {
269	$ret =<<EOT;
270	<p><strong>Attachment:
271	<a href="$urlfile" $target><tt>$namelabel</tt></a></strong><br>
272	$desc</p>
273	EOT
274	}
275	} else {
276	if ($icon_mu) {
277	$ret =<<EOT;
278	<table border="1" cellspacing="0" cellpadding="4">
279	<tr valign="top"><td><strong><a href="$urlfile" $target>$icon_mu</a>
280	<a href="$urlfile" $target><tt>$namelabel</tt></a></strong><br>
281	$desc</td></tr></table>
282	EOT
283	} else {
284	$ret =<<EOT;
285	<table border="1" cellspacing="0" cellpadding="4">
286	<tr><td><strong>Attachment:
287	<a href="$urlfile" $target><tt>$namelabel</tt></a></strong><br>
288	$desc</td></tr></table>
289	EOT
290	}
291	}
292	}
293
294	# Mark part filtered
295	my $cid = $fields->{'content-id'}[0]
296	if (defined($fields->{'content-id'}));
297	if (defined($cid)) {
298	$cid =~ s/[\s<>]//g;
299	$cid = 'cid:'.$cid;
300	} elsif (defined($fields->{'content-location'})) {
301	$cid = $fields->{'content-location'}[0];
302	$cid =~ s/['"\s]//g;
303	}
304	if (defined($cid) && defined($readmail::Cid{$cid})) {
305	$readmail::Cid{$cid}->{'filtered'} = 1;
306	$readmail::Cid{$cid}->{'uri'} = $filename;
307	}
308
309	($ret, $path \|\| $filename);
310	}
311
312	##---------------------------------------------------------------------------
313
314	sub debug {
315	local($_);
316	foreach (@_) {
317	print STDERR "m2h_external: ", $_;
318	print STDERR "\n" unless /\n$/;
319	}
320	}
321
322	##---------------------------------------------------------------------------
323	1;