use warnings;
use strict;
use IPC::Run qw( run timeout );
my @command = ('ls', '-la');
#print "cmd = @command\n";
    
my ( $buff );

my $exit = '0';
run \@command, \$buff, timeout(10) or $exit = 1; 
    
print "exit code = $exit\n";

##</code><code>##

#!/usr/bin/perl
use warnings;
use strict;
use IPC::Run qw( run timeout );

my $return = ( suba("XYZ") == 0 ) ? "success" : "failure";
print "return = $return\n";

sub suba
{
    my $job = shift;
    if ( $job =~ /^XYZ/ )
    {
        my @return = subb();
        my $exit = shift @return;
        print "exit = $exit\n";
        print "$_\n" for @return;
    }
} 

sub subb
{
    my @command = ('ls', '-la');

    my ( $buff, $in, $err );

    my $exit;
    run \@command, \$in, \$buff, \$err, timeout(10) and $exit = $?; 
    print "exit = $exit\n"; 

    my @return;

    push (@return, $exit, $buff);
    print "$_\n" for @return;
    return @return;
}

##</code><code>##

#!/usr/bin/perl
#$Id: Meru-Server.pl,v 1.2 2006/05/03 13:26:33 tfiedler Exp $

use strict;
use warnings;
use IPC::Run qw( run timeout );
use IO::Socket::INET;
use Crypt::CBC;
use Carp;

my $cipher = Crypt::CBC->new( -key => 'S3cr#tabcDeSal35', -cipher => 'Blowfish' );

my $port = 62750;

my $LOG;

$SIG{CHLD} = 'IGNORE';
$SIG{INT}  = 'IGNORE';

my $listener = IO::Socket::INET->new(LocalPort => $port,
                                     Listen    => 10,
                                     Proto     => 'tcp',
                                     Reuse     => 1);

confess "Error creating a listener on port 62570: $@\n"
    unless $listener;

open $LOG, "+>>", "Log.txt" or
    carp "Unable to open Log.txt: $@\n";

print "[Listening on port $port]\n";

while ( my $connection = $listener->accept)
{  
    my $child;
    confess "Cannot fork a process: $!\n"
        unless defined ( $child = fork() );

    
    if ( $child == 0 )
    {
        $listener->close;

        $connection->print("\n");
        $connection->print("connected\n");

        my $receive;
        if ( defined( $connection->recv($receive, 100,0) ) )
        {
            chomp($receive);
            my $command = $cipher->decrypt($receive);
            print "processing \"$receive\" => \"$command\"\n";
            print $LOG scalar(localtime), " $$ received: $receive\n";
            print $LOG scalar(localtime), " $$ decrypted: $command\n";
            $connection->print("your command was received\n");

            my $return = ( execute_command("$command") == 0 ) ? "success" : "failure";

            print $LOG scalar(localtime), " $$ \"$command\" $return\n";

            $connection->print("Your command ended in $return\n");
            $connection->print("Goodbye\n");
            $connection->print("1970__");
        }
            

    }
    else 
    {
        print $LOG scalar(localtime), " $$ Connect from ", $connection->peerhost, "\n";
        print "Connection from ", $connection->peerhost, "\n";
        $connection->close();
    }
}

sub execute_command
{
    my $line = shift;
    my @info = ( grep /\|/, $line ) ? split /\|/, $line : $line;
    #my @info = split /\|/, $line || $line;
    my $job  = $info[0];

    print $LOG scalar(localtime), " $$ job = $job info = @info\n";

    my $return = 2;
 
    print "job = $job\n";
 
    $return = ( ListKillProc(@info)       == 0 ) ? 0 : 1 
        if ( $job =~ /^ListKillProc/     );

    $return = ( unlockuser(@info)         == 0 ) ? 0 : 1
        if ( $job =~ /^unlockuser/       );

    $return = ( changepass(@info)         == 0 ) ? 0 : 1
        if ( $job =~ /^changepass/       );

    $return = ( showprintersall(@info)    == 0 ) ? 0 : 1
        if ( $job =~ /^showprintersall/  );

    $return = ( showprintersuser(@info)   == 0 ) ? 0 : 1
        if ( $job =~ /^showprintersuser/ );
        
    $return = ( showprinter(@info)        == 0 ) ? 0 : 1
        if ( $job =~ /^showprinter/      );

    $return = ( killprint(@info)          == 0 ) ? 0 : 1
        if ( $job =~ /^killprint/        );
    print "return before = $return\n";

    if ( $job =~ /^APP/ )
    {
        my @return = APP();
        my $exit = shift @return;
        print "exit = $exit\n";
        print @return;
        return $exit;
    }

    print $LOG scalar(localtime), " $$ execution return code = $return\n";

    return $return;
    
}

