PC Memorandom of augustus: perl アーカイブ

2010年01月05日

パスワード付きのAccessのmdbファイルの処理

perlでパスワード付きのmdbファイルにアクセスしたい場合、あるいはパスワードを変更したい場合にどうしたらよいか調べてみた。（近年、勤務先で要求されるセキュリティのレベルが上がってきたのだ。）

パスワード付きのmdbファイルにアクセスするには接続文字列に
Jet OLEDB:Database Password=YourPassword;
と追加すれば良い。

# パスワード付きのmdbファイルにアクセスする例
# PASSWORD というパスワードをもつ hoge.mdb に接続する。

use Win32::OLE;
my $password="PASSWORD";

# 接続文字列を作る
$connStr="Provider=Microsoft.Jet.OLEDB.4.0;";
$connStr.="Data Source=hoge.mdb;";
# 接続文字列にパスワードを追加
$connStr.="Jet OLEDB:Database Password=$password;" if($password ne "");

#アクセスのデータベースへの接続
$objDB=Win32::OLE->new("ADODB.Connection");
$objDB->Open($connStr);

#
# ここに読み書きその他の処理を書く。
#

# 接続を閉じる
$objDB->Close();
$objDB=undef();

パスワード変更をしたいときは、データベースを排他モードで開いて
ALTER DATABASE PASSWORD 新パスワード旧パスワード
を実行する。（空のパスワードは NULL と記述）

#
# hoge.mdb に接続して、パスワードを変更。
#
use Win32::OLE;
$password="PASSWORD";       #変更前のパスワード
$newpassword="NEWPASSWORD"; #変更後のパスワード

# 接続文字列を作る
$connStr="Provider=Microsoft.Jet.OLEDB.4.0;";
$connStr.="Data Source=hoge.mdb;";
# 接続文字列にパスワードを追加
$connStr.="Jet OLEDB:Database Password=$password;" if($password ne "");

#アクセスのデータベースへの接続
$objDB=Win32::OLE->new("ADODB.Connection");
$objDB->{Mode}=12; # 排他モードにする。
$objDB->Open($connStr);

# パスワード変更
$newpassword="NULL" if($newpassword eq "");
$cmd=$objDB->Execute(
	"ALTER DATABASE PASSWORD $newpassword $password"
 );

# 接続を閉じる
$objDB->Close();
$objDB=undef();

投稿者 augustus : 10:48 | コメント (0)

2009年07月10日

USBメモリのシリアル番号の取得

USBデバイスには製造元を表わすベンダーID、製品の種別を表わすプロダクトID、個別の製品の固有番号である iSerialNumber と呼ばれる文字列があり、 WMI 経由でそれらは取得できる。
以下はサンプルの perl スクリプト。

use strict;
use Win32::OLE;
use Win32;

my $strComputer=".";
my $wmi = Win32::OLE->GetObject(
  "WinMgmts:{impersonationLevel=impersonate}!//".
  "$strComputer\\root\\cimv2"
) or die;
my $colDiskDrives = $wmi->ExecQuery(
  "SELECT * FROM Win32_DiskDrive"
);
for my $disk (in $colDiskDrives) {
	next if $disk->{PNPDeviceID}!~/^usbstor/i;
	print "$disk->{PNPDeviceID}\n";
}

これを使うとUSBメモリを簡単な鍵のように使うことができそうだ。
１）予めユーザが使用しているUSBメモリのシリアル番号を登録しておく。
２）ログオンスクリプトで、接続しているUSBメモリのシリアル番号を読み取り、登録済みのシリアル番号が見つからなければシャットダウンする。
３）ログオンスクリプトだけでなく、一定時間ごとにチェックしてやるとさらに良いかもしれない。

投稿者 augustus : 21:48 | コメント (0)

2007年02月19日

ISBNの13桁化

今年（2007年）の1月から従来10桁だったISBNが13桁に拡張された。拡張の仕方は単純で頭に978を付け、最後の桁のチェックデジットを再計算するだけでよいらしい。

10桁のISBNと13桁のISBNを相互変換する関数が欲しくて CPAN を探すと、 Business::ISBN というぴったりのモジュールがあった。

