Googleメール用の漢字変換フィルタ (MTA→[フィルタ]→ML処理)

~~Googleメール用の~~漢字変換フィルタ

　←　はせがわさん作成の GMail-Filter のバナーです。
気が向いたら、これを使って宣伝よろしくです。m(__)m

GoogleメールからのUTF-8,GB2312,EUC-KR,... + base64なメールをそのままMLに流すと、処理できないMUAな人が困ってしまうので、MLに流す前に無理やり漢字変換するためのフィルタです。

メーリングリスト(Mailman,fml,...)の管理人が、MLサーバ上に設置して使います。

設置場所： ML配信サーバ　（　→MTA→[フィルタ]→ML処理→　）

設置方法：

下記にあげるメールのみ内容を変更します。それ以外は素通しです。

漢字コードが UTF-8,EUC-JP,shift_jis,iso-2022-jp,GB2312,GB18030,EUC-KR,BIG5 のいずれかで、
かつ、本文が base64 または quoted-printable の場合
→漢字コード/エンコードを変換して ML処理に渡します。
Content-Type: type/subtype の直後に charset= の記述がきていない場合
→charset= を type/subtype の直後に移動します。その他のパラメータの順序は維持します。
uuencode形式のデータと思われるものが本文にある場合
→4行目以降を削除して、警告メッセージに置き換えます。

※様々な変換処理を行うため、S/MIMEによる署名が行われている場合、受信後の検証に失敗する場合があります。

下記の点に同意頂けるのであれば、ご自由に使用して頂いて構いません。

「X-GMail-Filter:」ヘッダの出力内容は変更しないでください。
作者は、本ソフトウェアの使用に起因して又は関連して発生する損害、トラブルについて、その原因のいかんを問わず、一切責任を負いません。
作者は、本ソフトウェアにつき、その補修、改定、保守/サポート、更新、瑕疵の修正等のいかなる保証も行いません。

下記の皆さま(@openmyaML)に多大なご協力を頂きました。ありがとうございました。

はせがわさん、umqさん、上田さん、openmya-adomisoな皆さま、山科さん、bunさん (順不同)

GB18030 の漢字コード変換をするには、下記のインストールが必要です：

http://search.cpan.org/~autrijus/Encode-HanExtra-0.10/lib/Encode/HanExtra.pm

Last Modified: 2018/12/27(木)

#!/usr/local/bin/perl
use strict;
our $ver = 'X-GMail-Filter: gmail-filter.pl(ver0.20.01) by yamagata@openmya';

our $LINF = "\r\n";
#$LINF = "\n"; #←fmlの時は行頭のコメント外す

use Encode qw(from_to);
use MIME::Base64; use MIME::QuotedPrint;

my $mail = ''; my $header = -1; my $sCT = ''; my $sCTE = ''; my $cte = 0;
my @kugiri; my $cnt = 0; my $kc = ''; my $dmy;

my $kcodes0 = 'UTF-8|EUC-JP|shift_jis|GB2312|GB18030|EUC-KR|BIG5';
my $kcodes  = "$kcodes0|iso-2022-jp";

my $rxCharset = '[\s\t]*charset[\s\t]*=';

my $uuencode = 0; my $uuencode_count = 0;

