work.log

エンジニアの備忘録的ブログ

Perlでマルチプロセスなデーモン

投稿:2013-07-08 20:26  更新:

Perl でマルチプロセスなデーモンを動かすメモです。

ブログネタが切れたのでサーバ内を漁ってたらたまたま発見。

だいぶ前に処理を並行稼動させるために作ったみたいですが、自分でもすっかり忘れていたのでメモしておきます。

#!/usr/bin/perl

use strict;
use warnings;
use POSIX ();

    my @basename  =  split(/\//, $0);
    my $basename  =  pop(@basename);
    $basename     =~ s/.[a-z, 0-9]+$//;
    $0            =  $basename;

    # 多重起動のチェック用
    # pgrep の -u オプションには起動するユーザ名を指定
    my $cmd       =  {
                       grep  => '/usr/bin/grep',
                       pgrep => '/bin/pgrep -fo -u hoge',
                       kill  => '/bin/kill',
                     };

    my $chroot    =  "/home/hoge";
    my $log       =  "/home/hoge/daemon.log";
    my $pstatus   =  '0';

    my $opt       = $ARGV[0];

    # 子プロセスの最大数
    my $child_max = 3;

    my $child_num = 0;

## start

    &Check_Run( $opt );

sub Check_Run {

    my $run;
    my $pid=$$;

    $run = `$cmd->{pgrep} $basename | $cmd->{grep} -v $pid`;
    chomp( $run );

    # 親プロセスの起動
    if ( $run eq "" ) {

        &Daemon();

    # 親プロセスが既に起動している場合
    } else {

        # stop が指定された場合は親プロセスを kill
        if ( $opt =~ /^stop$/ ) {

            `$cmd->{kill} $run`;
            print " $basename\[$run\] is stop.\n";

        # オプションが指定されていなければ親プロセスの pid を返す
        } else {

            print " $basename\[$run\] is already running.\n";

        }

    }

}

sub Daemon {

    chdir "$chroot" or die "Can't chdir: $!";
    umask 0;

    open STDIN,  '/dev/null'  or die "Can't read /dev/null: $!";
    open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
    open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!";

    # 親プロセスの起動
    my $pid = fork();

    if ( ! defined $pid ) { die "Failed to fork(): $!"; }

    if ( $pid ) {

        exit 0;

    } else {

        POSIX::setsid() || die "Could not detach from parent process";

    }

    &Run( $pid );

}

sub Run {

    my ($pid, $wait_pid);

    while ( 1 ) {

        # 子プロセスを起動
        my $pid = fork;
        die "Cannot fork: $!" unless defined $pid;

        if ( $pid ne 0 ) {

            $child_num++;

        # 子プロセスの処理
        # $log に書き込んで一定時間後に停止
        } elsif ( defined $pid ) {

            my $str = rand;

            open( LOG, ">> $log" );
            print LOG "$str\n";
            close( LOG );

            sleep(1 + int rand 10);

            exit 0;

        } else {

            exit 1;

        }

        # 子プロセスの管理
        # 起動子プロセスが $child_max まで達したら子プロセスの生成を停止
        if ($child_num == $child_max) {

            $wait_pid = wait;
            $child_num--;

        }    

    }

}

exit;

コメントは失念している箇所もありますが概ねこんな感じです。

起動はこんな感じ。

# su - hoge
# perl my-daemon.pl

続けて起動すると。

# perl my-daemon.pl
 my-daemon[38684] is already running.

停止する時。

# perl my-daemon.pl stop
 my-daemon[38684] is stop.

とりあえず、親プロセスが停止して残った子プロセスは処理が完了後に停止。

スポンサーリンク

コメント

コメントを残す

よく読まれている記事

  • 今日
  • 週間
  • 月間