#!/usr/local/bin/perl #!D:/Perl/bin/perl.exe #--------------------------------------------------------------------------------- # imWHOISデータ自動更新プログラム(IO::Socketモジュール使用例) # ＵＲＬ：http://whois.sakaguch.com/ 電子メール：http://whois.sakaguch.com/cgi/postmail/ より送信して下さい。 # ファイル名：MakeImWhoisList.pl 2004.01.02 作成：鷹の巣 # 参考URL:サブルーチン内に記載有り。 #--------------------------------------------------------------------------------- # 改版記録： # 2004.01.02 Rev.1.000 初版で公開。 # 2004.02.01 Rev.1.010 ccTLDのWebページの途中改行対策を実施。 $ver = 'MakeImWhoisList.pl Rev.1.010(作成：鷹の巣 http://whois.sakaguch.com/)'; #--------------------------------------------------------------------------------- # 1.用途 # # このPerlスクリプトは、フリーソフトです。詳細は、項4をご一読願います。 # # このPerlスクリプトは、imWHOISで使用する煩雑なデータファイルを # 公式ページよりダウンロードして自動更新します。 # # ※注意 # 作成されるファイル名は、tld_a.listとrirs_a.listで、 # オリジナルとファイル名が異なります。 # ご使用される場合は、必ずim_whois.confの再設定を行なって下さい。 # # tld_a.listファイルは、tld.listと完全に互換性がありますので、 # そのまま差し替えてご使用出来ます。 # # rirs_a.listファイルをご使用されますと、JPNICのwhoisデータベースを # 検索しなくなります。 # rirs_a.listファイルをご使用して、JPNICのwhoisデータベースを検索させるには、 # このrirs_a.listファイル内に記載されている様に # im_whois.cgi ver1.05のスクリプトを一部変更する必要があります。 # 改造方法も含めた詳細は、以下のURLをご参照願います。 # 　http://whois.sakaguch.com/SetImWhoisKai.html # # #--------------------------------------------------------------------------------- # 2.作成されるファイルの表示例と特徴 # # 作成されたtld_a.listとrirs_a.listファイル例を以下のURLで公開しています。 # http://whois.sakaguch.com/DownLoad/tld_a.list.txt # http://whois.sakaguch.com/DownLoad/rirs_a.list.txt # # ○利点：imWHOISのデータの更新が容易。それ以外は何もありません。 # # ○欠点：アジア/太平洋州管理のIPアドレスの場合は、必ず # JPNIC管理のIPアドレスかどうか問合せを行なうので、多少処理に時間がかかる。 # また、im_whois.cgiのスクリプトを一部変更する必要がある。 # # このスクリプトは、HEADメソッドを使用してLast-Modified（更新日）を判断せずに、 # 最初からGETメソッドを使用するため、処理に時間がかかる。 # スクリプトの読みやすさに重点を置いているので、処理速度が多少、遅い。 # #--------------------------------------------------------------------------------- # 3.ご注意事項 # # このスクリプトは、Windows XP HOME Edition # Active Perl 5.8.4.810 built for MSWin32-x86-multi-thread # の環境のコマンドプロンプト画面にて、動作確認を行っております。 # # このスクリプトに対するご質問や不具合がございましたら、電子メールで、 # webmaster@whois.sakaguch.com まで、お寄せ下さい。 # また、「鷹の巣」の自宅サーバー掲示板 # http://sakaguch.com/cgi/bbs/ # にご投稿して頂いても結構です。 # # このPerlスクリプトは、鷹の巣が個人的に作成しました。 # CGI倶楽部さんとは、全く関係がありませんので、 # お問合せは、必ず、上記の掲示板の方に御願い致します。 # #--------------------------------------------------------------------------------- # 4.著作権 # # このスクリプトは、鷹の巣が作成しましたが、著作権は放棄しています。 # スクリプトの再配布や改造は自由ですが、無償として下さい。 # いかなる目的であっても、このスクリプトに付加価値をつけて、 # 有償配布してはなりません。 # #--------------------------------------------------------------------------------- # 5.起動方法 # # 基本設定部分を変更し、コマンドラインから、 # perl MakeImWhoisList.pl # を実施すれば、基本設定部分に記載された場所に # tld_a.listとirs_a.listファイルが生成されます。 # #--------------------------------------------------------------------------------- #■□■ 基本設定 ■□■ $file_rirs = 'D:\WWW\cgilib\whois\rirs_a.list'; # imWHOISのrirs.listの絶対パス表記ファイル名 $file_tld = 'D:\WWW\cgilib\whois\tld_a.list'; # imWHOISのtld.listの絶対パス表記ファイル名 #■□■ 基本設定終わり ■□■ $url_IPv4 = 'http://www.iana.org/assignments/ipv4-address-space';# INTERNET PROTOCOL V4 ADDRESS SPACEのURL $url_gTLD = 'http://www.iana.org/gtld/gtld.htm'; # gTLDのURL $url_TLD = 'http://www.iana.org/cctld/cctld-whois.htm'; # TLDのURL $http_version = '1.1'; # HTTPプロトコル(Hypertext Transfer Protocol)の改版番号 $timeout = 60; # 接続待ち許容時間（秒） %comment = ( # gTLDの説明部分の定義 ".aero" , "Air-transport" , ".biz" , "Businesses" , ".com" , "Commercial" , ".coop" , "Cooperatives" , ".edu" , "Educational" , ".gov" , "Government(US)" , ".info" , "Unrestricted" , ".int" , "International" , ".mil" , "Military(US)" , ".museum" , "Museums" , ".name" , "Individuals" , ".net" , "Network" , ".org" , "Organizations" , ".pro" , "Professional" ); use IO::Socket; # IO::Socketモジュールを使用 &main(); # perlで、URLを閲覧 exit; #----------# #　主回路　# #----------# sub main { # 改版番号の表示 print "$ver\n\n"; open ( OUT , "> $file_rirs" ) || die("Can't open in $file_rirs"); $rirs = &header_rirs ; print "$rirs\n"; print OUT "$rirs\n"; # IPv4のWebページを読込み、IPアドレスブロックとwhoisデータベース名を書出す。 my @rcv_data = &get( $url_IPv4 , $http_version , $timeout ); foreach (@rcv_data) { chomp ( $_ ); if ( $_ =~ /(\d{3}\/\d)(.+)/isg ) { my $rirs = $1 ; my $other = $2 ; $rirs =~ s/(^00|^0)//; if ( $other =~ /(.+)\(whois\.(.+)\)/isg ) { $rirs .= ",whois.$2"; } else { $rirs .= ",whois.arin.net"; } print "$rirs\n"; print OUT "$rirs\n"; } } close ( OUT ); print "\n\n\n\n\n"; open ( OUT , "> $file_tld" ) || die("Can't open in $file_tld"); $tld = &header_tld ; print "$tld\n"; print OUT "$tld\n"; # gTLDのWebページを読込み、ドメイン名とwhoisデータベース名と説明とURLを書出す。 my @rcv_data = &get( $url_gTLD , $http_version , $timeout ); $url_gTLD =~ /(http:)?(\/\/)?([^:\/]*)?(:([0-9]+))?(\/.*)?/; $base_url = 'http://' . $3; @html_link_data = &make_link_line ( \@rcv_data ); # 途中改行対策を追加 2004.02.01 foreach ( @html_link_data ) { if ( $_ =~ /(.+) domain<\/a>/isg ) { $url = $1 ; $domain = $2; $contry = $comment { $domain }; ( $url_reg , $whois_server ) = &get_whois_server ( $base_url . $url , $http_version , $timeout ); $tld = "$domain,$whois_server,$contry,$url_reg"; print "$tld\n"; print OUT "$tld\n"; } } # ccTLDのWebページを読込み、ドメイン名とwhoisデータベース名と説明とURLを書出す。 my @rcv_data = &get( $url_TLD , $http_version , $timeout ); $url_TLD =~ /(http:)?(\/\/)?([^:\/]*)?(:([0-9]+))?(\/.*)?/; $base_url = 'http://' . $3; @html_link_data = &make_link_line ( \@rcv_data ); # 途中改行対策を追加 2004.02.01 foreach ( @html_link_data ) { if ( $_ =~ /(.+)  –  (.+)<\/A>/isg ) { $url = $1 ; $domain = $2; $contry = $3; ( $url_reg , $whois_server ) = &get_whois_server ( $base_url . $url , $http_version , $timeout ); $tld = "$domain,$whois_server,$contry,$url_reg"; print "$tld\n"; print OUT "$tld\n"; } } close ( OUT ); } #---------------------------------# #　リンクを含む行を1行にまとめる　# #---------------------------------# # 途中改行対策を追加 2004.02.01 sub make_link_line { my ( $html_ref ) = @_; my ( $i , $line ); my @new = (); for ( $i = 0; $i < $#{$html_ref}; $i++ ) { $line = @{$html_ref}[$i]; chomp($line); $line =~ s/^[ \t]+/ /g; # 先頭行の半角空白とタブ文字を半角空白1個に置換する。 $line =~ s/[\r\n]+//g; # 改行コードを削除。 if ( $line =~ /(.*)(0 ){ @new[$#new] .= $line; } # ハイパーリンクを含まなければ、前行末尾に追加 } } return @new; } #---------------------------------# #　whois説明ページのデータ読込み　# #---------------------------------# sub get_whois_server { my ( $url , $http_version , $timeout ) = @_; # 引数0:URI、引数1:HTTPプロトコルのバージョン、引数2:接続待ち許容時間（秒） my @rcv_data = &get ( $base_url . $1 , $http_version , $timeout );# $urlに設定したURLのWebページを標準出力(HTTPクライアント) my $url_reg = ""; my $whois_server = ""; foreach (@rcv_data) { chomp ( $_ ); if ( $_ =~ /URL for registration services/isg ) { if ( $_ =~ /(.+)<\/a>/isg ) { $url_reg = $1; } } if ( $_ =~ /Whois server/isg ) { if ( $_ =~ /<\/u>:<\/b> (.+)<\/font><\/p>/isg ) { if ( $1 ne 'None listed.' ) { $whois_server = $1; } } } } return ( $url_reg , $whois_server ); } #---------------------# #　Webページの読込み　# #---------------------# sub get { # Webページ表示チェックプログラムその２(IO::Socketモジュール使用例) # SOCKEThttp2.pl 2002.08.17 作成：鷹の巣　http://whois.sakaguch.com/ # 参考URL # 説明が豊富なURL:http://x68000.q-e-d.net/~68user/net/http-2.html # 説明が豊富なURL:http://ash.or.jp/perl/socket_http.htm my ($url, $http_version, $timeout) = @_;# 引数0:URI、引数1:HTTPプロトコルのバージョン、引数2:接続待ち許容時間（秒） $url =~ /(http:)?(\/\/)?([^:\/]*)?(:([0-9]+))?(\/.*)?/; my $host = $3; if ($host eq "") {$host = 'localhost';} my $port = $5; if ($port eq "") {$port = 80;} # HTTPプロトコルgetservbyname('http','tcp')は80。 my $path = $6; if ($path eq "") {$path = '/';} my @rcv_data = (); # 戻り値を初期化。 my $SOCKET = IO::Socket::INET -> new(PeerAddr => $host, # HTTPプロトコルでWWWサーバーへ接続する PeerPort => $port, # サービスポート番号 Proto => "tcp", # プロトコル Timeout => $timeout,# 接続待ち許容時間（秒） ); if ($SOCKET) { if ($http_version eq '1.1') { # WWWサーバにHTTPリクエストを送る print $SOCKET "GET $path HTTP/1.1\r\n"; print $SOCKET "Host: $host\r\n"; print $SOCKET "Connection: close\r\n"; } else { print $SOCKET "GET $path HTTP/1.0\r\n"; } print $SOCKET "\r\n"; $SOCKET -> flush(); # バッファに溜まっているデータも送る while (<$SOCKET>){ m/^\r\n$/ and last; } # ヘッダ部分を除去する(改行のみの行ならループを抜ける) @rcv_data = <$SOCKET>; $SOCKET -> close(); # WWWサーバーから切断する } return (@rcv_data); # 戻り値を格納する。 } #---------------------------# # rirs.listのヘッダー作成 # #---------------------------# sub header_rirs { my $Date_Koushin = &Date_Koushin; my $rirs = <<"_COMMENT_"; # =========================================================================== # rirs.list ver1.00 # Copyright (C) 2001 pika@cgi-club.com # IPv4アドレス-WHOISサーバ対応リスト # =========================================================================== # ================= # 更新履歴 # ================= # [2001/10/19] v1.00 # 作成 # $Date_Koushin :鷹の巣 # このデータは、以下のURLに記載されている内容をもとに # $verにより、自動更新されています。 # INTERNET PROTOCOL V4 ADDRESS SPACE # $url_IPv4 # このデータを利用するには、im_whois.cgi ver1.05の改造が必要です。 # 改造方法も含めた詳細は、以下のURLをご参照願います。 # http://whois.sakaguch.com/ _COMMENT_ } #--------------------------# # tld.listのヘッダー作成 # #--------------------------# sub header_tld { my $Date_Koushin = &Date_Koushin; my $tld = <<"_COMMENT_"; # =========================================================================== # tld.list ver1.00 # Copyright (C) 2001 pika@cgi-club.com # 国コード-WHOISサーバ対応リスト # =========================================================================== # ================= # 更新履歴 # ================= # [2001/10/19] v1.00 # 作成 # $Date_Koushin :鷹の巣 # このデータは、以下のURLに記載されている内容をもとに # $verにより、自動更新されています。 # IANA | Generic Top-Level Domains # $url_gTLD # IANA | Root-Zone Whois Index by TLD Code # $url_TLD # このデータを利用するには、im_whois.cgi ver1.05の改造が必要です。 # 改造方法も含めた詳細は、以下のURLをご参照願います。 # http://whois.sakaguch.com/ _COMMENT_ } #----------------------# # データ更新日の生成 # #----------------------# sub Date_Koushin { my ($sec, $min, $hour, $day, $mon, $year, $wday) = localtime(time()); my $Date_Koushin = "データ更新日：" . sprintf("%04d年%02d月%02d日",$year+1900,$mon+1,$day); return $Date_Koushin; }