⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 serverstatus.cgi

📁 最新的仙镜传说服务器C语言源码
💻 CGI
字号:
🔍 
#!/usr/bin/perl

#=========================================================================
# serverstatus.cgi  ver.1.00  by 層挶棖
#	checkversion傪儔僢僾偟偨丄僒乕僶乕忬懺傪昞帵偡傞cgi
#
# ** 愝掕曽朄 **
#
# - 壓偺$checkv曄悢偵checkversion傊偺僷僗傪愝掕偡傞偙偲丅
# - perl偵僷僗偑捠偭偰偄側偄応崌偼 $perl 傪perl傊偺惓偟偄僷僗偵偡傞偙偲丅
# - 懠偼晛捠偺CGI偲摨偠丅乮幚峴尃傗cgi-bin僼僅儖僟側偳乯
# - %servers偺ip傪偦傟偧傟惓偟偔愝掕偡傞丅儂僗僩柤壜丅尰嵼偼inter偲char偼摨偠
# - 暋悢map嶪偵偟偰偄傞応崌偼,%servers偵峴傪壛偊傞偙偲偱懳墳壜擻偩偑丄
#   @serverorder偵%servers偺僉乕傪壛偊傞偙偲傪朰傟側偄傛偆偵丅
# - @state1,@state2偱昞帵傪懡彮曄峏壜擻丅
#
# ** 偦偺懠 **
# - 偁偔傑偱尰嵼偺忬懺昞帵偱儘僌偼偲偭偰偄側偄偺偱夁嫀偺僨乕僞偼嶲徠偱偒側偄
# - 僉儍僢僔儏側偳偟偰偄側偄偺偱傾僋僙僗偝傟傞偨傃偵僠僃僢僋偡傞丅
#   傛偭偰傾僋僙僗偑懡偄偲晧壸偑戝偒偔側傞偺偱拲堄丅
# - ping偵傛傞僠僃僢僋偼偍傑偗掱搙丅tcp-ping偼晧壸偑崅偄丅
#	icmp-ping偼晧壸寉傔偩偑root尃偑昁梫側偺偱幚幙柍棟丅
#   Net::Ping昁恵丅ActivePerl側偳偱偼alarm偑枹幚憰偱摦偐側偄壜擻惈偁傝丅
#   偆傑偔偄偐側偄側傜ping偟側偄傎偆偑晧壸偑掅偔側傞丅
#
#-------------------------------------------------------------------------


my($checkv)="../checkversion";	# checkversion偺僷僗(偍偦傜偔曄峏偑昁梫)
my($perl)="perl";				# perl偺僐儅儞僪柤

my($checkping)="tcp";			# NG偺偲偒ping偵傛傞僠僃僢僋傪峴偆ping偺庬椶
								# "tcp","udp","icmp"(root尃昁梫),""偐傜慖戰
								# ""偩偲ping偟側偄丅
								# Net::Ping偑側偄/幚憰偝傟偰偄側偄偲柍帇

my(@serverorder)=(				# 昞帵弴
	"login","char","inter","map"
);
my(%servers)=(					# 僨乕僞(ip偲柤慜)
	"login"	=> { "ip"=>"127.0.0.1:6900", "desc"=>"Login Server" },
	"char"	=> { "ip"=>"127.0.0.1:6121", "desc"=>"Charactor Server" },
	"inter"	=> { "ip"=>"127.0.0.1:6121", "desc"=>"Inter Server" },
	"map"	=> { "ip"=>"127.0.0.1:5121", "desc"=>"Map Server" },
);

my(@state1)=(					# 忬懺昞帵
	"Down",		# 愙懕偱偒側偄
	"Good",		# 惓忢摦嶌拞
	"Error",	# %servers偺愝掕偑偍偐偟偄(億乕僩斣崋)
	"Closed",	# ping偵偼墳摎
);
my(@state2)=(					# 怓
	"#ffc0c0",	# 愙懕偱偒側偄
	"#c0ffc0",	# 惓忢摦嶌拞
	"#c0c0ff",	# %servers偺愝掕偑偍偐偟偄(億乕僩斣崋)
	"#ffffc0",	# ping偵偼墳摎
);

#--------------------------- 愝掕偙偙傑偱 --------------------------------




use strict;
eval { use Net::Ping; };


my($msg)=<<"EOD";
<html>
<head><title>Athena Server Status</title></head>
<body text="black" bgcolor="white" link="blue" vlink="blue" alink="blue">
<h1>Athena Server Status</h1>
<table border=1>
<tr><th>Server</th><th>Address</th><th>Status</th><th>Version</th></tr>
EOD

my(%langconv)=(
);

my($i);
foreach $i (@serverorder){
	my($state)=0;
	
	open PIPE,"$perl $checkv $servers{$i}->{ip} |"
		or HttpError("Can't execute checkversion.\n");
	my(@dat)=<PIPE>;
	close PIPE;
	
	if($dat[1]=~m/Athena/ && $dat[2]=~/server/){
		if($dat[2]=~/$i/ ){
			$state=1;
		}else{
			$state=2;
		}
	}elsif($checkping){
		eval { 
			$dat[1]="n/a";
			my($p) = Net::Ping->new($checkping);
			my($addr)=$servers{$i}->{ip};
			$addr=~s/\:\d+$//;
			$state=3 if $p->ping($addr);
			$p->close();
		};
	}
	
	$msg.= "<tr bgcolor=\"$state2[$state]\"><td>".$servers{$i}->{desc}.
		"</td><td>".$servers{$i}->{ip}."</td><td>$state1[$state]</td>".
		"<td>$dat[1]</td></tr>"
}
$msg.="</table></body></html>";

print "Content-type: text/html\n\n$msg";

sub LangConv {
	my(@lst)= @_;
	my($a,$b,@out)=();
	foreach $a(@lst){
		foreach $b(keys %langconv){
			$a=~s/$b/$langconv{$b}/g;
			my($rep1)=$1;
			$a=~s/\$1/$rep1/g;
		}
		push @out,$a;
	}
	return @out;
}

sub HttpMsg {
	my($msg)=join("", LangConv(@_));
	$msg=~s/\n/<br>\n/g;
	print LangConv("Content-type: text/html\n\n"),$msg;
	exit;
}

sub HttpError {
	my($msg)=join("", LangConv(@_));
	$msg=~s/\n/<br>\n/g;
	print LangConv("Content-type: text/html\n\n"),$msg;
	exit;
}

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -