#!/usr/bin/perl -w

use strict;

# Fingerproxy: a fingerd that is actually a generic socket proxy.
# Offered under the Floodgap Free Software License:
#    http://www.floodgap.com/software/ffsl/
# Copyright 2009 Cameron Kaiser
#
# This must be connected to inetd to function.
# It is not a daemon.
#
#
### VERSION 0.1
# Initial release (11/11/09)

########################################
# YOU MUST CONFIGURE THIS SCRIPT FIRST #
########################################

# Set $NC to the location of netcat, or a tool that works like netcat.
# DON'T USE TELNET FOR THIS!
# Add any default arguments you want; for security reasons you can't do
# that below.
my $NC = "/usr/local/bin/nc -w 10";

# Set $FINGERD to where your fingerd normally resides. If you don't
# set this, then fingerproxy will handle all of the requests itself.
my $FINGERD = "/usr/libexec/fingerd";

# Remove the line below. If you don't, fingerproxy won't run.
die "You didn't configure this script properly";

#######################################################
# END OF CONFIGURATION SECTION. WHITE HATS ONLY BELOW #
#######################################################

# stuff warnings
$SIG{"__WARN__"} = sub { ; };

# The finger protocol accepts a single line of data, and that's what we'll
# do, with processing for binary characters and other entities.

select(STDOUT); $|++; my $request = <STDIN>;

# A fingerproxy command looks like this:
# hostname|port|data ...
# If that's not what we got, maybe we're trying to handle a regular
# finger request?

if ($request !~ /\|/ && length($FINGERD)) {
	my $pid = open(DAEMON, "|$FINGERD") || die("failed fingerd: $!\n");
	print DAEMON $request;
	close(DAEMON);
	exit;
}

# A reply gives a single character response code ("0" = no error),
# and then any data.

$request =~ s/[\012\015]+$//; # remove trailing \n or \r\n
$request =~ s/^\/[wW]\s+//; # ignore any leading /w some finger clients add
my ($host, $port, $data) = split(/\|/, $request, 3);
$port += 0;
$host = lc($host);
if (!length($host) || $port < 1) {
	print STDOUT "1$request"; # malformed request
	exit;
}
if ($host =~ /[^-a-z0-9_\.]/ || $host =~ /^[^a-z0-9]/) {
	print STDOUT "2$request";
		# malformed request: to avoid trivial security issues
	exit;
}

# Process the data.
# We understand: \n \r \t \b \0xXX
# And we accept \\ as backslash.
my $uniq = 0;
$uniq++ while ($data =~ /BACKSLASH_ESCAPE_SEQUENCE$uniq/);
$uniq = "BACKSLASH_ESCAPE_SEQUENCE$uniq";

$data =~ s/\\\\/$uniq/g;
$data =~ s/\\n/\012/g;
$data =~ s/\\r/\015/g;
$data =~ s/\\t/\011/g;
$data =~ s/\\b/\010/g;
$data =~ s/\\0x([a-z0-9]{2})/pack("H2",$1)/eg;
$data =~ s/$uniq/\\/g;

my $pid = open(NETCAT, "|$NC $host $port") || do {
	print STDOUT "3$!"; # system error
	exit;
};
print STDOUT "0";
print NETCAT $data;
close(NETCAT); # automatic wait
exit;