X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FAMsg.pm;fp=perl%2FAMsg.pm;h=19fe9208818f28a075e6264fcb9353059c11566a;hb=6f20114b034d329c1e2a4f91f0aba2f6ec4002d4;hp=06d281d13f95e89292503e37a0c03d22eac5fbab;hpb=72dc0f2eeecaf78902acacb9d183b7f9215dd385;p=spider.git diff --git a/perl/AMsg.pm b/perl/AMsg.pm index 06d281d1..19fe9208 100644 --- a/perl/AMsg.pm +++ b/perl/AMsg.pm @@ -4,19 +4,22 @@ # # $Id$ # -# Copyright (c) 2001 - Dirk Koopman G1TLH +# Copyright (c) 2005 - Dirk Koopman G1TLH # +use strict; + package AMsg; -use strict; use Msg; use DXVars; use DXUtil; use DXDebug; -use IO::File; -use IO::Socket; -use IPC::Open3; +use Aranea; +use Verify; +use DXLog; +use Thingy; +use Thingy::Hello; use vars qw($VERSION $BRANCH); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); @@ -26,41 +29,13 @@ $main::branch += $BRANCH; use vars qw(@ISA $deftimeout); -@ISA = qw(ExtMsg); +@ISA = qw(ExtMsg Msg); $deftimeout = 60; sub enqueue { my ($conn, $msg) = @_; - unless ($msg =~ /^[ABZ]/) { - if ($msg =~ /^E[-\w]+\|([01])/ && $conn->{csort} eq 'telnet') { - $conn->{echo} = $1; - if ($1) { -# $conn->send_raw("\xFF\xFC\x01"); - } else { -# $conn->send_raw("\xFF\xFB\x01"); - } - } else { - $msg =~ s/^[-\w]+\|//; - push (@{$conn->{outqueue}}, $msg . $conn->{lineend}); - } - } -} - -sub send_raw -{ - my ($conn, $msg) = @_; - my $sock = $conn->{sock}; - return unless defined($sock); - push (@{$conn->{outqueue}}, $msg); - dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); - Msg::set_event_handler ($sock, "write" => sub {$conn->_send(0)}); -} - -sub echo -{ - my $conn = shift; - $conn->{echo} = shift; + push (@{$conn->{outqueue}}, $msg . $conn->{lineend}); } sub dequeue @@ -71,7 +46,7 @@ sub dequeue if ($conn->{csort} eq 'ax25' && exists $conn->{msg}) { $conn->{msg} =~ s/\cM/\cJ/g; } - if ($conn->{state} eq 'WC') { + if ($conn->{state} eq 'WC' ) { if (exists $conn->{cmd}) { if (@{$conn->{cmd}}) { dbg("connect $conn->{cnum}: $conn->{msg}") if isdbg('connect'); @@ -90,38 +65,13 @@ sub dequeue } while (defined ($msg = shift @lines)) { dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); - - $msg =~ s/\xff\xfa.*\xff\xf0|\xff[\xf0-\xfe].//g; # remove telnet options -# $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g; # immutable CSI sequence + control characters - if ($conn->{state} eq 'C') { - &{$conn->{rproc}}($conn, "I$conn->{call}|$msg"); - } elsif ($conn->{state} eq 'WL' ) { - $msg = uc $msg; - if (is_callsign($msg) && $msg !~ m|/| ) { - my $sort = $conn->{csort}; - $sort = 'local' if $conn->{peerhost} eq "127.0.0.1"; - my $uref; - if ($main::passwdreq || ($uref = DXUser->get_current($msg)) && $uref->passwd ) { - $conn->conns($msg); - $conn->{state} = 'WP'; - $conn->{decho} = $conn->{echo}; - $conn->{echo} = 0; - $conn->send_raw('password: '); - } else { - $conn->to_connected($msg, 'A', $sort); - } - } else { - $conn->send_now("Sorry $msg is an invalid callsign"); - $conn->disconnect; - } - } elsif ($conn->{state} eq 'WP' ) { + &{$conn->{rproc}}($conn, $msg); + } elsif ($conn->{state} eq 'WA' ) { my $uref = DXUser->get_current($conn->{call}); $msg =~ s/[\r\n]+$//; if ($uref && $msg eq $uref->passwd) { my $sort = $conn->{csort}; - $conn->{echo} = $conn->{decho}; - delete $conn->{decho}; $sort = 'local' if $conn->{peerhost} eq "127.0.0.1"; $conn->{usedpasswd} = 1; $conn->to_connected($conn->{call}, 'A', $sort); @@ -138,7 +88,7 @@ sub dequeue } } } - } + } } sub to_connected @@ -151,7 +101,141 @@ sub to_connected delete $conn->{timeout}; $conn->nolinger; &{$conn->{rproc}}($conn, "$dir$call|$sort"); - $conn->_send_file("$main::data/connected") unless $conn->{outgoing}; } +sub login +{ + return \&new_channel; +} +sub new_client { + my $server_conn = shift; + my $sock = $server_conn->{sock}->accept(); + if ($sock) { + my $conn = $server_conn->new($server_conn->{rproc}); + $conn->{sock} = $sock; + $conn->nolinger; + Msg::blocking($sock, 0); + $conn->{blocking} = 0; + eval {$conn->{peerhost} = $sock->peerhost}; + if ($@) { + dbg($@) if isdbg('connll'); + $conn->disconnect; + } else { + eval {$conn->{peerport} = $sock->peerport}; + $conn->{peerport} = 0 if $@; + my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost}, $conn->{peerport}); + dbg("accept $conn->{cnum} from $conn->{peerhost} $conn->{peerport}") if isdbg('connll'); + if ($eproc) { + $conn->{eproc} = $eproc; + Msg::set_event_handler ($sock, "error" => $eproc); + } + if ($rproc) { + $conn->{rproc} = $rproc; + my $callback = sub {$conn->_rcv}; + Msg::set_event_handler ($sock, "read" => $callback); + $conn->_dotimeout(60); + $conn->{echo} = 0; + } else { + &{$conn->{eproc}}() if $conn->{eproc}; + $conn->disconnect(); + } + Log('Aranea', "Incoming connection from $conn->{peerhost}"); + $conn->{outgoing} = 0; + $conn->{state} = 'WH'; # wait for return authorize + my $thing = $conn->{lastthing} = Thingy::Hello->new(origin=>$main::mycall, group=>'ROUTE'); + $thing->send($conn, 'Aranea'); + } + } else { + dbg("ExtMsg: error on accept ($!)") if isdbg('err'); + } +} + +sub start_connect +{ + my $call = shift; + my $fn = shift; + my $conn = AMsg->new(\&new_channel); + $conn->{outgoing} = 1; + $conn->conns($call); + + my $f = new IO::File $fn; + push @{$conn->{cmd}}, <$f>; + $f->close; + $conn->{state} = 'WC'; + $conn->_dotimeout($deftimeout); + $conn->_docmd; +} + +# +# happens next on receive +# + +sub new_channel +{ + my ($conn, $msg) = @_; + my $thing = Aranea::input($msg); + return unless defined $thing; + + my $call = $thing->{origin}; + unless (is_callsign($call)) { + main::already_conn($conn, $call, DXM::msg($main::lang, "illcall", $call)); + return; + } + + # set up the basic channel info + # is there one already connected to me - locally? + my $user = DXUser->get_current($call); + my $dxchan = DXChannel->get($call); + if ($dxchan) { + if ($main::bumpexisting) { + my $ip = $conn->{peerhost} || 'unknown'; + $dxchan->send_now('D', DXM::msg($main::lang, 'conbump', $call, $ip)); + Log('DXCommand', "$call bumped off by $ip, disconnected"); + dbg("$call bumped off by $ip, disconnected"); + $dxchan->disconnect; + } else { + main::already_conn($conn, $call, DXM::msg($main::lang, 'conother', $call, $main::mycall)); + return; + } + } + + # is he locked out ? + my $basecall = $call; + $basecall =~ s/-\d+$//; + my $baseuser = DXUser->get_current($basecall); + my $lock = $user->lockout if $user; + if ($baseuser && $baseuser->lockout || $lock) { + if (!$user || !defined $lock || $lock) { + my $host = $conn->{peerhost} || "unknown"; + Log('DXCommand', "$call on $host is locked out, disconnected"); + $conn->disconnect; + return; + } + } + + if ($user) { + $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems + } else { + $user = DXUser->new($call); + } + + # create the channel + $dxchan = Aranea->new($call, $conn, $user); + + # check that the conn has a callsign + $conn->conns($call) if $conn->isa('IntMsg'); + + # set callbacks + $conn->set_error(sub {main::error_handler($dxchan)}); + $conn->set_rproc(sub {my ($conn,$msg) = @_; $dxchan->rec($msg)}); + $dxchan->rec($msg); +} + +sub send +{ + my $conn = shift; + for (@_) { + $conn->send_later($_); + } +}