Velocity Reviews - Computer Hardware Reviews

Velocity Reviews > Newsgroups > Programming > Perl > Perl Misc > Net::Telnet - Library Application

Reply
Thread Tools

Net::Telnet - Library Application

 
 
Carl Lafferty
Guest
Posts: n/a
 
      07-16-2006
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
 
Reply With Quote
 
 
 
 
Dr.Ruud
Guest
Posts: n/a
 
      07-16-2006
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."


 
Reply With Quote
 
 
 
 
Carl Lafferty
Guest
Posts: n/a
 
      07-17-2006
>
> ($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!!!!!!!


 
Reply With Quote
 
robic0
Guest
Posts: n/a
 
      07-17-2006
On Sun, 16 Jul 2006 19:03:43 -0400, Carl Lafferty <(E-Mail Removed)> 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";

 
Reply With Quote
 
Stephan Titard
Guest
Posts: n/a
 
      07-17-2006
robic0 escribió:
> On Sun, 16 Jul 2006 19:03:43 -0400, Carl Lafferty <(E-Mail Removed)> 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

 
Reply With Quote
 
Joe Smith
Guest
Posts: n/a
 
      07-17-2006
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?
 
Reply With Quote
 
Dr.Ruud
Guest
Posts: n/a
 
      07-17-2006
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."


 
Reply With Quote
 
Stephan Titard
Guest
Posts: n/a
 
      07-17-2006
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
 
Reply With Quote
 
Stephan Titard
Guest
Posts: n/a
 
      07-17-2006
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
 
Reply With Quote
 
Carl Lafferty
Guest
Posts: n/a
 
      07-17-2006
>>
> 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.

 
Reply With Quote
 
 
 
Reply

Thread Tools

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Static library Vs. Dynamic library iceColdFire C++ 3 05-17-2005 06:16 AM
Dynamic Library or Static Library under Linux gouqizi.lvcha@gmail.com C++ 6 05-10-2005 03:16 PM
Re: Difference between Web Control Library and Class Library Alan Ferrandiz [MCT] ASP .Net 0 09-11-2004 01:51 PM
Re: Difference between Web Control Library and Class Library Mythran ASP .Net 0 08-24-2004 05:53 PM
Library in library... Sweep C++ 1 12-09-2003 04:12 AM



Advertisments