projects
/
spider.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
3f64c56
)
added some more connection numbers
author
minima
<minima>
Mon, 9 Apr 2001 22:06:29 +0000
(22:06 +0000)
committer
minima
<minima>
Mon, 9 Apr 2001 22:06:29 +0000
(22:06 +0000)
perl/ExtMsg.pm
patch
|
blob
|
history
perl/Msg.pm
patch
|
blob
|
history
diff --git
a/perl/ExtMsg.pm
b/perl/ExtMsg.pm
index 8a5e4612926b9b5da6a8212f6404090f62c78fab..3f8159aa54699357bff0ac074a4a9235928a2698 100644
(file)
--- a/
perl/ExtMsg.pm
+++ b/
perl/ExtMsg.pm
@@
-50,7
+50,7
@@
sub send_raw
my $sock = $conn->{sock};
return unless defined($sock);
push (@{$conn->{outqueue}}, $msg);
my $sock = $conn->{sock};
return unless defined($sock);
push (@{$conn->{outqueue}}, $msg);
- dbg('connect',
$msg
) unless $conn->{state} eq 'C';
+ dbg('connect',
"connect $conn->{cnum}: $msg"
) unless $conn->{state} eq 'C';
Msg::set_event_handler ($sock, "write" => sub {$conn->_send(0)});
}
Msg::set_event_handler ($sock, "write" => sub {$conn->_send(0)});
}
@@
-65,7
+65,7
@@
sub dequeue
if ($conn->{state} eq 'WC') {
if (exists $conn->{cmd}) {
if (@{$conn->{cmd}}) {
if ($conn->{state} eq 'WC') {
if (exists $conn->{cmd}) {
if (@{$conn->{cmd}}) {
- dbg('connect',
$conn->{msg}
);
+ dbg('connect',
"connect $conn->{cnum}: $conn->{msg}"
);
$conn->_docmd($conn->{msg});
}
}
$conn->_docmd($conn->{msg});
}
}
@@
-80,7
+80,7
@@
sub dequeue
$conn->{msg} = pop @lines;
}
while (defined ($msg = shift @lines)) {
$conn->{msg} = pop @lines;
}
while (defined ($msg = shift @lines)) {
- dbg('connect',
$msg
) unless $conn->{state} eq 'C';
+ dbg('connect',
"connect $conn->{cnum}: $msg"
) unless $conn->{state} eq 'C';
$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/\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
@@
-208,16
+208,16
@@
sub _doconnect
my $r;
$sort = lc $sort;
my $r;
$sort = lc $sort;
- dbg('connect', "CONNECT sort: $sort command: $line");
+ dbg('connect', "CONNECT
$conn->{cnum}
sort: $sort command: $line");
if ($sort eq 'telnet') {
# this is a straight network connect
my ($host, $port) = split /\s+/, $line;
$port = 23 if !$port;
$r = $conn->connect($host, $port);
if ($r) {
if ($sort eq 'telnet') {
# this is a straight network connect
my ($host, $port) = split /\s+/, $line;
$port = 23 if !$port;
$r = $conn->connect($host, $port);
if ($r) {
- dbg('connect', "Connected to $host $port");
+ dbg('connect', "Connected
$conn->{cnum}
to $host $port");
} else {
} else {
- dbg('connect', "***Connect Failed to $host $port $!");
+ dbg('connect', "***Connect
$conn->{cnum}
Failed to $host $port $!");
}
} elsif ($sort eq 'agw') {
# turn it into an AGW object
}
} elsif ($sort eq 'agw') {
# turn it into an AGW object
@@
-242,7
+242,7
@@
sub _doconnect
my $callback = sub {$conn->_rcv};
Msg::set_event_handler ($a, read => $callback);
}
my $callback = sub {$conn->_rcv};
Msg::set_event_handler ($a, read => $callback);
}
- dbg('connect', "started pid: $conn->{pid} as $line");
+ dbg('connect', "
connect $conn->{cnum}:
started pid: $conn->{pid} as $line");
} else {
$^W = 0;
dbgclose();
} else {
$^W = 0;
dbgclose();
@@
-278,7
+278,7
@@
sub _doabort
{
my $conn = shift;
my $string = shift;
{
my $conn = shift;
my $string = shift;
- dbg('connect', "abort $string");
+ dbg('connect', "
connect $conn->{cnum}:
abort $string");
$conn->{abort} = $string;
}
$conn->{abort} = $string;
}
@@
-286,7
+286,7
@@
sub _dotimeout
{
my $conn = shift;
my $val = shift;
{
my $conn = shift;
my $val = shift;
- dbg('connect', "timeout set to $val");
+ dbg('connect', "
connect $conn->{cnum}:
timeout set to $val");
$conn->{timeout}->del if $conn->{timeout};
$conn->{timeval} = $val;
$conn->{timeout} = Timer->new($val, sub{ &_timedout($conn) });
$conn->{timeout}->del if $conn->{timeout};
$conn->{timeval} = $val;
$conn->{timeout} = Timer->new($val, sub{ &_timedout($conn) });
@@
-296,7
+296,7
@@
sub _dolineend
{
my $conn = shift;
my $val = shift;
{
my $conn = shift;
my $val = shift;
- dbg('connect', "lineend set to $val ");
+ dbg('connect', "
connect $conn->{cnum}:
lineend set to $val ");
$val =~ s/\\r/\r/g;
$val =~ s/\\n/\n/g;
$conn->{lineend} = $val;
$val =~ s/\\r/\r/g;
$val =~ s/\\n/\n/g;
$conn->{lineend} = $val;
@@
-311,16
+311,16
@@
sub _dochat
if ($line) {
my ($expect, $send) = $cmd =~ /^\s*\'(.*)\'\s+\'(.*)\'/;
if ($expect) {
if ($line) {
my ($expect, $send) = $cmd =~ /^\s*\'(.*)\'\s+\'(.*)\'/;
if ($expect) {
- dbg('connect', "expecting: \"$expect\" received: \"$line\"");
+ dbg('connect', "
connect $conn->{cnum}:
expecting: \"$expect\" received: \"$line\"");
if ($conn->{abort} && $line =~ /\Q$conn->{abort}/i) {
if ($conn->{abort} && $line =~ /\Q$conn->{abort}/i) {
- dbg('connect', "aborted on /$conn->{abort}/");
+ dbg('connect', "
connect $conn->{cnum}:
aborted on /$conn->{abort}/");
$conn->disconnect;
delete $conn->{cmd};
return;
}
if ($line =~ /\Q$expect/i) {
if (length $send) {
$conn->disconnect;
delete $conn->{cmd};
return;
}
if ($line =~ /\Q$expect/i) {
if (length $send) {
- dbg('connect', "got: \"$expect\" sending: \"$send\"");
+ dbg('connect', "
connect $conn->{cnum}:
got: \"$expect\" sending: \"$send\"");
$conn->send_later("D$conn->{call}|$send");
}
delete $conn->{msg}; # get rid any input if a match
$conn->send_later("D$conn->{call}|$send");
}
delete $conn->{msg}; # get rid any input if a match
@@
-335,7
+335,7
@@
sub _dochat
sub _timedout
{
my $conn = shift;
sub _timedout
{
my $conn = shift;
- dbg('connect', "timed out after $conn->{timeval} seconds");
+ dbg('connect', "
connect $conn->{cnum}:
timed out after $conn->{timeval} seconds");
$conn->disconnect;
}
$conn->disconnect;
}
diff --git
a/perl/Msg.pm
b/perl/Msg.pm
index 815937963962169d8fb2e4d8e0808cb8675bc2a4..3a422c3a817c4c93fe32fdd1c1f2f281c5a61e0f 100644
(file)
--- a/
perl/Msg.pm
+++ b/
perl/Msg.pm
@@
-134,9
+134,9
@@
sub pid_gone
my ($pkg, $pid) = @_;
my @pid = grep {$_->{pid} == $pid} values %conns;
my ($pkg, $pid) = @_;
my @pid = grep {$_->{pid} == $pid} values %conns;
- for (@pid) {
- &{$
_->{eproc}}($_, "$pid has gorn") if exists $_
->{eproc};
- $
_
->disconnect;
+ for
each my $p
(@pid) {
+ &{$
p->{eproc}}($p, "$pid has gorn") if exists $p
->{eproc};
+ $
p
->disconnect;
}
}
}
}
@@
-436,8
+436,8
@@
sub close_server
# close all clients (this is for forking really)
sub close_all_clients
{
# close all clients (this is for forking really)
sub close_all_clients
{
- for (values %conns) {
- $
_
->disconnect;
+ for
each my $conn
(values %conns) {
+ $
conn
->disconnect;
}
}
}
}