Path: usenet.cis.ufl.edu!usenet.eel.ufl.edu!spool.mu.edu!howland.reston.ans.net!news.sprintlink.net!psgrain!nntp.teleport.com!usenet
From: [email protected] (Eric Arnold)
Newsgroups: comp.lang.perl.announce,comp.lang.perl.misc,comp.lang.perl
Subject: ANNOUNCE:  "comm_utils.pl" -- perl4/5 easy client/server IPC
Date: 11 Jun 1995 17:51:34 GMT
Organization: Sun Microsystems
Lines: 727
Approved: [email protected] (comp.lang.perl.announce)
Message-ID: <[email protected]>
NNTP-Posting-Host: linda.teleport.com
Xref: usenet.cis.ufl.edu comp.lang.perl.announce:29 comp.lang.perl.misc:562 comp.lang.perl:51868


This is the perl4/5 client/server package that I try to keep updated
for myself.  I just included it in the posting of my "shelltalk"
program, but it's useful in its own right.

-Eric


#                         "comm_utils.pl"
#
# This is a library of IPC goodies.  There is no warrenty, but I'd
# be happy to get ideas for improvements.
#
#               - [email protected]
#
# It's been tested with Perl4/Perl5 and SunOS4.x and Solaris2.3 - 2.5.
# It's normally put into a file and "require"'d, but can also be simply
# concatinated to the end of some other perl script.
#
# A lot was borrowed from "chat2.pl", and then diverged as its goals became
# generalized client/server IPC, support for SVR4/Solaris, and to facilitate
# my "shelltalk" program.
#
# Function summary:
#
#   &init();
#
#   $handle = &comm'open_port($host, $port, $timeout);
#   $handle = &comm'open_listen( $port );
#   ( $Proc_handle, $Proc_tty_handle, $Proc_pid ) = &comm'open_proc($Shell_cmd);
#
#   ( $new_handle, $rem_host ) = &comm'accept_it( $handle );
#   @ready_handles = &comm'select_it( $timeout, $handle1, $handle2, ..... );
#
#   $string = &comm'gets( $handle );
#   &comm'sysread( $handle, $buf, $num_bytes );
#   &comm'print( $handle, $buf );
#   &comm'system( $Proc_tty_handle, $command );
#
#   &comm'close_noshutdown( $handle );
#   &comm'close( $handle )
#
#   &comm'ioctl( $Proc_tty_handle, $ioctl_command, $var );
#   &comm'stty_sane( $handle );
#   &comm'stty_raw( $handle );
#   &comm'get_ioctl_from_stty( $stty_cmd );
#   &comm'dump_ioctl( $stty_cmd );
#
#
# See the end for example programs demonstrating usage.
#
# Bugs:
#   - SOCK_STREAM (see comm_utils.pl) is different for SVR4/Solaris,
#     but if you use a perl compiled under SunOS, then the old value is
#     needed.  How do I tell whether I'm running a SunOS4.x perl or Solaris2?
#     I finally gave up and it first tries 1 for SOCK_STREAM, and if that
#     fails, then it tries 2.
#
# 09/11/94 07:03:04 PM;  eric:  fixed for Solaris and /dev/tty
# 09/14/94 02:11:19 AM;  eric:  close correct file handle in open_listen
# 09/15/94 03:33:31 AM;  eric:  added sock'system
# 09/19/94 10:48:11 AM;  eric:  added cheapo/easy ioctl dump/do
# 10/11/94 11:07:14 AM;  eric:  added I_POP to clear stream on pty
# 11/08/94 03:03:19 PM;  eric:  changed to first try SOCK_STREAM=1, then =2
# 02/28/95 12:53:22 PM;  eric:  found the right place to set SO_LINGER!
# 03/18/95 08:19:46 PM;  eric:  added timeout arg to open_port
# 05/07/95 10:56:25 PM;  eric:  fixed shutdown/close order bug in close()
#                               added close_noshutdown
# 06/08/95 01:06:03 PM;  eric:  fixed Sol2.4 problem with string literal
#                               as last arg to syscall($SYS_ioctl

package comm;

&init;

