package Perlbal::Plugin::Block;

use strict;
use warnings;

use FileHandle ;

use constant DEBUG => 0 ;

our $fh ;
our @patlist ;

# called when we're being added to a service
sub register {
  my ($class, $svc) = @_;

  # verify that an incoming request is a bad url request
  # if so, return a 403
  # designed for blocking nimda/code-red type worms

  $svc->register_hook('Block', 'start_proxy_request', 
					  sub {
						my Perlbal::ClientProxy $obj = shift;
						my Perlbal::HTTPHeaders $hd = $obj->{req_headers};

						my $uri = $hd->{uri} ;

						return 
						  $obj->_simple_response(403, "BLOCKED URL pattern");

						#my @patterns = map { qr/$_/ } @patlist ;
						#for my $pat (@patterns) {
						#  if ($uri =~ /$pat/) {
						#     return $obj->_simple_response(403, "BLOCKED URL pattern");
						#  } 
						#}
						return 0;
					  });
  
  return 1;
}

# called when we're no longer active on a service
sub unregister {
  my ($class, $svc) = @_;

  # clean up time
  $svc->unregister_hooks('Block');
  return 1;
}

# called when we are loaded/unloaded 
# load patterns into @patlist array

sub load { 
  dbg("block load");
  my $line = "";
  $fh = new FileHandle "/root/patlist", "r" ;
  while (defined ($line = $fh->getline)) {
	chomp($line);
	dbg("LD: $line");
	push (@patlist,$line) ;
  }
  return 1; 

}

# clear @patlist array so a fresh load can bring
# updated entries

sub unload { 
  dbg("block unload");
  my $patlist = join("\n",@patlist);
  dbg("UL:\n$patlist");
  @patlist = ();
  return 1; 
}

sub dbg {
  my ($msg) = @_ ;
  print STDERR "$msg\n" if Perlbal::Plugin::Block::DEBUG ;
  return 0 ;
}


1;