Context Navigation

source: branches/stable/cgi-bin/admin.cgi@ 291

Last change on this file since 291 was 286, checked in by Kris Deugau, 19 years ago

/branches/stable

Merge changes from /trunk revisions:

234
237
254 (ipdb.css only)
261
279
284
285

This merges the new search system (234, 237, 254), cleans up
some display CSS (254, 279), cleans up some leftover code (r261),
and merges the "private data" code (284, 285 - note SWIP hacks conflict).

/trunk should now be almost identical to /branches/stable.

Property svn:executable set to *
Property svn:keywords set to Date Rev Author

File size: 19.0 KB

Rev	Line
[54]	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.
[200]	5	#
[54]	6	###
	7	# SVN revision info
	8	# $Date: 2005-09-23 19:54:31 +0000 (Fri, 23 Sep 2005) $
	9	# SVN revision $Rev: 286 $
	10	# Last update by $Author: kdeugau $
	11	###
[158]	12	# Copyright (C) 2004,2005 - Kris Deugau
[54]	13
	14	use strict;
	15	use warnings;
	16	use CGI::Carp qw(fatalsToBrowser);
	17	use DBI;
	18	use CommonWeb qw(:ALL);
[200]	19	use MyIPDB;
	20	use CustIDCK;
[54]	21	#use POSIX qw(ceil);
	22	use NetAddr::IP;
	23
	24	use Sys::Syslog;
	25
	26	openlog "IPDB-admin","pid","local2";
	27
	28	# Collect the username from HTTP auth. If undefined, we're in a test environment.
	29	my $authuser;
	30	if (!defined($ENV{'REMOTE_USER'})) {
	31	$authuser = '__temptest';
	32	} else {
	33	$authuser = $ENV{'REMOTE_USER'};
	34	}
	35
	36	syslog "debug", "$authuser active";
	37
[200]	38	# Why not a global DB handle? (And a global statement handle, as well...)
	39	# Use the connectDB function, otherwise we end up confusing ourselves
	40	my $ip_dbh;
	41	my $sth;
	42	my $errstr;
	43	($ip_dbh,$errstr) = connectDB_My;
	44	if (!$ip_dbh) {
	45	printAndExit("Database error: $errstr\n");
	46	}
	47	initIPDBGlobals($ip_dbh);
	48
[242]	49	if ($IPDBacl{$authuser} !~ /A/) {
	50	print "Content-Type: text/html\n\n".
	51	"<html><head><title>Access denied</title></head><body>\n".
	52	'Access to this tool is restricted. Contact <a href="mailto:kdeugau@vianet.ca">Kris</a> '.
	53	"for more information.</body></html>\n";
	54	exit;
	55	}
	56
[54]	57	my %webvar = parse_post();
	58	cleanInput(\%webvar);
[58]	59
[54]	60	print "Content-type: text/html\n\n".
[242]	61	"<html>\n<head>\n\t<title>[IPDB admin tools]</title>\n".
[200]	62	qq(\t<link rel="stylesheet" type="text/css" href="/ip/ipdb.css">\n).
	63	"</head>\n<body>\n".
[54]	64	"<h2>IPDB - Administrative Tools</h2>\n<hr>\n";
	65
	66	if(!defined($webvar{action})) {
	67	$webvar{action} = "<NULL>"; #shuts up the warnings.
[200]	68
	69	my $typelist = '';
	70	$sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder");
	71	$sth->execute;
	72	my @data = $sth->fetchrow_array;
	73	$typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
	74	while (my @data = $sth->fetchrow_array) {
	75	$typelist .= "<option value='$data[0]'>$data[1]</option>\n";
	76	}
	77
[54]	78	print qq(WARNING: There are FAR fewer controls on what you can do here. Use the
	79	main interface if at all possible.
[200]	80	<hr>
	81	<a href="admin.cgi?action=newalloc">Add allocation</a>
	82	<hr>
	83	<form action="admin.cgi" method="POST">
[54]	84	<input type=hidden name=action value=alloc>
[200]	85	Allocate block/IP: <input name=cidr> as <select name=alloctype>$typelist</select> to <input name=custid>
	86	<input type=submit value=" GIMME!! "></form>
[54]	87	<hr><form action="admin.cgi" method="POST">
	88	<input type=hidden name=action value=alloctweak>
	89	Manually update allocation data in this /24: <input name=allocfrom>
	90	<input type=submit value="Show allocations">
[200]	91	</form>
	92	<hr><a href="admin.cgi?action=showpools">List IP Pools</a> for manual tweaking and updates
[260]	93	<hr><a href="admin.cgi?action=showusers">Manage users</a> (add/remove users; change
	94	internal access controls - note that this does NOT include IP-based limits)
[54]	95	);
	96	} else {
	97	print '<a href="/ip/cgi-bin/admin.cgi">Back</a> to main<hr>';
	98	}
	99