sub APP
{
    my @command = ('ls', '-la');
    print $LOG scalar(localtime), " $$ cmd = @command\n";
    
    my ( $buff, $in, $err );

    my $exit;
    run \@command, \$in, \$buff, \$err, timeout(10) and $exit = $?;
    print "exit = $exit\n"; 
    print $LOG scalar(localtime), " $$ exit code =", $exit, "\n";

    #print $out if $out;

    my @return;

    push (@return, $exit, $buff);
    print "$_\n" for @return;
    return @return;
}

sub AUTOLOAD
{
    print "I dont know how to do $_[0]\n";
    print $LOG scalar(localtime), " $$ Uh Oh we hit the Autoloader: no match for $_[0]\n";
    return 1;
}

##</code><code>##

#!/usr/bin/perl
#$Id: menu.pl,v 1.3 2006/05/03 13:27:47 tfiedler Exp $

use strict;
use warnings;
use IO::Socket::INET;
use Crypt::CBC;

my $cipher = Crypt::CBC->new( -key => 'S3cr#tabcDeSal35', -cipher => 'Blowfish');

$SIG{INT} = 'IGNORE';

sub do_menu
{
	my( $menu ) = @_;
	while(1)
	{
		my( $menu ) = @_;
		# display the menu
		print "\n";
		print $_+1, '. ', $menu->[$_]{'label'}, "\n"
			for 0 .. $#{$menu};
		print '0. ', ( @_ > 1 ? 'Return' : 'Exit' ), "\n";
		# get the user's input
		local @ARGV;
		print STDERR '> ';
		local $_ = <>; chomp;

		/\d/ && !/\D/ or next;
		$_ == 0 and last; # item 0 is special
		defined $menu->[$_-1] or warn("Invalid choice\n"), next;

		my $op = $menu->[$_-1]{'op'};
		my $arg = $menu->[$_-1]{'arg'};
		if ( $op eq 'submenu' )
		{
			do_menu( $arg, @_ ); # maintain the stack!
		}
		elsif ( $op eq 'exec_cmd' )
		{
			execute_command( $arg );
		}
		else
		{
			warn "Unrecognized op '$op'\n";
		}
	}
}


my @printers_menu = (
	{
		label => 'Show all Printers',
		op => 'exec_cmd',
		arg => 'showprintersall',
	},
	{
		label => 'Show user print jobs',
		op => 'exec_cmd',
		arg => 'showprintersuser',
	},
	{
		label => 'Show single printer',
		op => 'exec_cmd',
		arg => 'showprinter',
	},
	{
		label => 'Kill a print job',
		op => 'exec_cmd',
		arg => 'killprint',
	},
);

my @accounts_menu = (
	{
		label => 'Unlock user account',
		op => 'exec_cmd',
		arg => 'unlockuser',
	},
	{
		label => 'Change account password',
		op => 'exec_cmd',
		arg => 'changepass',
	},
);

my @main_menu = (
	{
		label => 'List and Kill UDT* processes by user',
		op => 'exec_cmd',
		arg => 'ListKillProc',
	},
	{
		label => 'List and Kill Print Jobs...',
		op => 'submenu',
		arg => \@printers_menu,
	},
	{
		label => 'Manage user accounts...',
		op => 'submenu',
		arg => \@accounts_menu,
	},
	{
		label => 'Run App',
		op => 'exec_cmd',
		arg => 'APP',
	},
);

sub execute_command
{
	warn "Executing command @_\n";
    
    my $command = $_[0];
    
    my @stack = &build_stack($command);
    
    my $STACK = join'|', @stack;

    my $cryptostack = $cipher->encrypt($STACK);

    if ($STACK =~ /^\d/)
    {
        print "Houston we have a problem... STACK = $STACK\n";
        return 1;
    }

    my $return = ( send_stack($cryptostack) == 0 ) ? "successful" : "unsuccessful" ;

    print "transmission of data was $return\n";
}

