2 # This class implements the new style comms for Aranea
3 # communications for Msg.pm
7 # Copyright (c) 2001 - Dirk Koopman G1TLH
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;
27 use vars qw(@ISA $deftimeout);
34 my ($conn, $msg) = @_;
35 unless ($msg =~ /^[ABZ]/) {
36 if ($msg =~ /^E[-\w]+\|([01])/ && $conn->{csort} eq 'telnet') {
39 # $conn->send_raw("\xFF\xFC\x01");
41 # $conn->send_raw("\xFF\xFB\x01");
44 $msg =~ s/^[-\w]+\|//;
45 push (@{$conn->{outqueue}}, $msg . $conn->{lineend});
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)});
63 $conn->{echo} = shift;
71 if ($conn->{csort} eq 'ax25' && exists $conn->{msg}) {
72 $conn->{msg} =~ s/\cM/\cJ/g;
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});
81 if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) {
82 $conn->to_connected($conn->{call}, 'O', $conn->{csort});
84 } elsif ($conn->{msg} =~ /\cJ/) {
85 my @lines = $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g;
86 if ($conn->{msg} =~ /\cJ$/) {
89 $conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g;
91 while (defined ($msg = shift @lines)) {
92 dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect');
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
97 if ($conn->{state} eq 'C') {
98 &{$conn->{rproc}}($conn, "I$conn->{call}|$msg");
99 } elsif ($conn->{state} eq 'WL' ) {
101 if (is_callsign($msg) && $msg !~ m|/| ) {
102 my $sort = $conn->{csort};
103 $sort = 'local' if $conn->{peerhost} eq "127.0.0.1";
105 if ($main::passwdreq || ($uref = DXUser->get_current($msg)) && $uref->passwd ) {
107 $conn->{state} = 'WP';
108 $conn->{decho} = $conn->{echo};
110 $conn->send_raw('password: ');
112 $conn->to_connected($msg, 'A', $sort);
115 $conn->send_now("Sorry $msg is an invalid callsign");
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);
129 $conn->send_now("Sorry");
132 } elsif ($conn->{state} eq 'WC') {
133 if (exists $conn->{cmd} && @{$conn->{cmd}}) {
135 if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) {
136 $conn->to_connected($conn->{call}, 'O', $conn->{csort});
146 my ($conn, $call, $dir, $sort) = @_;
147 $conn->{state} = 'C';
150 $conn->{timeout}->del if $conn->{timeout};
151 delete $conn->{timeout};
153 &{$conn->{rproc}}($conn, "$dir$call|$sort");
154 $conn->_send_file("$main::data/connected") unless $conn->{outgoing};