sub init{
 *Debug = *main'Debug;

 if ( -f "/vmunix" )
 {
   $OS_type = "BSD";
   $SOCK_STREAM=1;
 }
 else
 {
   $OS_type = "SVR4";
   if ( $] >= 5 ){
     $SOCK_STREAM=1;
   }else{
     $SOCK_STREAM=2;}
 }

 print STDERR "OS_type=$OS_type\n" if $Debug;

 chop( $thishost = `uname -n ` );

 $next_handle="stuff000000";
 $sockaddr = 'S n a4 x8';

 $thisaddr = (gethostbyname($thishost))[4];
 $thisproc = pack($sockaddr, 2, 0, $thisaddr);

 $SYS_ioctl = 54;

 if ( $OS_type eq "SVR4" ){
   # These must be syscalls because Perl's ioctl doesn't know about I_PUSH
   #syscall($SYS_ioctl, fileno($_TTY), $I_PUSH, "ptem" );
   #syscall($SYS_ioctl, fileno($_TTY), $I_PUSH, "ldterm");

   # from /usr/include/sys/termios.h
   $tIOC       =( unpack("C", 't') << 8);
   $TIOCGETP       =($tIOC|8);
   $TIOCSETP       =($tIOC|9);

   $TIOC       =( unpack("C", 'T' ) <<8);
   $TCGETS         =($TIOC|13);
   $TCSETS         =($TIOC|14);
   $TCSANOW        =(( unpack("C",'T')<<8)|14); #/* same as TCSETS */
   $TCGETA     =($TIOC|1);
   $TCSETA     =($TIOC|2);

   # From /usr/include/sys/stropts.h
   $STR =             ( unpack("C", "S") <<8 );
   $I_PUSH =          ($STR|02);       #$I_PUSH = 21250;
   $I_POP =           ($STR|03);
   $I_LOOK =          ($STR|04);
   #define I_FLUSH         (STR|05)

 }else{
   $TIOCGETP=0x40067408;       #d(1074164744)
   $TIOCSETP=0x80067409;       #d(-2147060727)
 }

 $SOL_SOCKET      =0xffff          ;#/* options for socket level */
 $SO_DEBUG        =0x0001          ;#* turn on debugging info recording */
 $SO_ACCEPTCONN   =0x0002          ;#* socket has had listen() */
 $SO_REUSEADDR    =0x0004          ;#* allow local address reuse */
 $SO_KEEPALIVE    =0x0008          ;#* keep connections alive */
 $SO_DONTROUTE    =0x0010          ;#* just use interface addresses */
 $SO_BROADCAST    =0x0020          ;#* permit sending of broadcast msgs */
 $SO_USELOOPBACK  =0x0040          ;#* bypass hardware when possible */
 $SO_LINGER       =0x0080          ;#* linger on close if data present */
 $SO_OOBINLINE    =0x0100          ;#* leave received OOB data in line */


}


sub open_port{

 local( $server, $port, $timeout ) = @_;
 local( $new_handle ) = ++$next_handle;
 local( %saveSIG, $ret );

 if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
         $serveraddr = pack('C4', $1, $2, $3, $4);
 } else {
         local(@x) = gethostbyname($server);
         return undef unless @x;
         $serveraddr = $x[4];
         printf( "server=$server,serveraddr=%x\n", $serveraddr) if $Debug;
 }

 $serverproc = pack($sockaddr, 2, $port, $serveraddr);
 print STDERR "\$serverproc = pack($sockaddr, 2, $port, ",
   join(".", unpack("C*", $serveraddr)), ");\n" if $Debug;

 unless (socket( $new_handle, 2, 1, 6)) {
   unless (socket( $new_handle, 2, 2, 6)) {
         # XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp'
         # but who the heck would change these anyway? (:-)
         ($!) = ($!, close( $new_handle)); # close new_handle while saving $!
         #die "socket failed";
         print STDERR "Socket error $!\n" if $Debug;
         return undef;
   }
 }
 unless (bind( $new_handle, $thisproc)) {
         ($!) = ($!, close( $new_handle)); # close new_handle while saving $!
         #die "bind failed";
         print STDERR "bind error $!\n" if $Debug;
         return undef;
 }

 %saveSIG=%SIG;
 if ( $timeout )
 {
   $SIG{ALRM} = "timedout";
   alarm($timeout);
 }
 eval { $ret = connect( $new_handle, $serverproc) };

 if ( !$ret || ($@ =~ /^timedout/) ) {
         ($!) = ($!, close( $new_handle)); # close new_handle while saving $!
         #die "connect failed, $!";
         print STDERR "connect error eval=($@)$!\n" if $Debug;
         if ( $@ =~ /^timedout/ ) {
           $! .= ", timeout after $timeout seconds";}
         return undef;
 }

 if ( $timeout )
 {
   %SIG = %saveSIG;
   alarm(0);
 }

 select((select( $new_handle), $| = 1)[0]);

 return $new_handle;
}


