ARCv2

 view release on metacpan or  search on metacpan

lib/Arc/Command.pod  view on Meta::CPAN

 $arc->{connection_vars}->{commands}

This hash describes the assignment of B<Command Name> and B<Command Class>. 
When a client has authenticated and wants to run a command, it will send 
the B<Command Name> and suitable, optional parameters. The server will look into 
the commands hash and creates an object of the B<Command Class> 
associated with B<Command Name>.

 my $perlcmd = $this->{commands}->{$cmd};
 [..]
 eval "require $perlcmd;"
 [..]
 (fork)
 my $ret = eval
 {
  my $object = new $perlcmd(
    _username => $this->{_username},
    _peeraddr => $this->{peeraddr},
    _peerport => $this->{peerport},
    _peername => $this->{peername},
    _cmd => $cmd,
    logfileprefix => "command",
  );
  $object->Execute(@a);

lib/Arc/Command.pod  view on Meta::CPAN

  while ($_ = <STDIN>) { # ends on EOF
     s/a/b/g; print;
  }
 }
 
If you want to implement a new Command for ARCv2 you have to derive from 
Arc::Command and override the sub C<Execute>. See existing Arc::Command::* 
classes for examples. To get your Command recognised you have to assign a 
B<Command Name> to your command class. ARCv2 ignores the return code of
B<Execute>. If your command runs into an error use the _SetError function 
and return immediately. This is what ARCv2 will evaluate and send to the
client.

B<Example>:
 sub Execute
 {
  my $this = shift;
  my $pw = <>;
  if ($pw ne "klaus") {
	  return $this->_SetError("Wrong password.");
  }

lib/Arc/Connection.pm  view on Meta::CPAN

	my $command = undef;
	if (my $line = $this->_RecvLine()) { # Fetch and parse a cmd from queue
		$line =~ s/[\r\n]//g;
		($command,$this->{_cmdparameter}) = $line =~ m/^([A-Z]+)\ ?(.*)?$/;
	}
		
	return $command; # There was an error if undef is return 
}

## process an ARCv2 command. (protocol)
## Process a command by evaling $this->_R$cmd. Also checks if 
## this command was expected now (looks into the $this->{_expectedcmds} array). 
## Used by client and server.
##in> $cmd
##out> true, if ARCv2 command has been in place, otherwise false
##eg> while (my $cmd = $this->_RecvCommand() && $this->_ProcessLine($cmd)) {}
sub _ProcessLine
{
	my $this = shift;
	my $cmd = shift;
	my $ret = 1;

	$this->_Debug("Received Command: $cmd (",@{$this->{_expectedcmds}},")");
	if (grep { $_ eq $cmd } @{$this->{_expectedcmds}} ) {
		$cmd = "_R".$cmd;
		$ret = $this->_SetError("Evaluation of command $cmd failed ($@).") 
			unless eval { $this->$cmd; }
	} else {
		$ret = $this->_SetError("Unexpected command: $cmd");
	}
	return $ret;
}

## send the ARCv2 SASL command. (protocol)
## This function encodes the output from sasl_*_start and sasl_*_step with Base-64 and sends
## it to the other side
##in> $saslstr

lib/Arc/Connection.pod  view on Meta::CPAN

B<Example:>

$this->_PrepareAuthentication() || return;


=item _ProcessLine ( $cmd ) 

B<Description>: process an ARCv2 command. (protocol)
Process a command by evaling $this->_R$cmd. Also checks if 
this command was expected now (looks into the $this->{_expectedcmds} array). 
Used by client and server.


B<Returns:> true, if ARCv2 command has been in place, otherwise false


B<Example:>

while (my $cmd = $this->_RecvCommand() && $this->_ProcessLine($cmd)) {}

lib/Arc/Connection/Client.pod  view on Meta::CPAN

B<Example:>

$this->_PrepareAuthentication() || return;


=item _ProcessLine ( $cmd ) I<inherited from Arc::Connection>

