gethttpheader.pl
#!/usr/bin/perl use Socket; my $proto = getprotobyname('tcp'); socket(Server,PF_INET,SOCK_STREAM,$proto) || die "socket: $!"; setsockopt(Server,SOL_SOCKET,SO_REUSEADDR,pack("l",1)) || die "setsocketopt: $!"; bind(Server,sockaddr_in(6799,INADDR_ANY)) || die "bind: $!"; listen(Server,SOMAXCONN) || die "listen: $!"; my $paddr; my $waitedpid = 0; sub REAPER { $SIG{CHLD} = \&REAPER; # loathe sysV $waitedpid = wait; } $SIG{CHLD} = \&REAPER; for ($waitedpid = 0; ($paddr=accept(Client,Server)) || $waitedpid; $waitedpid = 0, close Client) { next if $waitedpid; my($port,$iaddr) = sockaddr_in($paddr); my $name = gethostbyaddr($iaddr,AF_INET); print "Connection from: $name"; spawn (sub { while(<CLIENT>) { print $_; } }); } sub spawn { my $coderef=shift; my $pid=fork; if ($pid) { print "begat $pid"; return; # i'm the parent } # else i'm the child -- go spawn open(CLIENT, "<&Client") || die "can't dup client to stdin"; open(CLOUT, ">&Client") || die "can't dup client to stdout"; ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; exit &$coderef(); }
收藏
0人收藏
- 2013-03-06 12:58:17Perl实现HTTP POST请求 by JoanneTou
- 2013-03-14 19:38:14Perl 解析 HTTP Header by 王忠强
- 2012-11-04 13:35:32perl 使用 AnyDBM 操作 DBM 文件 by init0
- 2013-01-14 15:57:05js使用ajax读取http响应头信息 by 文丐
- 2013-03-28 16:18:13C# 发起HTTP请求并检查回应的Cookie数据 by firedtoad
- 2013-05-30 12:01:50Perl 使用 OLE 自动化来控制 Excel by YuChao
- 2013-08-26 14:39:55perl 脚本去掉 word 自定义属性 by 光索与诺
- 2013-11-14 16:23:37java代码里调用perl程序 by empireghost
- 2013-12-17 10:37:07Perl批量赋予可执行权限 by 睡到自然醒
- 2014-03-06 14:32:58php提交表单后页面重定向代码 by 南宫傲
- 2018-03-30 21:56:50java自动识别用户上传的文本文件编码 by Hugh
相关聚客文章