#!/usr/local/bin/perl
#### ◇WDB用ライブラリ 「WDBLIB」 V2.10
#### Copyright 1999-2004 GORRY.
#### mailto: gorry@hauN.org
####
#### History:
#### 2004/07/24 V2.10 ・RSSの読み込みに対応。
#### 2003/01/02 V2.09 ・"User-Agent:"で始まる行を発見したとき、自動的にDI解析モードに
#### 移行するようにした。
#### 2002/07/24 V2.08 ・Expiresが空のリモート情報を受け取ったときに、補完するようにした。
#### が、取り消し。
#### 2001/12/09 V2.07 ・リモートでhina-diを読み込んだとき、Hina-Versionを書き換えて
#### しまうバグを修正。
#### ・If-Modified-Since:に対応。
#### ・リクエスト時にAccept-Encoding: gzip, x-gzipを付けるようにした。
#### ・gif・jpeg・pngのイメージサイズを取得できるようにした。
#### 2001/11/28 V2.06 ・Virtualで取得したHTMLからメタ情報収集を行わないようにした。
#### ・hina.diにhina-2.2beta準拠全フィールドを出力するようにした。
#### ・hina.diの読み込み時にLast-Modified-Detectedフィールドがない
#### 場合、他から値を補完していた機能を削除した。
#### 2001/11/14 V2.05 ・認識時刻フォーマット追加。
#### "MM/DD_hh:mm:ss"(1月23日 16時56分07秒)
#### 2001/11/09 V2.04 ・WDBファイルの行が"COMMENT:"など(":"のあとに空白がない)に
#### なっていると誤動作するバグを修正。
#### ・http HEADERに存在するTitle:・Author:に対応。
#### 2001/09/11 V2.03 ・Perl4対応修正。(thanks to SARUMARU)
#### ・認識時刻フォーマット追加。(thanks to SARUMARU)
#### "YYYY/MM/DD_hh:mm_PM" (2001/01/23 4:56PM)
#### "YYYY/MM/DD_PM_hh:mm"(2001年1月23日 午後4時56分)
#### "MM/DD_hh:mm_PM" (01/23 4:56PM)
#### "MM/DD_PM_hh:mm"(1月23日 午後4時56分)
#### "MM/DD_PM_hh:"(1月23日 午後4時)
#### "MM/DD_hh:"(1月23日 16時)
#### 2001/07/11 V2.02 ・WDBファイルのパラメータに": "が入っているとそれ以降の文字列が切れるバグを修正。
#### 2001/05/17 V2.01 ・GETで採ったドキュメントに"^HINA/2.[0-9]$"がある場合の
#### hina.di処理時に、既存情報をクリアしないバグを修正。
#### 2000/10/17 V2.00 ・朝日奈アンテナ meta data format version 2.2 (HINA/2.2) document 0.9に準拠。
#### ・従来のLast-Modified-Detectedの役目「現在の更新時刻を最初に検知した時刻」を
#### X-First-Modified-Detectに移行させ、Last-Modified-Detectedは
#### 「最後に更新時刻を確認した時刻」とした。
#### ・X-No-Time-In-ContentsをX-LM-Is-FMDに移行。
#### 2000/09/24 V1.16 ・GETで採ったドキュメントに"^HINA/2.[0-9]$"がある場合、
#### hina.diであるとみなして処理するように変更。
#### ・"Expires:"を処理・出力するよう変更。
#### 2000/08/03 V1.16 ・hauNikki独自処理を廃止、代わりに"URL: "があるファイルを
#### hina.diであるとして認識するように変更。
#### 2000/05/25 V1.15 ・X-WDB-Title・X-WDB-Author-Nameを出力するよう変更。
#### ・GETしたものについて、
・を
#### 解析してTitle・Author-Nameを抽出するよう変更。
#### 2000/05/22 V1.15 ・$HTTP_REMOTE_TIMEOUTを追加。
#### 2000/03/14 V1.15 ・hina.diのparse時に、nodelistを捨て損なうために前ブロックの
#### データを持ち越してしまうことがあるバグを修正。
#### 2000/01/12 V1.14 ・Purveyor("Purveyor / v1.2 Windows NT")をクエリ不可
#### httpdとして追加。
#### 2000/01/05 V1.13 ・"1-Jan-0"形式の日付に対応。
#### ・"2000年 01月 06日"のような日付を読みとれるよう修正。
#### 2000/01/03 V1.12 ・HINA/2.1に対応。
#### 1999/12/31 V1.11 ・1999/12/31を2000/01/01と誤認するバグを修正。
#### 1999/11/04 V1.10 ・URIのポート番号を認識しないバグを修正。
#### 1999/09/29 V1.09 ・V1.08での
#### ・「1980/01/01 00:00:00 GMT」の時刻データを無視するよう変更。
#### を元に戻したうえで、新たに作業をし直した。
#### ・圧縮diに対応。
#### 1999/09/27 V1.08 ・検索結果行に更新時刻が検知されなかったとき、次の行の
#### 調査を行なわないバグを修正。
#### ・年号のない更新日を去年と判定するバグを修正。
#### ・Print_HINATXT()・Print_HINADI()において、
#### 自己取得したデータのみを出力するモードを追加。
#### ・「1980/01/01 00:00:00 GMT」の時刻データを無視するよう変更。
#### ・OVERALLモードに「uniqする/しない」モードを新設。
#### 1999/09/22 V1.07 ・タイムゾーンの判定を誤ることがあったのを修正。
#### ・HINA_TXTの出力がすべて"HINA_OK"になるバグを修正。
#### ・HEAD/GET失敗時にLast-Modifiedをクリアしないように変更。
#### 1999/09/15 V1.06 ・gmtime()・localtime()の$yearが年でなく「1900年からの
#### 経過年数」であることに起因するY2K問題に対処。
#### ・タイムゾーンの"+0030"の項を修正。
#### ・X-No-Time-In-Contentsは"0"でないときのみ出力するよう変更。
#### 1999/09/10 V1.05 ・splitの":[ \t]+"をsplitの":[ \t]*"に変更。
#### ・BuildRemoteDI()・BuildDirectDI()の引数処理ミスを修正。
#### ・hina.diのヘッダに"Date:"・"Content-Type:"を出力するようにした。
#### ・検索キーに".*"を付けたときに正しく切り取らないバグを修正。
#### ・HEAD取得の時の検索キーを"Last-Modified:"(case insensitive)に
#### 変更した。
#### ・Last-Modified-Detectedあたりの判定を変更。
#### 1999/09/07 V1.04 ・fragmentを含んだURIを正しく処理しないバグを修正。
#### ・%dance$$.downは存在時のみ削除するよう変更。
#### ・hina.diの判定をcase insensitiveに変更。
#### ・REMOTEでの「Authorized-url:」判定を外した。
#### つまり、REMOTEは外部をアクセスしない。
#### ・ExtractNormalURI()はURIが2つ以上含まれる場合に最右でなく最左を
#### 取り出すようにした。
#### ・$EXTRACTTIMEFORMATに、最後に変換した時刻フォーマットを
#### 残すようにした。これがX-Time-Formatに記録される。
#### ・年号なしの日付を更新時刻として採れるようにした。
#### ・検索キーに".*"を付け、前後を切り取れるように変更。
#### ・512バイト以上の行は分割してキー検索するよう変更。
#### ・タイムゾーンを追加。
#### 1999/08/27 V1.03 ステータス-200が出るべきときに出ないバグを修正。
#### ターゲット取得でタイムアウトになったときも更新時刻検索を
#### 行なうよう変更。
#### %dance.downへのロードを%dance$$.downへ行なうよう変更。
#### DEBUGOUTを開く位置を変更、CloseDebugFile)を追加。
#### hauNikki DI対応。
#### 1999/08/26 V1.02 負の値となる日付が出力されるバグを修正。
#### 1999/08/23 V1.01 hina.txtからリモート取得したときにX-No-Time-In-Contentsが
#### 強制的に削除されるのを「updateが検出されたときのみ削除」に
#### 変更。
#### hina.txtのExpire:をhina.txtそのものの更新時刻から導くよう
#### 仕様追加。
#### タイムアウトのエラー検出ミスを修正。
#### -200を「更新時刻が検知できない」エラーとして規定、hina.txtに
#### ""を出力する。
#### 1999/08/22 V1.00 公開。
#### 1999/07/07 V0.14 GET/HEAD失敗時にリモート情報を復活させる処理を修正。
#### Last-Modified-Detectedを追加。
#### X-No-Time-In-Contentsを追加。コンテンツには更新時刻情報が
#### 含まれず、Last-Modified-DetectedをLast-Modifedの代わりに
#### 使うべきであることを"1"で示す。
#### 1999/06/29 V0.13 method指定がない場合にGET取得になってしまっていたのを
#### HEAD取得に戻す。
#### 1999/06/28 V0.12 年月日だけのGETに対応。
#### 1999/06/16 V0.11 GET2・HEAD2を新設。
#### 内部処理では秒データを保存し、出力時にカットするよう修正。
#### hina.diの出力時刻フォーマットに秒を追加。
#### 1999/05/07 V0.10 Overallモード新設。
#### Host:が間違っていたのを修正。
#### DI情報のURIに"?"が含まれているときの不都合回避。
#### 1999/04/26 V0.09 Zone以降の余計な文字を落とし忘れるバグを修正。
#### 1999/04/25 V0.08 デバッグプリントの最適化。
#### 1999/04/22 V0.07 DI情報出力のMethodを複数結果出力対応。
#### HOP数出力対応。
#### 1999/04/21 V0.06 引数解析の"<>"置換をやめた。
#### カレンダー解釈方法を修正。
#### DI情報が読めないバグを修正。
#### HINA.TXTの"";
$lastmod =~ s%\d\d\d\d/(\d\d)/(\d\d) (\d\d):(\d\d)%\?$1$2$3$4%;
$server = $DP{$DPL[$i],"Server"};
if ( ( $server =~ /CERN/ ) ||
( $server =~ /Microsoft-Internet-Information-Server/ ) ||
( $server =~ m%Netscape-Communications/1.1$% ) ||
( $server =~ m%Netscape-Enterprise/3.0$% ) ||
( $server =~ /Purveyor/ ) ||
( $server =~ /IBM-ICS/ ) ) {
$lastmod = "";
print HINAOUT "";
}
} else {
$lastmod = "";
if ( $a == 404 ) {
print HINAOUT "";
} elsif ( $a == -100 ) {
print HINAOUT "";
} elsif ( $a == -101 ) {
print HINAOUT "";
} elsif ( $a == -200 ) {
print HINAOUT "";
} elsif ( $a == -300 ) {
print HINAOUT "";
} else {
print HINAOUT "";
}
}
$href = $DP{$DPL[$i],"URI"};
if ( $href =~ /#/ ) {
$href =~ s/(.*)#(.*)/$1$lastmod#$2/;
} else {
$href .= "$lastmod";
}
$title = $DP{$DPL[$i],"TITLE"};
print HINAOUT "$title\n";
}
close( HINAOUT );
}
########################################################################
### HINA.DI出力
## Print_HINADI()
#
sub Print_HINADI
{
local( $onlyorigdata ) = shift;
local( $i );
local( $cmdname );
local( $data );
return if ( $DIOUT eq "" );
print DEBUGOUT "Print_HINADI\n" if ($DEBUG);
open( DIOUT, ">$DIOUT" );
print DIOUT "$HINA_VER\n";
print DIOUT "User-Agent: $AGENT\n";
print DIOUT "Date: " . &ClockToDate2(&DateToClock($NOWTIME)) . " GMT\n";
print DIOUT "Content-Type: text/plain; charset=EUC-JP\n";
print DIOUT "\n";
for ( $i=0; $i<$DPLNO; $i++ ) {
print DEBUGOUT "$DPL[$i]\n" if ($DEBUG);
if ( $onlyorigdata != 0 ) {
next if ( $DP{$DPL[$i],"X-Result-Method" } =~ /remote/i );
}
if ( &DateToClock( $DP{$DPL[$i],'Date'} ) == 0 ) {
$DP{$DPL[$i],'Date'} = $NOWTIME;
}
foreach $cmdname ( @HINADI_CMDNAMELIST ) {
last if ( $cmdname =~ /TERMINATE/ );
$data = $DP{$DPL[$i],$cmdname};
if ( $cmdname eq "Method" ) {
$data .= "/" if ( $data ne "" );
$data .= $DP{$DPL[$i],"X-ResultStatus"}
} elsif ( $cmdname eq "URL" ) {
$data = $DP{$DPL[$i],"URI"}
} elsif ( $cmdname eq "Virtual" ) {
$data = $DP{$DPL[$i],"X-VirtualURI"}
} elsif ( $cmdname eq "X-WDB-Title" ) {
$data = $DP{$DPL[$i],"TITLE"}
} elsif ( $cmdname eq "X-WDB-Author-Name" ) {
$data = $DP{$DPL[$i],"AUTHOR"}
} elsif ( $cmdname eq "X-LM-Is-FMD" ) {
next if ( $data eq "0" );
}
next if ( $data eq "" );
if ( ( $cmdname eq "Date" ) ||
( $cmdname eq "Last-Modified" ) ||
( $cmdname eq "Last-Modified-Detected" ) ||
( $cmdname eq "X-First-Modified-Detected" ) ||
( $cmdname eq "Expires" ) ||
( $cmdname eq "Expire" ) ) {
$data = &DateToClock(&ExtractNormalDate( $data, "ZZZ" ));
next if ( $data == 0 );
$data = &ClockToDate2( $data ) . " GMT";
}
print DIOUT "$cmdname:\t\t$data\n";
}
print DIOUT "\n";
}
close( DIOUT );
}
########################################################################
### HINA.HTML出力
## Print_HINAHTML()
#
sub Print_HINAHTML
{
local( $a );
local( $i );
local( $lastmod );
local( $lastmod2 );
local( $href );
local( $title );
local( $name );
local( $comment );
local( $gettime );
local( $method );
local( $mark );
local( $codename );
local( $status );
local( $server );
local( $s );
local( $hop );
local( $errormark );
print DEBUGOUT "Print_HINAHTML\n" if ($DEBUG);
if ( $SORT == 1 ) {
open( SORT, "|sort -r" );
}
for ( $i=0; $i<$DPLNO; $i++ ) {
$errormark = $HINA_NOERRORMARK;
$lastmod = $DP{$DPL[$i],"Last-Modified"};
if ( $DP{$DPL[$i],"X-LM-Is-FMD"} eq "1" ) {
$lastmod = $DP{$DPL[$i],"X-First-Modified-Detected"};
}
$lastmod = &DateToClock( $lastmod );
if ( $lastmod == 0 ) {
$lastmod = "";
$lastmod2 = "----/--/-- --:--";
} else {
$lastmod -= $DEFAULTTZDIFFTIME*60*60;
$lastmod = &ClockToDate( $lastmod );
$lastmod =~ s%(\d\d\d\d\/\d\d\/\d\d \d\d\:\d\d).*$%$1%;
$lastmod2 = $lastmod;
$hop = $DP{$DPL[$i],"X-Hop"};
$status = "";
$lastmod =~ s%\d\d\d\d/(\d\d)/(\d\d) (\d\d):(\d\d)%\?$1$2$3$4%;
}
$a = $DP{$DPL[$i],"X-ResultStatus"};
if ( $a == 200 ) {
} else {
if ( $a == 404 ) {
$status = "";
$errormark = "N";
} elsif ( $a == -100 ) {
$status = "";
$errormark = "T";
} elsif ( $a == -101 ) {
$status = "";
$errormark = "R";
} elsif ( $a == -200 ) {
$status = "";
$errormark = "D";
} elsif ( $a == -300 ) {
$status = "";
$errormark = "C";
} else {
$status = "";
$errormark = "E";
}
}
$server = $DP{$DPL[$i],"Server"};
if ( ( $server =~ /CERN/ ) ||
( $server =~ /Microsoft-Internet-Information-Server/ ) ||
( $server =~ m%Netscape-Communications/1.1$% ) ||
( $server =~ m%Netscape-Enterprise/3.0$% ) ||
( $server =~ /Purveyor/ ) ||
( $server =~ /IBM-ICS/ ) ) {
$lastmod = "";
$status .= "";
}
$href = $DP{$DPL[$i],"URI"};
if ( $href =~ /#/ ) {
$href =~ s/(.*)#(.*)/$1$lastmod#$2/;
} else {
$href .= "$lastmod";
}
$title = $DP{$DPL[$i],"TITLE"};
$name = $DP{$DPL[$i],"AUTHOR"};
$comment = $DP{$DPL[$i],"COMMENT"};
$codename = $DPL[$i];
$mark = '';
$gettime = sprintf( "%02ds", $DP{$DPL[$i],"X-GETTIME"} );
$method = $DP{$DPL[$i],"X-Result-Method" };
# print DEBUGOUT "Method: $method\($mark\)\n" if ($DEBUG);
if ( $method =~ /hina-di/i ) {
$mark = 'D';
} elsif ( $method =~ /rss/i ) {
$mark = 'R';
} elsif ( $method =~ /head/i ) {
$mark = 'H';
} elsif ( $method =~ /get/i ) {
$mark = 'G';
} elsif ( $method =~ /remote/i ) {
# print DEBUGOUT "X-Authorized-Pagename: $DP{$DPL[$i],\"X-Authorized-Pagename\"}\n" if ($DEBUG);
$mark = $RP{ $DP{$DPL[$i],"X-Authorized-Pagename"}, "MARKURI" };
$gettime = sprintf( "%02ds", $RP{ $DP{$DPL[$i],"X-Authorized-Pagename"}, "X-GETTIME" } );
}
# print DEBUGOUT "Method: $method\($mark\)\n" if ($DEBUG);
if ( $mark eq "" ) {
$mark = "-";
}
# print DEBUGOUT "Output: $status $href $lastmod2 $codename\n" if ($DEBUG);
# $s = sprintf( "%s(%s:%s) %s by %s %s", $lastmod2, $mark, $gettime, $href, $title, $name, $comment );
# $s =~ s/[ ]+$//;
# print "$s\n";
$_ = $HINA_HTML_FORMAT;
s/%s/$status/g;
s/%h/$href/g;
s/%t/$title/g;
s/%n/$name/g;
s/%l/$lastmod2/g;
s/%m/$mark/g;
s/%g/$gettime/g;
s/%c//g;
s/%C/$comment/g;
s/%E/$errormark/g;
s/%H/$DP{$DPL[$i],"URI"}/;
s/[ ]+\n/\n/g;
s:[ ]+::g;
if ( $SORT == 0 ) {
print;
} else {
print SORT;
}
# $s = sprintf( "\n%s\n%s by %s %s", $status, $href, $title, $name, $comment );
# $s =~ s/[ ]+$//;
# print "$s";
# $s = sprintf( "\n%s (%s:%s)\n\n\n", $lastmod2, $mark, $gettime, $codename );
# print "$s";
}
}
########################################################################
### WDBファイル出力
## Print_WDBFileAll()
#
sub Print_WDBFileAll
{
local( $i );
local( $s );
for ( $i=0; $i<$RPLNO; $i++ ) {
# print "$RPL[$i], $RP{ $RPL[$i] }\n";
next if ( $RP{ $RPL[$i] } ne "defined" );
print "REMOTE:\t\t$RPL[$i]\n";
foreach $cmdname ( @REMOTE_CMDNAMELIST ) {
print "$cmdname:\t\t$RP{$RPL[$i],$cmdname}\n";
}
print "\n";
}
for ( $i=0; $i<$DPLNO; $i++ ) {
next if ( $DP{ $DPL[$i] } ne "defined" );
print "PAGE:\t\t$DPL[$i]\n";
foreach $cmdname ( @DIRECT_CMDNAMELIST ) {
print "$cmdname:\t\t$DP{$DPL[$i],$cmdname}\n";
}
print "\n";
}
}
########################################################################
### WDBの一部を編集用HTMLに出力
## Print_WDBDISPHTML( REMOTE, DIRECT, PASS )
#
sub Print_WDBDISPHTML
{
local( $remote ) = shift;
local( $direct ) = shift;
local( $pass ) = shift;
local( $i );
local( $selected );
local( $s );
local( $r1, $r2, $r3, $r4, $r51, $r52, $r53, $r54, $r55 );
$s = <
WDB Maintainance Display
EOF
&jcode'convert( *s, 'jis' );
print "$s";
}
########################################################################
### リモートアンテナリストへ登録
## RegisterRemote( PAGENAME, URI, TITLE, AUTHOR, VIRTUAL, MARK, SAVEAS )
#
sub RegisterRemote
{
local( $n );
local( $pagename ) = shift;
if ( $RP{ $pagename } ne "defined" ) {
$n = $RPLNO++;
$RPL[$n] = $pagename;
$RP{ $pagename } = "defined";
}
$RP{ $pagename, "URI" } = shift;
$RP{ $pagename, "TITLE" } = shift;
$RP{ $pagename, "AUTHOR" } = shift;
$RP{ $pagename, "VIRTUAL" } = shift;
$RP{ $pagename, "MARK" } = shift;
$RP{ $pagename, "SAVEAS" } = shift;
}
########################################################################
### リモートアンテナリストから削除
## UnregisterRemote( PAGENAME );
#
sub UnregisterRemote
{
local( $pagename ) = shift;
if ( $RP{ $pagename } eq "defined" ) {
$RP{ $pagename } = "undefined";
}
}
########################################################################
### 取得先リストへ登録
## RegisterDirect( PAGENAME, URI, TITLE, AUTHOR, VIRTUAL, METHOD, COMMENT, KEY )
#
sub RegisterDirect
{
local( $n );
local( $pagename ) = shift;
if ( $DP{ $pagename } ne "defined" ) {
$n = $DPLNO++;
$DPL[$n] = $pagename;
$DP{ $pagename } = "defined";
}
$DP{ $pagename, "URI" } = shift;
$DP{ $pagename, "TITLE" } = shift;
$DP{ $pagename, "AUTHOR" } = shift;
$DP{ $pagename, "VIRTUAL" } = shift;
$DP{ $pagename, "METHOD" } = shift;
$DP{ $pagename, "COMMENT" } = shift;
$DP{ $pagename, "KEY" } = shift;
}
########################################################################
### 取得先リストから削除
## UnregisterDirect( PAGENAME )
#
sub UnregisterDirect
{
local( $pagename ) = shift;
if ( $DP{ $pagename } eq "defined" ) {
$DP{ $pagename } = "undefined";
}
}
########################################################################
### date to clock
## CLOCK = DateToClock( DATE )
#
sub DateToClock
{
local( $lmdate ) = shift;
local( $nday, $clock );
local( $year, $month, $day, $hour, $min, $sec ) = split( "[/: ]", $lmdate );
local( $u1, $u4, $u100, $u400 );
local( $a1, $a4, $a100, $a400 );
$nday = 365*($year-1980);
$a4 = int( ($year-1980)%4 );
$u4 = int( ($year-1980+3)/4 );
$a100 = int( ($year-1900)%100 );
$u100 = int( ($year-1900)/100 );
$a400 = int( ($year-1600)%400 );
$u400 = int( ($year-1600)/400 );
# print "$nday, $u1, $a4, $u4, $a100, $u100, $a400, $u400\n";
if ( ( ($a4 == 0) && ($a100 != 0) ) || ($a400 == 0) ) {
$nday += $u4-$u100+$u400+$DAYOFMONTH_U[$month-1];
} else {
$nday += $u4-$u100+$u400+$DAYOFMONTH[$month-1];
}
$nday += $day-1;
# print "$nday, $u1, $a4, $u4, $a100, $u100, $a400, $u400\n";
$clock = $nday*24*60*60 + $hour*60*60 + $min*60 + $sec;
$clock = 0 if ( $clock < 0 );
return ($clock);
}
########################################################################
### clock to date
## DATE = ClockToDate( CLOCK )
#
sub ClockToDate
{
local( $year, $month, $day, $hour, $min, $sec, $mday ) = &ClockToDateCore( shift );
local( $s ) = sprintf( "%04d/%02d/%02d %02d:%02d:%02d", $year, $month, $day, $hour, $min, $sec );
return ($s);
}
sub ClockToDate2
{
local( $year, $month, $day, $hour, $min, $sec, $mday ) = &ClockToDateCore( shift );
local( $s ) = sprintf( "%s, %d %s %d %02d:%02d:%02d", $MDAY[$mday], $day, $MONTH[$month-1], $year, $hour, $min, $sec );
return ($s);
}
sub ClockToDate3
{
local( $year, $month, $day, $hour, $min, $sec, $mday ) = &ClockToDateCore( shift );
local( $s ) = sprintf( "%s, %02d %s %d %02d:%02d:%02d", $MDAY[$mday], $day, $MONTH[$month-1], $year, $hour, $min, $sec );
return ($s);
}
sub ClockToDateCore
{
local( $clock ) = shift;
local( $nday );
local( $year, $month, $day, $hour, $min, $sec, $mday );
local( $i );
local( $u1, $u4, $u100, $u400 );
local( $a1, $a4, $a100, $a400 );
$clock = 0 if ( $clock < 0 );
$nday = int( $clock/(24*60*60) );
$clock -= $nday*(24*60*60);
$hour = int( $clock/(60*60) );
$clock -= $hour*(60*60);
$min = int( $clock/60 );
$sec = $clock%60;
# print "$nday, $u1, $u4, $u100, $u400\n";
$mday = ($nday+2)%7;
$nday += ((1980-1600)*365)+(1-4+95);
# print "$nday, $u1, $u4, $u100, $u400\n";
$u400 = int( $nday/(365*400+1-4+100) );
$nday -= $u400* (365*400+1-4+100);
# print "$nday, $u1, $u4, $u100, $u400\n";
$u100 = int( ($nday-1)/(365*100-1+25) );
$nday -= $u100* (365*100-1+25);
# print "$nday, $u1, $u4, $u100, $u400\n";
$u4 = int( $nday/(365*4+1) );
$nday -= $u4* (365*4+1);
# print "$nday, $u1, $u4, $u100, $u400\n";
$u1 = int( ($nday-1)/365 );
$a1 = int( ($nday-1)%365 );
$nday -= ($u1*365)+( $u1 ? 1 : 0);
# print "$nday, $u1, $u4, $u100, $u400\n";
$year = $u1 + $u4*4 + $u100*100 + $u400*400 + 1600;
# print "$nday, $u1, $u4, $u100, $u400\n";
# print "$nday, $a1, $a4, $a100, $a400\n";
if ( ( (($year%4) == 0) && (($year%100) != 0) ) || (($year%400) == 0) ) {
for ( $i=1; $i<=12; $i++ ) {
# print "U $DAYOFMONTH_U[$i]\n";
last if ( $nday < $DAYOFMONTH_U[$i] );
}
$day = $nday - $DAYOFMONTH_U[$i-1] + 1;
} else {
for ( $i=1; $i<=12; $i++ ) {
# print "$DAYOFMONTH[$i]\n";
last if ( $nday < $DAYOFMONTH[$i] );
}
$day = $nday - $DAYOFMONTH[$i-1] + 1;
}
$month = $i;
return ( $year, $month, $day, $hour, $min, $sec, $mday );
}
########################################################################
### リモートファイルダウンロード
## SUCCESS = DownloadRemoteFileHTTP( REMOTENAME, METHOD, SAVEAS )
#
sub DownloadRemoteFileHTTP
{
local( $remotename ) = shift;
local( $method ) = shift;
local( $saveas ) = shift;
local( $href );
local( $dpl );
local( $status );
local( $gettime );
local( $uri );
local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = stat($saveas);
local( $modified );
local( $tmpsaveas ) = "\%$saveas.$$";
local( $httpstatus );
local( $contenttype );
$HTTP_REMOTE_TIMEOUT = 30 if ( !defined( $HTTP_REMOTE_TIMEOUT ) );
$HTTP_TIMEOUT_G = $HTTP_REMOTE_TIMEOUT;
if ( $mtime > 0 ) {
local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime( $mtime );
$modified = sprintf( "%04d/%02d/%02d %02d:%02d:%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec );
}
$rpl = $remotename;
$uri = $RP{ $rpl, "X-VirtualURI" };
if ( $uri eq "" ) {
$uri = $RP{ $rpl, "URI" };
}
$href = &ExtractNormalURI( $uri );
if ( $href =~ /[.]gz$/i ) {
$method .= "-GZIP";
}
print DEBUGOUT "DownloadHTTP( $href, $method, $tmpsaveas, $modified )\n";
( $status, $gettime, $contenttype ) = &DownloadHTTP( $href, $method, $tmpsaveas, $modified );
$RP{ $rpl, "X-GETTIME" } = $gettime;
$RP{ $rpl, "Content-Type" } = $contenttype;
if ( $status == 0 ) {
# success;
open( REMOTEFILE, "$tmpsaveas" );
$httpstatus = ;
close( REMOTEFILE );
print DEBUGOUT "REMOTEFILE: $httpstatus";
if ( $httpstatus !~ / 304 / ) {
print DEBUGOUT "rename( $tmpsaveas, $saveas )\n";
rename( $tmpsaveas, $saveas );
} else {
print DEBUGOUT "304 not modified : $href\n";
}
} elsif ( $status == 1 ) {
$RP{ $rpl, "X-ResultStatus" } = -100; # timeout
} elsif ( $status == 2 ) {
$RP{ $rpl, "X-ResultStatus" } = -300; # http error
}
unlink( $tmpsaveas );
return ( $status );
}
########################################################################
### ドキュメントダウンロード
## SUCCESS = DownloadDocumentHTTP( PAGENAME, METHOD, SAVEAS )
#
sub DownloadDocumentHTTP
{
local( $pagename ) = shift;
local( $method ) = shift;
local( $saveas ) = shift;
local( $href );
local( $dpl );
local( $staus );
local( $gettime );
local( $uri );
local( $modified );
local( $contenttype );
$HTTP_TIMEOUT_G = $HTTP_TIMEOUT;
$dpl = $pagename;
$uri = $DP{ $dpl, "X-VirtualURI" };
if ( $uri eq "" ) {
$uri = $DP{ $dpl, "URI" };
}
$href = &ExtractNormalURI( $uri );
$modified = $DP{ $dpl, "Last-Modified" };
( $status, $gettime, $contenttype ) = &DownloadHTTP( $href, $method, $saveas, $modified );
$DP{ $dpl, "X-GETTIME" } = $gettime;
$DP{ $dpl, "Content-Type" } = $contenttype;
if ( $status == 0 ) {
# success;
} elsif ( $status == 1 ) {
$DP{ $dpl, "X-ResultStatus" } = -100; # timeout
$status = 0;
} elsif ( $status == 2 ) {
$DP{ $dpl, "X-ResultStatus" } = -300; # http error
}
return ( $status, $contenttype );
}
########################################################################
### HTTPダウンロード
## SUCCESS = DownloadHTTP( HREF, METHOD, SAVEAS, MODIFIED )
#
sub DownloadHTTP
{
local( $href ) = shift;
local( $method ) = shift;
local( $saveas ) = shift;
local( $modified ) = shift;
local( $lmdate );
local( $server );
local( $port );
local( $path );
local( $host );
local( $sendstr );
local( $type, $len, $thataddr );
local( $that );
local( $oldselect );
local( $gettime );
local( $getgziped );
local( $gziped );
local( $gzipreadbuf );
local( $gzipreadlength );
local( $contentlength );
local( $data );
local( $isbody ) = 0;
local( $readimagesize ) = 0;
local( $contenttype );
local( $contentencoding );
local( $readlines ) = 0;
local( $readbufsize ) = 1024*4;
local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
local( @res, $family, $saddr, $canonname );
print DEBUGOUT "DownloadHTTP():\n" if ($DEBUG);
$getgziped = 0;
if ( $method eq "GET-GZIP" ) {
$method = "GET";
$getgziped = !0;
}
$path = $href;
if ( $PROXY ne "" ) {
$server = $PROXY;
$server =~ s/:.*//;
$port = $PROXY;
$port =~ s/.*://;
$path = $href;
$host = $href;
$host =~ s%http://([^/:]+).*$%$1%;
} else {
$server = $href;
$server =~ s%http://([^/:]+).*$%$1%;
$port = $href;
$port =~ s%http://[^:/]+:%%;
$port =~ s%^([^/]*).*$%$1%;
if ( $port == 0 ) {
$port = 80;
}
$path =~ s%http://[^/]+%%;
$host = $server;
}
$sendstr = "$method $path HTTP/1.0\015\012";
$sendstr .= "Host: $host\015\012";
$sendstr .= "User-Agent: $AGENT\015\012";
$sendstr .= "Referer: $ANTENNA_URI\015\012" if ( $ANTENNA_URI ne "" );
$sendstr .= "Pragma: no-cache\015\012";
$sendstr .= "Accept-Encoding: gzip, x-gzip\015\012";
$data = &DateToClock(&ExtractNormalDate( $modified, "ZZZ" ));
if ( $data != 0 ) {
$data = &ClockToDate3( $data ) . " GMT";
$sendstr .= "If-Modified-Since: $data\015\012";
}
$sendstr .= "\015\012";
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time());
print DEBUGOUT sprintf( "%02d:%02d:%02d ", $hour, $min, $sec ) if ($DEBUG);
print DEBUGOUT "access to $server:$port\n" if ($DEBUG);
print DEBUGOUT "--Send Request Header\n$sendstr\--Get Object Header\n" if ($DEBUG);
$gettime = time;
eval {
$SIG{'ALRM'} = 'timeout';
sub timeout { die "timeout"; }
eval {
alarm( $HTTP_TIMEOUT_G );
};
if ( $USE_IPV6 ) {
@res = getaddrinfo( $server, $port, AF_UNSPEC, SOCK_STREAM );
$family = -1;
while (scalar (@res) >= 5) {
( $family, $SOCK_STREAM, $proto, $saddr, $canonname, @res ) = @res;
( $host, $port ) = getnameinfo( $saddr, NI_NUMERICHOST | NI_NUMERICSERV );
print DEBUGOUT "Trying to connect $host port $port...\n" if ($DEBUG);
socket( S, $family, $SOCK_STREAM, $proto ) || next;
connect (S, $saddr) && last;
close( S );
$family = -1;
}
if ($family == -1) {
die "connect error";
}
print DEBUGOUT "connected to $host port $port\n" if ($DEBUG);
} else {
if ( $server =~ /^(\d{1,3})[.](\d{1,3})[.](\d{1,3})[.](\d{1,3})$/ ) {
$host = $server;
$thataddr = pack( 'C4', $1, $2, $3, $4 );
} else {
( $host, $aliases, $type, $len, $thataddr ) = gethostbyname( $server );
}
$that = pack_sockaddr_in( $port, $thataddr );
print DEBUGOUT "Trying to connect $host port $port...\n" if ($DEBUG);
if ( !socket(S, &PF_INET, &SOCK_STREAM, getprotobyname( 'tcp' )) ) {
die "socket error";
}
if ( !connect( S, $that ) ) {
die "connect error";
}
print DEBUGOUT "connected to $host port $port\n" if ($DEBUG);
}
$oldselect = select;
select ( S );
$| = 1;
print S "$sendstr";
select ( $oldselect );
$contentlength = 0;
open( SAVEAS, ">$saveas" );
binmode( SAVEAS );
while () {
s/\015\12/\012/g;
s/\015/\012/g;
s/\012$//;
if ( $_ eq '' ) {
print DEBUGOUT "--Get Object Body\n" if ($DEBUG);
print SAVEAS "\n";
last;
}
if ( $_ =~ /^Content-Length:[ \t]+(\d+)/i ) {
$contentlength = $1;
print DEBUGOUT "Get Content Length: $contentlength\n" if ($DEBUG);
}
if ( $_ =~ /^Content-Type:[ \t]+(.*)$/i ) {
$contenttype = $1;
$readimagesize = 0;
$readimagesize = 16 if ( $1 =~ 'image\/gif' );
$readimagesize = 1024 if ( $1 =~ 'image\/jpeg' );
$readimagesize = 1024 if ( $1 =~ 'image\/(x-|)png' );
# 今のところ未使用
print DEBUGOUT "Get Content Type: $contenttype\n" if ($DEBUG);
}
if ( $_ =~ /^Content-Encoding:[ \t]+(.*)$/i ) {
$contentencoding = $1;
$gziped = 0;
$gziped = !0 if ( $contentencoding eq 'gzip' );
$gziped = !0 if ( $contentencoding eq 'x-gzip' );
if ( $gziped != 0 ) {
$getgziped = $gziped;
}
print DEBUGOUT "Get Content Encoding: $contentencoding\n" if ($DEBUG);
}
print SAVEAS "$_\n";
print DEBUGOUT "$_\n" if ($DEBUG);
}
close( SAVEAS );
if ( ($contentlength == 0) && ($getgziped) ) {
$contentlength = 1024*1024;
}
if ( ($contentlength > 0) && ($method eq "GET") ) {
if ( $getgziped ) {
print DEBUGOUT "Get gziped data - $contentlength byte.\n" if ($DEBUG);
open( SAVEAS, "|gzip -d>>$saveas" );
} else {
print DEBUGOUT "Get binary data - $contentlength byte.\n" if ($DEBUG);
open( SAVEAS, ">>$saveas" );
}
binmode( SAVEAS );
binmode( S );
while ($contentlength) {
print DEBUGOUT "Rest: $contentlength\n" if ($DEBUG);
$gzipreadlength = $contentlength;
$gzipreadlength = $readbufsize if $gzipreadlength > $readbufsize;
$gzipreadlength = read( S, $gzipreadbuf, $gzipreadlength );
last if ( $gzipreadlength == 0 );
syswrite( SAVEAS, $gzipreadbuf, $gzipreadlength );
$contentlength -= $gzipreadlength;
}
close(SAVEAS);
print DEBUGOUT "Rest: 0\n" if ($DEBUG);
} else {
print DEBUGOUT "Get text data ... " if ($DEBUG);
open( SAVEAS, ">>$saveas" );
while () {
print SAVEAS "$_";
$readlines++;
}
close(SAVEAS);
print DEBUGOUT "$readlines lines.\n" if ($DEBUG);
}
print DEBUGOUT "--End of Object\n" if ($DEBUG);
close(S);
eval {
alarm( 0 );
};
};
$gettime = time - $gettime;
if ( $@ ne "" ) {
close(S);
close(SAVEAS);
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time());
print DEBUGOUT sprintf( "%02d:%02d:%02d ", $hour, $min, $sec );
print DEBUGOUT "ALARM $@ on $href.\n--\n";
return (1, $gettime, $contenttype) if ( $@ =~ "timeout" );
return (2, $gettime, $contenttype);
}
return (0, $gettime, $contenttype);
}
########################################################################
1;
# [EOF]