forked from TAEB/Interhack
-
Notifications
You must be signed in to change notification settings - Fork 0
/
ih-server.pl
73 lines (56 loc) · 1.57 KB
/
ih-server.pl
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
#!/usr/bin/perl
use strict;
use warnings;
use IO::Pty::Easy;
use IO::Socket::INET;
use Time::HiRes 'sleep';
# XXX THIS IS ONE HUGE HACK.
# this is a server that acts much like Interhack. it acts as a filter between a socket and a pseudo-tty. in essence, you do the following:
# change interhack.pl's default server from nao to ih_server:
# the line looks like the following:
# our $server = $servers{nao};
# change it to
# our $server = $servers{ih_server};
# then run interhack: ./interhack.pl
# it'll open up a new shell where you can ssh nethack.devnull.net or whatever
my $port = 9999;
my $socket = IO::Socket::INET->new(
LocalPort => $port,
Type => SOCK_STREAM,
Listen => 5,
ReuseAddr => 1,
Proto => 'tcp',
) or die $!;
warn "Waiting for a connection on port $port.";
$socket = $socket->accept;
warn "A client has connected.";
$socket->blocking(0);
$socket->autoflush(1);
my $pty = IO::Pty::Easy->new;
$pty->spawn($ENV{SHELL} || 'bash');
while (1) {
sleep 0.03;
my $input = read_socket();
if (defined $input) {
my $chars = $pty->write($input, 0);
die "Unable to write to pty." if (defined $chars) && $chars == 0;
}
my $output = $pty->read(0);
if (defined $output) {
die "Unable to read from pty." if $output eq '';
print_socket($output);
}
}
sub print_socket # {{{
{
my $txt = shift;
$socket->print($txt);
} # }}}
sub read_socket # {{{
{
return
unless defined(recv($socket, $_, 4096, 0));
die "The connection has closed."
unless length;
return $_;
} # }}}