#!/usr/local/bin/perl my %SET; $SET{LOG_FILE} = "./log.txt"; $SET{LOTATE_TYPE}=0; $SET{LOTATE_LOG_DIR}="./log"; $SET{MAX_HEADER_LEN_DEF}=256; $SET{MAX_HEADER_LEN}={ 'HOST'=>0, 'CONNECTION'=>0, 'ACCEPT'=>0, "ACCEPT_LANGUAGE"=>0, 'ACCEPT_ENCODING'=>0, 'ACCEPT_CHARSET'=>0, }; $SET{MAX_HEADER_CNT}=10; my $key = "abcd"; my $salt= "aa"; my($rand,$ckid,$udid,$soid,%FORM,%COOKIE,$buff); my @char = (A..Z,a..z,0..9); $rand = join '',map{$char[rand @char]}0..3; $udid = $rand.(substr(crypt("$key$rand",$salt),-4)); $rand = join '',map{$char[rand @char]}0..3; $soid = $rand.(substr(crypt("$key$rand",$salt),-4)); my $time = time; my @t = localtime($time); my $date = sprintf("%02d/%02d(%s)%02d:%02d",++$t[4],$t[3],('“ъ','ЊЋ','‰О','ђ…','–Ш','‹а','“y')[$t[6]],$t[2],$t[1]); my $addr = $ENV{REMOTE_ADDR}; my $host = $ENV{REMOTE_HOST}; for(split ';|\s+',$ENV{HTTP_COOKIE}){ if(m|([^=]*)=(.*)| && $1 eq escape(\$ENV{SCRIPT_NAME})){ for(split ',',$2){ $COOKIE{$1} = unescape(\$2) if m|^([^:]*):(.*)|; } last; } } if(exists $COOKIE{CKID}){ $COOKIE{CKID} = "********" if substr($COOKIE{CKID},4,4) ne substr(crypt(($key.substr($COOKIE{CKID},0,4)),$salt),-4); $ckid = $COOKIE{CKID}; }else{ $rand = join '',map{$char[rand @char]}0..3; $ckid = $rand.(substr(crypt("$key$rand",$salt),-4)); } if($ENV{QUERY_STRING} eq 'idlog'){ if($ENV{REQUEST_METHOD} eq 'POST'){ read STDIN,$buff,$ENV{CONTENT_LENGTH}; my($k,$v); for(split '&',$buff){ if(($k,$v) = m|^([^=]+)=(.*)$|){ $v =~tr|+| |; $v = unescape(\$v); $FORM{$k} = $v; } } if(open FH,"+<$SET{LOG_FILE}"){ for('udid','soid'){ next if $FORM{$_} eq ''; $FORM{$_} = "********" if substr($FORM{$_},4,4) ne substr(crypt(($key.substr($FORM{$_},0,4)),$salt),-4); } $FORM{ss}='?' unless $FORM{ss}=~m|^\d{1,5}x\d{1,5}$|; $buff = ""; while(){ if(m|^(\Q$FORM{time}\E)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t([^\t]*)\t\t\t\t(.*)|){ $buff .= "$1\t$2\t$3\t$4\t$5\t$FORM{udid}\t$FORM{soid}\t$FORM{ss}\t$6\n"; next; } $buff .= $_; } truncate FH,0; seek FH,0,0; print FH $buff; close FH; } } print "Content-Type:text/plain\n\n"; if(open FH,$SET{LOG_FILE}){ while(){ print; } close FH; } }else{ if(open FH,"+<$SET{LOG_FILE}"){ my @h; for(keys %ENV){ next if !m|^HTTP_(.*)| || (exists $SET{MAX_HEADER_LEN}{$1} && $SET{MAX_HEADER_LEN}{$1}==0); last if @h > $SET{MAX_HEADER_CNT}; push @h,sprintf("$1=%s", exists $SET{MAX_HEADER_LEN}? substr($ENV{$_},0,$SET{MAX_HEADER_LEN}): substr($ENV{$_},0,$SET{MAX_HEADER_LEN_DEF})); $h[$#h]=~s|\t| |g; $h[$#h]=~tr|\0-\x1f||d; } $pos=0; for($i=0;$i<7;$i++){ $old[$i] = $time- (($SET{LOTATE_TYPE}==1?$t[2]*3600:0)+$t[1]*60+$t[0])- $i*($SET{LOTATE_TYPE}==1?86400:3600); } while(){ next unless m|^(\d*)|; $pos = tell FH if $1 < $old[0]; next if $1 < $old[6]; last if $1 > $old[0]; while(1){ last if $i < 1; if($1 > $old[$i] && $1 < $old[$i-1]){ unless($fh[$i]){ $fh[$i] = "FH$i"; open $fh[$i],">>$SET{LOTATE_LOG_DIR}/$old[$i].log"; } print {$fh[$i]} $_; last; } $i--; } } seek FH,0,2; if($pos > 0){ opendir DIR,$SET{LOTATE_LOG_DIR}; for(readdir(DIR)){ next if m|^\.\.$|; unlink "$SET{LOTATE_LOG_DIR}/$_" if m|^(\d+)| && $1 < $old[6]; } closedir DIR; seek FH,0,0; open FH2,$SET{LOG_FILE}; seek FH2,$pos,0; while(read FH2,$buff,($pos>4096?4096:$pos)){ print FH $buff; $pos-=4096; } truncate FH,tell FH; close FH2; } print FH sprintf "$time\t$date\t$addr\t$host\t$COOKIE{CKID}\t\t\t\t%s\t\n",join("\t",@h); close FH; } printf "Set-Cookie: %s=CKID:$ckid; expires=%s;\n",escape(\$ENV{SCRIPT_NAME}),rfc1123(time+90*86400); print "Content-type:text/html\n\n"; print <

$pos HTML } sub unescape{ my $s = ${$_[0]}; $s =~s|%([a-f\d]{2})|pack 'H2',$1|ieg; $s; } sub escape{ my $s = ${$_[0]}; $s =~s|(\W)|'%'.unpack 'H2',$1|eg; $s; } sub rfc1123{ my @t = gmtime $_[0]; sprintf "%s, %02d-%s-%04d %02d:%02d:%02d GMT", ('Sat','Mon','Tue','Wed','Thu','Fri','Sat')[$t[6]],$t[3], ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$t[4]], $t[5]+1900,$t[2],$t[1],$t[0]; }