/usr/share/perl5/Net/SIP/Blocker.pm is in libnet-sip-perl 0.66-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | ###########################################################################
# package Net::SIP::Blocker
###########################################################################
use strict;
use warnings;
package Net::SIP::Blocker;
use fields qw( dispatcher block );
use Carp 'croak';
use Net::SIP::Debug;
###########################################################################
# creates new Blocker object
# Args: ($class,%args)
#   %args
#     block: \%hash where the blocked method is the key and its value
#       is a number with three digits with optional message
#       e.g. { 'SUBSCRIBE' => 405 }
#     dispatcher: the Net::SIP::Dispatcher object
# Returns: $self
###########################################################################
sub new {
	my ($class,%args) = @_;
	my $self = fields::new( $class );
	my $map = delete $args{block}
		or croak("no mapping between method and code");
	while (my ($method,$code) = each %$map) {
		$method = uc($method);
		($code, my $msg) = $code =~m{^(\d\d\d)(?:\s+(.+))?$} or
			croak("block code for $method must be DDD [text]");
		$self->{block}{$method} = defined($msg) ? [$code,$msg]:[$code];
	}
	$self->{dispatcher} = delete $args{dispatcher}
		or croak('no dispatcher given');
	return $self;
}
###########################################################################
# Blocks methods not wanted and sends a response back over the same leg
# with the Error-Message of the block_code
# Args: ($self,$packet,$leg,$from)
#   args as usual for sub receive
# Returns: block_code | NONE
###########################################################################
sub receive {
	my Net::SIP::Blocker $self = shift;
	my ($packet,$leg,$from) = @_;
	$packet->is_request or return;
	my $method = $packet->method;
	if ( $method eq 'ACK' and my $block = $self->{block}{INVITE} ) {
		$self->{dispatcher}->cancel_delivery($packet->tid);
		return $block->[0];
	}
	my $block = $self->{block}{$method} or return;
	DEBUG( 10,"block $method with code @$block" );
	$self->{dispatcher}->deliver(
		$packet->create_response(@$block),
		leg => $leg,
		dst_addr => $from
	);
	return $block->[0]
}
1;
 |