Greska u knjizi "Perl 5 Unleashed"

[VRider]

U knjizi Perl 5 Unleashed, poglavlje 12, postoji jednostavan primer klijent-server aplikacije. Sve funkcionise po prvi put. Kada, medjutim, nakon zavrsetka rada servera i klijenta, pokusam da ih startujem po drugi put, izbacuje gresku "can't bindaddres is used" (izgleda da se port pre gasenja servera ne oslobodi). Kada koristim AF_UNIX, u folderu gde se nalazi server se pojavljuje fajl imena "=^Z^a" i dok taj fajl postoji ne mogu ponovo da pokrenem server. Nakon sto sam na pocetku koda servera dodao "rm -f ??" server je poceo da radi normalno svaki put (ali to je ipak samo snalazenje). Kada koristim AF_INET zasada nemam resenje.
Moze li mi iko pomoci?
Hvala unapred

[code:1:3f1968bbc6]
#!/usr/bin/perl -w
 #
 #
 $AF_UNIX = 1;
 $AF_INET=2; # Use AF_INET instead of AF_UNIX.
 $SOCK_STR = 1;# Use STREAMS.
 $PROTOCOL = 0;# stick to the default protocols (IP).

 $port = 6668 unless $port;

 #
 # The pattern for packing into a sockaddr structure
 #
 $PACKIT='S n C4 x8';

 #
 # Disable any buffering on any newly created sockets.
 #
 select(NEWSOCKET);
 $| = 1;
 select(stdout);

 #
 # Create the socket.
 #
 socket(MY_SOCKET, $AF_INET, $SOCK_STR, $PROTOCOL) || die "n $0 Cannot open socket $!";
 print "Socket successfully openedn";

 #
 # Get the host address for this node
 #

 ($name, $aliases, $addrtype, $len, @addrs) = gethostbyname("localhost");
 ($a,$b,$c,$d) = unpack('C4',$addrs[0]);
 print "Server Name=$name, Server Address= $a.$b.$c.$dn";
 $my_ip_addr = pack($PACKIT,$AF_INET,$port,$addrs[0]);

 #
 # If you just want to test with the localhost, try this line
 # instead of the above.
 # $my_ip_addr = pack($PACKIT,$AF_INET,$port,127,0,0,1);

 #
 # Bind to the socket and listen on this port
 #
 bind(MY_SOCKET, $my_ip_addr) || die "$0 Cannot bind .. $!n";
 print "n Bound to socket";
 listen(MY_SOCKET,5) || die "$0 Cannot listen $!n";
 print "n Listening n";

while(1) {
$remote = accept(NEWSOCKET, MY_SOCKET) || die "$0 Unacceptable $!n";

@remoteInfo = unpack($PACKIT,$remote);
$, = ' ';
print @remoteInfo; print "n";

# $pid = fork || &cleanup;
 if ($pid == fork){# child
 sleep 3;
 print NEWSOCKET "Welcome to this servern";
 close NEWSOCKET;
 close MY_SOCKET;
 exit;
}

else {# parent
 sleep 10;
 close MY_SOCKET;
 close NEWSOCKET;# in parent
 exit;
}
}

sub cleanup {
close NEWSOCKET;
close(MY_SOCKET) || die "$0 Cannot fork  $!n";
}


/////////////////////////////////////////////////
#klijent
#!/usr/bin/perl
 #
 # define constants for talking to server
 #
 $PACKIT = 'S n C4 x8';
 $AF_INET = 2;
 $SOCK_STR = 1; # STREAMS
 $DEF_PROTO = 0;#default protocol of IP
 $port = 6668 unless $port;

 #
 # Get the name of the server
 #
 ($name, $aliases, $addrtype, $len, @addrs) = gethostbyname("localhost");
 ($a,$b,$c,$d) = unpack('C4',$addrs[0]);
 print "Server Name=$name, Server Address= $a.$b.$c.$dn";
 $that = pack($PACKIT,$AF_INET,$port,$addrs[0]);

 #
 # Confine yourself to the local host machine address of 127.0.0.1
 #
 $this = pack($PACKIT,$AF_INET,$port,127,0,0,1);

 #
 # Disable buffering on this socket.
 #
 select(CLIENT_SOCKET);
 $| = 1;
 select(stdout);


 socket(CLIENT_SOCKET,$AF_INET,$SOCK_STR,$DEF_PROTO) || die "$0 Cannot open socketn";
 print "Created socketn";

 #
 # Attempt to connect to server.
 #
