MJAM/Command/Shell.pm

package MJAM::Command::Shell;

use strict;
use warnings;

use Env qw ( HOME );
use IO::File;
use POE;
use MJAM::main;
use Term::ReadKey;

my @sh_commands_local = qw ( connect sc exit quit help ? );
my @sh_commands_remote = qw ( tell bye );

my %cfg;
$cfg{branding}{console_name} = "jash";

my %console;
$console{commands} = \@sh_commands_local;
$console{context} = "";

my %conn;
$conn{type} = "";
$conn{file_name} = "";
$conn{target} = "";
$conn{connected} = 0;
$conn{user} = 'anonymous';
$conn{remote_host} = "";
$conn{remote_port} = "";
$conn{commands} = \@sh_commands_remote;

my $poe_alias;

my %helpmsg;

$helpmsg{connect} = <<EOH;
 COMMAND:
   connect
 
 SYNOPSIS:
   connect
   connect cmdfile [cmdfile]
   connect rpc [username\@][hostname]

 DESCRIPTION:
   Connect to a local or remote command-engine
EOH

$helpmsg{sc} = <<EOH;
 COMMAND:
   sc (switch context)

 SYNOPSIS:
   sc <context>

 DESCRIPTION:
   Switches console-context to "<context>".
   Every remote-command issued from now on will be prefixed by the console-context.
   Delete a context by just typing "sc".
EOH

$helpmsg{exit} = <<EOH;
 COMMAND:
   exit|quit

 SYNOPSIS:
   exit
   quit

 DESCRIPTION:
   Quits from shell.
EOH
$helpmsg{quit} = $helpmsg{exit};

$helpmsg{tell} = <<EOH;
 COMMAND:
   tell

 SYNOPSIS:
   tell <target>|<alias> <command>

 DESCRIPTION:
   Tells an (aliased) target what to do
EOH


sub getUsage {
  my $bool_connected = "no";
  $conn{connected} && ($bool_connected = "yes");
  my $helpmsg = <<EOH;
----------------------------------------------------------
 commands:
  - local-commands:    @{$console{commands}}
  - remote-commands:   @{$conn{commands}}
----------------------------------------------------------
 status:
  - console-context:   $console{context}
  - connected:         $bool_connected
  - connection-target: $conn{target}
----------------------------------------------------------
EOH
}

sub getHelpMsg {
  my $helpkey = shift;
  my $msg = "";
  if ($helpmsg{$helpkey}) {
    $msg .= <<MSG;
---------------------------------------------
MSG
    $msg .= $helpmsg{$helpkey};
  }
  return $msg;
}

sub lCmd {

  my $cmd = shift;
  #print "lCmd: $cmd", "\n";
  
  #if ($cmd eq 'quit' || $cmd eq 'exit') { exit; }
  if ($cmd eq 'quit' || $cmd eq 'exit') { 
    ReadMode 1;
    exit; 
  }
  
  if ($cmd =~ m/(help|\?)\s*(.*)/) {
    my $helpkey = $2;
    if ($helpkey) {
      return getHelpMsg($helpkey);
    } else {
      return getUsage();
    }
  }
  
  if ($cmd =~ m/connect\s*(.*)/) {
    my $param = $1;
    my $c_where = "";
    my $c_args = "";
    if ($param =~ m/(cmdfile|rpc)\s*(.*)/) {
      $c_where = $1;
      $c_args = $2;
    } else {
      $c_where = "cmdfile";
    }
    rConnect($c_where, $c_args);
    return;
  }

  if ($cmd =~ m/sc\s*(.*)/) {
    my $context = $1;
    $console{context} = '';
    $console{context} = $1;
    return;
  }

}

