]> gb7djk.dxcluster.net Git - spider.git/blob - perl/AMsg.pm
add AMsg handler
[spider.git] / 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(Msg);
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