Shibuya Perl Mongersテクニカルトーク#11 でLTしてきました

昨日開催された Shibuya Perl Mongersテクニカルトーク#11で「Windowsユーザのための初めてのPerlプログラミング」というテーマでLTしてきました。なかなかゆっくり説明はできなかったので、デモとして用意しておいたコードを貼っておきます。

(追記)プレゼンテーション資料もアップロードしておきます。
http://www.slideshare.net/hasegawayosuke/windowsperl-1330816
ちなみに、「そのPPTのテンプレよく見つけたね」と言われたんですけど、手頃なテンプレがなかったので自分でハートとか並べて作ったやつです。

Perlからx86コードを呼びたいときの例。Win32 APIの SetConsoleCtrlHandler を使ってバイナリコードをシグナルハンドラに設定し、GenerateConsoleCtrlEvent で Ctrl+C (SIGINT) を発生させてバイナリコードにジャンプする例です。Perl側のシグナルハンドラも設定しておかないと、自分自身のCtrl+Cで終了してしまいます。

#!/usr/bin/perl
# call x86 code from Perl with signal 
use strict;
use warnings;
use Win32::API;

#include <windows.h>
my $GetModuleHandle = Win32::API->new( "kernel32", "GetModuleHandleA", "P", "N" );
my $GetProcAddress = Win32::API->new( "kernel32", "GetProcAddress", "NP", "N" );
my $GenerateConsoleCtrlEvent = Win32::API->new( "kernel32", "GenerateConsoleCtrlEvent", "NN", "N" );
my $SetConsoleCtrlHandler = Win32::API->new( "kernel32", "SetConsoleCtrlHandler", "NN", "N" );

use constant{
    TRUE => 1,
    CTRL_C_EVENT => 0,
};

sub catch_signal {
}

my $hUser32 = $GetModuleHandle->Call( "user32" );
my $hKernel32 = $GetModuleHandle->Call( "kernel32" );

my $MessageBox = pack( 'L', $GetProcAddress->Call( $hUser32, "MessageBoxA" ) );

#$SIG{INT} = \&catch_signal;

my $x86 = ""
.   "\x90"                  # --- check signal type ---
.   "\x83\x7d\x08\x00"          # cmp [dwCtrlEvent], 0
.   "\x74\x05"                  # je ...            if( not Ctrl+C ) return 
.   "\x33\xc0"                  # xor eax, eax
.   "\xc2\x04\x00"              # ret 4
.   "\x90"                  # --- MessageBox ---
.   "\x6a\0"                    # push 0            MB_OK
.   "\x68"                      # push caption
.       pack( 'P', "Message" )  # 
.   "\x68"                      # push text
.       pack( 'P', "Hello,World" )
.   "\x6a\0"                    # push 0            hWnd
.   "\xb8"                      # mov eax, addr
.       $MessageBox
.   "\xff\xd0"                  # call eax
.   "\x33\xc0"                  # xor eax, eax
.   "\xc2\x04\x00"              # ret 4
;

$SetConsoleCtrlHandler->Call( unpack( 'L', pack( 'P', $x86 ) ), TRUE );
$GenerateConsoleCtrlEvent->Call( CTRL_C_EVENT, 0 );
while( 1 ){};

x86バイナリコードからPerlのコードを呼ぶ例です。Perl上で $SIG{INT} でシグナルハンドラを設定しておき、バイナリコード内でGenerateConsoleCtrlEvent を使ってシグナルを発生させることで Perl 側にコンテキストを移します。バイナリコードの実行は、最初の例と同じく Perl 側からのシグナルを使います。Perlからバイナリコード、バイナリコードからPerlのそれぞれで使うシグナルをわけています。

#!/usr/bin/perl
# call Perl code from x86 code with signal
use strict;
use warnings;
use Win32::API;

#include <windows.h>
my $GetModuleHandle = Win32::API->new( "kernel32", "GetModuleHandleA", "P", "N" );
my $GetProcAddress = Win32::API->new( "kernel32", "GetProcAddress", "NP", "N" );
my $GenerateConsoleCtrlEvent = Win32::API->new( "kernel32", "GenerateConsoleCtrlEvent", "NN", "N" );
my $SetConsoleCtrlHandler = Win32::API->new( "kernel32", "SetConsoleCtrlHandler", "NN", "N" );

use constant{
    TRUE => 1,
    CTRL_BREAK_EVENT => 1,
};

sub catch_signal {
    print "Hello, Perl World!\n";
}
$SIG{INT} = \&catch_signal;

my $hUser32 = $GetModuleHandle->Call( "user32" );
my $hKernel32 = $GetModuleHandle->Call( "kernel32" );

my %addr = (
    'MessageBox' => pack( 'L', $GetProcAddress->Call( $hUser32, "MessageBoxA" ) ),
    'GenerateConsoleCtrlEvent' => pack( 'L', $GetProcAddress->Call( $hKernel32, "GenerateConsoleCtrlEvent" ) ),
);


my $x86 = ""
.   "\x90"                  # --- check signal type ---
.   "\x83\x7d\x08\x01"          # cmp [dwCtrlEvent], 0
.   "\x74\x05"                  # je ...            if( not Ctrl+BREAK ) return
.   "\x33\xc0"                  # xor eax, eax
.   "\xc2\x04\x00"              # ret 4
.   "\x90"                  # --- GenerateConsoleCtrlEvent ---
.   "\x6a\0"                    # push 0 Process Group Id
.   "\x6a\0"                    # push 0 Ctrl-C Event
.   "\xb8"                      # mov eax, addr
.       $addr{'GenerateConsoleCtrlEvent'}
.   "\xff\xd0"                  # call eax
.   "\xB8\x01\x00\x00\x00"      # mov eax, 1         return TRUE
.   "\xc2\x04\x00"              # ret 4
;

