#!/usr/bin/perl -w
use strict;
use Digest::MD5 qw(md5_base64);

## Master Control Program slave shell.
## Copyiright 2008, JS Stellingwerff
## License: This script can be used under the same terms as Perl itself, either Perl version 5.8 or later.

# password to (over)write configuration directives to ~/.mcprc
# password should be an Base64 encoded md5 hash (you want to change this :)
my $password = '0W5F5Bzjlu0dqwkXaoU1Ax';

# locations to look for config, in this order
my @rcfiles = ('/etc/mcprc', "$ENV{HOME}/.mcprc");

my %comm = (readconfig => \&readconfig, writeconfig => \&writeconfig, quit => \&quit);

# End of configuration

my @readfiles;
for my $file (@rcfiles) {
    my $ret;
    next if(!-e $file);
    if($ret = do $file) {
        push(@readfiles, $file);
        $comm{$_} = $ret->{$_} for(keys(%{$ret}));
    } else {
        warn "couldn't parse $file: $@" if $@;
        warn "couldn't do $file: $!"    unless defined $ret;
        warn "couldn't run $file"       unless $ret;
    }
}

print 'mcp>';
while(my $input = <STDIN>) {
    my ($command, $arg) = $input =~ /^([a-zA-Z0-9_-]+)\s?(.*?)$/;
    my @args;

    next if(!$command);
    next if($command =~ /^#/);

    @args = split(/\s+/, $arg) if($arg);
    eval { $comm{$command}->(@args); };
    error("Command died with error: $@") if($@);    
    print 'mcp>';
}

# quit program.
sub quit {
    print "Bye!\n";
    exit 0;
}

# reads configuration.
sub readconfig {
    for my $filename (@readfiles) {
        open(my $fh, $filename) or return error("Cannot read: $filename! ($!)");
        print "# Filename: $filename\n";
        print <$fh>;
        close($fh)
    }
}

# writes a new configuration to ~/.mcprc, requires password
sub writeconfig {
    my ($arg) = @_;
    return error("No Password provided!") if(!defined($arg));
    return error("Incorrect Password!") if(md5_base64($arg) ne $password);
    return error("No such directory: $ENV{HOME}") if(!-d "$ENV{HOME}");

    my $rcfile = "$ENV{HOME}/.mcprc";
    open(my $rcfh, "> $rcfile") or return error("Cannot open $rcfile for writing: $!");
    while(<STDIN>) {
        print $rcfh $_;
    }
    close($rcfh);
}

sub error {
    my ($message) = @_;
    print STDERR "$message\n";
    return undef;
}