do
{
sleep(1);
$result = connect(CLIENT_SOCKET,$that);
if (result != 1) {
print "Sleepingn";
}

 } while ($result != 1);

 sleep(5);
 print "After connectionn";

 #
 # send data to server
 #
 #write(CLIENT_SOCKET,"hello",5);

 read(CLIENT_SOCKET,$buf,100);
 chop ($buf);
 print "[" . $buf . "]n";
 close(CLIENT_SOCKET);[/code:1:3f1968bbc6]

[mire]

Koristis staru knjigu i stare primere, klijent server programi se vise tako ne pisu. Najbolje je da koristio IO::Socket ili cak xinetd (ako bash moras inetd) za server programe.

Ono sto si poslao izgleda da si editovao.

Koliko vidim prvi treba da dobije konekciju, forkuje child koji ce da nesto ispise klijentu i prekine vezu a on sam da nastavi i dalje da prima konekcije(while petlja).
Medjutim u tvom primeru i parent i child izlaze (exit) nakon prve konekcije? Samo child treba da ode kad zavrsi svoj posao, parent treba da ti ostane u while loop-u da bi mogao da dalje izvrsava zahteve. Ne znam zbog cega ce ti sleep za parent ?
[code:1:3dcc6f6785]
while(1) {
$remote = accept(NEWSOCKET, MY_SOCKET) || die "$0 Unacceptable $!n";
@remoteInfo = unpack($PACKIT,$remote);
$, = ' ';
print @remoteInfo; print "n";
# $pid = fork || &cleanup;
if ($pid == fork){# child
sleep 3;
print NEWSOCKET "Welcome to this servern";
close NEWSOCKET;
close MY_SOCKET;
exit;
}
else {# parent
sleep 10;
close MY_SOCKET;
close NEWSOCKET;# in parent
exit;
}
}
[/code:1:3dcc6f6785]
Komentari ti ne valjaju, ako dobijes $pid od forka to ti je master u suprotnom dobijas nulu i pitas da li je definisan $pid ako jeste to je child u suprotnom fork je bio neuspesan (ozbiljna greska koja se na srecu ne desava cesto). Dakle obrni komentare kako ti sada stoje.

Evo ti primer jednog fork daemona koji sam uradio za www.modperldev.com
[code:1:3dcc6f6785]
    if ($pid = fork) {
        # parent, child pid is in $pid
        # carp "parent $$";
        close STDOUT;
        close STDIN;
        close STDERR;
    } elsif (defined $pid) { # $pid is defined and zero here
        # child, parent is in getppid
        # carp "child $$";
        $SIG{INT} = "IGNORE";
        open STDIN, "</dev/null";
        open STDOUT,">/dev/null";
        open STDERR,">/dev/null";
        exec $line;
    } else {
        carp "Can not fork: $!n";
    }
[/code:1:3dcc6f6785]

Takodje treba da napravis reaper f-ju koja ce da pokupi mrtvu decu (da ih ceka sa wait) da ne bi imao zombie procese.

Npr.
[code:1:3dcc6f6785]
$SIG{CHLD} = &REAPER;

sub REAPER {
    my $stiff;
    while (($stiff = waitpid(-1, &WNOHANG)) > 0) {
    }
    $SIG{CHLD} = &REAPER;
}
[/code:1:3dcc6f6785]
Za ovo ti treba POSIX modul a za one ispise Carp
[code:1:3dcc6f6785]
use POSIX ":sys_wait_h";
use Carp;
[/code:1:3dcc6f6785]