sub build_stack
{
    my $command = @_;
    my @needed = ();
    my $set = \&set_item;
    my ( $username, $password, $password2, $jobid, $printer );

    push (@needed, @_);
       
    return @needed 
        if grep ( /^(APP|showprintersall)/, @_ );
        
    if ( grep /^(showprintersuser|unlockuser|ListKillProc|changepass)/, @_ )
    {
        $username = $set->('username');
        push (@needed, $username);
    } 

    if ( grep /^changepass/, @_ )
    {
        $password = $set->('password');
        $password2 = $set->('password2');
        return 0 if ( $password ne $password2 );
        push (@needed, $password);
    }

    if ( grep /^showprinter/, @_ )
    {
       $printer = $set->('printer');
        push (@needed, $printer);
    }
            
    if ( grep /^killprint/, @_ )
    {
        $jobid = $set->('jobid');
        push (@needed, $jobid);
    }
    return @needed;
}

sub set_item
{
    print "Enter @_: ";
    my $item = <stdin>;
    chomp($item);
    return $item;
}

sub send_stack
{
    my $send = shift;

    my $host = shift || "localhost";
    my $port = shift || 62750;

    my $sock = IO::Socket::INET ->new(
            PeerAddr => $host,
            PeerPort => $port,
            Proto    => 'tcp' );

    $sock->print($send);

    my $rtrn = 1;

    while (my $receive = <$sock>)
    {
        if ($receive =~ /^1970__/)
        {
            $rtrn = 0;
            last;
        }

        chomp($receive);
        print "$receive\n";
    }
    
    return $rtrn;

}

sub AUTOLOAD
{
    print "Sorry, I dont know how to do @_";
    return 1;
}

do_menu( \@main_menu );

##</code><code>##

[Listening on port 62750]
processing "Salted__
##&o#uw##" => "APP"
job = APP
return before = 2
Connection from 127.0.0.1
Use of uninitialized value in concatenation (.) or string at ./Menu-Server.pl line 136.
exit = 
Use of uninitialized value in print at ./Menu-Server.pl line 137.
Use of uninitialized value in concatenation (.) or string at ./Menu-Server.pl line 144.

total 10976
drwxr-x--- 4 tfiedler tfiedler     4096 May  4 09:42 .
drwxr-x--- 4 tfiedler tfiedler     4096 Apr 27 14:53 ..
-rw-r----- 1 tfiedler tfiedler 11115686 May  3 10:02 cbkwanzaa.wmv
-rwxr-x--- 1 tfiedler tfiedler     2659 May  1 16:29 client-test.pl
-rwxr-x--- 1 tfiedler tfiedler      659 May  4 09:05 ipcruntest.pl
-rw-r----- 1 tfiedler tfiedler      364 May  3 13:31 ipctest.pl
-rw-r----- 1 tfiedler tfiedler    31945 May  4 09:43 Log.txt
-rw-r----- 1 tfiedler tfiedler    16384 May  4 09:29 .Log.txt.swp
-rwxr-x--- 1 tfiedler tfiedler     3982 May  3 13:12 menu.pl
-rwxr-x--- 1 tfiedler tfiedler     3993 May  4 09:41 Menu-Server.pl
drwxr-x--- 2 tfiedler tfiedler     4096 May  1 08:09 ms1help
-rw-r----- 1 tfiedler tfiedler    14544 Apr 27 14:51 perlscript.zip
drwxr-x--- 2 tfiedler tfiedler     4096 May  3 09:28 RCS
-rwxr-x--- 1 tfiedler tfiedler     1775 May  2 13:56 server-test.pl