sub timedout {
 die "timedout";
}



sub open_listen{
 local( $port ) = @_;

 ( $thisproc_local ) = pack( $sockaddr, 2, $port, $thisaddr );
 #print "( $thisproc_local ) = pack( $sockaddr, 2, $port, $thisaddr );\n";

 $new_handle = ++$next_handle;

 unless (socket( $new_handle, 2, 1, 6)) {
   unless (socket( $new_handle, 2, 2, 6)) {
         # XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp'
         # but who the heck would change these anyway? ( :- )
         #die "socket failed: $!";
         print STDERR "socket failed: $!\n" if $Debug;
         ($!) = ($!, close($new_handle)); # close S while saving $!
         return undef;
   }
 }


 # We want it it release the socket for immediate reuse if the server is
 # shutdown/restarted.  It seems that SO_LINGER and SO_REUSEADDR are most
 # pertinant, but SO_KEEPALIVE seems like it might be nice too, for
 # notification of peer disappearance.
 $linger = pack("II", 0, 0 );  # linger is a C struct in socket.h
 setsockopt( $new_handle, $SOL_SOCKET, $SO_LINGER, $linger);
 setsockopt( $new_handle, $SOL_SOCKET, $SO_KEEPALIVE, 1);
 setsockopt( $new_handle, $SOL_SOCKET, $SO_REUSEADDR, 1);

 unless ( bind( $new_handle, $thisproc_local )) {
         #die "bind failed: $!";
         print STDERR "bind failed: $!\n" if $Debug;
         ($!) = ($!, close($new_handle)); # close S while saving $!
         return undef;
 }
 unless ( listen( $new_handle, 1 )) {
         #die "listen failed: $!";
         print STDERR  "listen failed: $!\n" if $Debug;
         ($!) = ($!, close($new_handle)); # close S while saving $!
         return undef;
 }

 select( (select( $new_handle ), $| = 1 )[0] );
 local( $family, $port, @myaddr ) = unpack( "S n C C C C x8",
               getsockname( $new_handle ));

 #print " local( family, port, myaddr ) = local( $family, $port, @myaddr) \n";
 return  $new_handle;
}



sub accept_it{ local( $handle ) = @_; local( $addr, $af, $port,
 $inetaddr, $acceptaddr ) = ();

 $new_handle = ++$next_handle;

 unless( ( $addr = accept( $new_handle, $handle ) ) ) {
         print STDERR "accept failed: $!";
 }

 ( $af, $port, $inetaddr ) = unpack( $sockaddr, $addr );
 @inetaddr = unpack( 'C4', $inetaddr );
 #print "accept: $af $port @inetaddr(", join('.', @inetaddr), ")\n";

 #print "host=", gethostbyaddr( join('.', @inetaddr), 2 ), "\n";
 #print "host=", gethostbyaddr( join(' ', @inetaddr), 2 ), "\n";
 ($name, $aliases, $type, $len, $acceptaddr) =
       gethostbyaddr( pack( 'C4', @inetaddr ), 2 );
 #print "accept: host=$name, port=$port\n";

 select( ( select( $new_handle ), $| = 1 )[0] );

 $name = join(".", @inetaddr ) unless $name;
 return $new_handle,$name;
}




