Perl Socket 编程

Socket 基础

创建 Socket

use Socket;

# 创建 TCP socket
socket(my $socket, PF_INET, SOCK_STREAM, 0)
    or die "Cannot create socket: $!";

Socket 地址结构

use Socket;

# 打包地址
my $packed_addr = pack_sockaddr_in(8080, inet_aton("localhost"));

# 解包地址
my ($port, $addr) = unpack_sockaddr_in($packed_addr);
my $ip = inet_ntoa($addr);

TCP 服务器

基本 TCP 服务器

#!/usr/bin/perl
use strict;
use warnings;
use Socket;

my $port = 8080;
my $protocol = getprotobyname('tcp');

# 创建 socket
socket(my $server, PF_INET, SOCK_STREAM, $protocol)
    or die "Cannot create socket: $!";

# 设置地址重用
setsockopt($server, SOL_SOCKET, SO_REUSEADDR, 1)
    or die "Cannot set socket options: $!";

# 绑定地址
my $packed_addr = pack_sockaddr_in($port, INADDR_ANY);
bind($server, $packed_addr)
    or die "Cannot bind to port $port: $!";

# 监听连接
listen($server, SOMAXCONN)
    or die "Cannot listen: $!";

print "Server listening on port $port\n";

# 接受连接
while (my $client = accept(my $new_sock, $server)) {
    my ($client_port, $client_addr) = unpack_sockaddr_in($client);
    my $client_ip = inet_ntoa($client_addr);
    
    print "Client connected from $client_ip:$client_port\n";
    
    # 读取客户端数据
    my $data;
    recv($new_sock, $data, 1024, 0);
    print "Received: $data\n";
    
    # 发送响应
    send($new_sock, "Hello from server\n", 0);
    
    close($new_sock);
}

close($server);

多客户端处理（fork）

#!/usr/bin/perl
use strict;
use warnings;
use Socket;

my $port = 8080;

socket(my $server, PF_INET, SOCK_STREAM, 0)
    or die "Cannot create socket: $!";

setsockopt($server, SOL_SOCKET, SO_REUSEADDR, 1);
bind($server, pack_sockaddr_in($port, INADDR_ANY))
    or die "Cannot bind: $!";
listen($server, SOMAXCONN)
    or die "Cannot listen: $!";

print "Server listening on port $port\n";

while (my $client = accept(my $new_sock, $server)) {
    my $pid = fork;
    
    if ($pid == 0) {
        # 子进程
        close($server);
        
        my $data;
        recv($new_sock, $data, 1024, 0);
        print "Received: $data\n";
        
        send($new_sock, "Response: $data", 0);
        close($new_sock);
        exit;
    } else {
        # 父进程
        close($new_sock);
    }
}

close($server);

TCP 客户端

基本 TCP 客户端

#!/usr/bin/perl
use strict;
use warnings;
use Socket;

my $host = 'localhost';
my $port = 8080;