sub rConnect {
  my $where = shift;
  my $args = shift;

  # local
  if ($where eq 'cmdfile') {
    if (!$args) { 
      $args = $HOME . '/.mjamcmd';
    }
    my $file = $args;
    if (-e $file) {
      print "trying to connect to $where ($args)", "\n";
      $conn{type} = "cmdfd";
      $conn{file_name} = $args;
      $conn{connected} = 1;
      $conn{target} = $conn{file_name};
    }
  }
  
  # rpc
  if ($where eq 'rpc') {
    if (!$args) { 
      $args = 'anonymous@localhost:7777';
    }
    if ($args =~ m/^(.+)\@(.+):+(.+)$/) {
      $conn{user} = $1;
      $conn{remote_host} = $2;
      $conn{remote_port} = $3;
    } elsif ($args =~ m/^(.*):*(.*)$/) {
      $conn{remote_host} = $1;
      $conn{remote_port} = $2;
    }
    
    $conn{user} || ($conn{user} = "anonymous");
    $conn{remote_host} || ($conn{remote_host} = "localhost");
    $conn{remote_port} || ($conn{remote_port} = "7777");
    my $url = 'http://' . $conn{user} . '@' . $conn{remote_host} . ':' . $conn{remote_port} . '/';
      
    if (1) {
      print "trying to connect to $where ($url)", "\n";
      $conn{type} = "rpc";
      $conn{connected} = 1;
      $conn{target} = $url;
      $poe_kernel->post('cmdcore', 'docmd', 'tell rpcxmla start');
      $poe_kernel->run_one_timeslice();

      my $meta = {
        Connection => \%conn,
        RequestSession => '',
        RequestState => '',
        ResponseSession => $poe_alias,
        ResponseState => 'issueResponse',
      };
      $poe_kernel->post( rpcxmla => setMeta => $meta );
      $poe_kernel->post( rpcxmla => 'startAgent' );
      
      #$conn{file_name} = $args;
      #$conn{connected} = 1;
      #$conn{target} = $conn{file_name};
    }
  }
  
}

sub rCmd {
  my $cmd = shift;
  if (!$conn{connected}) {
    print "\"$cmd\" is a remote command, please connect first!", "\n";
    return;
  }
  #my $fh = $conn{file_handle};
  my $handle = IO::File->new($conn{file_name}, "a+");
  $handle->print($cmd, "\n");
  $handle->close();
  return "done???";
}


sub issueCmd {

  # ----------------------------------------------------
  # get poe vars and resolve sender
  my ( $kernel, $session, $heap, $sender, $cmd, $target ) = @_[ KERNEL, SESSION, HEAP, SENDER, ARG0, ARG1 ];
  my $recieved = $cmd;
  if ($sender == $kernel) {
    my $caller = "Kernel" . " (Kernel " . $sender->ID() . ")";
    $recieved .= " (from \"" . $caller . "\")";
  } else {
    my $sender_heap = $sender->get_heap();
    my $caller = $sender_heap->{state}{Caption} . " (Session " . $sender->ID() . ")";
    $recieved .= " (from \"" . $caller . "\")";
  }
  DEBUG() && print __PACKAGE__, ": #>", $recieved, "\n";
  # ----------------------------------------------------

  $heap->{target} = $target;
  
  my $cmd_console = $cmd;
  
  my $cmd_issue;
  
  # if the console-command is empty, just return
  if (!$cmd_console) { return; }
  
  # split console-command by whitespace
  my @cmd = split(' ', $cmd_console);

  # is it a local command ...
  $cmd_issue = $cmd_console;
  if (in_array($cmd[0], $console{commands})) {
    my $result = lCmd($cmd_console);
    $kernel->post($session => issueResponse => $result);
    return 1;
  }
  
  # prefix console-command with console-context ;), to build complete remote-command
  my $context = '';
  $console{context} && ($context = $console{context} . " ");
  my $cmd_remote = $context . $cmd_console;
  
  # split remote-command by whitespace
  my @cmdr = split(' ', $cmd_remote);

  # ... or is it a remote one?
  $cmd_issue = $cmd_remote;
  if (in_array($cmdr[0], $conn{commands})) {
    if ($conn{type} eq 'rpc') {
      # dispatch to rpc
      my $data = {
        method => 'spoo',
        args => $cmd_remote,
      };
      $kernel->post( rpcxmla => request => $data );
    } else {
      # dispatch to cmdfd
      my $result = rCmd($cmd_remote);
      $kernel->post($session => issueResponse => $result);
    }
    return 1;
  }
  
  # unknown command, print this to shell
  my $result = "unknown command (\"$cmd_issue\"), type ? for help.";
  #$kernel->post($session => issuePromptChange => 1);
  $kernel->post($session => issueResponse => $result);
  return 1;
  
}


sub getPromptPart {
  my @parts;
  if ($conn{connected}) {
    my $target_prompt;
    if ($conn{type} eq "cmdfd") {
      $target_prompt = "cmdfd";
    } else {
      $target_prompt = $conn{remote_host};
    }
    push(@parts, "(" . $conn{user} . "\@" . $target_prompt . ")");
  }
  if ($console{context}) {
    push(@parts, "[ $console{context} ]");
  }

  my $tmp_login = '';
  $tmp_login = join(' ', @parts);
  if ($tmp_login) {
    return $tmp_login;
  }
}


