MIMEヘッダをデコードする 〜 decode_mimewordsさんのいけず、、、

```text:環境
% perl --version

This is perl 5, version 24, subversion 1 (v5.24.1) built for amd64-freebsd-thread-multi

Copyright 1987-2017, Larry Wall
```

# TL;DR

```perl:結論
use strict;
use utf8;
use feature 'say';
use Encode qw/encode_utf8 decode/;

# 参考元より拝借
my $src = "=?utf-8?B?44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OB?=
 =?utf-8?B?l+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=";

# これ！
while ($src =~ s/=\?([^?]+)\?([bq])\?([^?=]+)\?=\s+=\?\g1\?\g2\?(.+)/=?\1?\2?\3\4/ig){}

my $dst = decode('MIME-Header', $src);
say encode_utf8 $dst;
```
> `-> ギガシネマ with U-NEXT お申し込み完了のお知らせ`

## つまりは何をやったのか
連続した行が、

* 同じ文字セット/エンコーディングである
* 前行の行末にパディング('=')がない

という条件を満たした場合に前後の行を連結する、という処理を繰り返す。

# 闘いの狼煙が上がる

MIMEヘッダのデコードに引っかかり、[こちらのページ](http://qiita.com/kizashi1122/items/5a3e6e3928868bead40d)を発見するもISO-2022-JPで撃沈。

```perl:decode_mimewords
use strict;
use feature 'say';
use MIME::Words qw/decode_mimewords/;
use Encode qw/encode_utf8 decode/;

my $subject = "=?ISO-2022-JP?B?GyRCJDMkbCRPGyhCTUlNRSBTVUJKRUNUGyRCJE4bKEJkb2Nv?=
      =?ISO-2022-JP?B?ZGUbJEIlRiU5JUhNUSRHJDkbKEI=?=";

my $decoded = decode_mimewords($subject);

say $decoded;
```
> `-> ESC$B$3$l$OESC(BMIME SUBJECTESC$B$NESC(BdocodeESC$B%F%9%HMQ$G$9ESC(B`

生のISO-2022-JPかよ！

# 穴を掘って埋める

```perl:decode_mimewords+Encode::decode
# use文省略（以下同様）

my $subject = "=?ISO-2022-JP?B?GyRCJDMkbCRPGyhCTUlNRSBTVUJKRUNUGyRCJE4bKEJkb2Nv?=
      =?ISO-2022-JP?B?ZGUbJEIlRiU5JUhNUSRHJDkbKEI=?=";

my $decoded = decode_mimewords($subject);
my $encoded = decode('ISO-2022-JP', $decoded);
                                   
say encode_utf8 $encoded;
```
> `-> これはMIME SUBJECTのdocodeテスト用です`

やや納得いかないが、まあ確認なのでよしとする。

# 【指令】 charsetを取得せよ

[[CPAN] MIME::Words](http://search.cpan.org/~dskoll/MIME-tools-5.503/lib/MIME/Words.pm)によると、配列コンテキストならcharset取れるとのことなので、

```perl:decode_mimewords+
my $subject = "=?ISO-2022-JP?B?GyRCJDMkbCRPGyhCTUlNRSBTVUJKRUNUGyRCJE4bKEJkb2Nv?=
      =?ISO-2022-JP?B?ZGUbJEIlRiU5JUhNUSRHJDkbKEI=?=";

my @decoded = decode_mimewords($subject);
my $encoded = decode($decoded[1], $decoded[0]);
                    
say encode_utf8 $encoded;
```
> `-> Can't call method "can" on unblessed reference at /usr/local/lib/perl5/5.24/mach/Encode.pm line 107.`

???

ドキュメントを読み直して「あ〜、はいはい」

```perl:decode_mimewords(array)
# データ
my $subject = "=?ISO-2022-JP?B?GyRCJDMkbCRPGyhCTUlNRSBTVUJKRUNUGyRCJE4bKEJkb2Nv?=
      =?ISO-2022-JP?B?ZGUbJEIlRiU5JUhNUSRHJDkbKEI=?=";

my $decoded;
foreach (decode_mimewords($subject)) {
   my ($data, $charset) = @$_;
   if (defined($charset)) {
      $decoded .= decode($charset, $data);
   } else {
      $decoded .= $data;
   }
}

say encode_utf8 $decoded;
```
> `->これはMIME SUBJECTのdocodeテスト用です`

# で、

```perl:decode_mimewords(array)
my $subject = "=?utf-8?B?44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OB?=
 =?utf-8?B?l+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=";

my $decoded;
foreach (decode_mimewords($subject)) {
   my ($data, $charset) = @$_;
   if (defined($charset)) {
      $decoded .= decode($charset, $data);
   } else {
      $decoded .= $data;
   }
}

say encode_utf8 $decoded;
```
> `-> ギガシネマ with U-NEXT お申���込み完了のお知らせ`

元の木阿弥...orz
どうも配列コンテキストだと1行ずつの処理に戻ってしまうらしい。

# 【指令】なんとかせよ

```perl:decode_mimewords++(array)
my $subject = "=?utf-8?B?44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OB?=
 =?utf-8?B?l+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=";

my $decoded;
my $str;
my $charset_l;
foreach (decode_mimewords($subject)) {
   my ($data, $charset) = @$_;
   if ($charset) {
      if ($charset == $charset_l) {
         $str .= $data;
      } else {
         if ($charset_l) {
            $decoded .= decode($charset_l, $str);
         } elsif ($str) {
            $decoded .= $str;
         }
         $str = $data;
      }
      $charset_l = $charset;
   } else {
      if ($charset_l && $str) {
         $decoded .= decode($charset_l, $str);
         $charset_l = '';
         $str = '';
      }
      $decoded .= $data;
   }
}
if ($charset_l && $str ) {
   $decoded .= decode($charset_l, $str);
}

say encode_utf8 $decoded;
```
> `-> ギガシネマ with U-NEXT お申し込み完了のお知らせ`

＼(^o^)／

# いや、これで納得しちゃダメだろ

調べていた時に"[[livedoor Tech Blog] モブログに潜んでいる不具合](http://blog.livedoor.jp/techblog/archives/64631548.html)"を見つけていたので、こちらを参考に`Encode::decode('MIME-Header', $src)`を使う方法で書き直す。

```perl:decode('MIME-Header')
my $src = "=?utf-8?B?44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OB?=
 =?utf-8?B?l+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=";

$src =~ s/\?\=\s+\=\?[^?]+\?[bq]\?//igs;
my $dst = decode('MIME-Header', $src);
say encode_utf8 $dst;
```
> `-> ギガシネマ with U-NEXT お申し込み完了のお知らせ`

お〜

で、終わらないのはお約束。

# あらたなる敵の出現

```perl:'='パディング
my $src = "=?UTF-8?B?RmlyZSBUVuOBruOCteODvOODk+OCuQ==?=
     =?UTF-8?B?5ZCR5LiK44Gr44GU5Y2U5Yqb44KS44GK6aGY44GE44GX44G+44GZ?=";

my $dst = decode('MIME-Header', $src);
say "before: ",encode_utf8 $dst;
$src =~ s/\?\=\s+\=\?[^?]+\?[bq]\?//igs;
$dst = decode('MIME-Header', $src);
say "after:  ",encode_utf8 $dst;
```
> ```
-> before: Fire TVのサービス向上にご協力をお願いします
-> after:  Fire TVのサービス
```

探すと結構ある。

```perl:複数エンコーディング
my $src = "=?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?=
     =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=
     =?US-ASCII?Q?.._cool!?=";

# （以下略）
```
> ```
-> before: If you can read this you understand the example... cool!
-> after:  If you can read this yo
```

実際あるのかは謎だけど、[MIME::Wordsのドキュメント](http://search.cpan.org/~dskoll/MIME-tools-5.503/lib/MIME/Words.pm)に書かれてたので対応しないわけにはいくまい、、、

# パディング付き＝バイト列としては分断無しとみなす

```perl:パディング対策
my $src = "=?UTF-8?B?RmlyZSBUVuOBruOCteODvOODk+OCuQ==?=
     =?utf-8?B?5ZCR5LiK44Gr44GU5Y2U5Yqb44KS44GK6aGY44GE44GX44G+44GZ?=";

my $dst = decode('MIME-Header', $src);
say "before: ", encode_utf8 $dst;
say "   src: ", $src;
$src =~ s/([^=])\?\=\s+\=\?[^?]+\?[bq]\?/\1/ig;
$dst = decode('MIME-Header', $src);
say "after:  ",encode_utf8 $dst;
say "  src:  ", $src;
```
> ```
-> before: Fire TVのサービス向上にご協力をお願いします
->    src: =?UTF-8?B?RmlyZSBUVuOBruOCteODvOODk+OCuQ==?=
->       =?utf-8?B?5ZCR5LiK44Gr44GU5Y2U5Yqb44KS44GK6aGY44GE44GX44G+44GZ?=
-> after:  Fire TVのサービス向上にご協力をお願いします
->   src:  =?UTF-8?B?RmlyZSBUVuOBruOCteODvOODk+OCuQ==?=
->      =?utf-8?B?5ZCR5LiK44Gr44GU5Y2U5Yqb44KS44GK6aGY44GE44GX44G+44GZ?=
```

```perl:パディング対策の再確認(1)
my $src= '=?utf-8?B?44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OB?=
      =?utf-8?B?l+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=';

# 以下略
```
> ```
-> before: ギガシネマ with U-NEXT お申\xE3\x81\x97込み完了のお知らせ
->    src: =?utf-8?B?44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OB?=
->       =?utf-8?B?l+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=
-> after:  ギガシネマ with U-NEXT お申し込み完了のお知らせ
->   src:  =?utf-8?B?44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OBl+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=
```

```perl:パディング対策の再確認(2)
my $src = '=?ISO-2022-JP?B?GyRCJSohPCVXJXMlPSE8JTklPSVVJUglJiUnJSIhShsoQk9T?=
     =?ISO-2022-JP?B?UykbJEJASDxlQC0kSCROOH4kLTlnJCRKfRsoQi8bJEI6IzduJE4bKEJP?=
     =?ISO-2022-JP?B?U1MbJEI+UjJwJE46Rz83JSIlQyVXJUchPCVIGyhCKEFwYWNoZU1lc29z?=
     =?ISO-2022-JP?B?GyRCJHJESTJDIUsbKEIvGyRCOiM3biROQ21MXCU7JS0lZSVqJUYbKEI=?=
     =?ISO-2022-JP?B?GyRCJSM+cEpzGyhCPE5SSSBPcGVuU3RhbmRpYRskQiVLJWUhPCU5GyhC?=
     =?ISO-2022-JP?B?KFZvbC4xMTgpPg==?=';
```
> ```
-> before: (省略）
    :
-> after:  オープンソースソフトウェア（OSS)脆弱性との向き合い方/今月のOSS紹介の最新アップデート(ApacheMesosを追加）/今月の注目セキュリティ情報<NRI OpenStandiaニュース(Vol.118)>
->   src:  =?ISO-2022-JP?B?GyRCJSohPCVXJXMlPSE8JTklPSVVJUglJiUnJSIhShsoQk9TUykbJEJASDxlQC0kSCROOH4kLTlnJCRKfRsoQi8bJEI6IzduJE4bKEJPU1MbJEI+UjJwJE46Rz83JSIlQyVXJUchPCVIGyhCKEFwYWNoZU1lc29zGyRCJHJESTJDIUsbKEIvGyRCOiM3biROQ21MXCU7JS0lZSVqJUYbKEI=?=
->      =?ISO-2022-JP?B?GyRCJSM+cEpzGyhCPE5SSSBPcGVuU3RhbmRpYRskQiVLJWUhPCU5GyhCKFZvbC4xMTgpPg==?=
```

よしよし。

# 伝家の宝刀を抜く（誇大）

```perl:後方参照
my $src = "=?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?=
     =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=
     =?US-ASCII?Q?.._cool!?=";

$src =~ s/=\?([^?]+)\?([bq])\?([^?=]+)\?=\s+=\?\g1\?\g2\?(.+)/=?\1?\2?\3\4/ig;
my $dst = decode('MIME-Header', $src);
say encode_utf8 $dst;
say "src: ",$src;
```
> ```
-> If you can read this you understand the example... cool!
-> src: =?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?=
->      =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=
->      =?US-ASCII?Q?.._cool!?=
```

```perl:後方参照確認
my $src= '=?utf-8?B?44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OB?=
      =?utf-8?B?l+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=';
```
> ```
-> ギガシネマ with U-NEXT お申し込み完了のお知らせ
-> src: =?utf-8?B?44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OBl+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=
```

# 最後の罠

```perl:パディングなしの連続行
my $src = '=?UTF-8?B?RmlyZSBUVuOBruOCteODvOODk+OCuQ==?=
     =?utf-8?B?5ZCR5LiK44Gr44GU5Y2U5Yqb44KS44GK6aGY44GE44GX44G+44GZ?=
     =?utf-8?B?44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OB?=
     =?utf-8?B?l+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=';

$src =~ s/=\?([^?]+)\?([bq])\?([^?=]+)\?=\s+=\?\g1\?\g2\?(.+)/=?\1?\2?\3\4/ig;
my $dst = decode('MIME-Header', $src);
say encode_utf8 $dst;
say "src: ",$src;
```
> ```
-> Fire TVのサービス向上にご協力をお願いしますギガシネマ with U-NEXT お申\xE3\x81\x97込み完了のお知らせ
-> src: =?UTF-8?B?RmlyZSBUVuOBruOCteODvOODk+OCuQ==?=
->      =?utf-8?B?5ZCR5LiK44Gr44GU5Y2U5Yqb44KS44GK6aGY44GE44GX44G+44GZ44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OB?=
->      =?utf-8?B?l+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=
```

# 回せ回せ！！

```perl:while()
my $src = '=?UTF-8?B?RmlyZSBUVuOBruOCteODvOODk+OCuQ==?=
     =?utf-8?B?5ZCR5LiK44Gr44GU5Y2U5Yqb44KS44GK6aGY44GE44GX44G+44GZ?=
     =?utf-8?B?44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OB?=
     =?utf-8?B?l+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=';

while ($src =~ s/=\?([^?]+)\?([bq])\?([^?=]+)\?=\s+=\?\g1\?\g2\?(.+)/=?\1?\2?\3\4/ig){}
my $dst = decode('MIME-Header', $src);
say encode_utf8 $dst;
say "src: ",$src;
```
> ```
-> Fire TVのサービス向上にご協力をお願いしますギガシネマ with U-NEXT お申し込み完了のお知らせ
-> src: =?UTF-8?B?RmlyZSBUVuOBruOCteODvOODk+OCuQ==?=
     =?utf-8?B?5ZCR5LiK44Gr44GU5Y2U5Yqb44KS44GK6aGY44GE44GX44G+44GZ44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OBl+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=

あとはこれまでの各種パターン＋αで試す。

```perl:頑張ってるベクター
my $src = '=?iso-2022-jp?B?GyRCPzdIL0dkIVobKEI=?=2,980=?iso-2022-jp?B?GyRCMV8hWxsoQg==?=Microsoft Office=?iso-2022-jp?B?GyRCJEhCPT8nJEokJEFgOm5ALSRINi9OTyRKOF80OUAtIVYbKEI=?=Polaris Office=?iso-2022-jp?B?GyRCIVchWiVZJS8lPyE8GyhC?=PC=?iso-2022-jp?B?GyRCJTclZyVDJVchWxsoQg==?=';
```
> ```
-> 新発売【2,980円】Microsoft Officeと遜色ない操作性と強力な互換性「Polaris Office」【ベクターPCショップ】
```

```Perl:QiitaだけにQエンコードw
my $src = '=?UTF-8?Q?[Qiita]_FreeBSD_Advent_Calendar_2016?=
 =?UTF-8?Q?_16=E6=97=A5=E7=9B=AE=E3=81=AE=E4=BA=88=E7=B4=84=E6=8A=95=E7=A8=BF=E3=81=8C=E5=AE=8C=E4=BA=86=E3=81=97=E3=81=BE=E3=81=97=E3=81=9F?=';
```
> ```
-> [Qiita] FreeBSD Advent Calendar 2016 16日目の予約投稿が完了しました
```

```perl:ぼーずはSJISがお好き
my $src = '=?SHIFT_JIS?B?gXmDe4Fbg1mCqYLngsyCqJJtgueCuYF6IEJvc2UgV2lyZWxl?=
     =?SHIFT_JIS?B?c3MgSGVhZHBob25lcyCDj4NDg4SDjINYgsyOqZdSgrOCxpSXl82CzINU?=
     =?SHIFT_JIS?B?g0WDk4NogqqC0ILGgsKCyYFC?=';
```
> ```
-> 【ボーズからのお知らせ】 Bose Wireless Headphones ワイヤレスの自由さと迫力のサウンドがひとつに。
```

```perl:全部のせ
my $src = '=?ISO-2022-JP?B?GyRCJSohPCVXJXMlPSE8JTklPSVVJUglJiUnJSIhShsoQk9T?=
     =?ISO-2022-JP?B?UykbJEJASDxlQC0kSCROOH4kLTlnJCRKfRsoQi8bJEI6IzduJE4bKEJP?=
     =?ISO-2022-JP?B?U1MbJEI+UjJwJE46Rz83JSIlQyVXJUchPCVIGyhCKEFwYWNoZU1lc29z?=
     =?ISO-2022-JP?B?GyRCJHJESTJDIUsbKEIvGyRCOiM3biROQ21MXCU7JS0lZSVqJUYbKEI=?=
     =?ISO-2022-JP?B?GyRCJSM+cEpzGyhCPE5SSSBPcGVuU3RhbmRpYRskQiVLJWUhPCU5GyhC?=
     =?ISO-2022-JP?B?KFZvbC4xMTgpPg==?=
     =?ISO-2022-JP?B?GyRCJV0lMSViJXMbKEJHTyAbJEIlIhsoQg==?=
     =?ISO-2022-JP?B?GyRCJUMlVyVHITwlSEdbPy4zKztPGyhC?=
     =?SHIFT_JIS?B?gXmDe4Fbg1mCqYLngsyCqJJtgueCuYF6IEJvc2UgV2lyZWxl?=
     =?SHIFT_JIS?B?c3MgSGVhZHBob25lcyCDj4NDg4SDjINYgsyOqZdSgrOCxpSXl82CzINU?=
     =?SHIFT_JIS?B?g0WDk4NogqqC0ILGgsKCyYFC?=
     =?utf-8?B?TU9CSUxJVFkgU1RBVElPTiDllYblk4Hos7zlhaXnorroqo3j?=
     =?utf-8?B?ga7jgYrnn6XjgonjgZs=?=
     =?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?=
     =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=
     =?US-ASCII?Q?.._cool!?=";
     =?utf-8?B?44Ku44Ks44K344ON44OeIHdpdGggVS1ORVhUIOOBiueUs+OB?=
     =?utf-8?B?l+i+vOOBv+WujOS6huOBruOBiuefpeOCieOBmw==?=';
```
> ```
-> オープンソースソフトウェア（OSS)脆弱性との向き合い方/今月のOSS紹介の最新アップデート(ApacheMesosを追加）/今月の注目セキュリティ情報<NRI OpenStandiaニュース(Vol.118)>ポケモンGO アップデート配信開始【ボーズからのお知らせ】 Bose Wireless Headphones ワイヤレスの自由さと迫力のサウンドがひとつに。MOBILITY STATION 商品購入確認のお知らせIf you can read this you understand the example... cool!ギガシネマ with U-NEXT お申し込み完了のお知らせ
```

# おわりに

* 手元で試した範囲では大丈夫でしたが、もしダメなパターンあったら教えていただけるとありがたいです。
* 知ってて良かった「田中哲スペシャル」。
* 「TL;DR」って一度書いてみたかった。

# 参考
[[Qiita] Encode::decode('MIME-Header', $value) の挙動について](http://qiita.com/kizashi1122/items/5a3e6e3928868bead40d)
[[CPAN] MIME::Words](http://search.cpan.org/~dskoll/MIME-tools-5.503/lib/MIME/Words.pm)
[[livedoor Tech Blog] モブログに潜んでいる不具合](http://blog.livedoor.jp/techblog/archives/64631548.html)