while(<>) {
  s/\r?\n$//;
  if($header) {
    # ヘッダ部分について処理
    s{=\?($kcodes)\?([BQ])\?([^\?]+)\?=}{
      # ヘッダ内の =?UTF-8?B?...?= などの変換処理
      my($kc, $bq, $str) = ($1, $2, $3);
      if($bq eq 'B' || $bq eq 'b') {
        # base64
        $str = decode_base64(&rmCRLF($str));
      } else {
        # quoted-printable
        $str =~ tr/_/ /;
        $str = decode_qp(&rmCRLF($str));
      }
      # 先頭のatext文字はBase64しない
      $str = &toJIS($kc, $str);
      $str =~ m"^([[:alnum:]!#$%&'*+/=?^ `{|}-]*)(.*)$";
      $str = encode_base64($2, "");
      $1."=\?iso-2022-jp\?B\?$str\?=";
    }ige;
    if(/^Content-Type:/i) {
      # Content-Type: ヘッダの処理
      $sCT = $_;
      while(<>) { s/\r?\n$//; last if(!/^[\s\t]/); $sCT .= "$LINF$_"; }
      if($sCT =~ /;$rxCharset/is &&
         $sCT !~ /^Content-Type:[\s\t]+[^;]+;$rxCharset/is) {
        # type/subtype の直後に charset を移動。(電八,鶴亀メール用)
        print "X-Original-Order-$sCT$LINF";
        my($ct1, $ct2) = $sCT =~ /^(Content-Type:[\s\t]+[^;]+);[\s\t]*(.*)$/is;
        $ct2 .= ";";
        my @param =
          ($ct2 =~ /([^=]+=[\s\t]*(?:"[^"]*"|[^";]*));[\s\t\r\n]*/sg);
        $sCT = "";
        local($_);
        foreach(@param) {
          if(/^charset[\s\t]*=/i) { $sCT = "; $_$sCT"; }
          else { $sCT .= ";\n  $_"; }
        }
        $sCT = "$ct1$sCT";
      }
      if($sCT =~ /^Content-Type:[\s\t]*multipart.*boundary[\s\t]*=[\s\t]*(['"]?)([^'";]+)\1/is) {
        # MIME の Boundary を確保
        unshift @kugiri, $2;
      }
      redo;
    } elsif(/^Content-Transfer-Encoding:[\s\t]*/i) {
      # Content-Transfer-Encoding: ヘッダの処理
      $sCTE = $_;
      while(<>) { s/\r?\n$//; last if(!/^[\s\t]/); $sCTE .= "$LINF$_"; }
      redo;
    } elsif($_ eq '') {
      $header = 0;
      if($sCT =~ /^Content-Type:.*$rxCharset(["']?)($kcodes)\1/is &&
         $sCTE =~ /^Content-Transfer-Encoding:[\s\t]*base64/i) {
        # 漢字コード＆base64 の変換をする
        $cte = 1;
      } elsif(
          $sCT =~ /^Content-Type:.*$rxCharset(["']?)($kcodes)\1/is &&
          $sCTE =~ /^Content-Transfer-Encoding:[\s\t]*quoted-printable/i) {
        # 漢字コード＆quoted-printable の変換をする
        $cte = 2;
      } elsif(
          $sCT =~ /^Content-Type:.*$rxCharset(["']?)($kcodes0)\1/is &&
          $sCTE =~ /^Content-Transfer-Encoding:[\s\t]*[78]bit/i) {
        # 漢字コードの変換のみ
        $cte = 3;
      } else {
        # 変換は行わない
        $cte = 0;
      }
      ($dmy, $kc) =
        $sCT =~ /^Content-Type:.*$rxCharset(["']?)([^"';]+)\1/is;
      if($cte > 0) {
        # 変換を実施する場合、ヘッダを置換する
        print "X-Original-$sCT$LINF";
        print "X-Original-$sCTE$LINF";
        $sCT =~
          s/^(Content-Type:.*$rxCharset)(["']?)[^"';]+\2/\1"iso-2022-jp"/is;
        $sCTE =~ s/^(Content-Transfer-Encoding:)[\s\t]*\S+/\1 7bit/i;
      }
      # Content-Type, Content-Transfer-Encoding ヘッダを表示
      print "$sCT$LINF" if($sCT ne '');
      print "$sCTE$LINF" if($sCTE ne '');
      print "$ver$LINF" if(++$cnt <= 1);
      print "$LINF";
      next;
    }
  } else {
    if(length($kugiri[0]) > 0 && /^\Q--$kugiri[0]\E(--)?$/) {
      # MIME の Boundary を処理
      shift @kugiri if($1 eq '--');
      &shori($kc, $mail, $cte); $mail = '';
      $header = -1; $sCT = ''; $sCTE = ''; $cte = 0;
    } elsif($uuencode) {
      if(/^end$/) {
        $uuencode = 0;
      } elsif(/^[ -_`~]+$/) {
        if(++$uuencode_count == 4) {
          $_ = '** UUENCODE data was suppressed. **';
        } elsif($uuencode_count > 4) {
          next;
        }
      } else {
        $uuencode = 0;
      }
    } elsif(/^begin [0-7]{3,3} ./) {
      # uuencode 形式の添付ファイルを抑止
      # http://gabacho.reto.jp/tech-note/a-filter を参考にしました。
      $uuencode = -1;
      $uuencode_count = 0;
    }
  }
  if($cte > 0) {
    $mail .= "$_$LINF";
  } else {
    print "$_$LINF";
  }
}
&shori($kc, $mail, $cte);
exit;

sub shori {
  # 必要なら漢字コード＆転送エンコード形式の変換をする
  my($kc, $mail, $cte) = @_;
  if($cte == 1) {
    $mail = &toJIS($kc, decode_base64($mail)).$LINF.$LINF;
  } elsif($cte == 2) {
    $mail = &toJIS($kc, decode_qp($mail));
  } elsif($cte == 3) {
    $mail = &toJIS($kc, $mail);
  }
  print &convertCRLF($mail);
}

sub rmCRLF {
  # 改行コードを取り除く
  my($str) = @_;
  $str =~ s/[\r\n]+//g;
  return $str;
}

sub convertCRLF {
  # 改行コードを CR LF に置換する
  local($_) = @_;
  s/\x0D\x0A/\n/g; tr/\x0D\x0A/\n\n/;
  s/\n/\x0D\x0A/g if($LINF ne "\n");
  return $_;
}

sub UTF8toJIS {
  # UTF-8 から JIS に変換する
  my($str) = @_;
  $str =~ s/\xEF\xBD\x9E/\xE3\x80\x9C/g;
  $str =~ s/\xEF\xBC\x8D/\xE2\x88\x92/g;
  from_to($str, 'utf8', 'iso-2022-jp');
  return $str;
}

sub toJIS {
  # 漢字コードを JIS に変換する
  my($kc, $str) = @_;
  if($kc =~ /UTF-8/i) {
    $str = &UTF8toJIS($str);
  } elsif($kc =~ /EUC-JP/i) {
    from_to($str, 'euc-jp', 'iso-2022-jp');
  } elsif($kc =~ /shift_jis/i) {
    from_to($str, 'shiftjis', 'iso-2022-jp');
  } elsif($kc =~ /GB2312/i) {
    from_to($str, 'cp936', 'utf8');
    $str = &UTF8toJIS($str);
  } elsif($kc =~ /GB18030/i) {
    from_to($str, 'gb18030', 'utf8');
    $str = &UTF8toJIS($str);
  } elsif($kc =~ /EUC-KR/i) {
    from_to($str, 'euc-kr', 'utf8');
    from_to($str, 'utf8', 'cp932');
    from_to($str, 'cp932', 'iso-2022-jp');
  } elsif($kc =~ /BIG5/i) {
    from_to($str, 'big5', 'iso-2022-jp');
  }
  return $str;
}

<< ツール一覧に戻る