perl/AMsg.pm

   1 #
   2 # This class implements the new style comms for Aranea
   3 # communications for Msg.pm
   4 #
   5 # $Id$
   6 #
   7 # Copyright (c) 2001 - Dirk Koopman G1TLH
   8 #
   9
  10 package AMsg;
  11
  12 use strict;
  13 use Msg;
  14 use DXVars;
  15 use DXUtil;
  16 use DXDebug;
  17 use IO::File;
  18 use IO::Socket;
  19 use IPC::Open3;
  20
  21 use vars qw($VERSION $BRANCH);
  22 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  23 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  24 $main::build += $VERSION;
  25 $main::branch += $BRANCH;
  26
  27 use vars qw(@ISA $deftimeout);
  28
  29 @ISA = qw(ExtMsg);
  30 $deftimeout = 60;
  31
  32 sub enqueue
  33 {
  34         my ($conn, $msg) = @_;
  35         unless ($msg =~ /^[ABZ]/) {
  36                 if ($msg =~ /^E[-\w]+\|([01])/ && $conn->{csort} eq 'telnet') {
  37                         $conn->{echo} = $1;
  38                         if ($1) {
  39 #                               $conn->send_raw("\xFF\xFC\x01");
  40                         } else {
  41 #                               $conn->send_raw("\xFF\xFB\x01");
  42                         }
  43                 } else {
  44                         $msg =~ s/^[-\w]+\|//;
  45                         push (@{$conn->{outqueue}}, $msg . $conn->{lineend});
  46                 }
  47         }
  48 }
  49
  50 sub send_raw
  51 {
  52         my ($conn, $msg) = @_;
  53     my $sock = $conn->{sock};
  54     return unless defined($sock);
  55         push (@{$conn->{outqueue}}, $msg);
  56         dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect');
  57     Msg::set_event_handler ($sock, "write" => sub {$conn->_send(0)});
  58 }
  59
  60 sub echo
  61 {
  62         my $conn = shift;
  63         $conn->{echo} = shift;
  64 }
  65
  66 sub dequeue
  67 {
  68         my $conn = shift;
  69         my $msg;
  70
  71         if ($conn->{csort} eq 'ax25' && exists $conn->{msg}) {
  72                 $conn->{msg} =~ s/\cM/\cJ/g;
  73         }
  74         if ($conn->{state} eq 'WC') {
  75                 if (exists $conn->{cmd}) {
  76                         if (@{$conn->{cmd}}) {
  77                                 dbg("connect $conn->{cnum}: $conn->{msg}") if isdbg('connect');
  78                                 $conn->_docmd($conn->{msg});
  79                         }
  80                 }
  81                 if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) {
  82                         $conn->to_connected($conn->{call}, 'O', $conn->{csort});
  83                 }
  84         } elsif ($conn->{msg} =~ /\cJ/) {
  85                 my @lines =  $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g;
  86                 if ($conn->{msg} =~ /\cJ$/) {
  87                         delete $conn->{msg};
  88                 } else {
  89                         $conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g;
  90                 }
  91                 while (defined ($msg = shift @lines)) {
  92                         dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect');
  93
  94                         $msg =~ s/\xff\xfa.*\xff\xf0|\xff[\xf0-\xfe].//g; # remove telnet options
  95 #                       $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
  96
  97                         if ($conn->{state} eq 'C') {
  98                                 &{$conn->{rproc}}($conn, "I$conn->{call}|$msg");
  99                         } elsif ($conn->{state} eq 'WL' ) {
 100                                 $msg = uc $msg;
 101                                 if (is_callsign($msg) && $msg !~ m|/| ) {
 102                                         my $sort = $conn->{csort};
 103                                         $sort = 'local' if $conn->{peerhost} eq "127.0.0.1";
 104                                         my $uref;
 105                                         if ($main::passwdreq || ($uref = DXUser->get_current($msg)) && $uref->passwd ) {
 106                                                 $conn->conns($msg);
 107                                                 $conn->{state} = 'WP';
 108                                                 $conn->{decho} = $conn->{echo};
 109                                                 $conn->{echo} = 0;
 110                                                 $conn->send_raw('password: ');
 111                                         } else {
 112                                                 $conn->to_connected($msg, 'A', $sort);
 113                                         }
 114                                 } else {
 115                                         $conn->send_now("Sorry $msg is an invalid callsign");
 116                                         $conn->disconnect;
 117                                 }
 118                         } elsif ($conn->{state} eq 'WP' ) {
 119                                 my $uref = DXUser->get_current($conn->{call});
 120                                 $msg =~ s/[\r\n]+$//;
 121                                 if ($uref && $msg eq $uref->passwd) {
 122                                         my $sort = $conn->{csort};
 123                                         $conn->{echo} = $conn->{decho};
 124                                         delete $conn->{decho};
 125                                         $sort = 'local' if $conn->{peerhost} eq "127.0.0.1";
 126                                         $conn->{usedpasswd} = 1;
 127                                         $conn->to_connected($conn->{call}, 'A', $sort);
 128                                 } else {
 129                                         $conn->send_now("Sorry");
 130                                         $conn->disconnect;
 131                                 }
 132                         } elsif ($conn->{state} eq 'WC') {
 133                                 if (exists $conn->{cmd} && @{$conn->{cmd}}) {
 134                                         $conn->_docmd($msg);
 135                                         if ($conn->{state} eq 'WC' && exists $conn->{cmd} &&  @{$conn->{cmd}} == 0) {
 136                                                 $conn->to_connected($conn->{call}, 'O', $conn->{csort});
 137                                         }
 138                                 }
 139                         }
 140                 }
 141         }
 142 }
 143
 144 sub to_connected
 145 {
 146         my ($conn, $call, $dir, $sort) = @_;
 147         $conn->{state} = 'C';
 148         $conn->conns($call);
 149         delete $conn->{cmd};
 150         $conn->{timeout}->del if $conn->{timeout};
 151         delete $conn->{timeout};
 152         $conn->nolinger;
 153         &{$conn->{rproc}}($conn, "$dir$call|$sort");
 154         $conn->_send_file("$main::data/connected") unless $conn->{outgoing};
 155 }
 156
 157