use Business::ISBN qw( isbn_to_ean ean_to_isbn );
$isbn_10="4873113008";
$isbn_13=isbn_to_ean($isbn_10); # 旧ISBN ---> 13桁ISBN
$isbn_10=ean_to_isbn($isbn_13); # 13桁ISBN ---> 旧ISBN

13桁のISBN は EANコードと一致するのだ。

早速、「古代ローマ/書籍案内」で使っているプラグインに組み込んで ISBN: の後の10桁の番号を 13桁化して表示するようにした。これで各ページを個別に修正しなくてもよくてラッキーだ。

なお、13桁化したISBNはEANコード（日本ではJANコード）と一致するので、本の裏表紙などに印刷されているバーコードのうち上の方（978から始まるもの）がそのままISBNとなっている。

投稿者 augustus : 18:47 | コメント (0)

2004年08月05日

二重起動の防止

あるプログラムが走っているときに、同時に同じプログラムを起動させたくないときがある。Windows 環境であれば mutex オブジェクトを使うことができ、Perl にも Win32::Mutex モジュールが存在する。

use Win32::Mutex;
die "二重起動" if(Win32::Mutex->open('hogehoge'));
$mutex=Win32::Mutex->new(1, 'hogehoge');
while(1){
    print ++$n,"\n";
    sleep(5);
};

２行目で他に hogehoge という名前の Mutex オブジェクトが作られていないかどうかチェックし、もし他で hogehoge という名の Mutex オブジェクトが作られていれば、先へ進まずに終了する。３行目では hogehoge という Mutex オブジェクトを作成している。
したがって、このスクリプトを２つ起動しようとしても、２つ目は２行目のチェックで引っかかって終了してくれるはずである。

ただし、タイミングによっては完璧ではないようだ。

投稿者 augustus : 22:19 | コメント (0) | トラックバック

2004年08月03日

CSV の行を分解

CSVをコンマで分けるのは一見簡単そうであるが、実は奥が深い。Perl では Text::CSV_XS モジュールを使うのが便利だ。

たとえば、split 関数を使って「,」で分ければ、次のような単純な例はうまくいく。

$line='A,BB,CCC,,D';
@values=split(/,/,$line);

しかし、これでは「,」や「"」を含む値を適切に扱うことはできない。値の中に「,」や「"」を含むときは値を「"」で囲み、含まれる「"」は「""」と記述するのだが、単純に「,」で切っては当然うまくいかない。

