2019年06月15日

意外! みなさん、perlに関心があるんですねえ。

nanako1.jpg

意外でした。

perlでのCGIプログラムについて記事を載せたら意外なアクセス数があり驚きました。

perlはやや古いのかと思っていたので意外でした。

このブログでアクセス人数が100を超えることは滅多にないのですが、もう本日は超えています。

みなさん、強い関心をお持ちなんですねえ。驚きました。

明日も頑張って記事を続けます。

ただ、ちゃらんぽらんな説明は変わりませんが。(#^.^#)




posted by tsurutsuru at 23:30| Comment(0) | 日常茶飯事

perl再入門(4)・・・オブジェクト指向と正規表現

nanako1.jpg

次に進む前にオブジェクト指向と正規表現について学習しておきましょう。

次のサイトに次のような説明がありました。
https://perldoc.jp/docs/perl/5.14.1/perlobj.pod


1.オブジェクトとは、単に自分がどのクラスに属しているのかを 知っているようなリファレンスです。

2.クラスとは、単にオブジェクトのリファレンスを取り扱うメソッドを 提供するパッケージです。

3.メソッドとは、単にその第一引数にオブジェクトのリファレンス (もしくはクラスのメソッドに対するパッケージ名)を取るような サブルーチンです。

また、

C++ とは違って、Perl はコンストラクタに対して特別な構文を用意していません。 コンストラクタは単に、クラスに "bless" したなにかのリファレンスを 返すようなサブルーチンで、一般的にはサブルーチンが定義されているクラスです。


こういう説明を読んでもよく分からないので困ったものです。でも気にしないことにします。

次に正規表現について復習します。

次のサイトを参考にして説明していきます。
https://perldoc.jp/docs/perl/5.16.1/perlreref.pod

report.cgiに出てくる正規表現を例にとって説明します。

$ref =~ /^https?:\/\/[-.!~*'()\w;\/?:\@&=+\$,%#]+/i

きちんと説明しようと思いましたがかなり面倒なのでいやになりました。
ざっと説明します。

/^https? の/の前にはmが省略されています。パターンマッチのチェックですね。
^は行の先頭の意味。?は1つ前の文字が0か1ということでhttpまたはhttpsならOKです。
\/\/の¥はエスケープです。
[-.!~*'()\w;\/?:\@&=+\$,%#]+ は[]の中の文字であればヒットです。最後の+は[]の中の文字が繰り返されていてもOKということ。
最後の/iは大文字小文字を区別しないということです。

このように非常に説明が面倒です。上にあげたサイトを熟読して正規表現を学んでください。

今回はここまでです。


posted by tsurutsuru at 14:45| Comment(0) | 日常茶飯事

perl再入門(3)・・・perlのプログラムを追う(前回の続き)

nanako1.jpg

私が独学でperlを習得した20年前は今のようなオブジェクト指向のperlではありませんでした。

オブジェクト指向がどうも苦手な私にはこの先いろいろな壁が出てくると思いますが、なんとか頑張ってみましょう。

さて前回の続きですが、再度report.cgiを掲載しておきます。

<report.cgi>
--------------------------------------------------------------

#-----------------------------------------------------------
# 解析
#-----------------------------------------------------------
sub analyze_log {
# ランダムモード
if ($cf{rand} > 0) {
srand;
my $rand = int(rand($cf{rand}));
if ($rand != 0) { load_img(); }
}

# リンク元取得
my $ref;
if ($cf{ssi}) {
$ref = $ENV{HTTP_REFERER};
} else {
$ref = $ENV{QUERY_STRING};

# escapeで取得のためURLデコードしておく
$ref = $cgi->url_decode($ref) if ($ref);
}

# リンク元解析
if ($ref =~ /^https?:\/\/[-.!~*'()\w;\/?:\@&=+\$,%#]+/i) {

# URLデコード
$ref = $cgi->url_decode($ref);

# コード変換
require Jcode;
$ref = Jcode->new($ref)->sjis;

# 無害化
$ref = $cgi->htmlize($ref);
$ref =~ s/'/'/g;

} else {
$ref = '';
}

# リンク元集計での除外指定
if ($cf{myurl}) {
my $flg;
foreach ( split(/\s+/, $cf{myurl}) ) {
if (index($ref,$_) >= 0) { $flg++; last; }
}
if ($flg) { $ref = ''; }
}

# ホスト/IP除外
my ($addr,$host) = get_host();

# ブラウザ情報取得
my $hua = $ENV{HTTP_USER_AGENT};

my ($os,$agent);
if ($hua =~ /AOL/) { $agent = 'AOL'; }
elsif ($hua =~ /Opera/i) { $agent = 'Opera'; }
elsif ($hua =~ /PlayStation/i) { $agent = 'PlayStation'; }
elsif ($hua =~ /Googlebot/i) { $agent = 'Googlebot'; }
elsif ($hua =~ /slurp\@inktomi\.com/i) { $agent = 'Slurp/cat'; }
elsif ($hua =~ /Infoseek SideWinder/i) { $agent = 'Infoseek SideWinder'; }
elsif ($hua =~ /FAST\-WebCrawler/i) { $agent = 'FAST-WebCrawler'; }
elsif ($hua =~ /ia_archiver/i) { $agent = 'ia_archiver'; }
elsif ($hua =~ /Chrome/i) { $agent = 'Chrome'; }
elsif ($hua =~ /Safari/i) { $agent = 'Safari'; }
elsif ($hua =~ /Firefox/i) { $agent = 'Firefox'; }
elsif ($hua =~ /MSIE (\d+)/i) { $agent = "MSIE $1"; }
elsif ($hua =~ m|Mozilla/5.+Trident/7|i) { $agent = "MSIE 11"; }
elsif ($hua =~ /Netscape/i) { $agent = 'Netscape'; }
elsif ($hua =~ /Mozilla/i) { $agent = 'Mozilla'; }
elsif ($hua =~ /Gecko/i) { $agent = 'Gecko'; }
elsif ($hua =~ /Lynx/i) { $agent = 'Lynx'; }
elsif ($hua =~ /Cuam/i) { $agent = 'Cuam'; $os = 'Windows'; }
elsif ($hua =~ /Ninja/i) { $agent = 'Ninja'; $os = 'Windows'; }
elsif ($hua =~ /WWWC/i) { $agent = 'WWWC'; $os = 'Windows'; }
elsif ($hua =~ /DoCoMo/i) { $agent = $os = 'DoCoMo'; }
elsif ($hua =~ /^MOT-|^J-PHONE|^SoftBank|^Vodafone|NetFront/i) { $agent = $os = 'SoftBank'; }
elsif ($hua =~ /^UP\.Browser|^KDDI/i) { $agent = $os = 'EZweb'; }
elsif ($hua =~ /L\-mode/i) { $agent = $os = 'L-mode'; }
elsif ($hua =~ /ASTEL/i) { $agent = $os = 'ASTEL'; }
elsif ($hua =~ /PDXGW/i) { $agent = $os = 'H"'; }

$agent = $cgi->htmlize($agent) if ($agent);
$agent =~ s/['\r\n\0]//g;

if ($hua =~ /win[dows ]*95/i) { $os = 'Win95'; }
elsif ($hua =~ /win[dows ]*9x/i) { $os = 'WinMe'; }
elsif ($hua =~ /win[dows ]*98/i) { $os = 'Win98'; }
elsif ($hua =~ /win[dows ]*XP/i) { $os = 'WinXP'; }
elsif ($hua =~ /win[dows ]*NT ?5\.1/i) { $os = 'WinXP'; }
elsif ($hua =~ /Win[dows ]*NT ?5/i) { $os = 'Win2000'; }
elsif ($hua =~ /win[dows ]*2000/i) { $os = 'Win2000'; }
elsif ($hua =~ /Win[dows ]*NT ?5\.2/i) { $os = 'Win2003'; }
elsif ($hua =~ /Win[dows ]*NT 6\.0/i || $hua =~ /Vista/i) { $os = 'WinVista'; }
elsif ($hua =~ /Win[dows ]*NT 6\.1/i) { $os = 'Win7'; }
elsif ($hua =~ /Win[dows ]*NT 6\.2/i) { $os = 'Win8'; }
elsif ($hua =~ /Win[dows ]*NT 6\.3/i) { $os = 'Win8.1'; }
elsif ($hua =~ /Win[dows ]*NT/i) { $os = 'WinNT'; }
elsif ($hua =~ /Win[dows ]*CE/i) { $os = 'WinCE'; }
elsif ($hua =~ /shap pda browser/i) { $os = 'ZAURUS'; }
elsif ($hua =~ /Mac/i) { $os = 'Mac'; }
elsif ($hua =~ /X11|SunOS|Linux|HP-UX|FreeBSD|NetBSD|OSF1|IRIX/i) { $os = 'UNIX'; }
elsif ($hua =~ /iPhone/i) { $os = 'iPhone'; }
elsif ($hua =~ /iPad/i) { $os = 'iPad'; }
elsif ($hua =~ /Android/i) { $os = 'Android'; }

# 時間取得
$ENV{TZ} = "JST-9";
my $hour = (localtime(time))[2];

# ログ読み込み
my @data;
open(DAT,"+< $cf{logfile}") or die "open err: $cf{logfile}";
eval 'flock(DAT, 2);';
my $top = ;

# IPチェック
if ($cf{ip_chk}) {
chomp($top);
if ($addr eq $top) {
close(DAT);
&load_img;
}
}

# 記事数を調整
my $i = 0;
while () {
$i++;
push(@data,$_);

last if ($i >= $cf{maxlog} - 1);
}

# 更新
seek(DAT, 0, 0);
print DAT "$addr\n";
print DAT "$agent<>$os<>$host<>$ref<>$hour<>\n";
print DAT @data;
truncate(DAT, tell(DAT));
close(DAT);

# 表示
&load_img;
}

--------------------------------------------------------------

さて、前回の続きです。

# リンク元解析
if ($ref =~ /^https?:\/\/[-.!~*'()\w;\/?:\@&=+\$,%#]+/i) {

# URLデコード
$ref = $cgi->url_decode($ref);

# コード変換
require Jcode;
$ref = Jcode->new($ref)->sjis;

# 無害化
$ref = $cgi->htmlize($ref);
$ref =~ s/'/'/g;

} else {
$ref = '';
}

$ref =~ /^https?:\/\/[-.!~*'()\w;\/?:\@&=+\$,%#]+/i は正規表現を使ってパターンマッチしています。正規表現は面倒なので気が向いたら説明します。というか正規表現についてはほぼ忘れていますので、違っているかかも知れませんが、どうもhttps://を検索しているようです。あれば、次の処理をします。

# URLデコード
$ref = $cgi->url_decode($ref);

# コード変換
require Jcode;
$ref = Jcode->new($ref)->sjis;

# 無害化
$ref = $cgi->htmlize($ref);
$ref =~ s/'/'/g;

URLデコードは%29とかを文字に直していると思います。

コード変換はシフトJISにしています。この辺は日本語のやっかいなところです。

無害化は必ずやってください。ここではシングルコーテンションを&H39に変換してるようでう。

# リンク元集計での除外指定
if ($cf{myurl}) {
my $flg;
foreach ( split(/\s+/, $cf{myurl}) ) {
if (index($ref,$_) >= 0) { $flg++; last; }
}
if ($flg) { $ref = ''; }
}

init.cgiを見ると

# リンク元除外ページ(半角スペースで区切る)
# → ここで指定したURLは「リンク元」集計から除外されます
# → 例:$cf{myurl} = 'http://www.example.com/ http://www.example.jp/';
$cf{myurl} = '';

とあります。ですから、ここの処理はもしも$cf{myurl}にリンク先が指定されていたら、それと同じかどうかを調べて同じなら $ref = ''; にしてしまいます。

# ホスト/IP除外
my ($addr,$host) = get_host();

get_hostは下の方にあります。

-----------------------------------------------------------
# ホスト名取得
#-----------------------------------------------------------
sub get_host {
# ホスト名取得
my $host = $ENV{REMOTE_HOST};
my $addr = $ENV{REMOTE_ADDR};
if ($host eq "" || $host eq $addr) {
$host = gethostbyaddr(pack("C4",split(/\./,$addr)),2) || $addr;
}

if ($cf{deny_host}) {
my $flg;
foreach ( split(/\s+/, $cf{deny_host}) ) {
if (index("$host $addr",$_) >= 0) { $flg++; last; }
}
if ($flg) { &load_img; }
}

if ($host =~ /(.*)\.(\d+)$/) { ; }
elsif ($host =~ /(.*)\.(.*)\.(.*)\.(.*)$/) { $host = "\*\.$2\.$3\.$4"; }
elsif ($host =~ /(.*)\.(.*)\.(.*)$/) { $host = "\*\.$2\.$3"; }

# 結果
return ($addr,$host);
}

少し分かりにくいので説明は後回しにして結果をみてみます。

perl-host1.jpg

こんな風に表示していますので、結果から推測してみるしかないですね。

その前にperlの論理演算子を確認しておきましょう。

perl_ronri_enzansi1.jpg

a||b はaかbの少なくとも1つが真の場合に真なのですね。

分かりにくいと言ってもじっとプログラムをみていると少しずつ分かって来るから不思議ですね。

このプログラムを理解するためには、ホスト名とアドレスがどのようなパターンで出てくるのか分からないと理解できないですね。

ホスト名が *.ip-12-134-145.eu のような場合もあるようです。すべての場合に対応するためにこういうプログラムになっているようです。

ホスト名の取得は説明不足ですが、とりあえず今回はここまでとします。

完成されたプログラムをいきなり見るのはやっぱりつらいところがあります。

工夫して少し分かりやすくしてみますね。

では、次回をお待ちください。



 
posted by tsurutsuru at 12:00| Comment(0) | 日常茶飯事