File Coverage

blib/lib/POE/Component/Proxy/SOCKS.pm

Criterion	Covered	Total	%
statement	57	418	13.6
branch	8	188	4.2
condition	0	53	0.0
subroutine	11	49	22.4
pod	12	12	100.0
total	88	720	12.2

package POE::Component::Proxy::SOCKS;

use strict;
use warnings;
use POE qw(Component::Client::Ident Component::Client::DNS Wheel::SocketFactory Wheel::ReadWrite Filter::Stream);
use Socket;
use Net::Netmask;
use vars qw($VERSION);

$VERSION = '1.02';

sub spawn {
  my $package = shift;
  my %opts = @_;
  $opts{lc $_} = delete $opts{$_} for keys %opts;
  my $options = delete $opts{options};
  my $self = bless \%opts, $package;
  $self->{session_id} = POE::Session->create(
	object_states => [
	   $self => { shutdown       => '_shutdown',
		      send_event     => '__send_event',
		      ident_agent_reply => '_ident_agent_reply',
		      ident_agent_error => '_ident_agent_error',
	            },
	   $self => [ qw(
			_start
			register
			unregister
			_accept_client
			_accept_failed
			_conn_input
			_conn_error
			_conn_alarm
			__send_event
			_ident_done
			_reject_client
			_dns_response
			_do_connect
			_do_bind
			_sock_connection
			_sock_up
			_sock_failed
			_sock_input
			_sock_down
			_sock_alarm
			_bind_request
		        )
	   ],
	],
	heap => $self,
	( ref($options) eq 'HASH' ? ( options => $options ) : () ),
  )->ID();
  return $self;
}

sub session_id {
  return $_[0]->{session_id};
}

sub _conn_exists {
  my ($self,$wheel_id) = @_;
  return 0 unless $wheel_id and defined $self->{clients}->{ $wheel_id };
  return 1;
}

sub _link_exists {
  my ($self,$wheel_id) = @_;
  return 0 unless $wheel_id and defined $self->{links}->{ $wheel_id };
  return 1;
}

sub _sock_exists {
  my ($self,$wheel_id) = @_;
  return 0 unless $wheel_id and defined $self->{sockets}->{ $wheel_id };
  return 1;
}

sub _bind_request {
  my ($self,$id) = @_;
  return unless $self->_conn_exists( $id );
  my $client = $self->{clients}->{ $id };
  my $match;
  foreach my $cid ( keys %{ $self->{clients} } ) {
     next if $cid eq $id;
     next if $self->{clients}->{ $cid }->{dstip} ne $client->{dstip};
     next if $self->{clients}->{ $cid }->{dstport} ne $client->{dstport};
     $match = $cid;
     last;
  }
  return $match;
}

sub shutdown {
  my $self = shift;
  $poe_kernel->post( $self->{session_id}, 'shutdown' );
}

sub _start {
  my ($kernel,$self,$sender) = @_[KERNEL,OBJECT,SENDER];
  $self->{session_id} = $_[SESSION]->ID();
  if ( $self->{alias} ) {
	$kernel->alias_set( $self->{alias} );
  }
  else {
	$kernel->refcount_increment( $self->{session_id} => __PACKAGE__ );
  }
  if ( $kernel != $sender ) {
    my $sender_id = $sender->ID;
    $self->{events}->{'socksd_all'}->{$sender_id} = $sender_id;
    $self->{sessions}->{$sender_id}->{'ref'} = $sender_id;
    $kernel->refcount_increment($sender_id, __PACKAGE__);
    $kernel->post( $sender, 'socksd_registered', $self );
  }

  $self->{resolver} = POE::Component::Client::DNS->spawn( Alias => 'socksd' . $self->{session_id}, Timeout => 10 );

  $self->{filter} = POE::Filter::Stream->new();

  $self->{listener} = POE::Wheel::SocketFactory->new(
      ( defined $self->{address} ? ( BindAddress => $self->{address} ) : () ),
      ( defined $self->{port} ? ( BindPort => $self->{port} ) : ( BindPort => 1080 ) ),
      SuccessEvent   => '_accept_client',
      FailureEvent   => '_accept_failed',
      SocketDomain   => AF_INET,             # Sets the socket() domain
      SocketType     => SOCK_STREAM,         # Sets the socket() type
      SocketProtocol => 'tcp',               # Sets the socket() protocol
      Reuse          => 'on',                # Lets the port be reused
  );
  return;
}