Perlメモ(http://www.din.or.jp/~ohzaki/perl.htm#CSV2Values)に詳しくやり方が書いてあった。難しくて解読困難だ。(^^;

$tmp=$line='"""北海道,札幌市""",ABC,"XX,XX","abc"';
$tmp=~s/(?:\x0D\x0A|[\x0D\x0A])?$/,/;
@values=map {/^"(.*)"$/?scalar($_=$1,s/""/"/g,$_):$_}
        ($tmp =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g);

Text::CSV_XS を使って以下のようにすることもできる。日本語を扱わないなら {binary=>1} は不要である。

use Text::CSV_XS;
$csv=Text::CSV_XS->new({binary=>1}); #create a object
$line='"北海道,札幌市",ABC,"XX,XX","""abc"""';
$status=$csv->parse($line);          #parse a string
@values=$csv->fields();              #get the fields
print join("\n",@values);

Text::CSV_XS は Active Perl なら標準で含まれているからこれが便利だろう。

投稿者 augustus : 22:36 | コメント (0) | トラックバック

perl でリンクを抽出する

perl でリンクを抽出するには HTML::LinkExtor モジュールを使うのが便利だ。
$p = HTML::LinkExtor->new([$callback[, $base]]);
まずは LinkExtor オブジェクトを作るわけだが、 callback 関数を指定しておくと、リンクを見つけるたびに callback 関数が呼び出される。 callback 関数を指定していないときは $p->links で含まれるリンクを明示的に読み出すことができる。
$base を指定しておくと、相対パスで指定されたリンクを自動的に $base を基準にしたものとみなして絶対パスに直してくれる。

文字列からリンクを抽出したいときは $p->parse($strings) とするが、ファイルからリンクを抽出するときは $p->parse_file($filename) とする。

では、http://www.augustus.to/ に含まれるリンクを抽出してみよう。

use LWP;
use HTML::LinkExtor;

$url="http://www.augustus.to/";
$browser = LWP::UserAgent->new;
$response = $browser->get($url);

$p = HTML::LinkExtor->new(\&callback,$url);
$p->parse($response->{_content});

sub callback {
    my($tag, %links) = @_;
    print "$tag @{[%links]}\n";
}

callback 関数を使わないならこんな感じ。

use LWP;
use HTML::LinkExtor;

$url="http://www.augustus.to/";
$browser = LWP::UserAgent->new;
$response = $browser->get($url);

$p = HTML::LinkExtor->new(unlink(),$url);
$p->parse($response->{_content});
for $x ($p->links){
    print join(" ", @{$x}),"\n";
}

投稿者 augustus : 08:54 | コメント (0) | トラックバック

2004年08月02日

perl で cookie を取得

perl で web ページにアクセスするとき、クッキーを取得したいときもあるだろう。そういうときは HTTP::Cookies モジュールを使えばよい。
以下の例のようにするとページのソースが表示されるとともに、クッキーが指定されたファイルに保存される。

use LWP;
use HTTP::Cookies;

$url="http://www.amazon.co.jp/"; #アクセスする URL
$file="cookies_amazon.txt";      #クッキーを保存するファイル

$browser = LWP::UserAgent->new;
$browser->cookie_jar({file =>$file, autosave=>1 });
$response = $browser->get($url);
print $response->{_content};

投稿者 augustus : 21:24 | コメント (0)

2004年08月01日

ユーザ認証を要するページにperlでアクセス

BASIC認証またはDIGEST認証を要求する web ページに perl でアクセスしたいときには LWP::UserAgent モジュールの credentials メソッドが使える。
実験用に用意した http://www.augustus.to/test/authtest/ にアクセスしてみよう。領域名は Auth_Test、ユーザ名は authtestuser、パスワードは password である。スクリプトは以下のようになる。

use LWP;
use HTTP::Request::Common;

$domain="www.augustus.to";
$port=80;
$realm="Auth_Test";   #領域名
$user="authtestuser"; #ユーザ名
$passwd="password";   #パスワード
$url="http://www.augustus.to/test/authtest/";

$browser = LWP::UserAgent->new;
$browser->credentials(
    "$domain:$port",$realm,$user,$passwd);
$response = $browser->get($url);
print $response->{_content};

投稿者 augustus : 21:07 | コメント (2) | トラックバック

2004年05月02日

perl で web にアクセス (LWP::Simple)

perl から web にアクセスしたいときは LWP::Simple モジュールを使うのが便利だ。細かいところに手が届く感じではないが、実にシンプルに使うことができる。

実例を挙げると

use LWP::Simple;
$url="http://www.augustus.to/";
$data=get($url);

たったこれだけで web のドキュメントを取得できるのだから楽ちん、楽ちん。ただし、HTTP のレスポンスコードはとれない。

$code=getprint($url);

とすると $code にレスポンスコードが得られるが、$url の内容は標準出力に出力されてしまう。

細かいことをしたければ、LWP::UserAgent を使えば良いということなのだろう。

投稿者 augustus : 19:59 | コメント (0) | トラックバック

2004年04月01日

perl 実行時のコマンド窓を消す

Active Perl でスクリプトを実行するとき、黒いコマンドウィンドウが開いて邪魔に感じることがある。また、スクリプト実行の途中にこのコマンドウィンドウを×ボタンで閉じてしまうユーザもいて予期しない結果を生じたりもする。

コマンドウィンドウを出さない一番簡単な方法は Active Perl に標準でついてくる wperl.exe を使うことだ。wperl は実行時にコマンドウィンドウを勝手に開くことはない。
a.pl を実行させるのには wperl.exe a.pl を実行するショートカットを作っておけば良いだろう。

注意すべき点としては STDOUT, STDERR をリダイレクトしておかないと、これらの出力が得られないことがあげられる。
コマンドプロンプトから wperl a.pl と実行した場合でもリダイレクトしない限り STDOUT, STDERR の出力を見ることはできない。もっとも、STDOUT, STDERR の出力を見たいのならわざわざ wperl を使わなければよいだけなので問題はないだろう。

投稿者 augustus : 07:17 | コメント (0)

2004年03月20日

use utf8;

perl のスクリプト内で日本語を記述したいなら、Perl 5.8 以降の場合、文字コードは UTF-8 を使うのが簡単なようだ。正規表現もきちんと使えるし、「表」など Shift JIS では注意が必要だった文字も普通に扱うことができる。

use utf8;
と書いておけばソース内部の非アスキー文字は UTF-8 として解釈される。モジュールの場合は、
noencoding;
use utf8;
と書く。

この utf8 プラグマは、ソースが UTF-8 で記述されていることを示すだけで、外部のファイルから日本語を読んだり、日本語を書き出したりするときの挙動には関係がないようだ。

投稿者 augustus : 22:57 | コメント (0) | トラックバック

Encode, Encode::Guess モジュール

Encode モジュールを使うと、いろいろな文字コードを decode できる。どういう文字コードであるかをスクリプトに決定させるには、 Encode::Guess モジュールを使う。Active Perl のヘルプには以下のような例が載っている。$data に入っている文字列の文字コードを判別して、decode するものだ。

use Encode::Guess,
my $enc = guess_encoding($data, 
      qw/euc-jp shiftjis 7bit-jis/);
ref($enc) or die "Can't guess: $enc";
$utf8 = $enc->decode($data);
# or
$utf8 = decode($enc->name, $data)

投稿者 augustus : 22:48 | コメント (0) | トラックバック

2004年03月14日

Linux から Windows への perl スクリプトの移植

Linux で動作するように書かれた Perl のスクリプトの中には OSの機能の違いから Windows 上では動作しないものも多い。
ActivePerl の開発元の ActiveState 社のサイトには "Implementation Quirks" という記事があり、実装されていない関数として、以下のようなものが挙げられている。これらの関数を使っているものはそのままでは動かないだろう。

プロセス関係

alarm(), getpgrp(), getppid(), getpriority(), setpgrp(), setpriority()

ユーザやグループに関するもの

endgrent(), endpwent(), getgrent(), getgrgid(), getgrnam(), getpwent(), getpwnam(), getpwuid(), setgrent(), setpwent()

System V IPC 関係

msgctl(), msgget(), msgrcv(), msgsnd(), semctl(), semget(), semop(), shmctl(), shmget(), shmread(), shmwrite()

ファイルやディレクトリに関するもの

link(), symlink(), chroot()

入出力に関するもの

syscall()

ネットワーク関係

getnetbyname(), getnetbyaddr(), getnetent(), getprotoent(), getservent(), sethostent(), setnetent(), setprotoent(), setservent(), endhostent(), endnetent(), endprotoent(), endservent(), socketpair()

Microsoft TechNet にも「Linux から Windows 2000 へのスクリプトの移植性」という記事があり、参考になる。

投稿者 augustus : 11:00 | コメント (0) | トラックバック

2004年03月08日

Perl から DBI 経由でデータベースを使う

perl から Access や SQL Server のデータベースを扱うのに、OLE経由でADOを使う他、DBIを使うこともできる。 DBI経由はデータベースを変更しても接続文字列を変えるくらいで対応が出来きて便利だと思われる。

下の例の接続文字列は SQL server または MSDE のものだが、アクセスで hoge.mdb に接続するなら
dbi:ODBC:driver=Microsoft Access Driver (*.mdb);dbq=hoge.mdb という接続文字列を使えば良い。

use DBI;

# 接続文字列（SQL Server or MSDE の例）
$dataSource = "dbi:ODBC:".
    "driver={SQL Server};".
    "Server=(local);database=test;".
    "Trusted_Connection=yes;". # yesだとWindows認証
    "AutoTranslate=No;";
    
#データベースに接続
$user="tuser"; #ユーザ名
$pwd="tuser";  #パスワード
$dbh=DBI->connect($dataSource,$user,$pwd)
    or die $DBI::errstr;

# テーブル削除
$dbh->do("Drop table seito");

# テーブル作成
$dbh->do(
    "Create Table seito(id int, name varchar(30))"
) or die $DBI::errstr;

# データ挿入
$sth = $dbh->prepare(
    "INSERT INTO seito (id,name) VALUES (?,?)");
$sth->execute(11, "菅原 道真");
$sth->execute(12, "藤原 道長");

# データ読み出し
$ref=$dbh->selectall_arrayref("select * from seito");
for $x (@{$ref}){
	print join("/", @{$x},"\n");
}

# データベースから切断
$dbh->disconnect;

データベースを新規作成することは出来ないのかなあ？

投稿者 augustus : 19:53 | コメント (1) | トラックバック

2004年03月07日

SQLserver に perl でアクセス

この間のアクセスのデータベースを使った例と基本的に同じでよいのだが、接続文字列の書き方を忘れたときのためにメモを残しておく。

接続文字列中で Data Source= のあとにはサーバ名を書く。ローカルのSQL server または MSDE を使うなら Data Source=(local) と書ける。
Initial Catalog= のあとにはデータベース名を書く。

ユーザ名、パスワードは user id=, password=で指定する。もし、Windows認証を使うのなら、ユーザ名とパスワードの指定の替わりに、

Integrated Security=SSPI

あるいは

Trusted_Connection=yes

と書けばよい。

# SQLserver のデータベース操作の例
#
#     SRV2003 という名のサーバ上の SQLserver の
#     test という名のデータベースに接続し、
#     seito というテーブルを作成し、データを追加し、
#     データを読み出す。

use Win32::OLE;
$server="SRV2003";
$db="test";
$user="tuser";
$password="tuser";

# データベースへの接続
$objDB=Win32::OLE->new("ADODB.Connection");
$connStr="Provider=sqloledb;".
	"Data Source=${server};".
	"Initial Catalog=${db};".
	"user id=${user};password=${password}";
$objDB->Open($connStr);
$objDB->{Errors}->{Count} and 
    die "cannot connect '$connStr'";

# テーブル作成
$objDB->Execute(
    "Create Table seito (id int, name Char(20))" );

# データ挿入
$objDB->Execute(
    "Insert into seito values (11,'蘇我 馬子')");
$objDB->Execute(
    "Insert into seito values (12,'中臣 鎌子')");

# データ読み出し
$rs=Win32::OLE->new("ADODB.Recordset");
$rs->Open("select * from seito", $objDB);
while(!$rs->EOF and $rs->{RecordCount}!=0){
    print "$rs->{Fields}->{id}->{Value}, ",
        "$rs->{Fields}->{name}->{Value}\n";
    $rs->MoveNext();
}
$rs->Close();

# 接続を閉じる
$objDB->Close();
$objDB=undef();

投稿者 augustus : 11:58 | コメント (2) | トラックバック

2004年02月29日

Perl でデータベースを操作する実験

Windows 上の Perl でデータベースを操作するには DBI モジュールか、OLE 経由で ADO を使うことができる。どちらが便利なのかまだ自分には分からないのだが、とりあえずローカルコンピュータ上でアクセスのデータベースを OLE 経由の ADO で操作するサンプルを以下に書いておく。
接続のところを変えれば SQL server でも使えるはずである。

データベース作成、テーブル作成、データ挿入の例

# アクセスのデータベース操作の例
# アクセスのデータベース hoge.mdb を作り、
# hoge.mdb に接続して、テーブルを作成、データを挿入。
# Windows 2000 pro, Access 2003 で動作確認を行った。

use Win32::OLE;
$connStr="Provider=Microsoft.Jet.OLEDB.4.0;";
$connStr.="Data Source=hoge.mdb;";

# アクセスのデータベース作成

$objCat=Win32::OLE->new("ADOX.Catalog");
$objCat->Create($connStr);
$objCat=undef();

#アクセスのデータベースへの接続
$objDB=Win32::OLE->new("ADODB.Connection");
$objDB->Open($connStr);

# テーブル作成
$cmd=$objDB->Execute(
    "Create Table seito(id int, name Char(20))" );

# データ挿入
$cmd=$objDB->Execute(
    "Insert into seito values(11,'蘇我 馬子')"  );
$cmd=$objDB->Execute(
    "Insert into seito values(12,'中臣 鎌子')"  );

# 接続を閉じる
$objDB->Close();
$objDB=undef();

データ読み出しの例

#  データベース操作の例
#  カレントディレクトリの hoge.mdb から
#  foo テーブルのデータを読みだす。
#  Windows 2000 pro, Access 2003 で動作確認を行った。

use Win32::OLE;

#アクセスのデータベースへの接続
$connStr="Provider=Microsoft.Jet.OLEDB.4.0;";
$connStr.="Data Source=hoge.mdb;";
$objDB=Win32::OLE->new("ADODB.Connection");
$objDB->Open($connStr);

# データ読み出し
$rs=$objDB->Execute("select id,name from seito");
while(!$rs->EOF){
	print "$rs->{Fields}->{id}->{Value},";
	print " $rs->{Fields}->{name}->{Value}\n";
	$rs->MoveNext();
}
$rs->Close();

# 接続を閉じる
$objDB->Close();
$objDB=undef();

投稿者 augustus : 18:52 | コメント (2) | トラックバック

2004年02月22日

Wake up on LAN の実験

管理しているPCが離れたところにあったり、数が多かったりすると、電源を入れるだけでも結構大変である。多くの作業を自動化するように工夫していて、電源を入れるところだけは手動というのも悔しい。
そういうときに使えるのが Wake up on LAN。文字通り LAN 経由で、PCを起こしてくれる。

方法としては、マジックパケットと呼ばれるパケットをターゲットのPCに届けてやれば良いらしい。
http://www3.jpn.hp.com/CPO_TC/pc/doc/34602.pdf によるとマジックパケットというのは、６個の FF(16進)のあと、MACアドレスを１６回以上繰り返したものだそうである。

Perl によるスクリプトがhttp://adlib.rsch.tuis.ac.jp/~akira/unix/にあった。

自分用に書き直したのが、以下のスクリプト。複数のPCをターゲットにするよう書きかえるのも簡単である。(MAC address と Broadcast IP address を書き換えてから試してみてほしい。)

use Socket;
#
# wake up on LAN
#

# ターゲットの MAC address と Broadcast IP address
$ret=wakeup_on_lan("00-11-22-33-44-55", "10.255.255.255");
print $ret if $ret;

#
# wakeup_on_lan(MACアドレス, ブロードキャストアドレス)
# エラーのときはエラーの内容を示す文字列を返す。
# エラーでないときは空文字列を返す。
sub wakeup_on_lan{ 
    my($mac_address, $broadcast_address)=@_;
    my($macstr, $remote_port,$proto,$iaddr,$paddr,$pac);
    # MAC address decode
    $mac_address=~s/-//g;
    $macstr=pack("H12", $mac_address);
    # Magic Packet create
    $pac = "\xff\xff\xff\xff\xff\xff";
    for($i=0; $i<20;$i++) {
        $pac .=$macstr;
    }
    # open socket
    $remote_port="7";
    $proto=getprotobyname('udp');
    socket(S, PF_INET, SOCK_DGRAM, $proto) 
        or return "ERROR at open socket: $!";
    setsockopt(S, SOL_SOCKET, SO_BROADCAST,1) 
        or return "ERROR at sockopt: $!";
    # send Magic Packet
    $iaddr=inet_aton($broadcast_address) 
        or return "ERROR at get broadcast address: $!";
    $paddr=sockaddr_in($remote_port,$iaddr) 
        or return "ERROR at make broadcast: $!";
    send(S,$pac,0,$paddr) 
        or return "ERROR at send broadcast:$!";
    return("");
}

マジックパケットの送り先が１台なのにブロードキャストを使うには理由がある。届きさえすれば、ブロードキャストでなくてもよいのだが、arp テーブルがクリアされたりしていると届かない。ブロードキャストを使えば、そういうことは気にしなくて良くなる。
UDP の port 7 を使っているが、実験してみると port 番号は適当で良いようだ。

ターゲットの MAC アドレスが必要になるが、電源が入っているときに ping を飛ばしてから arp コマンドを使って、arp -a とやれば簡単に調べられる。

がんばれば、LAN だけでなくインターネット経由で Wake up on LAN を行うこともできるらしい。
http://bb.watch.impress.co.jp/column/shimizu/2003/09/16/

投稿者 augustus : 05:54 | コメント (0)

2004年02月21日

Perl の Net::Ping モジュール

ping といえばネットワーク的に繋がっているかどうかを確かめるための定番ツールだが、Net::Ping モジュールはそれと同様の機能をもつ Perl のモジュールである。

例えば、 192.168.0.1 に ping を飛ばして返事があれば、何かの処理をする例はこんな感じ。

use Net::Ping;
$host="192.168.0.1";
$timeout=0.1;
$p = Net::Ping->new("icmp");
if $p->ping($host, $timeout){
	print "$host is alive.\n";
}
$p->close();

もうちょっと複雑にしてみる。次は
192.168.0.11 から 192.168.0.40 の範囲に ping を飛ばしてから arp コマンドによって mac address を取得するスクリプト。

use Net::Ping;
$timeout=0.1;
$p = Net::Ping->new("icmp");
@host=map("192.168.0.$_", 11..41);
for $host (@host){
    $p->ping($host, $timeout);
}
$p->close();
open(CMD, "arp -a|") or die "cannot exec arp";
print grep($_!~/invalid/, <CMD>);
close(CMD);

投稿者 augustus : 12:05 | コメント (0) | トラックバック

2004年01月31日

プロセスの実行の防止

多くの学校では、生徒がフロッピーディスクにまずいプログラムを入れてきて実行することがあると思う。フロッピーディスクだから、NTFSのアクセス権でなんとかできる問題ではない。
Microsoft の TechNet にプロセスの実行の防止という記事があった。WSHからWMIを使って、プロセスが起動するたびにその名前をチェックして条件に合えばプロセスを kill する。

それを perl に移してみたのが以下のもの(Windows XP 用) 。
A:ドライブと E:ドライブの実行ファイルが起動されるとそのプロセスが kill される。フロッピーディスクだけでなく、CD-ROMドライブや、ユーザのホームディレクトリからの実行を防止するように改造するのは簡単だろう。

use Win32::OLE;
$strComputer=".";
$wmi = Win32::OLE->GetObject(
  "WinMgmts:{impersonationLevel=impersonate}!//".
  "$strComputer\\root\\cimv2"
) or die;
$colMonitoredProc = $wmi->ExecNotificationQuery(
  "select * from __instancecreationevent within 1".
  " where TargetInstance isa 'Win32_Process'"
);
while(1){
  $objLatestProcess = $colMonitoredProc->{NextEvent};
  $proc_name=$objLatestProcess->TargetInstance->Name();
  if($proc_name=~/a:/ or $proc_name=~/e:/){
    $objLatestProcess->TargetInstance->Terminate();
  }
}

上記のスクリプトだとコマンドプロンプトが開いてしまうので、別のプロセスからウィンドウを開かないようにして起動するのが使いやすいかも。

use Win32;
use Win32::OLE;
use Win32::Process;

if($ARGV[0] eq "-eXecute"){
  shift;
  procchk(@ARGV);
}else{
  my $path=Win32::ExpandEnvironmentStrings("%PATH%");
  ($perl_path)=grep(/perl/i, split(/;/,$path));
  $perl_path=~s/\\$//;
  $perl_path.="\\perl.exe";
  $perl_path="" if(! -e $perl_path);
  $script_path=Win32::GetFullPathName($0);
  
  ($strComputer, @inhibit)=@ARGV;
  $strComputer ||= ".";
  @inhibit = qw/a:\ z:\ e:\ install/ if(! @inhibit);
  Win32::Process::Create($ProcessObj, $perl_path,
    $perl_path.' "'.$script_path.
    "\" -eXecute $strComputer @inhibit",
    0, NORMAL_PRIORITY_CLASS|CREATE_NO_WINDOW, "."
  )|| die ErrorReport();
}

sub ErrorReport{
  die;
}

sub procchk{
  my ($strComputer, @inhibit)=@_;
  return if $inhibit[0] eq "";
  grep(s/\\/\\\\/g,@inhibit);
  $check_str=join(" or ",map("\$_[0]=~/$_/i",@inhibit));
  eval("\$check_name = sub {$check_str}");

  $wmi = Win32::OLE->GetObject(
    "WinMgmts:{impersonationLevel=impersonate}!//"."
    $strComputer\\root\\cimv2"
  );
  $colMonitoredProc = $wmi->ExecNotificationQuery(
    "select * from __instancecreationevent within 1 ".
    "where TargetInstance isa 'Win32_Process'"
  );
  while(1){
    $objLatestProcess = $colMonitoredProc->{NextEvent};
    $proc_name=
      $objLatestProcess->TargetInstance->Name();
    if($check_name->($proc_name)){
      $objLatestProcess->TargetInstance->Terminate();
    }
  }
}

投稿者 augustus : 21:29 | コメント (0) | トラックバック

2004年01月25日

Active Perl の ppm をインターネットに接続されていないPCで使う。

Active Perl でモジュールを追加するには PPM を使うのが簡単だ。最新のモジュールを Active State 社のサイトに探しに行ってくれ大変便利なのだが、インターネットから切り離されたPCで Perl のモジュールを入れたいときもあるだろう。そういうときは PPM の rep コマンドを利用してモジュールの場所を指定すれば良い。

まずは、インターネットに繋げるPCで追加したいモジュールをダウンロードしてくる。 http://ppm.activestate.com/PPMPackages/ には zip で圧縮されたモジュールがあるので、適当なディレクトリに解凍しておく。それを好きな外部メディアを使ってモジュールを追加したいコンピュータにコピーしておく。（ここでは C:\perl_mod にコピーしたとする。）
コマンドプロンプトから PPM を起動する。
PPM のプロンプトから
rep add 適当な名前モジュールを入れたディレクトリ名
と入力する。（ディレクトリ名のところには ppd ファイルが入っているディレクトリを指定する。）モジュールが C:\perl_mod にあるなら、
rep add local_perl_mod c:\perl_mod
みたいに入力すれば良い。
次に別のモジュールを追加するときもこのディレクトリを利用するようにすれば、 rep add コマンドをもう一度やる必要はない。
ここまで用意しておけば ppm の install コマンドが使える。ただし、依存関係にあるモジュールが入っていないときはうまく行かない。

rep add コマンドは、PPM がモジュールを探しに行く場所の指定を行うものである。だから、同じディレクトリにモジュールを保管するようにすれば、次回から rep add コマンドを入力せずにモジュールのインストールが可能になる。

詳しくは ppm を起動した状態で help rep と入力すると説明を読むことが出来る。

投稿者 augustus : 16:29 | コメント (5) | トラックバック

2004年01月24日

Active Perl の ppm をプロクシー越しに行う

プロクシー経由でインターネットに接続されているLAN内のコンピュータで Active Perl のモジュールを入れたい場面がある。
そういうときは環境変数 HTTP_proxy でプロクシーサーバの場所とポートを指定してから ppm を起動すれば良い。

例： proxyサーバが proxy1 でポート 8080 なら、コマンドプロンプトから
set HTTP_proxy=http://proxy1:8080
と入力してから ppm を起動する。
proxy1 のところは IP アドレスで指定することも可能。

参考：
http://www.geocities.co.jp/HeartLand-Gaien/3495/comp/perl1.html

投稿者 augustus : 13:16 | コメント (0) | トラックバック

2004年01月15日

perl 5.8 での日本語の取扱

perl 5.8 での日本語の取扱について

use utf8;
use encoding "shift_jis";
use Encoding;

これでかなり jperl っぽく使える。

ただし、どこで encode, decode されているかが今ひとつよくわからないでいる。

投稿者 augustus : 14:35 | コメント (1) | トラックバック