X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FExtMsg.pm;h=b39637d10e2af6f243eb580a6cbd814041ff24a1;hb=4f3bdfa16cf0d5adf08ef13fc06384e39db485c6;hp=8772955350f78c72381c37a3d2b4dcf95210c74e;hpb=586cbb347e7639f5575b48572e75140501a109c0;p=spider.git diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 87729553..b39637d1 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -19,6 +19,7 @@ use DXUtil; use DXDebug; use IO::File; use IO::Socket; +use IPC::Open2; use vars qw(@ISA $deftimeout); @@ -58,6 +59,9 @@ sub dequeue my $conn = shift; my $msg; + if ($conn->{csort} eq 'ax25' && exists $conn->{msg}) { + $conn->{msg} =~ s/\cM/\cJ/g; + } if ($conn->{state} eq 'WC') { if (exists $conn->{cmd}) { if (@{$conn->{cmd}}) { @@ -66,14 +70,11 @@ sub dequeue } } if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) { - $conn->{state} = 'C'; - &{$conn->{rproc}}($conn, "O$conn->{call}|telnet"); - delete $conn->{cmd}; - $conn->{timeout}->del if $conn->{timeout}; + $conn->to_connected($conn->{call}, 'O', 'telnet'); } - } elsif ($conn->{msg} =~ /\n/) { - my @lines = split /\r?\n/, $conn->{msg}; - if ($conn->{msg} =~ /\n$/) { + } elsif ($conn->{msg} =~ /\cJ/) { + my @lines = $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g; + if ($conn->{msg} =~ /\cJ$/) { delete $conn->{msg}; } else { $conn->{msg} = pop @lines; @@ -89,9 +90,7 @@ sub dequeue } elsif ($conn->{state} eq 'WL' ) { $msg = uc $msg; if (is_callsign($msg)) { - &{$conn->{rproc}}($conn, "A$msg|telnet"); - _send_file($conn, "$main::data/connected"); - $conn->{state} = 'C'; + $conn->to_connected($msg, 'A', 'telnet'); } else { $conn->send_now("Sorry $msg is an invalid callsign"); $conn->disconnect; @@ -100,10 +99,7 @@ sub dequeue if (exists $conn->{cmd} && @{$conn->{cmd}}) { $conn->_docmd($msg); if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) { - $conn->{state} = 'C'; - &{$conn->{rproc}}($conn, "O$conn->{call}|telnet"); - delete $conn->{cmd}; - $conn->{timeout}->del if $conn->{timeout}; + $conn->to_connected($conn->{call}, 'O', 'telnet'); } } } @@ -111,6 +107,18 @@ sub dequeue } } +sub to_connected +{ + my ($conn, $call, $dir, $sort) = @_; + $conn->{state} = 'C'; + $conn->conns($call); + delete $conn->{cmd}; + $conn->{timeout}->del if $conn->{timeout}; + delete $conn->{timeout}; + $conn->_send_file("$main::data/connected"); + &{$conn->{rproc}}($conn, "$dir$call|$sort"); +} + sub new_client { my $server_conn = shift; my $sock = $server_conn->{sock}->accept(); @@ -120,7 +128,7 @@ sub new_client { my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $sock->peerhost(), $conn->{peerport} = $sock->peerport()); if ($eproc) { $conn->{eproc} = $eproc; - set_event_handler ($sock, "error" => $eproc); + Msg::set_event_handler ($sock, "error" => $eproc); } if ($rproc) { $conn->{rproc} = $rproc; @@ -131,8 +139,9 @@ sub new_client { # $conn->send_raw("\xff\xfe\x01\xff\xfc\x01\ff\fd\x22"); # $conn->send_raw("\xff\xfa\x22\x01\x01\xff\xf0"); # $conn->send_raw("\xFF\xFC\x01"); - _send_file($conn, "$main::data/issue"); + $conn->_send_file("$main::data/issue"); $conn->send_raw("login: "); + $conn->_dotimeout(60); } else { $conn->disconnect(); } @@ -142,7 +151,7 @@ sub start_connect { my $call = shift; my $fn = shift; - my $conn = ExtMsg->new(\&main::rec); + my $conn = ExtMsg->new(\&main::new_channel); $conn->conns($call); my $f = new IO::File $fn; @@ -188,7 +197,8 @@ sub _doconnect { my ($conn, $sort, $line) = @_; my $r; - + + $sort = lc $sort; dbg('connect', "CONNECT sort: $sort command: $line"); if ($sort eq 'telnet') { # this is a straight network connect @@ -201,7 +211,20 @@ sub _doconnect dbg('connect', "***Connect Failed to $host $port $!"); } } elsif ($sort eq 'ax25' || $sort eq 'prog') { - ; + $conn->{sock} = new IO::File; + if ($conn->{sock}) { + my $outfd = fileno($conn->{sock}); + my $out = new IO::File ">&$outfd"; + if ($conn->{pid} = open2($conn->{sock}, $out, $line)) { + $conn->{csort} = $sort; + $conn->{lineend} = "\cM" if $sort eq 'ax25'; + dbg('connect', "started $line"); + } else { + dbg('connect', "can't start $line $!"); + } + } else { + dbg('connect', "can't start $line $!"); + } } else { dbg('err', "invalid type of connection ($sort)"); $conn->disconnect; @@ -222,9 +245,9 @@ sub _dotimeout my $conn = shift; my $val = shift; dbg('connect', "timeout set to $val"); - my $old = $conn->{timeout}->del if $conn->{timeout}; - $conn->{timeout} = Timer->new($val, sub{ &_timeout($conn) }); + $conn->{timeout}->del if $conn->{timeout}; $conn->{timeval} = $val; + $conn->{timeout} = Timer->new($val, sub{ &_timedout($conn) }); } sub _dolineend @@ -242,7 +265,7 @@ sub _dochat my $conn = shift; my $cmd = shift; my $line = shift; - + if ($line) { my ($expect, $send) = $cmd =~ /^\s*\'(.*)\'\s+\'(.*)\'/; if ($expect) { @@ -256,6 +279,7 @@ sub _dochat if ($line =~ /$expect/i) { dbg('connect', "got: \"$expect\" sending: \"$send\""); $conn->send_later($send); + delete $conn->{msg}; # get rid any input if a match return; } } @@ -264,10 +288,12 @@ sub _dochat unshift @{$conn->{cmd}}, $cmd; } -sub _timeout +sub _timedout { my $conn = shift; dbg('connect', "timed out after $conn->{timeval} seconds"); + $conn->{timeout}->del; + delete $conn->{timeout}; $conn->disconnect; } @@ -277,10 +303,11 @@ sub _doclient my $conn = shift; my $line = shift; my @f = split /\s+/, $line; - $conn->{call} = uc $f[0] if $f[0]; + my $call = uc $f[0] if $f[0]; + $conn->conns($call); $conn->{csort} = $f[1] if $f[1]; $conn->{state} = 'C'; - &{$conn->{rproc}}($conn, "O$conn->{call}|telnet"); + &{$conn->{rproc}}($conn, "O$call|telnet"); delete $conn->{cmd}; $conn->{timeout}->del if $conn->{timeout}; }