sub _shutdown {
  my ($kernel,$self) = @_[KERNEL,OBJECT];
  delete $self->{listener};
  delete $self->{clients};
  delete $self->{sockets};
  $kernel->alarm_remove_all();
  $kernel->alias_remove( $_ ) for $kernel->alias_list();
  $kernel->refcount_decrement( $self->{session_id} => __PACKAGE__ ) unless $self->{alias};
  $self->_unregister_sessions();
  $self->{resolver}->shutdown();
  return;
}

sub _accept_client {
  my ($kernel,$self,$socket,$peeraddr,$peerport) = @_[KERNEL,OBJECT,ARG0..ARG2];
  my $sockaddr = inet_ntoa( ( unpack_sockaddr_in ( getsockname $socket ) )[1] );
  my $sockport = ( unpack_sockaddr_in ( getsockname $socket ) )[0];
  $peeraddr = inet_ntoa( $peeraddr );

  if ( $self->denied( $peeraddr ) ) {
     $self->_send_event( 'socksd_denied', $peeraddr, $peerport );
     return;
  }

  my $wheel = POE::Wheel::ReadWrite->new(
	Handle => $socket,
	Filter => $self->{filter},
	InputEvent => '_conn_input',
	ErrorEvent => '_conn_error',
	FlushedEvent => '_conn_flushed',
  );

  return unless $wheel;

  my $id = $wheel->ID();
  $self->{clients}->{ $id } =
  {
	wheel    => $wheel,
	peeraddr => $peeraddr,
	peerport => $peerport,
	sockaddr => $sockaddr,
	sockport => $sockport,
  };
  $self->_send_event( 'socksd_connection', $id, $peeraddr, $peerport, $sockaddr, $sockport );

  $self->{clients}->{ $id }->{alarm} = $kernel->delay_set( '_conn_alarm', $self->{time_out} || 120, $id );

  if ( $self->{ident} ) {
       POE::Component::Client::Ident::Agent->spawn(
		PeerAddr => $peeraddr,
		PeerPort => $peerport,
		SockAddr => $sockaddr,
	        SockPort => $sockport,
		BuggyIdentd => 1,
		TimeOut => 10,
		Reference => $id );
  }

  return;
}

sub _accept_failed {
  my ($kernel,$self,$operation,$errnum,$errstr,$wheel_id) = @_[KERNEL,OBJECT,ARG0..ARG3];
  warn "Wheel $wheel_id generated $operation error $errnum: $errstr\n";
  delete $self->{listener};
  $self->_send_event( 'socksd_listener_failed', $operation, $errnum, $errstr );
  return;
}

sub _ident_agent_reply {
  my ($kernel,$self,$ref,$opsys,$other) = @_[KERNEL,OBJECT,ARG0,ARG1,ARG2];
  my $wheel_id = $ref->{Reference};
  return unless $self->_conn_exists( $wheel_id );
  my $ident = '';
  #$ident = $other if uc ( $opsys ) ne 'OTHER';
  $ident = $other;
  $self->{clients}->{ $wheel_id }->{ident} = $ident;
  $kernel->yield( '_ident_done' => $wheel_id );
  return;
}

sub _ident_agent_error {
  my ($kernel,$self,$ref,$error) = @_[KERNEL,OBJECT,ARG0,ARG1];
  my $wheel_id = $ref->{Reference};
  return unless $self->_conn_exists( $wheel_id );
  $self->{clients}->{ $wheel_id }->{ident} = '';
  $kernel->yield( '_ident_done' => $wheel_id );
  return;
}

sub _ident_done {
  my ($kernel,$self,$id) = @_[KERNEL,OBJECT,ARG0];
  return unless $self->_conn_exists( $id );
  return unless defined $self->{clients}->{ $id }->{user_id};
  return unless defined $self->{clients}->{ $id }->{ident};
  my $client = $self->{clients}->{ $id };
  unless ( $client->{ident} ) {
    $kernel->yield( '_reject_client', $id, '92', 'No Ident Response' );
    return;
  }
  unless ( $client->{ident} eq $client->{user_id} ) {
    $kernel->yield( '_reject_client', $id, '93', 'Ident and user_id mismatch' );
    return;
  }
  $kernel->yield( '_do_connect', $id ) if $client->{cd} eq '1';
  $kernel->yield( '_do_bind', $id ) if $client->{cd} eq '2';
  return;
}

