home *** CD-ROM | disk | FTP | other *** search
/ Borland Programmer's Resource / Borland_Programmers_Resource_CD_1995.iso / ntcode / ntperlb / eg / sock.cmd < prev    next >
Encoding:
Text File  |  1995-05-19  |  2.1 KB  |  98 lines
  1. @rem = '-*- Perl -*-';
  2. @rem = '
  3. @echo off
  4. perl %0.cmd %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. ';
  7. #
  8. # routine to connect to the echo service on a workstation
  9. # (main use is to test socket code)
  10. #
  11. # Note: The echo service is not normally enabled on Intergraph 
  12. #       workstations. you must edit /etc/inetd.conf and restart 
  13. #       inetd to enable it.
  14. #
  15.  
  16. die "usage: sock <host>\n" if scalar(@ARGV) == 0;
  17.  
  18. $serverhost = shift;
  19.  
  20. sub sock_close {
  21.     close S;
  22.     die "Socket closed due to SIGINT\n";
  23. }
  24.  
  25. $SIG{'INT'} = 'sock_close';
  26.  
  27. $service = 'echo';
  28.  
  29. $AF_INET = 2;
  30. $SOCK_STREAM = 1;
  31. $IPPROTO_TCP = 6;
  32.  
  33. $sockaddr = 'S n a4 x8';
  34. ($name, $aliases, $proto) = getprotobyname('tcp');
  35. #print "tcp protocol number is $proto\n";
  36.  
  37. ($name, $aliases, $port, $foo) = getservbyname($service, 'tcp');
  38. #print "$service port number is $port\n";
  39.  
  40.  
  41. ($name, $aliases, $adrtype, $length, @serveraddr) = 
  42.     gethostbyname($serverhost);
  43.  
  44. die "unable to get host address for $serverhost"
  45.     if ($length == 0);
  46.  
  47. ($a, $b, $c, $d) = unpack('C4', $serveraddr[0]);
  48.  
  49. #print "address for $serverhost is $a.$b.$c.$d\n";
  50.  
  51. unless (socket(S, $AF_INET, $SOCK_STREAM, $proto)) {
  52.     ($!) = ($!, close(S));
  53.     die "socket failed: $!";
  54. }
  55.  
  56. $serverproc = pack($sockaddr, $AF_INET, $port, $serveraddr[0]);
  57.  
  58. unless (connect(S, $serverproc)) {
  59.     ($!) = ($!, close(S)); # close S while saving $!
  60.     die "connect failed: $!\n";
  61. }
  62.  
  63. print "connected to echo service on $serverhost\n";
  64. print "type control-c to stop program\n";
  65.  
  66. while(1) {
  67.     print "Input a line: ";
  68.     $line = &gets;
  69.     last if $line eq "quit\n";
  70.     if (send (S, $line, 0) == undef) {
  71.     ($!) = ($!, close(S)); # close S while saving $!
  72.     close S;
  73.     die "send failed: $!\n";
  74.     }
  75.     recv(S, $buffer, 200, 0);
  76.     print "Received: $buffer";
  77. }
  78.  
  79. print "Shutting down connection to $serverhost\n";
  80. shutdown (S, 2);
  81. close S;
  82.  
  83.  
  84.  
  85. sub gets {
  86.     local($s) = "";
  87.     local($c);
  88.  
  89.     while(read(STDIN, $c, 1) == 1) {
  90.     last if ($c eq "\n");
  91.     $s .= $c;
  92.     }
  93.     "$s\n";
  94. }
  95.         
  96. __END__
  97. :endofperl
  98.