From 4ae3641339d8511e0b458bc6eacd287339c70cb2 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Mon, 16 Jun 2014 18:15:21 +0100 Subject: [PATCH] sh/qrz now working correctly with mojo --- Changes | 2 + cmd/show/db0sdx.pl | 2 +- cmd/show/qrz.pl | 4 +- perl/AsyncMsg.pm | 189 ++++++++++++++++++++------------------------- 4 files changed, 87 insertions(+), 110 deletions(-) diff --git a/Changes b/Changes index c62c1567..b4741006 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,5 @@ +16Jun14======================================================================= +1. Get AsyncMsg working for HTTP type ephemeral connections 21Apr14======================================================================= 1. Add CTY-2405 prefix list 08Mar14======================================================================= diff --git a/cmd/show/db0sdx.pl b/cmd/show/db0sdx.pl index 370b0b7f..b7574761 100644 --- a/cmd/show/db0sdx.pl +++ b/cmd/show/db0sdx.pl @@ -72,7 +72,7 @@ sub handle my $lth = length($s)+1; Log('call', "$call: show/db0sdx $line"); - my $conn = AsyncMsg->post($self, $target, $port, "$path$suffix", prefix => 'sdx> ', filter => \&process, + my $conn = AsyncMsg->post($self, $target, "$path$suffix", prefix => 'sdx> ', filter => \&process, 'Content-Type' => 'text/xml; charset=utf-8', 'Content-Length' => $lth, Connection => 'Close', diff --git a/cmd/show/qrz.pl b/cmd/show/qrz.pl index 6782b1a1..9a7d921f 100644 --- a/cmd/show/qrz.pl +++ b/cmd/show/qrz.pl @@ -67,13 +67,13 @@ sub handle return (1, $self->msg('e24')) unless $Internet::allow; return (1, "SHOW/QRZ , e.g. SH/QRZ g1tlh") unless $line; - my $target = $Internet::qrz_url || 'xmldata.qrz.com'; + my $target = $Internet::qrz_url || 'xml.qrz.com'; my $port = 80; my $path = qq{/xml/current/?callsign=$line;username=$Internet::qrz_uid;password=$Internet::qrz_pw;agent=dxspider}; dbg("qrz: $target:$port$path") if isdbg('qrz'); Log('call', "$call: show/qrz \U$line"); - my $conn = AsyncMsg->get($self, $target, $port, $path, filter=>\&filter, prefix=>'qrz> ', on_disc=>\&_on_disc); + my $conn = AsyncMsg->get($self, $target, $path, filter=>\&filter, prefix=>'qrz> ', on_disc=>\&_on_disc); if ($conn) { $conn->{state} = 'blank'; push @out, $self->msg('m21', "show/qrz"); diff --git a/perl/AsyncMsg.pm b/perl/AsyncMsg.pm index fe04f822..cb087876 100644 --- a/perl/AsyncMsg.pm +++ b/perl/AsyncMsg.pm @@ -27,17 +27,24 @@ $deftimeout = 15; my %outstanding; -# -# standard http get handler -# -sub handle_get +sub new { - my $conn = shift; - my $msg = shift; + my $pkg = shift; + my $call = shift; + my $handler = shift; + + my $conn = $pkg->SUPER::new($handler); + $conn->{caller} = ref $call ? $call->call : $call; - my $state = $conn->{_asstate}; + # make it persistent + $outstanding{$conn} = $conn; - dbg("asyncmsg: $state $msg") if isdbg('async'); + return $conn; +} + +sub handle_getpost +{ + my ($conn, $ua, $tx) = @_; # no point in going on if there is no-one wanting the output anymore my $dxchan = DXChannel::get($conn->{caller}); @@ -46,48 +53,11 @@ sub handle_get 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->{_asstate} = 'waitblank'; - } elsif ($code == 302) { - # redirect - $conn->{_asstate} = 'waitlocation'; - } else { - $dxchan->send("$code $ascii"); - $conn->disconnect; - } - } elsif ($state eq 'waitlocation') { - my ($path) = $msg =~ m|Location:\s*(.*)|; - if ($path) { - my $newconn; - my @uri = split m|/+|, $path; - if ($uri[0] eq 'http:') { - shift @uri; - my $host = shift @uri; - my $newpath = '/' . join('/', @uri); - $newpath .= '/' if $path =~ m|/$|; - $newconn = _getpost(ref $conn, $conn->{_assort}, $conn->{caller}, $host, 80, $newpath, @{$conn->{_asargs}}); - } elsif ($path =~ m|^/|) { - $newconn = _getpost(ref $conn, $conn->{_assort}, $conn->{caller}, $conn->{peerhost}, $conn->{peerport}, $path, @{$conn->{_asargs}}); - } - if ($newconn) { - # copy over any elements in $conn that are not in $newconn - while (my ($k,$v) = each %$conn) { - dbg("async: $state copying over $k -> \$newconn") if isdbg('async'); - $newconn{$k} = $v unless exists $newconn{$k}; - } - } - delete $conn->{on_disconnect}; - $conn->disconnect; - } - } elsif ($state eq 'waitblank') { - unless ($msg) { - $conn->{_asstate} = 'indata'; - } - } elsif ($conn->{_asstate} eq 'indata') { + my @lines = split qr{\r?\n}, $tx->res->body; + + foreach my $msg(@lines) { + dbg("AsyncMsg: $conn->{_asstate} $msg") if isdbg('async'); + if (my $filter = $conn->{_asfilter}) { no strict 'refs'; # this will crash if the command has been redefined and the filter is a @@ -99,43 +69,8 @@ sub handle_get $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; + $conn->disconnect; } # This does a http get on a path on a host and @@ -165,46 +100,62 @@ sub _getpost my $sort = shift; my $call = shift; my $host = shift; - my $port = shift; my $path = shift; my %args = @_; - my $conn = $pkg->new($call, \&handle_get); + my $conn = $pkg->new($call); $conn->{_asargs} = [@_]; $conn->{_asstate} = 'waitreply'; $conn->{_asfilter} = delete $args{filter} if exists $args{filter}; $conn->{prefix} = delete $args{prefix} if exists $args{prefix}; + $conn->{prefix} ||= ''; $conn->{on_disconnect} = delete $args{on_disc} || delete $args{on_disconnect}; $conn->{path} = $path; - $conn->{host} = $host; - $conn->{port} = $port; + $conn->{host} = $conn->{peerhost} = $host; + $conn->{port} = $conn->{peerport} = delete $args{port} || 80; + $conn->{sort} = 'outgoing'; $conn->{_assort} = $sort; + $conn->{csort} = 'http'; + + my $ua = Mojo::UserAgent->new; + my $s; + $s .= $host; + $s .= ":$port" unless $conn->{port} == 80; + $s .= $path; + dbg("AsyncMsg: $sort $s") if isdbg('async'); - $r = $conn->connect($host, $port, on_connect=>sub {$conn->_on_getpost_connect(@_)}); + my $tx = $ua->build_tx($sort => $s); + $ua->on(error => sub { $conn->_error(@_); }); +# $tx->on(error => sub { $conn->_error(@_); }); +# $tx->on(finish => sub { $conn->disconnect; }); + + $ua->start($tx => sub { $conn->handle_getpost(@_) }); + - return $r ? $conn : undef; + $conn->{mojo} = $ua; + return $conn if $tx; + + $conn->disconnect; + return undef; } -sub _on_getpost_connect +sub _dxchan_send { my $conn = shift; - - dbg("Sending '$conn->{_assort} $conn->{path} HTTP/1.0'") if isdbg('async'); - $conn->send_later("$conn->{_assort} $conn->{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"; - my $d = delete $args{data}; - - $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$d") if defined $d; + my $msg = shift; + my $dxchan = DXChannel::get($conn->{caller}); + $dxchan->send($msg) if $dxchan; } +sub _error +{ + my ($conn, $e, $err); + dbg("Async: $conn->host:$conn->port path $conn->{path} error $err") if isdbg('chan'); + $conn->_dxchan_send("$conn->{prefix}$msg"); + $conn->disconnect; +} + sub get { my $pkg = shift; @@ -239,10 +190,33 @@ sub raw my $handler = delete $args{handler} || \&handle_raw; my $conn = $pkg->new($call, $handler); $conn->{prefix} = delete $args{prefix} if exists $args{prefix}; + $conn->{prefix} ||= ''; $r = $conn->connect($host, $port, on_connect => &_on_raw_connect); return $r ? $conn : undef; } +# +# 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 + $dxchan->send("$conn->{prefix}$msg"); +} + + sub _on_raw_connect { my $conn = shift; @@ -280,6 +254,7 @@ sub disconnect $ondisc->($conn, $dxchan) } } + delete $conn->{mojo}; delete $outstanding{$conn}; $conn->SUPER::disconnect; } -- 2.43.0