目錄

名稱

perlipc - Perl 內部進程通信(信號、FIFO、管道、安全子進程、套接字和信號量)

描述

Perl 的基本 IPC 設施由古老的 Unix 信號、命名管道、管道打開、伯克利套接字例程和 SysV IPC 調用構建而成。每個在稍微不同的情況下使用。

信號

Perl 使用一種簡單的信號處理模型:%SIG 哈希包含用戶安裝的信號處理程序的名稱或引用。這些處理程序將被調用,參數是觸發它的信號的名稱。信號可以是有意從特定的鍵盤序列(如 control-C 或 control-Z)生成,

舉例來說,要捕獲一個中斷信號,設置一個處理器如下

our $shucks;

sub catch_zap {
    my $signame = shift;
    $shucks++;
    die "Somebody sent me a SIG$signame";
}
$SIG{INT} = __PACKAGE__ . "::catch_zap";
$SIG{INT} = \&catch_zap;  # best strategy

在 Perl 5.8.0 之前,你的處理器中應該盡量少做事情;請注意我們只是設置了一個全局變量,然後引發了一個異常。這是因為在大多數系統上,庫不可重入;特別是,內存分配和 I/O 例程不可重入。這意味著在你的處理器中幾乎做 任何 事情理論上都可能觸發內存錯誤和後續核心轉儲 - 請參閱下面的 "延遲信號(安全信號)"

信號的名稱是您系統上由 kill -l 列出的那些,或者您可以使用 CPAN 模塊 IPC::Signal 檢索它們。

您也可以選擇將字符串 "IGNORE""DEFAULT" 分配為處理器,此時 Perl 將嘗試丟棄信號或執行默認操作。

在大多數 Unix 平台上,CHLD(有時也稱為 CLD)信號對於 "IGNORE" 的值有特殊行為。在此類平台上將 $SIG{CHLD} 設置為 "IGNORE" 的效果是在父進程未能 wait() 其子進程時不創建殭屍進程(即自動收割子進程)。在此類平台上,使用設置為 "IGNORE"$SIG{CHLD} 通常會返回 -1

一些信號既不能被捕獲也不能被忽略,如 KILL 和 STOP(但不包括 TSTP)信號。請注意,忽略信號會使它們消失。如果您只想暫時阻止它們而不讓它們丟失,您將需要使用 POSIX 模塊的 sigprocmask

將信號發送到負進程 ID 意味著將信號發送到整個 Unix 進程組。此代碼向當前進程組中的所有進程發送一個掛起信號,並將 $SIG{HUP} 設置為 "IGNORE" 以防止其自殺

# block scope for local
{
    local $SIG{HUP} = "IGNORE";
    kill HUP => -getpgrp();
    # snazzy writing of: kill("HUP", -getpgrp())
}

發送的另一個有趣的信號是信號號為零。這實際上不會影響子進程,而是檢查它是否仍然活著或是否已更改其 UID。

unless (kill 0 => $kid_pid) {
    warn "something wicked happened to $kid_pid";
}

信號號為零可能失敗,因為在發送信號時,當前進程的真實或保存 UID 與發送進程的真實或有效 UID 不相同時,您可能沒有權限發送信號,即使進程仍然存活。您可以使用 $!%! 來確定失敗的原因。

unless (kill(0 => $pid) || $!{EPERM}) {
    warn "$pid looks dead";
}

你可能也想要對於簡單的信號處理程序採用匿名函數

$SIG{INT} = sub { die "\nOutta here!\n" };

SIGCHLD處理程序需要一些特殊的注意。如果第一個子進程死亡時引發的信號處理程序中發生第二個子進程的死亡,則我們將不會收到另一個信號。所以必須在這裡循環,否則我們會留下未被收集的子進程,成為殭屍進程。而且下一次兩個子進程死亡時我們會再得到一個殭屍進程,以此類推。

use POSIX ":sys_wait_h";
$SIG{CHLD} = sub {
    while ((my $child = waitpid(-1, WNOHANG)) > 0) {
        $Kid_Status{$child} = $?;
    }
};
# do something that forks...

請小心:qx(),system()和一些用於調用外部命令的模塊會執行fork(),然後等待()結果。因此,您的信號處理程序將被調用。由於system()或qx()已經調用了wait(),因此信號處理程序中的wait()將不會看到更多的殭屍進程,因此將被阻止。

防止此問題的最佳方法是使用waitpid(),如以下示例所示

use POSIX ":sys_wait_h"; # for nonblocking read

my %children;

$SIG{CHLD} = sub {
    # don't change $! and $? outside handler
    local ($!, $?);
    while ( (my $pid = waitpid(-1, WNOHANG)) > 0 ) {
        delete $children{$pid};
        cleanup_child($pid, $?);
    }
};

while (1) {
    my $pid = fork();
    die "cannot fork" unless defined $pid;
    if ($pid == 0) {
        # ...
        exit 0;
    } else {
        $children{$pid}=1;
        # ...
        system($command);
        # ...
   }
}

在Unix中,信號處理程序還用於超時。在一個安全受保護的eval{}塊內,您設置一個信號處理程序來捕獲警報信號,然後安排在幾秒鐘後向您發送一個警報。然後嘗試您的阻塞操作,在完成操作但在退出eval{}塊之前清除警報。如果觸發了,您將使用die()跳出塊。

以下是一個示例

my $ALARM_EXCEPTION = "alarm clock restart";
eval {
    local $SIG{ALRM} = sub { die $ALARM_EXCEPTION };
    alarm 10;
    flock($fh, 2)    # blocking write lock
                    || die "cannot flock: $!";
    alarm 0;
};
if ($@ && $@ !~ quotemeta($ALARM_EXCEPTION)) { die }

如果被定時的操作是system()或qx(),則這種技術容易生成殭屍進程。如果這對您很重要,則您需要自己進行fork()和exec(),並殺死不良的子進程。

對於更複雜的信號處理,您可能會看到標準的POSIX模塊。遺憾的是,這幾乎完全未記錄,但Perl源代碼分發中的ext/POSIX/t/sigaction.t文件中有一些示例。

處理守護進程中的SIGHUP信號

通常在系統啟動時開始並在系統關閉時關閉的進程稱為守護進程(Disk And Execution MONitor)。如果守護進程有一個在啟動進程後被修改的配置文件,則應該有一種方法告訴該進程重新讀取其配置文件而不停止該進程。許多守護進程使用SIGHUP信號處理程序提供此機制。當您想要告訴守護進程重新讀取文件時,只需向其發送SIGHUP信號。

以下示例實現了一個簡單的守護進程,每次接收到SIGHUP信號時都會重新啟動自己。實際的代碼位於子例程code()中,該子例程僅打印一些調試信息以顯示它的工作方式;它應該用實際的代碼替換。

#!/usr/bin/perl

use v5.36;

use POSIX ();
use FindBin ();
use File::Basename ();
use File::Spec::Functions qw(catfile);

$| = 1;

# make the daemon cross-platform, so exec always calls the script
# itself with the right path, no matter how the script was invoked.
my $script = File::Basename::basename($0);
my $SELF  = catfile($FindBin::Bin, $script);

# POSIX unmasks the sigprocmask properly
$SIG{HUP} = sub {
    print "got SIGHUP\n";
    exec($SELF, @ARGV)        || die "$0: couldn't restart: $!";
};

code();

sub code {
    print "PID: $$\n";
    print "ARGV: @ARGV\n";
    my $count = 0;
    while (1) {
        sleep 2;
        print ++$count, "\n";
    }
}

延遲信號(安全信號)

在 Perl 5.8.0 之前,安裝 Perl 代碼來處理信號會面臨兩個危險。首先,很少有系統庫函數是可重入的。如果信號在 Perl 執行一個函數(例如 malloc(3) 或 printf(3))時中斷,然後你的信號處理程序再次調用同一個函數,就可能會出現不可預測的行為,通常是核心轉儲。其次,Perl 在最低層級本身也不是可重入的。如果信號在 Perl 改變自身內部數據結構時中斷,同樣可能會導致不可預測的行為。

