X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FExtMsg.pm;h=1f543fc035bdc5e9f0c98a9760076edc7708c3c5;hb=e5c28b46a0f70c78747672091a8edd749aa8488c;hp=75b025f397cf34f553799460ed57318584c01490;hpb=980b697bd47c8f575b1c9a7f01f9b01adc6746bd;p=spider.git diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 75b025f3..1f543fc0 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -5,7 +5,7 @@ # This is where the cluster handles direct connections coming both in # and out # -# $Id$ +# # # Copyright (c) 2001 - Dirk Koopman G1TLH # @@ -21,17 +21,16 @@ use IO::File; use IO::Socket; use IPC::Open3; -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; -$main::build += $VERSION; -$main::branch += $BRANCH; - use vars qw(@ISA $deftimeout); @ISA = qw(Msg); $deftimeout = 60; +sub login +{ + goto &main::login; # save some writing, this was the default +} + sub enqueue { my ($conn, $msg) = @_; @@ -60,6 +59,12 @@ sub send_raw Msg::set_event_handler ($sock, "write" => sub {$conn->_send(0)}); } +sub echo +{ + my $conn = shift; + $conn->{echo} = shift; +} + sub dequeue { my $conn = shift; @@ -89,7 +94,7 @@ sub dequeue 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 +# $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"); @@ -98,11 +103,34 @@ sub dequeue if (is_callsign($msg) && $msg !~ m|/| ) { my $sort = $conn->{csort}; $sort = 'local' if $conn->{peerhost} eq "127.0.0.1"; - $conn->to_connected($msg, 'A', $sort); + 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' ) { + 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); + } else { + $conn->send_now("Sorry"); + $conn->disconnect; + } } elsif ($conn->{state} eq 'WC') { if (exists $conn->{cmd} && @{$conn->{cmd}}) { $conn->_docmd($msg); @@ -123,6 +151,7 @@ sub to_connected delete $conn->{cmd}; $conn->{timeout}->del if $conn->{timeout}; delete $conn->{timeout}; + $conn->nolinger unless $conn->isa('AGWMsg'); &{$conn->{rproc}}($conn, "$dir$call|$sort"); $conn->_send_file("$main::data/connected") unless $conn->{outgoing}; } @@ -133,6 +162,7 @@ sub new_client { 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}; @@ -160,6 +190,7 @@ sub new_client { $conn->_send_file("$main::data/issue"); $conn->send_raw("login: "); $conn->_dotimeout(60); + $conn->{echo} = 1; } else { &{$conn->{eproc}}() if $conn->{eproc}; $conn->disconnect(); @@ -240,49 +271,7 @@ sub _doconnect bless $conn, 'AGWMsg'; $r = $conn->connect($line); } elsif ($sort eq 'ax25' || $sort eq 'prog') { - local $^F = 10000; # make sure it ain't closed on exec - my ($a, $b) = IO::Socket->socketpair(AF_UNIX, SOCK_STREAM, PF_UNSPEC); - if ($a && $b) { - $r = 1; - $a->autoflush(1); - $b->autoflush(1); - my $pid = fork; - if (defined $pid) { - if ($pid) { - close $b; - $conn->{sock} = $a; - $conn->{csort} = $sort; - $conn->{lineend} = "\cM" if $sort eq 'ax25'; - $conn->{pid} = $pid; - if ($conn->{rproc}) { - my $callback = sub {$conn->_rcv}; - Msg::set_event_handler ($a, read => $callback); - } - dbg("connect $conn->{cnum}: started pid: $conn->{pid} as $line") if isdbg('connect'); - } else { - $^W = 0; - dbgclose(); - STDIN->close; - STDOUT->close; - STDOUT->close; - *STDIN = IO::File->new_from_fd($b, 'r') or die; - *STDOUT = IO::File->new_from_fd($b, 'w') or die; - *STDERR = IO::File->new_from_fd($b, 'w') or die; - close $a; - unless ($main::is_win) { -# $SIG{HUP} = 'IGNORE'; - $SIG{HUP} = $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = 'DEFAULT'; - alarm(0); - } - exec "$line" or dbg("exec '$line' failed $!"); - } - } else { - dbg("cannot fork"); - $r = undef; - } - } else { - dbg("no socket pair $!"); - } + $r = $conn->start_program($line, $sort); } else { dbg("invalid type of connection ($sort)"); }