Perlとプロセスとの連携
さて、
複数ホストに対して並行でデプロイ作業を行う
Perlにはithreadsというスレッドの機能もあるのですが、
forkで子プロセスを作る
何はともあれ、
forking...
forked!
forked!
親プロセス
子プロセスのpid:41794
子プロセス
と表示されます。このとき何が起こっているのかを見てみましょう。
use strict;
use warnings;
print "forking...\n"; ━(1)
my $pid = fork;
print "forked!\n"; ━(2)
if (! defined $pid) {
die "fork failed";
}
if ($pid == 0) { ┓
sleep 2; ┃
print "子プロセス\n"; ┣(3)
} ┛
else { ┓
sleep 1; ┃
print "親プロセス\n子プロセスのpid:$pid\n"; ┣(4)
waitpid($pid, 0); ┃
} ┛
リスト12"forking..."
が表示されるまでは普通のPerlプログラムなのでよいでしょう。fork
を呼び出すと、"forked!"
は2回表示されているわけです。
しかし、fork
の戻り値です。親プロセスでは、fork
の戻り値は生成された子プロセスのpidになりますが、
子プロセスの終了コードを取得する
子プロセスの終了コードは、waitpid
ののちに$?
特殊変数で取得できます。
並行で複数ホストに対してファイルをコピーする
さて、fork
を利用して複数ホストに並行してscp
でばらまいてみましょう。アーカイブする部分はリスト8ですでに見たので、
(リスト8の続き)
my $hosts = ["host1", "host2", "host3"];
my $deploy_dir = "~/deploy";
my $timestamp = time;
my $scp_pids = [];
for my $host (@$hosts) {
my $pid = fork;
if ($pid == 0) {
my $ret = system('scp', 'static.tgz', "$host:$deploy_dir"); ┓
exit $ret if $ret != 0; ┛(1)
$ret = system( ┓
'ssh', $host, 'mkdir', ┃
'-p', "$deploy_dir/$timestamp" ┣(2)
); ┃
exit $ret if $ret != 0; ┛
$ret = system( ┓
'ssh', $host, 'tar', 'zxvf', ┃
"$deploy_dir/static.tgz", '-C', "$deploy_dir/$timestamp" ┣(3)
); ┃
exit $ret if $ret != 0; ┛
exit system( ┓
'ssh', $host, 'rm', '-f', ┃
"$deploy_dir/static.tgz" ┣(4)
); ┛
}
else {
push(@$scp_pids, $pid);
}
}
for my $pid (@$scp_pids) {
waitpid($pid, 0);
die "scp failed" if $? != 0;
}
今回はhost1、
それぞれの子プロセスでは、
(1) static.tgzをscpでリモートにコピーする (2) デプロイ先ディレクトリに対して、タイムスタンプの名前で新しいディレクトリを作成する (3) そのディレクトリに対してstatic.tgzを展開する (4) static.tgzを削除する
という作業を、system
関数を利用して行っていますsystem
の戻り値を見て、exit
しています。
親プロセスでは、@scp_
に子プロセスのpidを貯めておいて、waitpid
でそれらのプロセスの終了を待ち、
すべてのホストに対するコピーが成功したらシンボリックリンクを張る
これですべてのホストに対してファイルのコピーを無事終えました。それでは、
(リスト13の続き)
my $symlink_pids = [];
for my $host (@$hosts) {
my $pid = fork;
if ($pid == 0) {
exit system(
'ssh', $host, 'ln', '-sf',
"$deploy_dir/$timestamp", "$deploy_dir/current"
);
}
else {
push(@$symlink_pids, $pid);
}
}
for my $pid (@$symlink_pids) {
waitpid($pid, 0);
die "symlink failed" if $? != 0;
}
あとはnginxなどで、
エラーが起こったらロールバックする
これでうまくデプロイができたと思いたいところですが、
戦略としては、
- 現在のタイムスタンプのディレクトリが存在すればそれを消す
- そのあとデプロイディレクトリに残っている最新のディレクトリに対してシンボリックリンクを張りなおす
にしましょう。コードにするとリスト15のようになります。ロールバックの失敗はかなり致命的なエラーですので、rollback_
するようにしてやれば、
use strict;
use warnings;
use File::Basename qw/dirname/;
use IPC::Open3;
(リスト14までと同じ)
sub rollback_all{
my ($timestamp, $hosts) = @_;
my $rollback_pids = [];
for my $host (@$hosts) {
my $pid = fork;
if ($pid == 0) {
rollback($timestamp, $host);
}
else {
push(@$rollback_pids, $pid);
}
}
for my $pid (@$rollback_pids) {
waitpid($pid, 0);
die "@@@@!! rollback failed !!@@@@" if $? != 0;
}
}
sub rollback {
my ($timestamp, $host) = @_;
my $ret = system(
'ssh', $host, 'rm', '-rf',
"$deploy_dir/current"
);
exit $ret if $ret != 0;
$ret = system(
'ssh', $host, 'rm', '-rf',
"$deploy_dir/$timestamp"
);
exit $ret if $ret != 0;
my $pid = open3(
my $wtr, my $rdr, undef,
'ssh', $host, 'ls', "$deploy_dir"
);
close $wtr;
waitpid($pid, 0);
exit $? if $? != 0;
my @files = <$rdr>;
close $rdr;
@files = sort {$b <=> $a} @files;
my $latest_file = shift @files;
chomp $latest_file;
exit system(
'ssh', $host, 'ln', '-nsf',
"$deploy_dir/$latest_file", "$deploy_dir/current"
);
}
まとめ
今回は簡単なデプロイスクリプトを通じてPerlが運用に適した言語であることを見てきました。今回のスクリプトは簡単のため手続きをベタ書きしたので、
ほかの言語でもこのようなスクリプトを書くことは難しくないでしょうが、
さて、
本誌最新号をチェック!
WEB+DB PRESS Vol.130
2022年8月24日発売
B5判/168ページ
定価1,628円
(本体1,480円+税10%)
ISBN978-4-297-13000-8
- 特集1
イミュータブルデータモデルで始める
実践データモデリング
業務の複雑さをシンプルに表現! - 特集2
いまはじめるFlutter
iOS/Android両対応アプリを開発してみよう - 特集3
作って学ぶWeb3
ブロックチェーン、スマートコントラクト、NFT