#!/usr/bin/perl
use 5.8.1;
use strict;
#-------------------------------------------------------------------------------
# Relay for HTTP Pseudo-Streaming with Windows Media Encoder
#                                             Copyright (C)2005,2007 nabe@abk
#-------------------------------------------------------------------------------
#[TAB=8][EUC-JP]	Lisenced on GPL(version 2 or later).
#			Sorry, comment is Japanese.
#
# 2007/03/08	Version 2.11	Fix not to run on Windows-GUI.
# 2007/02/13	Version 2.10	Windows GUI.
# 2007/02/12	Version 2.02	Fix bug, don't run digest-auth.
# 2007/02/05	Version 2.01	fix on big endian CPU (MacOS etc.)
# 2007/02/03	Version 2.00	Push stream support.
# 2005/06/10	Version 1.01	Client thread change for to sleep.
# 2005/06/03	Version 1.00	First Version
#
our $VERSION = "2.11";
use Socket;
use Fcntl;	# for sysopen
use Digest::MD5 qw(md5_hex);
use threads;
use threads::shared;
#-------------------------------------------------------------------------------
# ■動作 - 初期設定
#-------------------------------------------------------------------------------
my $bind_port  = 8080;			# default
my $client_max = 100;			# 最大クライアント数
my $log_file   = "wmrelay_%p.log";	# ログファイル名

#-----------------------------
# 以下は通常変更不要
#-----------------------------
my $debug;
my $nosilent  = 1;
my $timeout   = 0.2;			# select 時の Timeout 設定
my $down_wait = 15;			# 終了待ち（およそ $timeout * $down_wait）
my $bufsize   = 16;			# バッファサイズ。only 2^n
my $bufmask   = $bufsize - 1;
my $realm="wmrelay server";		# Digest認証関係
my $WinGUI   = ($^O eq 'MSWin32' || $^O eq 'MSWin64');

my $auth_test;
my $nonce_base = 'KUGX67jPtTekHhsAOZJBgRYobdxScWfm9VQay8IMNLFinElDqrCvupz32w54./10';
my $nonce_size = 16;