[200]	100
	101	## Possible actions.
[54]	102	if ($webvar{action} eq 'alloc') {
[200]	103	# OK, we know what we're allocating.
	104
	105	if ($webvar{cidr} !~ /^\s(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s$/) {
	106	printAndExit("Can't allocate something that's not a netblock/ip");
	107	}
	108
	109	$sth = $ip_dbh->prepare("select def_custid from alloctypes where type='$webvar{alloctype}'");
	110	$sth->execute;
	111	my @data = $sth->fetchrow_array;
	112	my $custid = $data[0];
	113	if ($custid eq '') {
	114	if ($webvar{custid} !~ /^(?:\d{10}\|\d{7}\|STAFF)(?:-\d\d?)?$/) {
	115	# Force uppercase for now...
	116	$webvar{custid} =~ tr/a-z/A-Z/;
	117	# Crosscheck with ... er... something.
	118	my $status = CustIDCK->custid_exist($webvar{custid});
	119	if ($CustIDCK::Error) {
	120	printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
	121	return;
	122	}
	123	if (!$status) {
	124	printError("Customer ID not valid. Make sure the Customer ID ".
	125	"is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ".
	126	"non-customer assignments.");
	127	return;
	128	}
	129	}
	130	# Type that doesn't have a default custid
	131	$custid = $webvar{custid};
	132	}
	133
	134	my $cidr = new NetAddr::IP $webvar{cidr};
	135	my @data;
	136	if ($webvar{alloctype} eq 'rm') {
	137	$sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and routed='n'");
	138	$sth->execute;
	139	@data = $sth->fetchrow_array;
	140	# User deserves errors if user can't be bothered to find the free block first.
	141	printAndExit("Can't allocate from outside a free block!!\n")
	142	if !$data[0];
[252]	143	} elsif ($webvar{alloctype} =~ /^(.)i$/) {
	144	$sth = $ip_dbh->prepare("select cidr from allocations where cidr >>='$cidr' and (type like '_d' or type like '_p')");
	145	$sth->execute;
	146	@data = $sth->fetchrow_array;
	147	# User deserves errors if user can't be bothered to find the pool and a free IP first.
	148	printAndExit("Can't allocate static IP from outside a pool!!\n")
	149	if !$data[0];
[200]	150	} else {
	151	$sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and not (routed='n')");
	152	$sth->execute;
	153	@data = $sth->fetchrow_array;
	154	# User deserves errors if user can't be bothered to find the free block first.
	155	printAndExit("Can't allocate from outside a routed block!!\n")
	156	if !$data[0];
	157	}
	158
	159	my $alloc_from = new NetAddr::IP $data[0];
	160	$sth->finish;
	161
	162	my $cities = '';
	163	foreach my $city (@citylist) {
	164	$cities .= "<option>$city</option>\n";
	165	}
	166
	167	print qq(<table class=regular>
	168	<form method=POST action=admin.cgi>
	169	<tr class=color1>
	170	<td>Allocating:</td>
	171	<td>$cidr<input type=hidden name=cidr value="$cidr"></td>
	172	</tr><tr class=color2>
	173	<td>Type:</td><td>$disp_alloctypes{$webvar{alloctype}}
	174	<input type=hidden name=alloctype value="$webvar{alloctype}"></td>
	175	</tr><tr class=color1>
	176	<td>Allocated from:</td>
	177	<td>$alloc_from<input type=hidden name=alloc_from value="$alloc_from"></td>
	178	</tr><tr class="color2">
	179	<td>Customer ID:</td><td>$custid<input type=hidden name=custid value="$custid"></td>
	180	</tr><tr class=color1>
	181	<td>Customer location:</td><td>
	182	<select name="city"><option selected>-</option>
	183	$cities
	184	</select>
	185	<a href="javascript:popNotes('/ip/newcity.html')">Add new location</a>
	186	</td>
	187	</tr>
	188	<tr class="color2">
	189	<td>Circuit ID:</td><td><input name=circid size=40></td>
	190	</tr><tr class="color1">
	191	<td>Description/Name:</td><td><input name="desc" size=40></td>
	192	</tr><tr class="color2">
	193	<td>Notes:</td><td><textarea name="notes" rows="3" cols="40"></textarea></td>
	194	</tr><tr class="warning">
	195	<td colspan=2><center>WARNING: This will IMMEDIATELY assign this block!!</center></td>
	196	</tr><tr class="color2">
	197	<td class="center" colspan="2"><input type="submit" value=" Assign "></td>
	198	<input type="hidden" name="action" value="confirm">
	199	</tr>
	200	</table>
	201	);
	202
	203
	204	} elsif ($webvar{action} eq 'confirm') {
	205
	206	print "Assigning $webvar{cidr} to $webvar{custid} (\"$webvar{desc}\") as ".
	207	"$disp_alloctypes{$webvar{alloctype}}...<br>\n";
	208	# Only need to check city here.
	209	if ($webvar{city} eq '-') {
	210	printError("Invalid customer location! Go back and select customer's location.");
	211	} else {
	212	my ($retcode,$msg) = allocateBlock($ip_dbh, $webvar{cidr}, $webvar{alloc_from},
	213	$webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
	214	$webvar{circid});
	215	if ($retcode eq 'OK') {
	216	print "Allocation OK!\n";
	217
	218	if ($webvar{alloctype} =~ /^.i$/) {
	219	# Notify tech@example.com
	220	mailNotify('tech@example.com',"$disp_alloctypes{$webvar{alloctype}} allocation",
	221	"$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
	222	"Description: $webvar{desc}\n\nAllocated by: $authuser\n");
	223	}
	224	syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ".
	225	"'$webvar{alloctype}'";
	226	} else {
	227	print "Allocation failed! IPDB::allocateBlock said:\n$msg\n";
	228	syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ".
[249]	229	"'$webvar{alloctype}' failed: '$msg'";
[200]	230	}
	231	} # done city check
	232
[54]	233	} elsif ($webvar{action} eq 'alloctweak') {
	234	fix_allocfrom();
	235	showAllocs($webvar{allocfrom});
	236	} elsif ($webvar{action} eq 'update') {
	237	update();
[58]	238	} elsif ($webvar{action} eq 'assign') {
	239	# Display a list of possible blocks within the requested block.
	240	open (HTML, "../admin_alloc.html")
	241	or croak "Could not open admin_alloc.html :$!";
	242	my $html = join('', <HTML>);
	243	$html =~ s/\$\$MASK\$\$/$webvar{masklen}/g;
	244	$html =~ s/\$\$ALLOCFROM\$\$/$webvar{allocfrom}/g;
	245
	246	my $from = new NetAddr::IP $webvar{allocfrom};
	247	my @blocklist = $from->split($webvar{masklen});
	248	my $availblocks;
	249	foreach (@blocklist) {
	250	$availblocks .= qq(<tr><td colspan=2 align=center><input type=radio name=block value="$_">$_</td></tr>\n);
	251	}
	252	$html =~ s/\$\$BLOCKLIST\$\$/$availblocks/g;
	253
	254	print $html;
[200]	255	} elsif ($webvar{action} eq 'showpools') {
	256	print "IP Pools currently allocated:\n".
	257	"<table border=1>\n<tr><td>Pool</td><td># of free IPs</td></tr>\n";
	258	$sth = $ip_dbh->prepare("select cidr from allocations where type like '%p' or type like '%d' order by cidr");
	259	$sth->execute;
	260	my %poolfree;
	261	while (my @data = $sth->fetchrow_array) {
	262	$poolfree{$data[0]} = 0;
	263	}
	264	$sth = $ip_dbh->prepare("select pool,ip from poolips where available='y' order by ip");
	265	$sth->execute;
	266	while (my @data = $sth->fetchrow_array) {
	267	$poolfree{$data[0]}++;
	268	}
	269	foreach my $key (keys %poolfree) {
	270	print qq(<tr><td><a href="admin.cgi?action=tweakpool&pool=$key">$key</a></td>).
	271	"<td>$poolfree{$key}</td></tr>\n";
	272	}
	273	print "</table>\n";
	274	} elsif ($webvar{action} eq 'tweakpool') {
	275	showPool($webvar{pool});
	276	} elsif ($webvar{action} eq 'updatepool') {
	277
	278	$sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}', ".
	279	"city='$webvar{city}', type='$webvar{type}', available='".
	280	(($webvar{available} eq 'y') ? 'y' : 'n').
	281	"', notes='$webvar{notes}', description='$webvar{desc}' ".
	282	"where ip='$webvar{ip}'");
	283	$sth->execute;
	284	if ($sth->err) {
	285	print "Error updating pool IP $webvar{ip}: $@<hr>\n";
	286	syslog "err", "$authuser could not update pool IP $webvar{ip}: $@";
	287	} else {
	288	$sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'");
	289	$sth->execute;
	290	my @data = $sth->fetchrow_array;
	291	print "$webvar{ip} in $data[0] updated\n<hr>\n";
	292	syslog "notice", "$authuser updated pool IP $webvar{ip}";
	293	}
