#! /usr/bin/perl
#---------------------------------------------------------------------
#
# PNGカウンタ version 2.0.2 (2004/ 8/ 8)
# (c) 2000-2004 桜月
# http://www.aurora.dti.ne.jp/~zom/Counter/
#
#---------------------------------------------------------------------
# 設置者による設定。
$keta = 0;
;# カウンタの表示桁を設定します。
## 0以外にすると、その桁数になるよう不足分は0で埋められます。
$ketah = 0;
;# 一日ごとのアクセス数を何桁で表示するかの設定。
## 0以外にすると、その桁数になるよう不足分は0で埋められます。
$hojiNissuu = 7;
;# 一日ごとのアクセス数を、何日分記録しておくかの設定。初期値は
## 7日分。
$relup = 1;
;# 再読込の時もカウントアップするなら1に。
$clevel = 2;
;# 再読込判定に用いる材料の指定。
## 1ならIPアドレスの第1〜第3オクテットを判定の材料にします。即ち
## 1.2.3.4というIPアドレスからアクセスがあったその次に、1.2.3.5
## というIPからアクセスがあっても、カウントアップしません。
## これは企業や大学等からのアクセスがあると、それと前後してアク
## セスしてくることがあるキャッシュサーバ(CacheFlow等)を除外し
## たい時に有用ですが、たまたま第4オクテットだけが異なるIPから赤
## の他人同士が続けてアクセスしてきても、やはりカウントアップさ
## れないという欠点もあります。
## ここを2にすると、IPアドレスの第1〜第4オクテットすべてを再読込
## の判定に使います。即ち、上で述べた状況の時でもカウントアップ
## します。
## ここを3にすると、IPアドレスに加えてプロキシサーバが使われてい
## る可能性を考慮して再読込判定が行われます。大規模なLANの内部で
## このカウンタを使う時にはこの指定が有用かもしれません。
$logdir = './log';
;# ログファイルが入っているサブディレクトリ名。
## (このスクリプトからの相対パス)
$gztype = 'png';
;# 数字用画像の種別。gifを使うときはここをgifに。
$gzdir = './png';
;# 画像合成に使う数字用画像が入っているディレクトリ名。
## このスクリプトからの相対パスまたは絶対パスで指定します。
$wsc = 0;
;# 画像をweb safe coloursの216色に減色して表示したい場合、ここを
## 1にします(PNGを使う時のみ有効)。
## ただし一度checkオプションで「検査済」となった画像については、
## 画像をアップロードしなおすか、または検査時に同じディレクトリ
## にバックアップされた元ファイル( "元々のファイル名_backup" と
## いう名前になっています)を元の名前に戻すかして、それから再度
## checkすることでようやくここでの指定変更が有効になります。
$locktype = 0;
;# ロック法。0ならflock式、1ならrename式。
# 以下はJavaScriptによるカウンタ呼び出しを行う時用の設定です。
$jsdir = './pngcntr';
;# JavaScriptによって貼り付ける数字用画像が入っているディレクト
## リを指定します。相対パスででも絶対パスででもURLででも指定可能
## ですが、カレントはカウンタではなく、それを呼ぶ(X)HTMLファイル
## があるほうのディレクトリであることにだけご注意。
# 設置者による設定箇所ここまで。
#---------------------------------------------------------------------
$version = 'PNG Counter 2.0.2';
exit(&Main);
# オプション取り出し。
sub Option
{
my($logFile, $opts) = @_;
my($env, $key, $value);
($$logFile, $env) = split(/;/, $ENV{'QUERY_STRING'} || '', 2);
$$logFile = '' if(!defined($$logFile));
$env = '' if(!defined($env));
foreach (split(/;/, $env))
{
($key, $value) = split(/=/, $_);
if(defined($key))
{
$opts->{$key} = $value || 1;
}
}
# セキュリティー対策。
$$logFile = '' if(index($$logFile, '..') + 1);
if(defined($opts->{'gzdir'}) && $opts->{'gzdir'} ne '')
{
$opts->{'gzdir'} = '' if(index($opts->{'gzdir'}, '..') + 1);
$opts->{'gzdir'} = ''
if($main::gzdir eq '' && substr($opts->{'gzdir'}, 0, 1) eq '/');
}
}
# 返り値はBOOL.
sub RenameLock
{
my($logFile, $lockFile) = @_;
my($i);
$$lockFile = "$$logFile.lock";
for($i = 0; $i < 5; $i++)
{
if(rename($$logFile, $$lockFile)) # ロック成功。
{
utime(time, time, $$lockFile);
return 1;
}
sleep(2);
}
if(time - (stat($$lockFile))[9] > 180) # 3分以上前のものなら遺物と見なし、
{
utime(time, time, $$lockFile); # そのまま横取り。
return 1;
}
return 0;
}
# Expiresヘッダ作成。
sub OutExpires
{
my($byoo, $fun, $zhi, $nichi, $gatsu, $nen, $yoobi) = gmtime(time + 32400);
my($nichizhi) = sprintf("%s, %d %s %d %02d:%02d:%02d GMT"
, ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$yoobi], $nichi
, ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun'
, 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$gatsu], 1900 + $nen
, 15, 0, 0
# , $zhi, $fun, $byoo
);
return "Expires: $nichizhi\n";
}
# ディレクトリ名の連結。
sub DirRenketsu
{
$_[0] .= '/' if($_[0] ne '' && substr($_[0], -1) ne '/');
if(defined($_[1]) && $_[1] ne '')
{
$_[0] .= $_[1];
$_[0] .= '/' if(substr($_[0], -1) ne '/');
}
}
# エラー処理。checkオプションのできた今、もはや存在意義が……。
sub Error
{
my($err) = @_;
$err = 4 if($err >= 100);
print "Content-Type: image/png\n\n";
print "\x89PNG\x0d\x0a\x1a\x0a";
print "\0\0\0\x0dIHDR\0\0\0 \0\0\0 \x01\x03\0\0\0I\xb4\xe8\xb7";
print "\0\0\0\x06PLTE";
if($err == -1) { print "\xFF\xFF\xFF\x00\x00\x00\x55\xC2\xD3\x7E"; }
elsif($err == 1){ print "\x00\x00\x00\x00\x00\xFF\x88\x65\x56\x42"; }
elsif($err == 2){ print "\x00\x00\x00\x00\xFF\x00\x36\x43\x44\xBD"; }
elsif($err == 3){ print "\x00\x00\x00\x00\xFF\xFF\x1B\x41\xAB\x30"; }
elsif($err == 4){ print "\x00\x00\x00\xFF\x00\x00\x1B\xFF\x8D\x22"; }
elsif($err == 5){ print "\x00\x00\x00\xFF\x00\xFF\x36\xFD\x62\xAF"; }
elsif($err == 6){ print "\x00\x00\x00\xFF\xFF\x00\x88\xDB\x70\x50"; }
else { print "\x00\x00\x00\xFF\xFF\xFF\xA5\xD9\x9F\xDD"; }
print "\0\0\0)IDATx\xdac\xf8\x0f\x04\x0c\x0d";
print "\x0c\x0c\x8c\xe8D\xfb\xff\xff\x0f\xd1\x89\x06\xe6\x03\x8c\x94";
print "\x13\xf3\xff\xff\xff\x89N`s\x01\xc8i\0\xeb[9";
print "\xa9\xb9\xc5K\xc5\0\0\0\0IEND\xaeB`\x82";
return $err || 0;
}
# レポート。
sub Report
{
my($narabi, $flags, $logFile, $verbose) = @_;
my($logName, $pngFile, $IHDRChunk, $width, $height, $colourInfo, $result, $prevCI, $bitDepth, $colourType);
my($resultSum, $resultSumL, $bFuzoroi, $cacheSeekoo) = (0, 0, 0, 0);
print "Content-Type: text/plain; charset=Shift_JIS\n\n";
eval { require $pngren::koLibrary; };
if($@)
{
print "エラー・補助ライブラリ ($pngren::koLibrary) が見つかりません。";
return 1;
}
if($logFile && defined($$logFile) && $$logFile ne '')
{
$logName = $$logFile;
$logName =~ s|^.*/||go;
print "ログファイル ($logName) の検査:\n\n・有無は?\t";
if(-e $$logFile)
{
print "ちゃんとあります。\n・読込可能\?\t";
if(-r $$logFile)
{
print "可能\。";
}
else
{
print "エラー・不可能\。要パーミッションの再確認。";
$resultSumL++;
}
print "\n・書込可能\?\t";
if(-w $$logFile)
{
print "可能\。";
}
else
{
print "エラー・不可能\。要パーミッションの再確認。";
$resultSumL++;
}
}
else
{
print 'エラー・ログファイルが見つかりません。';
$resultSumL++;
}
print "\n\n";
}
print "画像ファイルの検査:\n\n";
foreach $pngFile (@$narabi)
{
print "・$pngFile";
$result = &pngren::_CachePNG(\$pngFile, $flags, \$IHDRChunk, $verbose);
$resultSum += $result if($result >= 1);
if($verbose)
{
print "\n\tReturn value: $result\n\tError message: $pngren::errorMessage\n\tResult: ";
}
if($result == 1000)
{
print qq| エラー ($result) ファイルが見つかりません。\n|;
next;
}
elsif($result >= 100 && $result <= 199)
{
print " エラー ($result) PNGではないか、またはデータが壊れています。\n";
next;
}
# 正当なPNGであることは確定。
($width, $height, $bitDepth, $colourType)
= unpack('NNCC', substr($IHDRChunk, 0, 10));
$colourInfo = unpack('N', substr($IHDRChunk, -4));
# IHDRとキャッシュファイルとでは色情報が異なる。
$bFuzoroi++ if($prevCI && $prevCI != $colourInfo);
$prevCI = $colourInfo;
# print ":幅$width×高さ$height×";
# print "($width"."px×$height".'px×';
print '(';
if($colourType == 0 || $colourType == 4)
{
print $bitDepth.'bit階調の';
print 'グレースケール';
}
elsif($colourType == 2 || $colourType == 6)
{
print $bitDepth * 3;
print 'bitのカラー';
}
elsif($colourType == 3)
{
print $bitDepth.'bitの';
print 'パレットカラー';
}
if($colourType & 4)
{
print '+αチャンネル';
}
elsif($colourInfo & 0x400)
{
print '+透過';
}
# print '画像... ';
# print ' ⇒ ';
print ')... ';
if($result <= 0)
{
print 'OK ';
if($result == 0)
{
$cacheSeekoo++;
print '(cached';
}
elsif($result == -1)
{
print '(already cached';
}
elsif($result == -2)
{
$cacheSeekoo++;
print '(cache modified';
}
if($verbose)
{
printf(" as %dbit", ($colourInfo >> 5) & 0x7F8);
}
print ')';
print "\n"
if($verbose
&&
($result == 0 || $result == -2 || ($flags & $pngren::PARSEONLY)));
}
else
{
print "エラー ($result) ";
if($result == 200)
{
print 'インターレースのPNGは連結できません。';
}
elsif($result == 205)
{
print '幅が65536バイト以上あるPNGは連結できません。';
}
elsif($result >= 300 && $result <= 399)
{
print 'IDAT内部のzlibデータが不正です。';
}
elsif($result >= 1000 && $result <= 1099)
{ # 1001はちょっと違うけれど、ここへ制御が来てるなら大丈夫。
print 'キャッシュ書き込みエラー。';
}
else
{
print $pngren::errorMessage;
}
}
print "\n";
}
print "\n・$cacheSeekooファイルのキャッシュ化に成功。\n"
if($cacheSeekoo);
print "\n";
print "結果:\n";
if($logFile && defined($$logFile) && $$logFile ne '')
{
print "\n・ログファイルについて: ";
print $resultSumL ? "エラーが発生しています。" : "問題ありません。";
}
print "\n・画像ファイルについて: ";
if(!($resultSum | $bFuzoroi))
{
print "いずれの画像も問題ありません。";
}
else
{
if($bFuzoroi)
{
print "全体を通して画像の種別が揃っていません。\n それぞれの画像自体には問題ありませんが、カラー画像とグレースケール画像・または\n 透過のある画像とない画像とが混在しているため、このままでは連結できません。\n 画像の種別を揃えた後、再度checkしてみてください。";
}
else
{
print 'エラーが発生しています。';
}
}
print "\n\n";
print ($resultSum | $bFuzoroi | $resultSumL ? '問題が発生しています。' : 'すべて問題ありません。');
print "\n\n";
return $resultSum | $bFuzoroi | $resultSumL;
}
# メイン。
sub Main
{
my($logFile, $suffix, $width, $height, $headers, @gz);
my($errorBangoo, $html) = (0, '');
my(@narabi) = ();
my(%opts) = ();
binmode(STDOUT);
&Option(\$logFile, \%opts);
if($opts{'ver'} || $opts{'version'})
{
print "Content-Type: text/plain; charset=Shift_JIS\n\n$main::version";
return 0;
}
&DirRenketsu($main::gzdir, $opts{'gzdir'});
$logFile = "$main::logdir/$logFile" if($logFile ne '');
if($main::gztype eq 'png')
{
eval { require 'pngren.pl'; };
if($opts{'check'})
{
if($@)
{
print "Content-Type: text/plain; charset=Shift_JIS\n\nPNG連結ライブラリ (pngren.pl) が見つかりません。";
return -1;
}
$pngren::USEMYZLIB = 1;
&Suuzhi(\@narabi, \'', \'');
@gz = map("$main::gzdir$_.png", @narabi);
&Report(\@gz
, $main::wsc ? $pngren::ALLWSCs : $pngren::ALL | $pngren::DEC_BD8
, \$logFile, $opts{'check'} - 1);
return 0;
}
return &Error(-1) if($@);
}
if(&Suuzhi(\@narabi, \$logFile, \%opts))
{
$headers = &OutExpires;
if($opts{'js'})
{ # 少しいろうたらSSIも行けるけどexec cmdやないと引数がもらえん。
($suffix, $width, $height) = split(/,/, $opts{'js'});
$width = 0 if(!defined($width));
$height = 0 if(!defined($height));
if($suffix ne 'text')
{
&DirRenketsu($main::jsdir, $opts{'jsdir'});
$suffix = 'png' if(!$suffix || $opts{'js'} == 1);
$width = $width > 0 ? qq| width="$width"| : '';
$height = $height > 0 ? qq| height="$height"| : '';
foreach(@narabi)
{
$html .= qq{
};
}
}
else
{
foreach(@narabi)
{
$html .= $_;
}
}
print $headers;
print qq|Content-Type: text/javascript\n\n|;
print qq|function _png_counter_$ENV{'REMOTE_PORT'}_()\n{\n|;
print qq|\tdocument.open();\n\tdocument.write('$html');\n|;
print qq|\tdocument.close();\n}\n|;
print qq|_png_counter_$ENV{'REMOTE_PORT'}_();\n|;
}
elsif($main::gztype eq 'png')
{
@gz = map("$main::gzdir$_.png", @narabi);
$headers .= "Content-Type: image/png\n\n";
$errorBangoo = &pngren::PngRen(\@gz
, $pngren::CACHEONLY, $opts{'tate'}, \$headers);
return &Error($errorBangoo) if($errorBangoo);
}
elsif($main::gztype eq 'gif')
{
eval { require 'gifcat.pl'; };
if(!$@)
{
@gz = map("$main::gzdir$_.gif", @narabi);
print $headers;
print "Content-Type: image/gif\n\n";
print &gifcat::gifcat(@gz);
}
else
{
return &Error(-1);
}
}
else
{
return &Error(-1);
}
}
else # ログファイルが読み込めず。
{
return &Error(1);
}
return $errorBangoo;
}
# ここからインド数字版とローマ数字版同期外れ。
# 数字の整形。
sub Suuzhi
{
my($narabi, $logFile, $opts) = @_;
my($kazu, $fusoku);
if($$logFile eq '')
{ # ログファイルが0という名前である可能性を考慮。
push(@$narabi, qw|1 2 3 4 5 6 7 8 9 0|);
return 1;
}
else
{
$kazu = &CountUp($logFile, $opts) - 0;
return 0 if($kazu < 0);
}
# 桁の調整。
$main::keta = $opts->{'keta'} || $main::keta;
if($main::keta)
{
$fusoku = $main::keta - length($kazu);
if($fusoku > 0)
{
$kazu = ('0' x $fusoku).$kazu;
}
}
push(@$narabi, split(//, $kazu));
return 1;
# インド数字版とローマ数字版・再同期点。
}
# カウントアップ。
sub CountUp
{
my($logFile, $opts) = @_;
# ここから通常版と多機能版同期外れ。
my($lockFile, $kazu, $maeAfc, $maeZhikoku, @mae, $nNichimae, $ima, $afc, $higoto, $addr);
# Lockここから。
# $$logFile = $lockFile = "./$main::logdir/$$logFile";
$lockFile = $$logFile;
$main::locktype = 1 if(index($ENV{'SERVER_NAME'}, 'nifty') + 1);
if($main::locktype == 1) # ニフのftp1のflockは使えん。
{
if(!&RenameLock($logFile, \$lockFile)) # Rename lock失敗。別プロセスが
{ # ロックファイルにアクセスしている可能性高し。
$opts->{'mirudake'} = 1;
$main::locktype = -1;
} # -1は後で解除させんため。0ではこの後flockされてしまう。
}
unless(open(LOG, "+<$lockFile"))
{
rename($lockFile, $$logFile) if($main::locktype == 1);
return -1;
}
if($main::locktype == 0){ eval{ flock(LOG, 2); }; }
# Lockここまで。
($kazu, $maeAfc, $maeZhikoku) = split(/\t/, , 4);
($kazu, $higoto) = split(/-/, $kazu, 2);
$ima = time;
(@mae) = split(/-/, $maeZhikoku);
$maeZhikoku = $mae[7] - 0;
$nNichimae = int(($ima + 32400) / 86400) - int(($maeZhikoku + 32400) / 86400);
(@mae) = split(/\//, $higoto, $main::hojiNissuu + 1);
if($nNichimae && $nNichimae < $main::hojiNissuu)
{
unshift(@mae, (0) x $nNichimae);
}
elsif($nNichimae >= $main::hojiNissuu)
{
@mae = (0) x ($main::hojiNissuu);
}
if(!$opts->{'hi'})
{
$addr = $ENV{'REMOTE_ADDR'};
if($main::clevel == 1 && $addr =~ /(\d+\.\d+\.\d+)\.\d+/)
{
$afc = $1.'.*';
}
else
{
$afc = $addr; # if($main::clevel >= 2);
$afc .= '/'.$ENV{'HTTP_X_FORWARDED_FOR'}.'/'.$ENV{'HTTP_CLIENT_IP'}
if($main::clevel >= 3);
}
if(!$opts->{'mirudake'} && ($main::relup || $afc ne $maeAfc || $nNichimae))
{
$mae[0]++;
splice(@mae, $main::hojiNissuu);
$higoto = join('/', @mae);
$kazu++;
truncate(LOG, 0);
seek(LOG, 0, 0);
print LOG "$kazu-$higoto\t$afc\t-------$ima\t\n";
}
}
else
{
$kazu = $opts->{'hi'} - 1;
$main::keta = $main::ketah;
if($kazu < $main::hojiNissuu)
{
$kazu = $mae[$kazu];
}
else
{
$kazu = 0;
}
}
close(LOG);
rename($lockFile, $$logFile) if($main::locktype == 1);
return $kazu;
}
__END__
##--------------------------------------------------------------------
## ■ここから下は削除しても安全です■
##--------------------------------------------------------------------
##
## PNGカウンタ 更新履歴
##
## Version 0.1 (2000/ 2/24)
##
## Version 0.2 (2000/ 2/29) 〜 0.71 (2000/ 9/13)
## 色んなことがありました。
##
## Version 1.0 (2000/10/ 8)
## 大幅な仕様変更。
## pgcの使用をやめ、無圧縮pngを使って画像を連結するように。
##
## Version 1.01 (2000/10/ 9) 〜 1.7 (2004/ 5/30)
## 色んなことがありました。
##
## Version 2.0 (2004/ 6/20)
## 4年ぶりの仕様変更。専用ツールが不要に。
##
## Version 2.0.1 (2004/ 6/22)
## checkオプションを付けてカウンタを呼び出した際、常にログファ
## イルが見つかりませんと表示されてしまう問題を修正。
## 無用の変数が残っていたので削除。
## ライブラリ側の隠し引数入れ替えに伴う修正。
##
## Version 2.0.2 (2004/ 8/ 8)
## ビット深度が16のPNGを8のそれに下げるフラグを付け忘れていたの
## で追加修正。
##
##--------------------------------------------------------------------
##
## カウンタを呼び出す際の書式([]内は省略可):
##
## http://www.dokozo.ne.jp/~darezo/pngcntr.cgi?LOGFILE[;OPTION(s)]
##
##
## LOGFILE
## 数値等を記録しておくログファイル名を指定。必須。
##
## [OPTION(s)]
## 表示オプション。
## ;(セミコロン)で区切ることにより、複数のオプションを指定す
## ることも可能。
## 使用できるオプションは以下の通り。
##
## keta=N
## 数値をN桁で表示する。
## カウンタの値がN桁に満たぬ時は数字の前を0で埋める。
##
## tate
## 画像縦連結指定。
##
## gzdir=SUBDIR
## 一つのカウンタCGIで、複数の数字用画像を切り替えて使いたい時
## 用の設定。
## 連結する数字画像が置かれているサブディレクトリを、このスクリ
## プト冒頭において$gzdir変数で指定されているディレクトリからの
## 相対位置で指定する。つまり、
## $gzdir変数指定のDIR/gzdirオプション指定のSUBDIR/
## にある数字画像 [0-9].(png|gif) が使われる。
##
## hi=N
## hi=1で今日一日の、hi=2で昨日一日のアクセス数が表示される。
## なおhi=3でおとつい、hi=4でその前日……というように、更に遡る
## こともできる。
## 遡れる限度は、このスクリプト冒頭の$hojiNissuuで指定する。
##
## js
## js=IMAGETYPE
## カウンタスクリプトに対して、数字画像を合成したものではなく、
## 「個々の数字画像を直接呼び出すべく、複数のimgタグを貼り付け
## るJavaScript」を送り出してくるよう要求する。
## 例:カウンタの数値が123の時、
## ・このオプション無し:
## 各桁の数字が合成された[123]という1枚の画像が送り出されて
## くる。
## ・このオプション有り:
## 

とい
## うタグを貼り付けるJavaScriptが送られてくる。
## IMAGETYPEは個々の数字画像の拡張子。省略時はpngと見なされる。
##
## jsdir=SUBDIR
## jsオプション使用時において、一つのカウンタCGIで複数の数字用
## 画像セットを切り替えて使いたい時用の設定。
## 要は「$gzdir変数とgzdirオプション」の関係と同じで、0から9ま
## での数字画像が置かれているサブディレクトリを、このスクリプト
## 冒頭において$jsdir変数で指定されているディレクトリからの相対
## 位置で指定する。つまり、
## $jsdir変数指定のDIR/jsdirオプション指定のSUBDIR/
## にある数字画像 [0-9].(png|gif) が使われる。
##
## check
## ログファイルや数字用の画像ファイルがちゃんと使える状態になっ
## ているか、確認するためのオプション。
## 画像を入れ替えた際は、このオプションを付けてカウンタをブラウ
## ザのURL欄から直接呼び出し、調べる必要がある。
##
## mirudake
## その名の通り数値を「見るだけ」で、カウントアップされぬように
## する。
##
##
## オプション指定の例:
## http://〜/pngcntr.cgi?log.dat;tate;gzdir=train
##
## これは、
## trainというサブディレクトリにある数字画像を使い、
## 画像を縦に連結して表示する。
## という指定を意味する。
##
##--------------------------------------------------------------------