无法从perl中读取套接字 - 可能发生死锁？

Question

我的操作系统是Archlinux和perl 5.14.2。我只是想写一个小程序来完成一个远程comlile。该程序只是将C源文件传递给服务器。服务器将调用gcc编译C代码并传递编译器的消息。客户端无法收到编译器的消息。我在服务器中有消息。 有代码：

#!/usr/bin/perl -w 
# oj.pl --- alpha 


use warnings; 
use strict; 
use IO::File; 
use IO::Socket; 

use constant MY_TRAN_PORT => 138000; 
$| = 1; 


my $tmpFileToBeCompiled = IO::File->new ("> tmpFile09090989.c") or die "Can't creat this file"; 

#if (defined $tmpFileToBeCompiled) { 
# print $tmpFileToBeCompiled "argh";   # just for test! 
#} 
# $fihi->close; 

my $port  = shift || MY_TRAN_PORT; 

my $sock_server = IO::Socket::INET->new (Listen   => 20, 
             LocalPort  => $port, 
             Timeout  => 60, 
             Reuse   => 1) 
    or die "Can't create listening socket: $!\n"; 

my $tmp = 1; 
while ($tmp) { 
    next unless my $session = $sock_server->accept; 

    my $peer = gethostbyaddr ($session->peeraddr, AF_INET) 
     || $session->peerhost; 
    warn "Connection from [$peer, $port]\n"; 

    while (<$session>) { 
     print $tmpFileToBeCompiled $_;    # if it works, the filehandle should be changed into tmpFile. just fixed. 
     print $session "test!"; 

    } 

    my @lines = `gcc tmpFile09090989.c 2>&1`; 

    foreach (@lines) { 
     print $session $_ . "test!!!\n"; 
    # $session->print; 
    } 


    print "OK!"; 
    $tmpFileToBeCompiled->close; 

    warn "Connecting finished!\n"; 
    $session->close; 
    $tmp --; 
} 

$sock_server->close; 

----------------------------------------end-------------------------------------------------------- 
-------------------------------------client.pl-------------------------------------------------------- 
use warnings; 
use strict; 

use IO::Socket qw(:DEFAULT); 
use File::Copy; 
use constant MY_TRAN_PORT => 138000; 
use IO::File; 

my $host = shift || '127.0.0.1'; 
my $port = shift || MY_TRAN_PORT; 

my $socket = IO::Socket::INET->new("$host:$port") or die $@; 

my $fh = IO::File->new("a.c", "r"); 

my $child = fork(); 
die "Can't fork: $!\n" unless defined $child; 

# if (!$child) { 
#  $SIG{CHLD} = sub { exit 0 }; 
#  userToHost(); 
#  print "Run userToHost done!\n"; 

#  $socket->shutdown(1); 
#  sleep; 
# } else { 
#  hostToUser(); 
#  print "Run hostToUser done! \n"; 

#  warn "Connection closed by foreign host\n"; 

# } 
userToHost(); 
unless ($child) { 
    hostToUser(); 
    print "Run hostToUser done! \n"; 
    warn "Connection closed by foreign host\n"; 
    $socket->close; 

} 

sub userToHost { 
    while (<$fh>) { 
# print $_; # for debug 
    print $socket $_; 
    } 
} 

sub hostToUser { 
    while (<$socket >) { 
    print $_;  
    } 
} 
# copy ("a.c", $socket) or die "Copy failed: $!"; 
print "Done!"; 

Answer 1

1. 你不需要在客户端叉。完全一样。就像themel说
2. 你有错误的客户端代码：<$socket >应该<$socket>
3. 你需要通知你写的所有数据和服务器可以开始编译服务器。否则服务器将永远卡在while (<$session>)。 要达到此目的，您可以拨打shutdown($socket, 1)这意味着您完成了写作。见perldoc -f shutdown

最终原型（很粗糙）看起来是这样的：https://gist.github.com/19b589b8fc8072e3cfff

Answer 2

YKO钉，但我只想表明，你的任务将在一个更简单，更易于维护的方式由外壳来解决脚本从inetd运行。