Perlで学ぶ「詳解 UNIXプログラミング」(その8) 第8章 プロセス制御

はじめに

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

本家

http://d.hatena.ne.jp/atsuoishimoto/20110324/1300933805

8.1 fork関数の例

forkでは親プロセスと子プロセスのメモリ空間が異なるため
グローバル変数も共有しません。これはマルチスレッドと異なる点です。

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

# fork関数の例

my $glob = 6;
my $buf  = "a write to stdout\n";

sub main {
    my $var = 88;
    print STDOUT $buf;

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

    if ($pid == 0) { #child
        $glob += 1;
        $var  += 1;
    } else { # parent
        sleep 2;
    }

    printf "pid=%d, glob=%d, var=%d\n", $pid, $glob, $var;
}

main();

8.2 vfork関数の例

いまどきの forkは Copy on Writeなので vforkを使う需要はありません。
Copy on Writeの実現はページを全部読み出し専用にしておいて、
書き込みが発生したときにトラップを起こすようにして、書き込みを検知するようにしています。

8.3 プロセスの終了状態を出力する

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

use POSIX;

# プロセスの終了状態を出力する

sub pr_exit {
    my $status = shift;

    if (POSIX::WIFEXITED($status)) {
        printf "normal termination, exit status = %d\n"
        , POSIX::WEXITSTATUS($status);
    } elsif (POSIX::WIFSIGNALED($status)) {
        printf "abnormal termination, signal number = %d\n"
        , POSIX::WTERMSIG($status);
    } elsif (POSIX::WIFSTOPPED($status)) {
        printf "child stopped, signal number = %d\n"
        , POSIX::WSTOPSIG($status)
    }
}

8.4 様々な終了状態を出力する

Python同様、0除算をしても SIGFPEが発生しません。

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

use POSIX;

do "8_3.pl"; # import pr_exit

# 様々な終了状態を出力する

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

if ($pid == 0) { # child
    exit 7;
}

my $childpid = wait;
my $status   = $?;

pr_exit($status);

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

if ($pid == 0) {
    POSIX::abort;
}

$childpid = wait;
$status   = $?;
pr_exit($status);

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

if ($pid == 0) {
    my $dummy = 1 / 0;
}

$childpid = wait;
$status   = $?;

pr_exit($status);

8.5 forkを２度呼んでゾンビプロセスを避ける

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

use POSIX;

# forkを２度呼んでゾンビプロセスを避ける

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

if ($pid == 0) {
    my $pid2 = fork; # 一つ目の子プロセス
    die "Error: fork $!\n" unless defined $pid2;

    if ($pid2 > 0) { # 2回目のfork()の親プロセス (=一つ目の子プロセス)
        print "exit 0";
        exit 0;
    }

    # 二つ目の子プロセス
    # このプロセスの本来の親プロセスは起動後すぐに sys.exit() を呼び出すので、
    # 親プロセスが init に変更される。
    # このプロセスが終了すると、終了状態は init で解放される

    sleep 2;
    printf "second child, parent pid = %d\n", POSIX::getppid;
    exit 0;
}

waitpid $pid, 0;

8.6 レースコンディションを有するプログラム

Pythonでは sleepを入れる必要があったそうですが、Perlでは
というか私の環境では sleepなしでも出力が混在しました。

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

use IO::Handle;
use Time::HiRes;

# レースコンディションを有するプログラム

sub charatatime {
    my $str = shift;

    for my $c (split //, $str) {
        print STDOUT $c;
        STDOUT->autoflush;
        sleep 0.1;
    }
}

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

if ($pid == 0) {
    charatatime("output from child\n");
} else {
    charatatime("output from parent\n");
}

8.7 プログラム8.6をレースコンディションを避けるように変更

あんまり自信がない。キューとRPCみたいなものを使った方が良さそう。

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

use POSIX;
use Fcntl;
use IO::Handle;

# プログラム8.6をレースコンディションを避けるように変更

sub charatatime {
    my $str = shift;

    for my $c (split //, $str) {
        print STDOUT $c;
        STDOUT->autoflush;
        sleep 0.1;
    }
}

my $sigflag = 0;
sub TELL_WAIT {
    $SIG{USR1} = sub { $sigflag = 1; };
}

sub WAIT_PARENT {
    # wait for parent to terminate
    while ($sigflag == 0) {
        POSIX::pause();
    }
}

sub TELL_CHILD {
    my $pid = shift;
    kill POSIX::SIGUSR1, $pid;
}

TELL_WAIT();

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

if ($pid == 0) {
    WAIT_PARENT();
    charatatime("output from child\n");
} else {
    charatatime("output from parent\n");
    TELL_CHILD($pid);
}

8.8 exec関数の例

カレントディレクトリに echoallを設置してください

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

# exec関数の例

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

if ($pid == 0) {
    exec { "./echoall" } "echoall", "myarg1", "MY ARG2", "USER" => "unknown";
    exit 0;
}

waitpid $pid, 0;

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

if ($pid2 == 0) {
    exec { "./echoall" } "echoall", "only one arg";
    exit 0;
}

waitpid $pid2, 0;

8.9 全てのコマンド行引数と全ての環境変数を出力する

Perlでは環境変数は %ENVに格納されます。

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

# 全てのコマンド行引数と全ての環境変数を出力する

# echo all args
my $length = scalar @ARGV;
for my $i ( 0..($length-1) ) {
    printf "ARG[%d] = %s\n", $i, $ARGV[$i];
}

# echo all env strings
while (my ($key, $val) = each %ENV) {
    print "$key:$val\n";
}

8.10 解釈実行ファイルをexecするプログラム

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

# 解釈実行ファイルをexecするプログラム

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

if ($pid == 0) {
    exec { "./testinterp" } "testinterp", "arg1", "MY ARG2";
}