[260]	294	} elsif ($webvar{action} eq 'showusers') {
[242]	295	print "Notes:<br>\n".
[260]	296	"<li>Admin users automatically get all other priviledges.\n".
	297	"<hr>Add new user:<form action=admin.cgi method=POST>\n".
	298	"Username: <input name=username><br>\n".
	299	"Password: <input name=password> <input type=checkbox name=preenc>Password is pre-encrypted (MUST be crypt() encrypted)<br>\n".
	300	"<input type=submit value='Add user'><input type=hidden name=action value=newuser></form>\n";
[242]	301
	302	print "<hr>Users with access:\n<table border=1>\n";
[286]	303	print "<tr><td></td><td align=center colspan=3>General access</td></tr>\n";
[242]	304	print "<tr><td>Username</td><td>Add new</td><td>Change</td>".
[286]	305	"<td>Delete</td><td>Systems/Networking</td><td>Admin user</td></tr>\n".
[242]	306	"<form action=admin.cgi method=POST>\n";
	307	$sth = $ip_dbh->prepare("select username,acl from users order by username");
	308	$sth->execute;
	309	while (my @data = $sth->fetchrow_array) {
	310	print "<form action=admin.cgi method=POST><input type=hidden name=action value=updacl>".
	311	qq(<tr><td>$data[0]<input type=hidden name=username value="$data[0]"></td><td>).
	312	# Now for the fun bit. We have to pull apart the ACL field and
	313	# output a bunch of checkboxes.
	314	"<input type=checkbox name=add".($data[1] =~ /a/ ? ' checked=y' : '').
	315	"></td><td><input type=checkbox name=change".($data[1] =~ /c/ ? ' checked=y' : '').
	316	"></td><td><input type=checkbox name=del".($data[1] =~ /d/ ? ' checked=y' : '').
[286]	317	"></td><td><input type=checkbox name=sysnet".($data[1] =~ /s/ ? ' checked=y' : '').
[242]	318	"></td><td><input type=checkbox name=admin".($data[1] =~ /A/ ? ' checked=y' : '').
[260]	319	qq(></td><td><input type=submit value="Update"></td></form>\n).
	320	"<form action=admin.cgi method=POST><td><input type=hidden name=action value=deluser>".
	321	"<input type=hidden name=username value=$data[0]>".
	322	qq(<input type=submit value="Delete user"></tr></form>\n);
[242]	323
	324	}
	325	print "</table>\n";
	326	} elsif ($webvar{action} eq 'updacl') {
	327	print "Updating ACL for $webvar{username}:<br>\n";
	328	my $acl = 'b';
	329	if ($webvar{admin} eq 'on') {
[286]	330	$acl .= "acdsA";
[242]	331	} else {
	332	$acl .= ($webvar{add} eq 'on' ? 'a' : '').
	333	($webvar{change} eq 'on' ? 'c' : '').
[286]	334	($webvar{del} eq 'on' ? 'd' : '').
	335	($webvar{sysnet} eq 'on' ? 's' : '');
[242]	336	}
	337	print "New ACL: $acl<br>\n";
	338
	339	$sth = $ip_dbh->prepare("update users set acl='$acl' where username='$webvar{username}'");
	340	$sth->execute;
	341	print "OK\n" if !$sth->err;
	342
[260]	343	print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n);
[242]	344
[260]	345	} elsif ($webvar{action} eq 'newuser') {
	346	print "Adding user $webvar{username}...\n";
	347	my $cr_pass = ($webvar{preenc} ? $webvar{password} :
	348	crypt $webvar{password}, join('',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64]));
	349	$sth = $ip_dbh->prepare("insert into users (username,password,acl) values ".
	350	"('$webvar{username}','$cr_pass','b')");
	351	$sth->execute;
	352	if ($sth->err) {
	353	print "<br>Error adding user: ".$sth->errstr;
	354	} else {
	355	print "OK\n";
	356	}
	357
	358	print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n);
	359
	360	} elsif ($webvar{action} eq 'deluser') {
	361	print "Deleting user $webvar{username}.<br>\n";
	362	$sth = $ip_dbh->prepare("delete from users where username='$webvar{username}'");
	363	$sth->execute;
	364	print "OK\n" if !$sth->err;
	365
	366	print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n);
	367