sub _reject_client {
  my ($kernel,$self,$id,$reject_id,$reason) = @_[KERNEL,OBJECT,ARG0,ARG1,ARG2];
  return unless $self->_conn_exists( $id );
  my $client = $self->{clients}->{ $id };
  $client->{reject} = $reject_id;
  my $response = pack "CCnN", 0, $reject_id, $client->{dstport}, inet_aton( $client->{dstip} );
  $client->{wheel}->put( $response );
  $self->_send_event( 'socksd_rejected', $id, $reject_id, $reason );
  return;
}

sub _parse_input {
  my $input = shift || return;
  my $null_idx = index $input, "\0";
  return if $null_idx == -1;
  my $request = substr $input, 0, $null_idx;
  return unless $request;
  my $packet = substr $input, 0, 4;
  return unless $packet or length $packet == 4;
  my @results = unpack "CCn", $packet;
  return unless scalar @results == 3;
  my $dstip = substr $input, 4, 4;
  return unless $dstip;
  push @results, $dstip;
  my $remainder = substr $input, 8;
  $remainder =~ s/\0$//g;
  my ($id,$host) = split /\0/, $remainder;
  $id = '' unless $id;
  push @results, $id, $host;
  return @results;
}

sub _conn_input {
  my ($kernel,$self,$input,$id) = @_[KERNEL,OBJECT,ARG0,ARG1];
  return unless $self->_conn_exists( $id );
  my $client = $self->{clients}->{ $id };
  $kernel->delay_adjust( $client->{alarm}, $self->{time_out} || 120 );
  unless ( $client->{link_id} ) {
     # No uplink the client must be negotiating
     my @args = _parse_input( $input );
     unless ( @args ) {
	delete $self->{clients}->{ $id };
	return;
     }
     my ($vn,$cd,$dstport,$dstip,$userid,$host) = @args;
     $dstip = inet_ntoa( $dstip );
     unless ( $dstip ) {
	delete $self->{clients}->{ $id };
	return;
     }
     $client->{dstip} = $dstip;
     $client->{dstport} = $dstport;
     $client->{user_id} = $userid;
     if ( $vn ne '4' or $cd !~ /^(1|2)$/ ) {
	$kernel->yield( '_reject_client', $id, '91', 'Invalid request' );
	return;
     }
     if ( $dstip =~ /^0\.0\.0\./ and $cd ne '2' ) {
	# SOCKS 4a request
	unless ( $host ) {
	  $kernel->yield( '_reject_client', $id, '91', 'SOCKS4a request. No host' );
	  return;
	}
	my $response = $self->{resolver}->resolve(
      		event   => '_dns_response',
      		host    => $host,
      		context => { id => $id },
    	);
    	if ( $response ) {
      	   $kernel->yield( _dns_response => $response );
        }
	return;
     }
     if ( $cd eq '2' ) {
	my $cid = $self->_bind_request( $id );
	unless ( $cid ) {
	  $kernel->yield( '_reject_client', $id, '91', 'Invalid request' );
	  return;
	}
  	$client->{primary} = $cid;
  	$kernel->yield( '_ident_done', $id ) if $self->{ident};
  	$kernel->yield( '_do_bind', $id ) unless $self->{ident};
	return;
     }
     $kernel->yield( '_ident_done', $id ) if $self->{ident};
     $kernel->yield( '_do_connect', $id ) unless $self->{ident};
     return;
  }
  return unless $self->_link_exists( $client->{link_id} );
  $self->{links}->{ $client->{link_id} }->{wheel}->put( $input );
  return;
}

sub _dns_response {
  my ($kernel,$self,$arg) = @_[KERNEL,OBJECT,ARG0];
  my $net_dns_packet = $arg->{response};
  my $net_dns_errorstring = $arg->{error};
  my $id = $arg->{context}->{id};
  return unless $self->_conn_exists( $id );
  unless( defined $net_dns_packet ) {
	$kernel->yield( '_reject_client', $id, '91', 'DNS failed' );
	return;
  }
  my @net_dns_answers = $net_dns_packet->answer;
  unless ( @net_dns_answers ) {
	$kernel->yield( '_reject_client', $id, '91', 'No DNS answers' );
	return;
  }
  foreach my $net_dns_answer (@net_dns_answers) {
    next unless $net_dns_answer->type eq 'A';
    $self->{clients}->{ $id }->{dstip} = $net_dns_answer->rdatastr;
    $self->_send_event( 'socksd_dns_lookup', $id, $arg->{host}, $self->{clients}->{ $id }->{dstip} );
    $kernel->yield( '_ident_done', $id ) if $self->{ident};
    $kernel->yield( '_do_connect', $id ) unless $self->{ident};
    return;
  }
  $kernel->yield( '_reject_client', $id, '91', 'No DNS records found' );
  return;
}

