1##---------------------------------------------------------------------------##
2##  File:
3##	$Id: mhexternal.pl,v 2.19 2004/12/03 20:33:18 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
40package 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##
106sub filter {
107    my ($fields, $data, $isdecode, $args) = @_;
108    my ($ret, $filename, $urlfile);
109    require 'mhmimetypes.pl';
110
111    ## Init variables
112    $args = '' unless defined($args);
113    my $name       = '';
114    my $ctype      = '';
115    my $type       = '';
116    my $inline     = 0;
117    my $inext      = '';
118    my $intype     = '';
119    my $target     = '';
120    my $path       = '';
121    my $subdir     = $args =~ /\bsubdir\b/i;
122    my $usename    = $args =~ /\busename\b/i;
123    my $usenameext = $args =~ /\busenameext\b/i;
124    my $debug      = $args =~ /\bdebug\b/i;
125    my $inlineexts = '';
126    my $excexts    = '';
127    if ($args =~ /\binlineexts=(\S+)/) {
128        $inlineexts = join("", ',', lc($1), ',');
129        $inlineexts =~ s/['"]//g;
130    }
131    if ($args =~ /\bexcludeexts=(\S+)/) {
132        $excexts = join("", ',', lc($1), ',');
133        $excexts =~ s/['"]//g;
134        &debug("Exclude extensions: $excexts") if $debug;
135    }
136
137    ## Get content-type
138    if (!defined($ctype = $fields->{'x-mha-content-type'})) {
139        ($ctype) = $fields->{'content-type'}[0] =~ m%^\s*([\w\-\./]+)%;
140        $ctype =~ tr/A-Z/a-z/;
141    }
142    $type = (mhonarc::get_mime_ext($ctype))[1];
143
144    ## Get disposition
145    my ($disp, $nameparm, $raw_name, $html_name) =
146        readmail::MAILhead_get_disposition($fields, 1);
147    $name = $nameparm if $usename;
148    &debug(
149        "Content-type: $ctype",
150        "Disposition: $disp; filename=$nameparm",
151        "Arg-string: $args"
152    ) if $debug;
153
154    ## Get filename extension in disposition
155    my $dispext = '';
156    if ($nameparm && ($nameparm !~ /^\./) && ($nameparm =~ /\.(\w+)$/)) {
157        $dispext = lc $1;
158        &debug("Disposition filename extension: $dispext") if $debug;
159    }
160
161    ## Check if content is excluded based on filename extension
162    if ($excexts && index($excexts, ",$dispext,") >= $[) {
163        return (  qq|<p><tt>&lt;&lt;attachment: |
164                . mhonarc::htmlize($nameparm)
165                . qq|&gt;&gt;</tt></p>\n|);
166    }
167
168    ## Check if file goes in a subdirectory
169    $path = join('', $mhonarc::MsgPrefix, $mhonarc::MHAmsgnum)
170        if $subdir;
171
172    ## Check if extension and type description passed in
173    if ($args =~ /\bext=(\S+)/i) { $inext = $1; $inext =~ s/['"]//g; }
174    if ($args =~ /\btype="([^"]+)"/i) { $intype = $1; }
175
176    ## Check if utilizing extension from mail header defined filename
177    if ($dispext && $usenameext) {
178        $inext = $dispext;
179    }
180
181    ## Check if inlining (images only)
182INLINESW: {
183        if ($args =~ /\bforceattach\b/i) {
184            $inline = 0;
185            last INLINESW;
186        }
187        if ($args =~ /\bforceinline\b/i) {
188            $inline = 1;
189            last INLINESW;
190        }
191        if ($disp) {
192            $inline = ($disp =~ /\binline\b/i);
193            last INLINESW;
194        }
195        $inline = ($args =~ /\binline\b/i);
196    }
197
198    ## Check if target specified
199    if    ($args =~ /target="([^"]+)"/i) { $target = $1; }
200    elsif ($args =~ /target=(\S+)/i)     { $target = $1; }
201    $target =~ s/['"]//g;
202    $target = qq/ TARGET="$target"/ if $target;
203
204    ## Write file
205    ($filename, $urlfile) = mhonarc::write_attachment(
206        $ctype, $data,
207        {   '-dirpath'  => $path,
208            '-filename' => $name,
209            '-ext'      => $inext,
210        }
211    );
212    &debug("File-written: $filename") if $debug;
213
214    ## Check if inlining when CT not image/*
215    if ($inline && ($ctype !~ /\bimage/i)) {
216        if (   $inlineexts
217            && ($usename || $usenameext)
218            && ($filename =~ /\.(\w+)$/)) {
219            my $fext = lc($1);
220            $inline = 0 if (index($inlineexts, ",$fext,") < $[);
221        } else {
222            $inline = 0;
223        }
224    }
225
226    ## Create HTML markup
227    if ($inline) {
228        $ret = '<p>'
229            . mhonarc::htmlize($fields->{'content-description'}[0])
230            . "</p>\n"
231            if (defined $fields{'content-description'});
232        $ret .= qq|<p><a href="$urlfile" $target><img src="$urlfile" |
233            . qq|alt="$type"></a></p>\n|;
234
235    } else {
236        my $is_mesg = $ctype =~ /^message\//;
237        my $desc    = '<em>Description:</em> ';
238        my $namelabel;
239
240        if ($is_mesg && ($$data =~ /^subject:\s(.+)$/mi)) {
241            #$namelabel = mhonarc::htmlize($1);
242            $namelabel = readmail::MAILdecode_1522_str($1);
243            $desc .= 'Message attachment';
244        } else {
245            $desc .= mhonarc::htmlize($fields->{'content-description'}[0])
246                || $type;
247            if ($nameparm) {
248                #$namelabel = mhonarc::htmlize($nameparm);
249                $namelabel = $html_name;
250            } elsif ($filename) {
251                $namelabel = $filename;
252                $namelabel =~ s/^.*$mhonarc::DIRSEPREX//o;
253                mhonarc::htmlize(\$namelabel);
254            } else {
255                $namelabel = $ctype;
256            }
257        }
258
259        # check if using icon
260        my ($icon_mu, $iconurl, $iw, $ih);
261        if ($args =~ /\buseicon\b/i) {
262            if ($args =~ /\biconurl="([^"]+)"/i) {
263                $iconurl = $1;
264                if ($iconurl =~ s/\[(\d+)x(\d+)\]//) {
265                    ($iw, $ih) = ($1, $2);
266                }
267            } else {
268                ($iconurl, $iw, $ih) = mhonarc::get_icon_url($ctype);
269            }
270            if ($iconurl) {
271                $icon_mu = join('',
272                    '<img src="', $iconurl,
273                    '" align="left" border=0 alt="Attachment:"');
274                $icon_mu .= join('', ' width="',  $iw, '"') if $iw;
275                $icon_mu .= join('', ' height="', $ih, '"') if $ih;
276                $icon_mu .= '>';
277            }
278        }
279        my $frame = $args =~ /\bframe\b/;
280        if (!$frame) {
281            if ($icon_mu) {
282                $ret = <<EOT;
283
284<p><strong><a href="$urlfile" $target>$icon_mu</a>
285<a href="$urlfile" $target><tt>$namelabel</tt></a></strong><br>
286$desc</p>
287EOT
288            } else {
289                $ret = <<EOT;
290<p><strong>Attachment:
291<a href="$urlfile" $target><tt>$namelabel</tt></a></strong><br>
292$desc</p>
293EOT
294            }
295        } else {
296            if ($icon_mu) {
297                $ret = <<EOT;
298<table border="1" cellspacing="0" cellpadding="4">
299<tr valign="top"><td><strong><a href="$urlfile" $target>$icon_mu</a>
300<a href="$urlfile" $target><tt>$namelabel</tt></a></strong><br>
301$desc</td></tr></table>
302EOT
303            } else {
304                $ret = <<EOT;
305<table border="1" cellspacing="0" cellpadding="4">
306<tr><td><strong>Attachment:
307<a href="$urlfile" $target><tt>$namelabel</tt></a></strong><br>
308$desc</td></tr></table>
309EOT
310            }
311        }
312    }
313
314    # Mark part filtered
315    my $cid = $fields->{'content-id'}[0]
316        if (defined($fields->{'content-id'}));
317    if (defined($cid)) {
318        $cid =~ s/[\s<>]//g;
319        $cid = 'cid:' . $cid;
320    } elsif (defined($fields->{'content-location'})) {
321        $cid = $fields->{'content-location'}[0];
322        $cid =~ s/['"\s]//g;
323    }
324    if (defined($cid) && defined($readmail::Cid{$cid})) {
325        $readmail::Cid{$cid}->{'filtered'} = 1;
326        $readmail::Cid{$cid}->{'uri'}      = $filename;
327    }
328
329    ($ret, $path || $filename);
330}
331
332##---------------------------------------------------------------------------
333
334sub debug {
335    local ($_);
336    foreach (@_) {
337        print STDERR "m2h_external: ", $_;
338        print STDERR "\n" unless /\n$/;
339    }
340}
341
342##---------------------------------------------------------------------------
3431;
344