Perlで学ぶ「詳解 UNIXプログラミング」(その10) 第10章 シグナル

仕事が忙しくなり 4ヶ月ほど放置してましたが、再開.

はじめに

「詳解 UNIXプログラミング」の第十章を示します.

本家

http://d.hatena.ne.jp/atsuoishimoto/20110328/1301279230

10.1 SIGUSR1とSIGUSR2を捕捉する簡単なプログラム

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();

# SIGUSR1とSIGUSR2を捕捉する簡単なプログラム

local $SIG{USR1} = sub {
    print "received SIGUSR1\n";
};
local $SIG{USR2} = sub {
    print "received SIGUSR2\n";
};

printf "pid = %d\n", $$;

while (1) {
    POSIX::pause();
}

出力された pidに対してシグナルを送るとメッセージが出力されます。

  % kill -SIGUSR1 (表示されたpid)
  % kill -SIGUSR2 (表示されたpid)

10.2 シグナルハンドラからの再入不可能な関数の呼び出し

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX;

my $name;
local $SIG{ALRM} = sub {
    print "in signal hander\n";
    $name = (getpwnam("root"))[0];
    alarm 1;
};

alarm 1;

while (1) {
    $name = (getpwnam("syohei"))[0];
    if ($name ne "syohei") {
        print "return value corrupted\n";
    }
}

Pythonの場合と同様に %SIGに設定した場合はシグナル通知してすぐにハンドラが実行されると
いうわけではないです。

詳しくは以下を参照してください。
Perlでシグナル処理（DBIを黙らせる編） : D-7 <altijd in beweging>

10.3システムVにおいて正しく動作しないSIGCLDハンドラ

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX;

local $SIG{CHLD} = sub {
    print "SIGCHLD received\n";
    my $pid = wait;
    print "pid = $pid\n";
};

my $pid = fork;
die "Error: fork $!\n" unless defined $pid;

if ($pid == 0) { # child
    sleep 2;
} else {
    POSIX::pause;
}

10.4 sleepの単純な(不完全な)実装

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX;

sub sleep1 {
    my $sec = shift;

    local $SIG{ALRM} = sub {
        1; # nothing to do, just return to wake up the pause
    };

    alarm $sec;
    POSIX::pause();
    alarm 0;
}

my $sec = shift || 3;
sleep1($sec);

10.5, 10.6

Python同様なし

10.7 時間切れ付きのreadの呼び出し

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX;

# 時間切れ付きのreadの呼び出し

local $SIG{ALRM} = sub {
    print "raised SIGALRM\n";
    1; # noting to do, just return to interrupt the read
};
alarm 2;

my $line = sysread STDIN, my $buf, 2 ** 16;
if ($! == POSIX::EINTR) {
    $line = "\n";
}

alarm 0;

print "result: $line";

10.8 longjump()を用いた時間切れ付きのreadの呼び出し

evalブロックで dieしたら longjumpします。

10.9 sigaddset, sigdelset, sigismemberの実装

真似してテストをつけてみました。

#!/usr/bin/env perl
use strict;
use warnings;

use Config;
use POSIX;

# sigaddset, sigdelset, sigismemberの実装

sub SIGBAD {
    my $signo = shift;

    if ($signo <=0 || $signo >= $Config{sig_count}) {
        die "Invalid signal number($signo)\n";
    }
}

sub sigaddset {
    my ($sigset, $signo) = @_;

    SIGBAD($signo);
    $sigset = $sigset | (1 << ($signo - 1)); # turn bit on

    return $sigset;
}

sub sigdelset {
    my ($sigset, $signo) = @_;

    SIGBAD($signo);
    $sigset = $sigset & ~(1 << ($signo - 1)); # turn bit off

    return $sigset;
}

