Perl スクリプト - 自動バックアップ - Craftworks Tech Blog

最近 Nas を導入したので、Linux から重要なファイルを自動でバックアップするスクリプトをサクっと Perl で書いてみました。単にシェルスクリプトでエラー処理書くのが面倒臭かっただけですが。
コアモジュールしか使ってません、Perl 5.005 とか古いバージョンでも動きます。本当は IPC::Cmd を使いたかったのですが、コアモジュール入りは 5.009 からなので、IPC::Open3 を使いました。

tar で丸ごと固めて転送してるだけなので、バックアップ対象の容量が大きい用途には向きません。主に設定ファイル用です。画像や動画など大きいファイルのバックアップには rsync の差分転送使った方が良いです。

動作

バックアップ対象が書かれたファイルを読み込む
対象ファイルの存在チェック
指定されたファイルを tar で固める
固めた tar を指定リモートホストの指定ディレクトリに rsync
転送後、ローカルの tar を削除

使い方

backup.lst にバックアップしたいファイルやディレクトリを改行区切りで書く。行頭を # にするとコメントとして無視されます。
例えばこのような感じです。

/etc/lighttpd/lighttpd.conf
/root/.bashrc
/root/.screenrc
/root/backup.lst
/root/backup.pl
/root/setup/

後は下記ソースコードの転送先ホスト、転送先ディレクトリなどを編集して、backup.pl など適当な名前で保存して、cron から実行してください。
環境変数 DEBUG に 1 を入れておくと、コマンドの出力などが見れます。

#!/usr/bin/perl

use strict;
use warnings;
use IO::File;
use IPC::Open3;
use Net::Ping;

my $debug = $ENV{'DEBUG'};
my $uid = getpwuid $<;

my $host = '192.168.0.100';
my $list = "$ENV{'HOME'}/backup.lst";
my $file = "/tmp/backup-$uid.tar.bz2";
my $dst  = "root\@$host:/mnt/sataraid1/share/machine/devel/";

if ( Net::Ping->new('icmp')->ping($host, 5) ) {

    my @target;
    my $fh = IO::File->new($list, 'r') or die "open: $! $list\n";
    while (<$fh>) {
        next if /^#/o;
        chomp;
        -e or die "$! $_ at $list line $.\n";
        -r or die "$! $_ at $list line $.\n";
        push @target, $_;
    }

    # tar
    {
        IPC::Open3::open3( undef, my $out, undef,
            'tar', 'cvfj', $file, @target );
        $debug ? warn <$out> : ( () = <$out> );
    }

    # rsync
    {
        IPC::Open3::open3( undef, my $out, undef,
            'rsync', '-avz', '-e', 'ssh', $file, $dst );
        $debug ? warn <$out> : ( () = <$out> );
    }

    unlink $file;
}
else {
    die "cannot connect to host $host\n" if $debug;
}

open3() の出力を最後まで読まないとコマンドがきちんと実行されないので、デバッグプリントしない場合は全部読み出して捨てるようにしています。