Net::Telnet - Library Application

[Carl Lafferty]

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

 

[Dr.Ruud]

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)

 

[Carl Lafferty]

($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!!!!!!!

 

[robic0]

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";

 

[Stephan Titard]

robic0 escribió:

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

 

[Joe Smith]

robic0 escribió:

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?

 

[Dr.Ruud]

Carl Lafferty schreef:

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.

 

[Stephan Titard]

Joe Smith escribió:

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]

Carl Lafferty escribió:

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

 

[Carl Lafferty]

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]

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]

Carl Lafferty schreef:


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'....

 

[Peter J. Holzer]

Joe Smith escribió:
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

 

[robic0]

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

 

[Carl Lafferty]

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]

/$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]

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.

 

[robic0]

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]

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

 

[Carl Lafferty]

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.