Use of uninitialized value in concatenation (.) or string at ./Menu-Server.pl line 116.
exit = 
total 10976
drwxr-x--- 4 tfiedler tfiedler     4096 May  4 09:42 .
drwxr-x--- 4 tfiedler tfiedler     4096 Apr 27 14:53 ..
-rw-r----- 1 tfiedler tfiedler 11115686 May  3 10:02 cbkwanzaa.wmv
-rwxr-x--- 1 tfiedler tfiedler     2659 May  1 16:29 client-test.pl
-rwxr-x--- 1 tfiedler tfiedler      659 May  4 09:05 ipcruntest.pl
-rw-r----- 1 tfiedler tfiedler      364 May  3 13:31 ipctest.pl
-rw-r----- 1 tfiedler tfiedler    31945 May  4 09:43 Log.txt
-rw-r----- 1 tfiedler tfiedler    16384 May  4 09:29 .Log.txt.swp
-rwxr-x--- 1 tfiedler tfiedler     3982 May  3 13:12 menu.pl
-rwxr-x--- 1 tfiedler tfiedler     3993 May  4 09:41 Menu-Server.pl
drwxr-x--- 2 tfiedler tfiedler     4096 May  1 08:09 ms1help
-rw-r----- 1 tfiedler tfiedler    14544 Apr 27 14:51 perlscript.zip
drwxr-x--- 2 tfiedler tfiedler     4096 May  3 09:28 RCS
-rwxr-x--- 1 tfiedler tfiedler     1775 May  2 13:56 server-test.pl
Use of uninitialized value in numeric eq (==) at ./Menu-Server.pl line 57.

##</code><code>##

exit = 0
0
total 10976
drwxr-x--- 4 tfiedler tfiedler     4096 May  4 09:45 .
drwxr-x--- 4 tfiedler tfiedler     4096 Apr 27 14:53 ..
-rw-r----- 1 tfiedler tfiedler        0 May  4 09:47 1
-rw-r----- 1 tfiedler tfiedler 11115686 May  3 10:02 cbkwanzaa.wmv
-rwxr-x--- 1 tfiedler tfiedler     2659 May  1 16:29 client-test.pl
-rwxr-x--- 1 tfiedler tfiedler      659 May  4 09:05 ipcruntest.pl
-rw-r----- 1 tfiedler tfiedler      364 May  3 13:31 ipctest.pl
-rw-r----- 1 tfiedler tfiedler    32031 May  4 09:43 Log.txt
-rw-r----- 1 tfiedler tfiedler    16384 May  4 09:29 .Log.txt.swp
-rwxr-x--- 1 tfiedler tfiedler     3982 May  3 13:12 menu.pl
-rwxr-x--- 1 tfiedler tfiedler     3993 May  4 09:41 Menu-Server.pl
drwxr-x--- 2 tfiedler tfiedler     4096 May  1 08:09 ms1help
-rw-r----- 1 tfiedler tfiedler    14544 Apr 27 14:51 perlscript.zip
drwxr-x--- 2 tfiedler tfiedler     4096 May  3 09:28 RCS
-rwxr-x--- 1 tfiedler tfiedler     1775 May  2 13:56 server-test.pl

exit = 0
total 10976
drwxr-x--- 4 tfiedler tfiedler     4096 May  4 09:45 .
drwxr-x--- 4 tfiedler tfiedler     4096 Apr 27 14:53 ..
-rw-r----- 1 tfiedler tfiedler        0 May  4 09:47 1
-rw-r----- 1 tfiedler tfiedler 11115686 May  3 10:02 cbkwanzaa.wmv
-rwxr-x--- 1 tfiedler tfiedler     2659 May  1 16:29 client-test.pl
-rwxr-x--- 1 tfiedler tfiedler      659 May  4 09:05 ipcruntest.pl
-rw-r----- 1 tfiedler tfiedler      364 May  3 13:31 ipctest.pl
-rw-r----- 1 tfiedler tfiedler    32031 May  4 09:43 Log.txt
-rw-r----- 1 tfiedler tfiedler    16384 May  4 09:29 .Log.txt.swp
-rwxr-x--- 1 tfiedler tfiedler     3982 May  3 13:12 menu.pl
-rwxr-x--- 1 tfiedler tfiedler     3993 May  4 09:41 Menu-Server.pl
drwxr-x--- 2 tfiedler tfiedler     4096 May  1 08:09 ms1help
-rw-r----- 1 tfiedler tfiedler    14544 Apr 27 14:51 perlscript.zip
drwxr-x--- 2 tfiedler tfiedler     4096 May  3 09:28 RCS
-rwxr-x--- 1 tfiedler tfiedler     1775 May  2 13:56 server-test.pl

return = success