sub sigismember {
    my ($sigset, $signo) = @_;

    SIGBAD($signo);

    if (ref $sigset eq 'POSIX::SigSet') {
        if ($sigset->ismember($signo)) {
            return 1;
        } else {
            return 0;
        }
    } else {
        if ($sigset & (1 << ($signo - 1))) {
            return 1;
        } else {
            return 0;
        }
    }
}

unless (caller) {
    use Test::More;
    use Test::Exception;

    subtest 'SIGBAD test' => sub {
        lives_ok { SIGBAD(1) } 'valid signo';
        dies_ok { SIGBAD(0) } 'invalid signo';
    };

    subtest 'sigaddset test' => sub {
        is(sigaddset(0, 1), 1);
        is(sigaddset(1, 16), 32769);
        dies_ok { sigaddset(0, 0); } 'invalid argument';
    };

    subtest 'sigdelset test' => sub {
        is(sigdelset(1, 1), 0);
        is(sigdelset(3, 2), 1);
        dies_ok { sigdelset(0, 0); } 'invalid argument';
    };

    subtest 'sigismember test' => sub {
        is(sigismember(1, 1), 1);
        is(sigismember(3, 3), 0);
        dies_ok { sigismember(0, 0); } 'invalid argument';
    };

    done_testing;
}

1;

10.10 プログラムのシグナルマスクを出力する

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();

require '10_9.pl'; # import sigismember

# プログラムのシグナルマスクを出力する

sub pr_mask {
    my $str = shift;
    local $!;

    my $sigset = POSIX::SigSet->new;
    unless (POSIX::sigprocmask(0, undef, $sigset)) {
        die "$!\n";
    }
    if (sigismember($sigset, POSIX::SIGINT)) {
        print "SIGINT\n";
    }
    if (sigismember($sigset, POSIX::SIGQUIT)) {
        print "SIGQUIT\n";
    }
    if (sigismember($sigset, POSIX::SIGUSR1)) {
        print "SIGUSR1\n";
    }
    if (sigismember($sigset, POSIX::SIGALRM)) {
        print "SIGALRM\n";
    }

    print "\n";
}

1;

10.11 シグナルの集合と、sigprocmaskの例

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();

# シグナルの集合と、sigprocmaskの例

sub sig_quit {
    print "Caught SIGQUIT\n";
    $SIG{QUIT} = 'DEFAULT';
}

$SIG{QUIT} = \&sug_quit;

my ($newmask, $oldmask, $pendmask);
$newmask = POSIX::SigSet->new(POSIX::SIGQUIT);
$oldmask = POSIX::SigSet->new;
$pendmask = POSIX::SigSet->new;

unless (POSIX::sigprocmask(POSIX::SIG_BLOCK, $newmask, $oldmask)) {
    print "SIG_BLOCK error\n";
}

sleep 5;

unless (POSIX::sigpending($pendmask)) {
    print "sigpending error\n";
}

if ($pendmask->ismember(POSIX::SIGQUIT)) {
    print "SIGQUIT pending\n";
}

unless (POSIX::sigprocmask(POSIX::SIG_SETMASK, $oldmask)) {
    print "SIG_SETMASK error\n";
}

print "SIGQUIT unblocked\n";
sleep 5;

10.12 sigactionを用いたsignalの実装

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();

# sigactionを用いたsignalの実装

sub my_signal {
    my ($signo, $func) = @_;

    my $sigset = POSIX::SigSet->new;
    my $act = POSIX::SigAction->new($func, $sigset);
    my $oact = POSIX::SigAction->new;

    $act->flags(0);
    if ($signo != POSIX::SIGALRM) {
        $act->flags(POSIX::SA_RESTART);
    }

    unless (POSIX::sigaction($signo, $act, $oact)) {
        return POSIX::SIG_ERR;
    }

    return $oact->handler;
}

my_signal(POSIX::SIGUSR1, sub {
    print "Get Signal\n";
});

print "My pid is $$\n";
POSIX::pause;

10.13 signal_intr関数

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();

# signal_intr関数