sub issueResponse {
  my ( $kernel, $session, $heap, $sender, $response ) = @_[ KERNEL, SESSION, HEAP, SENDER, ARG0 ];
  #if ($sender != $kernel) {
    #my $sender_heap = $sender->get_heap();
#    print "rs: ", $heap->{meta}{ResponseSession}, "\n";
#    print "rs: ", $heap->{meta}{ResponseState}, "\n";
#  print "response: $response", "\n";
  $kernel->post($heap->{target}{ResponseSession} => $heap->{target}{PromptChangeState} => getPromptPart());
  $kernel->post($heap->{target}{ResponseSession} => $heap->{target}{ResponseState} => $response);
    #if ($response) {
      #print $response, "\n";
    #}
    #return 1;
  #}
}

sub issuePromptChange {
  my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];
  my $prompt = getPrompt();
  $kernel->post($heap->{target}{ResponseSession} => $heap->{target}{PromptChangeState} => $prompt);
}


sub _start {
  my ( $kernel, $session, $heap, $arg0 ) = @_[ KERNEL, SESSION, HEAP, ARG0 ];
  $kernel->alias_set($poe_alias);
  DEBUG() && print __PACKAGE__, " started", "\n";
}


sub start {

  $poe_alias = shift;

  my @handlers = qw( 
    _start
    issueCmd
    issueResponse
    issuePromptChange
  );
  
  my $pkg = __PACKAGE__;
  
  # the main session for the command-engine
  POE::Session->create( 
    package_states => [ $pkg => \@handlers ],
    args => [  ],
  );

}