sub select_it {
 local( $timeout, @handles ) = @_;

 local( @ready ) = ( );
 local( $rout, $rmask, $handle, $eout, $emask );

 for $handle ( @handles ) {
   vec( $rmask, fileno( $handle ), 1 ) = 1;
   vec( $emask, fileno( $handle ), 1 ) = 1;
 }
 ( $nfound, $timeleft ) = select( $rout=$rmask, undef, $eout=$emask, $timeout );

 print "nfound=$nfound\n" if $DEBUG;
 if ( $nfound < 1 ){
   if ( $nfound < 0 ){
     print "error=$!\n" if $DEBUG; }
   return @ready;
 }

 # You could also do:
 #   @bit = split(//,unpack('b*',$rout));
 #   if ($bit[fileno(STDIN)] == 1){ ... };

 for $handle ( @handles ) {
   if ( vec( $rout, fileno( $handle ), 1 ) == 1 ) {
     print "fh=$handle is ready\n" if $DEBUG;
     push( @ready, $handle ); }
   if ( vec( $eout, fileno( $handle ), 1 ) == 1 ) {
     print "Exception on read_handle=$handle\n" if $DEBUG; }
 }

 return @ready;
}

1;

## $handle = &chat'open_proc("command","arg1","arg2",...);
## opens a /bin/sh on a pseudo-tty

sub open_proc { ## public
       local(@cmd) = @_;

       #local(*TTY,*PTY);      # PTY must not die when sub returns
       local( $pty_handle, $tty_handle );

       $pty_handle = "proc" . ++$next_handle;
       *PTY = $pty_handle;
       $tty_handle = "proc" . ++$next_handle;
       *TTY = $tty_handle;

       local($pty,$tty) = &_getpty(PTY,TTY);

       die "Cannot find a new pty" unless defined $pty;
       local($pid) = fork;
       die "Cannot fork: $!" unless defined $pid;
       unless ($pid) {
               close STDIN; close STDOUT; close STDERR;
               if ( $OS_type eq "SVR4" ){
                 syscall(39,3); #* setsid():: syscall(39,3)
               }else{
                 #syscall(175);#setsid , doesn't seem to work well
                 setpgrp(0,$$);
                 # this ioctl is necessary for "isig" to work right,
                 # and otherwise "csh" freaks out and hangs:
                 if (open(DEVTTY, "/dev/tty")) {
                     ioctl(DEVTTY,0x20007471,0);       # XXX s/b &TIOCNOTTY
                     close DEVTTY;
                 }
               }
               open(STDIN,"<$tty");
               #open(STDIN,"<&TTY");   # fails to assign controlling tty!
               if ( $OS_type eq "BSD" ){
                 # doesn't seem to be necessary if open by filename
                 #TIOCSCTTY,d(536900740)0x(20007484)
                 #syscall(54, fileno(STDIN), 0x20007484,  1 );
               }

               open(STDOUT,">$tty");
               open(STDERR,">&STDOUT");
               die "Oops" unless fileno(STDERR) == 2;  # sanity
               close(PTY) || print "error closing master handle:$!\n";

               exec @cmd;
               die "Cannot exec @cmd: $!";
       }
       #close(TTY);
       return ($pty_handle,$tty_handle,$pid); # return symbol for switcharound

}



sub _getpty { ## private
       local($_PTY,$_TTY)=@_;
       local($pty,$tty);
       $_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
       $_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
       for $bank (112..127) {
               next unless -e sprintf("/dev/pty%c0", $bank);
               for $unit (48..57) {
                       $pty = sprintf("/dev/pty%c%c", $bank, $unit);
                       open($_PTY,"+>$pty") || next;
                       select((select($_PTY), $| = 1)[0]);
                       ($tty = $pty) =~ s/pty/tty/;
                       # some stupid magic says I can't use a variable
                       # name in the open for a TTY open
                       open($_TTY,"+>$tty") || next;
                       select((select($_TTY), $| = 1)[0]);
                       if ( $OS_type eq "SVR4" )
                       {
                         local( $pop ) = pack( "p", $pop );
                         syscall($SYS_ioctl, fileno($_TTY), $I_POP, 0 );
                         syscall($SYS_ioctl, fileno($_TTY), $I_POP, 0 );
                         #syscall($SYS_ioctl, fileno($_TTY), $I_LOOK, $pop );
                         #print "looked: len=", length($pop),"($pop)\n";
                         #$pop = pack( "p", $pop );
                         #syscall($SYS_ioctl, fileno($_TTY), $I_LOOK, $pop );
                         #print "looked: len=", length($pop),"($pop)\n";

                         local($tmp);
                         # $tmp needed because Solaris2.4,2.5 complains:
                         # Modification of a read-only value attempted at
                         # comm_utils.pl line  ...
                         # if you use a string literal instead
                         syscall($SYS_ioctl, fileno($_TTY), $I_PUSH, $tmp="ptem" );
                         syscall($SYS_ioctl, fileno($_TTY), $I_PUSH, $tmp="ldterm");
                       }
                       system "stty nl>$tty <$tty";
                       return ($pty,$tty);
               }
       }
       undef;
}