sub signal_intr {
    my ($signo, $func) = @_;

    my $sigset = POSIX::SigSet->new;
    my $act = POSIX::SigAction->new($func, $sigset);
    my $oact = POSIX::SigAction->new;

    $act->flags(0);
    unless (POSIX::sigaction($signo, $act, $oact)) {
        return POSIX::SIG_ERR;
    }

    return $oact->handler;
}

alarm 3;
signal_intr(POSIX::SIGALRM, sub { print "alarm now\n"; } );
POSIX::pause;
alarm 0;

10.14 シグナルマスク、sigsetjump、siglongjmp

Perlでは eval + dieで対応する.

10.15 シグナルから臨界領域を保護する

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();

do '10_10.pl'; # import pr_mask

# シグナルから臨界領域を保護する

sub sig_int {
    pr_mask("in sig_int");
    $SIG{QUIT} = 'DEFAULT';
}

$SIG{INT} = \&sig_int;

my ($newmask, $oldmask, $zeromask);

$newmask = POSIX::SigSet->new;
$oldmask = POSIX::SigSet->new;
$zeromask = POSIX::SigSet->new;

$newmask->emptyset;
$oldmask->emptyset;
$zeromask->emptyset;

$newmask->addset(POSIX::SIGINT);
unless (sigprocmask(POSIX::SIG_BLOCK, $newmask, $oldmask)) {
    print "SIG_BLOCK error\n";
}

pr_mask("in critical region");

unless (POSIX::sigsuspend($zeromask)) {
    die "sigsuspend error\n";
}

pr_mask("after return from sigsuspend");

# reset signal mask which unblocks SIGINT
unless (POSIX::sigprocmask(POSIX::SIG_SETMASK, $oldmask)) {
    die "SIG_SETMASK error\n";
}

# and continue processing

10.16 大域変数の設定を待ち合わせるためのsigsuspendの使い方

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();

# 大域変数の設定を待ち合わせるためのsigsuspendの使い方

my $quitflag = 0;

sub sig_int {
    my $signame = shift;

    if ($signame eq 'INT') {
        print "interrupt\n";
    } elsif ($signame eq 'QUIT') {
        $quitflag = 1; # set flag for main loop
    }
}

local $SIG{QUIT} = \&sig_int;
local $SIG{INT}  = \&sig_int;

my $newmask  = POSIX::SigSet->new;
my $oldmask  = POSIX::SigSet->new;
my $zeromask = POSIX::SigSet->new;

$newmask->emptyset;
$oldmask->emptyset;
$zeromask->emptyset;

$newmask->addset(POSIX::SIGQUIT);
unless (POSIX::sigprocmask(POSIX::SIG_BLOCK, $newmask, $oldmask)) {
    print "SIG_BLOCK error\n";
}

while ($quitflag == 0) {
   POSIX::sigsuspend($zeromask);
}

# SIGQUIT has been caught and is now blocked; do whatever

10.17 親と子の同期のためのルーティン

#!/usr/bin/env perl
use strict;
use warnings;

# 親と子の同期のためのルーティン

use POSIX ();

my $newmask  = POSIX::SigSet->new;
my $oldmask  = POSIX::SigSet->new;
my $zeromask = POSIX::SigSet->new;

$newmask->emptyset;
$oldmask->emptyset;
$zeromask->emptyset;

my $sigflag = 0;
sub sig_usr {
    my $signame = shift;
    $sigflag = 1;
}

sub TELL_WAIT {
    $SIG{USR1} = \&sig_usr;
    $SIG{USR2} = \&sig_usr;

    $newmask->emptyset;
    $zeromask->emptyset;

    # block SIGUSR1 and SIGUSR2 and save current signal mask
    $newmask->addset(POSIX::SIGUSR1);
    $newmask->addset(POSIX::SIGUSR2);

    unless (POSIX::sigprocmask(POSIX::SIG_BLOCK, $newmask, $oldmask)) {
        die "SIG_BLOCK error\n";
    }
}

