view release on metacpan or  search on metacpan

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

			$resp40x = $args{packet} or die;
		},
	);
	$ua->loop(\$resp40x);
	print "got ".$resp40x->code." response\n";

	# then issue another registration based on auth response from
	# last failed registration
	my $realm = '';
	$ua->register(
		registrar => $peer,
		auth => sub { 
			$realm = shift;
			return [ 'wolf','lobo' ],
		},
		resp40x => $resp40x,
	) || die;
	print "Registered wolf ($realm)\n";

	$realm = '';
	$ua->register(
		registrar => $peer,
		auth => sub { 
			$realm = shift;
			return [ '007','secret' ],
		},
	) || die;
	print "Registered 007 ($realm)\n";

	$realm = '';
	$ua->register(
		from => 'sip:noauth@example.com',
		registrar => $peer,
		auth => sub { 
			$realm = shift;
			return [ '007','secret' ],
		},
	) || die;
	print "Registered noauth ($realm)\n";

}


#############################################################################
# Registrar with Authorize in front
# The $auth_chain consists of an ReceiveChain with a Authorize object
# inside. The ReceiveChain has a filter so that only requests with
# contact info !~ noauth\@ will be forwarded to the Authorize object
# Then $auth_chain is put in front of the Registrar object into a chain
# which then handles all packets
# 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;
			my $need_auth = $packet->get_header( 'contact' ) !~m{noauth\@};
			return $need_auth;
		}
	);
	my $reg = Registrar->new(
		dispatcher => $ua->{dispatcher},
		domain => 'example.com',
	);
	$ua->create_chain( [ $auth_chain,$reg ] );
	print "Listening\n";
	$ua->loop
}