sub gets{
 local(*FH)=shift;
 scalar(<FH>);
}

sub sysread{
 local(*FH)=shift;
 sysread(FH, $_[0], $_[1]);
}

sub ioctl{
 local($fh)=shift;
 syscall( 54, fileno($fh), @_ ) == 0;
}

sub print{
 local($fh)=shift;
 local($ret)= print $fh @_;
 unless ( $ret ){
   print STDERR "Error printing to fh($fh),$!\n"; }
 return $ret;
}


# This is useful when there a parent and child share the file descriptor,
# because the shutdown affects both.
sub close_noshutdown{
 for (@_){
   next unless $_;
   close( $_ );
 }
}

sub close{
 for (@_){
   next unless $_;
   unless ( /^proc/ ){
     print STDERR "Doing shutdown on $_\n" if $DEBUG;
     shutdown($_,2) ;  # must happen before close
   }
   #print "comm'close: $_\n";
   #local( *fh ) = $_; # some god-aweful magic
   #close( $fh );      # some god-aweful magic
   close( $_ );
 }
}


# This is so you can run commands in the pty process without routing
# through the shell, which is ugly

sub system{
 local( $handle, @args ) = @_;
 unless ( fork() ){
   close(STDIN);close(STDOUT);
   open(STDIN,"<&$handle" );
   open(STDOUT,">&$handle" );
   exec ( @args );
   exit;
 }
}



sub stty_sane{
 local( $handle ) = @_;
 local( $packed ) = ();
 #&dump_ioctl( "stty sane erase '^H' " );
 if ( $OS_type eq "SVR4" ){
   $packed = pack("C*", 37,38,0,5,5,173,138,59,0,3,28,8,21,4 );
   ioctl( $handle, $TCSETA, $packed);
 }else{
   $packed = pack("C*", 15,15,8,21,0,216 );
   #$packed = &get_ioctl_from_stty( "stty sane erase '^H' " );
   ioctl( $handle, $TIOCSETP, $packed);
 }
}

sub stty_raw{
 local( $handle ) = @_;
 local( $packed ) = ();
 #&dump_ioctl( "stty raw -echo -icanon eol '^a'" );
 if ( $OS_type eq "SVR4" ){
   $packed = pack("C*", 0,0,0,4,4,189,138,48,0,3,28,8,21,1,1,0,0,22 );
   ioctl( $handle, $TCSETA, $packed);
 }else{
   $packed = pack("C*", 15,15,8,21,0,240 );
   #$packed = &get_ioctl_from_stty( "stty raw -echo -icanon eol '^a'" );
   ioctl( $handle, $TIOCSETP, $packed);
 }
}


sub get_ioctl_from_stty{
 local( $stty_cmd ) = @_;
 local( $ioctl_struct, $get_cmd, $set_cmd, $out, $ret ) = ();

 #print $stty_cmd,"\n";
 system $stty_cmd;

 # These only return 4 bytes.  Why?
 # $p = pack("p", $ioctl_struct );
 #$ret = syscall($SYS_ioctl, fileno(STDIN), $TIOCGETP, $p);
 #$ret = syscall($SYS_ioctl, fileno(STDIN), $TCGETA, $p);

 if ( $OS_type eq "SVR4" ){
   $get_cmd = $TCGETA;
 }else{
   $get_cmd = $TIOCGETP;
 }

 $!=0;
 $ret = ioctl(STDIN, $get_cmd, $ioctl_struct );

 return $ioctl_struct;
 #return ( $ioctl_struct, $ret );      # blows up $ioctl_struct on the stack
}