sub TELL_PARENT {
    my $pid = shift;
    kill POSIX::SIGUSR2, $pid; # tell parent we're done
}

sub WAIT_PARENT {
    while ($sigflag == 0) {
        POSIX::sigsuspend($zeromask); # and wait for parent
    }

    $sigflag = 0;
    unless (POSIX::sigprocmask(POSIX::SIG_SETMASK, $oldmask)) {
        die "SIG_SETMASK error\n";
    }
}

sub TELL_CHILD {
    my $pid = shift;
    kill POSIX::SIGUSR1, $pid; # tell child we're done
}

sub WAIT_CHILD {
    while ($sigflag == 0) {
        POSIX::sigsuspend($zeromask);  # and wait for child
    }

    $sigflag = 0;
    unless (POSIX::sigprocmask(POSIX::SIG_SETMASK, $oldmask)) {
        die "SIG_SETMASK error\n";
    }
}

10.18 POSIX.1のabortの実装

#!/usr/bin/env perl
use strict;
use warnings;

# POSIX.1のabortの実装

use POSIX ();
use IO::Handle;

sub abort {
    my $oldaction = POSIX::SigAction->new;

    POSIX::sigaction(POSIX::SIGABRT, undef, $oldaction);

    if (ref $oldaction->handler ne 'CODE') {
        # caller can't ignore SIGABRT, if so reset to default
        if ($oldaction->handler eq 'IGNORE') {
            $oldaction->handler('DEFALUT');
            POSIX::sigaction(POSIX::SIGABRT, $oldaction);
        }

        if ($oldaction->handler eq 'DEFAULT') {
            autoflush STDOUT 1; # flush all open stdio streams
        }
    }

    my $mask = POSIX::SigSet->new;
    $mask->fillset;
    $mask->delset(POSIX::SIGABRT);

    POSIX::sigprocmask(POSIX::SIG_SETMASK, $mask);

    kill POSIX::SIGABRT, POSIX::getpid();
    # if we are here, process caught SIGABRT and returned

    autoflush STDOUT, 1;

    my $action = POSIX::SigAction->new;
    $action->handler('DEFAULT');
    POSIX::sigaction(POSIX::SIGABRT, $action);
    POSIX::sigprocmask(POSIX::SIG_SETMASK, $mask);

    kill POSIX::SIGABRT, POSIX::getpid(); # and one more time

    exit 1;
}

abort();

10.19 edエディタを起動するためにsystemを利用する

#!/usr/bin/env perl
use strict;
use warnings;

# edエディタを起動するためにsystemを利用する

local $SIG{INT} = sub {
    print "caught SIGINT\n";
};

local $SIG{CHLD} = sub {
    print "caught SIGCHLD\n";
};

system("/bin/ed");

10.20 POSIX.2の正しいsystem関数の実装

waitpidではシグナルを受け取っても制御が返らないため、Proc::Wait3::wait3を使います。
詳細はこちら。

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();
use Errno ();
use Proc::Wait3 ();

# POSIX.2の正しいsystem関数の実装