[242]	368	} elsif ($webvar{action} ne '<NULL>') {
	369	print "webvar{action} check failed: Don't know how to $webvar{action}";
[54]	370	}
	371
	372	# Hokay. This is a little different. We have a few specific functions here:
	373	# -> Assign arbitrary subnet from arbitrary free space
	374	# -> Tweak individual DB fields
	375	#
	376
	377
	378	printFooter;
	379
	380	$ip_dbh->disconnect;
	381
	382	exit;
	383
	384
	385	# Tweak allocfrom into shape.
	386	sub fix_allocfrom {
	387	if ($webvar{allocfrom} =~ /^(\d+\.){2}\d+$/) {
	388	# 3-octet class C specified
	389	$webvar{allocfrom} .= ".0/24";
	390	} elsif ($webvar{allocfrom} =~ /^(\d+\.){3}\d+$/) {
	391	# 4-octet IP specified;
	392	$webvar{allocfrom} .= "/24";
	393	}
	394	}
	395
	396
[58]	397	# List free blocks in a /24 for arbitrary manual allocation
	398	sub showfree($) {
	399	my $cidr = new NetAddr::IP $_[0];
	400	print "Showing free blocks in $cidr<br>\n".
	401	"<table border=1>\n";
	402	$sth = $ip_dbh->prepare("select * from freeblocks where cidr <<= '$cidr' order by cidr");
	403	$sth->execute;
	404	while (my @data = $sth->fetchrow_array) {
	405	my $temp = new NetAddr::IP $data[0];
	406	print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=assign>\n".
	407	qq(<td>$temp<input type=hidden name=allocfrom value="$temp"></td>\n).
	408	"<td>".
	409	(($temp->masklen == 30) ? '<input type=hidden name=masklen value=30>30'
	410	: "<select name=masklen><option>30</option>\n<option>29</option>\n") .
	411	(($temp->masklen < 29) ? "<option>28</option>\n" : '') .
	412	(($temp->masklen < 28) ? "<option>27</option>\n" : '') .
	413	(($temp->masklen < 27) ? "<option>26</option>\n" : '') .
	414	(($temp->masklen < 26) ? "<option>25</option>\n" : '') .
	415	(($temp->masklen < 25) ? "<option>24</option>\n" : '') .
	416	"</td>".
	417	qq(<td>$data[2]</td><td><input type=submit value="Allocate from here"></td>).
	418	"\n</form></tr>\n";
	419	}
	420	print "</table>\n";
	421	}
	422
	423