1;
1	cvsjoko	1.1	package MJAM::Command::Shell;
2
3			use strict;
4			use warnings;
5
6			use Env qw ( HOME );
7			use IO::File;
8			use POE;
9			use MJAM::main;
10	cvsjoko	1.2	use Term::ReadKey;
11	cvsjoko	1.1
12			my @sh_commands_local = qw ( connect sc exit quit help ? );
13			my @sh_commands_remote = qw ( tell bye );
14
15			my %cfg;
16			$cfg{branding}{console_name} = "jash";
17
18			my %console;
19			$console{commands} = \@sh_commands_local;
20			$console{context} = "";
21
22			my %conn;
23			$conn{type} = "";
24			$conn{file_name} = "";
25			$conn{target} = "";
26			$conn{connected} = 0;
27			$conn{user} = 'anonymous';
28			$conn{remote_host} = "";
29			$conn{remote_port} = "";
30			$conn{commands} = \@sh_commands_remote;
31
32			my $poe_alias;
33
34			my %helpmsg;
35
36			$helpmsg{connect} = <<EOH;
37			COMMAND:
38			connect
39
40			SYNOPSIS:
41			connect
42			connect cmdfile [cmdfile]
43			connect rpc [username\@][hostname]
44
45			DESCRIPTION:
46			Connect to a local or remote command-engine
47			EOH
48
49			$helpmsg{sc} = <<EOH;
50			COMMAND:
51			sc (switch context)
52
53			SYNOPSIS:
54			sc <context>
55
56			DESCRIPTION:
57			Switches console-context to "<context>".
58			Every remote-command issued from now on will be prefixed by the console-context.
59			Delete a context by just typing "sc".
60			EOH
61
62			$helpmsg{exit} = <<EOH;
63			COMMAND:
64			exit\|quit
65
66			SYNOPSIS:
67			exit
68			quit
69
70			DESCRIPTION:
71			Quits from shell.
72			EOH
73			$helpmsg{quit} = $helpmsg{exit};
74
75			$helpmsg{tell} = <<EOH;
76			COMMAND:
77			tell
78
79			SYNOPSIS:
80			tell <target>\|<alias> <command>
81
82			DESCRIPTION:
83			Tells an (aliased) target what to do
84			EOH
85
86
87			sub getUsage {
88			my $bool_connected = "no";
89			$conn{connected} && ($bool_connected = "yes");
90			my $helpmsg = <<EOH;
91			----------------------------------------------------------
92			commands:
93			- local-commands: @{$console{commands}}
94			- remote-commands: @{$conn{commands}}
95			----------------------------------------------------------
96			status:
97			- console-context: $console{context}
98			- connected: $bool_connected
99			- connection-target: $conn{target}
100			----------------------------------------------------------
101			EOH
102			}
103
104			sub getHelpMsg {
105			my $helpkey = shift;
106			my $msg = "";
107			if ($helpmsg{$helpkey}) {
108			$msg .= <<MSG;
109			---------------------------------------------
110			MSG
111			$msg .= $helpmsg{$helpkey};
112			}
113			return $msg;
114			}
115
116			sub lCmd {
117
118			my $cmd = shift;
119			#print "lCmd: $cmd", "\n";
120
121			#if ($cmd eq 'quit' \|\| $cmd eq 'exit') { exit; }
122	cvsjoko	1.2	if ($cmd eq 'quit' \|\| $cmd eq 'exit') {
123			ReadMode 1;
124			exit;
125			}
126	cvsjoko	1.1
127			if ($cmd =~ m/(help\|\?)\s(.)/) {
128			my $helpkey = $2;
129			if ($helpkey) {
130			return getHelpMsg($helpkey);
131			} else {
132			return getUsage();
133			}
134			}
135
136			if ($cmd =~ m/connect\s(.)/) {
137			my $param = $1;
138			my $c_where = "";
139			my $c_args = "";
140			if ($param =~ m/(cmdfile\|rpc)\s(.)/) {
141			$c_where = $1;
142			$c_args = $2;
143			} else {
144			$c_where = "cmdfile";
145			}
146			rConnect($c_where, $c_args);
147			return;
148			}
149
150			if ($cmd =~ m/sc\s(.)/) {
151			my $context = $1;
152			$console{context} = '';
153			$console{context} = $1;
154			return;
155			}
156
157			}
158
159			sub rConnect {
160			my $where = shift;
161			my $args = shift;
162
163			# local
164			if ($where eq 'cmdfile') {
165			if (!$args) {
166			$args = $HOME . '/.mjamcmd';
167			}
168			my $file = $args;
169			if (-e $file) {
170			print "trying to connect to $where ($args)", "\n";
171			$conn{type} = "cmdfd";
172			$conn{file_name} = $args;
173			$conn{connected} = 1;
174			$conn{target} = $conn{file_name};
175			}
176			}
177
178			# rpc
179			if ($where eq 'rpc') {
180			if (!$args) {
181			$args = 'anonymous@localhost:7777';
182			}
183			if ($args =~ m/^(.+)\@(.+):+(.+)$/) {
184			$conn{user} = $1;
185			$conn{remote_host} = $2;
186			$conn{remote_port} = $3;
187			} elsif ($args =~ m/^(.):(.*)$/) {
188			$conn{remote_host} = $1;
189			$conn{remote_port} = $2;
190			}
191
192			$conn{user} \|\| ($conn{user} = "anonymous");
193			$conn{remote_host} \|\| ($conn{remote_host} = "localhost");
194			$conn{remote_port} \|\| ($conn{remote_port} = "7777");
195			my $url = 'http://' . $conn{user} . '@' . $conn{remote_host} . ':' . $conn{remote_port} . '/';
196
197			if (1) {
198			print "trying to connect to $where ($url)", "\n";
199			$conn{type} = "rpc";
200			$conn{connected} = 1;
201			$conn{target} = $url;
202			$poe_kernel->post('cmdcore', 'docmd', 'tell rpcxmla start');
203			$poe_kernel->run_one_timeslice();
204
205			my $meta = {
206			Connection => \%conn,
207			RequestSession => '',
208			RequestState => '',
209			ResponseSession => $poe_alias,
210			ResponseState => 'issueResponse',
211			};
212			$poe_kernel->post( rpcxmla => setMeta => $meta );
213			$poe_kernel->post( rpcxmla => 'startAgent' );
214
215			#$conn{file_name} = $args;
216			#$conn{connected} = 1;
217			#$conn{target} = $conn{file_name};
218			}
219			}
220
221			}
222
223			sub rCmd {
224			my $cmd = shift;
225			if (!$conn{connected}) {
226			print "\"$cmd\" is a remote command, please connect first!", "\n";
227			return;
228			}
229			#my $fh = $conn{file_handle};
230			my $handle = IO::File->new($conn{file_name}, "a+");
231			$handle->print($cmd, "\n");
232			$handle->close();
233			return "done???";
234			}
235
236
237			sub issueCmd {
238
239			# ----------------------------------------------------
240			# get poe vars and resolve sender
241			my ( $kernel, $session, $heap, $sender, $cmd, $target ) = @_[ KERNEL, SESSION, HEAP, SENDER, ARG0, ARG1 ];
242			my $recieved = $cmd;
243			if ($sender == $kernel) {
244			my $caller = "Kernel" . " (Kernel " . $sender->ID() . ")";
245			$recieved .= " (from \"" . $caller . "\")";
246			} else {
247			my $sender_heap = $sender->get_heap();
248			my $caller = $sender_heap->{state}{Caption} . " (Session " . $sender->ID() . ")";
249			$recieved .= " (from \"" . $caller . "\")";
250			}
251			DEBUG() && print __PACKAGE__, ": #>", $recieved, "\n";
252			# ----------------------------------------------------
253
254			$heap->{target} = $target;
255
256			my $cmd_console = $cmd;
257
258			my $cmd_issue;
259
260			# if the console-command is empty, just return
261			if (!$cmd_console) { return; }
262
263			# split console-command by whitespace
264			my @cmd = split(' ', $cmd_console);
265
266			# is it a local command ...
267			$cmd_issue = $cmd_console;
268			if (in_array($cmd[0], $console{commands})) {
269			my $result = lCmd($cmd_console);
270			$kernel->post($session => issueResponse => $result);
271			return 1;
272			}
273
274			# prefix console-command with console-context ;), to build complete remote-command
275			my $context = '';
276			$console{context} && ($context = $console{context} . " ");
277			my $cmd_remote = $context . $cmd_console;
278
279			# split remote-command by whitespace
280			my @cmdr = split(' ', $cmd_remote);
281
282			# ... or is it a remote one?
283			$cmd_issue = $cmd_remote;
284			if (in_array($cmdr[0], $conn{commands})) {
285			if ($conn{type} eq 'rpc') {
286			# dispatch to rpc
287			my $data = {
288			method => 'spoo',
289			args => $cmd_remote,
290			};
291			$kernel->post( rpcxmla => request => $data );
292			} else {
293			# dispatch to cmdfd
294			my $result = rCmd($cmd_remote);
295			$kernel->post($session => issueResponse => $result);
296			}
297			return 1;
298			}
299
300			# unknown command, print this to shell
301			my $result = "unknown command (\"$cmd_issue\"), type ? for help.";
302			#$kernel->post($session => issuePromptChange => 1);
303			$kernel->post($session => issueResponse => $result);
304			return 1;
305
306			}
307
308
309			sub getPromptPart {
310			my @parts;
311			if ($conn{connected}) {
312			my $target_prompt;
313			if ($conn{type} eq "cmdfd") {
314			$target_prompt = "cmdfd";
315			} else {
316			$target_prompt = $conn{remote_host};
317			}
318			push(@parts, "(" . $conn{user} . "\@" . $target_prompt . ")");
319			}
320			if ($console{context}) {
321			push(@parts, "[ $console{context} ]");
322			}
323
324			my $tmp_login = '';
325			$tmp_login = join(' ', @parts);
326			if ($tmp_login) {
327			return $tmp_login;
328			}
329			}
330
331
332			sub issueResponse {
333			my ( $kernel, $session, $heap, $sender, $response ) = @_[ KERNEL, SESSION, HEAP, SENDER, ARG0 ];
334			#if ($sender != $kernel) {
335			#my $sender_heap = $sender->get_heap();
336			# print "rs: ", $heap->{meta}{ResponseSession}, "\n";
337			# print "rs: ", $heap->{meta}{ResponseState}, "\n";
338			# print "response: $response", "\n";
339			$kernel->post($heap->{target}{ResponseSession} => $heap->{target}{PromptChangeState} => getPromptPart());
340			$kernel->post($heap->{target}{ResponseSession} => $heap->{target}{ResponseState} => $response);
341			#if ($response) {
342			#print $response, "\n";
343			#}
344			#return 1;
345			#}
346			}
347
348			sub issuePromptChange {
349			my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];
350			my $prompt = getPrompt();
351			$kernel->post($heap->{target}{ResponseSession} => $heap->{target}{PromptChangeState} => $prompt);
352			}
353
354
355			sub _start {
356			my ( $kernel, $session, $heap, $arg0 ) = @_[ KERNEL, SESSION, HEAP, ARG0 ];
357			$kernel->alias_set($poe_alias);
358			DEBUG() && print __PACKAGE__, " started", "\n";
359			}
360
361
362			sub start {
363
364			$poe_alias = shift;
365
366			my @handlers = qw(
367			_start
368			issueCmd
369			issueResponse
370			issuePromptChange
371			);
372
373			my $pkg = __PACKAGE__;
374
375			# the main session for the command-engine
376			POE::Session->create(
377			package_states => [ $pkg => \@handlers ],
378			args => [ ],
379			);
380
381			}
382
383
384	cvsjoko	1.2	1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26