view release on metacpan or  search on metacpan

lib/Net/EPP/Proxy.pm  view on Meta::CPAN

	$self->{epp}->{port}		= $params{remote_port};
	$self->{epp}->{ssl}		= $params{ssl};
	$self->{epp}->{timeout}		= (int($params{req_timeout}) > 0 ? int($params{req_timeout}) : 5);
	$self->{epp}->{clid}		= $params{clid};
	$self->{epp}->{pw}		= $params{pw};
	$self->{epp}->{svcs}		= $params{svcs};
	$self->{epp}->{debug}		= $params{debug};

	# connect to the server:
	my ($code, $msg) = $self->epp_connect;

	# check the response:
	if ($code != 1000) {
		carp('Unable to log into to server using supplied credentials: '.$msg);
		return undef;
	}

	# run the main server loop:
	return $self->run(%params);
}

sub epp_connect {
	my $self = shift;

	# build our EPP client:
	$self->{epp}->{client} = Net::EPP::Simple->new(
		host	=> $self->{epp}->{host},
		port	=> $self->{epp}->{port},
		user	=> $self->{epp}->{user},
		pass	=> $self->{epp}->{pass},
		ssl	=> $self->{epp}->{ssl},
		timeout	=> $self->{epp}->{timeout},
		debug	=> $self->{epp}->{debug},
		dom	=> 1,
	);

	if (!$self->{epp}->{client}) {
		carp("Error connecting: $Net::EPP::Simple::Error");
		return ($Net::EPP::Simple::Code, "Error connecting: $Net::EPP::Simple::Error");
	}

	$self->{epp}->{greeting} = $self->{epp}->{client}->{greeting};

	return ($Net::EPP::Simple::Code, $Net::EPP::Simple::Message);
}

# new connection, send the greeting:
sub mux_connection {
	my ($self, $mux, $peer) = @_;
	print Net::EPP::Protocol->prep_frame($self->{net_server}->{epp}->{greeting}->toString);
}

# a request frame was received, transmit to remote server and return response to client:
sub mux_input {
	my ($self, $mux, $peer, $input) = @_;

	my $hdr		= substr(${$input}, 0, 4);
	my $length	= unpack('N', $hdr) - 4;
	my $question	= substr(${$input}, 4, $length);

	my $oldsig = $SIG{PIPE};
	$SIG{PIPE} = 'IGNORE';
	my $answer;
	eval {
		local $SIG{ALRM} = sub { die("timed out") };
		alarm($self->{net_server}->{epp}->{timeout});
		$answer = $self->{net_server}->{epp}->{client}->request($question);
		alarm(0);
	};
	$SIG{PIPE} = $oldsig;

	# initialise some things:
	my $err = '';
	my $fatal = 0;

	if ($@ ne '') {
		$err = sprintf('error getting answer from remote server: %s timeout %ds)', $@, $self->{net_server}->{epp}->{timeout});

	} elsif (length($answer->toString) < 1) {
		$err = sprintf('error getting answer from remote server: answer was %d bytes long', length($answer));

	} elsif ($self->get_result_code($answer) =~ /^(2500|2501|2502)$/) {
		$err = sprintf('session error at remote server (code %d)', $self->get_result_code($answer));

	}

	if ($err ne '') {
		$answer = $self->create_error_frame($question, $err);
		$self->debug("Fatal error from remote server: $err");
		$fatal = 1;
	}

	# send answer to client:
	print Net::EPP::Protocol->prep_frame($answer->toString);

	# clean up:
	$self->server_close if ($err ne '' && $fatal == 1);

	# clear the buffer:
	${$input} = '';

	return 1;
}

sub create_error_frame {
	my ($self, $question, $err) = @_;
	my $frame = Net::EPP::Frame::Response->new;

	my $clTRID;
	eval {
		my $doc = $self->{epp}->{parser}->parse_string($question);
		my $nodes = $doc->getElementsByTagNameNS(EPP_XMLNS, 'clTRID');
		my $node = $nodes->shift;
		my $text = ($node->getChildNodes)[0];
		$clTRID = $text->data;
		print STDERR $question;
	};

	my $msg = $frame->createElement('msg');
	$msg->appendText($err);

	$frame->clTRID->appendText($clTRID);
	$frame->svTRID->appendText(sha1_hex(ref($self).time().$$));

	$frame->result->setAttribute('code', 2500);
	$frame->result->appendChild($msg);

	return $frame;
}