[54]	424	# Show allocations to allow editing.
	425	sub showAllocs($) {
	426	my $cidr = new NetAddr::IP $_[0];
	427	print "Edit custID, allocation type, city for allocations in ".
	428	"$cidr:\n<table border=1>";
	429	$sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr");
	430	$sth->execute;
	431	while (my @data = $sth->fetchrow_array) {
	432	print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=update>\n".
	433	qq(<td>$data[0]<input type=hidden value="$data[0]" name=block></td>\n).
[269]	434	qq(<td><input name=custid value="$data[1]"></td>\n).
	435	"<td><select name=alloctype>";
[54]	436
[269]	437	my $sth2 = $ip_dbh->prepare("select type,listname from alloctypes".
	438	" where listorder < 500 and not (type like '_i') order by listorder");
	439	$sth2->execute;
	440	while (my @types = $sth2->fetchrow_array) {
	441	print "<option". (($data[2] eq $types[0]) ? ' selected' : '') .
	442	" value='$types[0]'>$types[1]</option>\n";
	443	}
	444	print "<option". (($data[2] eq 'in') ? ' selected' : '') .
	445	" value='in'>Internal netblock</option>\n</select></td>\n";
	446
[54]	447	print qq(<td><input name=city value="$data[3]"></td>\n).
	448	"<td>$data[4]</td><td>$data[5]</td>".
	449	qq(<td><input type=submit value="Update"></td></form></tr>\n);
	450	}
	451	print "</table>\n";
	452
	453	# notes
	454	print "<hr><b>Notes:</b>\n".
	455	"<ul>\n<li>Use the main interface to update description and notes fields\n".
	456	"<li>Changing the allocation type here will NOT affect IP pool data.\n".
	457	"</ul>\n";
	458	}
	459
	460
	461	# Stuff updates into DB
	462	sub update {
	463	eval {
	464	# Relatively simple SQL transaction here. Note that we're deliberately NOT
	465	# updating notes/desc here as it's available through the main interface.
	466	$sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',".
	467	"city='$webvar{city}',type='$webvar{alloctype}' where cidr='$webvar{block}'");
	468	$sth->execute;
	469	$ip_dbh->commit;
	470	};
	471	if ($@) {
	472	carp "Transaction aborted because $@";
	473	eval { $ip_dbh->rollback; };
[200]	474	syslog "err", "$authuser could not update block '$webvar{block}': '$@'";
[54]	475	} else {
	476	# If we get here, the operation succeeded.
	477	syslog "notice", "$authuser updated $webvar{block}";
	478	print "Allocation $webvar{block} updated<hr>\n";
	479	}
	480	# need to get /24 that block is part of
	481	my @bits = split /\./, $webvar{block};
	482	$bits[3] = "0/24";
	483	showAllocs((join ".", @bits));
	484	}
