Net::Telnet - Library Application

Discussion in 'Perl Misc' started by Carl Lafferty, Jul 17, 2006.

  1. I have a problem with something I am doing using net::telnet in perl.
    I am trying to write a script that will access an automated library
    system via telnet and basically mimic what the company that sold us the
    system did in VB. I am basically reverse engineering their code only in
    perl.. anyway... My problem is that I am having to search for
    different flags using waitfor. sometimes it is the word Description,
    sometimes it is \x8f (I have no idea why but they seem to use that as a
    delimiter quite often) My problem is that when I get to a particular
    piece of data, I am not getting everything from the stream in my waitfor
    variable.

    This is a snippit of the code

    #cleaning out the buffer
    ($info) = $galaxy->waitfor("/\x8f/");
    print "1 $info\n";

    ($info) = $galaxy->waitfor("/\x8f/");
    print "2 $info\n";


    $galaxy->print("5000 5018 30 0 0 ");

    ($info) = $galaxy->waitfor("/\x8f/");
    $info =~ s/\\b/\n/g;
    $info =~ s/\\B/\<b\>/g;
    $info =~ s/\n/\<\/b\>\n/g;
    print "$info\n";


    ($info) = $galaxy->waitfor("/Description/");
    $info =~ s/\\b/\n/g;
    $info =~ s/\\B/\<b\>/g;
    $info =~ s/\n/\<\/b\>\n/g;
    print "$info\n";

    #got stuff up to description now
    ($info) = $galaxy->waitfor("/\x5C\x62/");
    $info =~ s/\\b/\n/g;
    $info =~ s/\\B/\<b\>/g;
    $info =~ s/\n/\<\/b\>\n/g;
    print "Description: $info\n";


    print "\nLogging out of galaxy\n";
    #$ok = $galaxy->waitfor("/\x8f/");
    $ok = $galaxy->print("999");
    $ok = $galaxy->print("0005 GALAXY||20");
    $ok = $galaxy->print("0010 ");

    $galaxy->close;
    -----------------------------------
    0x000e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
    0x000f0: 20 5c 62 20 20 54 79 70 65 2f 6c 61 6e 67 75 61 \b
    Type/langua
    0x00100: 67 65 3a 20 5c 42 42 6f 6f 6b 2f 65 6e 67 5c 62 ge:
    \BBook/eng\b
    0x00110: 0d 20 20 20 49 53 42 4e 2f 49 53 53 4e 3a 20 5c .
    ISBN/ISSN: \
    0x00120: 42 2f 5c 62 0d 20 44 65 73 63 72 69 70 74 69 6f B/\b.
    Descriptio
    0x00130: 6e 3a 20 5c 42 31 37 38 20 70 2e 2c 20 32 30 20 n: \B178 p.. 20
    0x00140: 63 6d 2e 20 20 20 20 20 20 20 20 20 5c 62 cm. \b

    0x00000: 39 39 39 0d 999.

    0x00000: 30 30 30 35 20 47 41 4c 41 58 59 7c 7c 32 30 0d 0005
    GALAXY||20.

    0x00000: 30 30 31 30 20 0d 0010 .

    ----------------------------------------------
    above is the dump file (a little difficult to read :( )


    it SEES the word description and gives me the info up to that.. BUT
    after description the delimiter is \b (\x5c\x62) which is what I do a
    waitfor on. all I get is a \

    Everything after 0x00140: is my program signing out of the telnet session..

    Any way to get that information into my variable?? Ive been beating my
    head for 4 days now... any help is appreciated.


    Carl Lafferty
    System Admin
    Floyd County Public Library
    Prestonsburg, KY
    Carl Lafferty, Jul 17, 2006
    #1
    1. Advertising

  2. Carl Lafferty

    Dr.Ruud Guest

    Carl Lafferty schreef:

    > #got stuff up to description now
    > ($info) = $galaxy->waitfor("/\x5C\x62/");


    Because of unexpected interpolation, that could change to "/\b/" to
    match backspace.

    Maybe use a compiled regex:

    ($info) = $galaxy->waitfor(qr/\x5C\x62/);

    Or try:
    ($info) = $galaxy->waitfor('/\\\b/');

    (single or double quotes, 3 or 4 backslashes)

    --
    Affijn, Ruud

    "Gewoon is een tijger."
    Dr.Ruud, Jul 17, 2006
    #2
    1. Advertising

  3. >
    > ($info) = $galaxy->waitfor(qr/\x5C\x62/);
    >
    > Or try:
    > ($info) = $galaxy->waitfor('/\\\b/');
    >

    Couldn't get the top one to work BUT the bottom one worked like a charm!!

    Thank you!!!!!!!
    Carl Lafferty, Jul 17, 2006
    #3
  4. Carl Lafferty

    robic0 Guest

    On Sun, 16 Jul 2006 19:03:43 -0400, Carl Lafferty <> wrote:

    >I have a problem with something I am doing using net::telnet in perl.
    >I am trying to write a script that will access an automated library
    >system via telnet and basically mimic what the company that sold us the
    >system did in VB. I am basically reverse engineering their code only in
    >perl.. anyway... My problem is that I am having to search for
    >different flags using waitfor. sometimes it is the word Description,
    >sometimes it is \x8f (I have no idea why but they seem to use that as a
    >delimiter quite often) My problem is that when I get to a particular
    >piece of data, I am not getting everything from the stream in my waitfor
    >variable.
    >
    >This is a snippit of the code
    >
    >#cleaning out the buffer
    > ($info) = $galaxy->waitfor("/\x8f/");
    > print "1 $info\n";
    >
    > ($info) = $galaxy->waitfor("/\x8f/");
    > print "2 $info\n";
    >
    >
    > $galaxy->print("5000 5018 30 0 0 ");
    >
    > ($info) = $galaxy->waitfor("/\x8f/");
    > $info =~ s/\\b/\n/g;
    > $info =~ s/\\B/\<b\>/g;
    > $info =~ s/\n/\<\/b\>\n/g;
    > print "$info\n";
    >
    >
    > ($info) = $galaxy->waitfor("/Description/");
    > $info =~ s/\\b/\n/g;
    > $info =~ s/\\B/\<b\>/g;
    > $info =~ s/\n/\<\/b\>\n/g;
    > print "$info\n";
    >
    >#got stuff up to description now
    > ($info) = $galaxy->waitfor("/\x5C\x62/");
    > $info =~ s/\\b/\n/g;
    > $info =~ s/\\B/\<b\>/g;
    > $info =~ s/\n/\<\/b\>\n/g;
    > print "Description: $info\n";
    >
    >
    >print "\nLogging out of galaxy\n";
    >#$ok = $galaxy->waitfor("/\x8f/");
    >$ok = $galaxy->print("999");
    >$ok = $galaxy->print("0005 GALAXY||20");
    >$ok = $galaxy->print("0010 ");
    >
    >$galaxy->close;
    >-----------------------------------
    >0x000e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
    >0x000f0: 20 5c 62 20 20 54 79 70 65 2f 6c 61 6e 67 75 61 \b
    >Type/langua
    >0x00100: 67 65 3a 20 5c 42 42 6f 6f 6b 2f 65 6e 67 5c 62 ge:
    >\BBook/eng\b
    >0x00110: 0d 20 20 20 49 53 42 4e 2f 49 53 53 4e 3a 20 5c .
    >ISBN/ISSN: \
    >0x00120: 42 2f 5c 62 0d 20 44 65 73 63 72 69 70 74 69 6f B/\b.
    >Descriptio
    >0x00130: 6e 3a 20 5c 42 31 37 38 20 70 2e 2c 20 32 30 20 n: \B178 p.. 20
    >0x00140: 63 6d 2e 20 20 20 20 20 20 20 20 20 5c 62 cm. \b
    >
    >0x00000: 39 39 39 0d 999.
    >
    >0x00000: 30 30 30 35 20 47 41 4c 41 58 59 7c 7c 32 30 0d 0005
    >GALAXY||20.
    >
    >0x00000: 30 30 31 30 20 0d 0010 .
    >
    >----------------------------------------------
    >above is the dump file (a little difficult to read :( )
    >
    >
    >it SEES the word description and gives me the info up to that.. BUT
    >after description the delimiter is \b (\x5c\x62) which is what I do a
    >waitfor on. all I get is a \
    >
    >Everything after 0x00140: is my program signing out of the telnet session..
    >
    >Any way to get that information into my variable?? Ive been beating my
    >head for 4 days now... any help is appreciated.
    >
    >
    >Carl Lafferty
    >System Admin
    >Floyd County Public Library
    >Prestonsburg, KY



    Net::Telnet is a just an ok module. The fact is that no module can
    correct the inherrant flaws of Telnet in general. For what it does,
    I give the author a thumbs up. He trully has written a awsome piece of code.

    The flaws of Telnet across OS's compounds the problem. The translation of
    newlines (and other control codes) alone in these terminal emulators
    (across OS's) is the death nail. Other nails are there, the big one is
    discovery handshaking and progrmability (mode setting). So implementation
    was the big deathnail to Telnet. That is of course on the level that you
    need to use it at because, there are plenty of smooth running Telnet
    automations out there, be it in C or Perl modules.

    In general, to design a piece of code for the Telnet module, you will have
    to know, to be able to anchor with certainty. This involves alot of work by
    hand ahead of time. Using the module capture "all" in several attempts for
    a statistical overview of your objective.

    What you reliably "waitfor" may not be the EOT (end of transmission).
    And the eot may not be a static thing.

    Whatever your waiting for it doesen't matter. What matters is that you want
    to capture some data, be it binary (not control) or printable. You don't want
    to capture the data of interest directly! You want some assurance that "it"
    can be gleened later on and you want to be immediatly ready to repeat the
    sequence.

    So many folks try to capture that "single" piece of data on the fly, but never
    get framed for it as the boxcars roll down the track (possibly several times).

    In actuality (this is the truth), some Telnet servers don't even send
    a frame down for a single data change. What you have to know is that when the handshaking
    is done what the full outcome of a frame request will be.

    You can force Telnet servers to re-send all the info in the frame however.
    I had written a wrapper module a very long time ago, that covers Win<->win, Nx<->Win.
    You can imbedd binary in the waitfor string (but its not necessary).

    I am posting it here (again) from along time ago. When I wrote this, I only had like
    1 year of Perl and 16 years of C/C++. What is here is stuff that works. I can take no
    cudo's for the code and I am not in the biz of re-writing code (for free).
    So here it is, a pm and pl file that "can" get what you wan't. If you don't use it
    its ok with me. It has worked for me in several Telnet automations within/across platform.

    Any usage questions, let me know.
    Just glanceing at the old examples, read through the lines on the intent, I don't want to
    revisit or modify this crap, even though it works. You will get the jist.

    robic0


    ==================================================
    TlnSvr.pm
    ==================================================
    package TlnSrv;
    use strict;
    #my $console_mode = 1;

    use Net::Telnet ();
    use Cwd;
    my $VERSION = 1.00;

    my $tln = undef;
    $|=1;

    # CONSOLE MODE ????? Info --
    # We need line-mode or stream!!
    # In console mode, the screen is treated
    # as a buffer X by Y where the display is
    # controlloed by ansi escape sequences.
    # This is bad when expecting specific output (prompts)
    # that may never come because those chars are already
    # in screen buffer.
    # Always make the server NON-Console, ie: use stream!!
    # If not, as a workaround, between real commands,
    # we can clear screen, then send return.
    # -------------------------------------------------------
    # Note that all 'Prompts' strings are single quote Regex
    # parameters.

    # Global variables
    sub new ($$$$$)
    {
    my $class = shift;
    my $self = {};
    $self->{'TlnServer'} = shift; # Telnet server address. IP or computer name
    $self->{'TlnUser'} = shift; # User name
    $self->{'TlnUser'} = "administrator" unless (defined $self->{'TlnUser'});
    $self->{'TlnPass'} = shift; # Password
    $self->{'TlnPass'} = "password" unless (defined $self->{'TlnPass'});
    $self->{'LogDir'} = shift;
    $self->{'LogDir'} = cwd() unless (defined $self->{'LogDir'});
    $self->{'Debug'} = 0;
    $self->{'Show_Prematch'} = 'no'; # Show reply up to 'match' (used in SendCommand only)
    $self->{'Port'} = 23;
    $self->{'Prompt'} = '/[\$%#>] $/'; # or '/c:\\\\>/i for dos
    $self->{'Timeout'} = 10;
    $self->{'ClearCmd'} = ''; # Clear screen shell command (or "" if not used)
    $self->{'Waitsecs'} = 10; # (see SendCommand)
    $self->{'Show_Wait'} = 'yes'; # Print line that counts off 'Waitsecs'
    $self->{'Error'} = '';
    bless ($self, $class);
    return $self;
    }

    #######################################
    # SetVal
    #######################################
    sub SetVal
    {
    my ($self, @args) = @_;
    my $val;
    if (@args > 0)
    {
    while (($_, $val) = splice @args, 0, 2) {
    if (/^Debug$/i) {
    $self->{'Debug'} = $val;
    }
    elsif (/^Show_Prematch$/i) {
    $self->{'Show_Prematch'} = $val;
    }
    elsif (/^Port$/i) {
    $self->{'Port'} = $val;
    }
    elsif (/^Prompt$/i) {
    $self->{'Prompt'} = $val;
    }
    elsif (/^Timeout$/i) {
    $self->{'Timeout'} = $val;
    }
    elsif (/^ClearCmd$/i) {
    $self->{'ClearCmd'} = $val;
    }
    elsif (/^Waitsecs$/i) {
    $self->{'Waitsecs'} = $val;
    }
    elsif (/^Show_Wait$/i) {
    $self->{'Show_Wait'} = $val;
    }
    }
    }
    $self->{'Error'} = '';
    return 1;
    }

    #######################################
    # Open telnet session
    #######################################
    sub OpenSession($$)
    {
    my $self = shift;
    my $logging = shift;

    ## default prompt and timeout for this session
    my $timeout = $self->{'Timeout'};
    my $prompt = $self->{'Prompt'};
    my $logging = 1 unless (defined $logging);

    if (defined $tln) {$tln->close;}
    $tln = undef;
    $tln = new Net::Telnet (Timeout => $self->{'Timeout'}, Prompt => $self->{'Prompt'});

    $tln->errmode ('return');
    ## logging is turned off by default
    ## if enabled, a new log is created each time
    if ($logging) {
    $tln->option_log ("$self->{'LogDir'}/option.log");
    $tln->dump_log ("$self->{'LogDir'}/dump.log");
    $tln->input_log ("$self->{'LogDir'}/input.log");
    }
    $tln->buffer_empty;
    $tln->cmd_remove_mode (0);

    if (!$tln->open(Host => $self->{'TlnServer'}, Port => $self->{'Port'})) {
    $self->{'Error'} = "Could not connect to: $self->{'TlnServer'}";
    $tln = undef;
    return 0;
    }
    if (!$tln->login ($self->{'TlnUser'}, $self->{'TlnPass'})) {
    $self->{'Error'} = "Login failed on $self->{'TlnServer'} (name|password): $self->{'TlnUser'}, $self->{'TlnPass'}";
    $tln = undef;
    return 0;
    }
    $self->{'Error'} = '';
    return 1;
    }

    #######################################
    # Close telnet session
    #######################################
    sub CloseSession($)
    {
    my $self = shift;
    if (defined $tln) {$tln->close;}
    $tln = undef;
    $self->{'Error'} = '';
    return 1;
    }

    #######################################
    # Clear screen
    # use as console mode workaround
    #######################################
    sub ClearScreen ($$$$)
    {
    my ($self, $cmd, $timeout, $prompt) = @_;
    my ($pre, $match);

    if (!defined $tln) {
    $self->{'Error'} = "Session not open";
    return 0;
    }
    $cmd = $self->{'ClearCmd'} unless defined $cmd;
    $timeout = $self->{'Timeout'} unless defined $timeout;
    $prompt = $self->{'Prompt'} unless defined $prompt;
    $tln->print ($cmd);
    $tln->waitfor (Match => $prompt, Timeout => $timeout);
    $tln->print ("");
    ($pre, $match) = $tln->waitfor (Match => $prompt, Timeout => $timeout);
    print "Sent clear screen ... recieved: $match\n" if ($self->{'Debug'});
    $tln->buffer_empty; # empty recieve buffer after clear
    $self->{'Error'} = '';
    return 1;
    }

    #######################################
    # Empty recieve buffer
    #######################################
    sub EmptyBuffer($)
    {
    my $self = shift;
    if (!defined $tln) {
    $self->{'Error'} = "Session not open";
    return 0;
    }
    $tln->buffer_empty;
    $self->{'Error'} = '';
    return 1;
    }

    #####################################################
    # Send command and wait for reply
    # - May wait for one of many reply regxs' passed in
    # via the 'Reply' array. Each MUST be single
    # quoted regex expressions. ie: '/any/i'
    # IN:
    # cmd - the shell command or program
    # waitsecs - total secs willing to wait (up to)
    # show_wait - 'yes' shows the seconds while waiting
    # Reply - list of matches will wait for
    # OUT:
    # Returns index+1 into the 'Reply' list passed in,
    # of the first match found in reply stream.
    # Otherwise returns 0, meaning timeout or other
    # error (check $self->{'Error'})
    #####################################################
    sub SendCommand
    {
    my ($self, $cmd, $waitsecs, $show_wait, @Reply) = @_;
    my ($pre, $match);

    if (!defined $tln) {
    $self->{'Error'} = "Session not open";
    return 0;
    }
    $waitsecs = $self->{'Waitsecs'} unless (defined $waitsecs);
    $show_wait = $self->{'Show_Wait'} unless (defined $show_wait);

    my @args = ('Timeout', 0);
    if (@Reply == 0) { push (@Reply, $self->{'Prompt'}) }
    for (@Reply) {
    push (@args, 'Match');
    push (@args, $_);
    }
    my $savedtimeout = $tln->timeout(0);
    $tln->print ($cmd);
    print "Sent: $cmd\n" if ($self->{'Debug'});

    for (my $i = 0; $i < $waitsecs; $i++) {
    ($pre, $match) = $tln->waitfor(@args);
    if (!$tln->timed_out) {
    print "\rRecieved ($i seconds): $match \n" if ($self->{'Debug'});
    print "\n$pre\n" if (lc($self->{'Show_Prematch'}) eq 'yes');
    last;
    }
    sleep (1);
    if ($show_wait eq lc('yes')) {
    print "\rWait progress: ".($i+1)." seconds " ;
    print "\n" if ($i == ($waitsecs-1));
    }
    }
    $tln->timeout($savedtimeout);

    ## check if timed out
    if ($tln->timed_out) {
    print "\r** WAIT EXPIRED - $waitsecs seconds ** \n" if ($self->{'Debug'});
    $self->{'Error'} = "Timed out ($waitsecs) executing command: $cmd";
    return 0;
    }
    ## return the index of the matched @Reply
    #return 1 if (!@Reply);
    my $pos = 0;
    for (@Reply) {
    $pos++;
    my $patcheck = "last if (\$match =~ $_);"; # pattern match check
    #print "$patcheck\n";
    eval $patcheck;
    }
    $self->{'Error'} = '';
    return $pos;
    }
    1;

    ==================================================
    tln.pl
    ==================================================
    use strict;

    use Net::Telnet;
    use sort 'stable';
    my $current = sort::current();

    use Net::Telnet qw(TELOPT_TTYPE);

    if (1)
    {
    my $Term = "ascii";
    my $Telopt_ttype_ok = '';
    my ($outline, $inline);

    my $tln = new Net::Telnet (Timeout => 1, Prompt => '/C:\\\\>/');
    my $savederrmode = $tln->errmode ('return');

    $tln->option_log('option.log');

    ## Set up callbacks to negotiate terminal type.
    if ($tln->open("155.64.151.193"))
    {
    $tln->login("administrator", "password");
    #print "$savederrmode\n";
    #my @aOut = $tln->cmd ( "help\n" );
    #print (join "\n", @aOut);
    #print "\n\n\ndid u see it?\n\n\n\n";
    #<>;

    $outline = "";
    while ($outline !~ /quit/i)
    {
    do {
    $inline = $tln->get();
    #chomp ($inline);
    print "$inline";
    } while (defined $inline);

    $outline = <STDIN>;
    chomp ($outline);
    # print $outline;
    $tln->print ($outline);
    }
    } else {
    print "Could not connect to host\n";
    }
    $tln->close;

    print "done!\n";

    ###################################
    # Option negotation callbacks
    ####################################
    sub opt_callback
    {
    my ($obj, $option, $is_remote,
    $is_enabled, $was_enabled, $buf_position) = @_;

    if ($option == TELOPT_TTYPE and $is_enabled and !$is_remote) {
    $Telopt_ttype_ok = 1;
    }
    1;
    }
    sub subopt_callback
    {
    my ($obj, $option, $parameters) = @_;
    my $ors_old;

    if ($option == TELOPT_TTYPE) {
    $ors_old = $obj->output_record_separator("");

    $obj->print("\xff\xfa", pack("CC", $option, 0), $Term, "\xff\xf0");

    $obj->output_record_separator($ors_old);
    }
    1;
    }
    }

    if (0)
    {
    ## Module import.
    use Net::Telnet qw(TELOPT_TTYPE);

    ## Global variables.
    my $Term = "vt100";
    my $Telopt_ttype_ok = '';

    ## Main program.
    {
    my $t;
    my ($host, $username, $passwd) = @ARGV;
    die "usage: $0 host username passwd\n" unless @ARGV == 3;

    $t = new Net::Telnet (Prompt => '/\$ $/',
    Dump_log => "/tmp/dump.log",
    Option_log => "/tmp/option.log");

    ## Set up callbacks to negotiate terminal type.
    $t->option_callback(\&opt_callback);
    $t->option_accept(Do => TELOPT_TTYPE);
    $t->suboption_callback(\&subopt_callback);

    $t->open($host);
    $t->login($username, $passwd);
    print "TERM=", $t->cmd("printenv TERM");
    $t->close;

    exit;
    } # end main program

    sub opt_callback {
    my ($obj, $option, $is_remote,
    $is_enabled, $was_enabled, $buf_position) = @_;

    if ($option == TELOPT_TTYPE and $is_enabled and !$is_remote) {
    $Telopt_ttype_ok = 1;
    }

    1;
    }

    sub subopt_callback {
    my ($obj, $option, $parameters) = @_;
    my $ors_old;

    if ($option == TELOPT_TTYPE) {
    $ors_old = $obj->output_record_separator("");

    $obj->print("\xff\xfa", pack("CC", $option, 0), $Term, "\xff\xf0");

    $obj->output_record_separator($ors_old);
    }

    1;
    }
    }

    =============================================
    tln2.pl
    =============================================
    use strict;

    use Net::Telnet;
    use sort 'stable';

    my $VERSION = 1.00;

    my $current = sort::current();
    #print "\n==> sort : $current\n\n";

    use Net::Telnet ();

    my $tln = undef;

    my $debug = 1;
    my $console_mode = 1;

    # CONSOLE MODE ????? Info --
    # We need line-mode or stream!!
    # In console mode, the screen is treated
    # as a buffer X by Y where the display is
    # controlloed by ansi escape sequences.
    # This is bad when expecting specific output (prompts)
    # that may never come because those chars are already
    # in your screen buffer.
    # Always make the server NON-Console, ie: use stream!!
    # If not, as a workaround we will clear screen cmd,
    # then return cmd, between real commands.

    if (1)
    {
    $tln = new Net::Telnet (Timeout => 2, Prompt => '/c:\\\\>/i');

    $tln->errmode ('return');
    $tln->option_log ('option.log');
    $tln->dump_log ('dump.log');
    $tln->input_log ('input.log');

    $tln->buffer_empty;
    $tln->cmd_remove_mode (0);

    my $prompt = '/c:\\\\>/i';

    if ($tln->open("155.64.151.193"))
    {
    $tln->prompt ($prompt);
    $tln->login ("administrator", "password");
    $tln->cmd_remove_mode (0);


    ## test loop

    for (my $t = 0; $t < 3; $t++)
    {
    $tln->timeout(2);

    my $ret;

    TlNet_ClearScreen ('cls', $prompt, 2);

    $ret = TlNet_Send ( "ping 155.64.151.193", 10, 'yes', '/asfdgbasdfgas/i', '/c:\\\\>/i');
    #print "send returned prompt #: $ret\n";

    TlNet_ClearScreen ('cls', $prompt, 2);

    $ret = TlNet_Send ( "dir", 10, 'yes', '/c:\\\\>/i', '/asfdgbasdfgas/i');
    #print "send returned prompt #: $ret\n";

    TlNet_ClearScreen ('cls', $prompt, 2);

    $ret = TlNet_Send ( "help\n\n\n\n\n\n", 5, 'yes', '/c:\\\\>/i', '/MORE ---/i');

    my $retry = 5;
    while ($ret != 1 && $retry-- > 0)
    {
    $ret = TlNet_Send ( "", 1, 'yes', '/c:\\\\>/i', '/MORE ---/i');
    #print "send returned prompt #: $ret\n";
    }
    $ret = TlNet_Send ( "echo hi\necho and\necho hello\necho there\n", 15, 'yes', '/c:\\\\>/i', '/MORE ---/i');
    TlNet_ClearScreen ('cls', $prompt, 2);
    TlNet_ClearScreen ('cls', $prompt, 2);

    }

    } else {
    print "Could not connect to host\n";
    }
    $tln->close;

    print "\nPress return. ";<>;
    print "done!\n";
    }

    ## send
    sub TlNet_Send
    {
    my ($cmd, $waitsecs, $showsecs, @prompt) = @_;
    my ($pre, $match);

    return 0 if (!defined $tln or !defined $cmd);

    $waitsecs = 2 unless (defined $waitsecs);
    $showsecs = 'yes' unless (defined $showsecs);

    my @args = ();
    @args = ('Match', '') if (@prompt == 0);

    for (@prompt) {
    push (@args, 'Match');
    push (@args, $_);
    }

    $tln->timeout(0); # save old timeout ??
    $tln->print ($cmd);
    print "Sent: $cmd\n" if (defined $debug);

    for (my $i = 0; $i < $waitsecs; $i++) {
    ($pre, $match) = $tln->waitfor(@args);
    if (!$tln->timed_out) {
    print "\rRecieved ($i seconds): $match \n" if (defined $debug);
    #print "\n$prematch\n";
    last;
    }
    sleep (1);
    print "\rWait progress: ".($i+1)." second " if ($showsecs eq lc ('yes'));

    }
    ## check time out
    if ($tln->timed_out) {
    print "\r** TIMED OUT ** after $waitsecs seconds -- add more time or change prompt ? \n" if (defined $debug);
    return 0;
    }
    ## return the index of the matched @prompt
    return 1 if (!@prompt); # no prompt entered, assume first returned

    my $pos = 0;
    for (@prompt) {
    $pos++;
    my $patcheck = "last if (\$match =~ $_);"; # pattern match check
    #print "$patcheck\n";
    eval $patcheck;
    }
    return $pos;
    }

    ## clear screen
    sub TlNet_ClearScreen
    {
    my ($cmd, $prompt, $timeout) = @_;
    my ($pre, $match);

    return 0 if (!defined $tln or !defined $cmd);

    $prompt = '' unless (defined $prompt);
    $timeout = 2 unless (defined $timeout);

    $tln->timeout($timeout);
    $tln->print ($cmd);
    $tln->waitfor ($prompt);
    $tln->print("");
    ($pre, $match) = $tln->waitfor ($prompt);
    print "Sent clear screen ... recieved: $match\n" if (defined $debug);
    $tln->buffer_empty; # empty recieve buffer between commands
    return $match;
    }

    ====================================================
    tln_unix.pl
    ====================================================
    use strict;

    #########################################
    # unixrun.pl - tests the TlnSrv module
    # R. Chalaire - 10/21/04
    #########################################

    require TlnSrv;
    $|=1;

    #############################################
    # CONSOLE MODE ????? Info --
    # We need line-mode or stream!!
    # In console mode, the screen is treated
    # as a buffer X by Y where the display is
    # controlloed by ansi escape sequences.
    # This is bad when expecting specific output (prompts)
    # that may never come because those chars are already
    # in screen buffer.
    # Always make the server NON-Console, ie: use stream!!
    # If not, as a workaround, between real commands,
    # we can clear screen, then send return.
    # -------------------------------------------------------
    # Note that all 'Prompts' strings are single quote Regex
    # parameters.
    #############################################
    # Default parameters on some methods are take from the class variables
    # if those parameters are not passed in with the call.
    # Set the class variables with SetVal() function.
    # Values passed into the functions are not assigned to class variables.
    # ----------------------------------
    # SetVal() will find these keys:
    # ----------------------------------
    # Debug 1/0 (default: 0)
    # Show_Prematch yes/no (default: no)
    # Port # (default: 23)
    # Prompt /regex/ (default: /[\$%#>] $/)
    # Timeout # (default: 10 secs)
    # ClearCmd (default: '')
    # Waitsecs # (default: 10 secs)
    # Show_Wait yes/no (default: yes)


    #############################################
    # TlnSrv::new (server, user, pwd, logdir);
    #############################################
    my $prompt = '/# $/i';
    my @p_cls = ("", 3, $prompt);
    my $ret;

    my $tln = new TlnSrv ("172.0.15.1", "x098", "sys2");

    $tln->SetVal (
    Port => 1023,
    Debug => 1,
    Waitsecs => 15,
    ClearCmd => '',
    Prompt => $prompt,
    Timeout => 10
    );

    if ($tln->OpenSession(1)) # 1 = enable logging, 0 = disable
    {
    $tln->EmptyBuffer();
    $tln->ClearScreen (@p_cls);

    $ret = $tln->SendCommand ( "cd /share/here"); # the values from above are used when nothing passed in
    print "$tln->{'Error'}\n" if (!$ret);

    $ret = $tln->SendCommand ("ls");
    print "$tln->{'Error'}\n" if (!$ret);

    $ret = $tln->SendCommand ( "cd /share/there"); # 1 will be returned here, if 0, its either timeout or some other error
    print "$tln->{'Error'}\n" if (!$ret);

    $ret = $tln->SendCommand ("ls");
    print "$tln->{'Error'}\n" if (!$ret);

    $ret = $tln->SendCommand ( "cd /share/and_here", 10, 'yes', '/asfdgbasdfgas/i', '/c:\\\\>/i', $prompt); # 3 will be returned here
    print "$tln->{'Error'}\n" if (!$ret);

    $ret = $tln->SendCommand ("ls");
    print "$tln->{'Error'}\n" if (!$ret);

    $tln->CloseSession();
    }
    else
    {
    print "Open Session error: $tln->{'Error'}\n";
    }

    print "\nPress return. ";<>;
    print "done!\n";
    robic0, Jul 17, 2006
    #4
  5. robic0 escribió:
    > On Sun, 16 Jul 2006 19:03:43 -0400, Carl Lafferty <> wrote:
    >
    >> I have a problem with something I am doing using net::telnet in perl.
    >> I am trying to write a script that will access an automated library
    >> system via telnet and basically mimic what the company that sold us the
    >> system did in VB. I am basically reverse engineering their code only in
    >> perl.. anyway... My problem is that I am having to search for
    >> different flags using waitfor. sometimes it is the word Description,
    >> sometimes it is \x8f (I have no idea why but they seem to use that as a
    >> delimiter quite often) My problem is that when I get to a particular
    >> piece of data, I am not getting everything from the stream in my waitfor
    >> variable.
    >>
    >> This is a snippit of the code
    >>
    >> #cleaning out the buffer
    >> ($info) = $galaxy->waitfor("/\x8f/");
    >> print "1 $info\n";
    >>
    >> ($info) = $galaxy->waitfor("/\x8f/");
    >> print "2 $info\n";
    >>
    >>
    >> $galaxy->print("5000 5018 30 0 0 ");
    >>
    >> ($info) = $galaxy->waitfor("/\x8f/");
    >> $info =~ s/\\b/\n/g;
    >> $info =~ s/\\B/\<b\>/g;
    >> $info =~ s/\n/\<\/b\>\n/g;
    >> print "$info\n";
    >>
    >>
    >> ($info) = $galaxy->waitfor("/Description/");
    >> $info =~ s/\\b/\n/g;
    >> $info =~ s/\\B/\<b\>/g;
    >> $info =~ s/\n/\<\/b\>\n/g;
    >> print "$info\n";
    >>
    >> #got stuff up to description now
    >> ($info) = $galaxy->waitfor("/\x5C\x62/");
    >> $info =~ s/\\b/\n/g;
    >> $info =~ s/\\B/\<b\>/g;
    >> $info =~ s/\n/\<\/b\>\n/g;
    >> print "Description: $info\n";
    >>
    >>
    >> print "\nLogging out of galaxy\n";
    >> #$ok = $galaxy->waitfor("/\x8f/");
    >> $ok = $galaxy->print("999");
    >> $ok = $galaxy->print("0005 GALAXY||20");
    >> $ok = $galaxy->print("0010 ");
    >>
    >> $galaxy->close;
    >> -----------------------------------
    >> 0x000e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
    >> 0x000f0: 20 5c 62 20 20 54 79 70 65 2f 6c 61 6e 67 75 61 \b
    >> Type/langua
    >> 0x00100: 67 65 3a 20 5c 42 42 6f 6f 6b 2f 65 6e 67 5c 62 ge:
    >> \BBook/eng\b
    >> 0x00110: 0d 20 20 20 49 53 42 4e 2f 49 53 53 4e 3a 20 5c .
    >> ISBN/ISSN: \
    >> 0x00120: 42 2f 5c 62 0d 20 44 65 73 63 72 69 70 74 69 6f B/\b.
    >> Descriptio
    >> 0x00130: 6e 3a 20 5c 42 31 37 38 20 70 2e 2c 20 32 30 20 n: \B178 p.. 20
    >> 0x00140: 63 6d 2e 20 20 20 20 20 20 20 20 20 5c 62 cm. \b
    >>
    >> 0x00000: 39 39 39 0d 999.
    >>
    >> 0x00000: 30 30 30 35 20 47 41 4c 41 58 59 7c 7c 32 30 0d 0005
    >> GALAXY||20.
    >>
    >> 0x00000: 30 30 31 30 20 0d 0010 .
    >>
    >> ----------------------------------------------
    >> above is the dump file (a little difficult to read :( )
    >>
    >>
    >> it SEES the word description and gives me the info up to that.. BUT
    >> after description the delimiter is \b (\x5c\x62) which is what I do a
    >> waitfor on. all I get is a \
    >>
    >> Everything after 0x00140: is my program signing out of the telnet session..
    >>
    >> Any way to get that information into my variable?? Ive been beating my
    >> head for 4 days now... any help is appreciated.
    >>
    >>
    >> Carl Lafferty
    >> System Admin
    >> Floyd County Public Library
    >> Prestonsburg, KY

    >
    >
    > Net::Telnet is a just an ok module. The fact is that no module can
    > correct the inherrant flaws of Telnet in general. For what it does,
    > I give the author a thumbs up. He trully has written a awsome piece of code.
    >
    > The flaws of Telnet across OS's compounds the problem. The translation of
    > newlines (and other control codes) alone in these terminal emulators
    > (across OS's) is the death nail. Other nails are there, the big one is
    > discovery handshaking and progrmability (mode setting). So implementation
    > was the big deathnail to Telnet. That is of course on the level that you
    > need to use it at because, there are plenty of smooth running Telnet
    > automations out there, be it in C or Perl modules.
    >
    > In general, to design a piece of code for the Telnet module, you will have
    > to know, to be able to anchor with certainty. This involves alot of work by
    > hand ahead of time. Using the module capture "all" in several attempts for
    > a statistical overview of your objective.
    >
    > What you reliably "waitfor" may not be the EOT (end of transmission).
    > And the eot may not be a static thing.
    >
    > Whatever your waiting for it doesen't matter. What matters is that you want
    > to capture some data, be it binary (not control) or printable. You don't want
    > to capture the data of interest directly! You want some assurance that "it"
    > can be gleened later on and you want to be immediatly ready to repeat the
    > sequence.
    >
    > So many folks try to capture that "single" piece of data on the fly, but never
    > get framed for it as the boxcars roll down the track (possibly several times).
    >
    > In actuality (this is the truth), some Telnet servers don't even send
    > a frame down for a single data change. What you have to know is that when the handshaking
    > is done what the full outcome of a frame request will be.
    >
    > You can force Telnet servers to re-send all the info in the frame however.
    > I had written a wrapper module a very long time ago, that covers Win<->win, Nx<->Win.
    > You can imbedd binary in the waitfor string (but its not necessary).
    >
    > I am posting it here (again) from along time ago. When I wrote this, I only had like
    > 1 year of Perl and 16 years of C/C++. What is here is stuff that works. I can take no
    > cudo's for the code and I am not in the biz of re-writing code (for free).
    > So here it is, a pm and pl file that "can" get what you wan't. If you don't use it
    > its ok with me. It has worked for me in several Telnet automations within/across platform.
    >
    > Any usage questions, let me know.
    > Just glanceing at the old examples, read through the lines on the intent, I don't want to
    > revisit or modify this crap, even though it works. You will get the jist.
    >
    > robic0
    >
    >
    > ==================================================
    > TlnSvr.pm
    > ==================================================
    > package TlnSrv;
    > use strict;
    > #my $console_mode = 1;
    >
    > use Net::Telnet ();
    > use Cwd;
    > my $VERSION = 1.00;
    >
    > my $tln = undef;
    > $|=1;
    >
    > # CONSOLE MODE ????? Info --
    > # We need line-mode or stream!!
    > # In console mode, the screen is treated
    > # as a buffer X by Y where the display is
    > # controlloed by ansi escape sequences.
    > # This is bad when expecting specific output (prompts)
    > # that may never come because those chars are already
    > # in screen buffer.
    > # Always make the server NON-Console, ie: use stream!!
    > # If not, as a workaround, between real commands,
    > # we can clear screen, then send return.
    > # -------------------------------------------------------
    > # Note that all 'Prompts' strings are single quote Regex
    > # parameters.
    >
    > # Global variables
    > sub new ($$$$$)
    > {
    > my $class = shift;
    > my $self = {};
    > $self->{'TlnServer'} = shift; # Telnet server address. IP or computer name
    > $self->{'TlnUser'} = shift; # User name
    > $self->{'TlnUser'} = "administrator" unless (defined $self->{'TlnUser'});
    > $self->{'TlnPass'} = shift; # Password
    > $self->{'TlnPass'} = "password" unless (defined $self->{'TlnPass'});
    > $self->{'LogDir'} = shift;
    > $self->{'LogDir'} = cwd() unless (defined $self->{'LogDir'});
    > $self->{'Debug'} = 0;
    > $self->{'Show_Prematch'} = 'no'; # Show reply up to 'match' (used in SendCommand only)
    > $self->{'Port'} = 23;
    > $self->{'Prompt'} = '/[\$%#>] $/'; # or '/c:\\\\>/i for dos
    > $self->{'Timeout'} = 10;
    > $self->{'ClearCmd'} = ''; # Clear screen shell command (or "" if not used)
    > $self->{'Waitsecs'} = 10; # (see SendCommand)
    > $self->{'Show_Wait'} = 'yes'; # Print line that counts off 'Waitsecs'
    > $self->{'Error'} = '';
    > bless ($self, $class);
    > return $self;
    > }
    >
    > #######################################
    > # SetVal
    > #######################################
    > sub SetVal
    > {
    > my ($self, @args) = @_;
    > my $val;
    > if (@args > 0)
    > {
    > while (($_, $val) = splice @args, 0, 2) {
    > if (/^Debug$/i) {
    > $self->{'Debug'} = $val;
    > }
    > elsif (/^Show_Prematch$/i) {
    > $self->{'Show_Prematch'} = $val;
    > }
    > elsif (/^Port$/i) {
    > $self->{'Port'} = $val;
    > }
    > elsif (/^Prompt$/i) {
    > $self->{'Prompt'} = $val;
    > }
    > elsif (/^Timeout$/i) {
    > $self->{'Timeout'} = $val;
    > }
    > elsif (/^ClearCmd$/i) {
    > $self->{'ClearCmd'} = $val;
    > }
    > elsif (/^Waitsecs$/i) {
    > $self->{'Waitsecs'} = $val;
    > }
    > elsif (/^Show_Wait$/i) {
    > $self->{'Show_Wait'} = $val;
    > }
    > }
    > }
    > $self->{'Error'} = '';
    > return 1;
    > }
    >
    > #######################################
    > # Open telnet session
    > #######################################
    > sub OpenSession($$)
    > {
    > my $self = shift;
    > my $logging = shift;
    >
    > ## default prompt and timeout for this session
    > my $timeout = $self->{'Timeout'};
    > my $prompt = $self->{'Prompt'};
    > my $logging = 1 unless (defined $logging);
    >
    > if (defined $tln) {$tln->close;}
    > $tln = undef;
    > $tln = new Net::Telnet (Timeout => $self->{'Timeout'}, Prompt => $self->{'Prompt'});
    >
    > $tln->errmode ('return');
    > ## logging is turned off by default
    > ## if enabled, a new log is created each time
    > if ($logging) {
    > $tln->option_log ("$self->{'LogDir'}/option.log");
    > $tln->dump_log ("$self->{'LogDir'}/dump.log");
    > $tln->input_log ("$self->{'LogDir'}/input.log");
    > }
    > $tln->buffer_empty;
    > $tln->cmd_remove_mode (0);
    >
    > if (!$tln->open(Host => $self->{'TlnServer'}, Port => $self->{'Port'})) {
    > $self->{'Error'} = "Could not connect to: $self->{'TlnServer'}";
    > $tln = undef;
    > return 0;
    > }
    > if (!$tln->login ($self->{'TlnUser'}, $self->{'TlnPass'})) {
    > $self->{'Error'} = "Login failed on $self->{'TlnServer'} (name|password): $self->{'TlnUser'}, $self->{'TlnPass'}";
    > $tln = undef;
    > return 0;
    > }
    > $self->{'Error'} = '';
    > return 1;
    > }
    >
    > #######################################
    > # Close telnet session
    > #######################################
    > sub CloseSession($)
    > {
    > my $self = shift;
    > if (defined $tln) {$tln->close;}
    > $tln = undef;
    > $self->{'Error'} = '';
    > return 1;
    > }
    >
    > #######################################
    > # Clear screen
    > # use as console mode workaround
    > #######################################
    > sub ClearScreen ($$$$)
    > {
    > my ($self, $cmd, $timeout, $prompt) = @_;
    > my ($pre, $match);
    >
    > if (!defined $tln) {
    > $self->{'Error'} = "Session not open";
    > return 0;
    > }
    > $cmd = $self->{'ClearCmd'} unless defined $cmd;
    > $timeout = $self->{'Timeout'} unless defined $timeout;
    > $prompt = $self->{'Prompt'} unless defined $prompt;
    > $tln->print ($cmd);
    > $tln->waitfor (Match => $prompt, Timeout => $timeout);
    > $tln->print ("");
    > ($pre, $match) = $tln->waitfor (Match => $prompt, Timeout => $timeout);
    > print "Sent clear screen ... recieved: $match\n" if ($self->{'Debug'});
    > $tln->buffer_empty; # empty recieve buffer after clear
    > $self->{'Error'} = '';
    > return 1;
    > }
    >
    > #######################################
    > # Empty recieve buffer
    > #######################################
    > sub EmptyBuffer($)
    > {
    > my $self = shift;
    > if (!defined $tln) {
    > $self->{'Error'} = "Session not open";
    > return 0;
    > }
    > $tln->buffer_empty;
    > $self->{'Error'} = '';
    > return 1;
    > }
    >
    > #####################################################
    > # Send command and wait for reply
    > # - May wait for one of many reply regxs' passed in
    > # via the 'Reply' array. Each MUST be single
    > # quoted regex expressions. ie: '/any/i'
    > # IN:
    > # cmd - the shell command or program
    > # waitsecs - total secs willing to wait (up to)
    > # show_wait - 'yes' shows the seconds while waiting
    > # Reply - list of matches will wait for
    > # OUT:
    > # Returns index+1 into the 'Reply' list passed in,
    > # of the first match found in reply stream.
    > # Otherwise returns 0, meaning timeout or other
    > # error (check $self->{'Error'})
    > #####################################################
    > sub SendCommand
    > {
    > my ($self, $cmd, $waitsecs, $show_wait, @Reply) = @_;
    > my ($pre, $match);
    >
    > if (!defined $tln) {
    > $self->{'Error'} = "Session not open";
    > return 0;
    > }
    > $waitsecs = $self->{'Waitsecs'} unless (defined $waitsecs);
    > $show_wait = $self->{'Show_Wait'} unless (defined $show_wait);
    >
    > my @args = ('Timeout', 0);
    > if (@Reply == 0) { push (@Reply, $self->{'Prompt'}) }
    > for (@Reply) {
    > push (@args, 'Match');
    > push (@args, $_);
    > }
    > my $savedtimeout = $tln->timeout(0);
    > $tln->print ($cmd);
    > print "Sent: $cmd\n" if ($self->{'Debug'});
    >
    > for (my $i = 0; $i < $waitsecs; $i++) {
    > ($pre, $match) = $tln->waitfor(@args);
    > if (!$tln->timed_out) {
    > print "\rRecieved ($i seconds): $match \n" if ($self->{'Debug'});
    > print "\n$pre\n" if (lc($self->{'Show_Prematch'}) eq 'yes');
    > last;
    > }
    > sleep (1);
    > if ($show_wait eq lc('yes')) {
    > print "\rWait progress: ".($i+1)." seconds " ;
    > print "\n" if ($i == ($waitsecs-1));
    > }
    > }
    > $tln->timeout($savedtimeout);
    >
    > ## check if timed out
    > if ($tln->timed_out) {
    > print "\r** WAIT EXPIRED - $waitsecs seconds ** \n" if ($self->{'Debug'});
    > $self->{'Error'} = "Timed out ($waitsecs) executing command: $cmd";
    > return 0;
    > }
    > ## return the index of the matched @Reply
    > #return 1 if (!@Reply);
    > my $pos = 0;
    > for (@Reply) {
    > $pos++;
    > my $patcheck = "last if (\$match =~ $_);"; # pattern match check
    > #print "$patcheck\n";
    > eval $patcheck;
    > }
    > $self->{'Error'} = '';
    > return $pos;
    > }
    > 1;
    >
    > ==================================================
    > tln.pl
    > ==================================================
    > use strict;
    >
    > use Net::Telnet;
    > use sort 'stable';
    > my $current = sort::current();
    >
    > use Net::Telnet qw(TELOPT_TTYPE);
    >
    > if (1)
    > {
    > my $Term = "ascii";
    > my $Telopt_ttype_ok = '';
    > my ($outline, $inline);
    >
    > my $tln = new Net::Telnet (Timeout => 1, Prompt => '/C:\\\\>/');
    > my $savederrmode = $tln->errmode ('return');
    >
    > $tln->option_log('option.log');
    >
    > ## Set up callbacks to negotiate terminal type.
    > if ($tln->open("155.64.151.193"))
    > {
    > $tln->login("administrator", "password");
    > #print "$savederrmode\n";
    > #my @aOut = $tln->cmd ( "help\n" );
    > #print (join "\n", @aOut);
    > #print "\n\n\ndid u see it?\n\n\n\n";
    > #<>;
    >
    > $outline = "";
    > while ($outline !~ /quit/i)
    > {
    > do {
    > $inline = $tln->get();
    > #chomp ($inline);
    > print "$inline";
    > } while (defined $inline);
    >
    > $outline = <STDIN>;
    > chomp ($outline);
    > # print $outline;
    > $tln->print ($outline);
    > }
    > } else {
    > print "Could not connect to host\n";
    > }
    > $tln->close;
    >
    > print "done!\n";
    >
    > ###################################
    > # Option negotation callbacks
    > ####################################
    > sub opt_callback
    > {
    > my ($obj, $option, $is_remote,
    > $is_enabled, $was_enabled, $buf_position) = @_;
    >
    > if ($option == TELOPT_TTYPE and $is_enabled and !$is_remote) {
    > $Telopt_ttype_ok = 1;
    > }
    > 1;
    > }
    > sub subopt_callback
    > {
    > my ($obj, $option, $parameters) = @_;
    > my $ors_old;
    >
    > if ($option == TELOPT_TTYPE) {
    > $ors_old = $obj->output_record_separator("");
    >
    > $obj->print("\xff\xfa", pack("CC", $option, 0), $Term, "\xff\xf0");
    >
    > $obj->output_record_separator($ors_old);
    > }
    > 1;
    > }
    > }
    >
    > if (0)
    > {
    > ## Module import.
    > use Net::Telnet qw(TELOPT_TTYPE);
    >
    > ## Global variables.
    > my $Term = "vt100";
    > my $Telopt_ttype_ok = '';
    >
    > ## Main program.
    > {
    > my $t;
    > my ($host, $username, $passwd) = @ARGV;
    > die "usage: $0 host username passwd\n" unless @ARGV == 3;
    >
    > $t = new Net::Telnet (Prompt => '/\$ $/',
    > Dump_log => "/tmp/dump.log",
    > Option_log => "/tmp/option.log");
    >
    > ## Set up callbacks to negotiate terminal type.
    > $t->option_callback(\&opt_callback);
    > $t->option_accept(Do => TELOPT_TTYPE);
    > $t->suboption_callback(\&subopt_callback);
    >
    > $t->open($host);
    > $t->login($username, $passwd);
    > print "TERM=", $t->cmd("printenv TERM");
    > $t->close;
    >
    > exit;
    > } # end main program
    >
    > sub opt_callback {
    > my ($obj, $option, $is_remote,
    > $is_enabled, $was_enabled, $buf_position) = @_;
    >
    > if ($option == TELOPT_TTYPE and $is_enabled and !$is_remote) {
    > $Telopt_ttype_ok = 1;
    > }
    >
    > 1;
    > }
    >
    > sub subopt_callback {
    > my ($obj, $option, $parameters) = @_;
    > my $ors_old;
    >
    > if ($option == TELOPT_TTYPE) {
    > $ors_old = $obj->output_record_separator("");
    >
    > $obj->print("\xff\xfa", pack("CC", $option, 0), $Term, "\xff\xf0");
    >
    > $obj->output_record_separator($ors_old);
    > }
    >
    > 1;
    > }
    > }
    >
    > =============================================
    > tln2.pl
    > =============================================
    > use strict;
    >
    > use Net::Telnet;
    > use sort 'stable';
    >
    > my $VERSION = 1.00;
    >
    > my $current = sort::current();
    > #print "\n==> sort : $current\n\n";
    >
    > use Net::Telnet ();
    >
    > my $tln = undef;
    >
    > my $debug = 1;
    > my $console_mode = 1;
    >
    > # CONSOLE MODE ????? Info --
    > # We need line-mode or stream!!
    > # In console mode, the screen is treated
    > # as a buffer X by Y where the display is
    > # controlloed by ansi escape sequences.
    > # This is bad when expecting specific output (prompts)
    > # that may never come because those chars are already
    > # in your screen buffer.
    > # Always make the server NON-Console, ie: use stream!!
    > # If not, as a workaround we will clear screen cmd,
    > # then return cmd, between real commands.
    >
    > if (1)
    > {
    > $tln = new Net::Telnet (Timeout => 2, Prompt => '/c:\\\\>/i');
    >
    > $tln->errmode ('return');
    > $tln->option_log ('option.log');
    > $tln->dump_log ('dump.log');
    > $tln->input_log ('input.log');
    >
    > $tln->buffer_empty;
    > $tln->cmd_remove_mode (0);
    >
    > my $prompt = '/c:\\\\>/i';
    >
    > if ($tln->open("155.64.151.193"))
    > {
    > $tln->prompt ($prompt);
    > $tln->login ("administrator", "password");
    > $tln->cmd_remove_mode (0);
    >
    >
    > ## test loop
    >
    > for (my $t = 0; $t < 3; $t++)
    > {
    > $tln->timeout(2);
    >
    > my $ret;
    >
    > TlNet_ClearScreen ('cls', $prompt, 2);
    >
    > $ret = TlNet_Send ( "ping 155.64.151.193", 10, 'yes', '/asfdgbasdfgas/i', '/c:\\\\>/i');
    > #print "send returned prompt #: $ret\n";
    >
    > TlNet_ClearScreen ('cls', $prompt, 2);
    >
    > $ret = TlNet_Send ( "dir", 10, 'yes', '/c:\\\\>/i', '/asfdgbasdfgas/i');
    > #print "send returned prompt #: $ret\n";
    >
    > TlNet_ClearScreen ('cls', $prompt, 2);
    >
    > $ret = TlNet_Send ( "help\n\n\n\n\n\n", 5, 'yes', '/c:\\\\>/i', '/MORE ---/i');
    >
    > my $retry = 5;
    > while ($ret != 1 && $retry-- > 0)
    > {
    > $ret = TlNet_Send ( "", 1, 'yes', '/c:\\\\>/i', '/MORE ---/i');
    > #print "send returned prompt #: $ret\n";
    > }
    > $ret = TlNet_Send ( "echo hi\necho and\necho hello\necho there\n", 15, 'yes', '/c:\\\\>/i', '/MORE ---/i');
    > TlNet_ClearScreen ('cls', $prompt, 2);
    > TlNet_ClearScreen ('cls', $prompt, 2);
    >
    > }
    >
    > } else {
    > print "Could not connect to host\n";
    > }
    > $tln->close;
    >
    > print "\nPress return. ";<>;
    > print "done!\n";
    > }
    >
    > ## send
    > sub TlNet_Send
    > {
    > my ($cmd, $waitsecs, $showsecs, @prompt) = @_;
    > my ($pre, $match);
    >
    > return 0 if (!defined $tln or !defined $cmd);
    >
    > $waitsecs = 2 unless (defined $waitsecs);
    > $showsecs = 'yes' unless (defined $showsecs);
    >
    > my @args = ();
    > @args = ('Match', '') if (@prompt == 0);
    >
    > for (@prompt) {
    > push (@args, 'Match');
    > push (@args, $_);
    > }
    >
    > $tln->timeout(0); # save old timeout ??
    > $tln->print ($cmd);
    > print "Sent: $cmd\n" if (defined $debug);
    >
    > for (my $i = 0; $i < $waitsecs; $i++) {
    > ($pre, $match) = $tln->waitfor(@args);
    > if (!$tln->timed_out) {
    > print "\rRecieved ($i seconds): $match \n" if (defined $debug);
    > #print "\n$prematch\n";
    > last;
    > }
    > sleep (1);
    > print "\rWait progress: ".($i+1)." second " if ($showsecs eq lc ('yes'));
    >
    > }
    > ## check time out
    > if ($tln->timed_out) {
    > print "\r** TIMED OUT ** after $waitsecs seconds -- add more time or change prompt ? \n" if (defined $debug);
    > return 0;
    > }
    > ## return the index of the matched @prompt
    > return 1 if (!@prompt); # no prompt entered, assume first returned
    >
    > my $pos = 0;
    > for (@prompt) {
    > $pos++;
    > my $patcheck = "last if (\$match =~ $_);"; # pattern match check
    > #print "$patcheck\n";
    > eval $patcheck;
    > }
    > return $pos;
    > }
    >
    > ## clear screen
    > sub TlNet_ClearScreen
    > {
    > my ($cmd, $prompt, $timeout) = @_;
    > my ($pre, $match);
    >
    > return 0 if (!defined $tln or !defined $cmd);
    >
    > $prompt = '' unless (defined $prompt);
    > $timeout = 2 unless (defined $timeout);
    >
    > $tln->timeout($timeout);
    > $tln->print ($cmd);
    > $tln->waitfor ($prompt);
    > $tln->print("");
    > ($pre, $match) = $tln->waitfor ($prompt);
    > print "Sent clear screen ... recieved: $match\n" if (defined $debug);
    > $tln->buffer_empty; # empty recieve buffer between commands
    > return $match;
    > }
    >
    > ====================================================
    > tln_unix.pl
    > ====================================================
    > use strict;
    >
    > #########################################
    > # unixrun.pl - tests the TlnSrv module
    > # R. Chalaire - 10/21/04
    > #########################################
    >
    > require TlnSrv;
    > $|=1;
    >
    > #############################################
    > # CONSOLE MODE ????? Info --
    > # We need line-mode or stream!!
    > # In console mode, the screen is treated
    > # as a buffer X by Y where the display is
    > # controlloed by ansi escape sequences.
    > # This is bad when expecting specific output (prompts)
    > # that may never come because those chars are already
    > # in screen buffer.
    > # Always make the server NON-Console, ie: use stream!!
    > # If not, as a workaround, between real commands,
    > # we can clear screen, then send return.
    > # -------------------------------------------------------
    > # Note that all 'Prompts' strings are single quote Regex
    > # parameters.
    > #############################################
    > # Default parameters on some methods are take from the class variables
    > # if those parameters are not passed in with the call.
    > # Set the class variables with SetVal() function.
    > # Values passed into the functions are not assigned to class variables.
    > # ----------------------------------
    > # SetVal() will find these keys:
    > # ----------------------------------
    > # Debug 1/0 (default: 0)
    > # Show_Prematch yes/no (default: no)
    > # Port # (default: 23)
    > # Prompt /regex/ (default: /[\$%#>] $/)
    > # Timeout # (default: 10 secs)
    > # ClearCmd (default: '')
    > # Waitsecs # (default: 10 secs)
    > # Show_Wait yes/no (default: yes)
    >
    >
    > #############################################
    > # TlnSrv::new (server, user, pwd, logdir);
    > #############################################
    > my $prompt = '/# $/i';
    > my @p_cls = ("", 3, $prompt);
    > my $ret;
    >
    > my $tln = new TlnSrv ("172.0.15.1", "x098", "sys2");
    >
    > $tln->SetVal (
    > Port => 1023,
    > Debug => 1,
    > Waitsecs => 15,
    > ClearCmd => '',
    > Prompt => $prompt,
    > Timeout => 10
    > );
    >
    > if ($tln->OpenSession(1)) # 1 = enable logging, 0 = disable
    > {
    > $tln->EmptyBuffer();
    > $tln->ClearScreen (@p_cls);
    >
    > $ret = $tln->SendCommand ( "cd /share/here"); # the values from above are used when nothing passed in
    > print "$tln->{'Error'}\n" if (!$ret);
    >
    > $ret = $tln->SendCommand ("ls");
    > print "$tln->{'Error'}\n" if (!$ret);
    >
    > $ret = $tln->SendCommand ( "cd /share/there"); # 1 will be returned here, if 0, its either timeout or some other error
    > print "$tln->{'Error'}\n" if (!$ret);
    >
    > $ret = $tln->SendCommand ("ls");
    > print "$tln->{'Error'}\n" if (!$ret);
    >
    > $ret = $tln->SendCommand ( "cd /share/and_here", 10, 'yes', '/asfdgbasdfgas/i', '/c:\\\\>/i', $prompt); # 3 will be returned here
    > print "$tln->{'Error'}\n" if (!$ret);
    >
    > $ret = $tln->SendCommand ("ls");
    > print "$tln->{'Error'}\n" if (!$ret);
    >
    > $tln->CloseSession();
    > }
    > else
    > {
    > print "Open Session error: $tln->{'Error'}\n";
    > }
    >
    > print "\nPress return. ";<>;
    > print "done!\n";
    >


    I have used for years the telnet module and never experienced any
    problem (except with a broken version of a windows server). I even used
    cat on the other end to get files; probably it is a good idea to choose
    a good prompt (something unlikely to collide with data and easy to find...)

    anyway, if you believe your wrapper may serve others you could contact
    the author to have your code added in the example section for example
    just a thought
    hth
    --stephan
    Stephan Titard, Jul 17, 2006
    #5
  6. Carl Lafferty

    Joe Smith Guest

    Stephan Titard wrote:
    > robic0 escribió:
    >> 759 lines

    >
    > I have used for years the telnet module and never experienced any problem


    Did you _HAVE_ to quote the entire article? All 759 lines of it?
    Joe Smith, Jul 17, 2006
    #6
  7. Carl Lafferty

    Dr.Ruud Guest

    Carl Lafferty schreef:

    >> ($info) = $galaxy->waitfor('/\\\b/');

    >
    > worked like a charm!!
    > Thank you!!!!!!!


    You're welcome. In the mean time I have read some of the documentation
    of the module, which says that you can give either a string or a regex
    to waitfor(). If the extra interpolation only happens with regexes, just
    waitfor("\x5C\x62") might work as well.

    --
    Affijn, Ruud

    "Gewoon is een tijger."
    Dr.Ruud, Jul 17, 2006
    #7
  8. Joe Smith escribió:
    > Stephan Titard wrote:
    >> robic0 escribió:
    >>> 759 lines

    >>
    >> I have used for years the telnet module and never experienced any problem

    >
    > Did you _HAVE_ to quote the entire article? All 759 lines of it?

    Sorry, I did not even notice there was so much code in there. I usually
    keep all of the context (and I have my newsgroup client setup this way
    actually, which I realize is not a good idea...will need something better)

    does this also mean I should not post 2*759 code lines?
    I mean no flame here, your *post* actually made me think and I browsed
    through the guidelines but did not find anything related to size
    it could be also that in general posting too much code is a bad idea

    common sense should apply, I guess
    hth
    --stephan
    Stephan Titard, Jul 17, 2006
    #8
  9. Carl Lafferty escribió:
    >>
    >> ($info) = $galaxy->waitfor(qr/\x5C\x62/);
    >>
    >> Or try:
    >> ($info) = $galaxy->waitfor('/\\\b/');
    >>

    > Couldn't get the top one to work BUT the bottom one worked like a charm!!
    >
    > Thank you!!!!!!!
    >
    >

    Just a small remark. The *Net::Telnet* module has a lot of
    functionality, but when it comes to automate an interactive program I
    think *expect* first. *expect* uses pseudo-terminals so this may be a
    limitation on some platforms.
    A pure perl clone exists as module *Expect*.


    hth
    --stephan
    Stephan Titard, Jul 17, 2006
    #9
  10. >>
    > Just a small remark. The *Net::Telnet* module has a lot of
    > functionality, but when it comes to automate an interactive program I
    > think *expect* first. *expect* uses pseudo-terminals so this may be a
    > limitation on some platforms.
    > A pure perl clone exists as module *Expect*.
    >


    I will give that a try. thanks.
    Carl Lafferty, Jul 17, 2006
    #10
  11. >
    > anyway, if you believe your wrapper may serve others you could contact
    > the author to have your code added in the example section for example
    > just a thought
    > hth
    > --stephan
    >

    Right now *my* code is almost embarrassing. I intend to try the other
    code when I get a chance. Right now I am wanting to get something to
    prove the concept so that I can devote some more time to it.

    I am having another problem however, NOW (remember this is a reverse
    engineering thing here) I have to accept a set length of characters from
    the server I am contacting.

    Let me stress something about the server I am using. it is running on a
    non standard port (2001) no problem there and was originally intended to
    be used interactively with a terminal program. the server runs under
    VMS something I have little or NO experience with beyond simple things
    like deleting processes and starting my library automation software with
    it. The company kludged together a windows interface a few years later
    when 98 became popular (yea it is that old) but it does not rely on a
    single 'prompt' from the data packets I have captured. there are
    delimiters (\x8f as well as the \b (those chars not a backspace)) but
    insofar as I can see when their software talks to the server, there are
    no prompts.
    Carl Lafferty, Jul 17, 2006
    #11
  12. Dr.Ruud wrote:
    > Carl Lafferty schreef:
    >
    >>> ($info) = $galaxy->waitfor('/\\\b/');

    >> worked like a charm!!
    >> Thank you!!!!!!!

    >
    > You're welcome. In the mean time I have read some of the documentation
    > of the module, which says that you can give either a string or a regex
    > to waitfor(). If the extra interpolation only happens with regexes, just
    > waitfor("\x5C\x62") might work as well.
    >

    I tried that and it didn't work. I tried the single quotes you
    suggested and it worked like a charm.

    ANy idea on how to get it to read x characters from the buffer with no
    delimiter???

    I THINK I can fake a delimiter if I can use an expression to check
    between different things it CAN be. Some may end in 'ion' or may be
    'fic'....
    Carl Lafferty, Jul 17, 2006
    #12
  13. On Mon, 17 Jul 2006 12:44:46 +0200, Stephan Titard wrote:

    > Joe Smith escribió:
    >> Stephan Titard wrote:
    >>> robic0 escribió:
    >>>> 759 lines
    >>>
    >>> I have used for years the telnet module and never experienced any problem

    >>
    >> Did you _HAVE_ to quote the entire article? All 759 lines of it?

    > Sorry, I did not even notice there was so much code in there. I usually
    > keep all of the context (and I have my newsgroup client setup this way
    > actually, which I realize is not a good idea...will need something better)


    The setup of your client has little to do with it. Your client doesn't
    understand the text you quote and cannot know what it relevant to your
    answer and what isn't. You have to decide that and trim the irrelevant
    parts.

    See the section "use an effective followup style" in the guidelines for
    details.


    > does this also mean I should not post 2*759 code lines?


    You probably shouldn't even post 1*759 code lines. This is a discussion
    group, not a source code archive (we have CPAN for that). What point in
    a discussion needs hundreds of lines of code to illustrate? And who is
    going to read that?

    > common sense should apply, I guess


    Right.

    hp

    --
    _ | Peter J. Holzer | > Wieso sollte man etwas erfinden was nicht
    |_|_) | Sysadmin WSR | > ist?
    | | | | Was sonst wäre der Sinn des Erfindens?
    __/ | http://www.hjp.at/ | -- P. Einstein u. V. Gringmuth in desd
    Peter J. Holzer, Jul 17, 2006
    #13
  14. Carl Lafferty

    robic0 Guest

    On Mon, 17 Jul 2006 10:05:28 -0400, Carl Lafferty <> wrote:

    >>
    >> anyway, if you believe your wrapper may serve others you could contact
    >> the author to have your code added in the example section for example
    >> just a thought
    >> hth
    >> --stephan
    >>

    >Right now *my* code is almost embarrassing. I intend to try the other
    >code when I get a chance. Right now I am wanting to get something to
    >prove the concept so that I can devote some more time to it.
    >
    >I am having another problem however, NOW (remember this is a reverse
    >engineering thing here) I have to accept a set length of characters from
    >the server I am contacting.
    >
    >Let me stress something about the server I am using. it is running on a
    >non standard port (2001) no problem there and was originally intended to
    >be used interactively with a terminal program.


    If it was intended to run interactively with a terminal program was the
    terminal a Telnet client? It would appear that it would have to be.
    What is the intitial interaction, do you hit return?

    > the server runs under
    >VMS something I have little or NO experience with beyond simple things
    >like deleting processes and starting my library automation software with
    >it. The company kludged together a windows interface a few years later
    >when 98 became popular (yea it is that old) but it does not rely on a
    >single 'prompt' from the data packets I have captured.


    How did you tickle it to give you data?

    > there are
    >delimiters (\x8f as well as the \b (those chars not a backspace)) but
    >insofar as I can see when their software talks to the server, there are
    >no prompts.


    If you have to accept a "packet" with a fixed structure, this can be done
    by passing into the waitfor, a regular expression with start delimeter, fixed length
    any char, end delimeter.

    In this case, the "delimeters" are redundant because of the fixed length (other than an
    EOT end delimeter). However stupid this may sound, there *is* a prompt there.

    Don't quote me on this but something like:

    /$sdelim(?:(.{26}?)$edelim$/

    Extract the data from the capture with a similar expression.

    robic0
    robic0, Jul 18, 2006
    #14
  15. > How did you tickle it to give you data?
    >

    Packet sniffed. I installed the program on my machine (XP) and ran a
    sniffer to capture the data to my server. performed the basic functions
    I wanted to emulate and the rest is history.



    > Don't quote me on this but something like:
    >
    > /$sdelim(?:(.{26}?)$edelim$/
    >

    I am going to have to do some work on regex's. . Kinda rudimentary
    understanding of it at best and that completely LOST me.
    Carl Lafferty, Jul 19, 2006
    #15
  16. >> /$sdelim(?:(.{26}?)$edelim$/
    >>

    > I am going to have to do some work on regex's. . Kinda rudimentary
    > understanding of it at best and that completely LOST me.
    >


    OK, I did some quick reading. I have found out a few things.

    1. I can use /.{59}/ to grab 59 characters at a time
    2. it didn't work immediately till I read deeper into net::telnet and
    found the prematch option on getting my info I think that may solve a
    few of my problems.
    3. My library (I have worked here since 92) will often have many copies
    of a book, each one generating a different item. Checking availability
    for each book generates x*59 bytes of data which the company that
    supplies our server THEN delimits with (you guessed it) \x8f.

    The result is that right before the availability line there is a line
    that (among other things) tells me how many availability lines there
    are. Now if I get say 3 lines each line is 59 chars long BUT on the
    second line one of them will be that stinking \x8f.

    6.5:1116 00183 003
    6.7: 003
    7 F ROWLING IN FCPL Fiction

    7.1 Length of info is 59
    7.2 prematch is
    7 F ROWLING Due:01-May-06 FCPL Fictio

    7.1 Length of info is 59
    7.2 prematch is
    7 nF ROWLING Due:26-Mar-04 FCLB Ficti

    7.1 Length of info is 59
    7.2 prematch is


    line 6.7 is the line that tells me how many are available (harry potter
    and sorcerers stone if anyone is interested) Not that the first 7 has
    Fiction spelled out, the next 7 line has Fictio and the next one has
    Ficit. The third 7 line has the 'n' from the previous line.
    I *think* I can fix it with a kludge of my own but ... well it's late
    and that is my progress report.

    in the end, sleep wins..
    Carl Lafferty, Jul 19, 2006
    #16
  17. Carl Lafferty wrote:
    > I *think* I can fix it with a kludge of my own but ... well it's late
    > and that is my progress report.
    >


    OK, I did fix it. I took the length of the string I expect, multiplied
    by how many and subtracted the number of \x8f's I was going to get
    (which is the same as the number I expect minus 1, grab that, split on
    the \x8f's and done.

    Now to take this and turn it into a reasonable facsimile of an online
    card catalog that accesses our database directly.

    I love linux/perl when it can save so much $$$$.

    Thanks for all the help I got here. I learned a LOT about regex and
    more about perl in general.

    --
    Carl Lafferty
    Carl Lafferty, Jul 19, 2006
    #17
  18. Carl Lafferty

    robic0 Guest

    On Mon, 17 Jul 2006 03:04:37 -0700, Joe Smith <> wrote:

    >Stephan Titard wrote:
    >> robic0 escribió:
    >>> 759 lines

    >>
    >> I have used for years the telnet module and never experienced any problem

    >
    >Did you _HAVE_ to quote the entire article? All 759 lines of it?


    This is a late post.
    All 759 lines of "it" constitutes all of about 30k.
    Whats the problem with quoting all 30k 20 or more times?
    That might give you 2/3 of a megabyte to download.

    Stay off the ng's because each nominal message is about 4,000 lines of uuenc.
    Something your immature ass does'ent know about.

    robic0
    robic0, Jul 21, 2006
    #18
  19. Carl Lafferty

    robic0 Guest

    On Wed, 19 Jul 2006 11:03:39 -0400, Carl Lafferty <> wrote:

    >Carl Lafferty wrote:
    >> I *think* I can fix it with a kludge of my own but ... well it's late
    >> and that is my progress report.
    >>

    >
    >OK, I did fix it. I took the length of the string I expect, multiplied
    >by how many and subtracted the number of \x8f's I was going to get
    >(which is the same as the number I expect minus 1, grab that, split on
    >the \x8f's and done.
    >
    >Now to take this and turn it into a reasonable facsimile of an online
    >card catalog that accesses our database directly.
    >
    >I love linux/perl when it can save so much $$$$.
    >
    >Thanks for all the help I got here. I learned a LOT about regex and
    >more about perl in general.



    I admit, have not read your problem from the beginning.
    I know you can use Net::Telnet as a pseudo socket communication device
    with the added bennifit of inline trigger callbacks.

    I would consider myself an expert on such items. Would your company like
    to contract to me for definative hard solution?
    Would be the best thing.

    robic0
    robic0, Jul 21, 2006
    #19
  20. robic0 wrote:
    >
    > I would consider myself an expert on such items. Would your company like
    > to contract to me for definative hard solution?
    > Would be the best thing.
    >


    Sorry for taking so long to get back to this. We are good for right now.

    I appreciate your help.
    Carl Lafferty, Aug 5, 2006
    #20
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Dale
    Replies:
    4
    Views:
    5,963
  2. vinay
    Replies:
    4
    Views:
    16,160
    vinay
    Jul 28, 2006
  3. Jim Isaacson
    Replies:
    5
    Views:
    603
    Default User
    Nov 5, 2004
  4. Hishaam
    Replies:
    1
    Views:
    431
    Eddie Corns
    Aug 13, 2008
  5. Carcarius
    Replies:
    0
    Views:
    292
    Carcarius
    Dec 6, 2007
Loading...

Share This Page