#!/usr/bin/perl # XMLRPC interface to IPDB search # Copyright (C) 2017 Kris Deugau use strict; use warnings; use DBI; use NetAddr::IP; use FCGI; use Frontier::Responder; use Sys::Syslog; # don't remove! required for GNU/FHS-ish install from tarball ##uselib## # push "the directory the script is in" into @INC use FindBin; use lib "$FindBin::RealBin/"; use MyIPDB; use CustIDCK; openlog "IPDB-search-rpc","pid","$IPDB::syslog_facility"; ##fixme: username source? can we leverage some other auth method? # we don't care except for logging here, and Frontier::Client needs # a patch that's not well-distributed to use HTTP AUTH. # Collect the username from HTTP auth. If undefined, we're in # a test environment, or called without a username. my $authuser; if (!defined($ENV{'REMOTE_USER'})) { $authuser = '__temptest'; } else { $authuser = $ENV{'REMOTE_USER'}; } # Why not a global DB handle? (And a global statement handle, as well...) # Use the connectDB function, otherwise we end up confusing ourselves my $ip_dbh; my $sth; my $errstr; ($ip_dbh,$errstr) = connectDB_My; initIPDBGlobals($ip_dbh); my $methods = { 'ipdb.search' => \&rpc_search, }; my $reqcnt = 0; my $req = FCGI::Request(); # main FCGI loop. while ($req->Accept() >= 0) { # done here to a) prevent $ENV{'REMOTE_ADDR'} from being empty and b) to collect # the right user for the individual call (since we may be running with FCGI) syslog "debug", "$authuser active, $ENV{'REMOTE_ADDR'}"; # don't *think* we need any of these... # %disp_alloctypes, %def_custids, %list_alloctypes # @citylist, @poplist # @masterblocks, %allocated, %free, %bigfree, %routed (removed in /trunk) # %IPDBacl #initIPDBGlobals($ip_dbh); my $res = Frontier::Responder->new( methods => $methods ); # "Can't do that" errors if (!$ip_dbh) { print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $DBI::errstr); } else { print $res->answer; } last if $reqcnt++ > $IPDB::maxfcgi; } # while FCGI::accept exit 0; ## ## Private subs ## # Check RPC ACL sub _aclcheck { my $subsys = shift; return 1 if grep /$ENV{REMOTE_ADDR}/, @{$IPDB::rpcacl{$subsys}}; warn "$subsys/$ENV{REMOTE_ADDR} not in ACL\n"; # a bit of logging return 0; } sub _commoncheck { my $argref = shift; my $needslog = shift; die "Missing remote system name\n" if !$argref->{rpcsystem}; die "Access denied\n" if !_aclcheck($argref->{rpcsystem}); if ($needslog) { die "Missing remote username\n" if !$argref->{rpcuser}; } } # stripped-down copy from from main.cgi. should probably be moved to IPDB.pm sub _validateInput { my $argref = shift; if (!$argref->{block}) { $argref->{block} = $argref->{cidr} if $argref->{cidr}; die "Block/IP is required\n" if !$argref->{block}; } # Alloctype check. chomp $argref->{type}; die "Invalid allocation type\n" if (!grep /$argref->{type}/, keys %disp_alloctypes); # Arguably not quite correct, as the custID won't be checked for # validity if there's a default on the type. if ($def_custids{$argref->{type}} eq '') { # Types without a default custID must have one passed in die "Customer ID is required\n" if !$argref->{custid}; # Crosscheck with billing. my $status = CustIDCK->custid_exist($argref->{custid}); die "Error verifying customer ID: $CustIDCK::ErrMsg\n" if $CustIDCK::Error; die "Customer ID not valid\n" if !$status; } else { # Types that have a default will use it unless one is specified. if ((!$argref->{custid}) || ($argref->{custid} ne 'STAFF')) { $argref->{custid} = $def_custids{$argref->{type}}; } } } # end validateInput() ## ## RPC method subs ## sub rpc_search { my %args = @_; _commoncheck(\%args); my @fields; my @vals; my @matchtypes; my %mt = ( EXACT => '=', EQUAL => '=', NOT => '!~', # text only? # CIDR options MASK => 'MASK', WITHIN => '<<=', CONTAINS => '>>=', ); if ($args{type}) { # assume alloctype class if we only get one letter $args{type} = "_$args{type}" if $args{type} =~ /^.$/; my $notflag = ''; if ($args{type} =~ /^NOT:/) { $args{type} =~ s/^NOT://; $notflag = 'NOT '; } if ($args{type} =~ /\./) { $args{type} =~ s/\./_/; push @matchtypes, $notflag.'LIKE'; } else { push @matchtypes, ($notflag ? '<>' : '='); } push @fields, 's.type'; push @vals, $args{type}; } ## CIDR query options. if ($args{cidr}) { $args{cidr} =~ s/^\s*(.+)\s*$/$1/g; # strip matching type substring, if any - only applies to full-CIDR my ($mnote) = $args{cidr} =~ /^(\w+):/; $args{cidr} =~ s/^$mnote:// if $mnote; if ($args{cidr} eq '') { # We has a blank CIDR. Ignore it. } elsif ($args{cidr} =~ /\//) { my ($net,$maskbits) = split /\//, $args{cidr}; if ($args{cidr} =~ /^(\d{1,3}\.){3}\d{1,3}\/\d{2}$/) { # Full CIDR match. push @fields, 's.cidr'; push @vals, $args{cidr}; if ($mnote =~ /(EQUAL|EXACT|CONTAINS|WITHIN)/) { push @matchtypes, $mt{$1}; } else { # default to exact match push @matchtypes, '='; } } elsif ($args{cidr} =~ /^(\d{1,3}\.){2}\d{1,3}\/\d{2}$/) { # Partial match; beginning of subnet and maskbits are provided # Show any blocks with the leading octet(s) and that masklength # eg 192.168.179/26 should show all /26 subnets in 192.168.179 # Need some more magic for bare /nn searches: push @fields, 's.cidr','masklen(s.cidr)'; push @vals, "$net.0/24", $maskbits; push @matchtypes, '<<=','='; } } elsif ($args{cidr} =~ /^(\d{1,3}\.){3}\d{1,3}$/) { # Specific IP address match. Will show the parent chain down to the final allocation. push @fields, 's.cidr'; push @vals, $args{cidr}; push @matchtypes, '>>='; } elsif ($args{cidr} =~ /^\d{1,3}(\.(\d{1,3}(\.(\d{1,3}\.?)?)?)?)?$/) { # 1, 2, or 3 leading octets in CIDR push @fields, 'text(s.cidr)'; push @vals, "$args{cidr}\%"; push @matchtypes, 'LIKE'; # hmm } else { # do nothing. ##fixme we'll ignore this to clear out the references to legacy code. } # done with CIDR query options. } # args{cidr} foreach my $sfield (qw(custid description notes city) ) { if ($args{$sfield}) { push @fields, "s.$sfield"; if ($args{$sfield} =~ /^(EXACT|NOT):/) { push @matchtypes, $mt{$1}; $args{$sfield} =~ s/^$1://; } else { push @matchtypes, '~*'; } push @vals, $args{$sfield}; } } if ($args{parent_id}) { # parent_id is always exact. default to positive match if ($args{parent_id} =~ /^NOT:/) { $args{parent_id} =~ s/^NOT://; push @matchtypes, '<>'; } else { push @matchtypes, '='; } push @fields, 's.parent_id'; push @vals, $args{parent_id}; } # Filter on "available", because we can. if (defined($args{available}) { # Flex input; accept 1 or 0 as y/n respectively. $args{available} =~ tr/10/yn/; if ($args{available} =~ /^[yn]$/) { push @fields, "s.available"; push @matchtypes, '='; push @vals, $args{available}; } } my $cols = "s.cidr, s.custid, s.type, s.city, s.description, s.id, s.parent_id, s.available, a.vrf, at.dispname"; # Validation and SQL field name mapping all in one! my %validcols = (cidr => 's.cidr', custid => 's.custid', oldcustid => 's.oldcustid', type => 's.type', city => 's.city', description => 's.description', notes => 's.notes', circuitid => 's.circuitid', vrf => 'a.vrf', vlan => 's.vlan', id => 's.id', parent_id => 's.parent_id', master_id => 's.master_id', available => 's.available'); my @usercols; if ($args{retfields}) { # caller wants a custom set of returned fields if (ref($args{retfields}) eq ref([])) { # field list passed as list/array foreach (@{$args{retfields}}) { push @usercols, $validcols{$_} if $validcols{$_}; } } elsif (not ref $args{retfields}) { # field list passed as simple string foreach (split /\s+/, $args{retfields}) { push @usercols, $validcols{$_} if $validcols{$_}; } } else { # nonfatal fail. only accepts array or string. fall back to default list } } # only replace the default set if a custom set was passed in $cols = join ', ', @usercols if @usercols; my $sql = qq(SELECT $cols FROM searchme s JOIN alloctypes at ON s.type = at.type JOIN allocations a ON s.master_id=a.id); my @sqlcriteria; for (my $i = 0; $i <= $#fields; $i++) { push @sqlcriteria, "$fields[$i] $matchtypes[$i] ?"; } $sql .= " WHERE ".join(' AND ', @sqlcriteria) if @sqlcriteria; # multifield sorting! if ($args{order}) { my @ordfields = split /,/, $args{order}; # there are probably better ways to do this my %omap = (cidr => 's.cidr', net => 's.cidr', network => 's.cidr', ip => 's.cidr', custid => 's.custid', type => 's.type', city => 's.city', desc => 's.description', description => 's.description'); my @ordlist; # only pass sort field values from the list of acceptable field names or aliases as per %omap foreach my $ord (@ordfields) { push @ordlist, $omap{$ord} if grep /^$ord$/, (keys %omap); } if (@ordlist) { $sql .= " ORDER BY ". join(',', @ordlist); } } my $result = $ip_dbh->selectall_arrayref($sql, {Slice=>{}}, @vals); die $ip_dbh->errstr if !$result; return $result; } # rpc_search() __END__ =pod =head1 IPDB XMLRPC Search This is a general-purpose search API for IPDB. It is currently being extended based on requirements from other tools needing to search for data in IPDB. It supports one XMLRPC sub, "search". The calling URL for this API should end with "/search-rpc.cgi". If you are doing many requests, you should use the FastCGI variant with .fcgi instead of .cgi. =head2 Calling conventions IPDB RPC services use "XMLRPC", http://xmlrpc.com, for data exchange. Arguments are passed in as a key-value list, and data is returned as an array of hashes in some form. =over 4 =item Perl use Frontier::Client; my $server = Frontier::Client->new( url => "http://server/path/search-rpc.cgi", ); my %args = ( rpcsystem => 'somesystem', rpcuser => 'someuser', arg1 => 'val1', arg2 => 'val2', ); my $result = $server->call('ipdb.search', %args); =item Python 2 import xmlrpclib server = xmlrpclib.Server("http://server/path/search-rpc.cgi") result = server.ipdb.search( 'rpcsystem', 'comesystems', 'rpcuser', 'someuser', 'arg1', 'val1', 'arg2', 'val2', ) =item Python 3 import xmlrpc.client server = xmlrpc.client.ServerProxy("http://server/path/search-rpc.cgi") result = server.ipdb.search( 'rpcsystem', 'somesystem', 'rpcuser', 'someuser', 'arg1', 'val1', 'arg2', 'val2', ) =back =head3 Standard arguments The C argument is required, and C is strongly recommended as it may be used for access control in some future updates. C must match a configuration entry in the IPDB configuration, and a given string may only be used from an IP listed under that configuration entry. =head2 Search fields and metaoperators Not all fields are exposed for search. For most purposes these should be sufficient. Most fields support EXACT: or NOT: prefixes on the search term to restrict the matches. =over 4 =item cidr A full or partial CIDR network or IP address. Valid formats include: =over 4 =item Complete CIDR network, eg 192.168.2.0/24 Returns an exact match for the passed CIDR network. If prefixed with "CONTAINS:", the containing netblocks up to the master block will also be returned. If prefixed with "WITHIN:", any suballocations in that IP range will be returned. =item Partial/short CIDR specification with mask length, eg 192.168.3/27 Returns all /27 assignments within 192.168.3.0/24. =item Partial/short CIDR specification, eg 192.168.4 Returns all assignments matching that leading partial string. Note that 192.168.4 will also return 192.168.40.0/24 through 192.168.49.0/24 as well as the obvious 192.168.4.0/24. =item Bare IP address with no mask, eg 192.168.5.42 Returns all assignments containing that IP. =back =item custid Match on a customer ID. Defaults to a partial match. =item type Match the two-character internal allocation type identifier. Defaults to an exact match. Replace the first character with a dot or underscore, or leave it off, to match all subtypes of a class; eg .i will return all types of static IP assignments. A full list of current allocation types is available from the main RPC API's getTypeList sub. =item city Matches in the city string. =item description Matches in the description string. =item notes Matches in the notes field. =item available Only useful for static IPs. For historic and architectural reasons, unallocated static IPs are included in general search results. Specify 'y' or 'n' to return only unallocated or allocated static IPs respectively. To search for a free block, use the main RPC API's listFree or findAllocateFrom subs. =item parent_id Restrict to allocations in the given parent. =item order Sort order specification. Send a string of comma-separated field names for subsorting. Valid sort fields are cidr, custid, type, city, and description. =item fields Specify the fields to return from the search. By default, these are returned: =over 4 cidr custid type city description id parent_id available vrf dispname (the "display name" for the type) =back The following are available from this interface: =over 4 cidr custid oldcustid type city description notes circuitid vrf vlan id parent_id master_id available =back The list may be sent as a space-separated string or as an array. Unknown field names will be ignored. =back