#!/usr/local/bin/perl
# 気持ちよく抜いてあげるね( SSI 用 )
# 説明：
# Referer 抜いたのに見に行ったらすでに更新されていてなにが書かれていたかわからなくて、
# おもん NEeeeeeeee! って妙に虚無感といらだちを覚えるのを防ぐ精神的プログラム
# Ver 1.01
# Copyright(c) 2002 Yuumi
# http://gochagocha.org/		http://gochagocha.ribbon.to/
# gochagocha@ribbon.to	yuumi@gochagocha.org
#
#　本プログラムはフリーソフトウェアーです。使用するには以下の使用許諾事項をお守りください
#　商業出版物に掲載する場合は事前に上記連絡先まで連絡し全てにおいて使用許諾を取る必要があります
#
#　使用許諾事項
#　１．商用目的に使用してはいけません
#　２．著作権を削除して使用してはいけません
#　３．著作権を削除して２次創作物を作成する、又は２次配布を行ってはいけません
#　４．$mUserAgent から 御茶御茶そふとの URL を削除してはいけません
#
#
#　設置方法
#　１．上記の Perl の位置と、以下の $PageSaveDir を設定します。PROXY を使用する場合は PROXY の欄も設定します
#　２．設置する場所にアップロードをし、パーミッションを 700 又は 705 に変更します
#　３．$PageSaveDir に設定したディレクトリを作成します。パーミッションは 700 又は 705
#　４．表示する HTML に SSI のコードを書いて完成！
#
#
#　特徴
#　１．通常の Referer 抜きでは味わえない生の声が聞ける場合があります
#　２．初期設定が楽です

use CGI;
use IO::Socket;

use vars qw($cgi);

$cgi = CGI->new();

#ページを保存するディレクトリ(ご自身で作成する必要があります)
$PageSaveDir = './getpage/';

#----------------- PROXY SETTING ---------------------------
#proxy 接続では $connectserver に PROXY サーバ名を設定し、$UseProxy を 1 にする
$UseProxy = 0;
$ProxyServer = 'dokozono.proxy.servername';
$ProxyPort = 80; # HTTP or Proxy
#-----------------------------------------------------------

#----------------- EXTEND SETTING --------------------------
#保存時にヘッダを切り取る場合 1
$SaveCutHeader = 1;
#PROXY RETRUN CODE	\n or \r\n を入力
$ProxyReturnCode = "\r\n";

#単純に REFERER を保存する場合 1
#(保存する場合ファイルサイズが青天井ででかくなるので適当に削除などをすること)
$SavePureReferer = 1;
#保存するファイル名
$PureRefererFile = $PageSaveDir . 'referer.txt';

#-----------------------------------------------------------

$mUserAgent = 'Kimotiyoku Nuiteagerune(http://gochagocha.org/)';
$mReferer   = 'http://gochagocha.org/';

&Main( $ENV{'HTTP_REFERER'} );
exit;

sub Main{
	my $ref = shift;
	if( $ref ne '' ){
		&WriteReferer( $ref );
	}
}

sub WriteReferer{
	my $ref = shift;
	if( $ref =~ m|^http://| ){	&checkSource( $ref );	}
	if( $SaveCutHeader ){
		if( open( FI , ">>$PureRefererFile" )){
			print FI $ref . "\n";
			close( FI );
		}
	}
}

sub checkSource{
	my $ref = shift;
	my $wrFile,$SaveFile;
	my $serverHost , $serverPort , $serverFile;
	my $sendHeader,@recvData;
	my $BaseTag = '<base href="%%">' . "\n";

	( $wrFile = $ref ) =~ s|[:/\?\*\+\|\<\>\\]+|_|g;
	if( $wrFile =~ m|_$| ){	$wrFile .= '.html';	}
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$d,$d) = localtime(time);
	# 一時間ごとに Referer を取るのであれば hour をつけたりしてね。そこらへんは考えて
	my $SaveFile = &SaveDirCheck( $PageSaveDir . sprintf("%04d%02d%02d", $year + 1900 ,$mon + 1,$mday) . '/' ) . $wrFile;
#print $SaveFile . $ref;
	if( -e $SaveFile ){	return 0;	}
	$ref =~ m|http://(.*?)/(.*)|;
	$serverFile = $2;
	$serverHost = $1;
	if( $serverHost =~ m|(.*?):(.*)| ){
		$serverHost = $1;
		$serverPort = $2;
	}else{
		$serverPort = 80;
	}

	$sendHeader = &MakeSendData( $serverHost , $serverPort , '/' . $serverFile , $UseProxy );
	if( $UseProxy == 1 ){
		@recvData = &connectINET( $ProxyServer , $ProxyPort , $sendHeader );
	}else{
		@recvData = &connectINET( $serverHost , $serverPort , $sendHeader );
	}
	$BaseTag =~ s|%%|$ref|;
	if( $SaveCutHeader == 1 ){
		my $crecvData = &CutHtmlHeader( @recvData );
		if( open( FI , ">$SaveFile" )){
			print FI $BaseTag;
			print FI $crecvData;
			close( FI );
		}
	}else{
		if( open( FI , ">$SaveFile" )){
			print FI $BaseTag;
			print FI @recvData;
			close( FI );
		}
	}
	return 1;
}

sub CutHtmlHeader{
	my @rDat = @_;
	my $headCount = 0;
	my $retString;

	foreach( @rDat ){
		if( $headCount < 1 ){
			if( $_ eq $ProxyReturnCode ){
				$headCount++;
			}
		}else{
			$retString .= $_;
		}
	}
	return $retString;
}

sub SaveDirCheck{
	my $tSaveDir = shift;
	unless( -d $tSaveDir ){
		mkdir $tSaveDir,0705;
	}
	return $tSaveDir;
}

#----------- Socket 関連 ---------------------

#----------- 通信サブルーチン(IO::Socket ) -----
sub connectINET{
	my $host = shift;
	my $port = shift;
	my $senddata = shift;
	my @recvBuf;

#print $senddata;
#return;

	my $Hsocket = IO::Socket::INET->new(	PeerAddr => $host,
											PeerPort => $port,
											Proto    => 'tcp',
											Timeout  => 20 ,
									);
	if ( $Hsocket ){
		my $getbuf;
		$Hsocket->flush();
		print $Hsocket $senddata;
		while(defined( $getbuf = <$Hsocket>) ){
			push @recvBuf , $getbuf;
		}
		$Hsocket->close();
	}

	return @recvBuf;
}

sub MakeSendData{
	my $WebServerName = shift;
	my $ConnectPort = shift;
	my $targetpage = shift;
	my $flag_useproxy = shift;
	my $senddata;

	if( $flag_useproxy != 1 ){
	$senddata = <<"_GETSOCK_";
GET $targetpage HTTP/1.0
Host: $WebServerName
Referer: $mReferer
User-Agent: $mUserAgent
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*
Accept-Charset: Shift_JIS,*,utf-8
Accept-Ebcodint: gzip
Accept-Language: ja
Pragma: no-cache
Connection: close


_GETSOCK_
	}else{
		$senddata = <<"_PROXYCONN_";
GET http://$WebServerName:$ConnectPort$targetpage HTTP/1.0
Host: $WebServerName
Referer: $mReferer
User-Agent: $mUserAgent
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*
Accept-Charset: Shift_JIS,*,utf-8
Accept-Ebcodint: gzip
Accept-Language: ja
Pragma: no-cache
Connection: close


_PROXYCONN_
	}
	$senddata =~ s/\r\n/\n/g;
	$senddata =~ s/\r/\n/g;
	$senddata =~ s/\n/\r\n/g;
	return $senddata;
}