scripts/perl/examples/telnet.pl

   1 #!/usr/bin/perl
   2 #
   3 # Written by Curtis L. Olson, started December 2002
   4 # Some code portions courtesy of Melchior FRANZ
   5 #
   6 # This file is in the Public Domain and comes with no warranty.
   7 #
   8 # $Id$
   9 # ----------------------------------------------------------------------------
  10
  11
  12 use IO::Socket;
  13
  14 use strict;
  15
  16
  17 sub my_not() {
  18     my( $val ) = shift;
  19
  20     if ( $val eq "true" ) {
  21         return 0;
  22     } elsif ( $val eq "false" ) {
  23         return 1;
  24     } elsif ( $val eq "" ) {
  25         return 1;
  26     } else {
  27         return 0;
  28     }
  29 }
  30
  31
  32 sub get_prop() {
  33     my( $handle ) = shift;
  34
  35     &send( $handle, "get " . shift );
  36     eof $handle and die "\nconnection closed by host";
  37     $_ = <$handle>;
  38     s/\015?\012$//;
  39     /^-ERR (.*)/ and die "\nfgfs error: $1\n";
  40
  41     return $_;
  42 }
  43
  44
  45 sub set_prop() {
  46     my( $handle ) = shift;
  47     my( $prop ) = shift;
  48     my( $value ) = shift;
  49
  50     &send( $handle, "set $prop $value");
  51
  52     # eof $handle and die "\nconnection closed by host";
  53 }
  54
  55
  56 sub send() {
  57     my( $handle ) = shift;
  58
  59     print $handle shift, "\015\012";
  60 }
  61
  62
  63 sub connect() {
  64     my( $host ) = shift;
  65     my( $port ) = shift;
  66     my( $timeout ) = (shift || 120);
  67     my( $socket );
  68     STDOUT->autoflush(1);
  69     while ($timeout--) {
  70         if ($socket = IO::Socket::INET->new( Proto => 'tcp',
  71                                              PeerAddr => $host,
  72                                              PeerPort => $port) )
  73         {
  74             $socket->autoflush(1);
  75             return $socket;
  76         }
  77         print "Attempting to connect to $host ... " . $timeout . "\n";
  78         sleep(1);
  79     }
  80     return 0;
  81 }
  82
  83
  84 return 1;                    # make perl happy