在知道這一點時,有兩種做法:悲觀或實用。悲觀的方法是在你的信號處理程序中盡量少做事情。設置一個已經有值的現有整數變量,然後返回。如果你正在進行一個慢速系統調用,這將無濟於事,它將重新啟動。這意味著你必須在處理程序中使用 die 函數跳轉。即使對於真正的悲觀主義者來說,這也有點大意,他們避免在處理程序中使用 die 函數,因為系統可能會對你不利。實用的方法是說:“我知道風險,但更喜歡方便”,在你的信號處理程序中做任何你想做的事情,並準備不時清理核心轉儲。

Perl 5.8.0 和之後的版本通過“延遲”信號來避免這些問題。也就是說,當系統向進程(實現 Perl 的 C 代碼)發送信號時,會設置一個標誌,然後立即返回處理程序。然後,在 Perl 解釋器的戰略性“安全”點(例如,當它即將執行新的操作碼時),檢查標誌,並執行 %SIG 中的 Perl 級別處理程序。這個“延遲”方案允許信號處理程序的編碼更靈活,因為我們知道 Perl 解釋器處於安全狀態,並且當調用處理程序時我們不在系統庫函數中。然而,實現與以前的 Perl 有以下不同之處

長運行操作碼

由於 Perl 解釋器只在即將執行新操作碼時查看信號標誌,因此在長時間運行的操作碼(例如,對非常大的字符串進行正則表達式操作)期間到達的信號將不會被看到,直到當前操作碼完成。

如果在一個操作碼期間某種類型的信號被觸發多次(例如來自於細粒度計時器),則該信號的處理程序只會在操作碼完成後被調用一次;所有其他實例將被丟棄。此外,如果您的系統信號隊列被淹沒到有信號被觸發但尚未被捕獲(因此尚未推遲)的程度,在操作碼完成時,這些信號可能會在後續操作碼中被捕獲並推遲,結果有時會令人意外。例如,即使調用了alarm(0)停止了警報的觸發,但不會取消已觸發但尚未被捕獲的警報的發送。不要依賴於本段描述的行為,因為它們是當前實現的副作用,並且在未來的Perl版本中可能會更改。

中斷IO

當傳遞一個信號(例如從控制-C的SIGINT)時,操作系統會中斷IO操作,如read(2),這用於實現Perl的readline()函數,<>運算符。在舊版本的Perl中,處理程序會立即被調用(而read不是"unsafe",這樣做效果很好)。使用"推遲"方案後,處理程序不會立即被調用,如果Perl正在使用系統的stdio庫,該庫可能會重新啟動read而不返回給Perl以便讓其有機會調用%SIG處理程序。如果在您的系統上發生這種情況,解決方案是使用:perlio層來進行IO--至少對於您希望使用信號中斷的那些句柄。(:perlio層會檢查信號標誌並在恢復IO操作之前調用%SIG處理程序。)

Perl 5.8.0及更高版本的默認值是自動使用:perlio層。

請注意,在信號處理程序中訪問與該信號中斷了同一句柄上的IO操作不是明智的。雖然perl至少會盡力避免崩潰,但無法保證數據完整性;例如,某些數據可能會被丟失或寫入兩次。

一些網絡庫函數,如gethostbyname(),已知具有自己的超時實現,可能與您的超時發生衝突。如果遇到此類問題,請嘗試使用POSIX sigaction()函數,該函數可以繞過Perl安全信號。請注意,這可能會導致內存損壞,如上所述。

不要設置$SIG{ALRM}而是

local $SIG{ALRM} = sub { die "alarm" };

嘗試類似以下的內容

use POSIX qw(SIGALRM);
POSIX::sigaction(SIGALRM,
                 POSIX::SigAction->new(sub { die "alarm" }))
         || die "Error setting SIGALRM handler: $!\n";

在本地停用安全信號行為的另一種方法是使用 CPAN 中的 Perl::Unsafe::Signals 模塊,這會影響所有信號。

可重啟系統呼叫

在支援的系統上,舊版 Perl 在安裝 %SIG 處理程序時使用了 SA_RESTART 標誌。這意味著可重啟系統呼叫將繼續進行,而不是在信號到達時返回。為了及時傳遞延遲的信號,Perl 5.8.0 及更高版本 使用 SA_RESTART。因此,在以前會成功的地方,可重啟系統呼叫可能會失敗(並將 $! 設置為 EINTR)。

默認的 :perlio 層會像上述描述的那樣重試 readwriteclose;中斷的 waitwaitpid 呼叫將始終被重試。

將信號視為“故障”

某些信號,如 SEGV、ILL、BUS 和 FPE,是由虛擬內存地址錯誤和類似的“故障”生成的。這些通常是致命的:在 Perl 層級處理程序幾乎無法處理它們。因此,Perl 立即傳遞它們,而不是嘗試延遲它們。

可以使用 %SIG 處理程序(參見 perlvar)捕獲這些信號,但除了“不安全”信號的通常問題外,信號很可能在從信號處理程序返回時立即重新抛出,因此這樣的處理程序應該使用 dieexit

由操作系統狀態觸發的信號

在某些操作系統上,某些信號處理程序應在返回之前“執行某些操作”。一個例子是 CHLD 或 CLD,它表示子進程已完成。在某些操作系統上,信號處理程序預計要 wait 完成的子進程。在這些系統上,延遲的信號方案將不適用於這些信號:它不執行 wait。同樣,失敗將看起來像一個循環,因為操作系統將重新發出信號,因為有已完成但尚未 wait 的子進程。

如果您希望恢復舊的信號行為,儘管可能會發生內存損壞,請將環境變量 PERL_SIGNALS 設置為 "unsafe"。此功能首次出現在 Perl 5.8.1 中。

命名管道

命名管道(通常稱為 FIFO)是進程在同一台機器上進行通信的一種舊 Unix IPC 機制。它的工作原理與常規的匿名管道相同,只是進程使用文件名會合並,並且不需要相關聯。

要創建命名管道,請使用 POSIX::mkfifo() 函數。

use POSIX qw(mkfifo);
mkfifo($path, 0700)     ||  die "mkfifo $path failed: $!";

您也可以使用 Unix 命令 mknod(1),或在某些系統上使用 mkfifo(1)。不過,這些命令可能不在您的正常路徑中。

# system return val is backwards, so && not ||
#
$ENV{PATH} .= ":/etc:/usr/etc";
if  (      system("mknod",  $path, "p")
        && system("mkfifo", $path) )
{
    die "mk{nod,fifo} $path failed";
}

當您想要將一個進程連接到另一個無關的進程時,命名管道是方便的。當您打開一個命名管道時,程序將被阻塞,直到另一端有內容。

舉例來說,假設你想要讓你的 .signature 檔案成為一個命名管道,而管道的另一端是一個 Perl 程式。現在每當任何程式(例如郵件程式、新聞閱讀器、finger 程式等)嘗試從該檔案讀取時,讀取程式將從你的程式讀取新的簽名。我們將使用管道檢查的文件測試運算子 -p 來確定是否有任何人(或任何東西)意外移除了我們的 fifo。

chdir();    # go home
my $FIFO = ".signature";

while (1) {
    unless (-p $FIFO) {
        unlink $FIFO;   # discard any failure, will catch later
        require POSIX;  # delayed loading of heavy module
        POSIX::mkfifo($FIFO, 0700)
                              || die "can't mkfifo $FIFO: $!";
    }

    # next line blocks till there's a reader
    open (my $fh, ">", $FIFO) || die "can't open $FIFO: $!";
    print $fh "John Smith (smith\@host.org)\n", `fortune -s`;
    close($fh)                || die "can't close $FIFO: $!";
    sleep 2;                # to avoid dup signals
}

使用 open() 進行 IPC

Perl 的基本 open() 陳述也可以通過將開啟模式指定為 |--| 來用於單向進程間通信。以下是如何啟動一個你打算寫入的子進程的方法

open(my $spooler, "|-", "cat -v | lpr -h 2>/dev/null")
                    || die "can't fork: $!";
local $SIG{PIPE} = sub { die "spooler pipe broke" };
print $spooler "stuff\n";
close $spooler      || die "bad spool: $! $?";

以下是如何啟動一個你打算從中讀取的子進程的方法

open(my $status, "-|", "netstat -an 2>&1")
                    || die "can't fork: $!";
while (<$status>) {
    next if /^(tcp|udp)/;
    print;
}
close $status       || die "bad netstat: $! $?";

