第38回　Perlで作るシステム運用ツール（3）

（1）はこちら、（⁠2）はこちらから。

Perlとプロセスとの連携

さて、Perlでシェルやコマンドと連携するための準備は整いました。続いては、複数ホストに対して並行で処理を行うために、プロセスとの連携を見てみましょう。

複数ホストに対して並行でデプロイ作業を行う

Perlにはithreadsというスレッドの機能もあるのですが、あまり使われていません。Perlで並行処理を行う場合、forkで子プロセスを生成し、複数プロセスを利用して並行処理を行うことが多いです。今回も、Perlで子プロセスを扱う例を見てみましょう。

forkで子プロセスを作る

何はともあれ、子プロセスを作成する必要があります。Perlで子プロセスを作成するためには、ほかの言語と同じようにforkを利用します。リスト12のようなプログラムを実行すると、

forking...
forked!
forked!
親プロセス
子プロセスのpid:41794
子プロセス

と表示されます。このとき何が起こっているのかを見てみましょう。

リスト12　forkによる子プロセスの生成

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（1）で"forking..."が表示されるまでは普通のPerlプログラムなのでよいでしょう。forkを呼び出すと、このプログラムが実行されているプロセスがそっくりそのまま複製されて、子プロセスでも同じプログラムがこから実行されます。ですので、次の行であるリスト12（2）からは複数プロセスで実行され、"forked!"は2回表示されているわけです。

しかし、親プロセスで実行されているプログラムと子プロセスで実行されているプログラムには唯一の違いがあります。それがforkの戻り値です。親プロセスでは、forkの戻り値は生成された子プロセスのpidになりますが、子プロセスでは0が返ります。そのため、子プロセスではリスト12（3）を、親プロセスではリスト12（4）を実行することになります。

子プロセスの終了コードを取得する

子プロセスの終了コードは、IPC::Open3のときと同様に、waitpidののちに$?特殊変数で取得できます。

並行で複数ホストに対してファイルをコピーする

さて、それではアーカイブした静的ファイルを、forkを利用して複数ホストに並行してscpでばらまいてみましょう。アーカイブする部分はリスト8ですでに見たので、その続きをリスト13に示します。

リスト13　複数ホストにファイルをコピーする

（リスト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、host2、host3の3つのホストに対してstatic.tgzをばらまいています。手順としては、ホストの数だけ子プロセスを生成し、それぞれの子プロセスでそれぞれのホストに対して作業を行います。

それぞれの子プロセスでは、

（1） static.tgzをscpでリモートにコピーする
（2） デプロイ先ディレクトリに対して、タイムスタンプの名前で新しいディレクトリを作成する
（3） そのディレクトリに対してstatic.tgzを展開する
（4） static.tgzを削除する

という作業を、system関数を利用して行っています（上記の丸数字はリスト13中のものに対応しています⁠）⁠。各コマンドに対してsystemの戻り値を見て、作業が失敗していたら失敗の終了コードでそのままexitしています。

親プロセスでは、@scp_pidsに子プロセスのpidを貯めておいて、waitpidでそれらのプロセスの終了を待ち、終了コードをチェックしています。今回はひとまず「どこかのプロセスが失敗していたらそのままデプロイを中断する」という挙動にしています。

すべてのホストに対するコピーが成功したらシンボリックリンクを張る

これですべてのホストに対してファイルのコピーを無事終えました。それでは、ここですべてのホストに対して今度はシンボリックリンクを張りましょう。やることはリスト13とそんなに変わらず、今回ばらまいたディレクトリへのシンボリックリンクを張るコマンドを子プロセスで並行して実行するだけです（リスト14⁠）⁠。

リスト14　各ホストでシンボリックリンクを張る

（リスト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などで、今回ばらまいたstaticディレクトリを静的に配信するように設定しておけば、複数のホストに対して静的ファイルをばらまき、ユーザーのアクセスを一斉に最新のファイルへ切り替えることができます[1]⁠。

エラーが起こったらロールバックする

これでうまくデプロイができたと思いたいところですが、そうは問屋がおろしません。というのも、もしも今回シンボリックリンクを張る作業で「どこかのホストだけ失敗してしまった」という場合はどうなるでしょうか？その場合、一部失敗したホストだけは古いファイルを配信し続けることになります。これはまずいですね。「⁠どこかのサーバで実行に失敗したら、ロールバックを行い以前の状態に戻す」というしくみが必要そうです。

戦略としては、

現在のタイムスタンプのディレクトリが存在すればそれを消す
そのあとデプロイディレクトリに残っている最新のディレクトリに対してシンボリックリンクを張りなおす

にしましょう。コードにするとリスト15のようになります。ロールバックの失敗はかなり致命的なエラーですので、わかりやすいように目立つ文字列を挿入しています。今まで「どこかのホストが失敗したらデプロイを中止する」という戦略を採っていた部分を、すべてrollback_all($timestamp, $hosts);するようにしてやれば、失敗したときのロールバックも行えます。

リスト15　エラーが起こったらロールバックする

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が運用に適した言語であることを見てきました。今回のスクリプトは簡単のため手続きをベタ書きしたので、抽象化して改善できるところもたくさん残っています。また、今回は「古いディレクトリを削除する」という手続きを書いていないため、このままこのスクリプトを運用していくとサーバのディスク容量を圧迫してしまいます。そのあたりの改善は、ぜひみなさんの手で行ってみてください。

ほかの言語でもこのようなスクリプトを書くことは難しくないでしょうが、最初に述べたとおり、Perlは高い後方互換性と枯れた言語であるがゆえの安定性を持っています。みなさんも、日々の運用をサポートするようなツールを、安定していてUNIX系システムとの相性が抜群のPerlで書いてみてはいかがでしょうか。

さて、次回の執筆者は鍛治匠一さんで、テーマはPerl6です。お楽しみに。

本誌最新号をチェック！
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