waitpid($pid, 0);

8.11 解釈実行ファイルに入れたPerlプログラム

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

# 解釈実行ファイルに入れたPerlプログラム

my $length = scalar @ARGV;
for my $i ( 0..($length-1) ) {
    printf "ARG[%d] = %s\n", $i, $ARGV[$i];
}

8.12 (シグナルを処理しない)システム関数

Python版では EINTRの部分は '=='ですが、本では '!='なので本に合わせました。

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

use POSIX;

# (シグナルを処理しない)システム関数

my $cmd = shift or die "Usage: $0 command\n";

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

my $status;
if ($pid == 0) {
    exec { '/bin/sh' } "sh", "-c", $cmd;
    exit 127;
} else {
    while (1) {
        my $pid = waitpid $pid, 0;
        $status = $?;
        last if defined $pid;

        if ($! != POSIX::EINTR) { # error other than EINTR from waitpid()
            $status = -1;
        }
    }
}

print "status = $status\n";
exit $status;

8.13 system関数を呼ぶ

system関数はリストで引数を渡すべきでしょう。

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

do '8_3.pl';

# system関数を呼ぶ

my $status;
$status = system ('date');
pr_exit($status);

$status = system ('nosuchcommand');
pr_exit($status);

$status = system('who; exit 44');
pr_exit($status);

8.14 systemを用いてコマンド行引数を実行する

systemにユーザの入力を与えるのは大変危険です。

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

do '8_3.pl';

# systemを用いてコマンド行引数を実行する

my $status = system ($ARGV[0]);
pr_exit($status);

8.15 実ユーザIDおよび実効ユーザIDを出力する

Perlだと特殊変数で取得できますが、POSIXモジュールの方が
わかりやすいと思います。

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

use POSIX;

# 実ユーザIDおよび実効ユーザIDを出力する
printf "real uid = %d, effective uid = %d\n", POSIX::getuid(), POSIX::geteuid();
printf "real uid = %d, effective uid = %d\n", $<, $>;

8.16 実効記録データを生成するためのプログラム

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

use autodie;
use POSIX;

# 実効記録データを生成するためのプログラム

my $pid = fork;
if ($pid != 0) {
    sleep 2;
    exit 2;
}

$pid = fork;
if ($pid != 0) {
    sleep 4;
    POSIX::abort();
}

$pid = fork;
if ($pid != 0) {
    exec { "/bin/dd" } "dd", "if=/etc/shells", "of=/dev/null";
    exit 7;
}

$pid = fork;
if ($pid != 0) {
    sleep 8;
    exit 0;
}

sleep 8;
kill POSIX::SIGKILL, $$;
exit 6;

8.17 システムの実効記録ファイルの特定フィールドを出力する

CPANで使えそうなものが見当たらなかったので、Inline::Cで、そのまま Cで書きました。
Python版はなんかカッコイイですよね。Cバインディングがわりと簡単そうな印象を受けた.

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

use Inline 'C';

# システムの実効記録ファイルの特定フィールドを出力する
#sudo aptitude install acctで /var/log/account/pacctに書きだされる
my $file = shift or die "Usage: $0 filename\n";
get_acct($file);

__END__
__C__
#include <stdio.h>
#include <sys/acct.h>

#ifdef HAS_SA_STAT
#define FMT "%-*.*s  e = %6ld, chars = %7ld, stat = %3u: %c %c %c %c\n"
#else
#define FMT "%-*.*s  e = %6ld, chars = %7ld, %c %c %c %c\n"
#endif
#ifndef HAS_ACORE
#define ACORE 0
#endif
#ifndef HAS_AXSIG
#define AXSIG 0
#endif

static unsigned long
compt2ulong(comp_t comptime)
{
    unsigned long    val;
    int    exp;

    val = comptime & 0x1fff;
    exp = (comptime >> 13) & 7;
    while (exp-- > 0)
        val *= 8;
    return(val);
}

void get_acct(char *file_name)
{
    struct acct_v3 acdata;
    FILE   *fp;

    fp = fopen(file_name, "r");
    if (fp == NULL) {
        return;
    }

    while (fread(&acdata, sizeof(struct acct_v3), 1, fp) == 1) {
        printf(FMT, (int)sizeof(acdata.ac_comm),
               (int)sizeof(acdata.ac_comm), acdata.ac_comm,
               compt2ulong(acdata.ac_etime), compt2ulong(acdata.ac_io),
#ifdef HAS_SA_STAT
               (unsigned char) acdata.ac_stat,
#endif
               acdata.ac_flag & ACORE ? 'D' : ' ',
               acdata.ac_flag & AXSIG ? 'X' : ' ',
               acdata.ac_flag & AFORK ? 'F' : ' ',
               acdata.ac_flag & ASU
               ? 'S' : ' ');
    }
}

8.18

Benchmarkモジュールのメソッド戻り値が各種時間の入った
配列リファレンスとは知りませんでした。

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

use Benchmark qw(timeit);

# 全てのコマンド行引数を実行し時間を計る

for my $arg (@ARGV) {
    my $t = timeit(
        1,
        sub {
            my @commands = ($arg);
            system @commands;
        },
    );

    # Please see perldoc Benchmark, NOTES setction.
    my ($real, $user, $system, $children_user, $children_system, undef) = @{$t};

    printf STDERR "  real:%g\n", $real;
    printf STDERR "  user:%g\n", $user;
    printf STDERR "   sys:%g\n", $system;
    printf STDERR "  child user:%g\n", $children_user;
    printf STDERR "  child  sys:%g\n", $children_system;
}

リポジトリ

以下でソースコードがあります。

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

まとめ

「詳解 UNIXプログラミング」の第八章を示しました。