請注意,這些操作是完整的 Unix 分叉,這意味著它們可能無法在所有外來系統上正確實現。有關可移植性詳細信息,請參見 "open" in perlport

在 open() 的兩引數形式中,管道開啟可以通過將管道符號附加或預置到第二個引數來實現

open(my $spooler, "| cat -v | lpr -h 2>/dev/null")
                    || die "can't fork: $!";
open(my $status, "netstat -an 2>&1 |")
                    || die "can't fork: $!";

這甚至可以在不支援分叉的系統上使用,但這可能允許打算讀取檔案的程式碼意外執行程式。如果能確定特定程式是期望在 @ARGV 中使用檔案名稱的 Perl 腳本,並使用 open() 的兩引數形式或 <> 運算子,聰明的程式設計師可以寫出如下程式

% program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile

無論從哪種類型的 shell 中調用,Perl 程式將從檔案 f1、進程 cmd1、標準輸入(在這種情況下為 tmpfile)、檔案 f2、命令 cmd2 和最後的檔案 f3 讀取。相當巧妙,對吧?

你可能會注意到你可以使用反引號達到與打開管道讀取相同的效果

print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
die "bad netstatus ($?)" if $?;

雖然表面上是這樣,但逐行或逐記錄處理檔案要高效得多,因為這樣你就不必一次性將整個檔案讀入記憶體中。這也讓你對整個過程有更細微的控制,讓你可以提前終止子進程。

請小心檢查open()和close()的返回值。如果你正在寫入一個管道,你還應該捕獲SIGPIPE信號。否則,想象一下當你開始向一個不存在的命令的管道寫入時會發生什麼:open()很可能會成功(它只反映了fork()的成功),但是然後你的輸出將會失敗——慘不忍睹。Perl無法知道命令是否成功,因為你的命令實際上是在一個獨立的進程中運行的,它的exec()可能已經失敗了。因此,當對虛假命令的讀取者只返回一個快速的EOF時,對虛假命令的寫入者將會收到一個信號,他們最好準備好處理它。請考慮

open(my $fh, "|-", "bogus") || die "can't fork: $!";
print $fh "bang\n";         #  neither necessary nor sufficient
                            #  to check print retval!
close($fh)                  || die "can't close: $!";

不檢查print()的返回值的原因是因為管道緩衝;物理寫入被延遲。這不會在close之前爆炸,它將以SIGPIPE爆炸。要捕獲它,您可以使用這個

$SIG{PIPE} = "IGNORE";
open(my $fh, "|-", "bogus") || die "can't fork: $!";
print $fh "bang\n";
close($fh)                  || die "can't close: status=$?";

Filehandles

主進程和它fork的任何子進程共享相同的STDIN、STDOUT和STDERR文件處理程序。如果兩個進程同時嘗試訪問它們,可能會發生奇怪的事情。您可能還想關閉或重新打開子進程的文件處理程序。您可以通過使用open()打開管道來解決這個問題,但在某些系統上,這意味著子進程不能生存超過父進程。

背景進程

您可以使用以下命令在後台運行一個命令

system("cmd &");

該命令的STDOUT和STDERR(取決於您的shell,可能還有STDIN)將與父進程的相同。由於發生了雙重fork,您將不需要捕獲SIGCHLD;有關詳細信息,請參閱下面的內容。

完全將子進程與父進程分離

在某些情況下(例如啟動服務器進程),您將希望完全將子進程與父進程分離。這通常被稱為守護進程。一個行為良好的守護進程還將chdir()到根目錄,以便它不會阻止卸載包含它所在目錄的文件系統,並將其標準文件描述符重定向到/dev/null,以便隨機輸出不會出現在用戶的終端上。

use POSIX "setsid";

sub daemonize {
    chdir("/")                     || die "can't chdir to /: $!";
    open(STDIN,  "<", "/dev/null") || die "can't read /dev/null: $!";
    open(STDOUT, ">", "/dev/null") || die "can't write /dev/null: $!";
    defined(my $pid = fork())      || die "can't fork: $!";
    exit if $pid;              # non-zero now means I am the parent
    (setsid() != -1)           || die "Can't start a new session: $!";
    open(STDERR, ">&", STDOUT) || die "can't dup stdout: $!";
}

在執行 setsid() 之前必須執行 fork(),以確保您不是進程組的領導者;如果是,setsid() 將失敗。如果您的系統沒有 setsid() 函數,則打開 /dev/tty,並對其使用 TIOCNOTTY ioctl()。詳細信息請參閱 tty(4)。

非 Unix 用戶應檢查其 Your_OS::Process 模塊,以尋找其他可能的解決方案。

安全管道開啟

另一種有趣的進程間通信(IPC)方法是使您的單個程序變成多進程並在其間或其中進行通信。open() 函數的兩個參數形式將接受文件參數,可以是 "-|" 或 "|-",從而執行非常有趣的操作:它會分叉一個子進程,連接到您打開的文件處理。子進程運行與父進程相同的程序。這在以假定的 UID 或 GID 運行時安全地打開文件時很有用,例如。如果您打開到負號的管道,您可以將數據寫入到您打開的文件處理,您的子進程將在其標準輸入(STDIN)中找到它。如果您從負號打開管道,您可以讀取您打開的文件處理,無論您的子進程向其標準輸出(STDOUT)寫入什麼。

my $PRECIOUS = "/path/to/some/safe/file";
my $sleep_count;
my $pid;
my $kid_to_write;

do {
    $pid = open($kid_to_write, "|-");
    unless (defined $pid) {
        warn "cannot fork: $!";
        die "bailing out" if $sleep_count++ > 6;
        sleep 10;
    }
} until defined $pid;

if ($pid) {                 # I am the parent
    print $kid_to_write @some_data;
    close($kid_to_write)    || warn "kid exited $?";
} else {                    # I am the child
    # drop permissions in setuid and/or setgid programs:
    ($>, $)) = ($<, $();
    open (my $outfile, ">", $PRECIOUS)
                            || die "can't open $PRECIOUS: $!";
    while (<STDIN>) {
        print $outfile;     # child STDIN is parent $kid_to_write
    }
    close($outfile)         || die "can't close $PRECIOUS: $!";
    exit(0);                # don't forget this!!
}

此構造的另一個常見用途是在無需 shell 干擾的情況下執行某些操作。對於 system(),這很簡單,但您不能安全地使用管道開啟或反引號。這是因為沒有辦法阻止 shell 介入您的參數。相反,使用更低級別的控制直接調用 exec()。

這是一個安全的反引號或管道開啟讀取

my $pid = open(my $kid_to_read, "-|");
defined($pid)            || die "can't fork: $!";

if ($pid) {             # parent
    while (<$kid_to_read>) {
                        # do something interesting
    }
    close($kid_to_read)  || warn "kid exited $?";

} else {                # child
    ($>, $)) = ($<, $(); # suid only
    exec($program, @options, @args)
                         || die "can't exec program: $!";
    # NOTREACHED
}

這是一個安全的管道開啟寫入

my $pid = open(my $kid_to_write, "|-");
defined($pid)            || die "can't fork: $!";

$SIG{PIPE} = sub { die "whoops, $program pipe broke" };

if ($pid) {             # parent
    print $kid_to_write @data;
    close($kid_to_write) || warn "kid exited $?";

} else {                # child
    ($>, $)) = ($<, $();
    exec($program, @options, @args)
                         || die "can't exec program: $!";
    # NOTREACHED
}

使用此類 open() 形式或多個子進程使用 pipe() 很容易造成進程死鎖。上面的示例是“安全的”,因為它簡單並調用 exec()。有關一般安全原則,請參閱“避免管道死鎖”,但安全管道開啟有額外的注意事項。

特別是,如果您使用 open $fh, "|-" 打開管道,則不能僅在父進程中使用 close() 來關閉不需要的寫入器。考慮以下代碼

my $pid = open(my $writer, "|-");        # fork open a kid
defined($pid)               || die "first fork failed: $!";
if ($pid) {
    if (my $sub_pid = fork()) {
        defined($sub_pid)   || die "second fork failed: $!";
        close($writer)      || die "couldn't close writer: $!";
        # now do something else...
    }
    else {
        # first write to $writer
        # ...
        # then when finished
        close($writer)      || die "couldn't close writer: $!";
        exit(0);
    }
}
else {
    # first do something with STDIN, then
    exit(0);
}