sub my_system {
    my $cmdstring = shift;

    unless (defined $cmdstring) {
        return 1;
    }

    my $ignore = POSIX::SigAction->new;
    $ignore->handler('IGNORE');
    $ignore->flags(0);

    my $saveintr = POSIX::SigAction->new;
    unless (POSIX::sigaction(POSIX::SIGINT, $ignore, $saveintr)) {
        return -1;
    }

    my $savequit = POSIX::SigAction->new;
    unless (POSIX::sigaction(POSIX::SIGQUIT, $ignore, $savequit)) {
        return -1;
    }

    # now block SIGCHLD
    my $chldmask = POSIX::SigSet->new(POSIX::SIGCHLD);
    my $savemask;
    POSIX::sigprocmask(POSIX::SIG_BLOCK, $chldmask, $savemask);

    my $pid = fork;
    die "Can't fork: $!" unless defined $pid;

    my $status;
    if ($pid == 0) { # child
        # restore previous signal actions & reset signal mask
        POSIX::sigaction(POSIX::SIGINT, $saveintr);
        POSIX::sigaction(POSIX::SIGQUIT, $savequit);
        POSIX::sigprocmask(POSIX::SIG_SETMASK, $savemask);

        exec { '/bin/sh' } 'sh', '-c', $cmdstring or die "Can't exec: $!";
        exit 127; # never reach here
    } else { # parent
        (undef, $status) = Proc::Wait3::wait3(1);
        if ($! && $! != Errno::EINTR) {
            warn "Error while waiting child process: $!\n";
        }
    }

    unless (POSIX::sigaction(POSIX::SIGINT, $saveintr)) {
        return -1;
    }
    unless (POSIX::sigaction(POSIX::SIGQUIT, $savequit)) {
        return -1;
    }
    unless (POSIX::sigprocmask(POSIX::SIG_SETMASK, $savemask)) {
        return -1;
    }

    return $status;
}

my_system('ls -l');

10.21 sleepの信頼性のある実装

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();

# sleepの信頼性のある実装

sub sig_alrm {
    # nothing to do, just returning wakes up sigsuspend()
}

sub sleep {
    my $nsecs = shift;

    my $newact = POSIX::SigAction->new;
    my $oldact = POSIX::SigAction->new;

    my $newmask  = POSIX::SigSet->new;
    my $oldmask  = POSIX::SigSet->new;
    my $suspmask = POSIX::SigSet->new;

    my $unslept = 0;

    # set out handler, save previous information
    $SIG{ALRM} = \&sig_alrm;
    POSIX::sigaction(POSIX::SIGALRM, undef, $oldact);

    $newmask->addset(POSIX::SIGALRM);

    POSIX::sigprocmask(POSIX::SIG_BLOCK, $newmask, $oldmask);

    alarm $nsecs;

    $suspmask = $oldmask;
    $suspmask->delset(POSIX::SIGALRM);
    POSIX::sigsuspend($suspmask);

    # some signalshas been caught, SIGALRM is now blocked

    $unslept = alarm 0;

    POSIX::sigaction(POSIX::SIGALRM, $oldact);
}

my $time = shift || 5;
print "sleep $time second\n";
main::sleep($time);

10.22 SIGTSTPの処理方法

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();

# SIGTSTPの処理方法

sub sig_tstp {
    # move cursor to lower left corner, reset tty mode ...

    # unblock SIGTSTP, since it's blocked while we're handling it
    my $sigset = POSIX::SigSet->new;

    $sigset->addset(POSIX::SIGTSTP);

    my $ret = POSIX::sigprocmask(POSIX::SIG_UNBLOCK, $sigset, undef);
    die "Error: sigprocmask $!\n" unless defined $ret;

    # reset disposition to default
    $SIG{TSTP} = 'DEFAULT';

    # and set the signal to ourself
    kill POSIX::SIGTSTP, POSIX::getpid;

    # we won't return from the kill untill we're continued

    # reestablish signal handler
    $SIG{TSTP} = \&sig_tstp;

    # reset tty mode, redraw screen, ...
}

# only catch SIGTSTP if we' re running with a job-control shell
$SIG{TSTP} = \&sig_tstp;

print "My pid = $$\n";

while (1) {
    my $ret = sysread STDIN, my $buf, 1024;
    die "Error: read $!\n" unless defined $ret;

    if ($! == POSIX::EINTR) {
        warn "EINTR\n";
        next;
    }

    last if length $buf == 0;
    syswrite STDOUT, $buf;
}

リポジトリ

p5-APUE/section10 at master · syohex/p5-APUE · GitHub

まとめ

詳解 UNIXプログラミングの第10章を示しました。
Perlの sigactionはオブジェクト指向で, POSIXモジュールの中では少し変わった感じですかね。