API tools faq
paste
yukiboard

Untitled

yukiboard
Jun 15th, 2015
357
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 53.46 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl
  2.  
  3. #Copyright (c) 2015 ◆okL.s3zZY5iC
  4. #Released under the MIT license
  5. #http://opensource.org/licenses/mit-license.php
  6.  
  7. #v0.17.1からの変更点
  8. # v0.17及びv0.17.1でContent-Lengthの値が0なレスポンス(したらば等)をクライアントへ返していない問題を修正
  9. # 試験的にhttps通信(CONNECT)を有効化
  10. # きっと増えているバグ
  11.  
  12. #注意事項
  13. #0. LinuxのJD(要は俺環)で動くことを想定して作っているので他の環境で動くかは分かりません
  14. #1. Webスクレイピングを有効にすると本来鯖から取得できるdatと
  15. #   整合性が取れなくなる恐れがあります
  16. #2. 専ブラで"200 OK"ではなく"416 Requested Range Not Satisfiable."が出た場合は
  17. #   datファイルの整合性が取れていないことによるエラーの可能性が高いです
  18. #   特に、WebスクレイピングのON/OFFを繰り返して使用した場合に起こりやすいです
  19. #   JDではスレ一覧の右クリックメニューのその他->スレ情報を消さずに再取得を行えばOK
  20. #3. 設定を変える際は原則として下のPROXY_CONFIG内の変数をいじってください
  21. #4. 設定の変更を適用する場合はプロクシの再起動が必要です
  22. #5. Windowsで使う場合はActive Perlではなくcygwin+perlを使う方が良いかもしれません
  23. #   現状で問題なく動いているなら変える必要はないと思います
  24. #6. きっとエラーは発生します
  25. #7. 自己責任で使ってください
  26. #
  27. #改変者Aよりの注意事項
  28. #これは作者氏作成のオリジナルより下記の経緯で改変しております
  29. #自己責任の上ご利用下さい
  30. #http://anago.2ch.net/test/read.cgi/software/1431176501/
  31. #90 名前：名無しさん＠お腹いっぱい。 [sage]： 2015/06/13(土) 19:06:58.20 ID:fWundqip0 (3)
  32. #2chproxy.plでJDを使ってるんだけど？ここで質問してもいいのかな？
  33. #一応おかしな挙動をチェックしてJD側ではなく2chproxy.plの問題だと
  34. #わかったんだけど直すスキルがないんで聞きにきました。
  35. #
  36. #html2datで正規表現を使用してレスの抽出をしているんだけど、be絡みの
  37. #部分がうまく動いていないみたい、具体的には
  38. #
  39. #'^<dt>(\d+)\s[^<]*<(?:a href="mailto:([^"]+)"|font[^>]*)><b>(.*?)</b></(?:a|font)>.([^<]+?)\s?(?:<a [^>]*be\((\d+)\)[^>]*>\?([^<]+)</a>)?<dd>(.+)'
  40. #
  41. #という正規表現でdat用のパーツを取り出しているんだけど、この
  42. #?(?:<a [^>]*be\((\d+)\)[^>]*>\?([^<]+)</a>)?
  43. #部分に問題があってうまく行かないみたい。
  44. #
  45. #perl正規表現の神スキルを持った方、助けて頂けないでしょうか？
  46. #
  47. #91 名前：名無しさん＠お腹いっぱい。 [sage]： 2015/06/13(土) 19:33:44.18 ID:fWundqip0 (3)
  48. #具体的に状態がおかしくなるスレは、以下です。
  49. #
  50. #【ネタバレ】ビジョルドpart10【禁止】
  51. #http://peace.2ch.net/test/read.cgi/sf/1308185794/
  52. #
  53. #レスが925あるはずなんだけど、422以降にbeの前に「神」というリンクが
  54. #あるんだけど、これのせいで該当のレスがエラーになって出力されず
  55. #datのレス数が920になってしまうという現象です。
  56. #
  57. #運用情報などで見かけるIDが???のbeはうまく変換できてるみたいですけど。
  58. #
  59. #94 名前：名無しさん＠お腹いっぱい。 [sage]： 2015/06/13(土) 20:50:05.71 ID:NrKctC500
  60. #>>90-91
  61. #'^<dt>(\d+)\s[^<]*<(?:a href="mailto:([^"]+)"|font[^>]*)><b>(.*?)</b></(?:a|font)>.([^<]+?)\s?(?:(?:<a .+?/a>\s)?<a [^>]*be\((\d+)\)[^>]*>\?([^<]+)</a>)?<dd>(.+)'
  62. #
  63. #(?:<a .*?/a>\s)?足しただけ
  64. #perl知らないから適当だお
  65. #
  66. #95 名前：名無しさん＠お腹いっぱい。 [sage]： 2015/06/13(土) 21:40:57.98 ID:fWundqip0 (3)
  67. #>>94
  68. #早速試してみました。ばっちりです。本当にありがとうございました。
  69. #
  70. #以上の経緯のもとに改変したものです
  71.  
  72. #use
  73. use strict;
  74.  
  75. use utf8;
  76. use POSIX;
  77.  
  78. use Encode 'encode';
  79. use File::Basename qw(dirname basename);
  80. use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat);
  81. use HTTP::Daemon;
  82. use IO::Compress::Gzip qw(gzip $GzipError);
  83. use LWP::Protocol::https;
  84. use LWP::UserAgent;
  85. use URI;
  86. use threads;
  87. use threads::shared;
  88. use Thread::Semaphore;
  89.  
  90. #定数の宣言(実質的なコンフィグファイル)
  91. my $PROXY_CONFIG  = {
  92.   PROXY_CONFIG_FILE => '',                            #コンフィグファイル
  93.   DEDICATED_BROWSER => "JD",                          #使用している専ブラの名前
  94.                                                       #スクレイピング時にRangeを使う場合は必須
  95.   DAT_DIRECTORY => "$ENV{HOME}/.jd/",                 #datファイルが置いてあるディレクトリ、最後の/はつけた方が良い
  96.                                                       #datへのアクセスにRangeヘッダーがあった際に
  97.                                                       #ローカルにあるdatへアクセスするのに必要
  98.   LISTEN_HOST => "localhost",                         #listenするホスト、ipv4に強制するなら"127.0.0.1"
  99.   LISTEN_PORT => 8080,                                #listenするポート
  100.   FORWARD_PROXY => '',                                #上位プロクシがあれば"http://host:port/"みたいに書く
  101.   MAXIMUM_CONNECTIONS => 20,                          #最大同時接続数
  102.   USER_AGENT => 'Mozilla/5.0 (X11; Linux x86_64; rv:38.0) Gecko/20100101 Firefox/38.0',
  103.   #USER_AGENT => '',
  104.                                                       #UA偽装
  105.   ENABLE_WEB_SCRAPING => 1,                           #datへのアクセスの際にWEBスクレイピングを有効にする
  106.                                                       #datへの直アクセスが禁止されない限りは有効にしない方がいい
  107.                                                       #0で無効、1で有効
  108.   ENABLE_PARTIAL_CONTENT => 1,                        #ENABLE_WEB_SCRAPINGが有効な状態で
  109.                                                       #datへのアクセスにRnageヘッダーが含まれていた場合に
  110.                                                       #206で応答するようにする(EXPERIMENTAL)
  111.                                                       #0で無効、1で有効
  112.   ENABLE_MEMORY_CACHE => 1,                           #メモリ上でdatの取得したサイズ、最新のレスの番号と内容をキャッシュする(EXPERIMENTAL)
  113.                                                       #0で無効、1で有効
  114.   TIMEOUT => 9,                                       #接続のタイムアウト値
  115.                                                       #専ブラのタイムアウト値より小さい値にした方が良い
  116.   DISABLE_TE_HEADER => 1,                             #If-Modified-Sinceヘッダーのない要求がプロクシに来た場合に
  117.                                                       #TEヘッダーが付加されるのを止めるかどうか
  118.                                                       #0で無効、1で有効
  119.   ENABLE_SSL_CONNECTION => 1,                         #https通信を有効にする、動くには動くが
  120.                                                       #しっかりした処理ではないので通信内容が壊れるかもしれない
  121.                                                       #0で無効、1で有効
  122.   TCP_CONNECTION_BUFFER => 8192,                      #tcpレベルで通信する時のバッファーの最大bytes数
  123.   KEEP_COOKIE => 1,                                   #このプロクシで*.2ch.net、*.bbspink.comのcookieを保持するかどうかのフラグ
  124.                                                       #0で無効、1で有効
  125.   UNIQ_COOKIE => 0,                                   #KEEP_COOKIEが有効になっている状態で
  126.                                                       #書き込み毎にcookieを変えたい場合はこれを有効にする
  127.                                                       #0で無効、1で有効
  128.   HANDLED_COOKIES => [qw(__cfduid yuki PREN)],        #プロクシで保持するクッキー
  129.   DAT_URL => '^http://([\w]+)(\.2ch\.net|\.bbspink\.com)(:[\d]+)?/([\w]+)/(?:dat|kako/\d+(?:/\d+)?)/([\d]+)\.dat(\.gz)?$',  #datへのアクセスかを判定する正規表現
  130.   NULL_DEVICE => '/dev/null',                         #nullデバイスの場所
  131.   PID_FILE_NAME => "/tmp/2chproxy.pid",               #pidが書かれたファイル、2重起動禁止にも用いている
  132.   LOG_FILE_NAME => "/tmp/2chproxy.log",               #ログファイル
  133.   NULL_DEVICE_WIN32 => 'nul',                         #nullデバイスの場所(Windows)
  134.   PID_FILE_NAME_WIN32 => dirname($0)."/2chproxy.pid", #pidが書かれたファイル、2重起動禁止にも用いている(Windows)
  135.   LOG_FILE_NAME_WIN32 => dirname($0)."/2chproxy.log", #ログファイル(Windows)
  136.   LOG_LEVEL => 5,                                     #ログ出力の閾値
  137.   #以下WEBスクレイピングの際の正規表現
  138.   TITLE_REGEX => '^<title>(.*)</title>$',             #タイトル抽出
  139.   #                       1.レス番                         2.目欄             3.名前/ハッシュ           4.日付|ID                 5.BE1           6.BE2          7.本文
  140.   #RESPONSE_REGEX  =>'^<dt>(\d+)\s[^<]*<(?:a href="mailto:([^"]+)"|font[^>]*)><b>(.*?)</b></(?:a|font)>.([^<]+?)\s?(?:<a [^>]*be\((\d+)\)[^>]*>\?([^<]+)</a>)?<dd>(.+)'
  141.   #（改変者Aより注意）上の行を下の行に改変しています
  142.   RESPONSE_REGEX  => '^<dt>(\d+)\s[^<]*<(?:a href="mailto:([^"]+)"|font[^>]*)><b>(.*?)</b></(?:a|font)>.([^<]+?)\s?(?:(?:<a .+?/a>\s)?<a [^>]*be\((\d+)\)[^>]*>\?([^<]+)</a>)?<dd>(.+)'
  143.   #WEBスクレイピングの細かい部分の正規表現は下の方
  144. };
  145.  
  146. #ログ出力用、こっちは弄らないでね
  147. use constant {
  148.   LOG_DEBUG => 7,
  149.   LOG_INFO => 6,
  150.   LOG_NOTICE => 5,
  151.   LOG_WARN => 4,
  152.   LOG_ERR => 3
  153. };
  154.  
  155. #グローバル変数の宣言
  156. my $log_level = $PROXY_CONFIG->{LOG_LEVEL};
  157. my $null_device;
  158. my $pid_file_name;
  159. my $log_file_name;
  160. my $charcode;
  161. my ($is_daemon, $help, $kill_process, $settings, $verbose);
  162. my $UA;
  163. my $dedicated_browser;
  164. my $dat_directory;
  165. my %cookie :shared;
  166. my %mem_cache_dat_last_str  :shared;
  167. my %mem_cache_dat_last_num  :shared;
  168. my %mem_cache_dat_length  :shared;
  169. my $semaphore;
  170. my $tcp_connection_buffer;
  171.  
  172. #グローバル変数の初期化
  173. sub initialize_global_var() {
  174.   $log_level = $PROXY_CONFIG->{LOG_LEVEL};
  175.   #ログレベルの変更
  176.   if ($verbose) {
  177.     $log_level = 6;
  178.   }
  179.   $null_device = ($^O !~ m|MSWin32|i) ? $PROXY_CONFIG->{NULL_DEVICE} : $PROXY_CONFIG->{NULL_DEVICE_WIN32};
  180.   $pid_file_name = ($^O !~ m|MSWin32|i) ? $PROXY_CONFIG->{PID_FILE_NAME} : $PROXY_CONFIG->{PID_FILE_NAME_WIN32};
  181.   $log_file_name = ($^O !~ m|MSWin32|i) ? $PROXY_CONFIG->{LOG_FILE_NAME} : $PROXY_CONFIG->{LOG_FILE_NAME_WIN32};
  182.  
  183.   $charcode  = "UTF-8";
  184.   #とりあえずWindowsだけcp932で出力
  185.   if ($^O =~ m/MSWin32/) {
  186.     $charcode = "cp932";
  187.   }
  188.   $UA  = LWP::UserAgent->new();
  189.   $dedicated_browser = $PROXY_CONFIG->{DEDICATED_BROWSER};
  190.   $dat_directory = ($PROXY_CONFIG->{DAT_DIRECTORY} =~ m|/$|) ? $PROXY_CONFIG->{DAT_DIRECTORY} : $PROXY_CONFIG->{DAT_DIRECTORY}."/";
  191.   $tcp_connection_buffer = ($PROXY_CONFIG->{TCP_CONNECTION_BUFFER} > 0) ? $PROXY_CONFIG->{TCP_CONNECTION_BUFFER} : 8192;
  192.   #タイムアウト値を設定
  193.   $UA->timeout($PROXY_CONFIG->{TIMEOUT});
  194.   #上位プロクシの設定(FORWARD_PROXY(http,httpsのみ)、環境変数)
  195.   #優先順位はFORWARD_PROXY > 環境変数
  196.   $UA->env_proxy();
  197.   if ($PROXY_CONFIG->{FORWARD_PROXY}) {
  198.     $UA->proxy([qw(http https)], $PROXY_CONFIG->{FORWARD_PROXY});
  199.   }
  200.   #TEヘッダーの付加をしないように設定する
  201.   if ($PROXY_CONFIG->{DISABLE_TE_HEADER}) {
  202.     push(@LWP::Protocol::http::EXTRA_SOCK_OPTS, SendTE => 0);
  203.   }
  204.   else {
  205.     push(@LWP::Protocol::http::EXTRA_SOCK_OPTS, SendTE => 1);
  206.   }
  207.   #セマフォの設定
  208.   if ($PROXY_CONFIG->{MAXIMUM_CONNECTIONS} > 1) {
  209.     $semaphore  = Thread::Semaphore->new($PROXY_CONFIG->{MAXIMUM_CONNECTIONS});
  210.   }
  211.   else {
  212.     $semaphore  = Thread::Semaphore->new(1);
  213.   }
  214. }
  215.  
  216. sub print_log() {
  217.   my $level  = shift;
  218.   my @args = @_;
  219.   if ($level <= $log_level) {
  220.     print Encode::encode($charcode, join("", @args));
  221.   }
  222.   return 0;
  223. }
  224.  
  225. #help
  226. sub help() {
  227.   print encode($charcode,
  228.         "Usage: 2chproxy [options]\n".
  229.         "\tWebスクレイピングも一応出来るプロクシ。\n".
  230.         "\tLinuxでJD使ってる人用だけど他のでも動くかも。\n".
  231.         "\tこのプロクシはユーザーが保存しているdatファイルを\n".
  232.         "\t読みにいこうとするので一般ユーザー以外での起動は\n".
  233.         "\tあまりおすすめしない。\n".
  234.         "\tまた、その場合はRangeヘッダーに対応できないので注意。\n".
  235.         "\tOption:\n".
  236.         "\t\t-d|--daemon\n".
  237.         "\t\t\tデーモンとして動かす。バックグラウンドで動くので\n".
  238.         "\t\t\tいちいちターミナルを開きっぱなしにしなくていい。\n".
  239.         "\t\t-h|--help\n".
  240.         "\t\t\tこのテキストを表示する。\n".
  241.         "\t\t-k|--kill\n".
  242.         "\t\t\tすでに起動している2chproxyを終了させる。\n".
  243.         "\t\t\t2chproxy --daemonと書いてあるシェルスクリプトと\n".
  244.         "\t\t\t2chproxy --killと書いてあるシェルスクリプトを用意すると\n".
  245.         "\t\t\tそれぞれ起動用と終了用として使えるかも。\n".
  246.         "\t\t\t時々--killしても2重起動云々と起こられる場合があるけど\n".
  247.         "\t\t\tその時はrm ".$pid_file_name."してくれれば大丈夫なはず。\n"
  248.       );
  249.   exit 0;
  250. }
  251.  
  252. sub settings() {
  253.   #stub
  254. }
  255.  
  256. #コマンドラインの取得
  257. sub getopt() {
  258.   GetOptions(
  259.     "daemon|d" => \$is_daemon,
  260.     "help|h" => \$help,
  261.     "kill|k" => \$kill_process,
  262.     "settings|s" => \$settings,
  263.     "verbose|v" => \$verbose
  264.   );
  265. }
  266.  
  267. #既にプロクシが起動しているか
  268. #戻り値:
  269. # 起動している:プロクシのpid
  270. # 起動していない:0
  271. sub is_running() {
  272.   my $lock_file;
  273.   if (open ($lock_file, "<", $pid_file_name)) {
  274.     my $pid;
  275.     if (read($lock_file, $pid, -s $pid_file_name)) {
  276.       &print_log(LOG_INFO, "pid: ".$pid."\n");
  277.       return $pid+0;
  278.     }
  279.     close ($lock_file);
  280.   }
  281.   undef $lock_file;
  282.   return 0;
  283. }
  284.  
  285. #起動中のプロクシを殺す
  286. sub kill() {
  287.   my $pid = $_[0];
  288.   if ("$pid" =~ m|^[\d]+$|) {
  289.     &print_log(LOG_INFO, "kill process: ".$pid."\n");
  290.     kill('INT', $pid+0);
  291.   }
  292.   else {
  293.     &print_log(LOG_DEBUG, "illegal pid: ".$pid."\n");
  294.   }
  295. }
  296.  
  297. #シグナルへの対処
  298. sub set_signal() {
  299.   $SIG{PIPE}  = sub {
  300.     &print_log(LOG_NOTICE, "Broken pipe\n");
  301.   };
  302.   $SIG{INT} = sub {
  303.     unlink $pid_file_name;
  304.     exit 0;
  305.   };
  306.   $SIG{TERM}  = sub {
  307.     unlink $pid_file_name;
  308.     exit 0;
  309.   };
  310. }
  311.  
  312. #デーモン化(*nix向け?)
  313. #そこそこちゃんと作ったけど
  314. #少なくともWinだとうまく動作しない
  315. #start-stop-daemonとかdaemonとか
  316. #そういうものが使える人はそっちを使った方がいいと思う
  317. sub demonize() {
  318.   fork() and exit 0;
  319.   POSIX::setsid();
  320.   fork() and exit 0;
  321.   umask 0;
  322.   chdir '/';
  323.   open(STDIN, '<', $null_device) or die;
  324.   open(STDOUT, '>', $log_file_name) or die;
  325.   open(STDERR, '>', $log_file_name) or die;
  326.   return 0;
  327. }
  328.  
  329. #pidの書き込み
  330. sub exclusive_lock() {
  331.   my $lock_file;
  332.   open ($lock_file, ">", $pid_file_name) or die "cannot open pid file: ".$pid_file_name."\n";
  333.   print $lock_file $$;
  334.   close ($lock_file);
  335.   undef $lock_file;
  336. }
  337.  
  338. sub html2dat() {
  339.   my $html  = $_[0];
  340.   my $title = 0;
  341.   my @dat;
  342.   my $res_del_tail_br = '<br><br>';                                     #末尾の<br> <br>を消す
  343.   my $res_del_a = '<a\shref=[^>]+>([^&][^<]*)</a>';                     #安価以外のリンクを消す
  344.   my $res_del_img = '<img\s*src="http://(img\.2ch\.net/[^"]*)"\s*/?>';  #BEの絵文字をsssp://に
  345.  
  346.   foreach my $line (split(/\n/, $html)) {
  347.     chomp $line;
  348.     &print_log(LOG_DEBUG, $line."\n");
  349.     if (!$title) {
  350.       if ($line =~ m/$PROXY_CONFIG->{TITLE_REGEX}/) {
  351.         $line =~ s|$PROXY_CONFIG->{TITLE_REGEX}|$1|g;
  352.         $title  = $line;
  353.         &print_log(LOG_INFO, $title."\n");
  354.       }
  355.       next;
  356.     }
  357.     &print_log(LOG_DEBUG, "line\n");
  358.     if ($line =~ m/$PROXY_CONFIG->{RESPONSE_REGEX}/) {
  359.       my $res_number;
  360.       $res_number = $1+0;
  361.       &print_log(LOG_DEBUG, "res_number: ".$res_number."\n");
  362.       $line = "$3<>$2<>$4 $5<>$6<>";
  363.       if ($5 && $6) {
  364.         $line = "$3<>$2<>$4 BE:$5-$6<>$7<>";
  365.       }
  366.       else {
  367.         $line = "$3<>$2<>$4<>$7<>";
  368.       }
  369.       $line =~ s|$res_del_tail_br||g;
  370.       $line =~ s|$res_del_a|$1|g;
  371.       $line =~ s|$res_del_img|sssp://$1|g;
  372.       if ($res_number == 1) {
  373.         $line .= $title;
  374.       }
  375.       &print_log(LOG_DEBUG, $line."\n");
  376.       push(@dat, $line);
  377.     }
  378.   }
  379.   return @dat;
  380. }
  381.  
  382. #保持しているcookieをスカラーの文字列で返す
  383. sub get_cookie() {
  384.   my ($domain)  = @_;
  385.   my @cookie_array;
  386.   &print_log(LOG_INFO, 'set cookie for '.$domain."\n");
  387.   foreach my $key (@{$PROXY_CONFIG->{HANDLED_COOKIES}}) {
  388.     lock(%cookie);
  389.     if ($cookie{$domain.'@'.$key}) {
  390.       &print_log(LOG_INFO, 'add cookie: '.$key."\n");
  391.       push(@cookie_array, $key.'='.$cookie{$domain.'@'.$key});
  392.     }
  393.   }
  394.   &print_log(LOG_INFO, 'cookie_array: '.($#cookie_array+1)."\n");
  395.   #cookieが存在しない場合はundefを返す
  396.   if ($#cookie_array == -1) {
  397.     return undef;
  398.   }
  399.   return join("; ", @cookie_array);
  400. }
  401.  
  402. #Cookieヘッダーの配列からCookieを取り出す
  403. sub extract_cookie() {
  404.   my @headers  = @_;
  405.   my %cookie_args;
  406.   my $domain;
  407.   foreach my $header (@headers) {
  408.     foreach my $cookie_arg (split(/;/, $header)) {
  409.       my ($key, $value) = split(/=/, $cookie_arg);
  410.       #先頭の空白を削除
  411.       $key  =~ s|^\s*||;
  412.       $cookie_args{$key}  = $value;
  413.     }
  414.   }
  415.   $domain = $cookie_args{"domain"};
  416.   &print_log(LOG_INFO, 'extract cookies from '.$domain."\n");
  417.   foreach my $key (@{$PROXY_CONFIG->{HANDLED_COOKIES}}) {
  418.     if ($cookie_args{$key}) {
  419.       &print_log(LOG_INFO, 'cookie found: '.$key."\n");
  420.       lock(%cookie);
  421.       $cookie{$domain.'@'.$key} = $cookie_args{$key};
  422.     }
  423.     else {
  424.       &print_log(LOG_INFO, 'cookie not found: '.$key."\n");
  425.     }
  426.   }
  427.   #特定条件下では保持しているクッキーを削除する
  428.   if ($PROXY_CONFIG->{UNIQ_COOKIE}) {
  429.     lock(%cookie);
  430.     if ($cookie{$domain.'@'.'PREN'}) {
  431.       undef %cookie;
  432.     }
  433.   }
  434. }
  435.  
  436. #専ブラ依存のdatファイルの場所を返す
  437. #今のところ.2ch.netと.bbspink.com以外のドメインは飛んでこないことを前提としている
  438. sub get_local_dat_path() {
  439.   my ($host, $domain, $category, $dat) = @_;
  440.   my $file_path = "";
  441.   if ($dedicated_browser =~ m@^(?:JD|Navi2ch)$@i) {
  442.     $file_path  = $dat_directory.$host.$domain.'/'.$category.'/'.$dat.'.dat';
  443.   }
  444.   elsif ($dedicated_browser =~ m@^V2C$@i) {
  445.     $domain =~ s|^\.?([^\.]*)\..*|$1_|;
  446.     if ($dat_directory |~ m@/log/@) {
  447.       $dat_directory  .= 'log/';
  448.     }
  449.     $file_path  = $dat_directory.$domain.'/'.$category.'/'.$dat.'.dat';
  450.   }
  451.   elsif ($dedicated_browser =~ m|^Live2ch$|i) {
  452.     if ($dat_directory !~ m|/log/$|) {
  453.       $dat_directory  .= "log/";
  454.     }
  455.     $file_path  = $dat_directory.$host.$domain.'/'.$category.'/'.$dat.'.dat';
  456.   }
  457.   elsif ($dedicated_browser =~ m|^gikoNavi$|i) {
  458.     $domain =~ s|^\.([^\.]*)\..*|$1|;
  459.     #bbspinkも2ch
  460.     if ($domain eq 'bbspink') {
  461.       $domain = '2ch';
  462.     }
  463.     if ($dat_directory !~ m|/Log/$|) {
  464.       $dat_directory  .= 'Log/';
  465.     }
  466.     $file_path  = $dat_directory.$domain.'/'.$category.'/'.$dat.'.dat';
  467.   }
  468.   elsif ($dedicated_browser =~ m|^rep2$|i) {
  469.     #ドメインが.2ch.net、.bbspink.comのどちらの場合も
  470.     #2channelへ変更する
  471.     if ($domain =~ m@(?:\.2ch\.net|\.bbspink\.com)@) {
  472.       $domain = '2channel';
  473.       $file_path  = $dat_directory.$domain.'/'.$category.'/'.$dat.'.dat';
  474.     }
  475.   }
  476.   if (!$file_path) {
  477.     &print_log(LOG_INFO, "no match type of 専ブラ: ".$dedicated_browser.".\n")
  478.   }
  479.   return $file_path;
  480. }
  481.  
  482. sub get_local_dat_content() {
  483.   my ($file_name) = @_;
  484.   my $file;
  485.   my $content;
  486.  
  487.   if (open($file, '<', $file_name)) {
  488.     #スカラー変数にファイルを全部ぶち込むため
  489.     #改行を表す変数をundefにして改行を検知させないようにする
  490.     local $/  = undef;
  491.     $content  = <$file>;
  492.     close($file);
  493.   }
  494.   else {
  495.     return undef;
  496.   }
  497.   undef $file;
  498.   #ギコナビのみ改行コードがCRLFになっているので直す
  499.   if ($dedicated_browser =~ m|^gikoNavi|i) {
  500.     $content =~ s|\r\n|\n|g;
  501.   }
  502.   return $content;
  503. }
  504.  
  505. #tcpレベルでの通信部分
  506. sub tcp_connection() {
  507.   my ($client, $server) = @_;
  508.   #変更前の値を保存
  509.   my $c_autoflush = $client->autoflush;
  510.   my $c_blocking  = $client->blocking;
  511.   my $s_autoflush = $server->autoflush;
  512.   my $s_blocking  = $server->blocking;
  513.   &print_log(LOG_DEBUG, "c_autoflush: ".$c_autoflush."\n");
  514.   &print_log(LOG_DEBUG, "c_blocking: ".$c_blocking."\n");
  515.   &print_log(LOG_DEBUG, "s_autoflush: ".$s_autoflush."\n");
  516.   &print_log(LOG_DEBUG, "s_blocking: ".$s_blocking."\n");
  517.   #自動でflushさせる、ブロッキングしない
  518.   $client->autoflush(1);
  519.   $client->blocking(0);
  520.   $server->autoflush(1);
  521.   $server->blocking(0);
  522.   my $buffer;   #送受信のバッファー
  523.   my $rbits;    #select(2)で使う、ファイルディスクリプタ(fd)を添字としたビット配列?
  524.   my $wbits;    #select(2)で使うかもしれない
  525.   my $rlen;     #読み込んだバッファーの長さ
  526.   my $wlen;     #書き込んだバッファーの長さ
  527.   while(1) {
  528.     #select(2)の準備
  529.     vec($rbits, fileno($client), 1)  = 1;
  530.     vec($rbits, fileno($server), 1)  = 1;
  531.     #TIMEOUT秒待つ
  532.     select($rbits, undef, undef, $PROXY_CONFIG->{TIMEOUT});
  533.     #クライアント側のfdが読み込み可能な状態であれば読み込みに行く
  534.     if (vec($rbits, fileno($client), 1)) {
  535.       $rlen = 0;
  536.       #デッドロックを考慮していないので結構危険
  537.       while (sysread($client, $buffer, $tcp_connection_buffer)) {
  538.         $rlen = length($buffer);
  539.         &print_log(LOG_DEBUG, "client read: ".$rlen."bytes\n");
  540.         $wlen = syswrite($server, $buffer, $rlen);
  541.         &print_log(LOG_DEBUG, "socket write: ".$wlen."bytes\n");
  542.       }
  543.       &print_log(LOG_DEBUG, "client read finished\n");
  544.       #読み込み可能にもかかわらず読み込むbyte列が無い場合は
  545.       #送るデータがないものとみなして通信を終了する
  546.       if (!$rlen) {
  547.         last;
  548.       }
  549.     }
  550.     else {
  551.       &print_log(LOG_DEBUG, "client can't read\n");
  552.     }
  553.     #サーバー側のfdが読み込み可能な状態であれば読み込みに行く
  554.     if (vec($rbits, fileno($server), 1)) {
  555.       $rlen = 0;
  556.       #デッドロックを考慮していないので結構危険
  557.       while (sysread($server, $buffer, $tcp_connection_buffer)) {
  558.         $rlen = length($buffer);
  559.         &print_log(LOG_DEBUG, "server read: ".$rlen."bytes\n");
  560.         $wlen = syswrite($client, $buffer, $rlen);
  561.         &print_log(LOG_DEBUG, "client write: ".$wlen."bytes\n");
  562.       }
  563.       &print_log(LOG_DEBUG, "server read finished\n");
  564.       #読み込み可能にもかかわらず読み込むbyte列が無い場合は
  565.       #送るデータがないものとみなして通信を終了する
  566.       if (!$rlen) {
  567.         last;
  568.       }
  569.     }
  570.     else {
  571.       &print_log(LOG_DEBUG, "server can't read\n");
  572.     }
  573.   }
  574.   #ソケットのautoflushとblockingを元の値に戻す(どうせこの後closeするしいらない処理?)
  575.   $client->autoflush($c_autoflush);
  576.   $client->blocking($c_blocking);
  577.   $server->autoflush($s_autoflush);
  578.   $server->blocking($s_blocking);
  579. }
  580.  
  581. #httpsな通信
  582. sub ssl_connection() {
  583.   my ($ref_client, $ref_request, $dport)  = @_;
  584.   my $client  = $$ref_client;
  585.   my $request = $$ref_request;
  586.   my $uri = $request->uri;
  587.   #CONNECTメソッドなので繋ぐだけ
  588.   my $socket  = IO::Socket::INET->new(
  589.     PeerAddr => $uri->host,
  590.     PeerPort => $dport,
  591.     Proto => 'tcp'
  592.   ) or return 'connection failed';
  593.   #クライアントへ200 Connection establishedを返す
  594.   &print_log(LOG_INFO, "return connection established\n");
  595.   my $str_connection_established  = $request->protocol." 200 Connection established\r\n\r\n";
  596.   syswrite($client, $str_connection_established, length($str_connection_established));
  597.   #通信の中身を見ずにtcpレベルで通信させる
  598.   &tcp_connection($client, $socket);
  599.   &print_log(LOG_INFO, "finished ssl connection\n");
  600.   #$clientはconnection()側で処理するのでこちら側ではcloseしない
  601.   close($socket);
  602.   return undef;
  603. }
  604.  
  605. #通信部分
  606. sub connection() {
  607.   my $client  = $_[0];
  608.   $semaphore->down(1);
  609.   &print_log(LOG_INFO, "start connection.\n");
  610.   while (my $request  = $client->get_request()) {
  611.     #接続先の表示
  612.     &print_log(LOG_INFO, $client->sockhost." : ".$request->method." ".$request->uri->as_string()."\n");
  613.     &print_log(LOG_DEBUG, $request->headers_as_string."\n");
  614.     my $uri = $request->uri;
  615.     my $dport;
  616.     if ($uri->as_string =~ m|^http://[^/]*(?::(\d+))|) {
  617.       $dport  = $1;
  618.       &print_log(LOG_INFO, "destination port is ".$dport."\n");
  619.     }
  620.  
  621.     if ($PROXY_CONFIG->{ENABLE_SSL_CONNECTION} && $dport == 443 && $request->method eq 'CONNECT') {
  622.       my $err = &ssl_connection(\$client, \$request, $dport);
  623.       if ($err) {
  624.         &print_log(LOG_INFO, $err."\n");
  625.       }
  626.       last;
  627.     }
  628.  
  629.     #一部のドメインへの接続はUAとクッキーを変更する
  630.     if ($uri->host =~ m@(\.2ch\.net|\.bbspink\.com)$@) {
  631.       my $domain  = $1;
  632.       if ($PROXY_CONFIG->{USER_AGENT}) {
  633.         &print_log(LOG_INFO, 'change user-agent:'.$request->header('User-Agent')."->".$PROXY_CONFIG->{USER_AGENT}."\n");
  634.         $request->header('User-Agent' => $PROXY_CONFIG->{USER_AGENT});
  635.       }
  636.       #クッキーが専ブラによって指定されていない場合は設定する
  637.       if ($PROXY_CONFIG->{KEEP_COOKIE}) {
  638.         my $cookie_str  = &get_cookie($domain);
  639.         if ($cookie_str) {
  640.           if ($request->header('Cookie')) {
  641.             $cookie_str = $request->header('Cookie')."; ".$cookie_str;
  642.           }
  643.           &print_log(LOG_INFO, 'Cookie: '.$cookie_str."\n");
  644.           $request->header('Cookie' => $cookie_str);
  645.         }
  646.       }
  647.     }
  648.  
  649.     #ウェブスクレイピングが無効かdat又は
  650.     #ホスト名がheadlineなドメインについてはあまり何もせずに返す
  651.     #ただし、一部ドメインに対してはクッキーを保存する
  652.     if (!$PROXY_CONFIG->{ENABLE_WEB_SCRAPING} || ( ($uri->as_string !~ m|$PROXY_CONFIG->{DAT_URL}|) || ($1 eq 'headline') ) ) {
  653.       my $sent_headers  = 0;
  654.       my $chunked = 0;
  655.       my $response  = $UA->simple_request($request,
  656.         #ここの関数内で受信したデータをクライアントへ逐次送信する
  657.         sub {
  658.           my ($chunk_data, $res, $proto) = @_;  #受信した部分的なコンテンツ、この通信のHTTP::Responseオブジェクト、何か
  659.           my $wlen;                             #ソケットに書き込んだ長さ
  660.           #クライアントへHTTPステータスとヘッダーを送っていない場合は送る
  661.           if (!$sent_headers) {
  662.             #受信したものにContent-Lengthヘッダーが存在しない場合は
  663.             #クライアントにchunked形式で返す
  664.             if (!$res->header('Content-Length')) {
  665.               &print_log(LOG_INFO, "chunked detected, content return as chunked\n");
  666.               $chunked  = 1;
  667.               $res->header('Transfer-Encoding' => 'chunked');
  668.             }
  669.             else {
  670.               &print_log(LOG_INFO, "Content-Length: ".$res->header('Content-Length')."\n");
  671.             }
  672.             #Client-*なヘッダーを削除
  673.             #特にClient-Transfer-Encodingは必ず削除する
  674.             #(JDはClient-Transfer-Encoding: chunkedがあるとchunked形式と判断しているような動作をするため)
  675.             foreach my $header (qw(Client-Peer Client-Response-Num Client-Transfer-Encoding)) {
  676.               if ($res->header($header)) {
  677.                 $res->remove_header($header);
  678.               }
  679.             }
  680.             #"\r\n"の指定はした方が良い
  681.             my $header = $res->as_string("\r\n");
  682.             &print_log(LOG_DEBUG, $header);
  683.             syswrite($client, $header, length($header));
  684.             $sent_headers = 1;
  685.           }
  686.           #コンテンツの部分はchunked形式で返すか否かで送信方法を分ける
  687.           if ($chunked) {
  688.             &print_log(LOG_DEBUG, sprintf("%x", length($chunk_data))."\r\n");
  689.             syswrite($client, sprintf("%x", length($chunk_data))."\r\n");
  690.             syswrite($client, $chunk_data."\r\n");
  691.           }
  692.           else {
  693.             syswrite($client, $chunk_data, length($chunk_data));
  694.           }
  695.         }
  696.       );
  697.       #一部ドメインへの接続はクッキーを保存する
  698.       if ($uri->host =~ m@(\.2ch\.net|\.bbspink\.com)$@) {
  699.         if ($PROXY_CONFIG->{KEEP_COOKIE} && $response->header('Set-Cookie')) {
  700.           &print_log(LOG_INFO, "Set-Cookie header found\n");
  701.           &extract_cookie($response->header('Set-Cookie'));
  702.         }
  703.       }
  704.       #chunked形式の場合はコールバック内でフッターが送れないのでここで送る
  705.       if ($chunked) {
  706.         &print_log(LOG_DEBUG, "0\r\n\r\n");
  707.         syswrite($client, "0\r\n\r\n");
  708.       }
  709.       # HEADリクエストと20x以外の応答(要はコンテンツの無いレスポンス)と
  710.       # Content-Lengthが0な20x応答は
  711.       # 上のコールバックが呼ばれないのでこちらで処理する
  712.       # if ( ($request->method eq 'HEAD') || (!$response->is_success) ) {
  713.       #上のコールバックが呼ばれない->コールバック内でヘッダー周りを処理出来ていないのとほぼ同等なので
  714.       #シンプルなこちらを分岐に使う
  715.       elsif (!$sent_headers) {
  716.         $client->send_response($response);
  717.       }
  718.       &print_log(LOG_INFO, $response->status_line."\n");
  719.       next;
  720.     }
  721.  
  722.     my $last_res;         #リクエストされたURIに対するメモリ上のキャッシュ/ローカルのdatファイルの中で最新のレス
  723.     my $host  = $1;
  724.     my $domain  = $2;
  725.     my $category  = $4;
  726.     my $dat = $5;
  727.     my $is_gzip = $6;
  728.     #URLをハッシュのキーにしようと思ったけど一部板で
  729.     #host名が違っても同じデータを寄越すものがあったので
  730.     #(kilauea.bbspink.comとaoi.bbspink.com、他にも板移転があった場合?)
  731.     #ドメイン、カテゴリ、datの3つをハッシュのキーに設定
  732.     my $hash_key  = $2.$4.$5;
  733.     my $rewrite_uri  = "http://".$host.$domain."/test/read.cgi/".$category."/".$dat."/";
  734.     my $range;
  735.     my $expected_partial_content;
  736.     my $expected_head_response;
  737.     #HEADでdatが更新されたかのみを確認する場合は
  738.     #レスポンスからコンテンツを取り除く
  739.     if ($request->method eq 'HEAD') {
  740.       &print_log(LOG_INFO, 'change method: '.'HEAD'.'->'.'GET'."\n");
  741.       $expected_head_response = 1;
  742.       $request->method('GET');
  743.     }
  744.     #スクレイピング時にENABLE_PARTIAL_CONTENTを有効にしていれば
  745.     #Rangeヘッダーを見に行って差分取得を行う
  746.     if ($PROXY_CONFIG->{ENABLE_PARTIAL_CONTENT} && $request->header('Range') =~ m|^bytes=(\d+)-$|) {
  747.       $range  = $1;
  748.       &print_log(LOG_INFO, 'Range header found: '.$range.'-'."\n");
  749.       #メモリ上のキャッシュに前回のアクセス時のものがあればそれを利用
  750.       if ($PROXY_CONFIG->{ENABLE_MEMORY_CACHE}) {
  751.         {
  752.           lock(%mem_cache_dat_last_num);
  753.           lock(%mem_cache_dat_last_str);
  754.           lock(%mem_cache_dat_length);
  755.           if ($mem_cache_dat_last_num{$hash_key} && $mem_cache_dat_last_str{$hash_key} && $mem_cache_dat_length{$hash_key}) {
  756.             $last_res = $mem_cache_dat_last_str{$hash_key};
  757.             &print_log(LOG_INFO, "cache found, last res: ".$last_res."\n");
  758.             $rewrite_uri  .= $mem_cache_dat_last_num{$hash_key}."n-";
  759.           }
  760.           else {
  761.             &print_log(LOG_INFO, "cache not found, try to read local dat file\n");
  762.           }
  763.         }
  764.       }
  765.       #無い場合はローカルのdatファイルからの読み込みを試みる
  766.       if (!$last_res) {
  767.         my $local_dat_file_name = &get_local_dat_path($host, $domain, $category, $dat);
  768.         &print_log(LOG_INFO, 'dat file path: '.$local_dat_file_name."\n");
  769.         my $local_dat_size;
  770.         my $local_dat_content = &get_local_dat_content($local_dat_file_name);
  771.         if ($local_dat_content) {
  772.           my @local_dat_content_array = split(/\n/, $local_dat_content);
  773.           if ($#local_dat_content_array > 0) {
  774.             {
  775.               lock(%mem_cache_dat_last_num);
  776.               lock(%mem_cache_dat_last_str);
  777.               lock(%mem_cache_dat_length);
  778.               $mem_cache_dat_last_num{$hash_key}  = $#local_dat_content_array+1;
  779.               $rewrite_uri  .= $mem_cache_dat_last_num{$hash_key}."n-";
  780.               #内部文字列で保持しておきたいので内部文字列にデコード
  781.               $mem_cache_dat_last_str{$hash_key}  = Encode::decode('cp932', $local_dat_content_array[$#local_dat_content_array]);
  782.               $last_res = $mem_cache_dat_last_str{$hash_key};
  783.               $mem_cache_dat_length{$hash_key}  = length($local_dat_content);
  784.               &print_log(LOG_INFO, "local dat length: ".$mem_cache_dat_length{$hash_key}."\n");
  785.             }
  786.             &print_log(LOG_INFO, "local dat found, last res: ".$last_res."\n");
  787.           }
  788.         }
  789.       }
  790.       #メモリ上にもローカルにも差分取得のための情報が無い場合は
  791.       #全レス取得してそこからRangeの該当部分を返す
  792.       if (!$last_res) {
  793.         $expected_partial_content = 1;
  794.       }
  795.       else {
  796.         #レス数が1001に到達している場合は304を返す
  797.         my $response;
  798.         {
  799.           lock(%mem_cache_dat_last_num);
  800.           if ($mem_cache_dat_last_num{$hash_key} >= 1001) {
  801.             &print_log(LOG_INFO, 'this thread already reached '.(1001)."\n");
  802.             $response = HTTP::Response->new(304, 'Not Modified');
  803.           }
  804.         }
  805.         if ($response) {
  806.           $client->send_response($response);
  807.           next;
  808.         }
  809.       }
  810.     }
  811.     &print_log(LOG_INFO, 'rewrite_uri: '.$rewrite_uri."\n");
  812.     $request->uri($rewrite_uri);
  813.  
  814.     #416を応答されないようにRangeヘッダーを削除
  815.     if ($request->header('Range')) {
  816.       $request->remove_header('Range');
  817.     }
  818.  
  819.     my $response  = $UA->simple_request($request);
  820.     &print_log(LOG_INFO, "response: ".$response->status_line."\n");
  821.  
  822.     #忘れぬ内にクッキーの保存
  823.     if ($PROXY_CONFIG->{KEEP_COOKIE} && $response->header('Set-Cookie')) {
  824.       &print_log(LOG_INFO, "Set-Cookie header found\n");
  825.       &extract_cookie($response->header('Set-Cookie'));
  826.     }
  827.  
  828.     #20x以外の応答は何もせずにクライアントへ返す
  829.     if (!$response->is_success()) {
  830.       &print_log(LOG_NOTICE, "Server didn't return 20x\n");
  831.       $client->send_response($response);
  832.       next;
  833.     }
  834.  
  835.     #Last-Modifiedヘッダーが無い場合は
  836.     #Dateヘッダーの値をコピーする
  837.     if (!$response->header('Last-Modified')) {
  838.       &print_log(LOG_INFO, "add Last-Modified header\n");
  839.       $response->header('Last-Modified' => $response->header('Date'));
  840.     }
  841.     #Dateがダブっているので片方削除
  842.     $response->remove_header('Date');
  843.  
  844.     &print_log(LOG_INFO, "convert html to dat\n");
  845.     my @content_array  = &html2dat($response->decoded_content(charset => 'cp932'));
  846.     &print_log(LOG_INFO, "size of content_array: ".($#content_array+1)."\n");
  847.  
  848.     #chunkedは消毒だー
  849.     if (defined($response->header("Transfer-Encoding"))) {
  850.       &print_log(LOG_INFO, "Transfer-Encoding defined.\n");
  851.       $response->remove_header("Transfer-Encoding");
  852.     }
  853.     if (defined($response->header("Client-Transfer-Encoding"))) {
  854.       &print_log(LOG_INFO, "Client-Transfer-Encoding defined.\n");
  855.       $response->remove_header("Client-Transfer-Encoding");
  856.     }
  857.  
  858.     my $content;
  859.     #last_resが存在する==クライアントには206を返すべきである
  860.     if ($last_res) {
  861.       my $first_res;          #デバッグ用、受信した中で最初のレス
  862.       #取得レス数が一個なら
  863.       #更新していないので304を返す
  864.       if ($#content_array == 0) {
  865.         &print_log(LOG_INFO, "content not modified\n");
  866.         $response = HTTP::Response->new(304, 'Not Modified');
  867.         $client->send_response($response);
  868.         next;
  869.       }
  870.       #更新が存在する場合は前回通信時での最新のレスと
  871.       #今回通信時の最初のレスが一致していれば206を返す
  872.       elsif ($last_res eq ($first_res = shift(@content_array))) {
  873.         {
  874.           lock(%mem_cache_dat_length);
  875.           #Rangeの値として不適切(というかクライアント側でファイルが壊れている云々と言うはず)
  876.           #なので416を返す
  877.           if ($range > $mem_cache_dat_length{$hash_key}) {
  878.             &print_log(LOG_NOTICE, 'invalid range: '.$range."\n");
  879.             &print_log(LOG_NOTICE, 'dat length: '.$mem_cache_dat_length{$hash_key}."\n");
  880.             $response = HTTP::Response->new(416, 'Requested Range Not Satisfiable');
  881.             $client->send_response($response);
  882.             #メモリのキャッシュを削除
  883.             {
  884.               lock(%mem_cache_dat_last_num);
  885.               $mem_cache_dat_last_num{$hash_key}  = undef;
  886.             }
  887.             {
  888.               lock(%mem_cache_dat_last_str);
  889.               $mem_cache_dat_last_str{$hash_key}  = undef;
  890.             }
  891.             {
  892.               lock(%mem_cache_dat_length);
  893.               $mem_cache_dat_length{$hash_key}  = undef;
  894.             }
  895.             next;
  896.           }
  897.           #rangeの方が小さい時(専ブラがエラー検出を行おうとしている時)は
  898.           #その分だけ前回の最新のレスからコピーする
  899.           #前回の最新のレスより大きなbyte数でエラー検出を行おうとしている場合は
  900.           #*未定義*
  901.           #(多分クライアントが"ファイルが壊れている"と言うはず)
  902.           elsif ($range < $mem_cache_dat_length{$hash_key}) {
  903.             my $error_detection  = Encode::encode('cp932', $last_res."\n");
  904.             $content  = substr($error_detection, $range-$mem_cache_dat_length{$hash_key});
  905.           }
  906.           $content  .= Encode::encode('cp932', join("\n", @content_array)."\n");
  907.           #差分を取得した分だけメモリのキャッシュを更新する
  908.           #ただし更新チェックのみ(methodがHEADなリクエスト)だった場合は更新しない
  909.           if (!$expected_head_response) {
  910.             {
  911.               lock(%mem_cache_dat_last_num);
  912.               $mem_cache_dat_last_num{$hash_key}  += $#content_array +1;
  913.             }
  914.             {
  915.               lock(%mem_cache_dat_last_str);
  916.               $mem_cache_dat_last_str{$hash_key}  = pop(@content_array);
  917.             }
  918.             {
  919.               lock(%mem_cache_dat_length);
  920.               $mem_cache_dat_length{$hash_key}  = $range+length($content);
  921.             }
  922.           }
  923.         }
  924.         &print_log(LOG_INFO, "content returned as partial content\n");
  925.         $response->code(206);
  926.         $response->message('Partial Content');
  927.         #206用のヘッダーを追加
  928.         $response->header('Accept-Range' => 'bytes');
  929.         &print_log(LOG_INFO, 'add header Content-Range: '.'bytes '.$range.'-'.($range+length($content)-1).'/'.($range+length($content))."\n");
  930.         $response->header('Content-Range' => 'bytes '.$range.'-'.($range+length($content)-1).'/'.($range+length($content)));
  931.       }
  932.       #レスが一致していないので416を返す
  933.       else {
  934.         &print_log(LOG_NOTICE, "responses don't match\n");
  935.         &print_log(LOG_INFO, "last  res: ".$last_res."\n");
  936.         &print_log(LOG_INFO, "first res: ".$first_res."\n");
  937.         $response = HTTP::Response->new(416, 'Requested Range Not Satisfiable');
  938.         $client->send_response($response);
  939.         #メモリのキャッシュを削除する
  940.         {
  941.           lock(%mem_cache_dat_last_num);
  942.           $mem_cache_dat_last_num{$hash_key}  = undef;
  943.         }
  944.         {
  945.           lock(%mem_cache_dat_last_str);
  946.           $mem_cache_dat_last_str{$hash_key}  = undef;
  947.         }
  948.         {
  949.           lock(%mem_cache_dat_length);
  950.           $mem_cache_dat_length{$hash_key}  = undef;
  951.         }
  952.         next;
  953.       }
  954.     }
  955.     #全レス取得時
  956.     else {
  957.       #html2datでの変換に失敗、または2ch側がエラーを返してきた
  958.       #(datが見つかりません的なもの)場合は302を返す
  959.       #info.2ch.net/index.php/Monazilla/develop/dat#未稿によれば
  960.       #302になる度.dat->kako.dat.gz->kako.dat[->offlaw.cgi]の順に使用
  961.       if (!@content_array || !$content_array[0]) {
  962.         &print_log(LOG_NOTICE, "content not found, returned as 302\n");
  963.         $response = HTTP::Response->new(302, 'Found');
  964.         #元のuriから次にLocationとして設定すべきuriを生成するのが面倒なので
  965.         #人大杉のurlを返しておく
  966.         #上コメント内のurlを見る限りではLocationヘッダーは見ないのだと思うが
  967.         #Locationヘッダーを見る専ブラはもしかしたらうまく過去ログ参照しないかも
  968.         $response->header('Location' => 'http://www2.2ch.net/live.html');
  969.         $client->send_response($response);
  970.         next;
  971.       }
  972.       $content  = Encode::encode('cp932', join("\n", @content_array)."\n");
  973.       {
  974.         lock(%mem_cache_dat_last_num);
  975.         $mem_cache_dat_last_num{$hash_key}  = $#content_array +1;
  976.         &print_log(LOG_INFO, "last num: ".($#content_array+1)."\n");
  977.       }
  978.       {
  979.         lock(%mem_cache_dat_last_str);
  980.         $mem_cache_dat_last_str{$hash_key}  = pop(@content_array);
  981.         &print_log(LOG_INFO, "last str: ".$mem_cache_dat_last_str{$hash_key}."\n");
  982.       }
  983.       {
  984.         lock(%mem_cache_dat_length);
  985.         $mem_cache_dat_length{$hash_key}  = length($content);
  986.         &print_log(LOG_INFO, "length: ".length($content)."\n");
  987.       }
  988.       if ($expected_partial_content) {
  989.         #リクエストにRangeヘッダーがあり206を返すのが期待されている場合は
  990.         #Rangeの範囲にあわせて206,416のどちらかを返す
  991.         if ($range < length($content)) {
  992.           &print_log(LOG_INFO, "content returned as partial content\n");
  993.           $content  = substr($content, $range);
  994.           $response->code(206);
  995.           $response->message('Partial Content');
  996.           #206用のヘッダーを追加
  997.           $response->header('Accept-Range' => 'bytes');
  998.           &print_log(LOG_INFO, 'add header Content-Range: '.'bytes '.$range.'-'.($range+length($content)-1).'/'.($range+length($content))."\n");
  999.           $response->header('Content-Range' => 'bytes '.$range.'-'.($range+length($content)-1).'/'.($range+length($content)));
  1000.         }
  1001.         #Rangeの範囲がおかしいので416を返す
  1002.         else {
  1003.           &print_log(LOG_NOTICE, 'invalid range: '.$range."\n");
  1004.           &print_log(LOG_NOTICE, 'dat length: '.$mem_cache_dat_length{$hash_key}."\n");
  1005.           $response = HTTP::Response->new(416, 'Requested Range Not Satisfiable');
  1006.           $client->send_response($response);
  1007.           #メモリのキャッシュを削除する
  1008.           {
  1009.             lock(%mem_cache_dat_last_num);
  1010.             $mem_cache_dat_last_num{$hash_key}  = undef;
  1011.           }
  1012.           {
  1013.             lock(%mem_cache_dat_last_str);
  1014.             $mem_cache_dat_last_str{$hash_key}  = undef;
  1015.           }
  1016.           {
  1017.             lock(%mem_cache_dat_length);
  1018.             $mem_cache_dat_length{$hash_key}  = undef;
  1019.           }
  1020.           next;
  1021.         }
  1022.       }
  1023.       #urlが.dat.gzだった場合はレスポンスの本体をgzipに圧縮する
  1024.       #Content-Typeをapplication/gzipにすることを忘れずに
  1025.       #過去ログはRangeが送られてこないはずなので処理部分はここだけでよいはず
  1026.       elsif ($is_gzip) {
  1027.         my $tmp;
  1028.         if (gzip \$content => \$tmp) {
  1029.           $content  = $tmp;
  1030.           $response->header('Content-Type' => 'application/gzip');
  1031.         }
  1032.         #gzip圧縮に失敗した場合は500を返す
  1033.         else {
  1034.           &print_log(LOG_ERR, $GzipError."\n");
  1035.           $response = HTTP::Response->new(500, 'Internal Server Error');
  1036.           $client->send_response($response);
  1037.           next;
  1038.         }
  1039.       }
  1040.     }
  1041.  
  1042.     #要求がHEADだった場合はContentに関するものを削除する
  1043.     if ($expected_head_response) {
  1044.       $content  = $response->content_ref;
  1045.       undef $content;
  1046.       $response->remove_header('Content-Length');
  1047.       if ($response->header('Content-Encoding')) {
  1048.         $response->remove_header('Content-Encoding');
  1049.       }
  1050.       $response->remove_header('Content-Type');
  1051.     }
  1052.     else {
  1053.       $response->content($content);
  1054.       $response->header('Content-Length' => length($content));
  1055.       if ($response->header('Content-Encoding')) {
  1056.         $response->remove_header('Content-Encoding');
  1057.       }
  1058.       #クライアントがgzipで圧縮したものを要求している場合は変更しない
  1059.       if (!$is_gzip && ($response->header('Content-Type') ne 'application/gzip') ) {
  1060.         $response->header('Content-Type' => 'text/plain');
  1061.       }
  1062.     }
  1063.     #クライアントに受けとったデータを流す
  1064.     $client->send_response($response);
  1065.   }
  1066.   $client->close();
  1067.   undef($client);
  1068.   &print_log(LOG_INFO, "finish connection.\n");
  1069.   $semaphore->up(1);
  1070. }
  1071.  
  1072. #
  1073. sub run_proxy() {
  1074.   my $proxy = HTTP::Daemon->new(
  1075.     LocalHost => $PROXY_CONFIG->{LISTEN_HOST},
  1076.     LocalPort => $PROXY_CONFIG->{LISTEN_PORT},
  1077.     ReuseAddr => 1  #
  1078.   ) or unlink $pid_file_name and die;
  1079.   &print_log(LOG_NOTICE, "listen to ".$proxy->url."\n");
  1080.   while (my $client = $proxy->accept()) {
  1081.     &print_log(LOG_INFO, "request received.\n");
  1082.     my $thread  = threads->new(\&connection, $client)->detach();
  1083.     #最大接続数を超える場合は現在の処理が終わるまで待つ
  1084.     $semaphore->down(1);
  1085.     $semaphore->up(1);
  1086.   }
  1087. }
  1088.  
  1089. sub load_config() {
  1090.   if ($PROXY_CONFIG->{PROXY_CONFIG_FILE} && -f $PROXY_CONFIG->{PROXY_CONFIG_FILE}) {
  1091.     require YAML::Tiny;
  1092.     my $YAML  = YAML::Tiny->read($PROXY_CONFIG->{PROXY_CONFIG_FILE});
  1093.     if ($YAML && $YAML->[0]) {
  1094.       foreach my $key (keys(%$PROXY_CONFIG)) {
  1095.         if ($YAML->[0]{$key}) {
  1096.           $PROXY_CONFIG->{$key} = $YAML->[0]{$key};
  1097.         }
  1098.       }
  1099.       #コンフィグファイルの読み込みに成功したらグローバル変数を一新する
  1100.       &initialize_global_var();
  1101.     }
  1102.   }
  1103. }
  1104.  
  1105. #初期化処理
  1106. sub initialize() {
  1107.   #コンフィグファイルの読み込み
  1108.   &load_config();
  1109.   #2重起動しているかの確認,起動中のプロクシの制御
  1110.   my $pid = &is_running();
  1111.   if ($pid) {
  1112.     if ($kill_process) {
  1113.       &kill($pid);
  1114.       exit 0;
  1115.     }
  1116.     &print_log(LOG_ERR, basename($0)." is already running.\n");
  1117.     &print_log(LOG_ERR, "if you kill ".basename($0).", please run this command: ".basename($0)." --kill\n");
  1118.     &print_log(LOG_ERR, "or : rm ".$pid_file_name."\n");
  1119.     exit 1;
  1120.   }
  1121.   elsif ($kill_process) {
  1122.     exit 0;
  1123.   }
  1124.   #プロセスのデーモン化
  1125.   if ($is_daemon) {
  1126.     &demonize();
  1127.   }
  1128.   #シグナルの設定
  1129.   &set_signal();
  1130.   #2重起動の防止
  1131.   &exclusive_lock();
  1132. }
  1133.  
  1134. #main
  1135. {
  1136.   #グローバル変数の初期化
  1137.   &initialize_global_var();
  1138.  
  1139.   &getopt();
  1140.   if ($help) {
  1141.     &help();
  1142.     exit 0;
  1143.   }
  1144.   elsif ($settings) {
  1145.     &print_settings();
  1146.     exit 0;
  1147.   }
  1148.   &initialize();
  1149.   &run_proxy();
  1150. }
  1151.  
  1152. ###   ChangeLog
  1153. #v0.1
  1154. #   初版。とりあえずスクレイピングは出来る状態
  1155. #v0.2
  1156. #   サーバーから受けとったクッキーをプロクシ側で保持して通信に使用出来るように
  1157. #v0.3
  1158. #   Webスクレイピング時のRangeへ対応、アクセスも必要な部分だけを取りに行くようにした
  1159. #   スレの更新チェック(HEAD)へ仮対応
  1160. #   eqと==を間違えるとんでもないミスを修正
  1161. #   BEがちゃんと取得出来てなかったのを修正
  1162. #   daemon化をもうちょっとまともにした
  1163. #   整合性をとるのは諦めた
  1164. #   他細々した修正ときっと増えてるバグ
  1165. #v0.4
  1166. #   ssspなgifのimgタグ周りが処理されていなかったのを修正
  1167. #   V2C/Live2ch使用時のスクレイピング時の差分取得の対応(多分)
  1168. #   スクレイピング時の差分取得のエラー検出への対応を若干強化(デフォルトでは強化前のものを使用、現状では強化の意味はなし)
  1169. #   多分増えたバグ
  1170. #v0.5
  1171. #   ギコナビでスクレイピング時の差分取得に対応
  1172. #v0.6
  1173. #   デフォルトでスクレイピングするように変更
  1174. #v0.7
  1175. #   SIGPIPEを無視するように変更
  1176. #v0.8
  1177. #   LWP::UserAgentによるTEヘッダーの挿入を抑制
  1178. #   .bbspink.comでもクッキーを保持できるようにした
  1179. #   .2ch.net、.bbspink.comへのアクセス時はUAを変更出来るようにした
  1180. #v0.9
  1181. #   Navi2chで差分取得出来るようにした
  1182. #v0.10
  1183. #   rep2(rep2スレを見るに多分rep2exの方)の差分取得に対応
  1184. #v0.11
  1185. #   差分取得に対応していない専ブラに対しては全レス取得してそこから
  1186. #   rangeに対応した部分だけ返すことで専ブラ側からは差分取得出来ているようにした
  1187. #v0.12
  1188. #   最新のレス等をキャッシュするようにした(ので実質的に全部の専ブラで差分取得出来るはず)
  1189. #   use IO::HTML;することでdecoded_contentでエラーをこっそり吐かれることがないようにした
  1190. #v0.13
  1191. #   v0.12で消えたHEADへの対応を追加
  1192. #   timeoutの値を設定できるようにした(これに起因するバグを修正するため)
  1193. #   [protocol]_proxyの環境変数に対応
  1194. #v0.13.1
  1195. #   v0.13でHEADへの対応がちゃんと出来ていなかったので修正
  1196. #v0.14
  1197. #   1001レスに達したら304を返して鯖と通信しない機能がv0.12で消えていたので修正
  1198. #   DEDICATED_BROWSER=>"rep2"が実質的にrep2ex用の設定になっていた(なってすらいなかった?)のを
  1199. #   無印rep2用の設定になるように修正
  1200. #   また、どうやらrep2(ex)の両方ともbbspink.comのdatは
  1201. #   2channelディレクトリの方に保存される*らしい*ので
  1202. #   そっちを見に行くように変更
  1203. #   rep2exを使っている人はDAT_DIRECTORYのパスの最後に"dat/"を追加する必要があるかもしれない
  1204. #v0.15
  1205. #   IO::HTMLは使わなくなっていたので削除
  1206. #   過去ログっぽいアクセスもurl書き換えの対象にした(但し正規表現は割と適当)
  1207. #   datが見つかりませんよ的なエラーが鯖から返ってきた時は302を返すようにした
  1208. #   過去ログへのアクセスのuriが.dat.gzな場合はgzipで圧縮したものをクライアントへ返すようにした
  1209. #   このため新たにIO::Compress::Gzipが追加された(コアモジュールだから何もいれなくて良い*はず*)
  1210. #v0.16
  1211. #   受信したリクエストにクッキーがある場合でKEEP_COOKIEが1ならプロクシ側で保持していたクッキーを追加するように変更
  1212. #   https通信を出来るようにした、ただし現状ではhttps通信は上位プロクシを通らないので注意
  1213. #   yamlファイルが存在した時に読み込む用にした、yamlファイルを使いたい場合にはYAML::Tinyが必要
  1214. #v0.17
  1215. #   chunkedなレスポンスはchunkedで返すように変更、画像等の大きなデータもこれで処理できるようになった*はず*
  1216. #   ssl通信でtcpレベルで通信させる部分を他のでも使えるかなーと思い関数にした、でも使わなさそう
  1217. #   yamlを読みに行くタイミングの関係で一部変数がちゃんと変わっていなかったのを修正
  1218. #   とりあえずheadlineも読み込めるようにした、DAT_URLが使われてる部分を弄っただけなので他のバージョンでも簡単に書き換え可能
  1219. #v0.17.1
  1220. #   v0.17でhelp呼びだし時に一部変数がundefになっていたのを修正
  1221. #v0.17.2
  1222. #   v0.17及びv0.17.1でContent-Lengthの値が0なレスポンス(したらば等)をクライアントへ返していない問題を修正
  1223. #   試験的にhttps通信(CONNECT)を有効化
  1224.  
  1225. #自分が把握しているバグっぽいもの
  1226. #rep2
  1227. #   書き込み後にStatus: 302 Foundという文字列が表示されてしまう
  1228. #   まちBBSのスレがうまく読み込めない?
  1229.  
  1230. #今後の予定のようなもの
  1231. #   ローカルのdatファイルのパスをリストで取得するようにするかもしれない
  1232. #   --reloadでコンフィグファイルを再読み込みするようにするかもしれない
  1233. #   CONNECTでも上位プロクシへ繋げられるようにするかもしれない
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!