ljr/wcmtools/spud/bin/cmdshell

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;
}