# 创建 socket
socket(my $socket, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
    or die "Cannot create socket: $!";

# 连接服务器
my $dest_addr = pack_sockaddr_in($port, inet_aton($host));
connect($socket, $dest_addr)
    or die "Cannot connect: $!";

print "Connected to $host:$port\n";

# 发送数据
my $message = "Hello from client\n";
send($socket, $message, 0)
    or die "Cannot send: $!";

# 接收响应
my $response;
recv($socket, $response, 1024, 0);
print "Received: $response";

close($socket);

自动重试客户端

#!/usr/bin/perl
use strict;
use warnings;
use Socket;

sub connect_with_retry {
    my ($host, $port, $max_retries) = @_;
    my $attempts = 0;
    
    while ($attempts < $max_retries) {
        my $socket;
        socket($socket, PF_INET, SOCK_STREAM, 0)
            or die "Cannot create socket: $!";
        
        my $addr = pack_sockaddr_in($port, inet_aton($host));
        
        if (connect($socket, $addr)) {
            return $socket;
        }
        
        close($socket);
        $attempts++;
        print "Connection failed, retrying... ($attempts/$max_retries)\n";
        sleep(2);
    }
    
    return undef;
}

my $socket = connect_with_retry('localhost', 8080, 5);

if ($socket) {
    print "Connected!\n";
    # ... 进行通信 ...
    close($socket);
} else {
    print "Failed to connect after 5 attempts\n";
}

UDP 编程

UDP 服务器

#!/usr/bin/perl
use strict;
use warnings;
use Socket;

my $port = 8080;

# 创建 UDP socket
socket(my $server, PF_INET, SOCK_DGRAM, getprotobyname('udp'))
    or die "Cannot create socket: $!";

bind($server, pack_sockaddr_in($port, INADDR_ANY))
    or die "Cannot bind: $!";

print "UDP server listening on port $port\n";

while (1) {
    my $data;
    my $client_addr = recv($server, $data, 1024, 0);
    
    my ($client_port, $client_ip) = unpack_sockaddr_in($client_addr);
    $client_ip = inet_ntoa($client_ip);
    
    print "Received from $client_ip:$client_port: $data\n";
    
    # 发送响应
    send($server, "Ack: $data", 0, $client_addr);
}

close($server);

UDP 客户端

#!/usr/bin/perl
use strict;
use warnings;
use Socket;

my $host = 'localhost';
my $port = 8080;

# 创建 UDP socket
socket(my $socket, PF_INET, SOCK_DGRAM, getprotobyname('udp'))
    or die "Cannot create socket: $!";

my $message = "Hello UDP server";
my $dest_addr = pack_sockaddr_in($port, inet_aton($host));

send($socket, $message, 0, $dest_addr)
    or die "Cannot send: $!";

print "Sent: $message\n";

# 接收响应
my $response;
my $server_addr = recv($socket, $response, 1024, 0);

my ($server_port, $server_ip) = unpack_sockaddr_in($server_addr);
$server_ip = inet_ntoa($server_ip);

print "Received from $server_ip:$server_port: $response\n";

close($socket);

高级 Socket 编程

非阻塞 Socket

#!/usr/bin/perl
use strict;
use warnings;
use Socket;
use Fcntl;

# 创建 socket
socket(my $socket, PF_INET, SOCK_STREAM, 0)
    or die "Cannot create socket: $!";

# 设置非阻塞模式
my $flags = fcntl($socket, F_GETFL, 0)
    or die "Cannot get flags: $!";
fcntl($socket, F_SETFL, $flags | O_NONBLOCK)
    or die "Cannot set non-blocking: $!";

# 连接（非阻塞）
my $addr = pack_sockaddr_in(8080, inet_aton("localhost"));
connect($socket, $addr);

# 检查连接状态
if ($!{EINPROGRESS}) {
    print "Connection in progress...\n";
    # 使用 select 等待连接完成
}

close($socket);

使用 IO::Select

#!/usr/bin/perl
use strict;
use warnings;
use IO::Select;
use IO::Socket;

# 创建服务器
my $server = IO::Socket::INET->new(
    LocalPort => 8080,
    Proto => 'tcp',
    Listen => 5,
    Reuse => 1
) or die "Cannot create server: $!";

my $select = IO::Select->new($server);
my %clients;

print "Server ready\n";

while (my @ready = $select->can_read) {
    foreach my $fh (@ready) {
        if ($fh == $server) {
            # 新连接
            my $client = $server->accept;
            $select->add($client);
            $clients{$client} = $client;
            print "New client connected\n";
        } else {
            # 客户端数据
            my $data;
            if (sysread($fh, $data, 1024)) {
                print "Received: $data\n";
                # 广播给所有客户端
                foreach my $c ($select->handles) {
                    if ($c != $server) {
                        syswrite($c, $data);
                    }
                }
            } else {
                # 客户端断开
                $select->remove($fh);
                delete $clients{$fh};
                close($fh);
                print "Client disconnected\n";
            }
        }
    }
}

close($server);

实践示例

示例 1：聊天服务器

#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;
use IO::Select;

my $port = 8080;
my $server = IO::Socket::INET->new(
    LocalPort => $port,
    Proto => 'tcp',
    Listen => 5,
    Reuse => 1
) or die "Cannot create server: $!";

print "Chat server listening on port $port\n";

my $select = IO::Select->new($server);
my %clients;
my %names;

while (my @ready = $select->can_read) {
    foreach my $fh (@ready) {
        if ($fh == $server) {
            # 新客户端
            my $client = $server->accept;
            $select->add($client);
            $clients{$client} = $client;
            
            # 请求名字
            print $client "Enter your name: ";
        } else {
            # 客户端消息
            my $data;
            if (sysread($fh, $data, 1024)) {
                chomp $data;
                
                if (exists $names{$fh}) {
                    # 广播消息
                    my $name = $names{$fh};
                    my $message = "$name: $data\n";
                    
                    foreach my $c ($select->handles) {
                        if ($c != $server) {
                            print $c $message;
                        }
                    }
                } else {
                    # 保存名字
                    $names{$fh} = $data;
                    print $fh "Welcome, $data!\n";
                }
            } else {
                # 客户端断开
                my $name = delete $names{$fh};
                delete $clients{$fh};
                $select->remove($fh);
                close($fh);
                
                # 通知其他客户端
                foreach my $c ($select->handles) {
                    if ($c != $server) {
                        print $c "$name has left\n";
                    }
                }
            }
        }
    }
}

close($server);

示例 2：简单 HTTP 服务器

#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;

my $port = 8080;
my $server = IO::Socket::INET->new(
    LocalPort => $port,
    Proto => 'tcp',
    Listen => 5,
    Reuse => 1
) or die "Cannot create server: $!";

print "HTTP server listening on port $port\n";

while (my $client = $server->accept) {
    my $request = <$client>;
    chomp $request;
    
    print "Request: $request\n";
    
    # 解析请求
    if ($request =~ /^GET\s+(\S+)/) {
        my $path = $1;
        $path = '/index.html' if $path eq '/';
        
        # 发送响应
        print $client "HTTP/1.1 200 OK\r\n";
        print $client "Content-Type: text/html\r\n";
        print $client "\r\n";
        print $client "<html><body><h1>Hello, World!</h1>";
        print $client "<p>You requested: $path</p></body></html>\r\n";
    }
    
    close($client);
}

close($server);

示例 3：时间服务器

#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;
use POSIX qw(strftime);

my $port = 8080;
my $server = IO::Socket::INET->new(
    LocalPort => $port,
    Proto => 'tcp',
    Listen => 5,
    Reuse => 1
) or die "Cannot create server: $!";

print "Time server listening on port $port\n";

while (my $client = $server->accept) {
    my $time = strftime("%Y-%m-%d %H:%M:%S", localtime);
    
    print $client "$time\n";
    print "Sent time to client\n";
    
    close($client);
}

close($server);

小结

本章节学习了 Perl 的 Socket 编程：

1. ✅ Socket 基础
2. ✅ TCP 服务器
3. ✅ TCP 客户端
4. ✅ UDP 编程
5. ✅ 高级 Socket 编程
6. ✅ 实践示例

接下来，我们将学习 Perl 面向对象。