##---------------------------------------------------------------------------## ## File: ## @(#) mhexternal.pl 2.7 99/06/25 13:59:18 ## Author: ## Earl Hood mhonarc@pobox.com ## 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: ## ## ## */*:m2h_external'filter:mhexternal.pl ## ## ## Where '*/*' represents various content-types. See code below for ## all types supported. ## ##---------------------------------------------------------------------------## ## MHonArc -- Internet mail-to-HTML converter ## Copyright (C) 1995-1999 Earl Hood, mhonarc@pobox.com ## ## 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: ## ## ext=ext Use `ext' as the filename extension. ## ## forceattach Never inline image data. ## ## forceinline Inline image data, always ## ## iconurl="url" Use "url" for location of icon to use. ## ## 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 { local($header, *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 $iconurl = ''; my $icon_mu = ''; 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 = ''; if ($args =~ /\binlineexts=(\S+)/) { $inlineexts = ',' . lc($1) . ','; $inlineexts =~ s/['"]//g; } ## Get content-type ($ctype) = $fields{'content-type'} =~ 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; ## 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 ($nameparm && # filename specified, and $usenameext && # use filename ext option set, and ($nameparm !~ /^\./) && # filename does not begin w/dot, and ($nameparm =~ /\.(\w+)$/)) { # filename has an extention $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 using icon if ($args =~ /\buseicon\b/i) { $iconurl = $mhonarc::Icons{$ctype} || $mhonarc::Icons{'unknown'}; if ($args =~ /\biconurl="([^"]+)"/i) { $iconurl = $1; } $icon_mu = qq/ / if $iconurl; } ## 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 = "

" . &htmlize($fields{'content-description'}) . "

\n" if ($fields{'content-description'}); $ret .= qq|

\n|; } else { $ret = qq|

$icon_mu| . (&htmlize($fields{'content-description'}) || $nameparm || $type) . qq|

\n|; } ($ret, $path || $filename); } ##--------------------------------------------------------------------------- sub htmlize { my $txt = shift; return "" unless defined($txt); $txt =~ s/&/\&/g; $txt =~ s/>/>/g; $txt =~ s/