#!/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;
}