返回顶部

收藏

Perl 解析 HTTP Header

更多
#!/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();
}

标签:perl,HTTP

收藏

0人收藏

支持

0

反对

0

»更多 您可能感兴趣的代码
  1. 2015-07-06 09:27:39Perl 解析 HTTP Header by 好剑
  2. 2013-03-06 12:58:17Perl实现HTTP POST请求 by JoanneTou
  3. 2012-11-04 13:35:32perl 使用 AnyDBM 操作 DBM 文件 by init0
  4. 2013-01-27 09:50:13python HTTP 客户端库–requests介绍 by firedtoad
  5. 2013-04-04 09:02:43Perl 调用 MySQL 存储过程并获得返回值 by Hugh
  6. 2013-05-30 15:34:41Perl 访问 Windows 的事件日志 by init0
  7. 2013-09-01 14:58:01perl的删除文件代码 by 张永磊
  8. 2013-12-13 13:04:13Perl Opendir范例 by ljl
  9. 2014-02-15 21:38:33perl 插入排序代码示例 by 赵振华
  10. 2014-03-23 15:10:06pcre的compile,exec和free by 睡到自然醒
  11. 2017-01-06 09:31:38Boolean operation in if by xwz

发表评论