sub _conn_error {
  my ($self,$errstr,$id) = @_[OBJECT,ARG2,ARG3];
  return unless $self->_conn_exists( $id );
  $self->_delete_client( $id );
  $self->_send_event( 'socksd_disconnected', $id, $errstr );
  return;
}

sub _conn_flushed {
  my ($self,$id) = @_[OBJECT,ARG0];
  return unless $self->_conn_exists( $id );
  return if $self->{clients}->{ $id }->{link_id};
  return unless $self->{clients}->{ $id }->{reject};
  $self->_delete_client( $id );
  return;
}

sub _conn_alarm {
  my ($kernel,$self,$id) = @_[KERNEL,OBJECT,ARG0];
  return unless $self->_conn_exists( $id );
  $self->_delete_client( $id );
  $self->_send_event( 'socksd_disconnected', $id );
  return;
}

sub _delete_client {
  my ($self,$id) = @_;
  return unless $self->_conn_exists( $id );
  my $client = delete $self->{clients}->{ $id };
  if ( $client->{link_id} and $self->_link_exists( $client->{link_id} ) ) {
    delete $self->{links}->{ $client->{link_id} };
  }
  if ( $client->{factory} and $self->_sock_exists( $client->{factory} ) ) {
    delete $self->{sockets}->{ $client->{factory} };
  }
  return 1;
}

sub _do_connect {
  my ($kernel,$self,$id) = @_[KERNEL,OBJECT,ARG0];
  return unless $self->_conn_exists( $id );
  my $client = $self->{clients}->{ $id };
  my $factory = POE::Wheel::SocketFactory->new(
	SocketDomain   => AF_INET,
	SocketType     => SOCK_STREAM,
	SocketProtocol => 'tcp',
	RemoteAddress  => $client->{dstip},
	RemotePort     => $client->{dstport},
	SuccessEvent   => '_sock_up',
	FailureEvent   => '_sock_failed',
  );
  my $fact_id = $factory->ID();
  $client->{factory} = $fact_id;
  $self->{sockets}->{ $fact_id } = { client => $id, factory => $factory };
  return;
}

sub _do_bind {
  my ($kernel,$self,$id) = @_[KERNEL,OBJECT,ARG0];
  return unless $self->_conn_exists( $id );
  my $client = $self->{clients}->{ $id };
  my $primary = $client->{primary};
  return unless $self->_conn_exists( $primary );
  my $link_id = $self->{clients}->{ $primary }->{link_id};
  return unless $link_id or $self->_link_exists( $link_id );
  my $bindaddr = $self->{links}->{ $link_id }->{sockaddr};
  my $factory = POE::Wheel::SocketFactory->new(
	SocketDomain   => AF_INET,
	SocketType     => SOCK_STREAM,
	SocketProtocol => 'tcp',
	BindAddress    => $bindaddr,
	BindPort       => 0,
	Reuse          => 'yes',
	SuccessEvent   => '_sock_connection',
	FailureEvent   => '_sock_failed',
  );
  my $sockname = $factory->getsockname();
  unless ( $sockname ) {
    $kernel->yield( '_reject_client', $id, '91', 'Socket failed' );
    return;
  }
  my ($port, $myaddr) = sockaddr_in( $sockname );
  my $fact_id = $factory->ID();
  $client->{factory} = $fact_id;
  $self->{sockets}->{ $fact_id } = { client => $id, factory => $factory };
  $self->{sockets}->{ $fact_id }->{alarm} = $kernel->delay_set( '_sock_alarm', $self->{time_out} || 120, $fact_id, $id );
  my $response = pack "CCnN", 0, 90, $port, $myaddr;
  $client->{wheel}->put( $response );
  $self->_send_event( 'socksd_bind_up', $id, $fact_id, inet_ntoa( $myaddr ), $port );
  return;
}

sub _sock_failed {
  my ($kernel,$self,$op,$errno,$errstr,$fact_id) = @_[KERNEL,OBJECT,ARG0..ARG3];
  my $factory = delete $self->{sockets}->{ $fact_id };
  $kernel->alarm_remove( $factory->{alarm} );
  my $client_id = $factory->{client};
  delete $self->{clients}->{ $client_id }->{factory} if $self->_conn_exists( $client_id );
  $kernel->yield( '_reject_client', $client_id, '91', 'Socket failed', $op, $errno, $errstr );
  return;
}

sub _sock_up {
  my ($kernel,$self,$socket,$fact_id) = @_[KERNEL,OBJECT,ARG0,ARG3];
  my $sockaddr = inet_ntoa( ( unpack_sockaddr_in ( getsockname $socket ) )[1] );
  my $sockport = ( unpack_sockaddr_in ( getsockname $socket ) )[0];
  my $factory = delete $self->{sockets}->{ $fact_id };
  my $client_id = $factory->{client};
  return unless $self->_conn_exists( $client_id );
  my $wheel = POE::Wheel::ReadWrite->new(
      Handle       => $socket,
      Filter	   => POE::Filter::Stream->new(),
      InputEvent   => '_sock_input',
      ErrorEvent   => '_sock_down',
  );
  my $link_id = $wheel->ID();
  $self->{clients}->{ $client_id }->{link_id} = $link_id;
  $self->{links}->{ $link_id } = { client => $client_id, wheel => $wheel, sockaddr => $sockaddr, sockport => $sockport };
  my $client = $self->{clients}->{ $client_id };
  my $response = pack "CCnN", 0, 90, $client->{dstport}, unpack("N", inet_aton( $client->{dstip}) );
  $client->{wheel}->put( $response );
  $self->_send_event( 'socksd_sock_up', $client_id, $link_id, $client->{dstip}, $client->{dstport} );
  return;
}

sub _sock_connection {
  my ($kernel,$self,$socket,$peeraddr,$fact_id) = @_[KERNEL,OBJECT,ARG0,ARG1,ARG3];
  my $sockaddr = inet_ntoa( ( unpack_sockaddr_in ( getsockname $socket ) )[1] );
  my $sockport = ( unpack_sockaddr_in ( getsockname $socket ) )[0];
  $peeraddr = inet_ntoa( $peeraddr );
  my $factory = delete $self->{sockets}->{ $fact_id };
  $kernel->alarm_remove( $factory->{alarm} );
  my $client_id = $factory->{client};
  return unless $self->_conn_exists( $client_id );
  my $client = $self->{clients}->{ $client_id };
  unless ( $peeraddr eq $client->{dstip} ) {
     $kernel->yield( '_reject_client', $client_id, '91', 'dstip and connecting ip differ' );
     return;
  }
  my $wheel = POE::Wheel::ReadWrite->new(
      Handle       => $socket,
      Filter	   => POE::Filter::Stream->new(),
      InputEvent   => '_sock_input',
      ErrorEvent   => '_sock_down',
  );
  my $link_id = $wheel->ID();
  $client->{link_id} = $link_id;
  $self->{links}->{ $link_id } = { client => $client_id, wheel => $wheel, sockaddr => $sockaddr, sockport => $sockport };
  my $response = pack "CCnN", 0, 90, $sockport, inet_aton( $sockaddr );
  $client->{wheel}->put( $response );
  $self->_send_event( 'socksd_sock_up', $client_id, $link_id, $sockaddr, $sockport );
  return;
}

sub _sock_alarm {
  my ($kernel,$self,$fact_id,$client_id) = @_[KERNEL,OBJECT,ARG0..ARG1];
  delete $self->{sockets}->{ $fact_id };
  delete $self->{clients}->{ $client_id };
  return;
}

sub _sock_input {
  my ($kernel,$self,$input,$link_id) = @_[KERNEL,OBJECT,ARG0,ARG1];
  return unless $self->_link_exists( $link_id );
  my $client_id = $self->{links}->{ $link_id }->{client};
  return unless $self->_conn_exists( $client_id );
  $self->{clients}->{ $client_id }->{wheel}->put( $input );
  return;
}

sub _sock_down {
  my ($self,$errstr,$link_id) = @_[OBJECT,ARG2,ARG3];
  return unless $self->_link_exists( $link_id );
  my $client_id = $self->{links}->{ $link_id }->{client};
  $self->{clients}->{$client_id}->{wheel}->flush;
  my $link = delete $self->{links}->{ $link_id };
  if ( $link->{client} and $self->_conn_exists( $link->{client} ) ) {
    delete $self->{clients}->{ $link->{client} };
  }
  $self->_send_event( 'socksd_sock_down', $link->{client}, $link_id, $errstr );
  $self->_send_event( 'socksd_disconnected', $link->{client} );
  return;
}

sub register {
  my ($kernel, $self, $session, $sender, @events) =
    @_[KERNEL, OBJECT, SESSION, SENDER, ARG0 .. $#_];

  unless (@events) {
    warn "register: Not enough arguments";
    return;
  }

  my $sender_id = $sender->ID();

  foreach (@events) {
    $_ = "socksd_" . $_ unless /^_/;
    $self->{events}->{$_}->{$sender_id} = $sender_id;
    $self->{sessions}->{$sender_id}->{'ref'} = $sender_id;
    unless ($self->{sessions}->{$sender_id}->{refcnt}++ or $session == $sender) {
      $kernel->refcount_increment($sender_id, __PACKAGE__);
    }
  }

  $kernel->post( $sender, 'socksd_registered', $self );
  return;
}

sub unregister {
  my ($kernel, $self, $session, $sender, @events) =
    @_[KERNEL,  OBJECT, SESSION,  SENDER,  ARG0 .. $#_];

  unless (@events) {
    warn "unregister: Not enough arguments";
    return;
  }

  $self->_unregister($session,$sender,@events);
  undef;
}

sub _unregister {
  my ($self,$session,$sender) = splice @_,0,3;
  my $sender_id = $sender->ID();

  foreach (@_) {
    $_ = "socksd_" . $_ unless /^_/;
    my $blah = delete $self->{events}->{$_}->{$sender_id};
    unless ( $blah ) {
	warn "$sender_id hasn't registered for '$_' events\n";
	next;
    }
    if (--$self->{sessions}->{$sender_id}->{refcnt} <= 0) {
      delete $self->{sessions}->{$sender_id};
      unless ($session == $sender) {
        $poe_kernel->refcount_decrement($sender_id, __PACKAGE__);
      }
    }
  }
  undef;
}

sub _unregister_sessions {
  my $self = shift;
  my $socksd_id = $self->session_id();
  foreach my $session_id ( keys %{ $self->{sessions} } ) {
     if (--$self->{sessions}->{$session_id}->{refcnt} <= 0) {
        delete $self->{sessions}->{$session_id};
	$poe_kernel->refcount_decrement($session_id, __PACKAGE__)
		unless ( $session_id eq $socksd_id );
     }
  }
}

sub __send_event {
  my( $self, $event, @args ) = @_[ OBJECT, ARG0, ARG1 .. $#_ ];
  $self->_send_event( $event, @args );
  return;
}

sub send_event {
  my $self = shift;
  $poe_kernel->post( $self->{session_id}, '__send_event', @_ );
}

sub _send_event  {
  my $self = shift;
  my ($event, @args) = @_;
  my $kernel = $POE::Kernel::poe_kernel;
  my $session = $kernel->get_active_session()->ID();
  my %sessions;

  $sessions{$_} = $_ for (values %{$self->{events}->{'socksd_all'}}, values %{$self->{events}->{$event}});

  $kernel->post( $_ => $event => @args ) for values %sessions;
  undef;
}

##################
# Access Control #
##################

sub add_denial {
  my $self = shift;
  my $netmask = shift || return;
  return unless $netmask->isa('Net::Netmask');
  $self->{denials}->{ $netmask } = $netmask;
  return 1;
}

sub del_denial {
  my $self = shift;
  my $netmask = shift || return;
  return unless $netmask->isa('Net::Netmask');
  return unless $self->{denials}->{ $netmask };
  delete $self->{denials}->{ $netmask };
  return 1;
}

sub add_exemption {
  my $self = shift;
  my $netmask = shift || return;
  return unless $netmask->isa('Net::Netmask');
  $self->{exemptions}->{ $netmask } = $netmask unless $self->{exemptions}->{ $netmask };
  return 1;
}

sub del_exemption {
  my $self = shift;
  my $netmask = shift || return;
  return unless $netmask->isa('Net::Netmask');
  return unless $self->{exemptions}->{ $netmask };
  delete $self->{exemptions}->{ $netmask };
  return 1;
}

sub denied {
  my $self = shift;
  my $ipaddr = shift || return;
  return 0 if $self->exempted( $ipaddr );
  foreach my $mask ( keys %{ $self->{denials} } ) {
    return 1 if $self->{denials}->{ $mask }->match($ipaddr);
  }
  return 0;
}

sub exempted {
  my $self = shift;
  my $ipaddr = shift || return;
  foreach my $mask ( keys %{ $self->{exemptions} } ) {
    return 1 if $self->{exemptions}->{ $mask }->match($ipaddr);
  }
  return 0;
}

1;
__END__