B<Description>: process an ARCv2 command. (protocol)
Process a command by evaling $this->_R$cmd. Also checks if 
this command was expected now (looks into the $this->{_expectedcmds} array). 
Used by client and server.


B<Returns:> true, if ARCv2 command has been in place, otherwise false


B<Example:>

while (my $cmd = $this->_RecvCommand() && $this->_ProcessLine($cmd)) {}

lib/Arc/Connection/Server.pm  view on Meta::CPAN

	my $perlcmd = $this->{commands}->{$cmd};
my $reason = $this->_CheckCmd($cmd, $perlcmd);

	if (defined $reason) {
		$this->Log(LOG_USER, "Command '$cmd' requested by user '".$this->{_username}.
		"' not ok", $reason ? ": $reason" : "");
		$this->_Error("Command $cmd not ok", $reason ? ": $reason" : "");
	} elsif( !$this->{_error} && defined $perlcmd ) {
		$this->Log(LOG_USER,"Command '$cmd' requested by user '".$this->{_username}.
			"' mapped to '$perlcmd'",$para ? "with parameters '$para'" : "");
		if (eval "require $perlcmd;") {

			my $in =  new IO::Pipe || return $this->_SetError("Could not create in-Pipe");
			my $out = new IO::Pipe || return $this->_SetError("Could not create out-Pipe");
			my $err = new IO::Pipe || return $this->_SetError("Could not create err-Pipe");

			my $oldsigchld = $SIG{CHLD};
			$SIG{CHLD} = 'IGNORE';

			my $cmdpid = fork();
			if ($cmdpid == 0) { # Child

lib/Arc/Connection/Server.pm  view on Meta::CPAN

   return split(/\s+/,$para) if defined $para; # better splitting for array TODO
   return ();
}

sub _RunCmd
{
	my $this = shift;
	my ($cmd, $perlcmd, $argref) = @_;

	my $cmderr;
	my $ret = eval {
		my $object = new $perlcmd (
			_commands => $this->{commands},
			_username => $this->{_username},
			_realm    => $this->{_realm},
			_mech     => $this->{_saslmech},
			_peeraddr => $this->{_connection}->peerhost,
			_peerport => $this->{_connection}->peerport,
			_peername => $this->{_connection}->peername,
			_cmd => $cmd,
			logfileprefix => "command",

lib/Arc/Connection/Server.pod  view on Meta::CPAN

B<Example:>

$this->_PrepareAuthentication() || return;


=item _ProcessLine ( $cmd ) I<inherited from Arc::Connection>

B<Description>: process an ARCv2 command. (protocol)
Process a command by evaling $this->_R$cmd. Also checks if 
this command was expected now (looks into the $this->{_expectedcmds} array). 
Used by client and server.


B<Returns:> true, if ARCv2 command has been in place, otherwise false


B<Example:>

while (my $cmd = $this->_RecvCommand() && $this->_ProcessLine($cmd)) {}

lib/Arc/Server.pm  view on Meta::CPAN

## start the server
## This function is used by the user to start the server and enter the main accept-loop.
## Only by calling the C<Interrupt> function this call can be aborted.
##out> return true if everything worked fine, otherwise false is returned and C<IsError> should be checked.
##eg> $arc->Start();
sub Start
{
	my $this = shift;
	my $ct = $this->{connection_type};
	eval "require $ct";
	croak "Please \"use $ct\" before calling Start(): $@" if $@;
	$this->run();
	return 1;
}

# Net::Server::* hooks and overrides

sub process_request
{
	my $this = shift;

scripts/object.pl  view on Meta::CPAN

		return "public";
	}
}

sub issuperior
{
	my ($type,$cname,$item,$acl) = @_;

	my $text = "";
	while ($cname = $iter{$cname}) {
		if (eval '$'.$type.'{$cname}->{$acl}->{$item}') {
			$ready{$item} = 1;
			$text = "reimplemented from $cname";
			last;
		}
	}
	return $text;
}

sub showmembers 
{