view release on metacpan or  search on metacpan

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

	is => "rw",
	traits => [qw[Getopt]],
	isa => "Bool",
	;

use Net::SSLeay::OO;
use Net::SSLeay::OO::Error qw(die_if_ssl_error);
use Net::SSLeay::OO::Constants
	qw(MODE_ENABLE_PARTIAL_WRITE MODE_ACCEPT_MOVING_WRITE_BUFFER
	OP_ALL OP_NO_SSLv2 VERIFY_PEER VERIFY_FAIL_IF_NO_PEER_CERT
	FILETYPE_PEM);

sub init_ssl {
	my ($self) = @_;

	my $ctx = Net::SSLeay::OO::Context->new(
		use_default_verify_paths => 0,
	);
	$ctx->set_options(&OP_ALL | OP_NO_SSLv2);
	my $options = VERIFY_PEER;
	if ( $self->rfc_compliant_ssl) {
		$self->log_info(
			"Strict RFC5734-compliant SSL enabled (client certificates required)"
		);
		$options |= VERIFY_FAIL_IF_NO_PEER_CERT;
	}
	$ctx->set_verify($options);
	$self->log_info("SSL Certificates from ".$self->ssl_cert_dir);
	$ctx->load_verify_locations("", $self->ssl_cert_dir);
	$self->log_info(
		"SSL private key: ".$self->ssl_key_file
			.", public certificate chain: ".$self->ssl_cert_file
	);
	$ctx->use_PrivateKey_file($self->ssl_key_file, FILETYPE_PEM);
	$ctx->use_certificate_chain_file($self->ssl_cert_file);
	die_if_ssl_error;  # one last check...
	$self->ssl_engine($ctx);
}

sub init {
    my ($self) = @_;

	$self->log_info("Initializing PGP");
	$self->init_pgp;
	$self->log_info("Initializing SSL");
	$self->init_ssl;
	$self->log_info("Initializing URIs");
	$self->init_uris;
	$self->log_info("Initializing Listener");
	$self->init_listener;
}

has 'openpgp' =>
	is => "ro",
	isa => "SRS::EPP::OpenPGP",
	lazy => 1,
	default => sub {
	my $self = shift;
	require SRS::EPP::OpenPGP;
	my $pgp_dir = $self->pgp_dir;
	my $secring_file = "$pgp_dir/secring.gpg";
	my $pubring_file = "$pgp_dir/pubring.gpg";
	my $pgp = SRS::EPP::OpenPGP->new(
		public_keyring => $pubring_file,
		secret_keyring => $secring_file,
	);
	$pgp->uid($self->pgp_keyid) if $self->pgp_keyid;
	my $key = $pgp->default_signing_key;
	$pgp;
	},
	handles => ["pgp"],
	;

has 'pgp_keyid' =>
	metaclass => "Getopt",
	is => "ro",
	isa => "Str",
	;

has 'pgp_dir' =>
	is => "ro",
	isa => "Str",
	default => sub {
	$ENV{GNUPGHOME} || "$ENV{HOME}/.gnupg";
	},
	;

sub init_pgp {
    my ($self) = @_;

	$self->pgp;
}

has 'extensions' =>
	metaclass => "Getopt",
	is => "ro",
	isa => "HashRef",
	required => 0,
	;
	
has 'services' =>
	metaclass => "Getopt",
	is => "ro",
	isa => "ArrayRef",
	required => 1,
	;

sub init_uris {
    my ($self) = @_;

	# Register namespaces to be returned by greeting
	use XML::EPP;
	XML::EPP::register_obj_uri(
		@{ $self->services },
	);
	
	if ($self->extensions) {
		XML::EPP::register_ext_uri(
			%{ $self->extensions },
		);
	}
}