デプロイツールの再発明 - file-glob こと k.daibaの日記

はじめに

世の中にはEURO 2016 NewsとかArcher - yet another deployment tool - metacpan.orgなんていうデプロイツールがあって，普段はこれらを使っています．でも，新規サーバにインストールしないといけないことがたびたび起きて，それが面倒だなと思っていました．ファイルを一個だけ入れれば，ライブラリを追加しなくてもさくっと使えるデプロイツールがないものか，探すのに飽きたので作ってみました．

使い方

使い方は

$ ./pawn.pl -h
Usage: pawn.pl [options] File

Optons:
  -h,--help       this message
  -s,--shell      simple shell

で，引数として渡すファイルにDSLでターゲットホストと実行するコマンドを記述します．

hosts 'idc1-web-0001 idc1-web-0002';
commands sub {
    (
        [ 'hostname' => sub { print shift } ],
        [ 'date'     => sub { print shift } ]
    );
};

この場合，idc1-web-0001, idc1-web-0002というホストに対して，hostnameとdateコマンドを実行します．コマンド実行結果は画面に表示することになります．

$ ./pawn.pl sample
idc1-web-0001.foo.co.jp
2010年  7月 22日 木曜日 18:59:00 JST
idc1-web-0002.foo.co.jp
2010年  7月 22日 木曜日 18:59:02 JST

このファイルにsampleという名前を付けて，実行すると

$ ./pawn.pl -s sample
Pawn> uptime
idc1-web-0001>  18:44:19 up 100 days,  3:56,  0 users,  load average: 1.63, 1.55, 1.48
idc1-web-0002>  18:44:21 up 100 days,  3:13,  0 users,  load average: 1.20, 1.27, 1.35
Pawn> ^C

という出力がでます．できることは単純だけど，簡単な調査をするには便利なツールにしようと思っています．

スクリプト

現状はこんなスクリプトです．parallel forkする機能はまだ作っていません．もう少し作り込んだら~~githubに上げるかもしれないです~~GitHub - daiba/Pawn: Yet another deploy toolにあげました．

#!/usr/bin/env perl
package App::Pawn::script;
use Getopt::Long;
use Term::ReadLine;
use strict;

sub new {
    my $class = shift;
    bless {
        argv => [],
        @_,
    }, $class;
}

sub parse_options {
    my $self = shift;
    local @ARGV = @{ $self->{argv} };
    push @ARGV, @_;

    Getopt::Long::Configure("bundling");
    Getopt::Long::GetOptions(
        's|shell'  => \$self->{shell},
        'h|help'   => sub { $self->help; exit },
    );
    $self->{argv} = \@ARGV;
}

sub help {
    my $self = shift;
    print <<HELP;
Usage: pawn.pl [options] File

Optons:
  -h,--help       this message
  -s,--shell      simple shell
HELP
}

sub load_file {
    my $self = shift;
    my $file   = shift @{$self->{argv}};
    my @attr   = qw( hosts commands );
    my $config = { file => $file };

    my $dsl = join "\n",
      map "sub $_ {my \$e=shift || return \$config->{$_}; \$config->{$_}=\$e }",
      @attr;
    $dsl .= <<DSL;

sub include {
    my \$b = shift || return;
    my \$f = dirname(\$self->{file}) . '/' . \$b;
    unless ( do \$f ) { die "can't include \$f\\n" }
}
DSL

    my $code = do { open my $io, "<", $file; local $/; <$io> };
    eval "package App::Pawn::Rule;\n"
      . "use File::Basename;\nuse strict;\nuse utf8;\n$dsl\n$code";
    die $@ if ($@);
}

sub loop {
    my $self = shift;
    if ( $self->{shell} ) {
        $self->shell;
    }
    else {
        $self->exec;
    }
}

sub shell {
    my $self  = shift;
    my @hosts = split /\s+/, App::Pawn::Rule::hosts();
    my $term  = Term::ReadLine->new('Pawn');
    my $out   = $term->OUT || \*STDOUT;
    while ( defined( my $line = $term->readline('Pawn> ') ) ) {
        next if $line =~ /^\s*$/;
        for my $host (@hosts) {
            next unless ($host);
            my $fd;
            open $fd, '-|', "ssh $host $line 2> /dev/null";
            my $output;
            {
                local $/ = undef;
                $output = <$fd>;
            }
            close $fd;
            printf $out "%s> %s", $host, $output;
        }
    }
}

sub exec {
    my $self = shift;
    my @hosts = split /\s+/, App::Pawn::Rule::hosts();
    my %ret;
    for my $host (@hosts) {
        next unless ($host);
        my $fd;
        my @doChecks = App::Pawn::Rule::commands()->();
        for my $doCheck (@doChecks) {
            my $do    = $$doCheck[0];
            my $check = $$doCheck[1];
            open $fd, '-|', "ssh $host $do 2> /dev/null";
            my $output;
            {
                local $/ = undef;
                $output = <$fd>;
            }
            $check->($output);
            close $fd;
        }
    }
}

sub doit {
    my $self = shift;
    $self->load_file;
    $self->loop;
}

package main;

unless (caller) {
    my $app = App::Pawn::script->new;
    $app->parse_options(@ARGV);
    $app->doit;
}

sshトンネリングしてる環境で，ssh先のホストが起動してないときにだんまりになる現象が起きてるので，異常系を作り込まないといけなさそうです．

おわりに

宮川さんのcpanm（のちょっと前のバージョン）を見ながら，こんな風に書けるんだと，思いながら作っています．すごいもんですね．