view release on metacpan or  search on metacpan

t/08_register_with_auth.t  view on Meta::CPAN

# The result is, that all requests must be authorized, except the ones
# where contact matches noauth\@
#############################################################################

sub registrar {
	my ($lsock,$laddr,$peer) = @_;
	my $ua = Simple->new( leg => $lsock );
	my $auth = Authorize->new(
		dispatcher => $ua->{dispatcher},
		user2a1   => { '007' => md5_hex('007:REALM.example.com:secret') },
		user2pass => sub { $_[0] eq 'wolf' ? 'lobo' : 'no-useful-password' },
		realm => 'REALM.example.com',
		opaque => 'HumptyDumpty',
		i_am_proxy => 0,
	);
	my $auth_chain = ReceiveChain->new(
		[ $auth ],
		filter => sub {
			my ($packet,$leg,$from) = @_;
			# no auth for responses and noauth@...
			return if $packet->is_response;

t/18_register_with_auth_step_by_step.t  view on Meta::CPAN

# The result is, that all requests must be authorized, except the ones
# where contact matches noauth\@
#############################################################################

sub registrar {
	my ($lsock,$laddr,$peer) = @_;
	my $ua = Simple->new( leg => $lsock );
	my $auth = Authorize->new(
		dispatcher => $ua->{dispatcher},
		user2a1   => { '007' => md5_hex('007:REALM.example.com:secret') },
		user2pass => sub { $_[0] eq 'wolf' ? 'lobo' : 'no-useful-password' },
		realm => 'REALM.example.com',
		opaque => 'HumptyDumpty',
		i_am_proxy => 0,
	);
	my $auth_chain = ReceiveChain->new(
		[ $auth ],
		filter => sub {
			my ($packet,$leg,$from) = @_;
			# no auth for responses and noauth@...
			return if $packet->is_response;