101 lines
2.7 KiB
Perl
Executable File
101 lines
2.7 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# Danga's Command Shell
|
|
# Glue that takes incoming connection on STDIN/STDOUT and forwards it to a
|
|
# local server running on a certain port. This is meant to be an account's
|
|
# shell in /etc/passwd.
|
|
#
|
|
# Configuration file format:
|
|
#
|
|
# <command> = <server> : <port>
|
|
#
|
|
# Caveats & Warnings:
|
|
# This program must be in a bin directory. E.g. /home/lj/bin/cmdshell. It
|
|
# will extrapolate the location of its config file as the portion
|
|
# before the bin/ plus conf/cmdshell.conf. So, for the example above,
|
|
# /home/lj/conf/cmdshell.conf is expected to exist.
|
|
#
|
|
# Copyright 2004, Danga Interactive
|
|
#
|
|
# Authors:
|
|
# Mark Smith <marksmith@danga.com>
|
|
#
|
|
# License:
|
|
# undecided.
|
|
#
|
|
|
|
# uses
|
|
use strict;
|
|
use IO::Socket;
|
|
|
|
# known commands
|
|
my %commands;
|
|
|
|
# try to guess the config file location?
|
|
if ($0 =~ m!^(.+)/bin/cmdshell$!) {
|
|
my $conf = "$1/conf/cmdshell.conf";
|
|
die "Config file $conf not found." unless -e $conf;
|
|
|
|
# open and parse
|
|
open FILE, "<$conf"
|
|
or die "Unable to open config file $conf: $!\n";
|
|
while (my $line = <FILE>) {
|
|
if ($line =~ /^\s*([^#].*)\s*=\s*(.*)\s*/) {
|
|
my ($l, $r) = (trim($1), trim($2));
|
|
if ($r =~ /^(.+)\s*:\s*(\d+)/) {
|
|
my ($host, $port) = (trim($1), trim($2)+0);
|
|
die "Invalid port '$2' for command $l in '$line'.\n" unless $port;
|
|
$commands{$l} = [ $host, $port ];
|
|
} else {
|
|
die "Invalid config file line: $line\n";
|
|
}
|
|
}
|
|
}
|
|
close FILE;
|
|
} else {
|
|
die "Unable to guess config file based off of path: $0\n";
|
|
}
|
|
|
|
# we're running, verify we have info
|
|
my $user = $ENV{LJUSERNAME};
|
|
my $cmd = lc($ENV{LJCOMMAND});
|
|
$cmd = '' unless $cmd =~ /^golive|replicator$/;
|
|
die "No information for command '$cmd'\n" unless $user && $cmd;
|
|
|
|
# now based on command, open connection to port
|
|
my $socket = IO::Socket::INET->new(Proto => 'tcp',
|
|
PeerAddr => $commands{$cmd}->[0],
|
|
PeerPort => $commands{$cmd}->[1],)
|
|
or die "Unable to connect to command server ($commands{$cmd}->[0]:$commands{$cmd}->[1])\n";
|
|
$socket->autoflush(1);
|
|
|
|
# parent pid
|
|
my $ppid = $$;
|
|
|
|
# now fork
|
|
my $kidpid;
|
|
die "Unable to fork: $!\n" unless defined($kidpid = fork());
|
|
|
|
# basic parts that handle reading/writing from the two sides
|
|
if ($kidpid) {
|
|
# parent
|
|
while (defined (my $line = <$socket>)) {
|
|
print STDOUT $line;
|
|
}
|
|
kill("TERM" => $kidpid); # death to the children
|
|
} else {
|
|
# child
|
|
while (defined (my $line = <STDIN>)) {
|
|
print $socket $line;
|
|
}
|
|
kill("TERM" => $ppid); # kill parent since we died
|
|
}
|
|
|
|
# little trimming sub
|
|
sub trim {
|
|
my $res = shift;
|
|
$res =~ s/^\s+//;
|
|
$res =~ s/\s+$//;
|
|
return $res;
|
|
}
|