#!/usr/bin/perl
package IO::Event::rinetd;
my $debug = 0;
$main::VERSION = '1.21';
use strict;
use IO::Event;
use Net::Netmask;
use Getopt::Long;
use File::Slurp;
use File::Flock;
use Daemon::Generic::Event;
require POSIX;
my %config;
my %filters;
my $counter = 1;
sub error;
newdaemon(
progname => 'rinetd.pl',
pidbase => '/var/run/rinetd',
);
sub error
{
my $e = shift;
if ($ARGV[0] && $ARGV[0] eq 'stop') {
warn $e;
} else {
die $e;
}
}
sub gd_preconfig
{
my $self = shift;
open(CONFIG, $self->{configfile})
or error "open $self->{configfile}: $!\n";
my %new;
$filters{global} = {};
my $last = 'global';
while (<CONFIG>) {
next if /^#/;
next if /^$/;
if (/^\s*(allow|deny)\s+(\S+)\s*(?:#.*)?$/) {
my ($action, $text) = ($1, $2);
$text =~ s/^(\d+(?:\.\d+)*)(?:\.\*)+$/$1/;
my $block = new2 Net::Netmask ($text);
if ($block) {
$block->{line} = $.;
$block->{action} = $action;
$block->storeNetblock($filters{$last});
} else {
error "parse error $self->{configfile}, line $.: $Net::Netmask::error\n";
}
next;
}
/^(\S+)\s+(\w+)\s+(\S+)\s+(\w+)\s*(?:#.*)?$/
or error "Parse error $self->{configfile}, line $.: $_";
my ($fhost, $fport, $thost, $tport) = ($1, $2, $3, $4);
my $new = join("\n", $fhost, $fport, $thost, $tport, $.);
$new{$new} = undef;
$last = $new;
$filters{$new} = {};
}
close(CONFIG);
return %new;
}
sub gd_postconfig
{
my $self = shift;
my (%new) = @_;
for my $old (keys %config) {
next if $new{$old};
$config{$old}->shutdown
if $config{$old};
delete $config{$old};
}
for my $new (keys %new) {
next if $config{$new};
$config{$new} = new RelayListener (split(/\n/, $new), $filters{$new});
}
}
package RelayListener;
use strict;
use Net::Netmask;
sub new
{
my ($pkg, $fhost, $fport, $thost, $tport, $line, $filter) = @_;
die unless $fhost;
die unless $fport;
die unless $thost;
die unless $thost;
my $self = bless {
tohost => $thost,
toport => $tport,
counter => $counter++,
filter => $filter,
line => $line,
desc => "Listen $fhost:$fport -> $thost:$tport",
}, $pkg;
$counter++;
my $listener = IO::Event::Socket::INET->new(
Listen => 20,
Proto => 'tcp',
LocalPort => $fport,
LocalHost => $fhost,
Description => "$fhost:$fport -> $thost:$tport",
Handler => $self,
Reuse => 1,
);
unless ($listener) {
warn "Could not listen at $fhost:$fport: $!";
return undef;
}
print "$self->{desc}\n" if $debug;
$self->{listener} = $listener;
return $self;
}
sub shutdown
{
my ($self) = @_;
print "SHUTDOWN $self->{desc}\n" if $debug;
$self->{listener}->close();
delete $self->{listener};
$self->{shutdown} = 1;
}
sub ie_connection
{
my ($self, $ioe) = @_;
print "CONNECT $self->{desc}\n" if $debug;
my $client = $ioe->accept();
my $client_ip = $client->peerhost();
my $filterblock = findNetblock($client_ip, $self->{filter})
|| findNetblock($client_ip, $filters{global});
if ($filterblock && $filterblock->{action} eq 'deny') {
print "DENIED from $client_ip for $self->{desc}\n";
$client->print("501 Relay denied $self->{line}\r\n");
$client->close();
} else {
print "accepted from $client_ip for $self->{desc}\n";
$client->readevents(0);
RelayConnect->new($client, $self->{desc}, $self->{tohost}, $self->{toport});
}
}
sub ie_input
{
die "why?";
}
package RelayConnect;
use strict;
use POSIX qw(ETIMEDOUT);
sub new
{
my ($pkg, $client, $desc, $tohost, $toport) = @_;
my $self = bless {
desc => $desc,
tohost => $tohost,
toport => $toport,
client => $client,
counter => $counter++,
}, $pkg;
IO::Event::Socket::INET->new(
PeerAddr => $tohost,
PeerPort => $toport,
Proto => 'tcp',
Handler => $self,
);
return undef;
}
sub ie_connected
{
my ($self, $ioe) = @_;
print "CONNECT Server$self->{counter} $self->{desc}\n" if $debug;
if ($self->{relaylisten}{shutdown}) {
# oh, well
$ioe->close();
return;
}
my $relayclient = Relay->new($self, $self->{client}, 'Client', $self->{desc});
bless $self, 'Relay';
$self->{other} = $relayclient;
$self->{role} = 'Server';
$self->{ioe} = $ioe;
delete $self->{client};
delete $self->{tohost};
delete $self->{toport};
}
sub ie_connect_failed
{
my ($self, $ioe, $error) = @_;
if ($error == ETIMEDOUT) {
print "TIMEOUT-CONNECT Server$self->{counter} $self->{desc}\n" if $debug;
$ioe->close();
new RelayConnect ($self->{client}, $self->{desc}, $self->{tohost}, $self->{toport});
} else {
print "NO-CONNECT Server$self->{counter} $self->{desc}: $error\n" if $debug;
$self->{client}->print("500 Relay open failed\r\n");
$self->{client}->close();
}
}
sub ie_input
{
die "why?";
}
package Relay;
use strict;
# also constructed by re-blessing RelayConnect objects
sub new
{
my ($pkg, $other, $ioe, $role, $desc) = @_;
my $self = bless {
ioe => $ioe,
other => $other,
role => $role,
desc => $desc,
counter => $counter++,
}, $pkg;
$ioe->handler($self);
$ioe->readevents(1);
return $self;
}
sub close
{
my ($self) = @_;
$self->{ioe}->close()
if $self->{ioe};
my $o = delete $self->{other};
$o->close() if $o;
}
sub ie_input
{
my ($self, $ioe, $ibr) = @_;
print "DATA $self->{role}$self->{counter} $self->{desc}\n" if $debug;
if (defined $self->{other}) {
$self->{other}{ioe}->print($$ibr) || warn "print: $!";
} else {
warn "other not defined";
}
$$ibr = '';
}
sub ie_werror
{
my ($self, $ioe) = @_;
print "WRITE-ERROR $self->{role}$self->{counter} $self->{desc}\n" if $debug;
$self->close();
}
sub ie_eof
{
my ($self, $ioe, $ibr) = @_;
print "EOF $self->{role}$self->{counter} $self->{desc}\n" if $debug;
$self->close();
}
sub ie_outputoverflow
{
my ($self, $ioe, $overflowing) = @_;
print "OVERFLOW-$overflowing $self->{role}$self->{counter} $self->{desc}\n" if $debug;
$self->{other}{ioe}->readevents(! $overflowing)
if $self->{other};
}
__END__
=head1 NAME
rinetd.pl - tcp redirection server
=head1 SYNOPSIS
rinetd.pl [ -c configfile ] [ -f ] { start | stop | reload | restart | check }
=head1 DESCRIPTION
Rinetd.pl forwards tcp connections from one IP address and port to
another. rinetd.pl can forward from multiple ports simultaneously
as defined in a config file (/etc/rinetd.pl.conf).
Rinetd.pl is called "rinetd.pl" instead of simply "rinetd" so as
to not be confused with Thomas Boutell's "rinetd" program.
Exactly one of imperitive is required on the command line:
=over 9
=item start
Start a new rinetd server if there isn't one already running.
=item stop
Stop a running rinetd server
=item restart
Stop the running rinetd server (if one is running).
Start a new rinetd server.
=item reload
Reconfigure the running rinetd server. Start a new server
if none is running.
=back
The command line options are:
=over 9
=item -c file
Specify an alternative configuration file. Multiple rinetd.pl servers
can run simultaneously if they have different config files.
=item -f
Run in the foreground. Normally rinetd.pl detaches itself and runs
as a deamon. When it runs as a daemon it redirects its output through
the logger(1) program.
=back
=head1 FORWARDING RULES
The format for forwarding rules (in the config file) is:
from-ip-address from-port to-ip-address to-port
IP addresses and ports can be numeric or named. Use 0.0.0.0 for
listening on all IP addresses.
=head1 FILTER RULES
Allow and deny rules can control what IP addresses are allowed
to use the server.
The format of rules is:
allow|deny netblock
Filters that follow a forwarding rule apply to that
forwarding rule only.
Filters that preceed any forwarding rules apply to
all forwarding rules if no per-forwarding rule filter
matches.
Filters are not ordered: the most specific filter (smallest
network block) that matches is the one that is used.
Filter rules may be indented for clarity. Filter rules must be
numeric -- hostnames are not allowed.
=head1 EXAMPLE CONFIG
# We have to start with the global access
# control list.
# The order of the rules does not matter.
deny any # '0.0.0.0/0' and 'default' work too
deny 216.240.32.1
allow 216.240.32/24
0.0.0.0 8282 idiom.com 23
allow 216.240.47/24
deny 216.240.47.38
deny 216.240.32.4
0.0.0.0 daytime idiom.com daytime # idiom's clock is better
=head1 LICENSE
Copyright (C) 2005,2006 David Muir Sharnoff <cpan@dave.sharnoff.org>
Copyright (C) 2013 Google, Inc.
This module may be used/copied/etc on the same terms as Perl
itself.