view release on metacpan or  search on metacpan

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

		$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
				$this->{logfileprefix} = "commandchild";

# prepare environment for the command
				$in->writer(); $out->reader(); $err->writer();
				open STDIN, "<&", $out;
				open STDOUT, ">&", $in;

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

					close $in; close $out; close $err;
				} else {
					$this->_SetError("Unknown host wanted ".
						"to use our command connection. ($peeraddr)");
				}
				wait();
			} else {
				$this->_SetError("Fork error.");
			}
			$SIG{CHLD} = $oldsigchld;
		} else {
			my $e = $@;
			$this->Log(LOG_CMD,"$perlcmd: ",$e);
			$this->_Error("Command $perlcmd not found or error: ".$e);
		}
	} else {
		$this->Log(LOG_USER,"Command '$cmd' requested by user '".$this->{_username}.
			"'",$para ? "with parameters '$para'" : "","was not found!");
		$this->_Error("Command $cmd not found (Unknown Command).");
	}