#Please save this file by EUC-code unless you use jperl. package libhuginn; use Socket; require 'jcode.pl'; $agentname = "Huginn DiaryCheck/1.20"; $update = "20001124"; $home = $ENV{HOME}; $DEBUG = "0"; $TIMEOUT = 10; $outputTMZ = "JST"; $innerTMZ = "GMT"; $logfile = "$home/.huginn.log"; $timeDBfile = "$home/.huginnDB"; $rcfile = "$home/.huginnrc"; $resultfile = "$home/.huginnResult.html"; #if you not use LIRS.pm, but you want to read LIRS Data $simpleLIRSsupport = "on"; $gzip = "/bin/gzip"; &initscript(); sub initscript{ local($i); &thistime(); $sock_addr = 'S n a4 x8'; $hostname = '$ENV{HOST}'; ($name,$aliases,$proto) = getprotobyname('tcp'); ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname); $port = 80; %TIMEZONE = ("GMT",0, "UT",0, "EST",-5, "CST",-6, "MST",-7, "PST",-8, "EDT",-4, "CDT",-5, "MDT",-6, "PDT",-7, "A",-1, "B",-2, "C",-3, "D",-4, "E",-5, "F",-6, "G",-7, "H",-8, "I",-9, "K",-10, "L",-11, "M",-12, "N",+1, "O",+2, "P",+3, "Q",+4, "R",+5, "S",+6, "T",+7, "U",+8, "V",+9, "W",+10, "X",+11, "Y",+12, "Z",0, "JST",+9, "ECT",+1, "EET",+2, "ART",+2, "EAT",+3, "MET",+3.5, "NET",+4, "PLT",+5, "IST",+5.5, "BST",+6, "VST",+7, "CTT",+8, "JST",+9, "ACT",+9.5, "AET",+10, "SST",+11, "NST",+12, "MIT",-11, "HST",-10, "AST",-9, "PNT",-7, "IET",-5, "PRT",-4, "CNT",-3.5, "AGT",-3, "BET",-3, "CAT",-1, "+00", 0, "+01", +1, "+02", +2, "+03", +3, "+04", +4, "+05", +5, "+06", +6, "+07", +7, "+08", +8, "+09", +9, "+10", +0, "+11", +11, "+12", +12, "-00", 0, "-01", -1, "-02", -2, "-03", -3, "-04", -4, "-05", -5, "-06", -6, "-07", -7, "-08", -8, "-09", -9, "-10", -10, "-11", -11, "-12", -12, "+0000", 0, "+0030", +0.5, "+0100", +1, "+0130", +1.5, "+0200", +2, "+0230", +2.5, "+0300", +3, "+0330", +3.5, "+0400", +4, "+0430", +4.5, "+0500", +5, "+0530", +5.5, "+0600", +6, "+0630", +6.5, "+0700", +7, "+0730", +7.5, "+0800", +8, "+0830", +8.5, "+0900", +9, "+0930", +9.5, "+1000", +10, "+1030", +10.5, "+1100", +11, "+1130", +11.5, "+1200", +12, "-0000", -0, "-0030", -0.5, "-0100", -1, "-0130", -1.5, "-0200", -2, "-0230", -2.5, "-0300", -3, "-0330", -3.5, "-0400", -4, "-0430", -4.5, "-0500", -5, "-0530", -5.5, "-0600", -6, "-0630", -6.5, "-0700", -7, "-0730", -7.5, "-0800", -8, "-0830", -8.5, "-0900", -9, "-0930", -9.5, "-1000", -10, "-1030", -10.5, "-1100", -11, "-1130", -11.5, "-1200", -12 ); %MONTH = ("Jan",1,"Feb",2,"Mar",3,"Apr",4,"May",5,"Jun",6, "Jul",7,"Aug",8,"Sep",9,"Oct",10,"Nov",11,"Dec",12); $MONTH = "(?:".join('|',keys %MONTH).")"; $TIMEARGS = '$year,$month,$day,$hour,$minute,$second,$timezone'; local(@pattern) =('(?:Sun,|Mon,|Tue,|Wed,|Thu,|Fri,|Sat,) (\d{2}) ($MONTH) (\d{4}) (\d{2}):(\d{2}):(\d{2}) ([^ \)\n\-]+|[+-]\d{4})', '(?:Sunday,|Monday,|Tuesday,|Wednesday,|Thursday,|Friday,|Saturday,) (\d{2})-($MONTH)-(\d{2,4}) (\d{2}):(\d{2}):(\d{2}) ([^ \)\n\-]+|[+-]\d{4})', '(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat) ($MONTH) (\d{1,2}) (\d{2}):(\d{2}):(\d{2}) (\d{4})', '[^\d](\d{4})(?:ǯ|\.|/| )(\d{1,2})(?:|\.|/| )(\d{1,2})[^\d]', '[^\d](\d{2})(?:ǯ|\.|/| )(\d{1,2})(?:|\.|/| )(\d{1,2})[^\d]', '[^\d](\d{1,2})(?:|\.|/| )(\d{1,2})[^\d]'); local(@args) =('$3,$MONTH{$2},$1,$4,$5,$6,$7', '($3<1970)?(2000+$3):($3),$MONTH{$2},$1,$4,$5,$6,$7', '$6,$MONTH{$1},$2,$3,$4,$5,"JST"', '$1,$2,$3,0,0,0,"JST"', '2000+$1,$2,$3,0,0,0,"JST"', '$thisyear,$1,$2,0,0,0,"JST"'); local($els) = ""; $parsescript = 'local($flag)=1;'."\n"; for($i=0;defined($pattern[$i]);$i++){ $parsescript .= $els."if(m%$pattern[$i]%)"; $parsescript .= "{($TIMEARGS) = ($args[$i]);}\n"; $els = "els"; } $parsescript .= "else{\$flag = 0;}\n"; $parsescript .= '$time = &convTMZ($year,$month,$day,$hour,$minute,$second,$timezone) if($flag != 0);'." \n"; } sub setCheckMode{ local($_) = @_; $checkmode = $_; } sub openLOG{ open(LOG,">$logfile"); } sub closeLOG{ close(LOG); } sub readRCfile{ open(COM,"$rcfile"); while(){ undef(%value); #parse rc-file line if(/^\#/){next;} &resolveRCMacro(*_); while(s/^(.*?)="(.*?[^\\])"\s*//){$value{$1} = "$2";} #do each command-param if(defined $value{"useraddress"}){ $useraddress = $value{"useraddress"}; } if(defined $value{"remote"}){ push(@remotelist,$value{"remote"}); if(defined $value{"type"}){ $agent_data_type{$value{"remote"}} = $value{"type"}; } if(defined $value{"sig"}){ $agent_sig{$value{"remote"}} = $value{"sig"}; } } if(defined $value{"ref"}){ push(@outlist,$value{"ref"}); if(defined $value{"title"}){ $title{$value{"ref"}}=$value{"title"}; }else{ $title{$value{"ref"}}=$value{"ref"}; } } if(defined $value{"logfile"}){$logfile = $value{"logfile"};} } } sub readtimeDB{ local($count,$_); open(DB,"$timeDBfile"); $count = 0; while(){ chop; ($time,$method,$url) = split("\t"); $url[$count] = $url; $whatmethod{$url} = $method; $timeDB{$url} = $time; $count++; } close(DB); } sub writetimeDB{ local($count,$_); open(DB,">$timeDBfile"); foreach $url(keys %timeDB){ print DB $timeDB{$url}."\t".$whatmethod{$url}."\t".$url."\n"; } close(DB); } sub mergeTimeDB{ foreach $url (keys %newtimeDB){ if($newtimeDB{$url} > $timeDB{$url}){ print LOG "renew timeDB: $url,$newtimeDB{$url}\n"; $timeDB{$url} = $newtimeDB{$url}; $whatmethod{$url} = $newwhatmethod{$url}; } } } sub RemoteCheck{ foreach $url (@remotelist){ &REMOTE($url); } } sub nonRemoteCheck{ foreach $url (@outlist){ if(defined($newtimeDB{$url})){ print LOG "use REMOTE data: $url\n"; print STDERR "use REMOTE data: $url\n"; }else{ $stat = &HEAD($url); &GET($url) if($stat != 404 && !defined($newtimeDB{$url})); $timeDB{$url} = "00000000000000" if(!defined($newtimeDB{$url})); } } } sub output{ local(%output,$output); foreach $url (@outlist){ $time = convTMZ($timeDB{$url},'JST'); $time =~ /\d{4}(\d{2}\d{2}\d{2}\d{2})\d{2}/; $query = $1; $output{"$time$url"} = "
  • ".&reformTIME($time).&outputMethodType($url) .qq!$title{$url}
  • \n!; } $output = ' Diary Checker Result '; open(RESULT,">$resultfile"); print RESULT $output; close(RESULT); } sub outputMethodType{ local($url) = @_; local($result); $_ = $whatmethod{$url}; if (/remote/i){$result="(r)";} elsif(/head/i ){$result="(h)";} elsif(/get/i ){$result="(g)";} elsif(/unknown/i){$result="(?)";} return $result; } sub HEAD{ local($url) = @_; local($_,$method,$time,$stat,$text,@text); $method = "HEAD"; print LOG "HEAD getting: $url ..."; print STDERR "HEAD getting: $url ..."; $text = &HTTPrequest($url,$method); normal_text(*text); @text = split("\n",$text); $_ = shift(@text);/(\d\d\d)/;$stat = $1; foreach (@text){ if(/^Last-Modified:/i){ eval $parsescript; $newtimeDB{$url} = $time; $newwhatmethod{$url} = "head"; last; } } return $stat; } sub GET{ local($url) = @_; local($_,$method,$time); $method = "GET";$newtimeDB{$url} = 0; print LOG "GET getting: $url ..."; print STDERR "GET getting: $url ..."; $text = &HTTPrequest($url,$method); normal_text(*text); &thistime(); foreach (split("\n",$text)){ eval $parsescript; if($time < $thistime && $time > $newtimeDB{$url}){ $newtimeDB{$url}=$time; $newwhatmethod{$url} = "get"; } } return; } sub REMOTE{ local($href) = @_; local($_,$text,$method,$url,$time); local($year,$month,$day,$hour,$minute,$second,$timezone); print LOG "REMOTE getting: $href ..."; print STDERR "REMOTE getting: $href ..."; $method = "GET"; $text = &HTTPrequest($href,$method); if($agent_data_type{$href} eq "LIRS"){ resolveLIRS($text); }else{ normal_text(*text); &resolveHINATXT($text); } } sub resolveHINATXT{ local($text) = @_; foreach (split("\n",$text)){ if(m%%i){ ($year,$month,$day,$hour,$minute,$second,$timezone) = ($1,$2,$3,$4,$5,0,'JST'); $time = &convTMZ($year,$month,$day,$hour,$minute,$second,$timezone); //i;$url = $1; if($DEBUG == 1){ printf("resolveHINATXT: $time\n"); } if($time > $newtimeDB{$url}){ $newtimeDB{$url} = $time; $newwhatmethod{$url} = "remote"; } } } } sub resolveLIRS{ local($text) = @_; open(GZIP,"| $gzip -d >tmp$$"); print GZIP $text; close(GZIP); $text = ""; open(GZIP,"tmp$$"); while(){$text .= $_;} close(GZIP); unlink("tmp$$"); local($time); foreach (split("\n",$text)){ # LIRS LM LD TMZ CLeng URL Title owner agent if(m%^LIRS,(\d+),(\d+),(\d+),(\d+),(.*?),(.*?),(.*?),(.*?),(.*)$%){ local($LM,$LD,$TMZ,$leng,$url,$title,$owner,$agent,$expand) = ($1,$2,$3,$4,$5,$6,$7,$8,$9); $time = USTtoHuginn($LM); if($DEBUG == 1){ printf("resolveLIRS: $time\n"); } if($time > $newtimeDB{$url}){ $newtimeDB{$url} = $time; $newwhatmethod{$url} = "remote"; } } } } sub HTTPrequest{ local($url,$method) = @_; $url =~ m%http://(.*?)(/.*/)(.*)%; local($serv,$dir,$file) = ($1,$2,$3); local($path) = $dir.$file; local ($text); $req_str = "$method $path HTTP/1.1\r\n"; $req_str .= "Connection: close\r\n"; $req_str .= "User-Agent: $agentname\r\n"; $req_str .= "From: $useraddress\r\n"; $req_str .= "Host: $serv\r\n"; $req_str .= "\r\n"; eval{ $SIG{'ALRM'} = 'timeout';sub timeout{ die "timeout";} ($name,$aliases,$port) = getservbyname($port,'tcp') unless $port =~/^\d+$/;; ($name,$aliases,$type,$len,$thataddr) = gethostbyname($serv); eval{alarm(0);}; }; if($@ ne ""){print LOG $@;print STDERR $@;return} $that = pack($sock_addr,&AF_INET,80,$thataddr); $this = pack($sock_addr,&AF_INET,0,$thisaddr); eval{ $SIG{'ALRM'} = 'timeout';sub timeout{ die "timeout";} eval{ alarm($TIMEOUT);}; socket(S,&PF_INET,&SOCK_STREAM,$proto)||die "cannot get a socket"; bind(S,$this) ||die "cannot bind socket"; connect(S,$that) ||die "cannot connect socket"; local($oldselect) = select;select(S);$| = 1; print S $req_str; select($oldselect); if($method eq "GET"){while(){if(/^\015\012$/){last;}}} while(){ $text .= $_; } close(S); eval{alarm(0);}; }; if($@ ne ""){close(S);print LOG $@;print STDERR $@;} else{print LOG "done.\n";print STDERR "done.\n";} return $text; } sub thistime{ ($thissecond,$thisminute,$thishour,$thisday,$thismonth, $thisyear,$thiswday,$thiswyear,$thisstime) = gmtime;$thismonth++; ($thislocalsecond,$thislocalminute,$thislocalhour,$thislocalday, $thislocalmonth,$thislocalyear,$thislocalwday,$thislocalwyear, $thislocalstime) = localtime;$thislocalmonth++; if($thisyear < 1970){$thisyear += 1900;} $thistime = sprintf("%04d%02d%02d%02d%02d%02d", $thisyear,$thismonth,$thisday, $thishour,$thisminute,$thissecond); $thislocaltime = sprintf("%04d%02d%02d%02d%02d%02d", $thislocalyear,$thislocalmonth,$thislocalday, $thislocalhour,$thislocalminute,$thislocalsecond); } sub normal_text{ local(*_) = @_; &jcode::convert(*_,"euc"); s/\015\012/\012/g; s/\015/\012/g; s/\012$/\n/g; s//1/g; s//2/g; s//3/g; s//4/g; s//5/g; s//6/g; s//7/g; s//8/g; s//9/g; s//0/g; } sub convTMZ{ local($time,$wday,$wyear,$stime); local($year,$month,$day,$hour,$minute,$second,$timezone,$targetzone); if(scalar(@_) == 2){ ($time,$targetzone) = @_; $time =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/; ($year,$month,$day,$hour,$minute,$second,$timezone) = ($1,$2,$3,$4,$5,$6,$innerTMZ); }else{ ($year,$month,$day,$hour,$minute,$second,$timezone,$targetzone) = @_; $targetzone = $innerTMZ if(!defined($targetzone)); } if($DEBUG == 1){ printf("convTMZ: %04d%02d%02d%02d%02d%02d\n" ,$year,$month,$day,$hour,$minute,$second); } local(@DAYOFMONTH) = (31,28,31,30,31,30,31,31,30,31,30,31); if($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)){ @DAYOFMONTH = (31,29,31,30,31,30,31,31,30,31,30,31); } # $time means days $time = $year * 365 + int($year/4) - int($year/100) + int(year/400); $time -= 719523;# days since 1970; $month--;for($i = 0;$i < $month;$i++){$time += $DAYOFMONTH[$i];} $time += $day-1; # $time means hours $time *= 24;$time += $hour; $time += ($TIMEZONE{$targetzone} - $TIMEZONE{$timezone}); # $time means minutes $time *= 60;$time += $minute; # $time means seconds(UNIX standard time) $time *= 60;$time += $second; ($second,$minute,$hour,$day,$month,$year,$wday,$wyear,$stime) = gmtime($time);$month++; if($year < 1970){$year += 1900;} if($DEBUG == 1){ printf("convTMZ: %04d%02d%02d%02d%02d%02d\n" ,$year,$month,$day,$hour,$minute,$second); } return sprintf("%04d%02d%02d%02d%02d%02d" ,$year,$month,$day,$hour,$minute,$second); } sub USTtoHuginn{ local($time) = @_; local($second,$minute,$hour,$day,$month,$year,$wday,$wyear,$stime) = gmtime($time);$month++; if($year < 1970){$year += 1900;} return sprintf("%04d%02d%02d%02d%02d%02d" ,$year,$month,$day,$hour,$minute,$second); } sub reformTIME{ local($time) = @_; $time =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/; return sprintf("%04d %02d/%02d %02d:%02d:%02d",$1,$2,$3,$4,$5,$6); } sub resolveRCMacro{ # ### You can Customize RCfile's Macro at here. # local(*_) = @_; s/(?=[^\\])%2y/sprintf("%02d",($thisyear % 100))/eg; s/(?=[^\\])%y/sprintf("%d",$thisyear)/eg; s/(?=[^\\])%m/sprintf("%d",$thismonth)/eg; s/(?=[^\\])%0m/sprintf("%02d",$thismonth)/eg; s/(?=[^\\])%d/sprintf("%d",$thisday)/eg; s/(?=[^\\])%\[(.*)\]/$1/eeg; s/(?=[^\\])%\((.*)\)/$1/eeg; s/(?=[^\\])%\{(.*)\}/$1/eeg; } 1;