| [600] | 1 | #!/usr/bin/perl | 
|---|
|  | 2 | # XMLRPC interface to manipulate most DNS DB entities | 
|---|
|  | 3 | ### | 
|---|
|  | 4 | # $Id$ | 
|---|
|  | 5 | ### | 
|---|
|  | 6 | # Copyright (C) 2013 Kris Deugau <kdeugau@deepnet.cx> | 
|---|
|  | 7 |  | 
|---|
|  | 8 | use strict; | 
|---|
|  | 9 | use warnings; | 
|---|
|  | 10 |  | 
|---|
|  | 11 | use DBI; | 
|---|
|  | 12 | use CustIDCK; | 
|---|
|  | 13 | use NetAddr::IP; | 
|---|
|  | 14 | use FCGI; | 
|---|
|  | 15 | use Frontier::Responder; | 
|---|
|  | 16 |  | 
|---|
|  | 17 | use Sys::Syslog; | 
|---|
|  | 18 |  | 
|---|
|  | 19 | # don't remove!  required for GNU/FHS-ish install from tarball | 
|---|
|  | 20 | ##uselib## | 
|---|
|  | 21 |  | 
|---|
|  | 22 | use MyIPDB; | 
|---|
|  | 23 |  | 
|---|
|  | 24 | openlog "IPDB-rpc","pid","$IPDB::syslog_facility"; | 
|---|
|  | 25 |  | 
|---|
|  | 26 | ##fixme:  username source?  can we leverage some other auth method? | 
|---|
|  | 27 | # we don't care except for logging here, and Frontier::Client needs | 
|---|
|  | 28 | # a patch that's not well-distributed to use HTTP AUTH. | 
|---|
|  | 29 |  | 
|---|
|  | 30 | # Collect the username from HTTP auth.  If undefined, we're in | 
|---|
|  | 31 | # a test environment, or called without a username. | 
|---|
|  | 32 | my $authuser; | 
|---|
|  | 33 | if (!defined($ENV{'REMOTE_USER'})) { | 
|---|
|  | 34 | $authuser = '__temptest'; | 
|---|
|  | 35 | } else { | 
|---|
|  | 36 | $authuser = $ENV{'REMOTE_USER'}; | 
|---|
|  | 37 | } | 
|---|
|  | 38 |  | 
|---|
|  | 39 | syslog "debug", "$authuser active, $ENV{'REMOTE_ADDR'}"; | 
|---|
|  | 40 |  | 
|---|
|  | 41 | # Why not a global DB handle?  (And a global statement handle, as well...) | 
|---|
|  | 42 | # Use the connectDB function, otherwise we end up confusing ourselves | 
|---|
|  | 43 | my $ip_dbh; | 
|---|
|  | 44 | my $sth; | 
|---|
|  | 45 | my $errstr; | 
|---|
|  | 46 | ($ip_dbh,$errstr) = connectDB_My; | 
|---|
|  | 47 | initIPDBGlobals($ip_dbh); | 
|---|
|  | 48 |  | 
|---|
|  | 49 | my $methods = { | 
|---|
|  | 50 | #       'ipdb.getCityList'      => \&rpc_getCityList, | 
|---|
|  | 51 | 'ipdb.getAvailableStatics'      => \&rpc_getAvailableStatics, | 
|---|
|  | 52 | 'ipdb.allocateBlock'    =>      \&rpc_allocateBlock, | 
|---|
|  | 53 | }; | 
|---|
|  | 54 |  | 
|---|
|  | 55 | my $reqcnt = 0; | 
|---|
|  | 56 |  | 
|---|
|  | 57 | # main FCGI loop. | 
|---|
|  | 58 | while (FCGI::accept >= 0) { | 
|---|
|  | 59 | # don't *think* we need any of these... | 
|---|
|  | 60 | # %disp_alloctypes, %def_custids, %list_alloctypes | 
|---|
|  | 61 | # @citylist, @poplist | 
|---|
|  | 62 | # @masterblocks, %allocated, %free, %bigfree, %routed  (removed in /trunk) | 
|---|
|  | 63 | # %IPDBacl | 
|---|
|  | 64 | #initIPDBGlobals($ip_dbh); | 
|---|
|  | 65 |  | 
|---|
|  | 66 | my $res = Frontier::Responder->new( | 
|---|
|  | 67 | methods => $methods | 
|---|
|  | 68 | ); | 
|---|
|  | 69 |  | 
|---|
|  | 70 | # "Can't do that" errors | 
|---|
|  | 71 | if (!$ip_dbh) { | 
|---|
|  | 72 | print "Content-type: text/xml\n\n".$res->{_decode}->encode_fault(5, $DBI::errstr); | 
|---|
|  | 73 | } else { | 
|---|
|  | 74 | print $res->answer; | 
|---|
|  | 75 | } | 
|---|
|  | 76 | #  last if $reqcnt++ > $IPDB::maxfcgi; | 
|---|
|  | 77 | } # while FCGI::accept | 
|---|
|  | 78 |  | 
|---|
|  | 79 | exit 0; | 
|---|
|  | 80 |  | 
|---|
|  | 81 |  | 
|---|
|  | 82 | ## | 
|---|
|  | 83 | ## Private subs | 
|---|
|  | 84 | ## | 
|---|
|  | 85 |  | 
|---|
|  | 86 | # Check RPC ACL | 
|---|
|  | 87 | sub _aclcheck { | 
|---|
|  | 88 | my $subsys = shift; | 
|---|
|  | 89 | return 1; | 
|---|
|  | 90 | return 1 if grep /$ENV{REMOTE_ADDR}/, $IPDB::rpcacl{$subsys}; | 
|---|
|  | 91 | warn "$subsys/$ENV{REMOTE_ADDR} not in ACL\n";        # a bit of logging | 
|---|
|  | 92 | return 0; | 
|---|
|  | 93 | } | 
|---|
|  | 94 |  | 
|---|
|  | 95 | sub _commoncheck { | 
|---|
|  | 96 | my $argref = shift; | 
|---|
|  | 97 | my $needslog = shift; | 
|---|
|  | 98 |  | 
|---|
|  | 99 | die "Missing remote system name\n" if !$argref->{rpcsystem}; | 
|---|
|  | 100 | die "Access denied\n" if !_aclcheck($argref->{rpcsystem}); | 
|---|
|  | 101 | if ($needslog) { | 
|---|
|  | 102 | die "Missing remote username\n" if !$argref->{rpcuser}; | 
|---|
|  | 103 | } | 
|---|
|  | 104 | } | 
|---|
|  | 105 |  | 
|---|
|  | 106 | # stripped-down copy from from main.cgi.  should probably be moved to IPDB.pm | 
|---|
|  | 107 | sub _validateInput { | 
|---|
|  | 108 | my $argref = shift; | 
|---|
|  | 109 |  | 
|---|
|  | 110 | die "Block/IP is required\n" if !$argref->{block}; | 
|---|
|  | 111 |  | 
|---|
|  | 112 | # Alloctype check. | 
|---|
|  | 113 | chomp $argref->{alloctype}; | 
|---|
|  | 114 |  | 
|---|
|  | 115 | die "Invalid allocation type\n" if (!grep /$argref->{alloctype}/, keys %disp_alloctypes); | 
|---|
|  | 116 |  | 
|---|
|  | 117 | # Arguably not quite correct, as the custID won't be checked for | 
|---|
|  | 118 | # validity if there's a default on the type. | 
|---|
|  | 119 | if ($def_custids{$argref->{alloctype}} eq '') { | 
|---|
|  | 120 | # Types without a default custID must have one passed in | 
|---|
|  | 121 | die "Customer ID is required\n" if !$argref->{custid}; | 
|---|
|  | 122 | # Crosscheck with billing. | 
|---|
|  | 123 | my $status = CustIDCK->custid_exist($argref->{custid}); | 
|---|
|  | 124 | die "Error verifying customer ID: $CustIDCK::ErrMsg\n" if $CustIDCK::Error; | 
|---|
|  | 125 | die "Customer ID not valid\n" if !$status; | 
|---|
|  | 126 | } else { | 
|---|
|  | 127 | # Types that have a default will use it unless one is specified. | 
|---|
|  | 128 | if ((!$argref->{custid}) || ($argref->{custid} ne 'STAFF')) { | 
|---|
|  | 129 | $argref->{custid} = $def_custids{$argref->{alloctype}}; | 
|---|
|  | 130 | } | 
|---|
|  | 131 | } | 
|---|
|  | 132 | } # end validateInput() | 
|---|
|  | 133 |  | 
|---|
|  | 134 |  | 
|---|
|  | 135 | ## | 
|---|
|  | 136 | ## RPC method subs | 
|---|
|  | 137 | ## | 
|---|
|  | 138 |  | 
|---|
|  | 139 | # Prefixed with rpc_ to not conflict with subs in IPDB.pm | 
|---|
|  | 140 |  | 
|---|
|  | 141 | sub rpc_getCityList { | 
|---|
|  | 142 | my %args = @_; | 
|---|
|  | 143 |  | 
|---|
|  | 144 | _commoncheck(\%args, 'n'); | 
|---|
|  | 145 | } | 
|---|
|  | 146 |  | 
|---|
|  | 147 | # Get a list of available static IPs of the given type | 
|---|
|  | 148 | sub rpc_getAvailableStatics { | 
|---|
|  | 149 | my %args = @_; | 
|---|
|  | 150 |  | 
|---|
|  | 151 | _commoncheck(\%args, 'n'); | 
|---|
|  | 152 |  | 
|---|
|  | 153 | my ($base,undef) = split //, $args{type}; | 
|---|
|  | 154 | $base .= "_"; | 
|---|
|  | 155 | my @params = ($base); | 
|---|
|  | 156 |  | 
|---|
|  | 157 | # IPDB 2.7 | 
|---|
|  | 158 | my $sql = "SELECT 0 AS id,poolips.ip,0 AS parent_id,pool ". | 
|---|
|  | 159 | "FROM poolips JOIN allocations ON poolips.pool=allocations.cidr WHERE poolips.type LIKE ?"; | 
|---|
|  | 160 |  | 
|---|
|  | 161 | $sql .= " AND allocations.city=?" if $base ne 'd_'; | 
|---|
|  | 162 | push @params, $args{city} if $base ne 'd_'; | 
|---|
|  | 163 |  | 
|---|
|  | 164 | $sql .= " AND poolips.available='y'"; | 
|---|
|  | 165 |  | 
|---|
|  | 166 | my $ret = $ip_dbh->selectall_arrayref($sql, { Slice => {} }, (@params) ); | 
|---|
|  | 167 | # IPDB 3.0 | 
|---|
|  | 168 | #my $ret = $ipdb->getIPList(arg arg arg); | 
|---|
|  | 169 | die $ip_dbh->errstr if !$ret; | 
|---|
|  | 170 | return $ret; | 
|---|
|  | 171 | } # rpc_getAvailableStatics() | 
|---|
|  | 172 |  | 
|---|
|  | 173 | sub rpc_allocateBlock { | 
|---|
|  | 174 | my %args = @_; | 
|---|
|  | 175 |  | 
|---|
|  | 176 | _commoncheck(\%args, 'y'); | 
|---|
|  | 177 |  | 
|---|
|  | 178 | _validateInput(\%args); | 
|---|
|  | 179 |  | 
|---|
|  | 180 | # Not required for update, delete | 
|---|
|  | 181 | die "City is required\n" if !$args{city}; | 
|---|
|  | 182 | die "Block/pool to allocate from is required\n" if !$args{alloc_from}; | 
|---|
|  | 183 |  | 
|---|
|  | 184 | # Desc, notes, circid, privdata, node, and vrf are all optional and handled in allocateBlock() | 
|---|
|  | 185 | my ($code,$msg) = allocateBlock($ip_dbh, $args{block}, $args{alloc_from}, | 
|---|
|  | 186 | $args{custid}, $args{alloctype}, $args{city}, $args{desc}, $args{notes}, | 
|---|
|  | 187 | $args{circid}, $args{privdata}, $args{node}, $args{vrf}); | 
|---|
|  | 188 |  | 
|---|
|  | 189 | if ($code eq 'OK' || $code eq 'WARN') { | 
|---|
|  | 190 | if ($args{alloctype} =~ /^.i$/) { | 
|---|
|  | 191 | $msg =~ s|/32||; | 
|---|
|  | 192 | mailNotify($ip_dbh, "a$args{alloctype}", "ADDED: $disp_alloctypes{$args{alloctype}} allocation", | 
|---|
|  | 193 | "$disp_alloctypes{$args{alloctype}} $msg allocated to customer $args{custid}\n". | 
|---|
|  | 194 | "Description: $args{desc}\n\nAllocated by: $args{rpcsystem}/$args{rpcuser}\n"); | 
|---|
|  | 195 | } else { | 
|---|
|  | 196 | my $netblock = new NetAddr::IP $args{block}; | 
|---|
|  | 197 | mailNotify($ip_dbh, "a$args{alloctype}", "ADDED: $disp_alloctypes{$args{alloctype}} allocation", | 
|---|
|  | 198 | "$disp_alloctypes{$args{alloctype}} $args{block} allocated to customer $args{custid}\n". | 
|---|
|  | 199 | "Description: $args{desc}\n\nAllocated by: $args{rpcsystem}/$args{rpcuser}\n"); | 
|---|
|  | 200 | } | 
|---|
|  | 201 | syslog "notice", "$args{rpcsystem}/$args{rpcuser} allocated '$args{block}' to '$args{custid}' as ". | 
|---|
|  | 202 | "'$args{alloctype}' ($msg)"; | 
|---|
|  | 203 | } else { | 
|---|
|  | 204 | syslog "err", "Allocation of '$args{block}' to '$args{custid}' as ". | 
|---|
|  | 205 | "'$args{alloctype}' by $args{rpcsystem}/$args{rpcuser} failed: '$msg'"; | 
|---|
|  | 206 | die "$msg\n"; | 
|---|
|  | 207 | } | 
|---|
|  | 208 | return $msg; | 
|---|
|  | 209 | } # rpc_allocateBlock() | 
|---|