#!/usr/bin/env perl #!E:/ProgramFilesXP/Programming/Compiler/Perl/ActivePerl/bin/perl.exe #!E:/ProgramFilesXP/Programming/Compiler/Perl/ActivePerl5.8/bin/perl.exe binmode STDIN; binmode STDOUT; #========================================================================= #・ソフト名称 WebProxy #・作者　　　　 Lunar Night #・バージョン 1.7.8 #・対応OS WinNT/UNIX系OS （Perl5 + Socket CGIが正常に動作すること） #・種別　　　　 フリーソフト(商用利用する場合は別途規模により料金頂きます #・概要　　　　 PerlProxyです #・連絡先　　　 lunar-night@ninus.ocn.ne.jp #・ホームページ http://www.age.jp/~lunar/ #========================================================================= #詳細はReadme.txt参照 $log_mode = "2"; #---ログ記録モード（0=なし、1=日単位、2=月単位） $log_folder = "./sysdata/logs/"; #---ログ格納フォルダ $system_folder = "./sysdata/"; #---システム一時フォルダ $session_folder = "./sysdata/session/"; #---セッション記録フォルダ $version = "1.7.8"; #---バージョン番号（変更しないで！） #---ライブラリ設定 $lib_http = './lib/httpcontrol.pl'; $lib_jcode = './lib/jcode.pl'; $lib_des = './lib/des.pl'; $lib_md5 = './lib/md5.pl'; $lib_encrypt = './lib/encrypt.pl'; $lib_mojicode = './lib/mojicode.pl'; #---デフォルトヘッダー設定 $def_header = <<'HEAD'; User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0) HEAD #---ダウンロード時にファイル名を通知するファイルの拡張子 %down_file_type = ('lzh' => 1, 'zip' => 1, 'gz' => 1, 'gca' => 1, 'yz1' => 1, 'exe' => 1, 'dat' => 1); #---解析対象とするタグ %replace_taglist = ('iframe' => 1, 'input' => 1, 'frame' => 1, 'a' => 1, 'area' => 1, 'td' => 1, 'tr' => 1, 'body' => 1, 'script' => 1, 'link' => 1, 'img' => 1, 'image' => 1, 'embed' => 1); #---解析対象外とするファイル名の拡張子 %replace_filter = ('src'=> 1); #------以下メインロジック-----# #---Base64変換ハッシュ %b64_encode = ( '000000', 'A', '000001', 'B', '000010', 'C', '000011', 'D', '000100', 'E', '000101', 'F', '000110', 'G', '000111', 'H', '001000', 'I', '001001', 'J', '001010', 'K', '001011', 'L', '001100', 'M', '001101', 'N', '001110', 'O', '001111', 'P', '010000', 'Q', '010001', 'R', '010010', 'S', '010011', 'T', '010100', 'U', '010101', 'V', '010110', 'W', '010111', 'X', '011000', 'Y', '011001', 'Z', '011010', 'a', '011011', 'b', '011100', 'c', '011101', 'd', '011110', 'e', '011111', 'f', '100000', 'g', '100001', 'h', '100010', 'i', '100011', 'j', '100100', 'k', '100101', 'l', '100110', 'm', '100111', 'n', '101000', 'o', '101001', 'p', '101010', 'q', '101011', 'r', '101100', 's', '101101', 't', '101110', 'u', '101111', 'v', '110000', 'w', '110001', 'x', '110010', 'y', '110011', 'z', '110100', '0', '110101', '1', '110110', '2', '110111', '3', '111000', '4', '111001', '5', '111010', '6', '111011', '7', '111100', '8', '111101', '9', '111110', '+', '111111', '/', ); @zero = ( '', '00000', '0000', '000', '00', '0' ); @pad = ( '', '===', '==', '=' ); #---月変換ハッシュ(^^; %month_hash = ( 'Jan' => '01', 'Feb' => '02', 'Mar' => '03', 'Apr' => '04', 'May' => '05', 'Jun' => '06', 'Jul' => '07', 'Aug' => '08', 'Sep' => '09', 'Oct' => '10', 'Nov' => '11', 'Dec' => '12' ); require $lib_http; #---HTTPコントローラー require $lib_jcode; #---日本語文字コード変換ライブラリ require $lib_des; #---DES暗号化ライブラリ require $lib_md5; #---MD5ハッシングライブラリ require $lib_encrypt; #---暗号化補助ライブラリ #---ファイル名設定 ($tmp) = $0 =~ /([^\/\\]+)$/; $filename = $tmp; #---環境変数読み込み $c_len = $ENV{'CONTENT_LENGTH'}; $query = $ENV{'QUERY_STRING' }; #---Cookie読み込み %cookie = (); &read_cookie(*cookie); #---Signature読み込み &mk_signature(); #---SystemInformation if ($query eq "account_ctl"){ &syscheck();} if ($query ne ""){ ($s_id,$s_len,$query) = split(/:/,$query); #---セッション読み込み *hash_p = &read_session($s_id); $ch_type1 = $hash_p{'ch_type1' }; $ch_type2 = $hash_p{'ch_type2' }; $usecookie= $hash_p{'cookie' }; $ftp_type = $hash_p{'ftp_type' }; $ftp_mail = $hash_p{'ftp_mail' }; $con_type = $hash_p{'con_type' }; $agent = $hash_p{'agent' }; $cryptseed= $hash_p{'crypt_s' }; $now_page = $hash_p{'page' }; $refer_f = $hash_p{'refer_f' }; $option_h = $hash_p{'opt_header'}; $auth_dat = $hash_p{'auth_dat' }; $random_f = $hash_p{'random_f' }; $b64_encf = $hash_p{'b64_enc' }; if ($cryptseed ne ""){ $random_s = ""; $random_s = $cookie{"c_seed"} if $random_f eq "1"; &encrypt("set_pass",$cryptseed.$random_s); ($rc,$query1) = &encrypt("decrypt",substr($query,0,$s_len),'b64') if $b64_encf eq "1"; ($rc,$query1) = &encrypt("decrypt",substr($query,0,$s_len)) if $b64_encf ne "1"; if ($rc ne "1"){ &error($rc);} $str = "crypt "; }else{ $query1 = substr($query,0,$s_len); $query1 =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg; $str = "normal "; } $query = $query1.substr($query,$s_len); &write_log($str."GET sub $query"); &http_get($query); }elsif($c_len != 0){ %in = (); &read_stdin(*in); $ch_type1 = $in{'ch_type1' }; $ch_type2 = $in{'ch_type2' }; $usecookie= $in{'cookie' }; $ftp_type = $in{'ftp_type' }; $ftp_mail = $in{'ftp_mail' }; $con_type = $in{'con_type' }; $crypt = $in{'crypt' }; $agent = $in{'agent' }; $form_ctl = $in{'wp_form_ctl' }; $refer_f = $in{'refer_f' }; $s_id = $in{'wp_session_id'}; $option_h = $in{'opt_header' }; $random_f = $in{'random_f' }; $b64_encf = $in{'b64_enc' }; if ($form_ctl eq "top" && $crypt ne ""){ $cryptseed = time(); $random_s = ""; $random_s = unpack('H*',&md5::convert(rand())) if $random_f eq "1"; $in{"crypt_s"} = $cryptseed; $add_cookie = "Set-Cookie: c_seed=$random_s;\n"; &encrypt("set_pass",$cryptseed.$random_s); $str = "crypt "; }else{ $cryptseed = ""; $str = "normal "; } #---セッション情報書き込み &write_session($s_id,*in); $buf = 'page:'.$in{'page'}; &write_log($str."GET top $buf"); &http_get($buf); } $s_id = &new_session(); print < WebProxy Ver$version WebProxy Ver$version


Proxy設定
■追加ヘッダー

※不正なヘッダーを書き込むと転送エラーの原因になります！
■ステルスモード
DES暗号化を有効にします。
強化モードを使う（ブラウザ側のCookieが利用可能であることが条件です。）
Base64モードを使う（暗号化URLがかなり短くなりますがレスポンスが若干悪くなります）
■ハイパーファイル名検索を使う
Lev1 - JavaScript内でフルURLで書かれているリンクと思われるものをProxy経由にしてみる
Lev2 - JavaScript内でファイル名と思われるものをProxy経由にしてみる
■Cookieを使う
Inside Cookie有効 (Cookie制限を掛けられた環境で威力を発揮します。)
Cookie有効 (Cookieをサイトごとに管理するようなことはしていません！)
Cookie無効
※「Cookie有効」の場合、ドメインごとにCookieは管理されていません。
通常はバッティングが起きないInsideCookieの利用をお勧めします。
■Refererを流す
Refererを流します。直リン対策されているページでOnにすると効果があります
■Connectionタイプ
Keep-Alive Close
■AnonymouseFTP機能を使う
Proxy内臓のFTPを用いて通信します。
メールアドレス
$copy_right
HTML exit; sub http_get{ ($query) = @_; $meth = substr($query,0,index($query,':')); $url = substr($query,index($query,':')+1); $now_url = $url; #---認証？ $auth_pass = ""; if ($meth eq "auth" ){ ($auth_pass) = &http_auth_set($url);} else { if ($hash_p{"auth_dat"} ne ""){ $len = 0; foreach $a (split(/\n/,$hash_p{"auth_dat"})){ ($tmp_url,$tmp_pass) = split(/\0/,$a); if (index($url,$tmp_url) == 0){ if (length($tmp_url) > $len){ $auth_pass = $tmp_pass; $len = length($tmp_url); } } } } } #---FTP? if ($meth eq "ftp" ){ &ftp_get($url);} if ($url =~ /^ftp:\/\//){ &ftp_get($url);} #---URL階層処理用データ &set_base_addr($url); #---POST/GETデータ処理 $send_jump_sub = ""; if ($con_type eq "" || $con_type eq "keep"){ $con = "Keep-Alive";} else { $con = "close"; } #---拡張ヘッダー %add_header = (); if ($option_h eq ""){ $option_h = $def_header;} foreach $a (split(/\n/,$option_h)){ ($key,$val) = split(/\s*:\s*/,$a); $posi = index($a,':'); $key = substr($a,0,$posi); $val = substr($a,$posi+1); $key = lc($key); $add_header{$key} = $val; } $add_header{"connection"} = $con; $add_header{"referer"} = $now_page if $refer_f ne ""; $add_header{"authorization"} = "Basic $auth_pass" if $auth_pass ne ""; $content_len = $ENV{'CONTENT_LENGTH'}; if ($meth eq "post"){ $send_jump_sub = "main::http_send"; $add_header{"content-length"} = $content_len; $add_header{"content-type" } = $ENV{'CONTENT_TYPE'}; } elsif($meth eq "get" ){ read(STDIN,$buf,$content_len); $url .= "?".$buf; } if ($usecookie eq "2"){ (*cookie) = &get_cookie($url); } %input_hash = ("url" => $url, "data_jump" => "main::http_read", "send_jump" => $send_jump_sub, "add_head" => *add_header, "cookie_data"=> *cookie); ($res,*out_head,*out_data) = &httpcontrol(*input_hash); if ($res != 1){ &error($res);} exit; } sub ftp_get{ ($url) = @_; require './lib/ftpcontrol.pl'; $url =~ m!(\w+:)?(//)?([^:/]*)?(:([0-9]+)?)?(/.*)?!; if ($ftp_type eq ""){ &error("FTP通信は利用不可に設定されています");} if ($1 ne "ftp:" ){ &error("不正なFTPアドレスです:$url"); } if ($3) {$host = $3;} if ($5) {$port = $5;} if ($6) {$path = $6;} #---ディレクトリ？ if ($path =~ /\/$/){ &ftp_list($url);} $out_head = ""; %ftp_con = ("host" => $host, "port" => $port, "user" => "Anonymous", "pass" => $ftp_mail); %ftp_opt = ("transfer_mode" => "pasv", "target" => $path, "jump" => 'main::ftp_output'); ($rc) = &ftpcontrol("login","",*ftp_con); if (substr($rc,0,5) eq "ERROR"){ &error($rc);} ($rc) = &ftpcontrol("get_file",*ftp_opt,*ftp_con); if (substr($rc,0,5) eq "ERROR"){ &error($rc);} ($rc) = &ftpcontrol("logout",*ftp_opt,*ftp_con); if (substr($rc,0,5) eq "ERROR"){ &error($rc);} exit; } sub ftp_output{ ($dat) = @_; if ($out_head eq ""){ ($file) = $path =~ /\/([^\/]+$)/; print "Content-type: application/octet-stream\n"; print "Content-Disposition: attachment; filename=\"$file\"\n\n"; $out_head = "1"; } print $dat; } sub ftp_list{ ($url) = @_; $url =~ m!(\w+:)?(//)?([^:/]*)?(:([0-9]+)?)?(/.*)?!; if ($ftp_type eq ""){ &error("FTP通信は利用不可に設定されています");} if ($1 ne "ftp:" ){ &error("不正なFTPアドレスです:$url"); } if ($3) {$host = $3;} if ($5) {$port = $5;} if ($6) {$path = $6;} %ftp_con = ("host" => $host, "port" => $port, "user" => "Anonymous", "pass" => $ftp_mail); %ftp_opt = ("transfer_mode" => "pasv", "path" => $path ); ($rc) = &ftpcontrol("login","",*ftp_con); if (substr($rc,0,5) eq "ERROR"){ &error($rc);} ($rc) = &ftpcontrol("filelist",*ftp_opt,*ftp_con); if (substr($rc,0,5) eq "ERROR"){ &error($rc);} *dsp_list = $rc; ($rc) = &ftpcontrol("logout",*ftp_opt,*ftp_con); if (substr($rc,0,5) eq "ERROR"){ &error($rc);} #---Fileリスト解析 $def_year = (localtime())[5]; $def_year += 1900; $out_size=0; $dirs = ""; $files = ""; foreach $a (@dsp_list){ if ($a =~ /^total/){ next;} ($perm,$type,$user,$group,$size,$month,$day,$time,$file) = $a =~ /([^\s]+)\s*(\d+)\s*([^\s]+)\s*([^\s]+)\s*(\d+)\s*(\w+)\s*(\d+)\s*([\d:]+)\s*([^\n]+)/; if ($time !~ /(\d*):(\d*)/){ $year = $time; $time = "";} else { $year = $def_year; } if ($day < 10){ $day = "0".$day;} $date = $year."/".$month_hash{$month}."/".$day." ".$time; if ($file eq "." || $file eq ".."){ next;} if (substr($perm,0,1) eq "d"){ $str = $url.$file."/"; $link= &encode("ftp:$str"); &jcode'convert(*file,"euc"); $dirs .= "$file/$date$size\n"; }else{ $str = $url.$file; $link= &encode("ftp:$str"); &jcode'convert(*file,"euc"); $files .= "$file$date$size\n"; } } @item = split(/\//,$url); pop(@item); $str = join("/",@item)."/"; $link= &encode("ftp:$str"); $parent = "../--"; print < Index of $path At $host - WebProxy Ver$version WebProxy Ver$version - FTP Proxy
$parent $dirs $files

Index of $path At $host
Name Date Size
　
HTML exit; } sub http_send{ $buf_size = 10240; $max_size = $content_len; $now_size = 0; while($max_size > $now_size){ read(STDIN,$buf,$buf_size); $now_size += length($buf); &http_control'http_tr($buf); } } sub encode{ ($dat) = @_; if ($cryptseed ne ""){ $dat = &encrypt("encrypt",$dat,'b64') if $b64_encf eq "1"; $dat = &encrypt("encrypt",$dat ) if $b64_encf ne "1";; }else{ $dat =~ s/(\W)/'%' . unpack('H2', $1)/eg; } $len = length($dat); return("$s_id:$len:$dat"); } sub set_base_addr{ $url = $_[0]; ($prot,$host,$addr) = $url =~ /(s?https?:\/\/)([^\/]+)([^\?]*)/; $str = ""; $addr =~ s/([^\/]*)$//; @addr_array = (); if ($url =~ /s?https?:\/\/[^\/]+$/ || $addr eq "/"){ @addr_array = ($prot.$host."/"); $addr = $prot.$host."/"; }else{ foreach $a (split(/\//,$addr)){ $str .= $a."/"; unshift(@addr_array,$prot.$host.$str); } } } sub http_read{ $flag = 0; %http_outhead= (); $http_msg = &http_control'http_rc(); $http_msg =~ s/\r//; $http_msg =~ s/\n//; $http_type = lc(substr($http_msg,0,8)); $html_data = ""; #---ヘッダー読み込み while(1){ $buf = &http_control'http_rc(); #---切り替え if ($buf eq "\r\n" || $buf eq "\n"){ last;} $buf =~ s/\r//; $buf =~ s/\n//; $data = index($buf,":"); $key = substr($buf,0,$data); $val = substr($buf,$data+2); if (lc($key) eq "set-cookie"){ $http_outhead{lc($key)} .= "$buf\n";} else { $http_outhead{lc($key)} .= $val; } } #---KeepAlive確認 $content_size = 0; if ($http_type eq "http/1.1" && $http_outhead{"content-length"} eq ""){ $flag = 1;} elsif($http_type eq "http/1.1" && $http_outhead{"content-length"} ne ""){ $flag = 2;} else { $flag = 3;} #---Keep-Aliveタイプ１ $bad_data = ""; if ($flag == 1){ $content_size = &http_control'http_rc(); $tmp = $content_size; $tmp =~ s/\r|\n| //g; if ($tmp =~ /[^0-9a-fA-F]/ || $tmp eq "" ){ $flag = 3; $bad_data = $content_size; } else { $http_outhead{"content-length"} = hex($tmp);} } #---Keep-Aliveタイプ２ if ($flag == 2 || $flag == 1){ $content_size = $http_outhead{"content-length"}; $buf_size = 10240; } #---ダウンロードファイル名指定 ($down_type) = $url =~ /\.([^\.]+)$/; if ($http_outhead{"content-disposition"} eq "" && $down_file_type{lc($down_type)} == 1 ){ ($down_name) = $url =~ /\/([^\/]+)$/; $http_outhead{"content-disposition"} = "attachment; filename=\"$down_name\"";} #---text/htmlのときの処理 $http_outhead{"content-length"} = "" if $http_outhead{"content-type"} eq "text/html"; #---認証あり？ if ($http_outhead{"www-authenticate"} ne ""){ ($auth_name) = $http_outhead{"www-authenticate"} =~ /realm\s*=\s*\"*([^\"]+)\"*/; &http_auth($auth_name); return(1); } #---ヘッダー出力 &output_header(*http_outhead,$flag); if ($http_outhead{"content-type"} =~ /text\/html/i){ $out_flag = 1;} elsif($http_outhead{"content-type"} eq "" ){ $out_flag = 1;} elsif($http_outhead{"content-type"} =~ /text\//i && $url =~ /\.css$/i ){ $out_flag = 2;} elsif($htto_outhead{"content-type"} =~ /text\/css/i ){ $out_flag = 2;} else { $out_flag = 3;} #---データ取得タイプ１ if ($flag == 1 || $flag == 2){ $last_f = 0; while($content_size > 0){ if ($content_size <= $buf_size){ $read_size = $content_size; $last_f = 1 if $flag == 1; $content_size = 0; } else { $read_size = $buf_size; $content_size -= $buf_size; } $buf = &http_control'http_rc($read_size); $content_size += $read_size - length($buf); if ($out_flag == 1 || $out_flag == 2){ $html_data .= $buf; } elsif($out_flag == 3){ print $buf; } if ($last_f == 1){ $tmp = &http_control'http_rc();$tmp = &http_control'http_rc(); $tmp =~ s/\r|\n| //g; $content_size = hex($tmp); if ($content_size != 0){ $last_f = 0;} else { last; } } } } #---データ取得タイプ２ if ($flag == 3){ if ($out_flag == 1 || $out_flag == 2){ $html_data .= $bad_data;} elsif($out_flag == 3){ print $bad_data; } while(1){ $buf = &http_control'http_rc(); if ($out_flag == 1|| $out_flag == 2){ $html_data .= $buf;} elsif($out_flag == 3){ print $buf; } if (index($buf,"\n") < 0){ last;} } } #---HTMLデータ解析 if ($out_flag == 1){ ($match,$code) = &jcode'getcode(*html_data); # if ($code ne "euc" && # $code ne "sjis"&& # $code ne "jis"){ $code = "";} # $tmpstr= ""; # if ($code eq ""){ # foreach $ctx (split(/\n/,$html_data)){ # &jcode'convert(*ctx,"euc"); # $tmpstr .= $ctx."\n"; # } # $html_data = $tmpstr; # }else{ # &jcode'convert(*html_data,"euc",$code); # } &jcode'convert(*html_data,"euc",$code) if $code ne ""; #---Script修正 $html_data =~ s/(]*>)((?:(?!<\/script>).)*)(<\/script>)/&replace_script($1,$2,$3)/eimgs; #---StyleSheet修正 $html_data =~ s/(]*>)((?:(?!<\/style>).)*)(<\/style>)/&replace_style($1,$2,$3)/eimgs; #---HTML修正 $html_data =~ s/<(\w+)([^"'<>]*(?:"[^"]*"[^"'<>]*|'[^']*'[^"'<>]*)*(?:>|(?=<)|$(?!\n)))/&replace_tag($1,$2,*addr_array)/gme; &jcode'convert(*html_data,$code,"euc") if $code ne ""; print $html_data; } #---スタイルシート解析 if ($out_flag == 2){ #---StyleSheet修正 $html_data =~ s/(]*>)((?:(?!<\/style>).)*)(<\/style>)/&replace_style($1,$2,$3)/eimgs; print $html_data; } # HTMLタグ正規表現 #$tag_regex_ = q{[^"'<>]*(?:"[^"]*"[^"'<>]*|'[^']*'[^"'<>]*)*(?:>|(?=<)|$(?!\n))}; #'}}}} #$comment_tag_regex = '-]*(?:-[^>-]+)*?)??)*(?:>|$(?!\n)|--.*$)'; #$tag_regex = qq{$comment_tag_regex|<$tag_regex_}; } #---HTTP認証セット sub http_auth_set{ ($auth_url) = @_; %in = (); &read_stdin(*in); #---認証コード生成 $auth_pass = $in{"user"}.":".$in{"pass"}; $auth_pass = &enc_base64($auth_pass); #---URL抽出 $auth_url = substr($auth_url,0,index($auth_url,"?")) if index($auth_url,"?") != -1; $auth_url = substr($auth_url,0,rindex($auth_url,"/")); $auth_f = 0; $auth_tmp = ""; foreach $a (split(/\n/,$auth_dat)){ ($key,$val) = split(/\0/,$a); if ($key eq $auth_url){ next;} $auth_tmp .= $a."\n"; } $auth_tmp .= $auth_url."\0".$auth_pass."\n"; #---セッション更新 %up_hash = ('auth_dat' => $auth_tmp); &update_session($s_id,*up_hash); #---内部情報更新 $hash_p{'auth_dat'} = $auth_tmp; return($auth_pass); } #---HTTP認証 sub http_auth{ ($auth_name) = @_; $link = &encode('auth:'.$url); print <HTTP Basic認証 
HTTP Basic認証を要求しています



サイト:$url
認証名:$auth_name

はHTTP Basic認証を要求しています。
認証情報を入力してください。

ユーザー名:
パスワード:
HTML return(1); } sub output_header{ (*http_headctl,$flag) = @_; #---Location認識 $locate = $http_outhead{"location"}; if (substr($locate,0,2) eq "//" ){ $locate = &encode("page:http:$locate"); $locate = $filename."?".$locate; } elsif(substr($locate,0,3) eq "ftp" ){ $locate = &encode("ftp:$locate"); $locate = $filename."?".$locate; } elsif(substr($locate,0,4) ne "http" && substr($locate,0,5) ne "https"){ $locate = &replace_link2($locate,*url_point,"page");} else { $locate = &encode("page:".$locate); $locate = $filename."?".$locate; } $agent_tmp = $agent; $agent_tmp =~ s/(\W)/'%' . unpack('H2', $1)/eg; print "Location: " .$locate ."\n" unless $http_headctl{"location" } eq ""; print "Content-type: " .$http_headctl{"content-type"} ."\n" unless $http_headctl{"content-type" } eq ""; print "Content-Disposition: ".$http_headctl{"content-disposition"}."\n" unless $http_headctl{"content-disposition"} eq ""; print "Content-length: " .$http_headctl{"content-length"} ."\n" if $http_headctl{"content-length" } ne "" && $http_headctl{"content-disposition"} ne "" && $flag != 1; print $http_headctl{"set-cookie"} if ($http_headctl{"set-cookie"} ne "" && $usecookie eq "1"); print $add_cookie if ($add_cookie ne ""); &set_cookie($http_headctl{"set-cookie"},$now_url) if $usecookie eq "2"; #---Cookie管理マネージャへ print "\n"; #---逆参照用データ書き込み if ($http_headctl{'content-type'} =~ /text\/html/i){ %up_hash = ('page' => $now_url); &update_session($s_id,*up_hash); } } sub replace_script{ ($scr_start,$scr_main,$scr_end) = @_; #---ハイパー文字列検索(^^; if ($ch_type2 eq "1"){ $scr_main =~ s/(["'])([\w\_\-.\/\%\?]+)(["'])/$1.&replace_link2($2,*url_point,"page","true").$3/egi; } #---アドレスと思われる文字検索 if ($ch_type1 eq "1"){ $scr_main =~ s/(["'])(s?https?:\/\/[-_.!~*()a-zA-Z0-9;\/?:\@&=+\$,%#]+)(["'])/$1.&replace_direct($2).$3/eg; } #---location.hrefジャンパー $scr_main =~ s/(location\.href)\s*=\s*"([^"]+)"/$1."="."\"".&replace_link2($2,*url_point,"page")."\""/gmei; $scr_main =~ s/(location\.href)\s*=\s*'([^']+)'/$1."="."\'".&replace_link2($2,*url_point,"page")."\'"/gmei; return($scr_start.$scr_main.$scr_end); } sub replace_style{ ($scr_start,$scr_main,$scr_end) = @_; # $scr_main =~ s/\:\s*url\(([^\)]+)\)/"\:url(".&replace_link2($1,*url_point,"page").")"/eig; if ($scr_main =~ s/\:\s*url\("([^"]+)"\)/"\:url(\"".&replace_link2($1,*url_point,"page")."\")"/eig){} elsif($scr_main =~ s/\:\s*url\('([^']+)'\)/"\:url(\'".&replace_link2($1,*url_point,"page")."\')"/eig){} else {$scr_main =~ s/\:\s*url\(([^\)]+)\)/"\:url(".&replace_link2($1,*url_point,"page").")"/eig;} return($scr_start.$scr_main.$scr_end); } sub replace_tag{ ($mode,$data,*url_point) = @_; #---基底アドレス指定がある場合、再計算する if ($mode =~ /^base/){ ($url) = $data =~ /href\s*=\s*"([^"]+)"/ if $url eq ""; ($url) = $data =~ /href\s*=\s*'([^']+)'/ if $url eq ""; ($url) = $data =~ /href\s*=\s*([^ >]+)/ if $url eq ""; &set_base_addr($url); $local_host = $ENV{'HTTP_HOST'}; $local_addr = $ENV{'REQUEST_URI'}; if (index($local_addr,"?") != 0 ){ $local_addr = substr($local_addr,0,index($local_addr,"?"));} if (substr($local_addr,0,4) ne "http"){ $local_addr = "http://$local_host$local_addr";} $local_addr =~ s/[^\/]*$//; $data =~ s/href\s*=\s*[^ >]*/href=$local_addr /i; return("<".$mode.$data); } #---Formタグ if($mode =~ /form/i){ $data = &replace_form($data); #---Metaタグ }elsif($mode =~ /^meta/i){ $data =~ s/(url)\s*=\s*([^" >']+)/&replace_link($1,$2,*url_point,"page")/ei; }elsif($mode =~ /^param/i){ if ($data =~ /name\s*=[\s"']*movie/i){ if ($data =~ s/(value)\s*=\s*"([^"]+)"/$1."="."\"".&replace_link2($2,*url_point,"page")."\""/mei){} elsif($data =~ s/(value)\s*=\s*'([^']+)'/$1."="."\"".&replace_link($1,$2,*url_point,"page")."\""/mei){} else {$data =~ s/(value)\s*=\s*([^ >]+)/$1."="."\"".&replace_link($1,$2,*url_point,"page")."\""/mei; } } #---その他タグ }elsif($replace_taglist{lc($mode)} == 1){ #---JavaScriptイベント処理 if ($data =~ /on\w+\s*=/i){ if ($data =~ s/(on\w+\s*=\s*')([^']*)(')/&replace_script($1,$2,$3)/eig){} elsif($data =~ s/(on\w+\s*=\s*")([^"]*)(")/&replace_script($1,$2,$3)/eig){} else {$data =~ s/(on\w+\s*=\s*)([^ >]*)([ >])/&replace_script($1,$2,$3)/eig} } #---通常タグ処理 if ($data =~ /href|src|background/i){ if ($data =~ s/\s(href|src|background)\s*=\s*"([^"]+)"/" ".&replace_link($1,$2,*url_point,"page","\"")/mei){} elsif($data =~ s/\s(href|src|background)\s*=\s*'([^']+)'/" ".&replace_link($1,$2,*url_point,"page","\'")/mei){} else {$data =~ s/\s(href|src|background)\s*=\s*([^ >]+)/" ".&replace_link($1,$2,*url_point,"page","")/mei; } } if ($data =~ /style/i){ if ($data =~ s/\s(style)\s*=\s*"([^"]+)"/" ".&replace_style("style=\"",$2,"\"")/mei){} elsif($data =~ s/\s(style)\s*=\s*'([^']+)'/" ".&replace_style("style='",$2,"'")/mei){} else {$data =~ s/\s(style)\s*=\s*([^ >]+)/" ".&replace_style("style=",$2,"")/mei; } } } return("<".$mode.$data); } sub replace_form{ ($data) = @_; #---Actionある？ if ($data =~ /action\s*=/i){ #---Method認識 ($meth) = $data =~ /method\s*=\s*\"(\w+)\"/i; ($meth) = $data =~ /method\s*=\s*\'(\w+)\'/i unless $meth; ($meth) = $data =~ /method\s*=\s*(\w+)/i unless $meth; #---Method=POSTに強制設定 if ($data =~ s/method\s*=\s*[^ >]*/method=POST /i) {} else{$data = substr($data,0,length($data)-1)." method=POST>";} if ($meth eq ""){ $meth = "get"; } else { $meth = lc($meth);} #---Action変換 if ($data =~ s/(action)\s*=\s*"([^"]+)"/&replace_link($1,$2,*url_point,$meth,"\"")/ei){} elsif($data =~ s/(action)\s*=\s*'([^']+)'/&replace_link($1,$2,*url_point,$meth,"\'")/ei){} else { $data =~ s/(action)\s*=\s*([^ >]+)/&replace_link($1,$2,*url_point,$meth,"")/ei;} } return($data); } sub replace_link{ ($src,$link,*point,$meth,$type) = @_; $type1 = $type2 = $type; #---特殊リンク？ if ($link =~ /^["']*\#/){ return($src."=".$link); }elsif ($link !~ /^javascript/i){ if ($type eq "\"" && index($link,"'") != -1){ $link1 = substr($link,0,index($link,"'")); $type2 = substr($link,index($link,"'")).$type2; $link = $link1; }elsif($type eq "\'" && index($link,"\"") != -1){ $link1 = substr($link,0,index($link,"\"")); $type2 = substr($link,index($link,"\"")).$type2; $link = $link1; } } if (substr($link,0,length($filename)) eq $filename){ return($link);} $link =~ s/\r|\n//g; if ($link !~ /^(http:\/\/|mailto:|javascript|ftp:\/\/|https:\/\/)/i){ $link =~ s/^.\///; $cnt = rindex($link,"../"); if (substr($link,0,1) eq "/"){ $link = $addr_array[$#addr_array].substr($link,1);} elsif($cnt != -1){ $link = substr($link,$cnt+3); $link = $addr_array[$cnt/3+1].$link; } else { $link = $addr_array[0].$link; } }elsif($link =~ /^mailto/i){ return("$src=$type1$link$type2"); }elsif($link =~ /^javascript/i){ $link = &replace_script("",$link,""); return("$src=$type1$link$type2"); }elsif($link =~ /^ftp/i){ $meth = "ftp"; } $outlink = &encode($meth.":".$link); if ($src =~ /^url/i){ return("$src=$type1$filename?$outlink$type2");} elsif($src eq "" ){ return("$filename?$outlink "); } else { return("$src=$type1$filename?$outlink$type2");} } sub replace_link2{ ($link2,*point2,$meth2,$filter) = @_; if ($filter eq "true"){ if ($link2 !~ /[\w\_\-.\/\%\?]+\.\w{2,4}$/){ return($link2);} ($r_type) = $link2 =~ /\.([^\.?]{2,4})/; if ($replace_filter{lc($r_type)} == 1){ return($link2);}} if (substr($link2,0,length($filename)) eq $filename){ return($link2);} $link2 =~ s/\r|\n//g; if ($link2 =~ /^["']*\#/){ return($link2); }elsif ($link2 !~ /^(http:\/\/|mailto:|javascript|ftp:\/\/|https:\/\/)/i){ $link2 =~ s/^.\///; $cnt2 = rindex($link2,"../"); if (substr($link2,0,1) eq "/"){ $link2 = $addr_array[$#addr_array].substr($link2,1);} elsif($cnt2 != -1){ $link2 = substr($link2,$cnt2+3); $link2 = $addr_array[$cnt2/3+1].$link2; } else { $link2 = $addr_array[0].$link2; } }elsif($link2 =~ /^mailto/i){ return($link2); }elsif($link2 =~ /^ftp/i){ $meth2 = "ftp"; } $outlink2 = &encode($meth2.":".$link2); return("$filename?$outlink2"); } sub replace_direct{ $direct_in = $_[0]; $outlink3 = &encode("page:".$direct_in); return($filename."?".$outlink3); } sub error{ $err_msg = $_[0]; $err_msg =~ tr/\0/ /d; $test = ""; foreach $a (keys(%cookie)){ $test .= $a.":".$cookie{$a}."\n"; } print <Error Error 

$err_msg

$test
$cryptseed
HTML exit; } #----------------------------------------------------------------- # Cookie読み取り #----------------------------------------------------------------- sub read_cookie{ $pointer = $_[0]; foreach $lib_a (split(/;/,$ENV{'HTTP_COOKIE'})) { ($lib_kye,$lib_value) = split(/=/,$lib_a); $lib_kye =~ s/^ +//; $$pointer{$lib_kye} = $lib_value; } return(1); } #----------------------------------------------------------------- # Stdin読み取り #----------------------------------------------------------------- sub read_stdin{ $pointer = $_[0]; if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $query_string, $ENV{'CONTENT_LENGTH'});} #--POSTの場合 else { $query_string = $ENV{'QUERY_STRING'}; } #--GET の場合 %$pointer = ""; @lib_item = split(/&/, $query_string); foreach $lib_a (@lib_item) { ($lib_key, $lib_value) = split(/=/, $lib_a); $lib_value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg; $lib_value =~ s/\+/ /g; if ($$pointer{$lib_key} ne ""){ $$pointer{$lib_key} .= "\0$lib_value";} else { $$pointer{$lib_key} = $lib_value; } } return(1); } #----------------------------------------------------------------- # ログ書き込み #----------------------------------------------------------------- sub write_log{ $option = $_[0]; $ref = $_[1]; $time_diff= $_[2]; #---時差取得 $hour = 9; $min = 0; $sec = 0; #---ログ用データ取得 $remotehost = $ENV{'REMOTE_HOST'}; $remoteaddr = $ENV{'REMOTE_ADDR'}; $user_agent = $ENV{'HTTP_USER_AGENT'}; $refer = $ENV{'HTTP_REFERER'}; if ($ref ne ""){ $refer = $ref;} $refer=""; if ($remotehost eq ""){ $remotehost = "不明";} if ($remoteaddr eq ""){ $remoteaddr = "不明";} if ($user_agent eq ""){ $user_agent = "不明";} #---GMT時刻取得 $now_time = time; if ($type eq "-"){ $now_time -= 3600*$hour+$min*60+$sec;} else { $now_time += 3600*$hour+$min*60+$sec;} ($sec,$min,$hour,$day, $month, $year, $week, $yday, $isdst) = gmtime($now_time); $month += 1; $year += 1900; $week = ("日","月","火","水","木","金","土")[$week]; if ($day < 10){ $day = "0".$day; } if ($sec < 10){ $sec = "0".$sec; } if ($min < 10){ $min = "0".$min; } if ($hour < 10){ $hour = "0".$hour; } if ($month < 10){ $month= "0".$month;} $data = "$year/$month/$day\0$week\0$hour:$min:$sec\0$remotehost\0$remoteaddr\0$user_agent\0$refer\0"; #---ログ記録モード $use_file = ""; $use_file = "$log_folder$year-$month\_log.txt" if $log_mode eq "2"; $use_file = "$log_folder$year-$month-$day\_log.txt" if $log_mode eq "1"; if ($use_file eq ""){ return(0);} open(FILE,">>".$use_file); flock(FILE,2); print FILE $option."\0".$data."\n"; flock(FILE,8); close(FILE); return 1; } #----------------------------------------------------------------- # セッション制御 #----------------------------------------------------------------- sub new_session{ open(IN,$system_folder."session.dat"); $id = ; close(IN); $id++; if ($id > 10000000){ $id = 0;} if (!open(IN,">".$system_folder."session.dat")){ &error('セッション情報記録不能');} print IN $id; close(IN); $deltime = 3600*24; $nowtime = time(); if (!opendir(DIR,$session_folder)){ &error('セッションフォルダ読み込み不能');} foreach $ans (readdir(DIR)) { if ($ans eq "." || $ans eq ".."){ next;} $ans = $session_folder."/".$ans; if( $nowtime >= (stat($ans))[9] + $deltime) { unlink($ans); } } closedir(DIR); open(IN,">".$session_folder.$id); close(IN); return($id); } sub read_session{ ($id) = @_; %session_hash = (); if (!open(IN,$session_folder.$id)){ &error('セッション読み込みエラー');} while(){ chomp($_); ($key,$val) = split(/=/,$_); $val = pack('H*',$val); $session_hash{$key} = $val; } close(IN); return(*session_hash); } sub write_session{ ($id,*hash_p) = @_; if (!open(IN,">".$session_folder.$id)){ &error('セッション書き込みエラー');} flock(IN,2); while(($key,$val) = each %hash_p){ $val = unpack('H*',$val); print IN $key."=".$val."\n"; } flock(IN,8); close(IN); return(1); } sub update_session{ ($id,*hash_p) = @_; if (!open(IN,"+<".$session_folder.$id)){ &error('セッション読み込みエラー');} flock(IN,2); %session_hash = (); seek(IN,0,0); while(){ chomp($_); ($key,$val) = split(/=/,$_); $session_hash{$key} = $val; } while(($key,$val) = each %hash_p){ $session_hash{$key} = unpack('H*',$val); } truncate(IN,0); seek(IN,0,0); while(($key,$val) = each %session_hash){ print IN $key."=".$val."\n"; } close(IN); return(1); } #----------------------------------------------------------------- # Cookie制御 #----------------------------------------------------------------- sub set_cookie{ ($h_cookie,$s_nurl) = @_; if ($h_cookie eq ""){ return(1);} %tmp_hash = (); $s_nurl = (split(/\?/,$s_nurl))[0]; @item = split(/\//,$s_nurl); $s_nhost = $item[2]; $s_nprot = $item[0]; $s_npath = substr($s_nurl,length($item[0])+2+length($s_nhost)+1); $s_npath =~ s/[^\/]+$//; if (substr($s_npath,0,1) ne "/"){ $s_npath = "/".$s_npath;} #---Cookieデータロード open(IN,$session_folder.$s_id.".cookie"); while(){ chomp($_); ($domain,$path,$key,$val) = split(/\0/,$_); $tmp_hash{$domain."\0".$path."\0".$key} = $val; } close(IN); $h_cookie =~ tr/\r//d; foreach $x (split(/\n/,$h_cookie)){ ($val,$opt1,$opt2,$opt3) = split(/;/,substr($x,12)); $u_path = ""; $d_path = ""; if (index($opt1,'path=') != -1){ ($u_path) = $opt1 =~ /path=([^;]+)/i;} elsif(index($opt2,'path=') != -1){ ($u_path) = $opt2 =~ /path=([^;]+)/i;} if (index($opt1,'domain=') != -1){ ($d_path) = $opt1 =~ /domain=([^;]+)/i;} elsif(index($opt2,'domain=') != -1){ ($d_path) = $opt2 =~ /domain=([^;]+)/i;} elsif(index($opt3,'domain=') != -1){ ($d_path) = $opt3 =~ /domain=([^;]+)/i;} $d_path = $s_nhost if $d_path eq ""; $u_path = $s_npath if $u_path eq ""; ($key,@vals) = split(/=/,$val); $tmp_hash{$d_path."\0".$u_path."\0".$key} = join("=",@vals); } open(IN,">".$session_folder.$s_id.".cookie"); foreach $a (keys(%tmp_hash)){ print IN $a."\0".$tmp_hash{$a}."\n"; } close(IN); return(1); } sub get_cookie{ ($nurl) = @_; %out_getcookie = (); @item = split(/\//,$nurl); $s_nhost = $item[2]; $s_nprot = $item[0]; $s_npath = substr($nurl,length($item[0])+2+length($s_nhost)+1); $s_npath =~ s/[^\/]+$//; if (substr($s_npath,0,1) ne "/"){ $s_npath = "/".$s_npath;} open(IN,$session_folder.$s_id.".cookie"); while(){ chomp($_); ($domain,$path,$key,$val) = split(/\0/,$_); if (rindex($s_nhost,$domain) == length($s_nhost) - length($domain)){ if (index($s_npath,$path) == 0){ $out_getcookie{$key} = $val; } } } close(IN); return(*out_getcookie); } #----------------------------------------------------------------- # 各種エンコード #----------------------------------------------------------------- sub enc_base64{ ($encstr) = @_; $out = unpack("B*", $encstr); $out .= $zero[(length($out))%6]; $out =~ s/(.{6})/$b64_encode{$1}/go; $out .= $pad[(length($out))%4]; return($out); } sub enc_md5{ ($encstr) = @_; return(unpack("H*",&md5::convert($encstr))); } #------------------------------------------------------------------------------- # SystemInformation #------------------------------------------------------------------------------- sub syscheck{ %in = (); &read_stdin(*in); $check_key = ""; open(IN,"serialkey.dat"); while(){ $check_key .= $_; } close(IN); $check_key =~ tr/\r\n//d; print "Content-Type: text/html\n\n"; &encrypt('set_pass',$check_key); ($rc,$key_dat) = &encrypt('decrypt',$in{'key'},'b64'); &encrypt('set_pass',$key_dat); ($rc,$output) = &encrypt('decrypt',$check_key,'b64'); $md51 = unpack('H*',&md5'convert($check_key)); $md52 = unpack('H*',&md5'convert($output)); print "\n"; print "---SystemInformation---\n"; print $md51."\n"; print $md52."\n"; print $output; print $rc; exit; } #------------------------------------------------------------------------------- # CopyRight Information #------------------------------------------------------------------------------- sub mk_signature{ if (! -e $system_folder."signature.pl"){ open(IN,">".$system_folder."signature.pl"); print IN <<'SIGN'; $copy_right = <<'SIGNATURE';
Programmed By LunarNight
LunarNight Laboratory
Home : http://www.age.jp/~lunar/
Mail : lunar-night@ninus.ocn.ne.jp
SIGNATURE return 1; SIGN close(IN); } require $system_folder."signature.pl"; return(1); }