sub dump_ioctl{
 local( $stty_cmd ) = @_;
 local( $ioctl_struct, $c, $out ) = ();

 $ioctl_struct = &get_ioctl_from_stty( $stty_cmd );
 for $c ( unpack("C*", $ioctl_struct) ){
   #$out .= sprintf("0x%2.2x,", $c );
   $out .= sprintf("%d,", $c );
 }
 print "$stty_cmd = $out \n";
 # I don't know off hand how much of the returned buffer is actually
 # significant; certainly less than the full 256 bytes.
 return $ioctl_struct;
}


1;

__END__

#--------------------------------Example server---------------------------------
#
# Allows multiple client connections, and rebroadcasts data between them.

eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
& eval 'exec perl -S $0 $argv:q'
if 0;

require "comm_utils.pl" unless defined &comm'init;

$Listen_port = 5050;
$Listen_port = $ARGV[0] if $ARGV[0];

$SIG{'HUP'} = "my_exit";
$SIG{'INT'} = "my_exit";
$SIG{'QUIT'} = "my_exit";

$DEBUG = 1;
$|=1;

&comm'init;

if(1)
{
 $Listen_handle = &comm'open_listen( $Listen_port );
 die "open_listen failed on port $Listen_port" unless $Listen_handle;
}
else
{
 # This is optional; it can be useful to use a range of ports
 # if your sockets don't always release a port right away when you kill
 # a process.  However, the "setsockopt()" calls should release the ports
 # for you, so this should no longer be necessary.
 $start_port = $Listen_port;
 {
   if ( ! ( $Listen_handle = &comm'open_listen( $Listen_port ) ) )
   {
     redo unless ( ++$Listen_port <= $start_port + 10 );
     die "open_listen failed on port $Listen_port";
   }
 }
}

print "Listening on port $Listen_port\n" if $DEBUG;

while (1)
{
 @ready_handles = &comm'select_it(1, keys(%Client_handles), $Listen_handle );
 print "Handles ready: @ready_handles\n" if $DEBUG && @ready_handles;

 foreach $handle (@ready_handles)
 {
   if ($handle eq $Listen_handle)
   {
     ($new_handle, $rem_host) = &comm'accept_it($handle);
     $Client_handles{$new_handle} = $rem_host;
     print "New connection from $rem_host\n" if $DEBUG;
   }
   else
   {
     #print &comm'gets($handle);       # if new-line oriented
     if ( &comm'sysread($handle, $buf, 10000) )
     {
       $buf = $Client_handles{$handle} . ": $buf";
       $buf =~ s/[\n]*$/\n/;
       print $buf;
       # rebroadcast data to all clients:
       for $client_handle ( keys %Client_handles ) {
         &comm'print( $client_handle, $buf ); }
     }
     else
     {
       print "Closing handle $handle, host $rem_host\n";
       &comm'close( $handle );
       delete $Client_handles{ $handle };
     }
   }
 }
}


sub my_exit
{
 &comm'close( $Listen_handle );
 print "Closing listen port\n" if $DEBUG;
 exit;
}





#--------------------------------Example client---------------------------------

# Connect to a server, and send STDIN data to it.
# Usage:  tstclient <host> <port>

eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
& eval 'exec perl -S $0 $argv:q'
if 0;

require "comm_utils.pl" unless defined &comm'init;

$Server_port = 5050;
$Server_host = "serverhost.domain";

( $Server_host, $Server_port ) = @ARGV if @ARGV;

$SIG{'HUP'} = "my_exit";
$SIG{'INT'} = "my_exit";
$SIG{'QUIT'} = "my_exit";

$|=1;
$DEBUG = 1;

&comm'init;

if ( ! ( $Server_handle = &comm'open_port($Server_host, $Server_port, 5) ) )
{
 die "open_port failed on host $Server_host, port $Server_port";
}

print "Connected to host $Server_host, port $Server_port\n" if $DEBUG;

while (1)
{
 @ready_handles = &comm'select_it(1, $Server_handle, STDIN);

 foreach $handle (@ready_handles)
 {
   if ($handle eq "STDIN")
   {
     $buf = <STDIN>;
     &comm'print( $Server_handle, $buf );
   }
   else        # server
   {
     unless ( &comm'sysread($handle, $buf, 1000) )
     {
       print "Server connection broken\n";
       &my_exit;
     }
     print $buf;
   }
 }
}


sub my_exit
{
 &comm'close($HANDLE);
 exit;
}

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.