#!/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"; #------ $s = <[取得先登録]

    登録コード名
    PASS : [Help]
    URI
    タイトル
    著者
    コメント
    更新時刻取得用URI
    取得方法
    キーワード

    EOF &jcode'convert( *s, 'jis' ); print "$s"; #------ $s = <[リモートアンテナ登録]

    登録コード名
    PASS : [Help]
    アンテナURI
    アンテナ名
    管理者
    アンテナファイル実体
    アンテナマーク
    保存ファイル名

    EOF &jcode'convert( *s, 'jis' ); print "$s"; #------ $s = <
    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]