ルータにシリアルポート経由アクセスするperlスクリプト

perlを使ってルータの設定をするのはよくやっていたが、全部telnetで、シリアルポートを使ったことがないのに気付いた。

Win32::SerialPort

を使う。

ppm install Win32::SerialPort

をやって、以下、サンプル。

use strict;
use Win32::SerialPort;

my $ob = new Win32::SerialPort('COM1') || die;

$ob->user_msg(1);
$ob->error_msg(1);

$ob->baudrate(9600);
$ob->parity("none");
$ob->parity_enable(1);
$ob->databits(8);
$ob->stopbits(1);
$ob->handshake('rts');

$ob->write_settings;

$ob->write("\n");
sleep 1;
my $result = $ob->input;
print $result;


$ob->write("en\n");
sleep 1;
my $result = $ob->input;
print $result;

$ob->write("enable\n");
sleep 1;
my $result = $ob->input;
print $result;


$ob->write("conf t\n");
sleep 1;
my $result = $ob->input;

print $result;

$ob->write("hostname donguri\n");
sleep 1;
$result = $ob->input;
print $result;

$ob->write("end\n");
sleep 1;
$result = $ob->input;
print $result;

$ob->write("reset\n");
sleep 1;
$result = $ob->input;
print $result;

$ob->write("y\n");

undef $ob;

sleepして結果を表示しているところはダサいですね。 ここはteratermの waitのようにしたいところですが、そのやり方は後で調べる。 とりあえずserialポートで入出力ができるというサンプルです。

プロンプト待ちバージョン。

use strict;
use Win32::SerialPort;
use Time::HiRes;

my $ob = new Win32::SerialPort('COM1') || die;

$ob->user_msg(1);
$ob->error_msg(1);

$ob->baudrate(9600);
$ob->parity("none");
$ob->parity_enable(1);
$ob->databits(8);
$ob->stopbits(1);
$ob->handshake('rts');

$ob->write_settings;

$ob->are_match('>','#','word:');
$ob->lookclear;

&waitfor("\n",">");
&waitfor("en\n","word:");
&waitfor("enable\n","#");
&waitfor("conf t\n","#");
&waitfor("hostname otanko\n","#");
&waitfor("end\n","#");
&waitfor("reset\n",'(y/n)');

$ob->write("y\n");

undef $ob;

sub waitfor{
    my($output_string,$prompt_to_wait)=@_;
    my $gotit = "";

    $ob->are_match($prompt_to_wait);
    $ob->write($output_string);

    until ("" ne $gotit) {
        $gotit = $ob->lookfor;
        die "aborted\n" unless (defined $gotit);
        sleep 0.1;
    }

    my ($match, $after) = $ob->lastlook;
    printf "%s%s",$gotit,$match;

}

$ob->are_match("hoge1", "hoge2", ...)

という風にして、特定の文字列を待つことができる。複数指定できる。 waitfor というサブルーチンを作って、入力するコマンドと、期待するプロンプトを指定して実行する。

$ob->lookfor で、are_matchで指定した文字列が来るのを待つ。

sleepは1秒未満で待ちたいので Time::HiRes を使う。

$ob->lastlook で、マッチした文字列を取得できる。 この例では are_matchを1個しかしていないので確認する必要はないが、 複数していした場合はどの文字列にマッチしたのかを知ることができる。 これでだいぶ使えるでしょう。 あとは、期待したプロンプトが帰ってこなかったときにタイムアウトするようにすれば完璧。