1 | #!/usr/bin/perl |
---|
2 | # ipdb/cgi-bin/admin.cgi |
---|
3 | # Hack interface to make specific changes to IPDB that (for one reason |
---|
4 | # or another) can't be made through the main interface. |
---|
5 | # |
---|
6 | ### |
---|
7 | # SVN revision info |
---|
8 | # $Date: 2010-08-04 20:08:41 +0000 (Wed, 04 Aug 2010) $ |
---|
9 | # SVN revision $Rev: 459 $ |
---|
10 | # Last update by $Author: kdeugau $ |
---|
11 | ### |
---|
12 | # Copyright (C) 2004-2010 - Kris Deugau |
---|
13 | |
---|
14 | use strict; |
---|
15 | use warnings; |
---|
16 | use CGI::Carp qw(fatalsToBrowser); |
---|
17 | use CGI::Simple; |
---|
18 | use HTML::Template; |
---|
19 | use DBI; |
---|
20 | use CommonWeb qw(:ALL); |
---|
21 | use CustIDCK; |
---|
22 | #use POSIX qw(ceil); |
---|
23 | use NetAddr::IP; |
---|
24 | |
---|
25 | use Sys::Syslog; |
---|
26 | |
---|
27 | # don't remove! required for GNU/FHS-ish install from tarball |
---|
28 | ##uselib## |
---|
29 | |
---|
30 | use MyIPDB; |
---|
31 | |
---|
32 | openlog "IPDB-admin","pid","$IPDB::syslog_facility"; |
---|
33 | |
---|
34 | # Collect the username from HTTP auth. If undefined, we're in a test environment. |
---|
35 | my $authuser; |
---|
36 | if (!defined($ENV{'REMOTE_USER'})) { |
---|
37 | $authuser = '__temptest'; |
---|
38 | } else { |
---|
39 | $authuser = $ENV{'REMOTE_USER'}; |
---|
40 | } |
---|
41 | |
---|
42 | syslog "debug", "$authuser active"; |
---|
43 | |
---|
44 | # Why not a global DB handle? (And a global statement handle, as well...) |
---|
45 | # Use the connectDB function, otherwise we end up confusing ourselves |
---|
46 | my $ip_dbh; |
---|
47 | my $sth; |
---|
48 | my $errstr; |
---|
49 | ($ip_dbh,$errstr) = connectDB_My; |
---|
50 | if (!$ip_dbh) { |
---|
51 | printAndExit("Database error: $errstr\n"); |
---|
52 | } |
---|
53 | initIPDBGlobals($ip_dbh); |
---|
54 | |
---|
55 | ##fixme - need to autofill this somehow |
---|
56 | $ENV{HTML_TEMPLATE_ROOT} = '/home/kdeugau/dev/ipdb/trunk/templates'; |
---|
57 | |
---|
58 | if ($IPDBacl{$authuser} !~ /A/) { |
---|
59 | print "Content-Type: text/html\n\n". |
---|
60 | "<html>\n<head>\n\t<title>Access denied</title>\n". |
---|
61 | qq(\t<link rel="stylesheet" type="text/css" href="/ip/ipdb.css">\n). |
---|
62 | qq(\t<link rel="stylesheet" type="text/css" href="/ip/local.css">\n). |
---|
63 | "</head>\n<body>\n". |
---|
64 | qq(Access to this tool is restricted. Contact the <a href="mailto:ipdbadmin\@example.com">IPDB administrator</a> \n). |
---|
65 | "for more information.\n</body>\n</html>\n"; |
---|
66 | exit; |
---|
67 | } |
---|
68 | |
---|
69 | # Set up the CGI object... |
---|
70 | my $q = new CGI::Simple; |
---|
71 | # ... and get query-string params as well as POST params if necessary |
---|
72 | $q->parse_query_string; |
---|
73 | |
---|
74 | # Convenience; saves changing all references to %webvar |
---|
75 | ##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection) |
---|
76 | my %webvar = $q->Vars; |
---|
77 | |
---|
78 | print "Content-type: text/html\n\n". |
---|
79 | "<html>\n<head>\n\t<title>[IPDB admin tools]</title>\n". |
---|
80 | qq(\t<link rel="stylesheet" type="text/css" href="/ip/ipdb.css">\n). |
---|
81 | qq(\t<link rel="stylesheet" type="text/css" href="/ip/local.css">\n). |
---|
82 | "</head>\n<body>\n". |
---|
83 | "<h2>IPDB - Administrative Tools</h2>\n<hr>\n"; |
---|
84 | |
---|
85 | if(!defined($webvar{action})) { |
---|
86 | $webvar{action} = "<NULL>"; #shuts up the warnings. |
---|
87 | |
---|
88 | my $typelist = ''; |
---|
89 | $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder"); |
---|
90 | $sth->execute; |
---|
91 | my @data = $sth->fetchrow_array; |
---|
92 | $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n"; |
---|
93 | while (my @data = $sth->fetchrow_array) { |
---|
94 | $typelist .= "<option value='$data[0]'>$data[1]</option>\n"; |
---|
95 | } |
---|
96 | |
---|
97 | my $masterlist = ''; |
---|
98 | $sth = $ip_dbh->prepare("select cidr,mtime from masterblocks order by cidr"); |
---|
99 | $sth->execute; |
---|
100 | while (my @data = $sth->fetchrow_array) { |
---|
101 | $masterlist .= "<option value='$data[0]'>$data[0] ($data[1])</option>\n"; |
---|
102 | } |
---|
103 | |
---|
104 | print qq(WARNING: There are FAR fewer controls on what you can do here. Use the |
---|
105 | main interface if at all possible. |
---|
106 | <hr> |
---|
107 | <form action="admin.cgi" method="POST"> |
---|
108 | <input type=hidden name=action value=alloc> |
---|
109 | Allocate block/IP: <input name=cidr> as <select name=alloctype>$typelist</select> to <input name=custid> |
---|
110 | <input type=submit value=" GIMME!! "></form> |
---|
111 | <hr><form action="admin.cgi" method="POST"> |
---|
112 | <input type=hidden name=action value=alloctweak> |
---|
113 | Manually update allocation data in this /24: <input name=allocfrom> |
---|
114 | <input type=submit value="Show allocations"> |
---|
115 | </form> |
---|
116 | |
---|
117 | <hr>rWHOIS tools: |
---|
118 | <form action="admin.cgi" method="POST"> |
---|
119 | <input type=hidden name=action value=touch> |
---|
120 | Bump "last updated" timestamp on this master: <select name=whichmaster>$masterlist</select> |
---|
121 | <input type=submit value="Update timestamp"> (Sets timestamp to "now")</form> |
---|
122 | <a href="admin.cgi?action=listcust">Edit customer data for rWHOIS</a> - data used for |
---|
123 | blocks with the SWIP box checkmarked. Links to edit/add data are on this page. |
---|
124 | |
---|
125 | <hr><a href="admin.cgi?action=showpools">List IP Pools</a> for manual tweaking and updates |
---|
126 | |
---|
127 | <hr><a href="admin.cgi?action=showusers">Manage users</a> (add/remove users; change |
---|
128 | internal access controls - note that this does NOT include IP-based limits)<br> |
---|
129 | <a href="admin.cgi?action=emailnotice">Manage email notice options</a> (pick which events |
---|
130 | and allocation types cause notifications; configure recipient lists for notices) |
---|
131 | |
---|
132 | <hr>Consistency check tools<br> |
---|
133 | <a href="consistency-check.pl">General</a>: Check general netblock consistency.<br> |
---|
134 | <a href="freespace.pl">Free space</a>: List total and aggregate free space. Does not |
---|
135 | include private networks (192.168.0.0/16, 172.16.0.0/12, 10.0.0.0/8) |
---|
136 | ); |
---|
137 | } else { |
---|
138 | print '<a href="/ip/cgi-bin/admin.cgi">Back</a> to main<hr>'; |
---|
139 | } |
---|
140 | |
---|
141 | |
---|
142 | ## Possible actions. |
---|
143 | if ($webvar{action} eq 'alloc') { |
---|
144 | # OK, we know what we're allocating. |
---|
145 | |
---|
146 | if ($webvar{cidr} !~ /^\s*(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s*$/) { |
---|
147 | printAndExit("Can't allocate something that's not a netblock/ip"); |
---|
148 | } |
---|
149 | |
---|
150 | $sth = $ip_dbh->prepare("select def_custid from alloctypes where type='$webvar{alloctype}'"); |
---|
151 | $sth->execute; |
---|
152 | my @data = $sth->fetchrow_array; |
---|
153 | my $custid = $data[0]; |
---|
154 | if ($custid eq '') { |
---|
155 | if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)(?:-\d\d?)?$/) { |
---|
156 | # Force uppercase for now... |
---|
157 | $webvar{custid} =~ tr/a-z/A-Z/; |
---|
158 | # Crosscheck with billing. |
---|
159 | my $status = CustIDCK->custid_exist($webvar{custid}); |
---|
160 | if ($CustIDCK::Error) { |
---|
161 | printError("Error verifying customer ID: ".$CustIDCK::ErrMsg); |
---|
162 | return; |
---|
163 | } |
---|
164 | if (!$status) { |
---|
165 | printError("Customer ID not valid. Make sure the Customer ID ". |
---|
166 | "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ". |
---|
167 | "non-customer assignments."); |
---|
168 | return; |
---|
169 | } |
---|
170 | } |
---|
171 | # Type that doesn't have a default custid |
---|
172 | $custid = $webvar{custid}; |
---|
173 | } |
---|
174 | |
---|
175 | my $cidr = new NetAddr::IP $webvar{cidr}; |
---|
176 | my @data; |
---|
177 | if ($webvar{alloctype} eq 'rm') { |
---|
178 | $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and routed='n'"); |
---|
179 | $sth->execute; |
---|
180 | @data = $sth->fetchrow_array; |
---|
181 | # User deserves errors if user can't be bothered to find the free block first. |
---|
182 | printAndExit("Can't allocate from outside a free block!!\n") |
---|
183 | if !$data[0]; |
---|
184 | } elsif ($webvar{alloctype} =~ /^(.)i$/) { |
---|
185 | $sth = $ip_dbh->prepare("select cidr from allocations where cidr >>='$cidr' and (type like '_d' or type like '_p')"); |
---|
186 | $sth->execute; |
---|
187 | @data = $sth->fetchrow_array; |
---|
188 | # User deserves errors if user can't be bothered to find the pool and a free IP first. |
---|
189 | printAndExit("Can't allocate static IP from outside a pool!!\n") |
---|
190 | if !$data[0]; |
---|
191 | } else { |
---|
192 | $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and not (routed='n')"); |
---|
193 | $sth->execute; |
---|
194 | @data = $sth->fetchrow_array; |
---|
195 | # User deserves errors if user can't be bothered to find the free block first. |
---|
196 | printAndExit("Can't allocate from outside a routed block!!\n") |
---|
197 | if !$data[0]; |
---|
198 | } |
---|
199 | |
---|
200 | my $alloc_from = new NetAddr::IP $data[0]; |
---|
201 | $sth->finish; |
---|
202 | |
---|
203 | my $cities = ''; |
---|
204 | foreach my $city (@citylist) { |
---|
205 | $cities .= "<option>$city</option>\n"; |
---|
206 | } |
---|
207 | |
---|
208 | print qq(<table class=regular> |
---|
209 | <form method=POST action=admin.cgi> |
---|
210 | <tr class=color1> |
---|
211 | <td>Allocating:</td> |
---|
212 | <td>$cidr<input type=hidden name=cidr value="$cidr"></td> |
---|
213 | </tr><tr class=color2> |
---|
214 | <td>Type:</td><td>$disp_alloctypes{$webvar{alloctype}} |
---|
215 | <input type=hidden name=alloctype value="$webvar{alloctype}"></td> |
---|
216 | </tr><tr class=color1> |
---|
217 | <td>Allocated from:</td> |
---|
218 | <td>$alloc_from<input type=hidden name=alloc_from value="$alloc_from"></td> |
---|
219 | </tr><tr class="color2"> |
---|
220 | <td>Customer ID:</td><td>$custid<input type=hidden name=custid value="$custid"></td> |
---|
221 | </tr><tr class=color1> |
---|
222 | <td>Customer location:</td><td> |
---|
223 | <select name="city"><option selected>-</option> |
---|
224 | $cities |
---|
225 | </select> |
---|
226 | <a href="javascript:popNotes('/ip/cgi-bin/newcity.cgi')">Add new location</a> |
---|
227 | </td> |
---|
228 | </tr> |
---|
229 | <tr class="color2"> |
---|
230 | <td>Circuit ID:</td><td><input name=circid size=40></td> |
---|
231 | </tr><tr class="color1"> |
---|
232 | <td>Description/Name:</td><td><input name="desc" size=40></td> |
---|
233 | </tr><tr class="color2"> |
---|
234 | <td>Notes:</td><td><textarea name="notes" rows="3" cols="40"></textarea></td> |
---|
235 | </tr><tr class="warning"> |
---|
236 | <td colspan=2><center>WARNING: This will IMMEDIATELY assign this block!!</center></td> |
---|
237 | </tr><tr class="color2"> |
---|
238 | <td class="center" colspan="2"><input type="submit" value=" Assign "></td> |
---|
239 | <input type="hidden" name="action" value="confirm"> |
---|
240 | </form> |
---|
241 | </tr> |
---|
242 | </table> |
---|
243 | ); |
---|
244 | |
---|
245 | |
---|
246 | } elsif ($webvar{action} eq 'confirm') { |
---|
247 | |
---|
248 | print "Assigning $webvar{cidr} to $webvar{custid} (\"$webvar{desc}\") as ". |
---|
249 | "$disp_alloctypes{$webvar{alloctype}}...<br>\n"; |
---|
250 | # Only need to check city here. |
---|
251 | if ($webvar{city} eq '-') { |
---|
252 | printError("Invalid customer location! Go back and select customer's location."); |
---|
253 | } else { |
---|
254 | if ($webvar{alloctype} =~ /^.i$/) { |
---|
255 | $sth = $ip_dbh->prepare("update poolips set available='n', custid='$webvar{custid}', ". |
---|
256 | "city='$webvar{city}', description='$webvar{desc}', notes='$webvar{notes}' ". |
---|
257 | "where ip='$webvar{cidr}'"); |
---|
258 | $sth->execute; |
---|
259 | if ($sth->err) { |
---|
260 | print "Allocation failed! DBI said:\n".$sth->errstr."\n"; |
---|
261 | syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ". |
---|
262 | "'$webvar{alloctype}' failed: '".$sth->errstr."'"; |
---|
263 | } else { |
---|
264 | print "Allocation OK!\n"; |
---|
265 | syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ". |
---|
266 | "'$webvar{alloctype}'"; |
---|
267 | mailNotify($ip_dbh, "a$webvar{alloctype}", |
---|
268 | "$disp_alloctypes{$webvar{alloctype}} $webvar{cidr} allocated to customer". |
---|
269 | " $webvar{custid}\n". |
---|
270 | "Description: $webvar{desc}\n\nAllocated by: $authuser\n"); |
---|
271 | } |
---|
272 | } else { |
---|
273 | my ($retcode,$msg) = allocateBlock($ip_dbh, $webvar{cidr}, $webvar{alloc_from}, |
---|
274 | $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes}, |
---|
275 | $webvar{circid}); |
---|
276 | if ($retcode eq 'OK') { |
---|
277 | print "Allocation OK!\n"; |
---|
278 | syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ". |
---|
279 | "'$webvar{alloctype}'"; |
---|
280 | } else { |
---|
281 | print "Allocation failed! IPDB::allocateBlock said:\n$msg\n"; |
---|
282 | syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ". |
---|
283 | "'$webvar{alloctype}' failed: '$msg'"; |
---|
284 | } |
---|
285 | } # static IP vs netblock |
---|
286 | |
---|
287 | } # done city check |
---|
288 | |
---|
289 | } elsif ($webvar{action} eq 'alloctweak') { |
---|
290 | fix_allocfrom(); |
---|
291 | showAllocs($webvar{allocfrom}); |
---|
292 | } elsif ($webvar{action} eq 'update') { |
---|
293 | update(); |
---|
294 | } elsif ($webvar{action} eq 'assign') { |
---|
295 | # Display a list of possible blocks within the requested block. |
---|
296 | open (HTML, "../admin_alloc.html") |
---|
297 | or croak "Could not open admin_alloc.html :$!"; |
---|
298 | my $html = join('', <HTML>); |
---|
299 | $html =~ s/\$\$MASK\$\$/$webvar{masklen}/g; |
---|
300 | $html =~ s/\$\$ALLOCFROM\$\$/$webvar{allocfrom}/g; |
---|
301 | |
---|
302 | my $from = new NetAddr::IP $webvar{allocfrom}; |
---|
303 | my @blocklist = $from->split($webvar{masklen}); |
---|
304 | my $availblocks; |
---|
305 | foreach (@blocklist) { |
---|
306 | $availblocks .= qq(<tr><td colspan=2 align=center><input type=radio name=block value="$_">$_</td></tr>\n); |
---|
307 | } |
---|
308 | $html =~ s/\$\$BLOCKLIST\$\$/$availblocks/g; |
---|
309 | |
---|
310 | print $html; |
---|
311 | } elsif ($webvar{action} eq 'touch') { |
---|
312 | print "Touching master $webvar{whichmaster}\n"; |
---|
313 | $sth = $ip_dbh->prepare("update masterblocks set mtime=now() where cidr='$webvar{whichmaster}'"); |
---|
314 | $sth->execute; |
---|
315 | if ($sth->err) { |
---|
316 | print "<p>Error updating modified timestamp on master $webvar{whichmaster}: ".$sth->errstr."\n"; |
---|
317 | } |
---|
318 | } elsif ($webvar{action} eq 'listcust') { |
---|
319 | print qq(Add new entry:\n |
---|
320 | <form action=admin.cgi method=POST> |
---|
321 | <table border=1><tr> |
---|
322 | <input type=hidden name=action value=edcust> |
---|
323 | <input type=hidden name=newcust value=1> |
---|
324 | <td>CustID:</td><td><input name=custid></td> |
---|
325 | <td align=center><input type=submit value="Go to edit page for this custid"></td></tr> |
---|
326 | </form></table> |
---|
327 | ); |
---|
328 | print "<p>Click CustID to edit existing customer contact data:\n". |
---|
329 | "<table border=1>\n<tr><td>CustID</td><td>Name</td><td>Tech handle</td></tr>\n"; |
---|
330 | $sth = $ip_dbh->prepare("select custid,name,tech_handle from customers order by custid"); |
---|
331 | $sth->execute; |
---|
332 | while (my @data = $sth->fetchrow_array) { |
---|
333 | print qq(<tr><td><a href="admin.cgi?action=edcust&custid=$data[0]">$data[0]</td>). |
---|
334 | "<td>$data[1]</td><td>$data[2]</td></tr>\n"; |
---|
335 | } |
---|
336 | print "</table>\n"; |
---|
337 | } elsif ($webvar{action} eq 'edcust') { |
---|
338 | if ($webvar{newcust}) { |
---|
339 | print "got here?\n"; |
---|
340 | $sth = $ip_dbh->prepare("INSERT INTO customers (custid) VALUES (?)"); |
---|
341 | $sth->execute($webvar{custid}); |
---|
342 | } |
---|
343 | $sth = $ip_dbh->prepare("select custid,name,street,city,province,". |
---|
344 | "country,pocode,phone,tech_handle,abuse_handle,admin_handle,special ". |
---|
345 | "from customers where custid='$webvar{custid}'"); |
---|
346 | $sth->execute; |
---|
347 | my ($custid, $name, $street, $city, $prov, $country, $pocode, $phone, $tech, $abuse, $admin, $special) = |
---|
348 | $sth->fetchrow_array; |
---|
349 | print qq(<form action=admin.cgi method=POST> |
---|
350 | <table border=1><tr> |
---|
351 | <input type=hidden name=action value=updcust> |
---|
352 | <td>CustID:</td><td>$custid<input type=hidden name=custid value=$custid></td> |
---|
353 | <td>Name:</td><td><input name=name value="$name"></td></tr> |
---|
354 | <tr><td>Street:</td><td><input name=street value="$street"></td> |
---|
355 | <!-- <td>Street2:</td><td><input name=street2></td> --> |
---|
356 | <td>City:</td><td><input name=city value="$city"></td></tr> |
---|
357 | <tr><td>Province/State: (2-letter code)</td><td><input name=province value="$prov" length=2 size=2></td> |
---|
358 | <td>Country: (2-letter code)</td><td><input name=country value="$country" length=2 size=2></td></tr> |
---|
359 | <tr><td>Postal/ZIP Code:</td><td><input name=pocode value="$pocode"></td> |
---|
360 | <td>Phone:</td><td><input name=phone value="$pocode"></td></tr> |
---|
361 | <!-- <td>Default rDNS:</td><td><input name=def_rdns></td></tr> |
---|
362 | <td>Description:</td><td><input name=description></td> --> |
---|
363 | <tr><td>Contacts/ARIN Handles:</td><td> |
---|
364 | Tech: <input name=tech_handle value="$tech"><br> |
---|
365 | Abuse: <input name=abuse_handle value="$abuse"><br> |
---|
366 | Admin: <input name=admin_handle value="$admin"><br> |
---|
367 | Note: Only tech is required at the moment. |
---|
368 | </td> |
---|
369 | <td>"Special":</td><td><textarea name=special rows=4 cols=50>$special</textarea></td> |
---|
370 | </tr> |
---|
371 | <tr><td colspan=4 align=center><input type=submit value="Update"></td></tr> |
---|
372 | </form></table> |
---|
373 | <div style="margin-left:5px"> |
---|
374 | <h3>Explanation for "Special" field:</h3> |
---|
375 | This is a temporary place to define the WHOIS "net name" for a block. |
---|
376 | It may be removed later, more likely migrated elsewhere. |
---|
377 | <p>It's formatted like this, one line for each custom net name: |
---|
378 | <pre>NetName[CIDR block]: NET-NAME</pre> |
---|
379 | Example: |
---|
380 | <pre>NetName192.168.236.0/24: MEGAWIDGET-1</pre> |
---|
381 | Note: |
---|
382 | <ul style="margin-top: 0px;"> |
---|
383 | <li>Spacing is important - there should only be ONE space, in between the colon and the net name. |
---|
384 | <li>The CIDR block name nust include all four octets - no short forms are accepted. |
---|
385 | <li>Net names must be all uppercase, and consist only of A-Z, 0-9, and - (same as for SWIPed net names). |
---|
386 | </ul> |
---|
387 | </div> |
---|
388 | ); |
---|
389 | |
---|
390 | } elsif ($webvar{action} eq 'updcust') { |
---|
391 | $sth = $ip_dbh->prepare("UPDATE customers SET". |
---|
392 | " name=?, street=?, city=?, province=?, country=?, pocode=?,". |
---|
393 | " phone=?, tech_handle=?, abuse_handle=?, admin_handle=?, special=?". |
---|
394 | " WHERE custid=?"); |
---|
395 | $sth->execute($webvar{name}, $webvar{street}, $webvar{city}, $webvar{province}, |
---|
396 | $webvar{country}, $webvar{pocode}, $webvar{phone}, $webvar{tech_handle}, |
---|
397 | $webvar{abuse_handle}, $webvar{admin_handle}, $webvar{special}, $webvar{custid}); |
---|
398 | print "Updated $webvar{custid}<br>\n". |
---|
399 | qq(<table border=1> |
---|
400 | <tr><td>CustID:</td><td>$webvar{custid}</td></tr> |
---|
401 | <tr><td>Name:</td><td>$webvar{name}</td></tr> |
---|
402 | <tr><td>Street:</td><td>$webvar{street}</td></tr> |
---|
403 | <tr><td>City:</td><td>$webvar{city}</td></tr> |
---|
404 | <tr><td>Province/State:</td><td>$webvar{province}</td></tr> |
---|
405 | <tr><td>Country:</td><td>$webvar{country}</td></tr> |
---|
406 | <tr><td>Postal/ZIP Code:</td><td>$webvar{pocode}</td></tr> |
---|
407 | <tr><td>Phone:</td><td>$webvar{phone}</td></tr> |
---|
408 | <!-- <td>Default rDNS:</td><td>$webvar{def_rdns}</td></tr> --> |
---|
409 | <tr><td>Contacts/ARIN Handles:</td><td> |
---|
410 | Tech: $webvar{tech_handle}<br> |
---|
411 | Abuse: $webvar{abuse_handle}<br> |
---|
412 | Admin: $webvar{admin_handle}<br> |
---|
413 | </td></tr> |
---|
414 | <tr><td>"Special":</td><td><pre>$webvar{special}</pre></td></tr> |
---|
415 | </table> |
---|
416 | <a href="admin.cgi?action=listcust">Back</a> to rWHOIS customer list<br>\n); |
---|
417 | |
---|
418 | } elsif ($webvar{action} eq 'showpools') { |
---|
419 | print "IP Pools currently allocated:\n". |
---|
420 | "<table border=1>\n<tr><td>Pool</td><td># of free IPs</td></tr>\n"; |
---|
421 | $sth = $ip_dbh->prepare("select cidr from allocations where type like '%p' or type like '%d' order by cidr"); |
---|
422 | $sth->execute; |
---|
423 | my %poolfree; |
---|
424 | while (my @data = $sth->fetchrow_array) { |
---|
425 | $poolfree{$data[0]} = 0; |
---|
426 | } |
---|
427 | $sth = $ip_dbh->prepare("select pool,ip from poolips where available='y' order by ip"); |
---|
428 | $sth->execute; |
---|
429 | while (my @data = $sth->fetchrow_array) { |
---|
430 | $poolfree{$data[0]}++; |
---|
431 | } |
---|
432 | foreach my $key (keys %poolfree) { |
---|
433 | print qq(<tr><td><a href="admin.cgi?action=tweakpool&pool=$key">$key</a></td>). |
---|
434 | "<td>$poolfree{$key}</td></tr>\n"; |
---|
435 | } |
---|
436 | print "</table>\n"; |
---|
437 | } elsif ($webvar{action} eq 'tweakpool') { |
---|
438 | showPool($webvar{pool}); |
---|
439 | } elsif ($webvar{action} eq 'updatepool') { |
---|
440 | |
---|
441 | $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}', ". |
---|
442 | "city='$webvar{city}', type='$webvar{type}', available='". |
---|
443 | (($webvar{available} eq 'y') ? 'y' : 'n'). |
---|
444 | "', notes='$webvar{notes}', description='$webvar{desc}' ". |
---|
445 | "where ip='$webvar{ip}'"); |
---|
446 | $sth->execute; |
---|
447 | if ($sth->err) { |
---|
448 | print "Error updating pool IP $webvar{ip}: $@<hr>\n"; |
---|
449 | syslog "err", "$authuser could not update pool IP $webvar{ip}: $@"; |
---|
450 | } else { |
---|
451 | $sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'"); |
---|
452 | $sth->execute; |
---|
453 | my @data = $sth->fetchrow_array; |
---|
454 | print "$webvar{ip} in $data[0] updated\n<hr>\n"; |
---|
455 | syslog "notice", "$authuser updated pool IP $webvar{ip}"; |
---|
456 | } |
---|
457 | } elsif ($webvar{action} eq 'showusers') { |
---|
458 | print "Notes:<br>\n". |
---|
459 | "<li>Admin users automatically get all other priviledges.\n". |
---|
460 | "<li>Everyone has basic read access.\n". |
---|
461 | "<hr>Add new user:<form action=admin.cgi method=POST>\n". |
---|
462 | "Username: <input name=username><br>\n". |
---|
463 | "Password: <input name=password> <input type=checkbox name=preenc>Password is pre-encrypted (MUST be crypt() encrypted)<br>\n". |
---|
464 | "<input type=submit value='Add user'><input type=hidden name=action value=newuser></form>\n"; |
---|
465 | |
---|
466 | print "<hr>Users with access:\n<table border=1>\n"; |
---|
467 | print "<tr><td></td><td align=center colspan=3>General access</td></tr>\n"; |
---|
468 | print "<tr><td>Username</td><td>Add new</td><td>Change</td>". |
---|
469 | "<td>Delete</td><td>Systems/Networking</td><td>Admin user</td></tr>\n". |
---|
470 | "<form action=admin.cgi method=POST>\n"; |
---|
471 | $sth = $ip_dbh->prepare("select username,acl from users order by username"); |
---|
472 | $sth->execute; |
---|
473 | while (my @data = $sth->fetchrow_array) { |
---|
474 | print "<form action=admin.cgi method=POST><input type=hidden name=action value=updacl>". |
---|
475 | qq(<tr><td>$data[0]<input type=hidden name=username value="$data[0]"></td><td>). |
---|
476 | # Now for the fun bit. We have to pull apart the ACL field and |
---|
477 | # output a bunch of checkboxes. |
---|
478 | "<input type=checkbox name=add".($data[1] =~ /a/ ? ' checked=y' : ''). |
---|
479 | "></td><td><input type=checkbox name=change".($data[1] =~ /c/ ? ' checked=y' : ''). |
---|
480 | "></td><td><input type=checkbox name=del".($data[1] =~ /d/ ? ' checked=y' : ''). |
---|
481 | "></td><td><input type=checkbox name=sysnet".($data[1] =~ /s/ ? ' checked=y' : ''). |
---|
482 | "></td><td><input type=checkbox name=admin".($data[1] =~ /A/ ? ' checked=y' : ''). |
---|
483 | qq(></td><td><input type=submit value="Update"></td></form>\n). |
---|
484 | "<form action=admin.cgi method=POST><td><input type=hidden name=action value=deluser>". |
---|
485 | "<input type=hidden name=username value=$data[0]>". |
---|
486 | qq(<input type=submit value="Delete user"></tr></form>\n); |
---|
487 | |
---|
488 | } |
---|
489 | print "</table>\n"; |
---|
490 | } elsif ($webvar{action} eq 'updacl') { |
---|
491 | print "Updating ACL for $webvar{username}:<br>\n"; |
---|
492 | my $acl = 'b'; |
---|
493 | if ($webvar{admin} eq 'on') { |
---|
494 | $acl .= "acdsA"; |
---|
495 | } else { |
---|
496 | $acl .= ($webvar{add} eq 'on' ? 'a' : ''). |
---|
497 | ($webvar{change} eq 'on' ? 'c' : ''). |
---|
498 | ($webvar{del} eq 'on' ? 'd' : ''). |
---|
499 | ($webvar{sysnet} eq 'on' ? 's' : ''); |
---|
500 | } |
---|
501 | print "New ACL: $acl<br>\n"; |
---|
502 | |
---|
503 | $sth = $ip_dbh->prepare("update users set acl='$acl' where username='$webvar{username}'"); |
---|
504 | $sth->execute; |
---|
505 | print "OK\n" if !$sth->err; |
---|
506 | |
---|
507 | print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n); |
---|
508 | |
---|
509 | } elsif ($webvar{action} eq 'newuser') { |
---|
510 | print "Adding user $webvar{username}...\n"; |
---|
511 | my $cr_pass = ($webvar{preenc} ? $webvar{password} : |
---|
512 | crypt $webvar{password}, join('',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64])); |
---|
513 | $sth = $ip_dbh->prepare("insert into users (username,password,acl) values ". |
---|
514 | "('$webvar{username}','$cr_pass','b')"); |
---|
515 | $sth->execute; |
---|
516 | if ($sth->err) { |
---|
517 | print "<br>Error adding user: ".$sth->errstr; |
---|
518 | } else { |
---|
519 | print "OK\n"; |
---|
520 | } |
---|
521 | |
---|
522 | print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n); |
---|
523 | |
---|
524 | } elsif ($webvar{action} eq 'deluser') { |
---|
525 | print "Deleting user $webvar{username}.<br>\n"; |
---|
526 | $sth = $ip_dbh->prepare("delete from users where username='$webvar{username}'"); |
---|
527 | $sth->execute; |
---|
528 | print "OK\n" if !$sth->err; |
---|
529 | |
---|
530 | print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n); |
---|
531 | |
---|
532 | } elsif ($webvar{action} eq 'emailnotice') { |
---|
533 | print "<h4>Email notice management:</h4>\nClick the email addresses to edit that list."; |
---|
534 | $sth = $ip_dbh->prepare("SELECT action,reciplist FROM notify"); |
---|
535 | $sth->execute; |
---|
536 | |
---|
537 | print "<table border=1>\n"; |
---|
538 | while (my ($notice_code,$reciplist) = $sth->fetchrow_array() ) { |
---|
539 | ##fixme: hairy mess, only a few things call mailNotify() anyway, so many possible notices won't work. |
---|
540 | my $action_out = dispNoticeCode($notice_code); |
---|
541 | print "<tr><td>$action_out</td>". |
---|
542 | qq(<td><a href="admin.cgi?action=ednotice&code=$notice_code">$reciplist</a></td>). |
---|
543 | qq(<td><a href="admin.cgi?action=delnotice&code=$notice_code">Delete</a></tr>\n); |
---|
544 | } |
---|
545 | print qq(<tr><td colspan=2>Known "special" codes:<br> |
---|
546 | <ul style="margin-top: 0px; margin-bottom: 0px;"> |
---|
547 | <li>swi: Notify if block being updated has SWIP flag set</li> |
---|
548 | </ul></td></tr> |
---|
549 | </table> |
---|
550 | ); |
---|
551 | |
---|
552 | # add new entries from this tangle: |
---|
553 | print "<h4>Add new notification:</h4>\n". |
---|
554 | "Note: Failure notices on most conditions are not yet supported.\n"; |
---|
555 | |
---|
556 | print qq(<table border=1><form action=admin.cgi method="POST"> |
---|
557 | <input type=hidden name=action value=addnotice> |
---|
558 | <tr> |
---|
559 | <td>Recipients</td><td colspan=3><textarea name=reciplist cols=50 rows=5></textarea></td></tr> |
---|
560 | <tr><td>Action</td><td> |
---|
561 | <table><tr> |
---|
562 | <td><input type=radio name=msgaction value=a>Add |
---|
563 | <input type=radio name=msgaction value=u>Update |
---|
564 | <input type=radio name=msgaction value=d>Delete |
---|
565 | <input type=radio name=msgaction value=n>New listitem</td> |
---|
566 | </tr><tr> |
---|
567 | <td> |
---|
568 | <input type=radio name=msgaction value=s:>Special: <input name=special>(requires code changes) |
---|
569 | </td></tr></table> |
---|
570 | </td> |
---|
571 | <td>Failure?</td><td><input type=checkbox name=onfail></td></tr> |
---|
572 | <tr><td>Event/Allocation type:</td><td colspan=3> |
---|
573 | <table> |
---|
574 | <tr> |
---|
575 | <td><input type=radio name=alloctype value=a>All allocations</td> |
---|
576 | <td><input type=radio name=alloctype value=.i>All static IPs</td> |
---|
577 | <td><input type=radio name=alloctype value=ci>New city</td> |
---|
578 | <td><input type=radio name=alloctype value=no>New node</td> |
---|
579 | </tr> |
---|
580 | <tr> |
---|
581 | ); |
---|
582 | |
---|
583 | $sth = $ip_dbh->prepare("SELECT type,dispname FROM alloctypes WHERE listorder < 500 ". |
---|
584 | "ORDER BY listorder"); |
---|
585 | $sth->execute; |
---|
586 | my $i=0; |
---|
587 | while (my ($type,$disp) = $sth->fetchrow_array) { |
---|
588 | print " <td><input type=radio name=alloctype value=$type>$disp</td>"; |
---|
589 | $i++; |
---|
590 | print " </tr>\n\t<tr>" |
---|
591 | if ($i % 4 == 0); |
---|
592 | } |
---|
593 | |
---|
594 | print qq( </tr> |
---|
595 | </table> |
---|
596 | </tr> |
---|
597 | <tr><td colspan=4 align=center><input type=submit value="Add notice"></td></tr> |
---|
598 | </table> |
---|
599 | </form> |
---|
600 | ); |
---|
601 | ## done spitting out add-new-spam-me-now table |
---|
602 | |
---|
603 | } elsif ($webvar{action} eq 'addnotice') { |
---|
604 | $webvar{alloctype} = $webvar{special} if $webvar{msgaction} eq 's:'; |
---|
605 | if ($webvar{msgaction} && $webvar{alloctype} && $webvar{reciplist}) { |
---|
606 | $webvar{reciplist} =~ s/[\r\n]+/,/g; |
---|
607 | $webvar{msgaction} = "f:$webvar{msgaction}" if $webvar{onfail}; |
---|
608 | print "Adding notice to $webvar{reciplist} for ".dispNoticeCode($webvar{msgaction}.$webvar{alloctype}).":\n"; |
---|
609 | $sth = $ip_dbh->prepare("INSERT INTO notify (action, reciplist) VALUES (?,?)"); |
---|
610 | ##fixme: automagically merge reciplists iff action already exists |
---|
611 | $sth->execute($webvar{msgaction}.$webvar{alloctype}, $webvar{reciplist}); |
---|
612 | if ($sth->err) { |
---|
613 | print "Failed: DB error: ".$sth->errstr."\n"; |
---|
614 | } else { |
---|
615 | print "OK!<br>\n" |
---|
616 | } |
---|
617 | } else { |
---|
618 | print "Need to specify at least one recipient, an action, and an allocation type. ". |
---|
619 | qq{("Special" content is considered an allocation type). Hit the Back button and try again.<br>\n}; |
---|
620 | } |
---|
621 | print qq(<a href="admin.cgi?action=emailnotice">Back to email notice list</a>\n); |
---|
622 | |
---|
623 | } elsif ($webvar{action} eq 'delnotice') { |
---|
624 | print "Deleting notices on ".dispNoticeCode($webvar{code}.$webvar{alloctype}).":\n"; |
---|
625 | $sth = $ip_dbh->prepare("DELETE FROM notify WHERE action=?"); |
---|
626 | $sth->execute($webvar{code}); |
---|
627 | if ($sth->err) { |
---|
628 | print "Failed: DB error: ".$sth->errstr."\n"; |
---|
629 | } else { |
---|
630 | print "OK!<br>\n" |
---|
631 | } |
---|
632 | print qq(<a href="admin.cgi?action=emailnotice">Back to email notice list</a>\n); |
---|
633 | |
---|
634 | } elsif ($webvar{action} eq 'ednotice') { |
---|
635 | print "<h4>Editing recipient list for '".dispNoticeCode($webvar{code})."':</h4>\n"; |
---|
636 | $sth = $ip_dbh->prepare("SELECT reciplist FROM notify WHERE action=?"); |
---|
637 | $sth->execute($webvar{code}); |
---|
638 | my ($reciplist) = $sth->fetchrow_array; |
---|
639 | $reciplist =~ s/,/\n/g; |
---|
640 | print qq(<form action=admin.cgi method=POST><input type=hidden name=code value="$webvar{code}">\n). |
---|
641 | qq(<input type=hidden name=action value="updnotice"><table border=1><tr><td>). |
---|
642 | qq(<textarea cols="40" rows="5" name=reciplist>$reciplist</textarea></td><td><input type=submit value="Update">\n). |
---|
643 | "</td></tr></table></form>\n"; |
---|
644 | } elsif ($webvar{action} eq 'updnotice') { |
---|
645 | print "<h4>Updating recipient list for '".dispNoticeCode($webvar{code})."':</h4>\n"; |
---|
646 | $sth = $ip_dbh->prepare("UPDATE notify SET reciplist=? WHERE action=?"); |
---|
647 | $webvar{reciplist} =~ s/[\r\n]+/,/g; |
---|
648 | $sth->execute($webvar{reciplist}, $webvar{code}); |
---|
649 | if ($sth->err) { |
---|
650 | print "Failed: DB error: ".$sth->errstr."\n"; |
---|
651 | } else { |
---|
652 | print "OK!<br>\n" |
---|
653 | } |
---|
654 | print qq(<a href="admin.cgi?action=emailnotice">Back to email notice list</a>\n); |
---|
655 | } elsif ($webvar{action} ne '<NULL>') { |
---|
656 | print "webvar{action} check failed: Don't know how to $webvar{action}"; |
---|
657 | } |
---|
658 | |
---|
659 | # Hokay. This is a little different. We have a few specific functions here: |
---|
660 | # -> Assign arbitrary subnet from arbitrary free space |
---|
661 | # -> Tweak individual DB fields |
---|
662 | # |
---|
663 | |
---|
664 | print qq(<hr><a href="/ip/">Back</a> to main interface</a>\n); |
---|
665 | |
---|
666 | # We print the footer here, so we don't have to do it elsewhere. |
---|
667 | my $footer = HTML::Template->new(filename => "footer.tmpl"); |
---|
668 | # we're already in the admin tools, no need to provide a bottom link. maybe. |
---|
669 | #$footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/)); |
---|
670 | |
---|
671 | print $footer->output; |
---|
672 | |
---|
673 | $ip_dbh->disconnect; |
---|
674 | |
---|
675 | exit; |
---|
676 | |
---|
677 | |
---|
678 | # Tweak allocfrom into shape. |
---|
679 | sub fix_allocfrom { |
---|
680 | if ($webvar{allocfrom} =~ /^(\d+\.){2}\d+$/) { |
---|
681 | # 3-octet class C specified |
---|
682 | $webvar{allocfrom} .= ".0/24"; |
---|
683 | } elsif ($webvar{allocfrom} =~ /^(\d+\.){3}\d+$/) { |
---|
684 | # 4-octet IP specified; |
---|
685 | $webvar{allocfrom} .= "/24"; |
---|
686 | } |
---|
687 | } |
---|
688 | |
---|
689 | |
---|
690 | # List free blocks in a /24 for arbitrary manual allocation |
---|
691 | sub showfree($) { |
---|
692 | my $cidr = new NetAddr::IP $_[0]; |
---|
693 | print "Showing free blocks in $cidr<br>\n". |
---|
694 | "<table border=1>\n"; |
---|
695 | $sth = $ip_dbh->prepare("select * from freeblocks where cidr <<= '$cidr' order by cidr"); |
---|
696 | $sth->execute; |
---|
697 | while (my @data = $sth->fetchrow_array) { |
---|
698 | my $temp = new NetAddr::IP $data[0]; |
---|
699 | print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=assign>\n". |
---|
700 | qq(<td>$temp<input type=hidden name=allocfrom value="$temp"></td>\n). |
---|
701 | "<td>". |
---|
702 | (($temp->masklen == 30) ? '<input type=hidden name=masklen value=30>30' |
---|
703 | : "<select name=masklen><option>30</option>\n<option>29</option>\n") . |
---|
704 | (($temp->masklen < 29) ? "<option>28</option>\n" : '') . |
---|
705 | (($temp->masklen < 28) ? "<option>27</option>\n" : '') . |
---|
706 | (($temp->masklen < 27) ? "<option>26</option>\n" : '') . |
---|
707 | (($temp->masklen < 26) ? "<option>25</option>\n" : '') . |
---|
708 | (($temp->masklen < 25) ? "<option>24</option>\n" : '') . |
---|
709 | "</td>". |
---|
710 | qq(<td>$data[2]</td><td><input type=submit value="Allocate from here"></td>). |
---|
711 | "\n</form></tr>\n"; |
---|
712 | } |
---|
713 | print "</table>\n"; |
---|
714 | } |
---|
715 | |
---|
716 | |
---|
717 | # Show allocations to allow editing. |
---|
718 | sub showAllocs($) { |
---|
719 | my $cidr = new NetAddr::IP $_[0]; |
---|
720 | print "Edit custID, allocation type, city for allocations in ". |
---|
721 | "$cidr:\n<table border=1>"; |
---|
722 | $sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr"); |
---|
723 | $sth->execute; |
---|
724 | while (my @data = $sth->fetchrow_array) { |
---|
725 | print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=update>\n". |
---|
726 | qq(<td>$data[0]<input type=hidden value="$data[0]" name=block></td>\n). |
---|
727 | qq(<td><input name=custid value="$data[1]"></td>\n). |
---|
728 | "<td><select name=alloctype>"; |
---|
729 | |
---|
730 | my $sth2 = $ip_dbh->prepare("select type,listname from alloctypes". |
---|
731 | " where listorder < 500 and not (type like '_i') order by listorder"); |
---|
732 | $sth2->execute; |
---|
733 | while (my @types = $sth2->fetchrow_array) { |
---|
734 | print "<option". (($data[2] eq $types[0]) ? ' selected' : '') . |
---|
735 | " value='$types[0]'>$types[1]</option>\n"; |
---|
736 | } |
---|
737 | |
---|
738 | print qq(<td><input name=city value="$data[3]"></td>\n). |
---|
739 | "<td>$data[4]</td><td>$data[5]</td>". |
---|
740 | qq(<td><input type=submit value="Update"></td></form></tr>\n); |
---|
741 | } |
---|
742 | print "</table>\n"; |
---|
743 | |
---|
744 | # notes |
---|
745 | print "<hr><b>Notes:</b>\n". |
---|
746 | "<ul>\n<li>Use the main interface to update description and notes fields\n". |
---|
747 | "<li>Changing the allocation type here will NOT affect IP pool data.\n". |
---|
748 | "</ul>\n"; |
---|
749 | } |
---|
750 | |
---|
751 | |
---|
752 | # Stuff updates into DB |
---|
753 | sub update { |
---|
754 | eval { |
---|
755 | # Relatively simple SQL transaction here. Note that we're deliberately NOT |
---|
756 | # updating notes/desc here as it's available through the main interface. |
---|
757 | $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',". |
---|
758 | "city='$webvar{city}',type='$webvar{alloctype}' where cidr='$webvar{block}'"); |
---|
759 | $sth->execute; |
---|
760 | $ip_dbh->commit; |
---|
761 | }; |
---|
762 | if ($@) { |
---|
763 | carp "Transaction aborted because $@"; |
---|
764 | eval { $ip_dbh->rollback; }; |
---|
765 | syslog "err", "$authuser could not update block '$webvar{block}': '$@'"; |
---|
766 | } else { |
---|
767 | # If we get here, the operation succeeded. |
---|
768 | syslog "notice", "$authuser updated $webvar{block}"; |
---|
769 | print "Allocation $webvar{block} updated<hr>\n"; |
---|
770 | } |
---|
771 | # need to get /24 that block is part of |
---|
772 | my @bits = split /\./, $webvar{block}; |
---|
773 | $bits[3] = "0/24"; |
---|
774 | showAllocs((join ".", @bits)); |
---|
775 | } |
---|
776 | |
---|
777 | |
---|
778 | # showPool() |
---|
779 | # List all IPs in a pool, and allow arbitrary admin changes to each |
---|
780 | # Allow changes to ALL fields |
---|
781 | sub showPool($) { |
---|
782 | my $pool = new NetAddr::IP $_[0]; |
---|
783 | print qq(Listing pool $pool:\n<table border=1> |
---|
784 | <form action=admin.cgi method=POST> |
---|
785 | <input type=hidden name=action value=updatepool> |
---|
786 | <tr><td align=right>Customer ID:</td><td><input name=custid></td></tr> |
---|
787 | <tr><td align=right>Customer location:</td><td><input name=city></td></tr> |
---|
788 | <tr><td align=right>Type:</td><td><select name=type><option selected>-</option>\n); |
---|
789 | |
---|
790 | $sth = $ip_dbh->prepare("select type,listname from alloctypes where type like '_i' order by listorder"); |
---|
791 | $sth->execute; |
---|
792 | while (my @data = $sth->fetchrow_array) { |
---|
793 | print "<option value='$data[0]'>$data[1]</option>\n"; |
---|
794 | } |
---|
795 | |
---|
796 | print qq(</select></td></tr> |
---|
797 | <tr><td align=right>Available?</td><td><input type=checkbox value=y></td></tr> |
---|
798 | <tr><td align=right>Description/name:</td><td><input name=desc size=40></td></tr> |
---|
799 | <tr><td align=right>Notes:</td><td><textarea name=notes rows=3 cols=40></textarea></td></tr> |
---|
800 | <tr><td colspan=2 align=center><input type=submit value="Update"></td></tr> |
---|
801 | ). |
---|
802 | "</table>Update the following record:<table border=1>\n"; |
---|
803 | $sth = $ip_dbh->prepare("select pool,ip,custid,city,type,available,description,notes from poolips where pool='$pool' order by ip"); |
---|
804 | $sth->execute; |
---|
805 | while (my @data = $sth->fetchrow_array) { |
---|
806 | print qq(<tr><td><input type=radio name=ip value="$data[1]">$data[1]</td>). |
---|
807 | "<td>$data[2]</td><td>$data[3]</td><td>$data[4]</td>". |
---|
808 | "<td>$data[5]</td><td>$data[6]</td><td>$data[7]</td></tr>\n"; |
---|
809 | } |
---|
810 | print "</form></table>\n"; |
---|
811 | } |
---|
812 | |
---|
813 | |
---|
814 | # interpret the notify codes |
---|
815 | sub dispNoticeCode { |
---|
816 | my $code = shift; |
---|
817 | my $action_out = ''; |
---|
818 | |
---|
819 | if ($code =~ /^s:/) { |
---|
820 | $code =~ s/^s:/Special: /; |
---|
821 | return $code; |
---|
822 | } |
---|
823 | if ($code =~ /^f:(.+)$/) { |
---|
824 | $code =~ s/^f://; |
---|
825 | $action_out = "Failure on "; |
---|
826 | } |
---|
827 | if (my $target = $code =~ /^n(.+)/) { |
---|
828 | $action_out .= "New "; |
---|
829 | if ($1 eq 'ci') { $action_out .= "city"; } |
---|
830 | elsif ($1 eq 'no') { $action_out .= "node"; } |
---|
831 | else { $action_out .= '<unknown>'; } |
---|
832 | } else { |
---|
833 | my ($action,$target) = ($code =~ /^(.)(.+)$/); |
---|
834 | if ($action eq 'a') { $action_out .= 'Add '; } |
---|
835 | elsif ($action eq 'u') { $action_out .= 'Update '; } |
---|
836 | elsif ($action eq 'd') { $action_out .= 'Delete '; } |
---|
837 | ##fixme: what if we get something funky? |
---|
838 | # What about the eleventy-billion odd combinations possible? |
---|
839 | # this should give an idea of the structure tho |
---|
840 | if ($target eq 'a') { $action_out .= "all"; } |
---|
841 | elsif ($target eq '.i') { |
---|
842 | $action_out .= "all static IPs"; |
---|
843 | } |
---|
844 | else { $action_out .= $disp_alloctypes{$target}; } |
---|
845 | } |
---|
846 | return $action_out; |
---|
847 | } |
---|