Convert sh/wm7d command to AsyncMsg.
Modify all the HTTPMsg converted cmds to use AsyncMsg.
Add a 'raw' 'telnet' handler. This allows one to query things with command
prompts or stuff that isn't a HTTP server. But it ain't always easy. See the
messing around in sh/wm7d I had to do, to get something that is stable given
that the thing that I am looking doesn't have a \n at the end.
It's just a prompt.
dbg("sh/contest: url=$url") if isdbg("contest");
- my $r = HTTPMsg->get($self->call, $host, $port, $url);
+ my $r = AsyncMsg->get($self->call, $host, $port, $url, prefix=>'ctst> ');
if ($r) {
push @out, $self->msg('m21', "show/contest");
}
dbg("IK3QAR: url=$path") if isdbg('ik3qar');
Log('call', "$call: SH/IK3QAR $line");
- my $r = HTTPMsg->get($self->call, $target, $port, $path);
+ my $r = AsyncMsg->get($self, $target, $port, $path, prefix=>'qar> ',
+ 'User-Agent' => "DxSpider;$main::version;$main::build;$^O;$main::mycall;$call");
if ($r) {
push @out, $self->msg('m21', "show/ik3qar");
} else {
#
#
+use Minimuf;
+
my ($self, $line) = @_;
my @f = split /\s+/, $line;
#
# Query the WM7D Database server for a callsign
#
-# Largely based on "sh/qrz" and info in the Net::Telnet documentation
+# Was Largely based on "sh/qrz" and info in the Net::Telnet documentation
#
-# Copyright (c) 2002 Charlie Carroll K1XX
+# Original Copyright (c) 2002 Charlie Carroll K1XX
#
+# Async version (c) Dirk Koopman G1TLH
#
-#
-use Net::Telnet;
+
+sub waitfor
+{
+ my $conn = shift;
+ my $msg = shift;
+ $msg =~ s/\cM//g;
+
+ my $buf = $conn->{msg};
+ $buf =~ s/\r/\\r/g;
+ $buf =~ s/\n/\\n/g;
+ dbg "state $conn->{state} '$msg' '$buf'";
+
+ if ($conn->{state} eq 'waitfor') {
+ if ($msg =~ /utc$/ ) {
+ $conn->send_later("$conn->{target_call}\n");
+ $conn->{state} = 'working';
+ }
+ } elsif ($conn->{state} eq 'working') {
+ if ($conn->{msg} =~ /^\rquery->\s*$/) {
+ $conn->send_later("QUIT\n");
+ $conn->{state} = 'ending';
+ }
+ return if $msg =~ /^query->/;
+ $conn->handle_raw($msg);
+ } else {
+ return if $msg =~ /^query->/ || $msg =~ /bye/;
+ $conn->handle_raw($msg);
+ }
+}
# wm7d accepts only single callsign
sub handle
my $call = $self->call;
my @out;
+# $DB::single = 1;
+
+
# send 'e24' if allow in Internet.pm is not set to 1
return (1, $self->msg('e24')) unless $Internet::allow;
return (1, "SHOW/WM7D <callsign>, e.g. SH/WM7D k1xx") unless $line;
my $port = 5000;
my $cmdprompt = '/query->.*$/';
- my($info, $t);
-
- $t = new Net::Telnet;
- $info = $t->open(Host => $target,
- Port => $port,
- Timeout => 20);
+ Log('call', "$call: show/wm7d \U$line");
- if (!$info) {
+ my $conn = AsyncMsg->raw($self, $target, $port,
+ handler => \&waitfor, prefix=>'wm7d> ');
+ if ($conn) {
+ $conn->{state} = 'waitfor';
+ $conn->{target_call} = $line;
+
+ push @out, $self->msg('m21', "show/wm7d");
+ } else {
push @out, $self->msg('e18', 'WM7D.net');
}
- else {
- ## Wait for prompt and respond with callsign.
- $t->waitfor($cmdprompt);
- $t->print($line);
- ($info) = $t->waitfor($cmdprompt);
-
- # Log the lookup
- Log('call', "$call: show/wm7d \U$line");
- $t->close;
- push @out, split /[\r\n]+/, $info;
- }
+
return (1, @out);
}
--- /dev/null
+#
+# This class is the internal subclass that does various Async connects and
+# retreivals of info. Typical uses (and specific support) include http get and
+# post.
+#
+# This merely starts up a Msg handler (and no DXChannel) ($conn in other words)
+# does the GET, parses out the result and the data and then (assuming a positive
+# result and that the originating callsign is still online) punts out the data
+# to the caller.
+#
+# It isn't designed to be very clever.
+#
+# Copyright (c) 2013 - Dirk Koopman G1TLH
+#
+
+package AsyncMsg;
+
+use Msg;
+use DXDebug;
+use DXUtil;
+use DXChannel;
+
+use vars qw(@ISA $deftimeout);
+
+@ISA = qw(Msg);
+$deftimeout = 15;
+
+my %outstanding;
+
+#
+# standard http get handler
+#
+sub handle_get
+{
+ my $conn = shift;
+ my $msg = shift;
+
+ my $state = $conn->{state};
+
+ dbg("asyncmsg: $msg") if isdbg('async');
+
+ # no point in going on if there is no-one wanting the output anymore
+ my $dxchan = DXChannel::get($conn->{caller});
+ unless ($dxchan) {
+ $conn->disconnect;
+ return;
+ }
+
+ if ($state eq 'waitreply') {
+ # look at the reply code and decide whether it is a success
+ my ($http, $code, $ascii) = $msg =~ m|(HTTP/\d\.\d)\s+(\d+)\s+(.*)|;
+ if ($code == 200) {
+ # success
+ $conn->{state} = 'waitblank';
+ } else {
+ $dxchan->send("$code $ascii");
+ $conn->disconnect;
+ }
+ } elsif ($state eq 'waitblank') {
+ unless ($msg) {
+ $conn->{state} = 'indata';
+ }
+ } else {
+ if (my $filter = $conn->{filter}) {
+ no strict 'refs';
+ # this will crash if the command has been redefined and the filter is a
+ # function defined there whilst the request is in flight,
+ # but this isn't exactly likely in a production environment.
+ $filter->($conn, $msg, $dxchan);
+ } else {
+ my $prefix = $conn->{prefix} || '';
+ $dxchan->send("$prefix$msg");
+ }
+ }
+}
+
+#
+# simple raw handler
+#
+# Just outputs everything
+#
+sub handle_raw
+{
+ my $conn = shift;
+ my $msg = shift;
+
+ # no point in going on if there is no-one wanting the output anymore
+ my $dxchan = DXChannel::get($conn->{caller});
+ unless ($dxchan) {
+ $conn->disconnect;
+ return;
+ }
+
+ # send out the data
+ my $prefix = $conn->{prefix} || '';
+ $dxchan->send("$prefix$msg");
+}
+
+sub new
+{
+ my $pkg = shift;
+ my $call = shift;
+ my $handler = shift;
+
+ my $conn = $pkg->SUPER::new($handler);
+ $conn->{caller} = ref $call ? $call->call : $call;
+
+ # make it persistent
+ $outstanding{$conn} = $conn;
+
+ return $conn;
+}
+
+# This does a http get on a path on a host and
+# returns the result (through an optional filter)
+#
+# expects to be called something like from a cmd.pl file:
+#
+# AsyncMsg->get($self, <host>, <port>, <path>, [<key=>value>...]
+#
+# Standard key => value pairs are:
+#
+# filter => CODE ref (e.g. sub { ... })
+# prefix => <string> prefix output with this string
+#
+# Anything else is taken and sent as (extra) http header stuff e.g:
+#
+# 'User-Agent' => qq{DXSpider;$main::version;$main::build;$^O}
+# 'Content-Type' => q{text/xml; charset=utf-8}
+# 'Content-Length' => $lth
+#
+# Host: is always set to the name of the host (unless overridden)
+# User-Agent: is set to default above (unless overridden)
+#
+sub get
+{
+ my $pkg = shift;
+ my $call = shift;
+ my $host = shift;
+ my $port = shift;
+ my $path = shift;
+ my %args = @_;
+
+ my $filter = shift;
+
+ my $conn = $pkg->new($call, \&handle_get);
+ $conn->{state} = 'waitreply';
+ $conn->{filter} = delete $args{filter} if exists $args{filter};
+ $conn->{prefix} = delete $args{prefix} if exists $args{prefix};
+ $conn->{path} = $path;
+
+ $r = $conn->connect($host, $port);
+ if ($r) {
+ dbg("Sending 'GET $path HTTP/1.0'") if isdbg('async');
+ $conn->send_later("GET $path HTTP/1.0\n");
+ my $h = delete $args{Host} || $host;
+ my $u = delete $args{'User-Agent'} || "DxSpider;$main::version;$main::build;$^O;$main::mycall";
+ $conn->send_later("Host: $h\n");
+ $conn->send_later("User-Agent: $u\n");
+ while (my ($k,$v) = each %args) {
+ $conn->send_later("$k: $v\n");
+ }
+ $conn->send_later("\n");
+ }
+
+ return $r ? $conn : undef;
+}
+
+# do a raw connection
+#
+# Async->raw($self, <host>, <port>, [handler => CODE ref], [prefix => <string>]);
+#
+# With no handler defined, everything sent by the connection will be sent to
+# the caller.
+#
+# One can send stuff out on the connection by doing a standard "$conn->send_later(...)"
+# inside the (custom) handler.
+
+sub raw
+{
+ my $pkg = shift;
+ my $call = shift;
+ my $host = shift;
+ my $port = shift;
+
+ my %args = @_;
+
+ my $handler = delete $args{handler} || \&handle_raw;
+ my $conn = $pkg->new($call, $handler);
+ $conn->{prefix} = delete $args{prefix} if exists $args{prefix};
+ $r = $conn->connect($host, $port);
+ return $r ? $conn : undef;
+}
+
+sub connect
+{
+ my $conn = shift;
+ my $host = shift;
+ my $port = shift;
+
+ # start a connection
+ my $r = $conn->SUPER::connect($host, $port);
+ if ($r) {
+ dbg("HTTPMsg: Connected $conn->{cnum} to $host $port") if isdbg('async');
+ } else {
+ dbg("HTTPMsg: ***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('async');
+ }
+
+ return $r;
+}
+
+sub disconnect
+{
+ my $conn = shift;
+ delete $outstanding{$conn};
+ $conn->SUPER::disconnect;
+}
+
+sub DESTROY
+{
+ my $conn = shift;
+ delete $outstanding{$conn};
+ $conn->SUPER::DESTROY;
+}
+
+1;
+
use DB_File;
use VE7CC;
use DXXml;
-use HTTPMsg;
+use AsyncMsg;
use strict;
use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase %nothereslug
};
#wrap the code into a subroutine inside our unique package
- my $eval = qq(package DXCommandmode::$package; use POSIX qw{:math_h}; use DXLog; use DXDebug; use DXUser; use DXUtil; use Minimuf; use Sun; use HTTPMsg; our \@ISA = qw{DXCommandmode}; );
+ my $eval = qq(package DXCommandmode::$package; use POSIX qw{:math_h}; use DXLog; use DXDebug; use DXUser; use DXUtil; our \@ISA = qw{DXCommandmode}; );
if ($sub =~ m|\s*sub\s+handle\n|) {
+++ /dev/null
-#
-# This class is the internal subclass that does the equivalent of a
-# GET http://<some site>/<some path> and passes the result back to the caller.
-#
-# This merely starts up a Msg handler (and no DXChannel) ($conn in other words)
-# does the GET, parses out the result and the data and then (assuming a positive
-# result and that the originating callsign is still online) punts out the data
-# to the caller.
-#
-# It isn't designed to be very clever.
-#
-# Copyright (c) 2013 - Dirk Koopman G1TLH
-#
-
-package HTTPMsg;
-
-use Msg;
-use DXDebug;
-use DXUtil;
-use DXChannel;
-
-use vars qw(@ISA $deftimeout);
-
-@ISA = qw(Msg);
-$deftimeout = 15;
-
-my %outstanding;
-
-sub handle
-{
- my $conn = shift;
- my $msg = shift;
-
- my $state = $conn->{state};
-
- dbg("httpmsg: $msg") if isdbg('http');
-
- # no point in going on if there is no-one wanting the output anymore
- my $dxchan = DXChannel::get($conn->{caller});
- return unless $dxchan;
-
- if ($state eq 'waitreply') {
- # look at the reply code and decide whether it is a success
- my ($http, $code, $ascii) = $msg =~ m|(HTTP/\d\.\d)\s+(\d+)\s+(.*)|;
- if ($code == 200) {
- # success
- $conn->{state} = 'waitblank';
- } else {
- $dxchan->send("$code $ascii");
- $conn->disconnect;
- }
- } elsif ($state eq 'waitblank') {
- unless ($msg) {
- $conn->{state} = 'indata';
- }
- } else {
- if (my $filter = $conn->{filter}) {
- no strict 'refs';
- # this will crash if the command has been redefined and the filter is a
- # function defined there whilst the request is in flight,
- # but this isn't exactly likely in a production environment.
- $filter->($conn, $msg, $dxchan);
- } else {
- $dxchan->send($msg);
- }
- }
-}
-
-sub get
-{
- my $pkg = shift;
- my $call = shift;
- my $host = shift;
- my $port = shift;
- my $path = shift;
- my $filter = shift;
-
- my $conn = $pkg->new(\&handle);
- $conn->{caller} = $call;
- $conn->{state} = 'waitreply';
- $conn->{host} = $host;
- $conn->{port} = $port;
- $conn->{filter} = $filter if $filter;
-
- # make it persistent
- $outstanding{$conn} = $conn;
-
- $r = $conn->connect($host, $port);
- if ($r) {
- dbg("Sending 'GET $path HTTP/1.0'") if isdbg('http');
- $conn->send_later("GET $path HTTP/1.0\nHost: $host\nUser-Agent: DxSpider;$main::version;$main::build;$^O;$main::mycall;$call\n\n");
- }
-
- return $r;
-}
-
-sub connect
-{
- my $conn = shift;
- my $host = shift;
- my $port = shift;
-
- # start a connection
- my $r = $conn->SUPER::connect($host, $port);
- if ($r) {
- dbg("HTTPMsg: Connected $conn->{cnum} to $host $port") if isdbg('http');
- } else {
- dbg("HTTPMsg: ***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('http');
- }
-
- return $r;
-}
-
-sub disconnect
-{
- my $conn = shift;
- delete $outstanding{$conn};
- $conn->SUPER::disconnect;
-}
-
-sub DESTROY
-{
- my $conn = shift;
- delete $outstanding{$conn};
- $conn->SUPER::DESTROY;
-}
-
-1;
-
my $conn = shift;
return if $conn->{disconnecting};
- if ($conn->{msg} =~ /\n/) {
- my @lines = split /\r?\n/, $conn->{msg};
- if ($conn->{msg} =~ /\n$/) {
+ if ($conn->{msg} =~ /\cJ/) {
+ my @lines = split /\cM?\cJ/, $conn->{msg};
+ if ($conn->{msg} =~ /\cM?\cJ$/) {
delete $conn->{msg};
} else {
$conn->{msg} = pop @lines;
$version = '1.55';
$subversion = '0';
-$build = '125';
-$gitversion = 'a554922';
+$build = '128';
+$gitversion = '1ec21f9';
1;
projects / spider.git / commitdiff