#!/usr/local/bin/perl ################################################################################ # 高機能アクセス解析CGI Standard版(アクセスログ ロギング用) # Ver 4.0.0 # Copyright(C) futomi 2001 - 2007 # http://www.futomi.com/ ############################################################################### use strict; BEGIN { use FindBin; if($FindBin::Bin && $FindBin::Bin ne "/") { push(@INC, "$FindBin::Bin/lib"); chdir $FindBin::Bin; } else { push(@INC, "./lib"); } } use Time::Local; use CGI; use CGI::Carp qw(fatalsToBrowser); $| = 1; &main; sub main { require './conf/config.cgi'; my $c = &config::get; #フリーサーバのドメインリスト(正規表現) $c->{FREE_SERVER_NAME} = '\.tok2\.com|\.infoseek\.co\.jp|\.xrea\.com'; # my $q = new CGI; # Remote host my $remote_host = &get_remote_host; # 指定ホストからのアクセスを除外する if(@{$c->{REJECT_HOSTS}}) { my $reject_flag = 0; for my $reject (@{$c->{REJECT_HOSTS}}) { if($reject =~ /[^0-9\.]/) { # ホスト名指定の場合 if($remote_host =~ /\Q${reject}\E$/) { $reject_flag = 1; last; } } else { # IPアドレス指定の場合 if($ENV{'REMOTE_ADDR'} =~ /^\Q${reject}\E/) { $reject_flag = 1; last; } } } if($reject_flag) { &print_image; exit; } } # my $now = time + $c->{TIMEDIFF}*3600; my $timestamp = &get_timestamp($now); my $ymd = substr($timestamp, 0, 8); my $logfile = $c->{LOG}; if($c->{LOTATION} == 2) { $logfile .= "\.${ymd}\.cgi"; } elsif($c->{LOTATION} == 3) { my $mon = substr($timestamp, 0, 6); $logfile .= "\.${mon}".'00.cgi'; } else { $logfile .= "\.cgi"; } # Access Log Lotation if($c->{LOTATION}) { &log_lotation($c, $ymd, $logfile); } # my %logdata; $logdata{remote_host} = $remote_host; # Remote user $logdata{remote_user} = &get_remote_user; # The date and time of the request $logdata{date} = $timestamp; # Requested URI $logdata{request} = &get_request($q); # HTTP_REFERER $logdata{referrer} = &get_referrer; # Screen ($logdata{screen_width}, $logdata{screen_height}, $logdata{color_depth}) = &get_screen_info($q); # Make Log String my $log_string = &get_log_string(\%logdata); # Loging # &loging($logfile, $log_string); &loging($logfile, $log_string, $c->{PAGEVIEW}); # Modify by Umeda 2008/5/13 # Print Image to the Client &print_image($c); } exit; ###################################################################### # Subroutine ###################################################################### # Print Image to the Client sub print_image { my($c) = @_; my $ua = $ENV{'HTTP_USER_AGENT'}; my $mime_type = 'image/gif'; my $image_file = "./conf/acclogo.gif"; if($ua =~ /^(J\-PHONE|Vodafone|Softbank)/i) { $mime_type = 'image/png'; $image_file = "./conf/acclogo.png"; } elsif($ua =~ /UP\.Browser/) { $mime_type = 'image/jpeg'; $image_file = "./conf/acclogo.jpg"; } my $logo_size = -s $image_file; open(IMAGE, "<${image_file}") or &error("${image_file}をオープンできませんでした。: $!"); binmode(IMAGE); my $data; sysread IMAGE, $data, $logo_size; close IMAGE; print "Pragma: no-cache\n"; print "Cache-Control: no-cache\n"; print "Content-Type: ${mime_type}\n"; if($ENV{SERVER_NAME} !~ /($c->{FREE_SERVER_NAME})/) { print "Content-Length: ${logo_size}\n"; } print "\n"; print $data; exit; } sub get_screen_info { my($q) = @_; my $width = $q->param('width'); my $height = $q->param('height'); my $color = $q->param('color'); my $ua = $ENV{HTTP_USER_AGENT}; if($ua =~ /(J\-PHONE|Vodafone|Softbank)/i) { if($ENV{HTTP_X_JPHONE_DISPLAY} && $ENV{HTTP_X_JPHONE_COLOR}) { ($width, $height) = split(/\*/, $ENV{HTTP_X_JPHONE_DISPLAY}); my $jcolor = $ENV{HTTP_X_JPHONE_COLOR}; $jcolor =~ s/^[^0-9]+//; $color = log($jcolor) / log(2); } } elsif($ua =~ /(KDDI|UP\.Browser)/i) { if($ENV{HTTP_X_UP_DEVCAP_SCREENDEPTH} && $ENV{HTTP_X_UP_DEVCAP_SCREENPIXELS}) { ($width, $height) = split(/,/, $ENV{HTTP_X_UP_DEVCAP_SCREENPIXELS}); ($color) = split(/,/, $ENV{HTTP_X_UP_DEVCAP_SCREENDEPTH}); } } elsif($ua =~ /^PDXGW\/[0-9\.]+\s*\(([^\)]+)\)/) { #PDXGW/1.0 (TX=8;TY=7;GX=96;GY=84;C=C256;G=BF;GI=2) my $tmp = $1; my @devinfos = split(/;/, $tmp); for my $key (@devinfos) { my($name, $value) = split(/=/, $key); if($name eq 'GX') { $width = $value; } elsif($name eq 'GY') { $height = $value; } elsif($name eq 'C') { if($value eq 'CF') { $color = '16'; } elsif($value eq 'C256') { $color = '8'; } elsif($value eq 'C4') { $color = '2'; } elsif($value eq 'G2') { $color = '1'; } else { $color = ''; } } } } return $width, $height, $color; } sub loging { # my($log_file, $string) = @_; my($log_file, $string, $pageview) = @_; # Modify by Umeda 2008/5/13 open(LOGFILE, ">>${log_file}") || &error("ログファイルの書き込みに失敗しました。ディレクトリ「logs」のパーミッションを777にしてください。パーミッションを変更したら、ディレクトリ「logs」内にあるファイルをすべて削除してから、再度ブラウザーで acclog.cgi にアクセスしてみて下さい。: $!"); if(&lock(*LOGFILE)) { &error("ログファイルのロック処理に失敗しました。 : $!"); } print LOGFILE "${string}\n"; close(LOGFILE); # Added by Umeda 2008/5/13 if ($pageview ne '') { my $COUNT = $ENV{'DOCUMENT_ROOT'} . "/../count/" . $pageview . ".dat"; my $LOCK = $ENV{'DOCUMENT_ROOT'} . "/../count/" . $pageview . ".lock"; my $retry = 5; if (-e $LOCK) { my $mtime = (stat($LOCK))[9]; if ($mtime < time - 60) { unlink($LOCK); } } while (!symlink(".", $LOCK)) { if (--$retry <= 0) { &error("ロックエラーです。$!"); } sleep(1); } if (-e "$COUNT") { } else { open(COUNTFILE, ">$COUNT") || &error("カウントファイルをオープンできませんでした。$!"); print COUNTFILE "0\n"; close(COUNTFILE); } open(COUNTFILE, "$COUNT") || &error("カウントファイルをオープンできませんでした。$!"); my $cnt = ; close(COUNTFILE); $cnt++; open(COUNTFILE, ">$COUNT") || &error("カウントファイルをオープンできませんでした。$!"); print COUNTFILE "$cnt\n"; close(COUNTFILE); unlink($LOCK); } # End Add } sub get_log_string { my($p) = @_; my $log; $log .= "$p->{date} $p->{remote_host} - $p->{remote_user} $p->{request} $p->{referrer}"; $log .= " \"$ENV{'HTTP_USER_AGENT'}\""; if($ENV{HTTP_ACCEPT_LANGUAGE} eq '') { $log .= " \"-\""; } else { $log .= " \"$ENV{HTTP_ACCEPT_LANGUAGE}\""; } if($p->{screen_width} && $p->{screen_height} && $p->{color_depth}) { $log .= " \"$p->{screen_width} $p->{screen_height} $p->{color_depth}\""; } else { $log .= " \"-\""; } return $log; } sub get_referrer { my @query_parts = split(/&/, $ENV{QUERY_STRING}); my $referrer; my $part; my $flag = 0; for $part (@query_parts) { if($part =~ /^(width|height|color)=/i) { $flag = 0; } if($part =~ /^referrer=/i) { $flag = 1; } if($flag) { $part =~ s/^referrer=//; $referrer .= "$part&"; } } $referrer =~ s/&$//; if($referrer eq '') { $referrer = '-'; } $referrer =~ s/\%7e/\~/ig; return $referrer; } sub get_timestamp { my($time) = @_; my($sec, $min, $hour, $mday, $mon, $year) = localtime($time); $year += 1900; $mon += 1; $mon = sprintf("%02d", $mon); $mday = sprintf("%02d", $mday); $hour = sprintf("%02d", $hour); $min = sprintf("%02d", $min); $sec = sprintf("%02d", $sec); return "${year}${mon}${mday}${hour}${min}${sec}"; } sub lock { local(*FILE) = @_; eval{flock(FILE, 2)}; if($@) { return $!; } else { return ''; } } sub get_request { my($q) = @_; my $request = $q->param('url'); unless($request) { if($ENV{HTTP_REFERER} eq '') { $request = '-'; } else { $request = $ENV{HTTP_REFERER}; } } $request =~ s/\%7e/\~/ig; return $request; } sub get_remote_user { my $remote_user; if($ENV{REMOTE_USER} eq '') { $remote_user = '-'; } else { $remote_user = $ENV{REMOTE_USER}; } return $remote_user; } sub get_remote_host { my $remote_host; if($ENV{REMOTE_HOST} =~ /[^0-9\.]/) { $remote_host = $ENV{REMOTE_HOST}; } else { my(@addr) = split(/\./, $ENV{REMOTE_ADDR}); my($packed_addr) = pack("C4", $addr[0], $addr[1], $addr[2], $addr[3]); my($aliases, $addrtype, $length, @addrs); ($remote_host, $aliases, $addrtype, $length, @addrs) = gethostbyaddr($packed_addr, 2); unless($remote_host) { $remote_host = $ENV{REMOTE_ADDR}; } } return $remote_host; } sub log_lotation { my($c, $ymd, $logfile) = @_; my $log_size = -s $logfile; if($c->{LOTATION} == 1) { if($log_size > $c->{LOTATION_SIZE}) { if($c->{LOTATION_SAVE}) { my $f = $logfile; $f =~ s/\.cgi//; if(-e "${f}.${ymd}.cgi" || -e "${f}.${ymd}.0.cgi" ) { for( my $i=1; $i<=100; $i++ ) { my $fpath = "${f}\.${ymd}\.${i}\.cgi"; unless(-e $fpath) { rename($logfile, $fpath); if(-e "${f}.${ymd}.cgi") { rename("${f}.${ymd}.cgi", "${f}.${ymd}.0.cgi"); } last; } } } else { rename($logfile, "${f}\.${ymd}\.cgi"); } } else { unlink($logfile); } } } elsif($c->{LOTATION} == 2 || $c->{LOTATION} == 3) { unless($c->{LOTATION_SAVE}) { my @parts = split(/\//, $logfile); my $logname = pop @parts; my($logname_key) = split(/\./, $logname); my $logdir = join('/', @parts); if(opendir(DIR, "$logdir")) { my @files = readdir(DIR); closedir(DIR); my $file; for $file (@files) { if($file eq $logname) { next; } if($file =~ /^$logname_key/) { unlink("$logdir/$file"); } } } } } } sub error { my($msg) = @_; my $html; $html .= "\n"; $html .= "\n"; $html .= "\n"; $html .= "\n"; $html .= "エラー\n"; $html .= "\n"; $html .= "

${msg}

"; $html .= ""; print "Content-Type: text/html; charset=utf-8\n"; print "\n"; print $html; exit; }