perlquestion
Dru
Greetings Monks,<br><br>
Recently, I was given the task of finding all modems at my companies location. I've used the war dialer <a href="http://www.securityfocus.com/tools/47/scoreit" taget="_blank">THC-Scan</a> in the past with good results, but for some reason this time I went to use it and it failed to detect any modems even when they where present. I tried the other popular dialer <a href="http://www.securityfocus.com/tools/48" target="_blank">Toneloc</a>, but I could not get it working correctly. <br><br>
I then thought "I wonder if there is a Perl module that will help me roll my own." And sure enough, I found [cpan://Win32::SerialPort]. Hacking an <a href="http://members.aol.com/Bbirthisel/pager_files.txt" target="_blank">example</a> from the author's site, I was able to get almost what I wanted. When it detects a modem, I receive the following: <code>Output: Got ."ATDT123456789</code>, which is great since I can just send all the output to a file and just parse on ATDT to get a list of modems.<br><br>
But knowing my manager, he's going to ask "Is there anyway to tell if they are faxes or not." Since faxes sound distinctively different, I'm wondering if this is possible?
<br><br>
Any help is much appreciated,<br>
Dru
<code>
# The majority of this code is borrowed from:
# http://members.aol.com/Bbirthisel/pager_files.txt
# I just removed the parts to let it run unattended.
use Win32::SerialPort;
use strict;
use warnings;
my ($line, $port, $port_obj, $string, $timeout);
my $paging_service = "123456789"; # Supply real number here
my $debug = 1;
$port = 'COM3';
# Open port with previously saved configuration
$port_obj = start Win32::SerialPort ("pager_$port.cfg")
|| die "Can't open pager_$port.cfg: $^E\n";
print STDERR "Dialing Number: \"$paging_service\"\n" if $debug;
# You probably need at least BUSY and CONNECT
$port_obj->are_match("BUSY","CONNECT","OK",
"NO DIALTONE","ERROR","RING","NO CARRIER","NO ANSWER");
# my modem resets to give verbose responses
$port_obj->write("ATZ\r") || die "Could Not Reset\n";
# Check Modem responding to reset
# 5 second timeout from config file
waitfor() || die "Modem Did Not Reset\n";
# Timeouts will need adjustment for dfferent services and locations.
# Must give the receiving modem a few seconds to pickup and negotiate.
$port_obj->read_const_time(30000);
my $retries = 0;
for (;;) {
$port_obj->write("ATDT$paging_service\r")
|| die "Could Not Dial\n";
# Dial Paging service
my $diallog = waitfor();
die "Dial timed out or failed\n" unless (defined $diallog);
last if ($diallog eq "CONNECT");
if ((++$retries < 5) && ($diallog eq "BUSY")) {
sleep 1; # adjust as required
next;
}
die "Dial did not connect properly: $diallog\n"
}
$port_obj->write("\r\r");
# Hit enter when connected
$port_obj->read_const_time(10000);
$port_obj->read_const_time(5000);
## waitfor("Goodbye\r") || die "Missing signoff from service\n";
waitfor("Goodbye") || die "Missing signoff from service\n";
$port_obj->close;
# Close port
sub waitfor {
$port_obj->lookclear; # clear buffers
my $gotit = "";
my $response = shift;
if ($response) {
$port_obj->are_match($response);
print "Output: Waiting for \"$response\".\n" if $debug;
}
else {
print "Output: Waiting for \"are_match()\".\n" if $debug;
}
for (;;) {
return unless (defined ($gotit = $port_obj->lookfor(1)));
if ($gotit ne "") {
my ($match, $after, $pattern) = $port_obj->lastlook;
print "Output: Got .\"$gotit$match$after\".\n" if $debug;
return $match;
}
return if ($port_obj->reset_error);
}
}
</code>