PL_check hack
（あとでかく）
XS くらいいじれないと Shibuya.pm に加入できないらしいので，とりあえず書きましたー。今回は実践編なので，あまりわかりやすい内容＆たいした内容ではないです。わっふるさせてごめんなさい。
ゴール
#!/usr/bin/perl eval 'print "Hello ' . $ARGV[0] . '!\n"';
とか危険ですよねー*1。こんな機能があるなんてけしからん。ですので，eval の実行を抑制するモジュールを書いてみました。
というのは冗談で，eval の実行主体となる OPCODEが，システム内で「完結」してます（んーうまく表現できない）。なのでサンプルとしていじりやすく，この題材をとりあげました。
評価型 eval はどのような OPCODE に変換されるのか
まずは単純なコードを書いて，OPCODE がどのようになるのかたしかめてみます。
use strict; use warnings; eval 'print "Hello!", "\n";';
OPCODE を確認するには，B::Concise を使います。
% perl -MO=Concise test.pl 5 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 3 test.pl:6) v/2 ->3 4 <1> entereval[t1794] vK/1 ->5 3 <$> const[PV "print \"Hello!\", \"\\n\";"] s ->4 test.pl syntax OK
このように OPCODE 構文木を再現してくれます。
ラフに書くと，
leaveしてねー
でもleaveする前にenterしてねーnextstateしてねーenterevalしてねー
でもenterevalする前に（する際に以下の引数が必要だよー）constしてねー
みたいな感じです。
ツリー状じゃない形式で見たい場合は，たとえば -exec オプションをつけます*2。
% perl -MO=Concise,-exec test.pl 1 <0> enter 2 <;> nextstate(main 3 test.pl:6) v/2 3 <$> const[PV "print \"Hello!\", \"\\n\";"] s 4 <1> entereval[t1794] vK/1 5 <@> leave[1 ref] vKP/REFC test.pl syntax OK
これは実行順*3に並べてくれます。スタックマシン的な挙動としてはこちらのほうが「ぽい」かも。
ともかく，entereval (PL_ENTEREVAL) を無効化すればよいことがわかります((leaveeval が利用される状況はあるのでしょうか？まだちゃんと読んでいません。))。
XS プロジェクトの雛形を作り，ソースを書く
Shibuya.pm #9 での id:hirose31 さんの発表にしたがって，h2xs -A -n で雛形を生成します*4。
てきとうなディレクトリで下記のように実行します。
% h2xs -A -n eval Defaulting to backwards compatibility with perl 5.8.8 If you intend this module to be compatible with earlier perl versions, please specify a minimum perl version with the -b option. Writing eval/ppport.h Writing eval/lib/eval.pm Writing eval/eval.xs Writing eval/Makefile.PL Writing eval/README Writing eval/t/eval.t Writing eval/Changes Writing eval/MANIFEST
eval なんて予約語と同じ名前のモジュールを作ってしまいました（良い子は真似しないでください）。これで eval/ ディレクトリができるので，今後はそのディレクトリの内部で作業を行います。
eval.xs が XS としてのコアソースになります。以下のような内容です。
/* eval.xs */ #define PERL_CORE #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" static OP * my_ck_entereval(pTHX_ OP *o) { op_null(o); return o; } MODULE = eval PACKAGE = eval PROTOTYPES: ENABLE void _no_eval() PROTOTYPE: CODE: PL_check[OP_ENTEREVAL] = my_ck_entereval;
OP_ENTEREVAL の PL_check[] を，自分のオリジナルの関数に置き換えています。普通は事前の PL_check[OP_ENTEREVAL] に OPCODE の生成をおまかせして後からいじったりするものです。が，今回は完全に無効化するだけなので，デフォルトの挙動はいらないやーと思い，古い PL_check[] を保存していません。
自作の PL_check[OP_ENTEREVAL] 用コード my_ck_eval() の内容は，渡された OPCODE を op_null() という関数でさっくり無効化しています。ほんとにこのコードでいいのかはわかりませんが，ソースを見てたらこんな名前の関数を使っていたりしたので，今回は使ってみました。
んで，以上のような XS ソースを書くと，_no_eval() という関数を pm モジュール側から呼び出せるようになります。
# eval.pm package eval; use strict; use warnings; our $VERSION = '0.01'; require XSLoader; XSLoader::load('eval', $VERSION); sub unimport { _no_eval(); } 1; __END__ =head1 NAME eval - ignore "eval" statement =head1 SYNOPSIS no eval; eval "some code"; =head1 DESCRIPTION Blah blah blah. =cut
unimport() という関数で XS 側の _no_eval() 関数を呼び出しています。
use と import()，no と unimport
unimport() という関数は，no モジュール とした場合に呼び出される関数です。つまり，
use Foo LIST; # is equivalent to BEGIN { require Foo; Foo->import( LIST ); }
なのに対して，
no Foo LIST; # is equivalent to BEGIN { require Foo; Foo->unimport( LIST ); }
となります((だから，実は no URI; URI->new(...); とか書けるんですよ。))。
Pure Perl モジュールとして no の使いどころはあまりなく，不憫なので使ってみました（嘘）。実はこのようなレキシカルに作用するモジュールでは import() / unimport() を使うと BEGIN 節で実行されるので便利です，ということに後で気がつきました。
ビルドする
普通の Perl modules と同じように，
% perl Makefile.PL Checking if your kit is complete... Looks good Writing Makefile for eval
して
% make cp lib/eval.pm blib/lib/eval.pm ...... snip snip snip ...... Manifying blib/man3/eval.3pm
すれば出来上がりです。
実行してみよう
それでは挙動をたしかめるコードを書いてみます。
use strict; use warnings; no eval; eval 'print "Hello!", "\n";';
このようなコードで Hello! と表示されなければ OK のはずです。
このコードを簡単に実行するためには t/ ディレクトリにテストスクリプトとして置けばいいんですけど，出力結果が煩雑になってしまうので，モジュールサーチパスを指定して直接実行してみます。
% perl -Iblib/lib -Iblib/arch test.pl Useless use of a constant in void context at test.pl line 6.
おお，謎の warning((eval を無効化したので，'print "Hello!", "\n";'; という文字列定数のみが存在する文を書いたような状況になっているためです。くわしくは perldiag を参照してください。)) がでましたが，無事？Hello! とは表示されませんでした。
OPCODE がどのようになったのかたしかめてみます。
% perl -Iblib/lib -Iblib/arch -MO=Concise test.pl Useless use of a constant in void context at test.pl line 6. 3 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 210 test.pl:6) v/2 ->3 - <1> ex-entereval vK/1 ->3 - <0> ex-const v ->- test.pl syntax OK
もともと entereval だったツリー部分が ex-entereval だの ex-const だのになっています。これは，実は op_null(o) が親切にも「もともと何だったのか」というのを記録してくれているためです((Perl_op_null() のソースも参照してください。))。
おもしろいことに，末尾の「遷移先」をみると，nextstate のあとに 3，すなわち leave まで戻っています。このように Perl の構文生成器は最適化してくれるんですね。
改善する
entereval の下位ツリーも保存されていたためにさきほどのような warning がでてしまいました。ので，よりキッチリと「無効化」しようと思います。
XS のコードを下記のように書き換えます。
static OP * my_ck_entereval(pTHX_ OP *o) { op_free(o); return newOP(OP_NULL, 0); }
さきほど op_null(o) で NULL 化しましたが，今回は op_free(o) で free して((op_free(o) は子ツリーの OPCODE もリリースしてくれます。))新たに OP_NULL な OPCODE を生成して NULL 化しています。無引数の OPCODE は newOP() で生成すればそれで OK です((単一引数の OPCODE 用 newUNOP() や2引数の OPCODE 用 newBINBOP() などの関数も存在します。まぁ newOP() してから自力で操作してもいいんですが。))。
ビルドしてから OPCODE をみてみましょう。
% perl -Iblib/lib -Iblib/arch -MO=Concise test.pl 3 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 210 test.pl:6) v/2 ->3 - <0> null v ->3 test.pl syntax OK
今度は OPCODE null の下位ツリーが消失しています。「Useless use of a constant」な warnings も出力されていません。
-exec オプションをつけて OPCODE を観察すると，
% perl -Iblib/lib -Iblib/arch -MO=Concise,-exec test.pl 1 <0> enter 2 <;> nextstate(main 210 test.pl:6) v/2 3 <@> leave[1 ref] vKP/REFC test.pl syntax OK
最適化によって実際には OPCODE null の部分は実行されないことがわかります。
上記コードで OP_NULL な OPCODE を返しているところ，NULL 返すとうまくやってくれるんじゃないの？とか思いますが，たぶんうまくいきません。もしよしなにやってくれたとしても，上位ツリーの引数が1つ減ることになってしまいますからね。
eval を「有効化」できるようにする
no eval したコードを再び use eval できるようにしてみましょう。
XS のコードは下記の通りです。
/******* snip snip snip *******/ MODULE = eval PACKAGE = eval PROTOTYPES: ENABLE void _no_eval() PROTOTYPE: CODE: PL_check[OP_ENTEREVAL] = my_ck_entereval; void _use_eval() PROTOTYPE: CODE: PL_check[OP_ENTEREVAL] = Perl_ck_eval;
ほんとは _no_eval() するときに事前の PL_check を保存しておいて，_use_eval() したときにそこに戻す必要があります((さもないと，他のモジュールで PL_check[OP_ENTEREVAL] をいじってるものがあるとおかしくなります。さらに，ネスト等も検出して自力でマネージするべきでしょうね。めんどくさー。))が，めんどうなのでデフォルト値である Perl_ck_eval を設定しています。
書くまでもないでしょうが pm 側のコードは下記のようになります。
/******* snip snip snip *******/ our $VERSION = '0.01'; require XSLoader; XSLoader::load('eval', $VERSION); sub unimport { _no_eval(); } sub import { _use_eval(); } /******* snip snip snip *******/
さて，テストコードは下記のようになります。
use strict; use warnings; eval 'print "Should print", "\n";'; no eval; eval 'print "Should not print", "\n";'; use eval; eval 'print "Should print", "\n";';
これで「Should print」の部分だけ表示されれば成功ですが……
% perl -Iblib/lib -Iblib/arch test.pl Should print Should print
無事成功しました。
OPCODE ツリーを覗いてみます。
% perl -Iblib/lib -Iblib/arch -MO=Concise test.pl 9 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 3 test.pl:5) v/2 ->3 4 <1> entereval[t1794] vK/1 ->5 3 <$> const[PV "print \"Should print\", \"\\n\";"] s ->4 5 <;> nextstate(main 210 test.pl:8) v/2 ->6 - <0> null v ->6 6 <;> nextstate(main 211 test.pl:11) v/2 ->7 8 <1> entereval[t1794] vK/1 ->9 7 <$> const[PV "print \"Should print\", \"\\n\";"] s ->8 test.pl syntax OK
no eval されている2つめの entereval だけ null に変化しています。
いままで B::Concise によって OPCODE ツリーだけ見てきましたが，代わりに B::Deparse を使うと Perl のコードとして「デコンパイル」することができます。
% perl -Iblib/lib -Iblib/arch -MO=Deparse test.pl use warnings; use strict 'refs'; eval 'print "Should print", "\\n";'; no eval; use eval; eval 'print "Should print", "\\n";'; test.pl syntax OK
OPCODE 的に2個めの eval が消えているので，当然デコンパイルしてもあらわれてきません。
例外構文の eval { ... } にも対応する
no eval とうたうくらいですから，ブロックを与えるタイプの eval についても対応しなくてはなりません*5。
use strict; use warnings; eval { print "Hello", "\n"; };
こんなやつ。これの OPCODE ツリーは，
% perl -MO=Concise test.pl 5 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 4 test.pl:6) v/2 ->3 4 <@> leavetry vK ->5 3 <|> entertry(other->4) v ->6 6 <;> nextstate(main 3 test.pl:7) v/2 ->7 a <@> print vK ->4 7 <0> pushmark s ->8 8 <$> const[PV "Hello"] s ->9 9 <$> const[PV "\n"] s ->a test.pl syntax OK
さきほどより複雑。
ブロック型 eval の場合，OPCODE のシリアルな実行順としては
- まず
entertryして - その後ブロック内の OPCODE ツリーが並び
- 最後に
leavetryする
となっているようです。が，単に eval { ... } ブロックを無効化するためには，ツリーとして leavetry (PL_LEAVETRY) を null にすればよいことがわかります。
では，XS のコードです。
/******* snip snip snip *******/ static OP * my_ck_leavetry(pTHX_ OP *o) { op_free(o); return newOP(OP_NULL, 0); } /******* snip snip snip *******/ MODULE = eval PACKAGE = eval PROTOTYPES: ENABLE void _no_eval() PROTOTYPE: CODE: PL_check[OP_ENTEREVAL] = my_ck_entereval; PL_check[OP_LEAVETRY] = my_ck_leavetry; void _use_eval() PROTOTYPE: CODE: PL_check[OP_ENTEREVAL] = Perl_ck_eval; PL_check[OP_LEAVETRY] = Perl_ck_null;
実は my_ck_leavetry() の内容は my_ck_entereval とまったく同じです。が，わかりやすくするため新たに関数を設けています。また，PL_check[OP_LEAVETRY] はもともと Perl_ck_null なので，「有効化」するときに Perl_ck_null を代入しています。
今回は pm 側のコードを書き換える必要はありません。
テストコードは下記の通りです。
use strict; use warnings; no eval; eval { print "Hello", "\n"; };
これをいままでと同様に実行すると，
% perl -Iblib/lib -Iblib/arch test.pl
無事？print 文は実行されませんでした。
OPCODE ツリーの状態は……
% perl -Iblib/lib -Iblib/arch -MO=Concise test.pl 3 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 211 test.pl:7) v/2 ->3 - <0> null v ->3 test.pl syntax OK
あれだけ複雑だった eval { ... } ブロックの中身がごっそり消えています。
おわりに
今回は単純に OP_NULL に置き換えるハックだけ行いましたが，ここを自力で OPCODE ツリーを構築すると，より複雑な「改変」が可能になります。暇があればやってみたいです。
最後に参考文献を書こうと思いましたが，次回にまわします。とりあえず今回の内容のもととなった id:yappo ++，id:tokuhirom ++, id:hirose31 ++, そして Shibuya.pm #9 をオーガナイズしたみなさんと動画として公開してくれた方々 ++！
*1:TAINT モードを使えば軽減されますが。あと Safe というモジュールもあり細かく許可不許可を制御できるそうです。see 404 Blog Not Found:use Safe; # XS知らなくても大丈夫!
*2:see http://d.hatena.ne.jp/tokuhirom/20080623/1214198833
*3:OPCODE の「格納順」というより，「実行順」です。後の「最適化」の例を見ればわかります。
*4:Module::Starter いれてないもので。
*5:もはや当初の「危険ですよねー」とか関係なくなってます ;-P
