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><<attachment: | 164 . mhonarc::htmlize($nameparm) 165 . qq|>></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