1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
# socketstuff.pl - routines for allowing working timeouts to sockets
# on open and read.
# $Id: socketstuff.pl.in,v 1.8 2001/08/28 15:22:24 remstats Exp $
# Copyright 1999, 2000, 2001 (c) Thomas Erskine <@@AUTHOR@@>
# See the COPYRIGHT file with the distribution.
# - - - Version History - - -
use strict;
# $Revision: 1.8 $
# - - - Usage - - -
# local $SIG{'ALRM'} = sub { $main::socketstuff_alarm=1; die "timeout\n"; }; # optional
# alarm($timeout); # optional
#
# ($socket, $status, [$timeout]) = &open_socket( $host, $port [,$timeout] [,$ip]);
# ($line, $status, [$timeout]) = &read_socket( $socket, [$timeout]);
# ($status, [$timeout]) = &write_socket( $socket, $string, [$timeout]);
#
# alarm(0); # optional
# $SIG{'ALRM'} = 'DEFAULT'; # optional
# $socket->close();
# If the optional $timeout args are supplied, alarm() will be called before and
# after the enclosing eval around the I/O and the remaining time will be returned.
# This should permit easier and proper handling of the timeout.
# - - - Setup - - -
use IO::Socket;
# Status "constant" values
$main::SOCKET_OK = 1;
$main::SOCKET_TIMEOUT = 2;
$main::SOCKET_ERROR = 3;
# Get rid of those *^%$* warnings from IO::Socket
BEGIN { $main::SIG{'__WARN__'} = sub {warn @_ unless $main::suppress_warnings; } }
$main::suppress_warnings = 0;
#-------------------------------------------------- open_socket ---
# Pass it a host and port to connect to.
# Returns an IO::Socket and a status (see above).
sub open_socket {
my ($host, $port, $timeout, $ip) = @_;
my ($socket, $status);
die "open_socket: host must be defined\n" unless (defined $host);
die "open_socket: port must be defined\n" unless (defined $port);
$main::suppress_warnings = 1;
if (defined $timeout and $timeout > 0) {
eval {
local $SIG{'ALRM'} = sub { $main::socketstuff_alarm = 1; die "timeout\n"; };
alarm($timeout);
$socket = IO::Socket::INET->new(
Proto => 'tcp',
PeerAddr => ((defined $ip) ? $ip : $host),
PeerPort => $port);
$timeout = alarm(0);
};
}
else {
eval {
$socket = IO::Socket::INET->new(
Proto => 'tcp',
PeerAddr => ((defined $ip) ? $ip : $host),
PeerPort => $port);
};
}
if ($@ and $@ =~ /^timeout\n/) {
&debug("open_socket: open timeout on $host:$port") if($main::debug>1);
$status = $main::SOCKET_TIMEOUT;
}
elsif ($@ or ! defined $socket) {
&debug("open_socket: open error on $host:$port: $@") if ($main::debug>1);
$status = $main::SOCKET_ERROR;
}
else {
$status = $main::SOCKET_OK;
$socket->autoflush(1);
}
$main::suppress_warnings = 0;
($socket, $status, $timeout);
}
#---------------------------------------------------- read_socket ---
# Pass it an IO::Socket, probably obtained from open_socket.
# Returns a newline-terminated line and a status.
sub read_socket {
my ($socket, $timeout, $what) = @_;
my ($line, $status);
&debug("read_socket: starting read") if ($main::debug>2);
# Local timeout handled here
$main::suppress_warnings = 1;
if (defined $timeout and $timeout > 0) {
local $SIG{'ALRM'} = sub { $main::socketstuff_alarm = 1; die "timeout\n"; };
eval {
alarm($timeout);
$line = <$socket>;
$timeout = alarm(0);
};
}
# Timeout handled outside
else { eval { $line = <$socket> }; }
if ($@ and $@ =~ /^timeout\n/) {
&debug("read_socket: read timeout" . ((defined $what) ? " for $what" : ''))
if ($main::debug>1);
$status = $main::SOCKET_TIMEOUT;
}
elsif ($@) {
$! = $@;
&debug("read_socket: read error" . ((defined $what) ? " for $what" : ''))
if ($main::debug>1);
$status = $main::SOCKET_ERROR;
}
else { $status = $main::SOCKET_OK; }
$main::suppress_warnings = 0;
&debug("read_socket: read done") if ($main::debug>2);
($line, $status, $timeout);
}
#--------------------------------------------------- write_socket ---
sub write_socket {
my ($socket, $string, $timeout, $what) = @_;
my $status;
# Locally handled timeout
$main::suppress_warnings = 1;
if (defined $timeout and $timeout > 0) {
eval {
local $SIG{'ALRM'} = sub { $main::socketstuff_alarm = 1; die "timeout\n"; };
alarm($timeout);
$socket->print($string);
$timeout = alarm(0);
};
}
# Timeout handled outside, and incompletely;
else {
eval {
$socket->print($string);
};
}
if ($@ and $@ eq "timeout\n") {
&debug("write_socket: write timeout ". ((defined $what) ? " for $what" : '')
."writing '$string'") if ($main::debug>1);
$status = $main::SOCKET_TIMEOUT;
}
elsif ($@) {
&debug("write_socket: write error ". ((defined $what) ? " for $what" : '')
."writing '$string'") if ($main::debug>1);
$status = $main::SOCKET_ERROR;
$! = $@;
}
else { $status = $main::SOCKET_OK; }
$main::suppress_warnings = 0;
($status, $timeout);
}
# Tell perl it's OK
1;
|
