| 1 | ##---------------------------------------------------------------------------## |
| 2 | ## File: |
| 3 | ## $Id: mhmsgextbody.pl,v 1.3 2001/09/05 15:48:15 ehood Exp $ |
| 4 | ## Author: |
| 5 | ## Earl Hood mhonarc@mhonarc.org |
| 6 | ## Description: |
| 7 | ## Library defines routine to filter message/external-body parts to |
| 8 | ## HTML for MHonArc. |
| 9 | ## Filter routine can be registered with the following: |
| 10 | ## <MIMEFILTERS> |
| 11 | ## message/external-body;m2h_msg_extbody::filter;mhmsgextbody.pl |
| 12 | ## </MIMEFILTERS> |
| 13 | ##---------------------------------------------------------------------------## |
| 14 | ## MHonArc -- Internet mail-to-HTML converter |
| 15 | ## Copyright (C) 1999-2001 Earl Hood, mhonarc@mhonarc.org |
| 16 | ## |
| 17 | ## This program is free software; you can redistribute it and/or modify |
| 18 | ## it under the terms of the GNU General Public License as published by |
| 19 | ## the Free Software Foundation; either version 2 of the License, or |
| 20 | ## (at your option) any later version. |
| 21 | ## |
| 22 | ## This program is distributed in the hope that it will be useful, |
| 23 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 24 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 25 | ## GNU General Public License for more details. |
| 26 | ## |
| 27 | ## You should have received a copy of the GNU General Public License |
| 28 | ## along with this program; if not, write to the Free Software |
| 29 | ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA |
| 30 | ## 02111-1307, USA |
| 31 | ##---------------------------------------------------------------------------## |
| 32 | |
| 33 | package m2h_msg_extbody; |
| 34 | |
| 35 | ##---------------------------------------------------------------------------## |
| 36 | ## message/external-body filter for MHonArc. |
| 37 | ## The following filter arguments are recognized ($args): |
| 38 | ## |
| 39 | ## local-file Support local-file access-type. This option |
| 40 | ## is best used for internal local mail archives |
| 41 | ## where it is known that readers will have |
| 42 | ## direct access to the file. |
| 43 | ## |
| 44 | sub filter { |
| 45 | my($fields, $data, $isdecode, $args) = @_; |
| 46 | $args = '' unless defined $args; |
| 47 | |
| 48 | # grab content-type |
| 49 | my $ctype = $fields->{'content-type'}[0]; |
| 50 | return '' unless $ctype =~ /\S/; |
| 51 | |
| 52 | # parse argument string |
| 53 | my $b_lfile = $args =~ /\blocal-file\b/i; |
| 54 | |
| 55 | my $ret = ""; |
| 56 | my $parms = readmail::MAILparse_parameter_str($ctype, 1); |
| 57 | my $access_type = lc $parms->{'access-type'}{'value'}; |
| 58 | $access_type =~ s/\s//g; |
| 59 | my $cdesc = $fields->{'content-description'}[0] || ""; |
| 60 | |
| 61 | $$data =~ s/\A\s+//; |
| 62 | my $dfields = readmail::MAILread_header($data); |
| 63 | my $dctype = $dfields->{'content-type'}[0] || ""; |
| 64 | my $dcte = $dfields->{'content-transfer-encoding'}[0] || ""; |
| 65 | my $dmd5 = $dfields->{'content-md5'}[0] || ""; |
| 66 | my $size = $parms->{'size'}{'value'} || ""; |
| 67 | my $perms = $parms->{'permission'}{'value'} || ""; |
| 68 | my $expires = $parms->{'expiration'}{'value'} || ""; |
| 69 | my $name = $parms->{'name'}{'value'} || ""; |
| 70 | |
| 71 | ATYPE: { |
| 72 | ## FTP, TFTP, ANON-FTP |
| 73 | if ( $access_type eq 'ftp' || |
| 74 | $access_type eq 'anon-ftp' || |
| 75 | $access_type eq 'tftp' ) { |
| 76 | my $site = $parms->{'site'}{'value'}; |
| 77 | my $dir = $parms->{'directory'}{'value'} || ""; |
| 78 | $dir = '/'.$dir unless $dir =~ m|^/| || $dir eq ""; |
| 79 | my $mode = $parms->{'mode'}{'value'} || ""; |
| 80 | my $proto = $access_type eq 'tftp' ? 'tftp' : 'ftp'; |
| 81 | my $url = "$proto://" . |
| 82 | mhonarc::urlize($site) . |
| 83 | $dir . '/' . |
| 84 | mhonarc::urlize($name); |
| 85 | $ret = '<dl><dt>'; |
| 86 | $ret .= qq|<a href="$url">$cdesc</a><br>\n| |
| 87 | if $cdesc; |
| 88 | $ret .= qq|<a href="$url"><$url></a></dt><dd>\n|; |
| 89 | $ret .= qq|Content-type: <tt>$dctype</tt><br>\n| |
| 90 | if $dctype; |
| 91 | $ret .= qq|MD5: <tt>$dmd5</tt><br>\n| |
| 92 | if $dmd5; |
| 93 | $ret .= qq|Size: $size bytes<br>\n| |
| 94 | if $size; |
| 95 | $ret .= qq|Transfer-mode: <tt>$mode</tt><br>\n| |
| 96 | if $mode; |
| 97 | $ret .= qq|Expires: <tt>$expires</tt><br>\n| |
| 98 | if $expires; |
| 99 | $ret .= qq|Username/password may be required.<br>\n| |
| 100 | if $access_type eq 'ftp'; |
| 101 | $ret .= "</dd></dl>\n"; |
| 102 | last ATYPE; |
| 103 | } |
| 104 | |
| 105 | ## Local file |
| 106 | if ($access_type eq 'local-file') { |
| 107 | last ATYPE unless $b_lfile; |
| 108 | my $site = $parms->{'site'}{'value'} || ""; |
| 109 | my $url = mhonarc::urlize("file://$name"); |
| 110 | $ret = '<dl><dt>'; |
| 111 | $ret .= qq|<a href="$url">$cdesc</a><br>\n| if $cdesc; |
| 112 | $ret .= qq|<a href="$url"><$url></a></dt><dd>\n|; |
| 113 | $ret .= qq|Content-type: <tt>$dctype</tt><br>\n| |
| 114 | if $dctype; |
| 115 | $ret .= qq|MD5: <tt>$dmd5</tt><br>\n| |
| 116 | if $dmd5; |
| 117 | $ret .= qq|Size: $size bytes<br>\n| if $size; |
| 118 | $ret .= qq|Expires: <tt>$expires</tt><br>\n| |
| 119 | if $expires; |
| 120 | $ret .= qq|File accessible from the following domain: | . |
| 121 | qq|$site<br>\n| if $site; |
| 122 | $ret .= "</dd></dl>\n"; |
| 123 | last ATYPE; |
| 124 | } |
| 125 | |
| 126 | ## Mail server |
| 127 | if ($access_type eq 'mail-server') { |
| 128 | # not supported |
| 129 | last ATYPE; |
| 130 | } |
| 131 | |
| 132 | ## URL |
| 133 | if ($access_type eq 'url') { |
| 134 | my $url = $parms->{'url'}{'value'}; |
| 135 | $url =~ s/\s+//g; |
| 136 | $ret = '<dl><dt>'; |
| 137 | $ret .= qq|<a href="$url">$cdesc</a><br>\n| if $cdesc; |
| 138 | $ret .= qq|<a href="$url"><$url></a></dt><dd>\n|; |
| 139 | $ret .= qq|Content-type: <tt>$dctype</tt><br>\n| |
| 140 | if $dctype; |
| 141 | $ret .= qq|MD5: <tt>$dmd5</tt><br>\n| |
| 142 | if $dmd5; |
| 143 | $ret .= qq|Size: $size bytes<br>\n| |
| 144 | if $size; |
| 145 | $ret .= qq|Expires: <tt>$expires</tt><br>\n| |
| 146 | if $expires; |
| 147 | $ret .= "</dd></dl>\n"; |
| 148 | last ATYPE; |
| 149 | } |
| 150 | |
| 151 | last ATYPE; |
| 152 | } |
| 153 | |
| 154 | ($ret); |
| 155 | } |
| 156 | |
| 157 | ##---------------------------------------------------------------------------## |
| 158 | 1; |