$SetConsoleCtrlHandler->Call( unpack( 'L', pack( 'P', $x86 ) ), TRUE );
$GenerateConsoleCtrlEvent->Call( CTRL_BREAK_EVENT, 0 );
sleep( 1 );

Win32::API::Callback を普通に使う例です。EnumWindows を使ってウィンドウタイトルを列挙する、教科書通りの例です。

#!/usr/bin/perl
# Win32::API::Callback sample
use strict;
use warnings;
use Win32::API;
use Win32::API::Callback;

#include <windows.h>
my $EnumWindows = Win32::API->new( "user32", "EnumWindows", "KN", "N" );
my $GetWindowText = Win32::API->new( "user32", "GetWindowTextA", "NPN", "N" );

my $callback = Win32::API::Callback->new( 
    sub {
        my ( $hWnd, $param ) = @_;
        my $buf = "\0" x 1024;

        $GetWindowText->Call( $hWnd, $buf, length( $buf ) );

        $buf =~ s/\0.*$//;
        if( length( $buf ) ){
            print "$hWnd : $buf\n";
        }
        return 1;
    },
    "NN", "N",
);
$EnumWindows->Call( $callback, 0 );

Win32::API::Callback を使って、x86コードからPerlの関数を呼び出す例です。EnumWindowsのコールバック関数としてバイナリコードを呼び出し、そのバイナリコードへの引数としてPerl側で用意した Callback オブジェクトのアドレスを渡しておきます。バイナリコード内では、受け取ったアドレスをcallします。シグナルハンドラによるコンテキストの切り替えと異なり、引数や返り値の受け渡しもスムーズに行えます。

#!/usr/bin/perl
# Call Perl code from x86 code using Win32::API::Callback 
use strict;
use warnings;
use Win32::API;
use Win32::API::Callback;

#include <windows.h>
#my $EnumWindows = Win32::API->new( "user32", "EnumWindows", "KN", "N" );
my $EnumWindows = Win32::API->new( "user32", "EnumWindows", "NK", "N" );

my $callback = Win32::API::Callback->new( 
    sub {
        my $value = shift;
        print "Hello, Perl World! arg = $value\n";
        return 0;
    },
    "N", "N",
);

my $x86 = ""
.   "\x8b\x44\x24\x08"          # mov eax, dword ptr[ callback ]
.   "\x68\x4E\x61\xBC\x00"      # push 12345678
.   "\xff\xd0"                  # call eax
.   "\x33\xc0"                  # xor eax, eax
.   "\xc2\x08\x00"              # ret
;

$EnumWindows->Call( unpack( 'L', pack( 'P', $x86 ) ), $callback ); 

最後に、Perlからバイナリコードを呼び出す応用として少しは使い勝手のあるサンプルとして、stdcallではないDLL関数を呼び出すコードです。msvcrt.dllに含まれる sprintf 関数は、cdecl という呼び出し規約になっていますので、普通に Win32::API では呼び出せませんが、関数を呼び出す部分を自前で書くことによって、stdcall ではない関数も使うことができます。

#!/usr/bin/perl
# calling non-stdcall function (sprintf)
use strict;
use warnings;
use Win32::API;

#include <windows.h>
my $EnumWindows = Win32::API->new( "user32", "EnumWindows", "NN", "N" );
my $GetProcAddress = Win32::API->new( "kernel32", "GetProcAddress", "NP", "N" );
my $LoadLibrary = Win32::API->new( "kernel32", "LoadLibraryA", "P", "N" );
my $FreeLibrary = Win32::API->new( "kernel32", "FreeLibrary", "N" );

sub my_sprintf{
    if( @_ < 1 ){
        die "argument error";
    }

    my $hDll = $LoadLibrary->Call( "msvcrt" );
    my $sprintf = pack( 'L', $GetProcAddress->Call( $hDll, "sprintf" ) );
    my $buf = "\0" x 1024;
    my $x86 ="";
    my $i = @_;

    while( $i-- > 0 ){
        $x86 .= "\x68" . $_[ $i ];      # push args
    }
    $x86 .= "\x68" . pack( 'P', $buf ); # push $buf
    my $n = ( @_ + 1 ) * 4;
    $x86 .= ""
.       "\xb8" . $sprintf               # mov eax, func
.       "\xff\xd0"                      # call eax
.       "\x81\xC4"                      # add esp, @_ * 4
.       pack( 'L', $n )
.       "\x33\xc0"                      # xor eax, eax
.       "\xc2\x08\x00"                  # ret
;

#   print unpack( 'H2 ' x length( $x86 ), $x86 );
#   print "\n";
    $EnumWindows->Call( unpack( 'L', pack( 'P', $x86 ) ), 0 );
    $FreeLibrary->Call( $hDll );
#   print unpack( 'H2 ' x 20, $buf );
#   print "\n";
    $buf =~s/\0.*$//;
    return $buf;
}

my $s = my_sprintf( pack( 'P', "%s,%s" ), pack( 'P', "Hello" ), pack( 'P', "World" ) );
print $s;