This file is indexed.

/usr/bin/theft-server is in clc-intercal 1:1.0~4pre1.-94.-2-2.

This file is owned by root:root, with mode 0o755.

The actual contents of the file can be viewed below.

  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
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell

# INTERNET (INTERcal NETworking) server

# This file is part of CLC-INTERCAL

# Copyright (c) 2007-2008 Claudio Calvelli, all rights reserved.

# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
# and distribute it is granted provided that the conditions set out in the
# licence agreement are met. See files README and COPYING in the distribution.

require 5.005;

use strict;
use Socket;
use Getopt::Long;

use Language::INTERCAL::Server '1.-94.-2';

use vars qw($VERSION $PERVERSION);
($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base bin/theft-server 1.-94.-2") =~ /\s(\S+)$/;

my ($PERVNUM) = $PERVERSION =~ /\s(\S+)$/;

if (defined &Getopt::Long::Configure) {
    Getopt::Long::Configure qw(no_ignore_case auto_abbrev permute bundling);
} else {
    $Getopt::Long::ignorecase = 0;
    $Getopt::Long::autoabbrev = 1;
    $Getopt::Long::order = $Getopt::Long::PERMUTE;
    $Getopt::Long::bundling = 1;
}

my $port = undef;
my $debug = 0;
my $linger = 600; # time we hang around

GetOptions(
    'port|p=i'      => \$port,
    'debug|d!'      => \$debug,
    'linger|l=i'    => \$linger,
) or usage();

defined $port or die "Must specify --port\n";

unless ($debug) {
    close STDIN;
    close STDOUT;
    close STDERR;
    my $pid = fork;
    defined $pid or die "Cannot fork(): $!\n";
    $pid and exit 0;
    if (open(TTY, '<', '/dev/tty')) {
	eval {
	    require 'ioctl.ph';
	    my $x;
	    ioctl(TTY, &TIOCNOTTY, $x);
	};
	close TTY;
    }
    $SIG{HUP} = 'IGNORE';
    $SIG{TSTP} = 'IGNORE';
    $SIG{INT} = 'IGNORE';
}

my $server = Language::INTERCAL::Server->new();
$server->tcp_listen(\&_open, \&_line, \&_close, undef, $port);
$server->udp_listen($port);
$debug and $server->debug;

$debug and print STDERR time, ": Opened TCP and UDP sockets on port $port\n";
my $socket_bitmap = '';
my %pids = ();
my %ports = ();
my %ids = ();

while ($server->connections || $linger == 0 || time < $server->active + $linger) {
    my $timeout = $server->connections || $linger == 0
		? undef
		: ($server->active + $linger);
    $server->progress($timeout);
}
$debug and print STDERR time, ": Exiting server\n";
exit 0;

sub _open {
    my ($id, $sockhost, $peerhost, $close) = @_;
    my $local = $peerhost eq '127.0.0.1';
    $ids{$id} = [$local, undef, undef];
    "200 INTERNET on $sockhost (CLC-INTERCAL $PERVNUM)";
}

sub _line {
    my ($server, $id, $close, $line) = @_;
    exists $ids{$id}
	or return "598 Internal error: missing ID";
    my ($local, $pid, $port) = @{$ids{$id}};
    $line =~ s/^\s+//;
    if ($local && $line =~ /^VICTIM\s+(\d+)\s+ON\s+PORT\s+(\d+)/i) {
	my $new_pid = $1;
	my $new_port = $2;
	if (defined $pid || defined $port) {
	    return '530 You have already issued a VICTIM command';
	} elsif ($new_pid == 0) {
	    return '531 That was an invalid PID';
	} elsif (exists $pids{$new_pid}) {
	    return '532 I already know about that PID';
	} elsif ($new_port > 65535 || $new_port == 0) {
	    return '533 That was an invalid PORT';
	} elsif (exists $ports{$new_port}) {
	    return '534 I already know about that PORT';
	} else {
	    $ids{$id}[1] = $new_pid;
	    $ids{$id}[2] = $new_port;
	    $pids{$new_pid} = $new_port;
	    $ports{$new_port} = $id;
	    return "230 Welcome $new_pid:$new_port!";
	}
    }
    if ($line =~ /^CASE\s+PID/i) {
	my @pids = map { "$_ ON PORT $pids{$_}" } keys %pids;
	my $num = @pids || 'no';
	my $es = @pids == 1 ? '' : 'es';
	return (
	    "210 We have $num process$es running",
	    @pids,
	    '.',
	);
    }
    if ($line =~ /^CASE\s+PORT\s+(\d+)/i) {
	if (exists $pids{$1}) {
	    return "220 $pids{$1} is the port you need";
	} else {
	    return "520 No such PID";
	}
    }
    if ($line =~ /^THANKS/i) {
	$$close = 1;
	return '240 You are welcome';
    }
    return '590 Command not understood';
}

sub _close {
    my ($id) = @_;
    exists $ids{$id} or return;
    my ($local, $pid, $port) = @{$ids{$id}};
    defined $pid and delete $pids{$pid};
    defined $port and delete $ports{$port};
    delete $ids{$id};
}

sub usage {
    (my $p = $0) =~ s#^.*/##;
    die "Usage: $p [--port=PORT] [--debug] [--linger-TIME]\n";
}

__END__

=pod

=head1 NAME

theft-server - CLC-INTERCAL networking

=head1 SYNOPSIS

B<theft-server> --port=I<port> [options]

=head1 DESCRIPTION

The B<theft-server> mediates the communication between two CLC-INTERCAL
programs with the I<internet> extension. It keeps a list of process IDs
running on the current computer so it can provide lists of processes which
can be engaged in INTERcal NETworking; it also responds to broadcasts
allowing other CLC-INTERCAL programs on the LAN to know there is something
happening on this computer.

Under normal conditions, the B<theft-server> is started automatically
by a CLC-INTERCAL programs with the I<internet> extension (unless one
is already running, of course!) because the extension cannot operate
without a server on the local computer. However, it is possible to
start one manually, for example from a F</etc/init.d> or F</etc/rc.d>.

If the program is started automatically, it uses defaults for all its
configuration; when started manually, it accepts the following options:

=over 4

=item B<-p>I<port> / B<--port>=I<port>

Uses the given I<port> (number or service name) for communications,
instead of using the default one from a configuration file.

=item B<-l>I<seconds> / B<--linger>=I<seconds>

Waits the specified time for a connection, then exit. The default is
600 (10 minutes). The timeout applies when the program starts and also
when all existing connections are closed. This allows the program to
be started on demand by CLC-INTERCAL programs, and to automatically
exit when no longer required (unless more programs start up during
the timeout).

This function is disabled by setting the timeout to 0 (i.e. B<-l>I<0>);
for example, if starting the server from F</etc/init.d> or equivalent
one would disable the timeout.

=item B<-d> / B<--debug>

Tells everything it's doing (on Standard Error). Also, prevents the
program from detaching from the current terminal and going into the
background.

=head1 BUGS

IPv6 is not yet implemented.