無法從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運行。