forked from blind-coder/nethack-nhbot
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Comm.pm
executable file
·105 lines (86 loc) · 2.35 KB
/
Comm.pm
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
use IO::Socket;
use Telnet;
$| = 1; #autoflush output so logfiles are updated immediately
my $sock;
my ($logdebug, $logoutput, $loginput);
sub open_logs($$$)
{
($logdebug, $logoutput, $loginput) = @_;
open (DEBUGLOG, ">logs/debug.log") if $logdebug;
open (OUTLOG, ">logs/output.log") if $logoutput;
open (INLOG, ">logs/input.log") if $loginput;
}
sub close_logs()
{
close DEBUGLOG if $logdebug;
close OUTLOG if $logoutput;
close INLOG if $loginput;
}
sub timestamp()
{
my $ret = "[".scalar(localtime)."] ";
$ret =~ s/([A-Z][a-z][a-z] [A-Z][a-z][a-z] \d\d) (\d\d:\d\d:\d\d)/$2 $1/;
return $ret;
}
sub debug($)
{
return unless $logdebug;
my $line = shift;
$line = timestamp() . $line . "\n";
print DEBUGLOG $line;
print STDOUT $line;
}
sub out($)
{
my $line = shift;
print $sock $line;
return unless $logoutput;
$line =~ s/\n//mg;
#commented out the timestamp because it was making huge logs...
$line = #timestamp() .
$line . "\n";
print OUTLOG $line;
}
sub response()
{
my ($buf, $ret, $timeout);
my $recursion = shift;
print $sock "\xFF\xFA\x05\x01\xFF\xF0"; #iac subnegotiation status send iac endsubnegotiation
$timeout = 60 + time; #one minute is very generous..
$ret = '';
while (time < $timeout)
{
$ret .= $buf if recv($sock, $buf, 1024, 0);
sleep 0.1;
if ($ret =~ /\xFF\xFA\x05\x00.*?\xFF\xF0/) #iac subnegotiation status is .* iac endsubnegitiation
{
$ret = parse_telnet($ret);
if ($ret =~ /--More--/)
{
print $sock "\n";
$ret .= &response(++$recursion); #ampersand exists to bypass (W prototype)
}
$ret =~ s/--More--//g;
#commented out the timestamp because it was making huge logs...
print INLOG #timestamp .
$ret . "\n" if ($recursion && $loginput);
return $ret;
}
}
die "timed out while waiting for pong";
}
sub create_sock()
{
$sock = new IO::Socket::INET(PeerAddr => 'nethack.alt.org',
PeerPort => 23,
Proto => 'tcp');
die "Could not create socket: $!\n" unless $sock;
$sock->blocking(0);
debug("Socket blocked and loaded. Let's negotiate.");
initial_negotiations($sock);
}
sub close_sock()
{
close $sock;
}
1;