windowsで名前付きパイプを作る

ActivePerl で Win32::Pipe が正常動作しなかった（AutoLoaderが実行時に異常終了する）ので Win32::API を直接叩いてみた。

クライアント側は普通に open/close で読み書きできるので、サーバ側で namedpipe を作る部分を書いてみる。

use strict;  
use warnings;  
use Win32::API;  
use Fcntl;  
use constant {  
    PIPE_ACCESS_INBOUND     => 0x00000001,  # O_RDONLY相当
    PIPE_ACCESS_OUTBOUND    => 0x00000002,  # O_WRONLY相当
    PIPE_ACCESS_DUPLEX      => 0x00000003,  # O_RDWR相当

    PIPE_WAIT               => 0x00000000,
    FILE_FLAG_OVERLAPPED    => 0x40000000,
};

*STDOUT->autoflush;

my $PIPE_NAME = "\\\\.\\pipe\\pipesv";

my $CreateNamedPipe = Win32::API->new( "kernel32", "CreateNamedPipe", "PNNNNNNP", "N" ) or die;  
my $PIPE = $CreateNamedPipe->Call(  
    $PIPE_NAME,                #  LPCTSTR lpName,                             // パイプ名
    PIPE_ACCESS_DUPLEX,     #  DWORD dwOpenMode,                           // パイプを開くモード
    PIPE_WAIT,              #  DWORD dwPipeMode,                           // パイプ固有のモード
    255,                    #  DWORD nMaxInstances,                        // インスタンスの最大数
    0,                      #  DWORD nOutBufferSize,                       // 出力バッファのサイズ
    0,                      #  DWORD nInBufferSize,                        // 入力バッファのサイズ
    10_000,                 #  DWORD nDefaultTimeOut,                      // タイムアウト(msec)の間隔
    0,                      #  LPSECURITY_ATTRIBUTES lpSecurityAttributes  // セキュリティ記述子
);
my $CloseHandle = Win32::API->new( "kernel32", "CloseHandle", "N", "N" ) or die;

my $ReadFile = Win32::API->new( "kernel32", "ReadFile", "NPNPP", "N" ) or die;  
sub ReadFile {  
    my $hFile = shift;
    my $lpBuffer = "\0" x 512;
    my $nNumberOfBytesToRead = 512;
    my $lpNumberOfBytesRead = "\0" x 8;
    my $result = $ReadFile->Call(
        $hFile,
        $lpBuffer,
        $nNumberOfBytesToRead,
        $lpNumberOfBytesRead,
        0);
    return undef unless $result;
    my $length = unpack "V", $lpNumberOfBytesRead;
    return undef unless $length;
    return substr $lpBuffer, 0, $length;
}

my $WriteFile = Win32::API->new( "kernel32", "WriteFile", "NPNPP", "N" ) or die;  
sub WriteFile {  
    my $hFile = shift;
    my $lpBuffer = shift;
    while (my $nNumberOfBytesToWrite = defined $lpBuffer && length $lpBuffer) {
        my $lpNumberOfBytesWritten = "\0" x 8;
        my $result = $WriteFile->Call(
            $hFile,
            $lpBuffer,
            $nNumberOfBytesToWrite,
            $lpNumberOfBytesWritten,
            0);
        return undef unless $result;
        my $length = unpack "V", $lpNumberOfBytesWritten;
        $lpBuffer = substr $lpBuffer, $length;
    }
    return undef;
}

my $ConnectNamedPipe = Win32::API->new( "kernel32", "ConnectNamedPipe", "NP", "N" ) or die;  
my $DisconnectNamedPipe = Win32::API->new( "kernel32", "DisconnectNamedPipe", "N", "N" ) or die;

while ($ConnectNamedPipe->Call($PIPE, 0)) {  
    WriteFile($PIPE, "Welcome\n");
    print ReadFile($PIPE);         # client from "Hello"
    $DisconnectNamedPipe->Call($PIPE);
    #last;      # no loop
}
$CloseHandle->Call($PIPE);

1;  
__END__  

本来はセキュリティ記述子を指定すべきだが、本件は動作サンプルなので省略¹する。バッファサイズについてはダミーなので 0 と書いて良い。 こうして出来た PIPEハンドル（単なるint値）は、PerlIOの感知するところではないため² 通常の sysread/syswrite では扱えない。従って CloseHandle/WriteFile/ReadFile についても Win32API で実装する。

ConnectNamedPipe() はソケット通信の accept() に相当する関数で、クライアント側が同名パイプを開くまでI/Oブロックする。DisconnectNamedPipe()はこのセッションを閉じてクライアントを切断する。

いっぽう、クライアント側は普通のファイルアクセスとなんら変わるところはない。

use strict;  
use warnings;

*STDOUT->autoflush;

my $PIPE_NAME = "\\\\.\\pipe\\pipesv";

open my $FH, "+<", $PIPE_NAME or die "$!";  
$FH->binmode(":raw");
print scalar <$FH>;                # server from "Welcome"  
$FH->write("hello\n");
$FH->close;

1;  
__END__  

マルチクライアントサーバを実装する場合、基本的には ConnectNamedPipe のあとで CreateThread すればよいが、CreateNamedPipe に FILE_FLAG_OVERLAPPED の指定と、ConnectNamedPipe に lpOverlapped の指定が必要になる。³