perl-win32で再起動前に終了処理をする方法

結構つまったのでメモ。

Win32では通常、ユーザーが再起動またはログアウト処理を開始すると全てのWindowに対してWM_QUERYENDSESSIONというメッセージが送られてくる。これを受信した際に各種終了処理（データを保存したり接続を切ったり）を行い、その結果終了していい場合はtrueを返す。falseを返せば再起動要求をキャンセルできる。(強制再起動ではない場合)

Perlでシステム管理系のツールを書く場合、これと同じような動作をさせたいので調べてみた。

環境は ActivePerl 5.8.8.822 / Perl 5.8.8 / WinXP SP2

まず、PerlはコンソールプログラムなのでそもそもMessageを処理していない。この場合、再起動の通知を受け取る場合はSetConsoleCtrlHandlerにて通知を受け取るCallback関数を登録する。これにより、CTRL_SHUTDOWN_EVENTやCTRL_C_EVENTなどを受け取ることができる。

ってことで、Win32::APIモジュールを使って実装してみた。

use Win32::API;
use Win32::API::Callback;

sub handler {
    my $sig = shift;
    print "SIG: $sig\n";
    return 1;
}

my $cb = Win32::API::Callback->new(\&handler, "I", "I" );
my $setcchand = Win32::API->new('kernel32','SetConsoleCtrlHandler','KI','I' );
$setcchand ->Call($cb, 1);

Win32::Sleep(200) for (1..1000);

ここでCtrl+Cを押せばCTRL_C_EVENTが発生してprintされるはずなんだが・・・Perlがエラーで落ちる。さて困ったぞと。

しょうがないのでPerlのwin32の実装を見てみる。

win32/win32.c:5188
    SetConsoleCtrlHandler(win32_ctrlhandler,TRUE);

win32/win32.c:5038-
    case CTRL_C_EVENT:
        /*  A CTRL+c signal was received */
        if (do_raise(aTHX_ SIGINT))
            sig_terminate(aTHX_ SIGINT);
        return TRUE;

なるほど。。。SetConsoleCtrlHandlerにすでに登録済み。これには本来は複数登録することが可能なのだが、どれかがTRUEを返した時点で他のは実行されない。って事で、こいつがここでSIGINTを投げるようにエミュレートしてるっぽい。なんつー罠。ちなみにCTRL_SHUTDOWN_EVENTの時はSIGTERMを投げるようだ。

なので、こう書くのが正解。

use Win32;

$SIG{TERM} = \&before_shutdown;
$SIG{INT}  = \&on_ctrl_c_press;  # Ctrl + C
$SIG{HUP}  = \&on_close_click;   # [x] ボタンを押したとき

sub before_shutdown { exit; }
sub on_ctrl_c_press { exit; }
sub on_close_click  { exit; }

Win32::Sleep(1000) while(1);

シグナルを処理する関数内ではexitしないと、終了しなくなる。タスクマネージャからは終了できるけど。
これでいいはずなのだが、シャットダウンはなぜかキャッチできない。

詳しくコードを追っかけるのが面倒だったので適当に調べたところ、再起動時にはSIGQUITが飛んでくる。どこからだろうか。まぁいい。

なので、

$SIG{QUIT} = \&before_shutdown;

とかけばいい事になる。で、一見解決したようなんだが、このままだとDOS窓が邪魔。なのでActivePerlに入ってるwperl.exeを使う。これだとDOS窓がでない。素敵。

っと思ったら罠が。単純に表示しないようにしてるわけじゃなく、コンソールプログラムからWindowsプログラムにsubsystemを切替えてるらしい。そのおかげでこっちでは使えない。なので窓無しでシステムの終了をHOOKする為にはやっぱりWM_QUERYENDSESSIONを処理しろって事なのか。

win32/win32.c:1900   win32_async_check
     /* Perhaps some other messages could map to signals ? ... */

とか書いてあるがそこ一帯が#if 0でコメントアウト。

うーん。Perlだけでやるのきついかなー、やっぱ。wperlって窓作ってるのかなー。こりゃもうちょいソースまじめに読まないとダメだ。とりあえずここまでで諦め。