MJAM/Command/Shell.pm

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