fix nasty timer bug

[spider.git] / perl / ExtMsg.pm

diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm
index 838c74e122460dfae490b6737727dec32590be99..cc938bd822223706de2e50369d5cd29fe1b0590c 100644 (file)
--- a/perl/ExtMsg.pm
+++ b/perl/ExtMsg.pm
@@ -115,36 +115,43 @@ sub to_connected
        delete $conn->{cmd};
        $conn->{timeout}->del if $conn->{timeout};
        delete $conn->{timeout};
-       $conn->_send_file("$main::data/connected");
        &{$conn->{rproc}}($conn, "$dir$call|$sort");
+       $conn->_send_file("$main::data/connected");
 }
 
 sub new_client {
        my $server_conn = shift;
     my $sock = $server_conn->{sock}->accept();
-    my $conn = $server_conn->new($server_conn->{rproc});
-       $conn->{sock} = $sock;
-
-    my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $sock->peerhost(), $conn->{peerport} = $sock->peerport());
-       if ($eproc) {
-               $conn->{eproc} = $eproc;
-        Msg::set_event_handler ($sock, "error" => $eproc);
+       if ($sock) {
+               my $conn = $server_conn->new($server_conn->{rproc});
+               $conn->{sock} = $sock;
+               Msg::blocking($sock, 0);
+               $conn->{blocking} = 0;
+               
+               my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $sock->peerhost(), $conn->{peerport} = $sock->peerport());
+               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);
+                       # send login prompt
+                       $conn->{state} = 'WL';
+                       #               $conn->send_raw("\xff\xfe\x01\xff\xfc\x01\ff\fd\x22");
+                       #               $conn->send_raw("\xff\xfa\x22\x01\x01\xff\xf0");
+                       #               $conn->send_raw("\xFF\xFC\x01");
+                       $conn->_send_file("$main::data/issue");
+                       $conn->send_raw("login: ");
+                       $conn->_dotimeout(60);
+               } else { 
+                       &{$conn->{eproc}}() if $conn->{eproc};
+                       $conn->disconnect();
+               }
+       } else {
+               dbg('err', "ExtMsg: error on accept ($!)");
        }
-    if ($rproc) {
-        $conn->{rproc} = $rproc;
-        my $callback = sub {$conn->_rcv};
-               Msg::set_event_handler ($sock, "read" => $callback);
-               # send login prompt
-               $conn->{state} = 'WL';
-#              $conn->send_raw("\xff\xfe\x01\xff\xfc\x01\ff\fd\x22");
-#              $conn->send_raw("\xff\xfa\x22\x01\x01\xff\xf0");
-#              $conn->send_raw("\xFF\xFC\x01");
-               $conn->_send_file("$main::data/issue");
-               $conn->send_raw("login: ");
-               $conn->_dotimeout(60);
-    } else { 
-        $conn->disconnect();
-    }
 }
 
 sub start_connect
@@ -211,6 +218,10 @@ sub _doconnect
                } else {
                        dbg('connect', "***Connect Failed to $host $port $!");
                }
+       } elsif ($sort eq 'agw') {
+               # turn it into an AGW object
+               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);
@@ -241,7 +252,7 @@ sub _doconnect
                                        *STDOUT = IO::File->new_from_fd($b, 'w') or die;
                                        *STDERR = IO::File->new_from_fd($b, 'w') or die;
                                        close $a;
-                                       unless ($^O =~ /^MS/) {
+                                       unless ($main::is_win) {
 #                                              $SIG{HUP} = 'IGNORE';
                                                $SIG{HUP} = $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = 'DEFAULT';
                                                alarm(0);
@@ -307,8 +318,10 @@ sub _dochat
                                return;
                        }
                        if ($line =~ /\Q$expect/i) {
-                               dbg('connect', "got: \"$expect\" sending: \"$send\"");
-                               $conn->send_later($send);
+                               if (length $send) {
+                                       dbg('connect', "got: \"$expect\" sending: \"$send\"");
+                                       $conn->send_later("D$conn->{call}|$send");
+                               }
                                delete $conn->{msg}; # get rid any input if a match
                                return;
                        }
@@ -322,8 +335,6 @@ sub _timedout
 {
        my $conn = shift;
        dbg('connect', "timed out after $conn->{timeval} seconds");
-       $conn->{timeout}->del;
-       delete $conn->{timeout};
        $conn->disconnect;
 }
 
@@ -337,7 +348,7 @@ sub _doclient
        $conn->conns($call);
        $conn->{csort} = $f[1] if $f[1];
        $conn->{state} = 'C';
-       &{$conn->{rproc}}($conn, "O$call|telnet");
+       &{$conn->{rproc}}($conn, "O$call|$conn->{csort}");
        delete $conn->{cmd};
        $conn->{timeout}->del if $conn->{timeout};
 }
@@ -352,6 +363,7 @@ sub _send_file
                if ($f) {
                        while (<$f>) {
                                chomp;
+                               dbg('connll', $_);
                                $conn->send_raw($_ . $conn->{lineend});
                        }
                        $f->close;