在上面的示例中,真正的父進程不想對 $writer 文件處理寫入,因此關閉它。但是,因為 $writer 是使用 open $fh, "|-" 打開的,它具有特殊行為:關閉它會調用 waitpid()(請參閱 perlfunc 中的“waitpid”),該函數等待子進程退出。如果子進程最終等待在標有“執行其他操作”部分中發生的事件上,則會發生死鎖。

在更複雜的程式碼中,中間的子進程也可能出現問題,這些子進程在全域解構期間會對所有打開的檔案描述符調用 waitpid(),且沒有可預測的順序。

要解決這個問題,您必須手動使用 pipe()、fork(),以及將 open() 的形式設置為另一個文件描述符的形式,如下所示:

pipe(my $reader, my $writer)   || die "pipe failed: $!";
my $pid = fork();
defined($pid)                  || die "first fork failed: $!";
if ($pid) {
    close $reader;
    if (my $sub_pid = fork()) {
        defined($sub_pid)      || die "first fork failed: $!";
        close($writer)         || die "can't close writer: $!";
    }
    else {
        # write to $writer...
        # ...
        # then  when finished
        close($writer)         || die "can't close writer: $!";
        exit(0);
    }
    # write to $writer...
}
else {
    open(STDIN, "<&", $reader) || die "can't reopen STDIN: $!";
    close($writer)             || die "can't close writer: $!";
    # do something...
    exit(0);
}

自從 Perl 5.8.0 版本以來,您還可以使用 open() 的列表形式進行管道操作。當您希望避免 shell 解釋可能存在於命令字符串中的元字符時,這是首選。

所以,例如,不要使用:

open(my $ps_pipe, "-|", "ps aux") || die "can't open ps pipe: $!";

您可以使用以下任一種:

open(my $ps_pipe, "-|", "ps", "aux")
                                  || die "can't open ps pipe: $!";

my @ps_args = qw[ ps aux ];
open(my $ps_pipe, "-|", @ps_args)
                                  || die "can't open @ps_args|: $!";

因為 open() 有超過三個參數,它會 fork ps(1) 命令而不會產生 shell,並通過 $ps_pipe 檔案描述符讀取其標準輸出。寫入命令管道的對應語法是將 "|-" 替換為 "-|"。

這無疑是一個相當愚蠢的例子,因為您使用的是內容完全安全的字符串文字。因此,沒有理由使用更難閱讀的多參數形式的 pipe open()。然而,每當您無法確保程序參數不包含 shell 元字符時,應該使用更複雜的 open() 形式。例如:

my @grep_args = ("egrep", "-i", $some_pattern, @many_files);
open(my $grep_pipe, "-|", @grep_args)
                    || die "can't open @grep_args|: $!";

這裡更傾向於使用 pipe open() 的多參數形式,因為模式甚至文件名本身都可能包含元字符。

避免管道死鎖

每當您有多個子進程時,必須小心地關閉任何用於進程間通信的管道的每一半。這是因為任何從管道讀取並期望 EOF 的子進程將永遠不會收到它,因此永遠不會退出。僅僅一個進程關閉管道是不夠的;必須關閉管道的最後一個仍然打開的進程,以便讀取 EOF。

某些內建的Unix功能大多數情況下有助於防止這種情況發生。例如,文件處理器具有“執行時關閉”標誌,該標誌在$^F變量的控制下設置。這樣,任何您沒有明確路由到子程式的STDIN、STDOUT或STDERR的文件處理器將自動關閉。

始終明確並立即對任何管道的可寫端調用close(),除非該過程實際上正在對其進行寫入。即使您沒有明確調用close(),Perl仍將在全局銷毀期間close()所有文件處理器。如前所述,如果這些文件處理器是使用安全管道打開的,則這將導致調用waitpid(),這可能再次造成死鎖。

與另一個進程的雙向通信

雖然這對於單向通信很有效,但是雙向通信呢?最明顯的方法不起作用

# THIS DOES NOT WORK!!
open(my $prog_for_reading_and_writing, "| some program |")

如果您忘記use warnings,則完全錯過了有用的診斷消息

Can't do bidirectional pipe at -e line 1.

如果您真的想要,您可以使用IPC::Open2模塊中的標準open2()捕獲兩端。還有一個IPC::Open3中的open3()用於三向I/O,因此您還可以捕獲子程式的STDERR,但這樣做將需要一個笨拙的select()循環,並且不允許您使用正常的Perl輸入操作。

如果您查看其源代碼,您將看到open2()使用低級原始的pipe()和exec()系統調用來創建所有連接。儘管使用socketpair()可能效率更高,但這將使其更不具移植性。open2()和open3()函數不太可能在除Unix系統之外的任何地方工作,或者至少在聲稱符合POSIX的系統上。

這是使用open2()的示例

use IPC::Open2;
my $pid = open2(my $reader, my $writer, "cat -un");
print $writer "stuff\n";
my $got = <$reader>;
waitpid $pid, 0;

問題在於緩衝區真的會毀了你的一天。即使您的$writer文件處理器是自動刷新的,因此另一端的過程及時收到您的數據,但通常情況下,您無法強迫該過程以同樣快的速度將其數據提供給您。在這種特殊情況下,我們實際上可以這樣做,因為我們給了cat一個-u標誌來使其無緩衝。但是很少有命令被設計為在管道上運行,因此這很少有效,除非您自己編寫了雙向管道另一端的程序。

解決這個問題的方法是使用一個使用虛擬終端(pseudottys)的庫,讓您的程序表現得更加合理。這樣,您就不需要對您正在使用的程序的源代碼進行控制。CPAN 中的 Expect 模組也解決了這種問題。此模組需要 CPAN 中的另外兩個模組,IO::PtyIO::Stty。它設置了一個虛擬終端以與堅持與終端設備驅動程序對話的程序進行交互。如果您的系統支持,這可能是您最好的選擇。

自我雙向通訊

如果您願意,您可以使用低級的 pipe() 和 fork() 系統調用手工將這些內容拼接在一起。此示例僅與自身對話,但您可以重新打開相應的 STDIN 和 STDOUT 句柄並調用其他進程。(以下示例缺少適當的錯誤檢查。)

#!/usr/bin/perl
# pipe1 - bidirectional communication using two pipe pairs
#         designed for the socketpair-challenged
use v5.36;
use IO::Handle;  # enable autoflush method before Perl 5.14
pipe(my $parent_rdr, my $child_wtr);  # XXX: check failure?
pipe(my $child_rdr,  my $parent_wtr); # XXX: check failure?
$child_wtr->autoflush(1);
$parent_wtr->autoflush(1);

if ($pid = fork()) {
    close $parent_rdr;
    close $parent_wtr;
    print $child_wtr "Parent Pid $$ is sending this\n";
    chomp(my $line = <$child_rdr>);
    print "Parent Pid $$ just read this: '$line'\n";
    close $child_rdr; close $child_wtr;
    waitpid($pid, 0);
} else {
    die "cannot fork: $!" unless defined $pid;
    close $child_rdr;
    close $child_wtr;
    chomp(my $line = <$parent_rdr>);
    print "Child Pid $$ just read this: '$line'\n";
    print $parent_wtr "Child Pid $$ is sending this\n";
    close $parent_rdr;
    close $parent_wtr;
    exit(0);
}

但您實際上不必進行兩次 pipe 調用。如果您有 socketpair() 系統調用,它將為您完成所有操作。

#!/usr/bin/perl
# pipe2 - bidirectional communication using socketpair
#   "the best ones always go both ways"

use v5.36;
use Socket;
use IO::Handle;  # enable autoflush method before Perl 5.14

# We say AF_UNIX because although *_LOCAL is the
# POSIX 1003.1g form of the constant, many machines
# still don't have it.
socketpair(my $child, my $parent, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
                            ||  die "socketpair: $!";

$child->autoflush(1);
$parent->autoflush(1);

if ($pid = fork()) {
    close $parent;
    print $child "Parent Pid $$ is sending this\n";
    chomp(my $line = <$child>);
    print "Parent Pid $$ just read this: '$line'\n";
    close $child;
    waitpid($pid, 0);
} else {
    die "cannot fork: $!" unless defined $pid;
    close $child;
    chomp(my $line = <$parent>);
    print "Child Pid $$ just read this: '$line'\n";
    print $parent "Child Pid $$ is sending this\n";
    close $parent;
    exit(0);
}

套接字:客戶端/服務器通信

雖然並不完全限於 Unix 衍生操作系統(例如,在個人計算機上的 WinSock 提供套接字支持,某些 VMS 库也提供套接字支持),但您的系統可能沒有套接字,如果是這樣,則本節可能對您沒有多大幫助。使用套接字,您可以執行像 TCP 流那樣的虛擬電路和像 UDP 封包那樣的數據報。根據您的系統,您可能還可以執行更多操作。

Perl 處理套接字的函數與 C 中對應的系統調用具有相同的名稱,但它們的參數通常有所不同。首先,Perl 文件處理與 C 文件描述符的工作方式不同。其次,Perl 已經知道其字符串的長度,因此您無需傳遞該信息。

在 Perl 中古老的、上千年前的套接字代碼的一個主要問題是它使用了一些常量的硬編碼值,這嚴重影響了可移植性。如果您看到任何像明確設置 $AF_INET = 2 之類的代碼,那麼您就知道您將面臨很大的麻煩。一種無法衡量的更優越的方法是使用 Socket 模組,它更可靠地授予您所需的各種常量和函數訪問權限。

如果您不是為現有協議(如 NNTP 或 SMTP)編寫服務器/客戶端,您應該考慮一下您的服務器將如何知道客戶端何時已經完成對話,反之亦然。大多數協議都基於單行消息和響應(因此當接收到“\n”時,一方知道另一方已經完成),或者多行消息和以空行上的句號結尾的響應(“\n。\n”終止消息/響應)。

網際線終結符

互联网行终止符是 "\015\012"。在Unix的ASCII变体下,通常可以写成 "\r\n",但在其他系统下,"\r\n" 有时可能是 "\015\015\012","\012\012\015",或者完全不同的东西。标准规定写成 "\015\012" 是符合规范的(在提供内容时要严格),但它们也建议在输入时接受单独的 "\012"(在需要时要宽松)。我们在本手册中的代码方面并没有总是做得很好,但除非你使用的是 Unix 的前身 Mac,你可能会没问题。

互联网 TCP 客户端和服务器

当您想要进行可能延伸到您自己系统之外的客户端-服务器通信时,请使用 Internet 域套接字。

这是一个使用 Internet 域套接字的示例 TCP 客户端

#!/usr/bin/perl
use v5.36;
use Socket;

my $remote  = shift || "localhost";
my $port    = shift || 2345;  # random port
if ($port =~ /\D/) { $port = getservbyname($port, "tcp") }
die "No port" unless $port;
my $iaddr   = inet_aton($remote)       || die "no host: $remote";
my $paddr   = sockaddr_in($port, $iaddr);

my $proto   = getprotobyname("tcp");
socket(my $sock, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
connect($sock, $paddr)              || die "connect: $!";
while (my $line = <$sock>) {
    print $line;
}

close ($sock)                        || die "close: $!";
exit(0);

这是一个相应的服务器。我们将地址留为空INADDR_ANY,以便内核可以在多宿主主机上选择适当的接口。如果您想要坐在特定接口上(比如网关或防火墙机器的外部),请用您的真实地址填写。

#!/usr/bin/perl -T
use v5.36;
BEGIN { $ENV{PATH} = "/usr/bin:/bin" }
use Socket;
use Carp;
my $EOL = "\015\012";

sub logmsg { print "$0 $$: @_ at ", scalar localtime(), "\n" }

my $port  = shift || 2345;
die "invalid port" unless $port =~ /^ \d+ $/x;

my $proto = getprotobyname("tcp");

socket(my $server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt($server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
                                              || die "setsockopt: $!";
bind($server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen($server, SOMAXCONN)                    || die "listen: $!";

logmsg "server started on port $port";

for (my $paddr; $paddr = accept(my $client, $server); close $client) {
    my($port, $iaddr) = sockaddr_in($paddr);
    my $name = gethostbyaddr($iaddr, AF_INET);

    logmsg "connection from $name [",
            inet_ntoa($iaddr), "]
            at port $port";

    print $client "Hello there, $name, it's now ",
                    scalar localtime(), $EOL;
}

这是一个多任务版本。它是多任务的,因为像大多数典型的服务器一样,它会生成(fork())一个子服务器来处理客户端请求,以便主服务器可以快速返回以服务新的客户端。

#!/usr/bin/perl -T
use v5.36;
BEGIN { $ENV{PATH} = "/usr/bin:/bin" }
use Socket;
use Carp;
my $EOL = "\015\012";

sub spawn;  # forward declaration
sub logmsg { print "$0 $$: @_ at ", scalar localtime(), "\n" }

my $port  = shift || 2345;
die "invalid port" unless $port =~ /^ \d+ $/x;

my $proto = getprotobyname("tcp");

socket(my $server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt($server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
                                              || die "setsockopt: $!";
bind($server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen($server, SOMAXCONN)                    || die "listen: $!";

logmsg "server started on port $port";

my $waitedpid = 0;

use POSIX ":sys_wait_h";
use Errno;

sub REAPER {
    local $!;   # don't let waitpid() overwrite current error
    while ((my $pid = waitpid(-1, WNOHANG)) > 0 && WIFEXITED($?)) {
        logmsg "reaped $waitedpid" . ($? ? " with exit $?" : "");
    }
    $SIG{CHLD} = \&REAPER;  # loathe SysV
}

$SIG{CHLD} = \&REAPER;

while (1) {
    my $paddr = accept(my $client, $server) || do {
        # try again if accept() returned because got a signal
        next if $!{EINTR};
        die "accept: $!";
    };
    my ($port, $iaddr) = sockaddr_in($paddr);
    my $name = gethostbyaddr($iaddr, AF_INET);

    logmsg "connection from $name [",
           inet_ntoa($iaddr),
           "] at port $port";

    spawn $client, sub {
        $| = 1;
        print "Hello there, $name, it's now ",
              scalar localtime(),
              $EOL;
        exec "/usr/games/fortune"       # XXX: "wrong" line terminators
            or confess "can't exec fortune: $!";
    };
    close $client;
}

sub spawn {
    my $client = shift;
    my $coderef = shift;

    unless (@_ == 0 && $coderef && ref($coderef) eq "CODE") {
        confess "usage: spawn CLIENT CODEREF";
    }

    my $pid;
    unless (defined($pid = fork())) {
        logmsg "cannot fork: $!";
        return;
    }
    elsif ($pid) {
        logmsg "begat $pid";
        return; # I'm the parent
    }
    # else I'm the child -- go spawn

    open(STDIN,  "<&", $client)   || die "can't dup client to stdin";
    open(STDOUT, ">&", $client)   || die "can't dup client to stdout";
    ## open(STDERR, ">&", STDOUT) || die "can't dup stdout to stderr";
    exit($coderef->());
}

这个服务器会为每个传入请求克隆一个子版本。这样它就可以同时处理许多请求,这可能并不总是您想要的。即使您不 fork(),listen() 也会允许同样数量的挂起连接。分叉服务器必须特别小心清理他们的已死亡子进程(在 Unix 术语中称为 "僵尸"),否则您将很快填满进程表。在这里使用 REAPER 子例程调用 waitpid() 来等待任何已完成的子进程,从而确保它们干净地终止并不加入活动的行列。

在 while 循环中,我们调用 accept() 并检查它是否返回假值。这通常表示需要报告系统错误。但是,Perl 5.8.0 引入了安全信号(参见上面的 "Deferred Signals (Safe Signals)")意味着当进程接收到信号时,accept() 也可能被中断。这通常发生在 fork() 的子进程退出并通过 CHLD 信号通知父进程时。

如果 accept() 被信号中断,$! 将设置为 EINTR。如果发生这种情况,我们可以安全地继续下一次循环迭代和另一个 accept() 调用。重要的是,您的信号处理代码不要修改 $! 的值,否则这个测试很可能失败。在 REAPER 子例程中,我们在调用 waitpid() 之前创建了 $! 的本地版本。当 waitpid() 设置 $! 为 ECHILD 时(它无可避免地会在没有更多等待的子进程时),它会更新本地副本并保持原样。

即使我们没有运行 setuid 或 setgid,您应该使用 -T 标志来启用污点检查(请参阅 perlsec)。对于服务器或代表他人运行的任何程序(如 CGI 脚本),这总是一个好主意,因为这样可以减少外部人员破坏您系统的机会。请注意,perl 可以在没有污点支持的情况下构建。有两种不同的模式:在其中一种模式下,-T 将悄悄地不起作用。在另一种模式下,-T 会导致致命错误。

讓我們來看另一個TCP客戶端。這個客戶端連接到多台不同的機器上的TCP“time”服務,並顯示它們的時鐘與運行它的系統的時鐘相差多遠。

#!/usr/bin/perl
use v5.36;
use Socket;

my $SECS_OF_70_YEARS = 2208988800;
sub ctime { scalar localtime(shift() || time()) }

my $iaddr = gethostbyname("localhost");
my $proto = getprotobyname("tcp");
my $port = getservbyname("time", "tcp");
my $paddr = sockaddr_in(0, $iaddr);

$| = 1;
printf "%-24s %8s %s\n", "localhost", 0, ctime();

foreach my $host (@ARGV) {
    printf "%-24s ", $host;
    my $hisiaddr = inet_aton($host)     || die "unknown host";
    my $hispaddr = sockaddr_in($port, $hisiaddr);
    socket(my $socket, PF_INET, SOCK_STREAM, $proto)
                                        || die "socket: $!";
    connect($socket, $hispaddr)         || die "connect: $!";
    my $rtime = pack("C4", ());
    read($socket, $rtime, 4);
    close($socket);
    my $histime = unpack("N", $rtime) - $SECS_OF_70_YEARS;
    printf "%8d %s\n", $histime - time(), ctime($histime);
}

Unix域TCP客戶端和服務器

這對於互聯網域客戶端和服務器來說沒問題,但是對於本地通信呢?雖然您可以使用相同的設置,但有時您可能不希望這樣。Unix域套接字僅限於當前主機,通常在內部用於實現管道。與互聯網域套接字不同,Unix域套接字可以在文件系統中顯示為ls(1)列表。

% ls -l /dev/log
srw-rw-rw-  1 root            0 Oct 31 07:23 /dev/log

您可以使用Perl的-S文件測試來測試這些套接字

unless (-S "/dev/log") {
    die "something's wicked with the log system";
}

這是一個示例Unix域客戶端

#!/usr/bin/perl
use v5.36;
use Socket;

my $rendezvous = shift || "catsock";
socket(my $sock, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
connect($sock, sockaddr_un($rendezvous))  || die "connect: $!";
while (defined(my $line = <$sock>)) {
    print $line;
}
exit(0);

這是相應的服務器。在這裡您不必擔心愚蠢的網絡終止符,因為Unix域套接字保證在本地主機上,因此一切正常。

#!/usr/bin/perl -T
use v5.36;
use Socket;
use Carp;

BEGIN { $ENV{PATH} = "/usr/bin:/bin" }
sub spawn;  # forward declaration
sub logmsg { print "$0 $$: @_ at ", scalar localtime(), "\n" }

my $NAME = "catsock";
my $uaddr = sockaddr_un($NAME);
my $proto = getprotobyname("tcp");

socket(my $server, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
unlink($NAME);
bind  ($server, $uaddr)                     || die "bind: $!";
listen($server, SOMAXCONN)                  || die "listen: $!";

logmsg "server started on $NAME";

my $waitedpid;

use POSIX ":sys_wait_h";
sub REAPER {
    my $child;
    while (($waitedpid = waitpid(-1, WNOHANG)) > 0) {
        logmsg "reaped $waitedpid" . ($? ? " with exit $?" : "");
    }
    $SIG{CHLD} = \&REAPER;  # loathe SysV
}

$SIG{CHLD} = \&REAPER;


for ( $waitedpid = 0;
      accept(my $client, $server) || $waitedpid;
      $waitedpid = 0, close $client)
{
    next if $waitedpid;
    logmsg "connection on $NAME";
    spawn $client, sub {
        print "Hello there, it's now ", scalar localtime(), "\n";
        exec("/usr/games/fortune")  || die "can't exec fortune: $!";
    };
}

sub spawn {
    my $client = shift();
    my $coderef = shift();

    unless (@_ == 0 && $coderef && ref($coderef) eq "CODE") {
        confess "usage: spawn CLIENT CODEREF";
    }

    my $pid;
    unless (defined($pid = fork())) {
        logmsg "cannot fork: $!";
        return;
    }
    elsif ($pid) {
        logmsg "begat $pid";
        return; # I'm the parent
    }
    else {
        # I'm the child -- go spawn
    }

    open(STDIN,  "<&", $client)
        || die "can't dup client to stdin";
    open(STDOUT, ">&", $client)
        || die "can't dup client to stdout";
    ## open(STDERR, ">&", STDOUT)
    ##  || die "can't dup stdout to stderr";
    exit($coderef->());
}

正如您所見,它與互聯網域TCP服務器非常相似,事實上,我們省略了幾個重複的函數--spawn(),logmsg(),ctime()和REAPER()--它們與其他服務器中的相同。

那麼為什麼您希望使用Unix域套接字而不是更簡單的命名管道呢?因為命名管道不提供會話。您無法將一個進程的數據與另一個的數據區分開來。通過套接字編程,您為每個客戶端獲得一個單獨的會話;這就是為什麼accept()需要兩個參數的原因。

例如,假設您有一個長期運行的數據庫服務器守護程序,您希望人們能夠通過Web訪問,但只有在通過CGI接口時才能這樣做。您將擁有一個小型、簡單的CGI程序,該程序進行任何您想要的檢查和記錄,然後作為Unix域客戶端並連接到您的私有服務器。

使用IO::Socket的TCP客戶端

對於那些更喜歡使用較高級界面進行套接字編程的人來說,IO::Socket模塊提供了一種面向對象的方法。如果出於某種原因您缺少此模塊,您可以從CPAN中獲取IO::Socket,您還可以找到提供以下系統易於使用界面的模塊:DNS、FTP、Ident(RFC 931)、NIS和NISPlus、NNTP、Ping、POP3、SMTP、SNMP、SSLeay、Telnet和Time——僅舉幾例。

一個簡單的客戶端

這是一個客戶端,它在主機名“localhost”的端口13上創建到“日間”服務的TCP連接,並打印出服務器提供的所有內容。

#!/usr/bin/perl
use v5.36;
use IO::Socket;
my $remote = IO::Socket::INET->new(
                    Proto    => "tcp",
                    PeerAddr => "localhost",
                    PeerPort => "daytime(13)",
                )
             || die "can't connect to daytime service on localhost";
while (<$remote>) { print }

當您運行此程序時,應該會收到類似於以下的返回結果

Wed May 14 08:40:46 MDT 1997

以下是new()構造函數的參數的含義

Proto

這是要使用的協議。在這種情況下,返回的套接字句柄將連接到TCP套接字,因為我們想要一個流導向的連接,即行為幾乎與普通文件一樣。並非所有的套接字都是這種類型。例如,UDP協議可用於創建數據報套接字,用於消息傳遞。

PeerAddr

這是運行服務器的遠程主機的名稱或Internet地址。我們可以指定一個更長的名稱,例如"www.perl.com",或者像"207.171.7.72"這樣的地址。為了演示目的,我們使用了特殊的主機名"localhost",這應該始終表示您正在運行的當前計算機。localhost的相應Internet地址是"127.0.0.1",如果您更喜歡使用該地址。

PeerPort

這是我們想要連接的服務名稱或端口號。在具有良好配置的系統服務文件的系統上,我們可以僅使用"daytime",但在這裡我們在括號中指定了端口號(13)。僅使用數字也可以,但數字文字使謹慎的程序員感到不安。

一個Webget客戶端

這是一個簡單的客戶端,它需要一個遠程主機以從中獲取文檔,然後是要從該主機獲取的文件列表。這比前一個客戶端更有趣,因為它在從服務器獲取響應之前首先向服務器發送了一些內容。

#!/usr/bin/perl
use v5.36;
use IO::Socket;
unless (@ARGV > 1) { die "usage: $0 host url ..." }
my $host = shift(@ARGV);
my $EOL = "\015\012";
my $BLANK = $EOL x 2;
for my $document (@ARGV) {
    my $remote = IO::Socket::INET->new( Proto     => "tcp",
                                        PeerAddr  => $host,
                                        PeerPort  => "http(80)",
              )     || die "cannot connect to httpd on $host";
    $remote->autoflush(1);
    print $remote "GET $document HTTP/1.0" . $BLANK;
    while ( <$remote> ) { print }
    close $remote;
}

處理 HTTP 服務的 Web 伺服器假設位於其標準埠,號碼為 80。如果您嘗試連接的伺服器位於不同的埠,例如 1080 或 8080,您應將其指定為命名參數對,PeerPort => 8080。對套接字使用 autoflush 方法是因為否則系統將緩衝我們發送的輸出。 (如果您使用的是史前時代的 Mac,您還需要將代碼中每個傳送資料到網絡的 "\n" 改為 "\015\012"。)

連接到伺服器僅是過程的第一部分:一旦建立了連接,您必須使用伺服器的語言。網絡上的每個伺服器都有自己的小型命令語言,它期望作為輸入。我們發送到以 "GET" 開頭的伺服器的字串是 HTTP 語法。在這種情況下,我們只是請求每個指定的文件。是的,我們確實為每個文件進行了新的連接,即使它們是同一主機。這是您總是需要使用 HTTP 的方式。最近版本的 Web 瀏覽器可能會要求遠程伺服器保持連接一小段時間,但伺服器不必遵循此類要求。

這是運行該程式的範例,我們將其稱為 webget

% webget www.perl.com /guanaco.html
HTTP/1.1 404 File Not Found
Date: Thu, 08 May 1997 18:02:32 GMT
Server: Apache/1.2b6
Connection: close
Content-type: text/html

<HEAD><TITLE>404 File Not Found</TITLE></HEAD>
<BODY><H1>File Not Found</H1>
The requested URL /guanaco.html was not found on this server.<P>
</BODY>

好吧,那不是很有趣,因為它沒有找到該特定文件。但是,一個長回應不會適合在此頁面上。

對於這個程式的更多功能版本,您應該查看 CPAN 中包含的 LWP 模組中的 lwp-request 程式。

使用 IO::Socket 的交互式客戶端

如果您想要發送一條命令並獲得一個答案,那麼這一切都很好,但是如果要設置完全交互式的東西,與 telnet 的工作方式有些類似怎麼辦?這樣您就可以輸入一行,獲得答案,輸入一行,獲得答案,依此類推。

這個客戶端比我們迄今為止做過的兩個要複雜得多,但如果您在支持強大的 fork 調用的系統上,解決方案就不會那麼粗糙。一旦您連接到想要聊天的服務,就調用 fork 來克隆您的進程。這兩個相同進程中的每個都有一個非常簡單的任務要完成:父進程將所有內容從套接字複製到標準輸出,而子進程同時將所有內容從標準輸入複製到套接字。要僅使用一個進程完成相同的事情會更難,因為編寫兩個進程執行一個任務比編寫一個進程執行兩個任務更容易。 (這是 Unix 哲學的一個基石,也是良好的軟件工程的原則,這可能是為什麼它傳播到其他系統的原因。)

這是代碼

#!/usr/bin/perl
use v5.36;
use IO::Socket;

unless (@ARGV == 2) { die "usage: $0 host port" }
my ($host, $port) = @ARGV;

# create a tcp connection to the specified host and port
my $handle = IO::Socket::INET->new(Proto     => "tcp",
                                   PeerAddr  => $host,
                                   PeerPort  => $port)
           || die "can't connect to port $port on $host: $!";

$handle->autoflush(1);       # so output gets there right away
print STDERR "[Connected to $host:$port]\n";

# split the program into two processes, identical twins
die "can't fork: $!" unless defined(my $kidpid = fork());

# the if{} block runs only in the parent process
if ($kidpid) {
    # copy the socket to standard output
    while (defined (my $line = <$handle>)) {
        print STDOUT $line;
    }
    kill("TERM", $kidpid);   # send SIGTERM to child
}
# the else{} block runs only in the child process
else {
    # copy standard input to the socket
    while (defined (my $line = <STDIN>)) {
        print $handle $line;
    }
    exit(0);                # just in case
}

父進程中的 kill 函數位於其 if 塊中,它是為了在遠程伺服器關閉其連接的一端時向我們當前運行在 else 塊中的子進程發送一個信號。

如果遠程伺服器一次發送一個字節的數據,並且您需要立即獲得該數據而不必等待換行(可能不會發生),則可能希望將父進程中的 while 循環替換為以下內容

my $byte;
while (sysread($handle, $byte, 1) == 1) {
    print STDOUT $byte;
}

對於每個要讀取的字節進行系統調用效率不高(委婉地說)但是最簡單解釋且效果還不錯。

使用 IO::Socket 的 TCP 伺服器

一如既往,設定伺服器比執行客戶端更為複雜。模式是伺服器建立一種特殊的套接字,專門在特定埠口上監聽傳入的連接。它通過呼叫 IO::Socket::INET->new() 方法來完成,其參數略有不同於客戶端。

Proto(協定)

這是要使用的協定。與我們的客戶端一樣,這裡仍然會指定 "tcp"

LocalPort(本地埠口)

我們在 LocalPort 參數中指定一個本地埠口,這是我們為客戶端所未做的。這是您希望成為伺服器的服務名稱或埠口號碼。(在 Unix 下,埠口號碼小於 1024 的埠口受限於超級用戶。)在我們的範例中,我們將使用埠口 9000,但您可以使用系統上目前未使用的任何埠口。如果您嘗試使用已被使用的埠口,您將收到一條「地址已在使用中」的訊息。在 Unix 下,netstat -a 命令將顯示當前有哪些服務器正在運行。

Listen(監聽)

Listen 參數設置為我們可以接受的最大挂起連接數,直到我們拒絕傳入的客戶端。把它想像成您電話的等待接聽佇列。低階 Socket 模組有一個系統最大值的特殊符號,即 SOMAXCONN。

Reuse(重用)

需要 Reuse 參數,這樣我們可以在不等待幾分鐘以讓系統緩衝區清除的情況下手動重新啟動我們的伺服器。

一旦使用上述列出的參數創建了通用伺服器套接字,伺服器就等待新的客戶端連接。伺服器在 accept 方法中阻塞,最終接受來自遠程客戶端的雙向連接。(確保自動刷新此處理以繞過緩衝。)

為了增加使用者友好性,我們的伺服器提示使用者輸入命令。大多數伺服器不會這樣做。由於沒有換行符的提示,您將需要使用上面的互動客戶端的 sysread 變體。

此伺服器接受五種不同的命令之一,並將輸出發送回客戶端。與大多數網絡伺服器不同,此伺服器一次只處理一個傳入的客戶端。多任務伺服器在「Camel」的第 16 章中介紹。

這是程式碼。

#!/usr/bin/perl
use v5.36;
use IO::Socket;
use Net::hostent;      # for OOish version of gethostbyaddr

my $PORT = 9000;       # pick something not in use

my $server = IO::Socket::INET->new( Proto     => "tcp",
                                    LocalPort => $PORT,
                                    Listen    => SOMAXCONN,
                                    Reuse     => 1);

die "can't setup server" unless $server;
print "[Server $0 accepting clients]\n";

while (my $client = $server->accept()) {
  $client->autoflush(1);
  print $client "Welcome to $0; type help for command list.\n";
  my $hostinfo = gethostbyaddr($client->peeraddr);
  printf "[Connect from %s]\n",
         $hostinfo ? $hostinfo->name : $client->peerhost;
  print $client "Command? ";
  while ( <$client>) {
    next unless /\S/;     # blank line
    if    (/quit|exit/i)  { last                                      }
    elsif (/date|time/i)  { printf $client "%s\n", scalar localtime() }
    elsif (/who/i )       { print  $client `who 2>&1`                 }
    elsif (/cookie/i )    { print  $client `/usr/games/fortune 2>&1`  }
    elsif (/motd/i )      { print  $client `cat /etc/motd 2>&1`       }
    else {
      print $client "Commands: quit date who cookie motd\n";
    }
  } continue {
     print $client "Command? ";
  }
  close $client;
}

UDP:消息傳遞

另一種客戶端-伺服器設置是使用消息而不是連接。UDP 通訊涉及較低的開銷,但也提供較低的可靠性,因為不能保證消息會到達,更不用說按順序和未受損地到達。儘管如此,UDP 在某些方面優於 TCP,包括能夠一次向整個目標主機群組“廣播”或“多播”(通常在您的本地子網上)。如果您對可靠性過於關注並開始在您的消息系統中添加檢查,那麼您可能應該一開始就使用 TCP。

UDP 數據包並不是一個字節流,不應該這樣對待。這使得使用像 stdio(即 print() 和其它相關函數)這樣具有內部緩衝的 I/O 機制尤其麻煩。使用 syswrite(),或更好的是 send(),就像下面的示例中一樣。

這是一個類似於之前給出的樣本網際網路 TCP 客戶端的 UDP 程序。但是,UDP 版本不是一次檢查一個主機,而是通過模擬多播來異步檢查許多主機,然後使用 select() 進行超時等待 I/O。要想在 TCP 中進行類似的操作,您將不得不為每個主機使用不同的 socket 句柄。

#!/usr/bin/perl
use v5.36;
use Socket;
use Sys::Hostname;

my $SECS_OF_70_YEARS = 2_208_988_800;

my $iaddr = gethostbyname(hostname());
my $proto = getprotobyname("udp");
my $port = getservbyname("time", "udp");
my $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick

socket(my $socket, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
bind($socket, $paddr)                           || die "bind: $!";

$| = 1;
printf "%-12s %8s %s\n",  "localhost", 0, scalar localtime();
my $count = 0;
for my $host (@ARGV) {
    $count++;
    my $hisiaddr = inet_aton($host)         || die "unknown host";
    my $hispaddr = sockaddr_in($port, $hisiaddr);
    defined(send($socket, 0, 0, $hispaddr)) || die "send $host: $!";
}

my $rout = my $rin = "";
vec($rin, fileno($socket), 1) = 1;

# timeout after 10.0 seconds
while ($count && select($rout = $rin, undef, undef, 10.0)) {
    my $rtime = "";
    my $hispaddr = recv($socket, $rtime, 4, 0) || die "recv: $!";
    my ($port, $hisiaddr) = sockaddr_in($hispaddr);
    my $host = gethostbyaddr($hisiaddr, AF_INET);
    my $histime = unpack("N", $rtime) - $SECS_OF_70_YEARS;
    printf "%-12s ", $host;
    printf "%8d %s\n", $histime - time(), scalar localtime($histime);
    $count--;
}

此示例不包括任何重試,因此可能無法聯繫到可達的主機。造成這種情況的最突出原因是,如果要聯繫的主機數量足夠大,發送主機上的隊列將擁塞。

SysV IPC

雖然 System V IPC 沒有像 sockets 那麼廣泛使用,但它仍然具有一些有趣的用途。但是,您不能使用 SysV IPC 或 Berkeley mmap() 來在多個進程之間共享變量。這是因為 Perl 在您不希望它進行時將重新分配您的字符串。您可以查看 IPC::Shareable 或 threads::shared 模塊進行相應的處理。

這裡是一個展示共享內存使用的小示例。

use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRUSR S_IWUSR);

my $size = 2000;
my $id = shmget(IPC_PRIVATE, $size, S_IRUSR | S_IWUSR);
defined($id)                    || die "shmget: $!";
print "shm key $id\n";

my $message = "Message #1";
shmwrite($id, $message, 0, 60)  || die "shmwrite: $!";
print "wrote: '$message'\n";
shmread($id, my $buff, 0, 60)      || die "shmread: $!";
print "read : '$buff'\n";

# the buffer of shmread is zero-character end-padded.
substr($buff, index($buff, "\0")) = "";
print "un" unless $buff eq $message;
print "swell\n";

print "deleting shm $id\n";
shmctl($id, IPC_RMID, 0)        || die "shmctl: $!";

這是一個信號量的示例

use IPC::SysV qw(IPC_CREAT);

my $IPC_KEY = 1234;
my $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT);
defined($id)                    || die "semget: $!";
print "sem id $id\n";

將此代碼放入一個單獨的文件中,以便在多個進程中運行。將文件命名為 take

# create a semaphore

my $IPC_KEY = 1234;
my $id = semget($IPC_KEY, 0, 0);
defined($id)                    || die "semget: $!";

my $semnum  = 0;
my $semflag = 0;

# "take" semaphore
# wait for semaphore to be zero
my $semop = 0;
my $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);

# Increment the semaphore count
$semop = 1;
my $opstring2 = pack("s!s!s!", $semnum, $semop,  $semflag);
my $opstring  = $opstring1 . $opstring2;

semop($id, $opstring)   || die "semop: $!";

將此代碼放入一個單獨的文件中,以便在多個進程中運行。將文件命名為 give

# "give" the semaphore
# run this in the original process and you will see
# that the second process continues

my $IPC_KEY = 1234;
my $id = semget($IPC_KEY, 0, 0);
die unless defined($id);

my $semnum  = 0;
my $semflag = 0;

# Decrement the semaphore count
my $semop = -1;
my $opstring = pack("s!s!s!", $semnum, $semop, $semflag);

semop($id, $opstring)   || die "semop: $!";

上面的 SysV IPC 代碼是很久以前寫的,看起來確實有些笨拙。要想得到更現代化的外觀,請查看 IPC::SysV 模塊。

示範 SysV 訊息佇列的小例子

use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRUSR S_IWUSR);

my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRUSR | S_IWUSR);
defined($id)                || die "msgget failed: $!";

my $sent      = "message";
my $type_sent = 1234;

msgsnd($id, pack("l! a*", $type_sent, $sent), 0)
                            || die "msgsnd failed: $!";

msgrcv($id, my $rcvd_buf, 60, 0, 0)
                            || die "msgrcv failed: $!";

my($type_rcvd, $rcvd) = unpack("l! a*", $rcvd_buf);

if ($rcvd eq $sent) {
    print "okay\n";
} else {
    print "not okay\n";
}

msgctl($id, IPC_RMID, 0)    || die "msgctl failed: $!\n";

注意事項

大多數這些例程在失敗時都會安靜地但禮貌地返回 undef,而不是立即因為未捕獲的異常而使您的程序中止。 (實際上,一些新的 Socket 轉換函數確實在不良參數上使用 croak()。)因此,從這些函數檢查返回值是至關重要的。為了取得最佳成功,始終以這種方式開始您的套接字程序,並且不要忘記在服務器的 #! 行中添加 -T 污點檢查標誌。

#!/usr/bin/perl -T
use v5.36;
use sigtrap;
use Socket;

錯誤

這些例程都會創建特定於系統的可移植性問題。正如在其他地方所述,Perl 在很大程度上受制於您的 C 函式庫,因為它的系統行為。假設信號的 SysV 語義存在問題可能是最安全的,並且堅持使用簡單的 TCP 和 UDP 套接字操作;例如,如果您希望代碼具有可移植性,請勿嘗試通過本地 UDP 數據報套接字傳遞打開的文件描述符。

作者

Tom Christiansen,偶爾帶有 Larry Wall 的原始版本的遺留部分和 Perl Porters 的建議。

另請參閱

網絡世界遠不止於此,但這應該能讓您開始。

對於勇敢的程序員來說,不可或缺的教科書是 W. Richard Stevens 撰寫的《Unix 網絡編程,第二版,卷 1》(由 Prentice-Hall 出版)。大多數關於網絡的書籍都從 C 程序員的角度來討論這一主題;將其翻譯為 Perl 是讀者的練習。

IO::Socket(3) 手冊頁描述了對象庫,而 Socket(3) 手冊頁描述了套接字的低級界面。除了在perlfunc中明顯的功能之外,您還應該檢查您最近的 CPAN 站點上的 modules 文件,特別是http://www.cpan.org/modules/00modlist.long.html#ID5_Networking_。參見perlmodlib,或者最好是 Perl FAQ,了解 CPAN 是什麼以及如何獲取它,如果上述鏈接對您無效的話。

CPAN 的 modules 文件第 5 部分專門討論 "網絡、設備控制(數據機)和進程間通信",包含眾多未打包的模塊、大量網絡模塊、聊天和期望操作、CGI 編程、DCE、FTP、IPC、NNTP、代理、Ptty、RPC、SNMP、SMTP、Telnet、線程和 ToolTalk——僅舉其中一部分。