lib/mimew.pl

   1 package MIME;
   2 # Copyright (C) 1993-94,1997 Noboru Ikuta <noboru@ikuta.ichihara.chiba.jp>
   3 #
   4 # mimew.pl: MIME encoder library Ver.2.02 (1997/12/30)
   5
   6 $main'mimew_version = "2.02";
   7
   8 # \e$B%$%s%9%H!<%k\e(B : @INC \e$B$N%G%#%l%/%H%j!JDL>o$O\e(B /usr/local/lib/perl\e$B!K$K%3%T!<\e(B
   9 #                \e$B$7$F2<$5$$!#\e(B
  10 #
  11 # \e$B;HMQNc\e(B1 : require 'mimew.pl';
  12 #           $from = "From: \e$B@8ED\e(B \e$B>:\e(B <noboru\@ikuta.ichihara.chiba.jp>";
  13 #           print &mimeencode($from);
  14 #
  15 # \e$B;HMQNc\e(B2 : # UNIX\e$B$G\e(BBase64\e$B%(%s%3!<%I$9$k>l9g\e(B
  16 #           require 'mimew.pl';
  17 #           undef $/;
  18 #           $body = <>;
  19 #           print &bodyencode($body);
  20 #           print &benflush;
  21 #
  22 # &bodyencode($data,$coding):
  23 #   \e$B%G!<%?$r\e(BBase64\e$B7A<0$^$?$O\e(BQuoted-Printable\e$B7A<0$G%(%s%3!<%I$9$k!#\e(B
  24 #   \e$BBh\e(B2\e$B%Q%i%a!<%?$K\e(B"qp"\e$B$^$?$O\e(B"b64"\e$B$r;XDj$9$k$3$H$K$h$j%3!<%G%#%s%07A<0\e(B
  25 #   \e$B$r;X<($9$k$3$H$,$G$-$k!#Bh\e(B2\e$B%Q%i%a!<%?$r>JN,$9$k$H\e(BBase64\e$B7A<0$G%(%s\e(B
  26 #   \e$B%3!<%I$9$k!#\e(B
  27 #   Base64\e$B7A<0$N%(%s%3!<%I$N>l9g$O!"\e(B$foldcol*3/4 \e$B%P%$%HC10L$GJQ49$9$k\e(B
  28 #   \e$B$N$G!"EO$5$l$?%G!<%?$N$&$AH>C<$JItJ,$O%P%C%U%!$KJ]B8$5$l<!$K8F$P$l\e(B
  29 #   \e$B$?$H$-$K=hM}$5$l$k!#:G8e$K%P%C%U%!$K;D$C$?%G!<%?$O\e(B&benflush\e$B$r8F$V\e(B
  30 #   \e$B$3$H$K$h$j=hM}$5$l%P%C%U%!$+$i%/%j%"$5$l$k!#\e(B
  31 #   Quoted-Printable\e$B7A<0$N%(%s%3!<%I$N>l9g$O!"9TC10L$GJQ49$9$k$?$a!"\e(B
  32 #   \e$B%G!<%?$N:G8e$K2~9TJ8;z$,L5$$>l9g!":G8e$N2~9TJ8;z$N8e$m$N%G!<%?$O\e(B
  33 #   \e$B%P%C%U%!$KJ]B8$5$l!"<!$K8F$P$l$?$H$-$K=hM}$5$l$k!#:G8e$K%P%C%U%!\e(B
  34 #   \e$B$K;D$C$?%G!<%?$O\e(B&benflush("qp")\e$B$r8F$V$3$H$K$h$j=hM}$5$l%P%C%U%!\e(B
  35 #   \e$B$+$i%/%j%"$5$l$k!#\e(B
  36 #
  37 # &benflush($coding):
  38 #   \e$BBh\e(B1\e$B%Q%i%a!<%?$K\e(B"b64"\e$B$^$?$O\e(B"qp"\e$B$r;XDj$9$k$3$H$K$h$j!"$=$l$>$l\e(BBase64
  39 #   \e$B7A<0$^$?$O\e(BQuoted-Printable\e$B7A<0$N%(%s%3!<%I$r;XDj$9$k$3$H$,$G$-$k!#\e(B
  40 #   \e$BBh\e(B1\e$B%Q%i%a!<%?$K2?$b;XDj$7$J$1$l$P\e(BBase64\e$B7A<0$G%(%s%3!<%I$5$l$k!#\e(B
  41 #   Base64\e$B$N%(%s%3!<%I$N>l9g!"\e(B&bodyencode\e$B$,=hM}$7;D$7$?%G!<%?$r=hM}$7\e(B
  42 #   pad\e$BJ8;z$r=PNO$9$k!#\e(BQuoted-Printable\e$B$N>l9g!"9TC10L$G$J$/%V%m%C%/C1\e(B
  43 #   \e$B0L$G\e(B&bodyencode\e$B$r8F$V>l9g!"\e(B&bodyencode\e$B$,=hM}$7;D$7$?%G!<%?$,$b$7\e(B
  44 #   \e$B%P%C%U%!$K;D$C$F$$$l$P$=$l$r=hM}$9$k!#\e(B
  45 #   \e$B0l$D$N%G!<%?$r\e(B(1\e$B2s$^$?$O2?2s$+$KJ,$1$F\e(B)&bodyencode\e$B$7$?8e$KI,$:\e(B1\e$B2s\e(B
  46 #   \e$B8F$VI,MW$,$"$k!#\e(B
  47 #
  48 # &mimeencode($text):
  49 #   \e$BBh\e(B1\e$B%Q%i%a!<%?$,F|K\8lJ8;zNs$r4^$s$G$$$l$P!"$=$NItJ,$r\e(BISO-2022-JP\e$B$K\e(B
  50 #   \e$BJQ49$7$?$"$H!"\e(BMIME encoded-word(RFC2047\e$B;2>H\e(B)\e$B$KJQ49$9$k!#I,MW$K1~$8\e(B
  51 #   \e$B$F\e(Bencoded-word\e$B$NJ,3d$H\e(Bencoded-word\e$B$NA08e$G$N9TJ,3d$r9T$&!#\e(B
  52 #
  53 #   \e$BJ8;z%3!<%I$N<+F0H=Dj$O!"F10l9T$K\e(BShiftJIS\e$B$H\e(BEUC\e$B$,:.:_$7$F$$$k>l9g$r\e(B
  54 #   \e$B=|$$$F4A;z%3!<%I$N:.:_$K$bBP1~$7$F$$$k!#\e(BShiftJIS\e$B$+\e(BEUC\e$B$+$I$&$7$F$b\e(B
  55 #   \e$BH=CG$G$-$J$$$H$-$O\e(B$often_use_kanji\e$B$K@_Dj$5$l$F$$$k%3!<%I$HH=Dj$9$k!#\e(B
  56 #   ISO-2022-JP\e$B$N%(%9%1!<%W%7!<%1%s%9$O\e(B$jis_in\e$B$H\e(B$jis_out\e$B$K@_Dj$9$k$3$H\e(B
  57 #   \e$B$K$h$jJQ992DG=$G$"$k!#\e(B
  58
  59 $often_use_kanji = 'EUC'; # or 'SJIS'
  60
  61 $jis_in  = "\x1b\$B"; # ESC-$-B ( or ESC-$-@ )
  62 $jis_out = "\x1b\(B"; # ESC-(-B ( or ESC-(-J )
  63
  64 # \e$BG[I[>r7o\e(B : \e$BCx:n8"$OJ|4~$7$^$;$s$,!"G[I[!&2~JQ$O<+M3$H$7$^$9!#2~JQ$7$F\e(B
  65 #            \e$BG[I[$9$k>l9g$O!"%*%j%8%J%k$H0[$J$k$3$H$rL@5-$7!"%*%j%8%J%k\e(B
  66 #            \e$B$N%P!<%8%g%s%J%s%P!<$K2~JQHG%P!<%8%g%s%J%s%P!<$rIU2C$7$?7A\e(B
  67 #            \e$BNc$($P\e(B Ver.2.02-XXXXX \e$B$N$h$&$J%P!<%8%g%s%J%s%P!<$rIU$1$F2<\e(B
  68 #            \e$B$5$$!#$J$*!"\e(BCopyright\e$BI=<($OJQ99$7$J$$$G$/$@$5$$!#\e(B
  69 #
  70 # \e$BCm0U\e(B : &mimeencode\e$B$r\e(Bjperl1.X(\e$B$N\e(B2\e$B%P%$%HJ8;zBP1~%b!<%I\e(B)\e$B$G;HMQ$9$k$H!"\e(BSJIS
  71 #        \e$B$H\e(BEUC\e$B$r$&$^$/\e(B7bit JIS(ISO-2022-JP)\e$B$KJQ49$G$-$^$;$s!#\e(B
  72 #        \e$BF~NO$K4^$^$l$kJ8;z$,\e(B7bit JIS(ISO-2022-JP)\e$B$H\e(BASCII\e$B$N$_$G$"$k$3$H\e(B
  73 #        \e$B$,J]>Z$5$l$F$$$k>l9g$r=|$-!"I,$:\e(Boriginal\e$B$N1Q8lHG$N\e(Bperl\e$B!J$^$?$O\e(B
  74 #        jperl1.4\e$B0J>e$r\e(B -Llatin \e$B%*%W%7%g%sIU$-!K$GF0$+$7$F$/$@$5$$!#\e(B
  75 #        \e$B$J$*!"\e(BPerl5\e$BBP1~$N\e(Bjperl\e$B$O;n$7$?$3$H$,$J$$$N$G$I$N$h$&$JF0:n$K$J$k\e(B
  76 #        \e$B$+$o$+$j$^$;$s!#\e(B
  77 #
  78 # \e$B;2>H\e(B : RFC1468, RFC2045, RFC2047
  79
  80 ## MIME base64 \e$B%"%k%U%!%Y%C%H%F!<%V%k!J\e(BRFC2045\e$B$h$j!K\e(B
  81 %mime = (
  82 "000000", "A",  "000001", "B",  "000010", "C",  "000011", "D",
  83 "000100", "E",  "000101", "F",  "000110", "G",  "000111", "H",
  84 "001000", "I",  "001001", "J",  "001010", "K",  "001011", "L",
  85 "001100", "M",  "001101", "N",  "001110", "O",  "001111", "P",
  86 "010000", "Q",  "010001", "R",  "010010", "S",  "010011", "T",
  87 "010100", "U",  "010101", "V",  "010110", "W",  "010111", "X",
  88 "011000", "Y",  "011001", "Z",  "011010", "a",  "011011", "b",
  89 "011100", "c",  "011101", "d",  "011110", "e",  "011111", "f",
  90 "100000", "g",  "100001", "h",  "100010", "i",  "100011", "j",
  91 "100100", "k",  "100101", "l",  "100110", "m",  "100111", "n",
  92 "101000", "o",  "101001", "p",  "101010", "q",  "101011", "r",
  93 "101100", "s",  "101101", "t",  "101110", "u",  "101111", "v",
  94 "110000", "w",  "110001", "x",  "110010", "y",  "110011", "z",
  95 "110100", "0",  "110101", "1",  "110110", "2",  "110111", "3",
  96 "111000", "4",  "111001", "5",  "111010", "6",  "111011", "7",
  97 "111100", "8",  "111101", "9",  "111110", "+",  "111111", "/",
  98 );
  99
 100 ## JIS\e$B%3!<%I\e(B(byte\e$B?t\e(B)\e$B"*\e(Bencoded-word \e$B$NJ8;z?tBP1~\e(B
 101 %mimelen = (
 102  8,30, 10,34, 12,34, 14,38, 16,42,
 103 18,42, 20,46, 22,50, 24,50, 26,54,
 104 28,58, 30,58, 32,62, 34,66, 36,66,
 105 38,70, 40,74, 42,74,
 106 );
 107
 108 ## \e$B%X%C%@%(%s%3!<%I;~$N9T$ND9$5$N@)8B\e(B
 109 $limit=74; ## \e$B!vCm0U!v\e(B $limit\e$B$r\e(B75\e$B$h$jBg$-$$?t;z$K@_Dj$7$F$O$$$1$J$$!#\e(B
 110
 111 ## \e$B%\%G%#\e(Bbase64\e$B%(%s%3!<%I;~$N9T$ND9$5$N@)8B\e(B
 112 $foldcol=72; ## \e$B!vCm0U!v\e(B $foldcol\e$B$O\e(B76\e$B0J2<$N\e(B4\e$B$NG\?t$K@_Dj$9$k$3$H!#\e(B
 113
 114 ## \e$B%\%G%#\e(BQuoted-Printable\e$B%(%s%3!<%I;~$N9T$ND9$5$N@)8B\e(B
 115 $qfoldcol=75; ## \e$B!vCm0U!v\e(B $foldcol\e$B$O\e(B76\e$B0J2<$K@_Dj$9$k$3$H!#\e(B
 116
 117 ## null bit\e$B$NA^F~$H\e(B pad\e$BJ8;z$NA^F~$N$?$a$N%F!<%V%k\e(B
 118 @zero = ( "", "00000", "0000", "000", "00", "0" );
 119 @pad  = ( "", "===",   "==",   "=" );
 120
 121 ## ASCII, 7bit JIS, Shift-JIS \e$B5Z$S\e(B EUC \e$B$N3F!9$K%^%C%A$9$k%Q%?!<%s\e(B
 122 $match_ascii = '\x1b\([BHJ]([\t\x20-\x7e]*)';
 123 $match_jis = '\x1b\$[@B](([\x21-\x7e]{2})*)';
 124 $match_sjis = '([\x81-\x9f\xe0-\xfc][\x40-\x7e\x80-\xfc])+';
 125 $match_euc  = '([\xa1-\xfe]{2})+';
 126
 127 ## MIME Part 2(charset=`ISO-2022-JP',encoding=`B') \e$B$N\e(B head \e$B$H\e(B tail
 128 $mime_head = '=?ISO-2022-JP?B?';
 129 $mime_tail = '?=';
 130
 131 ## &bodyencode \e$B$,;H$&=hM};D$7%G!<%?MQ%P%C%U%!\e(B
 132 $benbuf = "";
 133
 134 ## &bodyencode \e$B$N=hM}C10L!J%P%$%H!K\e(B
 135 $bensize = int($foldcol/4)*3;
 136
 137 ## &mimeencode interface ##
 138 sub main'mimeencode {
 139     local($_) = @_;
 140     s/$match_jis/$jis_in$1/go;
 141     s/$match_ascii/$jis_out$1/go;
 142     $kanji = &checkkanji;
 143     s/$match_sjis/&s2j($&)/geo if ($kanji eq 'SJIS');
 144     s/$match_euc/&e2j($&)/geo if ($kanji eq 'EUC');
 145     s/(\x1b[\$\(][BHJ@])+/$1/g;
 146     1 while s/(\x1b\$[B@][\x21-\x7e]+)\x1b\$[B@]/$1/;
 147     1 while s/$match_jis/&mimeencode($&,$`,$')/eo;
 148     s/$match_ascii/$1/go;
 149     $_;
 150 }
 151
 152 ## &bodyencode interface ##
 153 sub main'bodyencode {
 154     local($_,$coding) = @_;
 155     if (!defined($coding) || $coding eq "" || $coding eq "b64"){
 156         $_ = $benbuf . $_;
 157         local($cut) = int((length)/$bensize)*$bensize;
 158         $benbuf = substr($_, $cut+$[);
 159         $_ = substr($_, $[, $cut);
 160         $_ = &base64encode($_);
 161         s/.{$foldcol}/$&\n/g;
 162     }elsif ($coding eq "qp"){
 163         # $benbuf \e$B$,6u$G$J$1$l$P%G!<%?$N:G=i$KDI2C$9$k\e(B
 164         $_ = $benbuf . $_;
 165
 166         # \e$B2~9TJ8;z$r@55,2=$9$k\e(B
 167         s/\r\n/\n/g;
 168         s/\r/\n/g;
 169
 170         # \e$B%G!<%?$r9TC10L$KJ,3d$9$k\e(B(\e$B:G8e$N2~9TJ8;z0J9_$r\e(B $benbuf \e$B$KJ]B8$9$k\e(B)
 171         @line = split(/\n/,$_,-1);
 172         $benbuf = pop(@line);
 173
 174         local($result) = "";
 175         foreach (@line){
 176             $_ = &qpencode($_);
 177             $result .= $_ . "\n";
 178         }
 179         $_ = $result;
 180     }
 181     $_;
 182 }
 183
 184 ## &benflush interface ##
 185 sub main'benflush {
 186     local($coding) = @_;
 187     local($ret) = "";
 188     if ((!defined($coding) || $coding eq "" || $coding eq "b64")
 189         && $benbuf ne ""){
 190         $ret = &base64encode($benbuf) . "\n";
 191         $benbuf = "";
 192     }elsif ($coding eq "qp" && $benbuf ne ""){
 193         $ret = &qpencode($benbuf) . "\n";
 194         $benbuf = "";
 195     }
 196     $ret;
 197 }
 198
 199 ## MIME \e$B%X%C%@%(%s%3!<%G%#%s%0\e(B
 200 sub mimeencode {
 201     local($_, $befor, $after) = @_;
 202     local($back, $forw, $blen, $len, $flen, $str);
 203     $befor = substr($befor, rindex($befor, "\n")+1);
 204     $after = substr($after, 0, index($after, "\n")-$[);
 205     $back = " " unless ($befor eq ""
 206                      || $befor =~ /[ \t\(]$/);
 207     $forw = " " unless ($after =~ /^\x1b\([BHJ]$/
 208                      || $after =~ /^\x1b\([BHJ][ \t\)]/);
 209     $blen = length($befor);
 210     $flen = length($forw)+length($&)-3 if ($after =~ /^$match_ascii/o);
 211     $len = length($_);
 212     return "" if ($len <= 3);
 213     if ($len > 39 || $blen + $mimelen{$len+3} > $limit){
 214         if ($limit-$blen < 30){
 215             $len = 0;
 216         }else{
 217             $len = int(($limit-$blen-26)/4)*2+3;
 218         }
 219         if ($len >= 5){
 220             $str = substr($_, 0, $len).$jis_out;
 221             $str = &base64encode($str);
 222             $str = $mime_head.$str.$mime_tail;
 223             $back.$str."\n ".$jis_in.substr($_, $len);
 224         }else{
 225             "\n ".$_;
 226         }
 227     }else{
 228         $_ .= $jis_out;
 229         $_ = &base64encode($_);
 230         $_ = $back.$mime_head.$_.$mime_tail;
 231         if ($blen + (length) + $flen > $limit){
 232             $_."\n ";
 233         }else{
 234             $_.$forw;
 235         }
 236     }
 237 }
 238
 239 ## MIME base64 \e$B%(%s%3!<%G%#%s%0\e(B
 240 sub base64encode {
 241     local($_) = @_;
 242     $_ = unpack("B".((length)<<3), $_);
 243     $_ .= $zero[(length)%6];
 244     s/.{6}/$mime{$&}/go;
 245     $_.$pad[(length)%4];
 246 }
 247
 248 ## Quoted-Printable \e$B%(%s%3!<%G%#%s%0\e(B
 249 sub qpencode {
 250     local($_) = @_;
 251
 252     # `=' \e$BJ8;z$r\e(B16\e$B?JI=8=$KJQ49$9$k\e(B
 253     s/=/=3D/g;
 254
 255     # \e$B9TKv$N%?%V$H%9%Z!<%9$r\e(B16\e$B?JI=8=$KJQ49$9$k\e(B
 256     s/\t$/=09/;
 257     s/ $/=20/;
 258
 259     # \e$B0u;z2DG=J8;z\e(B(`!'\e$B!A\e(B`~')\e$B0J30$NJ8;z$r\e(B16\e$B?JI=8=$KJQ49$9$k\e(B
 260     s/([^!-~ \t])/&qphex($1)/ge;
 261
 262     # 1\e$B9T$,\e(B$qfoldcol\e$BJ8;z0J2<$K$J$k$h$&$K%=%U%H2~9T$r$$$l$k\e(B
 263     local($folded, $line) = "";
 264     while (length($_) > $qfoldcol){
 265         $line = substr($_, 0, $qfoldcol-1);
 266         if ($line =~ /=$/){
 267             $line = substr($_, 0, $qfoldcol-2);
 268             $_ = substr($_, $qfoldcol-2);
 269         }elsif ($line =~ /=[0-9A-Fa-f]$/){
 270             $line = substr($_, 0, $qfoldcol-3);
 271             $_ = substr($_, $qfoldcol-3);
 272         }else{
 273             $_ = substr($_, $qfoldcol-1);
 274         }
 275         $folded .= $line . "=\n";
 276     }
 277     $folded . $_;
 278 }
 279
 280 sub qphex {
 281     local($_) = @_;
 282     $_ = '=' . unpack("H2", $_);
 283     tr/a-f/A-F/;
 284     $_;
 285 }
 286
 287 ## Shift-JIS \e$B$H\e(B EUC \e$B$N$I$A$i$N4A;z%3!<%I$,4^$^$l$k$+$r%A%'%C%/\e(B
 288 sub checkkanji {
 289     local($sjis,$euc);
 290     $sjis += length($&) while(/$match_sjis/go);
 291     $euc  += length($&) while(/$match_euc/go);
 292     return 'NONE' if ($sjis == 0 && $euc == 0);
 293     return 'SJIS' if ($sjis > $euc);
 294     return 'EUC'  if ($sjis < $euc);
 295     $often_use_kanji;
 296 }
 297
 298 ## EUC \e$B$r\e(B 7bit JIS \e$B$KJQ49\e(B
 299 sub e2j {
 300     local($_) = @_;
 301     tr/\xa1-\xfe/\x21-\x7e/;
 302     $jis_in.$_.$jis_out;
 303 }
 304
 305 ## Shift-JIS \e$B$r\e(B 7bit JIS \e$B$KJQ49\e(B
 306 sub s2j {
 307     local($string);
 308     local(@ch) = split(//, $_[0]);
 309     while(($j1,$j2)=unpack("CC",shift(@ch).shift(@ch))){
 310         if ($j2 > 0x9e){
 311             $j1 = (($j1>0x9f ? $j1-0xb1 : $j1-0x71)<<1)+2;
 312             $j2 -= 0x7e;
 313         }
 314         else{
 315             $j1 = (($j1>0x9f ? $j1-0xb1 : $j1-0x71)<<1)+1;
 316             $j2 -= ($j2>0x7e ? 0x20 : 0x1f);
 317         }
 318         $string .= pack("CC", $j1, $j2);
 319     }
 320     $jis_in.$string.$jis_out;
 321 }
 322 1;