#!@l_prefix@/bin/perl
#
# whois wrapper to filter out private objects and attributes
# Arnd Vehling, NetHead - 11/03/2004
# For Cable & Wireless Munich
#

  require 5.004;
  use strict;
  require Net::Daemon;
  package cwho;

  use RipeWhois;
  
  use vars qw($VERSION @ISA);
  $VERSION = '0.01';
  @ISA = qw(Net::Daemon); # to inherit from Net::Daemon

  sub Version ($) { 'CW Local whoisd server by ::nethead::, 0.01'; }
  
  #
  # Glob Vars
  #

  # Where to write the pidfile. Specify "none" for none.
  my $pidfile = '@l_prefix@/var/ripe-dbase/whois_filt.pid';

  my $header = "% This is the Cable & Wireless Whois server.\n% The objects are in RPSL format.\n%\n% Rights restricted by copyright.\n";
  
  # Configuration file with private definitions
  my $config="@l_prefix@/etc/ripe-dbase/whois_filt.config";


  # All whois objects go into this
  my @src_objects = ();
  my @privates    = ();

  # Whois Server Definition
  my %ldb = ('Host' => 'localhost',  'Port' => '43001', 
	     'Mode' => 0);

  # Which source
  my $local_source  = "ARINCW";

  ##
  ## Whois Query Code
  ##

  #
  # Parse Config File
  # 
  sub read_config 
  {
    # Parse config file and read private attributes and local-src name
    # for later use
    my $Mode = $/; undef $/;
    open( CONFIG, $config ) || die( "Cant open config-file $config\n" );
    my $cnf  = <CONFIG>;

    # Put all private attributes into a string
    if ( $cnf =~ /<private>(.*?)<\/private>/ims ) {
     my $priv = $1;
     @privates = split( /\n/, $priv );
    } else { 
	die( "Problem with config file $config. No private attributes!\n" ); 
	}

    close( CONFIG );
    $/ = $Mode;
  }


  #
  # Make the Query
  #
  sub do_query
  {
    my $whois_query = $_[0];

    my $source_whois = new RipeWhois(Host => $ldb{'Host'}, 
				  Port => $ldb{'Port'},
				  FormatMode => $ldb{'Mode'});

    unless(ref($source_whois)) {
	  print STDERR "ERROR Failed to open Whois Source ".$ldb{'Host'}."\n";
	  exit 1;
    }

    if($source_whois->GetErrorCode()) {
       print "Error. Problem with ". $ldb{'Host'}.":".$ldb{'Port'}." ".$source_whois->GetErrorString();
       exit 2;
    }

    # Execute query 
    #print "Query: $whois_query\n";

    @src_objects = $source_whois->QueryObjects($whois_query);

    unless(@src_objects) {
      print "\nNo Objects found.\n";
      my $myerr = $source_whois->GetErrorString();
      print "Query error: $myerr\n";
      exit 3;
    }
  }

  ##
  ## Daemon Code
  ##

  # Treat command line option in the constructor
  sub new ($$;$) {
      my($class, $attr, $args) = @_;
      my($self) = $class->SUPER::new($attr, $args);
      if ($self->{'parent'}) {
          # Called via Clone()
          $self->{'base'} = $self->{'parent'}->{'base'};
      } else {
          # Initial call
          if ($self->{'options'}  &&  $self->{'options'}->{'base'}) {
              $self->{'base'} = $self->{'options'}->{'base'}
          }
      }
      if (!$self->{'base'}) {
          $self->{'base'} = 'dec';
      }
      $self;
  }

  sub Run ($) {

      my($self) = @_;
      my($line, $sock, $source, $query, $rc);
      $sock = $self->{'socket'};
     
      if (!defined($line = $sock->getline())) {
	  if ($sock->error()) {
	      $self->Error("Client connection error %s",
			   $sock->error());
	  }
	  $sock->close();
	  return;
      }

      # Process whois query
      $line =~ s/\s+$//; # Remove CRLF, if any
      
      # Construct Query
      $query = "-s $local_source $line";
     
      # Execute Query, fills @src_objects
      &do_query( $query );

      # Print header
      $rc = printf $sock $header;

      if (!$rc) {
	  $self->Error("Client connection error %s",
		       $sock->error());
	  $sock->close();
	  return;
      }

      # Filter and Print Objects
      foreach $source (@src_objects) {

	#
	# Skip private Objects 
	#
	# I need to change the config.dat format
	# so that attributes and objects are in separate
	# config sections so i dont need to code it
	# statically here
	#
	if ( ($source =~ /remarks:\s+NO-EXPORT/is) ||
	     ($source =~ /^range:\s+/is)           ||
	     ($source =~ /^ticket:\s+/is)          ||
	     ($source =~ /^reg-id:\s+/is)          ||
	     ($source =~ /^purpose:\s+/is)         || 
	     ($source =~ /^facility:\s+/is)       
	   ) { next; }

	# Remove private attributes, if any
	foreach my $priv (@privates) {
	  $source =~ s/^$priv:.*?$//mgi;
	}
	$source =~ s/\n\n/\n/g;

	#print("\n$source\n");
	$rc = printf $sock ("\n$source\n");

	if (!$rc) {
	    $self->Error("Client connection error %s",
			 $sock->error());
	    $sock->close();
	    return;
	}
      } # foreach

      $rc = printf $sock ("\n");

      if (!$rc) {
	  $self->Error("Client connection error %s",
		       $sock->error());
	  $sock->close();
	  return;
      }
  }

##
## Main
##


  # Read Config File
  &read_config();

  package Main;

  # Create Server
  my $server = cwho->new({'pidfile' => $pidfile,
                                'localport' => 43}, \@ARGV);
  # Bind to address/port, run server
  $server->Bind();