#-------------------------------------------------------------------------------
# ■スタートアップと引数解析
#-------------------------------------------------------------------------------
my $help = 0;
my %s;
my @ary;
while(my $a=shift(@ARGV)) {
	if (ord($a) != 0x2d) { push(@ary, $a); next; }
	my $x = substr($a, 1);
	if    ($x eq "h")  { $help  = 1; }
	elsif ($x eq "d")  { $debug = 1; }
	elsif ($x eq "dd") { $debug = 2; }
	elsif ($x eq "s")  { $nosilent  = 0; }
	elsif ($x eq "t")  { $auth_test = 1; }
	elsif ($x eq "c")  { $WinGUI    = 0; }
	else { $s{$x}=shift(@ARGV); }
}
my $url = shift(@ary);
my $host;
my $port;
my $path;
if ($url =~ m|(?:\w+://)([^/:]*)(?:\:(\d*))?(\/?.*)|) {
	$host = $1;
	$port = $2;
	$path = $3;
} elsif ($url ne '') { $host = $url; }
if ($path eq '') { $path='/'; }
if (defined $ary[0] && $ary[0] =~ /^\d+$/) { $port = int(shift(@ary)); }

if ($help) {
	print <<TEXT;
Usage: $0 [options] [http://URL]
	-h		view this message.
	-s		silent mode
	-p bind_port	bind port number (default $bind_port).
	-m max_conn	max connections (default $client_max).
	-l log_file	log file name (default $log_file).
			replace %p macro with listen port number.
	-f secret_file	push server mode password file
	-a password	push server mode password (anyuser)
	If not set http://URL/, run on push server mode.

	(See more info) http://nabe.blog.abk.nu/0124
TEXT
	exit(0);
}

if (defined $s{p}) { $bind_port  = int($s{p}); }
if (defined $s{m}) { $client_max = int($s{m}); }
if (defined $s{l}) { $log_file   = $s{l};    }

#-------------------------------------------------------------------------------
# ●リレー本体用変数宣言
#-------------------------------------------------------------------------------
my $server_down : shared;	# サーバ終了用フラグ
my $ctrlc_down  : shared;	# CTRL-C によるサーバダウン
my $DATA_header : shared;	# Stream data Header
my @end_thread  : shared;	# 終了したスレッド
my $seq      : shared;		# sequence number
my @buffer   : shared;		# クライアントsocket 一時記録配列

my $time     : shared;		# 動作開始時刻
my $rec_byte : shared;		# 受信データサイズ
my $rec_seq  : shared;		# 受信データ数
my @thread_id_pool : shared;	# thread id 保持配列
#-------------------------------------------------------------------------------
# ■プログラムのスタート
#-------------------------------------------------------------------------------
my @winlog;
my $win;
my $log_fh;
if ($WinGUI) {
	share(@winlog);
	&WinMain();
} else {
	&logmsg("*** Program Start");
	$log_file =~ s/%p/$bind_port/;
	if ($log_file) { sysopen($log_fh, $log_file, O_CREAT | O_WRONLY | O_APPEND); }
	&reley_start();
}
exit(0);

#################################################################################
my $S_listen;
my $HTTP_header="";

sub reley_start {
#################################################################################
#-------------------------------------------------------------------------------
# ■ログファイルのオープン
#-------------------------------------------------------------------------------
my $perl_v = $];
$perl_v =~ s/\.?00/./g;
&logmsg("*** Version : $VERSION with Perl $perl_v ($^O)");
&logmsg("*** Log file name : $log_file");

#-------------------------------------------------------------------------------
# ■指定ポートをListenする
#-------------------------------------------------------------------------------
{
	&logmsg("*** Connections max : $client_max");
	&logmsg("*** Bind port : $bind_port");
	socket($S_listen, PF_INET, SOCK_STREAM, 0)
		|| &fail("socket failed: $!") || return 1;
	setsockopt($S_listen, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
		|| &fail("setsockopt failed: $!") || return 1;
	bind($S_listen, sockaddr_in($bind_port, INADDR_ANY))
		|| &fail("bind port failed: $!") || return 1;
	listen($S_listen, $client_max)
		|| &fail("listen failed: $!") || return 1;
	if ($bind_port == 0) {
		&fail("port number error"); return 1;
	} 
}

#-------------------------------------------------------------------------------
# ■popサーバモード（中継元に接続に行く）
#-------------------------------------------------------------------------------
if ($host ne '') {
	my $ip_bin   = inet_aton($host);
	if (!defined $ip_bin) {
		&logmsg("Lookup failed '$host'\n");
		return 1;
	}
	my $ip_adr   = join(".", unpack("C4", $ip_bin));
	my $sock_adr = pack_sockaddr_in($port, $ip_bin);

	&logmsg("*** Connect to http://$host:$port$path");
	my $S_get;
	socket ($S_get, PF_INET, SOCK_STREAM, 0) || &fail("socket failed: $!")     || return 1;
	connect($S_get, $sock_adr)		 || &fail("Connection failed. $!") || return 1;

	# データ取得リクエスト
	&HTTP_REQUEST_get_stream($S_get);
	while(<$S_get>) {
		$HTTP_header .= $_;
		if ($_ eq "\r\n" || $_ eq "\n") { last; }
	}
	&server_main($S_get, $S_listen, 0);
	&logmsg("*** Close receive connection.");
	&logmsg("*** Program shutdown\n");
	close($S_get);
	close($S_listen);
	return 0;
}
#-------------------------------------------------------------------------------
# ■standaloneモード（push中継モード）
#-------------------------------------------------------------------------------
&logmsg("*** Standalone deamon mode (push server)");
my $file = $s{f};
my $anypass = $s{a};
my %user;
if ($file ne '') {
	&logmsg("*** Open user password file '$file'");
	sysopen(my $fh, $file, O_RDONLY);
	while(<$fh>) {
		if (ord($_) == 0x23) { next; }	# '#'で始まる行はコメント
		$_ =~ s/[\r\n]//g;
		my ($user, $pass) = split('=', $_);
		if ($user ne '' && $pass ne '') {
			$user{$user} = $pass;
		}
	}
	close($fh);
}
my $digest;
if ($anypass ne '' || %user) {
	$digest = 1;
	&logmsg("*** Server is digest-authrization mode.");
	if ($anypass ne '') {
		&logmsg("*** Use shared password.");
	}
} else {
	$auth_test = 0;
	&logmsg("*** Users not exists.");
	&logmsg("!!! Server is anonymouse authrization mode.");
}
if ($auth_test) { &logmsg("!!! Authorization test mode."); }
#-----------------------------------------------------------
# ○中継元受け付けループ
#-----------------------------------------------------------
&set_bit(my $listen_bits, $S_listen);
# 応答HTTPヘッダの生成
$HTTP_header = <<TEXT;
HTTP/1.0 200 OK
Server: Rex/9.0.0.2980
Cache-Control: no-cache
Pragma: no-cache
Pragma: client-id=31415926535
Pragma: features="broadcast,playlist"
Content-Type: application/x-mms-framed

TEXT
my %nonce_buf;
my %authed_push_id;
&logmsg("****************************");
&logmsg("*** Push stream waitting ***");
&logmsg("****************************");
$server_down=0;
while(1) {
	my $r = select(my $x = $listen_bits, undef, undef, 1);
	if ($server_down) { last; }
	if (!$r) { next; }

	# 接続のaccept
	my $sock_addr = accept(my $sock, $S_listen);
	if (! $sock_addr) { next; }

	# クライアント情報の取得
	my($port, $ip_bin) = sockaddr_in($sock_addr);
	my $ip   = inet_ntoa($ip_bin);
	my $host = gethostbyaddr($ip_bin, AF_INET);
	&logmsg("*** Connection from $host");

	# リクエストの受信
For_keep_alive:
	my $h = &receive_HTTP_header( $sock );
	my $method = $h->{method};
	# リクエストのチェック
	if (!$auth_test && ($method ne 'POST'	# POSTではないか
	 || ($digest && $h->{'X-ACCEPT-AUTHENTICATION'} !~ /Digest/i) )) {	# Digest 認証ができないか
		&HTTP_RESPONSE_bad_request($sock);
		&logmsg("*** Connection close (Bad Request)");
		close($sock);
		next;
	}
	# push-id の取得
	my $push_id;
	if ($h->{COOKIE} =~ /push\-id=(\d+)/) {
		$push_id = $1;
	}
	if ($push_id) { &logmsg("*** Detected push-id=$push_id"); }
	else {
		$push_id = int(rand(2147483640))+7;
		delete $authed_push_id{$push_id};
		&logmsg("*** Generated push-id=$push_id");
	}
	my $auth_ok = $authed_push_id{$push_id};	# cookie session
	# Reject チェック
	if ($auth_ok < 0) {	# CTRL-Cなどで閉じられたコネクション
		&HTTP_RESPONSE_bad_request($sock);
		&logmsg("*** Connection close (Reject push-id)");
		close($sock);
		delete $authed_push_id{$push_id};	# 次からは許可する
		next;
	}
	# Digest認証
	if (!$auth_ok && $digest) {
		# 認証の確認処理
		while($h->{"AUTHORIZATION"}) {
			&logmsg('*** Client try Digest-authorized');
			my $auth = $h->{"AUTHORIZATION"};
			if (substr($auth,0,7) ne 'Digest ') { last; }
			$auth = substr($auth,7);
			# Authorization ヘッダの解析
			my %auth;
			$auth =~ s/(\w+)=(?:\"([^\"]*)\"|([^\s,]+))/$auth{$1}="$2$3",""/eg;
			# Digest用の情報確認
			if ($auth{realm} ne $realm || $auth{qop} ne 'auth'
			 || $auth{algorithm} ne 'MD5-sess') { last; }
			# nonce の確認（発行しているnonce値か？）
			my $nonce = $auth{nonce};
			if (!exists $nonce_buf{$nonce}) { last; }
			delete $nonce_buf{$nonce};	# １度使用したnonceの削除
			# パスワードのロード
			my $uname=$auth{username};
			my $pass =$anypass;
			if ($pass eq '') {
				if (!exists $user{$uname}) { last; }
				$pass=$user{$uname};
			}
			$auth_test && &logmsg("*** User \"$uname\" with password \"$pass\"");
			# Digest response値の確認
			my $cnonce    = $auth{cnonce};
			my $cresponse = $auth{response};
			my $ha1 = md5_hex( md5_hex("$uname:$realm:$pass") . ":$nonce:$cnonce");
			my $ha2 = md5_hex("$method:$auth{uri}");
			my $response = md5_hex("$ha1:$nonce:$auth{nc}:$cnonce:auth:$ha2");
			&logmsg("*** User=\"$uname\" nonce=\"$nonce\" cnonce=\"$cnonce\"");
			&logmsg("*** Client response=\"$cresponse\"");
			&logmsg("*** Server response=\"$response\"");
			if ($cresponse eq $response) {
				$auth_ok=1;
				$authed_push_id{$push_id}=1;
				&logmsg("*** Client Authorized!");
			}
		}
		if (!$auth_ok) {
			my $nonce = &generate_nonce();
			$nonce_buf{$nonce} = $ip;
			&logmsg("*** 401_unauthorized (nonce \"$nonce\")");
			&HTTP_RESPONSE_401_unauthorized($sock, $push_id, $nonce);
			close($sock);
			next;
		}
	}
	### 受け入れok
	&logmsg("*** Responsed push-ok to $host");
	if ($h->{'CONTENT-LENGTH'} == 0) {
		# Connection確認時は Content-Length = 0
		&HTTP_RESPONSE_pushsetup( $sock, $push_id );
		if ($h->{CONNECTION} eq 'Keep-Alive') {
			&logmsg("*** Keep alive connection [$host]");
			goto For_keep_alive;
		}
	} else {
		# 中継サーバ起動
		my $sig_int = $SIG{INT};
		&server_main($sock, $S_listen, 1);
		$SIG{INT} = $sig_int;
		&logmsg("!!! push-id=$push_id is set Reject flag.");
		$authed_push_id{$push_id}=-1;
	}
	# Stream受信
	&logmsg("*** Close receive connection.");
	close($sock);

	if ($WinGUI && $ctrlc_down) { last; }
	# 次のループ用
	$server_down=0;
	&logmsg("****************************");
	&logmsg("*** Push stream waitting ***");
	&logmsg("****************************");
}
close($S_listen);
&logmsg("*** Server Down\n");
return 0;
#################################################################################
}

#################################################################################
# ■サーバプロセス
#################################################################################
my $push_mode;
my $receive_bits;
sub server_main {
#-------------------------------------------------------------------------------
# ●サーバーメイン
#-------------------------------------------------------------------------------
	my ($S_receive, $S_listen, $pm) = @_;
	$push_mode = $pm;
	#--------------------------------------------------
	# ハンドラの設定
	#--------------------------------------------------
	$server_down = 0;
	$ctrlc_down  = 0;
	local($SIG{INT})  = \&server_down;
	local($SIG{PIPE}) = sub { return ; };

	#--------------------------------------------------
	# ソケット関連の変数設定
	#--------------------------------------------------
	my $select_bits  ='';
	my $listen_bits  ='';
	   $receive_bits ='';
	&set_bit($select_bits,  $S_listen);
	&set_bit($listen_bits,  $S_listen);
	&set_bit($select_bits,  $S_receive);
	&set_bit($receive_bits, $S_receive);
	my $s_receive_fileno = fileno($S_receive);
	my $s_listen_fileno  = fileno($S_listen);

	#--------------------------------------------------
	# ループ前の初期化
	#--------------------------------------------------
	$time = time;		# 動作開始時刻
	$rec_byte = 0;		# 受信データサイズ
	$rec_seq = 0;		# 受信データ数
	@thread_id_pool = ();	# thread id 保持配列
	my @threads;		# threads object 保存用
	for(my $i=0; $i<$client_max; $i++) {
		$thread_id_pool[$i] = $client_max - $i;
	}
	#--------------------------------------------------
	# メインループ
	#--------------------------------------------------
	&logmsg("*******************");
	&logmsg("*** Relay start ***");
	&logmsg("*******************");
	while(1) {
		# 接続を監視
		if ($server_down) { $select_bits = $listen_bits; }
		my $r = select(my $x = $select_bits, undef, undef, $timeout);
		if ($r < 0) { $x=''; }	# CTRL-C など
		#----------------------------------------------------
		# 新たな接続
		#----------------------------------------------------
		if (vec($x, $s_listen_fileno, 1) ) {
			# スレッドを生成し接続を Accept する
			my $sock_addr = accept(my $S_client, $S_listen);
			my $thread_id = pop(@thread_id_pool);
			$debug && logmsg("[thread:$thread_id] create");
			$threads[ $thread_id ] = threads->create(\&accept_listener, $S_client, $sock_addr, $thread_id);
			close($S_client);
		#----------------------------------------------------
		# 中継元からデータを受信
		#----------------------------------------------------
		} elsif (!$server_down && vec($x, $s_receive_fileno, 1) ) {
			# $debug && &logmsg("new data from stream server");
			my $size = &read_stream_1block( $S_receive, my $data );
			if (!$size) {
				&logmsg("*** relay-server down (please wait).");
				$server_down=1; next;
			}
			$rec_byte += $size;
			$rec_seq++;
		#----------------------------------------------------
		# クライアント接続チェック
		#----------------------------------------------------
		} else {
			# 終了したスレッドを join し thread_id を再利用可能にする
			if (@end_thread) {
				my @ary = @end_thread; @end_thread = ();
				foreach(@ary) {
					my $obj = $threads[$_];
					if ($obj) {
						$obj->join();
						$threads[$_] = undef;
						if ($_) { push(@thread_id_pool, $_); }
					}
				}
				&display_connection_num();
			}
			# Server down check
			if ($server_down) {
				if (++$server_down > $down_wait) { last; }
			}
		}
	}
	#--------------------------------------------------
	# メインループ終了
	#--------------------------------------------------
	$time     = format_time( time - $time );
	$rec_byte = format_byte( $rec_byte );
	&logmsg("*** time $time, $rec_byte byte received. $rec_seq sequences.");

	# クライアントスレッドを終了させる
	foreach(@threads) { if (defined $_) { $_->join(); } }

	# リレーサーバのループ終了
	return $ctrlc_down;
}

#-------------------------------------------------------------------------------
# ●CTRL-Cの処理
#-------------------------------------------------------------------------------
sub server_down {	# CTRL-C
	print "\n";
	if ($server_down) { $server_down=9999999; return ; }
	$server_down=2;
	$ctrlc_down =1;
	&send_eos();
	&logmsg("*** relay-server down (please wait).");
}
#-------------------------------------------------------------------------------
# ●コネクション数の表示
#-------------------------------------------------------------------------------
sub display_connection_num {
	my $str = sprintf("[%d / $client_max]", $client_max - $#thread_id_pool -1);
	&logmsg("*** connections $str");
}
#-------------------------------------------------------------------------------
# ●リスナーの接続許可処理
#-------------------------------------------------------------------------------
my $client_loop;
my $client_id;
sub accept_listener {
	my ($S_client, $sock_addr, $thread_id) = @_;
	$win=undef;
	# コネクション数表示
	&display_connection_num();
	# メイン処理
	my $r = &accept_listener_main( @_ );
	# 終了処理
	close($S_client);
	push(@end_thread, $thread_id);
	# デバッグログ
	$debug && logmsg("[thread:$thread_id] end");
	return $r;
}
sub accept_listener_main {
	my ($sock, $sock_addr, $thread_id) = @_;
	# accept エラー
	if (! $sock_addr) { close($sock); return -1; }
	# クライアント情報の取得
	my($port, $ip_bin) = sockaddr_in($sock_addr);
	my $ip   = inet_ntoa($ip_bin);
	my $host = gethostbyaddr($ip_bin, AF_INET);
	my $id   = "$ip:$port";		# クライアント識別ID
	&logmsg("[$id] Connection from $host");

	# 最大接続数にたっしていないか確認
	if (! $thread_id) {
		&logmsg("[$id] $client_max connected max. connection close.");
		&HTTP_RESPONSE_client_max( $sock );
		return -2;
	}

	# HTTP ヘッダ受信
	my $h = &receive_HTTP_header( $sock );
	my $method = $h->{method};

	# Windows media steram じゃない
	# asx ファイルの取得？
	if ($method eq 'GET' && $h->{HOST} && $h->{path} =~ /\.asx$/) {
		&logmsg("[$id] client needed asx file ($h->{path})");
		my $title = $s{t} || 'wmrelay stream';
		$title =~ s/[\x00-\x1f<>\"\']//g;
		my $asx = <<TEXT;
<ASX version="3.0">
	<Entry>
		<Title>$title</Title>
		<Ref href="http://$h->{HOST}/stream.asf"/>
	</Entry>
</ASX>
TEXT
		&HTTP_RESPONSE_data( $sock, $asx, 'video/x-ms-asx');
		return 3;
	}
	if (!$method || $h->{'USER-AGENT'} !~ /^NSPlayer/) {
		&HTTP_RESPONSE_bad_request($sock);
		&logmsg("[$id] close (Bad Request, client get mp3 stream)");
		return 1;
	}
	if ($method eq 'POST' && $h->{log_line}) {		# log POST
		&logmsg("[$id] log-line from client : $h->{log_line}");
		return 2;
	}

	#---------------------------------------------------
	# ストリーミングデータのヘッダを転送
	#---------------------------------------------------
	# HTTP 応答ヘッダ出力
	socket_out($sock, $HTTP_header);
	# データブロックヘッダ出力
	socket_out($sock, $DATA_header);

	$client_loop=1;
	$client_id  =$id;
	local($SIG{PIPE}) = \&broken_client_pipe;
	my $start_time = time;	# 開始時刻
	my $byte  = 0;		# 送信バイト数
	my $myseq = $seq;	# 現在のシーケンス番号
	while($client_loop && !$server_down) {
		select(my $x = $receive_bits, undef, undef, $timeout);
		if ($seq <= $myseq) { next; }

		# 新たな受信データをクライアントに送信
		while($myseq < $seq) {
			$myseq++;
			my $bufnum = $myseq & $bufmask;
			my $buflen = length($buffer[$bufnum]);
			$debug && &logmsg("[$id] send data $buflen byte, seq=$myseq");
			my $r      = syswrite($sock, $buffer[$bufnum], $buflen);
			$byte += $buflen;
			# ネットワーク遅延などで飛びすぎならば途中データを破棄
			if ($seq - $bufsize > $myseq) { $myseq=$seq; last; }
			if (!defined $r) { $client_loop=0; last; }	# 書き込み失敗→broken pipe
		}
	}
	my $time = &format_time( time - $start_time );
	   $byte = &format_byte( $byte );
	&logmsg("[$id] close. time $time, $byte sended.");
	return 0;
}

sub broken_client_pipe {
	$client_loop=0;
	&logmsg("[$client_id] pipe breoken");
};

#-------------------------------------------------------------------------------
# ●ストリームを１ブロック受信する
#-------------------------------------------------------------------------------
sub read_stream_1block {
	my $fh = shift;
	# Read 1 block
	read($fh, my $head,     2);
	read($fh, my $size_bin, 2);

	if (ord($head) != 0x24 && $head ne '?D') {		# unknown block
		$head =~ s/([\x00-\x1f\x7f-\xff])/'[' . unpack('H2',$1) . ']'/eg;
		&logmsg("*** Receive data faild (unknown block '$head')");
		return 0;
	}
	# Save block header

	# Read block data
	my $data;
	my ($size, $sequence);
	if ($push_mode) {
		# プッシュサーバモード
		$size = unpack('v', $size_bin);
		$size_bin = pack('v', $size+8);	# MSS Pre-Headerサイズの追加
		my $id_flags;
		if ($head eq '$H') {
			$sequence = 0;
			$id_flags = "\x00\x0c";
		} else {
			$sequence = $seq+1;
			$id_flags = "\x00\x00";
		}
		# MSS Pre-header を追加する
		$data = $head . $size_bin . pack('V', $sequence) . $id_flags . $size_bin;
		read($fh, $data, $size, 12);
	} else {
		# 通常の pop リレーモード
		$data = $head . $size_bin;
		$size = unpack('v', $size_bin);
		read($fh, $data, $size, 4);
		$sequence = unpack('V', substr($data,4,4));
	}
	# End of stream
	if ($head eq '$E') {
		$nosilent && &logmsg("Recived stream $head : $size byte, seq=$sequence [End of Stream]");
		&send_eos();
		return 0;
	}
	# メッセージ表示
	$nosilent && &logmsg("Recived stream $head : $size byte, seq=$sequence");

	# save to ring buffer
	$buffer[$sequence & $bufmask] = $data;
	$seq = $sequence;

	# DATA Header save
	if ($head eq '$H') {
		$DATA_header = $data;
	}
	return $size + 4;
}

#-------------------------------------------------------------------------------
# ●ストリームを１ブロック受信する
#-------------------------------------------------------------------------------
sub send_eos {
	my $newseq = $seq+1;
	my $eos    = '$E' . pack('v', 4) . pack('V', 1);
	$debug && &logmsg("*** EOS save to buffer seq=$newseq");
	$buffer[$newseq & $bufmask] = $eos;
	$seq = $newseq;
}

#################################################################################
# ■HTTP/socket サブルーチン
#################################################################################
#-------------------------------------------------------------------------------
# ■HTTPヘッダ解析ルーチン
#-------------------------------------------------------------------------------
sub receive_HTTP_header {
	my $fh = shift;
	my %h;
	my $str = <$fh>;
	$str =~ s/\r\n/\n/;
	if ($str =~ /^(GET|POST) ([^\s]+) HTTP\/(\d\.\d)/) {
		$h{method} = $1;
		$h{path}   = $2;
		$h{http}   = $3;
	} elsif ($str =~ m|^HTTP/(\d.\d) (\d+) (\w+)|) {
		$h{http}       = $1;
		$h{status}     = $2;
		$h{status_msg} = $3;
	} else {
		$debug && &logmsg("[HTTP] Bad HTTP request or response");
		$h{error} = 1;
		return \%h;	# bad request
	}

	while(<$fh>) {
		$_ =~ s/\r\n/\n/;
		if ($_ eq "\n") { last; }
		$str .= $_;
		chomp($_);
		if (substr($_, 0, 17) eq "Pragma: log-line=") {
			$h{log_line} = substr($_, 17);
			next;
		}
		if ($_ =~ /^([\w\-]+): (.+)/) {
			my $key = uc($1);
			while (exists $h{$key}) { $key .= '_'; }
			$h{$key} = $2;
		}
	}
	if (0 && $debug) {
		foreach(sort(keys(%h))) {
			print "$_=$h{$_}\n";
		}
	}
	$h{string} = $str;
	($debug >1) && print $str;
	return \%h;
}


#-------------------------------------------------------------------------------
# ■HTTPヘッダルーチン
#-------------------------------------------------------------------------------
sub HTTP_REQUEST_get_stream {
	my $fh = shift;
	my $p="";
	if ($port != 80) { $p=":$port"; } 
	&socket_out($fh, <<TEXT);
GET $path HTTP/1.0
Accept: */*
User-Agent: NSPlayer/4.1.0.3928
Host: $host$p
Pragma: no-cache
Content-Type: application/x-mms-framed

TEXT
}
#----------------------------------------------------------
sub HTTP_RESPONSE_bad_request {
	my $fh = shift;
	&socket_out($fh, <<TEXT);
HTTP/1.0 400 Bad Request
Server: Rex/10.0.0.3650.1
Cache-Control: no-cache
Pragma: no-cache
Pragma: client-id=1337885143

TEXT
}
#----------------------------------------------------------
sub HTTP_RESPONSE_client_max {
	my $fh = shift;
	&socket_out($fh, <<TEXT);
GET / HTTP/1.0
HTTP/1.0 501 Not Implemented
Server: Rex/9.0.0.2980.1
Cache-Control: no-cache
Pragma: no-cache

TEXT
}
#----------------------------------------------------------
sub HTTP_RESPONSE_data {
	my $fh      = shift;
	my $content = shift;
	my $type    = shift || 'text/plain';
	my $length  = length($content);
	&socket_out($fh, <<TEXT);
HTTP/1.0 200 OK
Server: wmrelay.pl
Content-Length: $length
Content-type: $type
Cache-Control: no-cache
Pragma: no-cache

$content
TEXT
}

#----------------------------------------------------------
sub HTTP_RESPONSE_pushsetup {
	my $fh   = shift;
	my $pid  = shift;
	my $date = &get_rfc_date();
	&socket_out($fh, <<TEXT);
HTTP/1.1 204 No Content
Server: Cougar/9.01.01.3814
Content-Length: 0
Date: $date
Pragma: no-cache, timeout=60000
Cache-Control: no-cache
Set-Cookie: push-id=$pid

TEXT
}

#----------------------------------------------------------
sub HTTP_RESPONSE_401_unauthorized {
	my $fh    = shift;
	my $pid  = shift;
	my $nonce = shift;
	my $date  = &get_rfc_date();
	my $content = <<TEXT;
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>401 Authorization Required</title>
</head><body>
<h1>Authorization Required</h1>
<p>This windows media stream server is needed digest authorize.</p>
<p>This page is generated by "wmrelay.pl".</p>
</body></html>
TEXT
	my $length = length($content);
	&socket_out($fh, <<TEXT);
HTTP/1.1 401 Unauthorized
Server: Cougar/9.01.01.3814
WWW-Authenticate: Digest qop="auth",algorithm=MD5-sess,nonce="$nonce",realm="$realm"
Date: $date
Pragma: no-cache, timeout=60000
Set-Cookie: push-id=$pid
Content-Length: $length
Content-type: text/html
Supported: com.microsoft.wm.srvppair, com.microsoft.wm.sswitch, com.microsoft.wm.predstrm, com.microsoft.wm.fastcache, com.microsoft.wm.startupprofile

$content
TEXT
}

#-------------------------------------------------------------------------------
# ■サブルーチン
#-------------------------------------------------------------------------------
sub set_bit	{ vec($_[0], fileno($_[1]), 1) = 1; }
sub reset_bit	{ vec($_[0], fileno($_[1]), 1) = 0; }
sub fail {
	&logmsg(@_);
	if (! $WinGUI) { exit(1); }
	return 0;
}
sub socket_out {
	my $socket = shift;
	syswrite($socket, $_[0], length($_[0]) );
}
sub generate_nonce {
	my $size = shift;
	my $nonce='';
	foreach(1..$nonce_size) {
		$nonce .= substr($nonce_base, int(rand(64)), 1);
	}
	return $nonce;
}

sub get_rfc_date {
        my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
        my($wd, $mn);
        $wd = substr('SunMonTueWedThuFriSat',$wday*3,3);
        $mn = substr('JanFebMarAprMayJunJulAugSepOctNovDec',$mon*3,3);
        return sprintf("$wd, %02d $mn %04d %02d:%02d:%02d GMT"
                , $mday, $year+1900, $hour, $min, $sec);
}

sub format_time	{
	my ($sec) = @_;
	my $min  = int($sec/60);
	$sec -= $min  * 60;
	my $hour = int($min/60);
	$min -= $hour * 60;
	return sprintf("%02d:%02d:%02d", $hour, $min, $sec);
}
sub format_byte	{
	my ($byte) = @_;
	my $z = "Byte";
	if ($byte > 1024) { $byte >>= 10; $z = "KB"; }
	if ($byte > 1024) { $byte >>= 10; $z = "MB"; }
	return "$byte$z";
}

sub logmsg {
	my $tm  = &get_timestamp();
	my $msg = "$tm @_\n";
	if ($WinGUI) { push(@winlog, $msg); return; }
	if ($log_fh) { print $log_fh $msg; }
	print $msg;

}
sub get_timestamp {
	my ($sec,$min,$hour, $day,$mon,$year, $wday) = localtime();
	$year += 1900; $mon++;
	$mon  = sprintf('%02d', $mon);
	$day  = sprintf('%02d', $day);
	$hour = sprintf('%02d', $hour);
	$min  = sprintf('%02d', $min);
	$sec  = sprintf('%02d', $sec);

	return "$year/$mon/$day $hour:$min:$sec";
}

###############################################################################
###############################################################################
###############################################################################


###############################################################################
# ■Windows用GUIルーチン
###############################################################################
#------------------------------------------------------------------------------
# ●Windows main
#------------------------------------------------------------------------------
my $relay_running = undef;
my $timer;
sub WinMain {
	require Win32::GUI;
	require Win32::GUI::Loft::Design;
	my $filename = "wmrelay.gld";
	my $gld = read_file( $filename );
	my $design = Win32::GUI::Loft::Design->newScalar($gld, $filename);
	$win = $design->buildWindow() or die("Could not build window)");
	$win->Text("wmrelay $VERSION (C)nabe\@abk");

	$win->Show();
	$win->SetForegroundWindow();
	$win->SetActiveWindow();

	# ダイアログ初期値
	$win->tfPortNumber->Text( $bind_port );
	$win->tfMaxConnection->Text( $client_max );
	$win->tfLogFile->Text( $log_file );

	# タイマー登録
	$timer = $win->AddTimer( "system", 100 );	# 0.1秒ごと

	# スタートアップ処理
	share( $relay_running );
	$nosilent = 0;
	&logmsg("*** Program Start");
	Win32::GUI::Dialog();
}

#------------------------------------------------------------------------------
# ●Windowsイベント処理
#------------------------------------------------------------------------------
my $rec;
sub ::system_Timer {
	# ログの転送
	while(@winlog) {
		&win_logmsg(shift(@winlog));
	}
	# リレーサーバ動作中
	if ($relay_running && $rec<$rec_byte) {
		my $byte  = &format_byte( $rec_byte );
		my $times = &format_time( time - $time );
		my $conn  = $client_max - $#thread_id_pool -1;
		$win->tfRecBytes->Text( $byte  );
		$win->tfRecTimes->Text( $times );
		$win->tfConnections->Text( $conn );
	# リレーサーバの停止
	} elsif ($relay_running eq '0') {
		$relay_running = undef;
		$win->btnMain->Text('スタート');
		close($log_fh);
	}
	$rec = $rec_byte;
}

my $server_thread;
sub ::btnMain_Click {
	if ($relay_running) {
		&logmsg('*** Stopping');
		$server_down = 1;	# GoTo Down
		$ctrlc_down  = 1;
	} else {
		if ($server_thread) {
		#	$server_thread->join();
			$server_thread = undef;
		}
		&win_server_start();
	}
}

sub win_server_start {
	$win->btnMain->Text('ストップ');
	&logmsg('*** Starting server process');
	# 設定値の取り込み
	$bind_port  = int( $win->tfPortNumber->Text() );
	$client_max = int( $win->tfMaxConnection->Text() );
	$log_file   = $win->tfLogFile->Text();

	$s{f} = $s{a} = $url = $host = $port = $path = undef;
	if ( $win->rbRecSelect0->Checked() ) {	# GET モード
		$host = 'unknown';
		$url = $win->tfURL->Text();
		if ($url =~ m|(?:\w+://)([^/:]*)(?:\:(\d*))?(\/?.*)|) {
			$host = $1 || 'unknown';
			$port = $2;
			$path = $3;
		}
	} elsif ( $win->rbRecSelect1->Checked() ) {	# 共有パスワードモード
		$s{a} = $win->tfPass->Text();
	} elsif ( $win->rbRecSelect1->Checked() ) {	# ユーザー別パスワードファイル
		$s{f} = $win->tfPassFile->Text();
	}

	# 初期化処理
	$win->tfRecBytes->Text( '0' );
	$win->tfRecTimes->Text( '00:00:00' );
	$win->tfConnections->Text( '0' );

	# ログファイルのオープン
	$log_file =~ s/%p/$bind_port/;
	if ($log_file) { sysopen($log_fh, $log_file, O_CREAT | O_WRONLY | O_APPEND); }

	$timer->Kill(1);
	$timer = undef;
	$server_thread = threads->create(\&win_relay_start);
	$timer = $win->AddTimer( "system", 100 );	# 0.1秒ごと
	$relay_running = 1;
}

# サーバスレッドを呼び出し（余計な変数をコピーさせない）
sub win_relay_start {
	close($log_fh);
	$log_fh=undef;
	$win=undef;
	$server_thread=undef;
	$rec=$rec_byte=0;
	&reley_start();
	$relay_running = 0;
}


#------------------------------------------------------------------------------
# ●Window処理用ルーチン
#------------------------------------------------------------------------------
# ログファイル選択ボタン
sub ::btnLogFile_Click {
	my $ret = Win32::GUI::GetSaveFileName(
		-owner		=> $win,
		-title		=> 'ログファイル名を選択',
		-file		=> "wmrelay_%p.log",
		-filter		=> ['ログファイル', '*.log', 'すべてのファイル', '*.*'],
		-directory	=> '.\\'
	);
	$win->tfLogFile->Text($ret);
}

# パスワードファイル選択ボタン
sub ::btnPassFile_Click {
	my $ret = Win32::GUI::GetOpenFileName(
		-owner		=> $win,
		-title		=> 'ユーザーパスワードファイルを選択',
		-file		=> "wmrelay_users.txt",
		-filter		=> ['すべてのファイル', '*.*'],
		-directory	=> '.\\'
	);
	$win->tfPassFile->Text($ret);
}

#------------------------------------------------------------------------------
# ●Window用サブルーチン
#------------------------------------------------------------------------------
# for PAR
sub read_file {
	my $file = shift;
	if ($INC{'PAR.pm'}) {	# PAR
		return PAR::read_file($file);
	}
	sysopen(my $fh, $file, O_RDONLY);
	my @ary = <$fh>;
	close($fh);
	return join('', @ary);
}

sub win_logmsg {
	my $msg   = shift;
	my $reMsg = $win->reMsg;
	if (!$reMsg) { return ; }
	my $text  = $reMsg->Text();
	my $len   = length($text);
	$reMsg->SetFocus();
	$reMsg->Select($len, $len);
	$reMsg->ReplaceSel($msg);

	if ($log_fh) { print $log_fh $msg; }
}