|
|
@@ -0,0 +1,231 @@
|
|
|
+#!@l_prefix@/bin/perl
|
|
|
+
|
|
|
+#
|
|
|
+# whois wrapper to filter out private objects and attributes
|
|
|
+#
|
|
|
+# By Arnd Vehling, NetHead - 11/03/2004
|
|
|
+#
|
|
|
+# For Cable & Wireless Munic
|
|
|
+#
|
|
|
+
|
|
|
+ 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
|
|
|
+ #
|
|
|
+
|
|
|
+ # Whois Server Definition
|
|
|
+ my %ldb = ('Host' => '@l_hostname@', 'Port' => '43001',
|
|
|
+ 'Mode' => 0);
|
|
|
+
|
|
|
+ my @header = (
|
|
|
+ "% This is the Cable & Wireless Whois server.\n",
|
|
|
+ "% The objects are in RPSL format.\n",
|
|
|
+ "%\n",
|
|
|
+ "% Rights restricted by copyright.\n\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 = ();
|
|
|
+
|
|
|
+ # 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;
|
|
|
+ }
|
|
|
+
|
|
|
+ $source_whois->destroy();
|
|
|
+ }
|
|
|
+
|
|
|
+ ##
|
|
|
+ ## 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
|
|
|
+ #map {($rc = printf $sock)} @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' => '@l_prefix@/var/ripe-dbase/whois_filt.pid', 'localport' => 43}, \@ARGV);
|
|
|
+ # Bind to address/port, run server
|
|
|
+ $server->Bind();
|
|
|
+
|
Michael Schloh von Bennewitz