直接上代码:
################################################################################
# Filename:
# websocket.pl
# Description:
# Perl mutithreaded TCP server of HTML5 Websocket-draft-76
# Test enviroment:
# OS - Windows XP
# Perl - ActivePerl 5.12.1
# Browser - Chrome 8.0
################################################################################
#!/usr/bin/perl -w
use strict;
use warnings;
use 5.010;
use IO::Socket::INET;
use Digest::MD5 qw/md5/;
use Redis;
use POSIX ':sys_wait_h';
### main part ##################################################################
### system level options
my %VARS = (
DEBUG => 1,
LOG2FILE => 0
);
#common global variables
my @TIMER_TASK; #its element is %{task_name, interval fun_ref}
### stdout to log file
if( $VARS{LOG2FILE} ){
open LOG, ">>syslog.txt";
select LOG;
}
### redis db initialization
my $r = Redis->new;
$r->ping or die now() . "[Server]: connect Redis failed";
$r->flushall;
my $redis_sock = $$r{sock};
$r->hset("sys:sock", "redis", $redis_sock);
say now() . " | Redis: " . $redis_sock->sockhost() . ":" . $redis_sock->sockport() .
" <---> " . $redis_sock->peerhost() . ":" . $redis_sock->peerport();
### tcp server
my $PORT = 8000;
my $server = IO::Socket::INET->new( Proto => 'tcp',
LocalPort => $PORT,
Listen => 255,
Reuse => 1);
$server or die now() . "[Server]: Err = can't setup server";
say now() . " | Server: Listening at TCP:" . $server->sockport;
#zombie
my $zombies = 0;
$SIG{CHLD} = sub {$zombies++;};
while(my $client = $server->accept()){
#zombie reaper
while($zombies) {
$zombies = 0;
while ((my $zombie = waitpid( -1, WNOHANG)) != -1){}
};
$client->autoflush(1);
#handshake
sysread $client, my $handshake_req, 1024;
my($handshake_resp,$page) = handshake($handshake_req);
print $client $handshake_resp;
close $client unless $client;
my $client_info = $client->peerhost() . ":" . $client->peerport() . "$page";
$r->hset("sys:sock", $client_info,$client);
say now() . " | Client: connected from " . $client_info;
#data framing
$client->blocking(0);
#fork child for new connection
if(my $child = fork()){
$/ = "\xff"; #new line seperator
my($req,@resp);
while(<$client>){
/\x00(.*)\xff/;
$req = $1;
say now() . " | ws://" . "$client_info >>> [$req]" if $VARS{DEBUG};
@resp = request($req);
foreach my $resp (@resp){
say now() . " | ws://" . "$client_info <<< [$resp]" if $VARS{DEBUG};
print $client "\x00$resp\xff";
}
}
return; #go back to parent
}
}
### sub routines ###############################################################
# Description: Request format from webSocket
# Format: command param1,param2, ... ,paramN
sub request{
my @resp = ();
$_ = shift;
my($cmd, @param) = split / /;
$cmd = "req_$cmd";
if(defined(&$cmd)){
no strict 'refs';
@resp = $cmd->(@param);
}else{
push @resp, "!$_";
}
return @resp;
}
sub req_echo{ return @_; }
sub req_random{
$_ = shift;
my $r;
if(/float/){ #float
$r = rand(100);
}else{ #integer
$_ = "int";
$r = int(rand(100));
}
return ("random: $_ = $r");
}
sub req_showsock{
my @socks = ();
my %s = $r->hgetall("sys:sock");
say "..............";
foreach (keys %s){
say ;
#push @socks, $item;
}
return @socks;
}
sub now{
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
$year += 1900;
return sprintf("%.4d-%.2d-%.2d %2d:%.2d:%.2d",$year,$mon,$mday,$hour,$min,$sec);
}
sub handshake{
my $req = shift;
($req, my $key3) = split /\r\n\r\n/, $req;
my @req = split /\r\n/, $req;
my $field = shift @req;
$field =~ /GET (.*) HTTP/;
my $page = $1;
$field = shift @req;
$field = shift @req;
$field = shift @req;
$field =~ /Host: (.*)/;
my $location = "ws://" . $1 . $page;
$field = shift @req;
$field =~ /Origin: (.*)/;
my $origin = $1;
$field = shift @req;
$field =~ /Sec-WebSocket-Key1: (.*)/;
$field = $1;
my @key1= $field =~ /([0-9])/g;
my $key1 = join('', @key1) + 0;
my @space1 = $field =~ /\x20/g;
my $space1 = @space1 + 0;
my $part1 = $key1 / $space1;
my $part1_hex = pack 'L>', $part1;
$field = shift @req;
$field =~ /Sec-WebSocket-Key2: (.*)/;
$field = $1;
my @key2 = $field =~ /([0-9])/g;
my $key2 = join('', @key2) + 0;
my @space2 = $field =~ /\x20/g;
my $space2 = @space2 + 0;
my $part2 = $key2 / $space2;
my $part2_hex = pack 'L>', $part2;
my $challenge = md5($part1_hex, $part2_hex, $key3);
my $resp = "HTTP/1.1 101 Web Socket Protocol Handshake\r\n" .
"Upgrade: WebSocket\r\n" .
"Connection: Upgrade\r\n" .
"Sec-WebSocket-Origin: $origin\r\n" .
"Sec-WebSocket-Location: $location\r\n\r\n" . $challenge;
return ($resp, $page);
}
sub hexcode{
my $str = unpack 'H*', shift;
$str =~ s/(.)(.)/\U$1$2 /g;
return $str;
}
分享到:
相关推荐
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...
Tcp服务端与客户端的JAVA实例源代码,一个简单的Java TCP服务器端程序,别外还有一个客户端的程序,两者互相配合可以开发出超多的网络程序,这是最基础的部分。 递归遍历矩阵 1个目标文件,简单! 多人聊天室 3...
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...
Tcp服务端与客户端的JAVA实例源代码 2个目标文件 摘要:Java源码,文件操作,TCP,服务器 Tcp服务端与客户端的JAVA实例源代码,一个简单的Java TCP服务器端程序,别外还有一个客户端的程序,两者互相配合可以开发出超多...
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...
WebSocket4J 并未实现客户端通讯协议,所以不能用它来连接 WebSocket 服务器。 Struts验证码插件 JCaptcha4Struts2 JCaptcha4Struts2 是一个 Struts2的插件,用来增加验证码的支持,使用时只需要用一个 JSP 标签 ...