Perlでリクに答えるスクリプトを作るスレ

Perlでリクに答えるスクリプトを作るスレat TECH

Perlでリクに答えるスクリプトを作るスレ - 暇つぶし2ch■コピペモード
□スレを通常表示
□オプションモード
□このｽﾚｯﾄﾞのURL
■項目テキスト

50:SimpleHTTPD.pl
 04/06/09 01:07
#!/usr/bin/perl 
use IO::Socket; 
$SIG{CHLD} = sub {wait()}; 
$main_sock= new IO::Socket::INET(LocalHost => 'localhost', 
LocalPort => 9999, 
Listen =>5, 
Proto => 'tcp', 
Reuse => 1, 
 ); 
$Dfile="index.html";  
while($new_sock = $main_sock->accept()){ 
 select($new_sock); 
  $ |= 1; 
  select(STDOUT); 
    $pid = fork(); 
    die "Cannot fork: $!" unless defined ($pid); 
    if($pid == 0){  
while(defined ($buf = <$new_sock>)){ 
    print $buf; 
    if($buf eq "exit"){close $new_sock} 
    if($buf=~/^GET\s/){ 
$buf=~s/^GET\s\/(.*)\sHTTP\/1.\d/ 
    $1/x; 
$Dfile=$buf; 
print "File $Dfile\n";

51:Dream☆ ◆hG4XfSMGTg 
 04/06/09 01:10
    } 
    if($buf=~/^\r\n$/){ 
print $new_sock "HTTP/1.1 200 OK\r 
Server: Apache/2.0.40 (Red Hat Linux)\r 
Accept-Ranges: bytes\r 
Connection: close\r 
Content-Type: text/html; charset=ISO-8859-1\r 
\r\n\r\n"; 
open(FILE,$Dfile); 
while(<FILE>){ 
    print $new_sock $_; 
} 
close($new_sock); 
    } 
#else{print $new_sock "HTTP OK $buf\r\n";} 
}#while <> 
 
exit(0); 
    }#pid 
    }#while sock 
close($main_sock);

次ページ