[200]	485
	486
	487	# showPool()
	488	# List all IPs in a pool, and allow arbitrary admin changes to each
	489	# Allow changes to ALL fields
	490	sub showPool($) {
	491	my $pool = new NetAddr::IP $_[0];
	492	print qq(Listing pool $pool:\n<table border=1>
	493	<form action=admin.cgi method=POST>
	494	<input type=hidden name=action value=updatepool>
	495	<tr><td align=right>Customer ID:</td><td><input name=custid></td></tr>
	496	<tr><td align=right>Customer location:</td><td><input name=city></td></tr>
[269]	497	<tr><td align=right>Type:</td><td><select name=type><option selected>-</option>\n);
	498
	499	$sth = $ip_dbh->prepare("select type,listname from alloctypes where type like '_i' order by listorder");
	500	$sth->execute;
	501	while (my @data = $sth->fetchrow_array) {
	502	print "<option value='$data[0]'>$data[1]</option>\n";
	503	}
	504
	505	print qq(</select></td></tr>
[200]	506	<tr><td align=right>Available?</td><td><input type=checkbox value=y></td></tr>
	507	<tr><td align=right>Description/name:</td><td><input name=desc size=40></td></tr>
	508	<tr><td align=right>Notes:</td><td><textarea name=notes rows=3 cols=40></textarea></td></tr>
	509	<tr><td colspan=2 align=center><input type=submit value="Update"></td></tr>
	510	).
	511	"</table>Update the following record:<table border=1>\n";
	512	$sth = $ip_dbh->prepare("select pool,ip,custid,city,type,available,description,notes from poolips where pool='$pool' order by ip");
	513	$sth->execute;
	514	while (my @data = $sth->fetchrow_array) {
	515	print qq(<tr><td><input type=radio name=ip value="$data[1]">$data[1]</td>).
	516	"<td>$data[2]</td><td>$data[3]</td><td>$data[4]</td>".
	517	"<td>$data[5]</td><td>$data[6]</td><td>$data[7]</td></tr>\n";
	518	}
	519	print "</form></table>\n";
	520	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats: