Ignore:
Timestamp:
06/17/05 16:42:45 (20 years ago)
Author:
Kris Deugau
Message:

/branches/dns

Update branch base with trunk changes from r216:261

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/dns/cgi-bin/main.cgi

    r214 r262  
    2222openlog "IPDB","pid","local2";
    2323
    24 # Collect the username from HTTP auth.  If undefined, we're in a test environment.
     24# Collect the username from HTTP auth.  If undefined, we're in
     25# a test environment, or called without a username.
    2526my $authuser;
    2627if (!defined($ENV{'REMOTE_USER'})) {
    … …  
    3940($ip_dbh,$errstr) = connectDB_My;
    4041if (!$ip_dbh) {
    41   printAndExit("Database error: $errstr\n");
     42  exitError("Database error: $errstr\n");
    4243}
    4344initIPDBGlobals($ip_dbh);
    4445
    45 #prototypes
    46 sub viewBy($$);         # feed it the category and query
    47 sub queryResults($$$);  # args is the sql, the page# and the rowCount
    48 # Needs rewrite/rename
    49 sub countRows($);       # returns first element of first row of passed SQL
    50                         # Only usage passes "select count(*) ..."
     46# Headerize!  Make sure we replace the $$EXTRA0$$ bit as needed.
     47printHeader('', ($IPDBacl{$authuser} =~ /a/ ?
     48        '<td align=right><a href="/ip/cgi-bin/main.cgi?action=assign">Add new assignment</a>' : ''
     49        ));
     50
    5151
    5252# Global variables
    53 my $RESULTS_PER_PAGE = 50;
    5453my %webvar = parse_post();
    5554cleanInput(\%webvar);
    … …  
    6463if($webvar{action} eq 'index') {
    6564  showSummary();
     65} elsif ($webvar{action} eq 'addmaster') {
     66  if ($IPDBacl{$authuser} !~ /a/) {
     67    printError("You shouldn't have been able to get here.  Access denied.");
     68  } else {
     69    open HTML, "<../addmaster.html";
     70    print while <HTML>;
     71  }
    6672} elsif ($webvar{action} eq 'newmaster') {
    67   printHeader('');
    68 
    69   my $cidr = new NetAddr::IP $webvar{cidr};
    70 
    71   print "<div type=heading align=center>Adding $cidr as master block....</div>\n";
    72 
    73   # Allow transactions, and raise an exception on errors so we can catch it later.
    74   # Use local to make sure these get "reset" properly on exiting this block
    75   local $ip_dbh->{AutoCommit} = 0;
    76   local $ip_dbh->{RaiseError} = 1;
    77 
    78   # Wrap the SQL in a transaction
    79   eval {
    80     $sth = $ip_dbh->prepare("insert into masterblocks values ('$webvar{cidr}')");
    81     $sth->execute;
     73
     74  if ($IPDBacl{$authuser} !~ /a/) {
     75    printError("You shouldn't have been able to get here.  Access denied.");
     76  } else {
     77
     78    my $cidr = new NetAddr::IP $webvar{cidr};
     79
     80    print "<div type=heading align=center>Adding $cidr as master block....</div>\n";
     81
     82    # Allow transactions, and raise an exception on errors so we can catch it later.
     83    # Use local to make sure these get "reset" properly on exiting this block
     84    local $ip_dbh->{AutoCommit} = 0;
     85    local $ip_dbh->{RaiseError} = 1;
     86
     87    # Wrap the SQL in a transaction
     88    eval {
     89      $sth = $ip_dbh->prepare("insert into masterblocks values ('$webvar{cidr}')");
     90      $sth->execute;
    8291
    8392# Unrouted blocks aren't associated with a city (yet).  We don't rely on this
    … …  
    8594# Thus the "routed" flag.
    8695
    87     $sth = $ip_dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
     96      $sth = $ip_dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
    8897        " values ('$webvar{cidr}',".$cidr->masklen.",'<NULL>','n')");
    89     $sth->execute;
    90 
    91     # If we get here, everything is happy.  Commit changes.
    92     $ip_dbh->commit;
    93   }; # end eval
    94 
    95   if ($@) {
    96     carp "Transaction aborted because $@";
    97     eval { $ip_dbh->rollback; };
    98     syslog "err", "Could not add master block '$webvar{cidr}' to database: '$@'";
    99     printError("Could not add master block $webvar{cidr} to database: $@");
    100   } else {
    101     print "<div type=heading align=center>Success!</div>\n";
    102     syslog "info", "$authuser added master block $webvar{cidr}";
    103   }
     98      $sth->execute;
     99
     100      # If we get here, everything is happy.  Commit changes.
     101      $ip_dbh->commit;
     102    }; # end eval
     103
     104    if ($@) {
     105      carp "Transaction aborted because $@";
     106      eval { $ip_dbh->rollback; };
     107      syslog "err", "Could not add master block '$webvar{cidr}' to database: '$@'";
     108      printError("Could not add master block $webvar{cidr} to database: $@");
     109    } else {
     110      print "<div type=heading align=center>Success!</div>\n";
     111      syslog "info", "$authuser added master block $webvar{cidr}";
     112    }
     113
     114  } # ACL check
    104115
    105116} # end add new master
    … …  
    113124elsif($webvar{action} eq 'listpool') {
    114125  listPool();
    115 }
    116 elsif($webvar{action} eq 'search') {
    117   printHeader('');
    118   if (!$webvar{input}) {
    119     # No search term.  Display everything.
    120     viewBy('all', '');
    121   } else {
    122     # Search term entered.  Display matches.
    123     # We should really sanitize $webvar{input}, no?
    124     viewBy($webvar{searchfor}, $webvar{input});
    125   }
    126126}
    127127
    … …  
    153153# which is not in any way guaranteed to provide anything useful.
    154154else {
    155   printHeader('');
    156155  my $rnd = rand 500;
    157156  my $boing = sprintf("%.2f", rand 500);
    … …  
    171170print qq(<div align=right style="position: absolute; right: 30px;">).
    172171        qq(<a href="/ip/cgi-bin/admin.cgi">Admin tools</a></div><br>\n)
    173         if $authuser =~ /kdeugau|jodyh|jipp/;
     172        if $IPDBacl{$authuser} =~ /A/;
    174173
    175174# We print the footer here, so we don't have to do it elsewhere.
    … …  
    181180
    182181
    183 sub viewBy($$) {
    184   my ($category,$query) = @_;
    185 
    186   # Local variables
    187   my $sql;
    188 
    189 #print "<pre>\n";
    190 
    191 #print "start querysub: query '$query'\n";
    192 # this may happen with more than one subcategory.  Unlikely, but possible.
    193 
    194   # Calculate start point for LIMIT clause
    195   my $offset = ($webvar{page}-1)*$RESULTS_PER_PAGE;
    196 
    197 # Possible cases:
    198 # 1) Partial IP/subnet.  Treated as "first-three-octets-match" in old IPDB,
    199 #    I should be able to handle it similarly here.
    200 # 2a) CIDR subnet.  Treated more or less as such in old IPDB.
    201 # 2b) CIDR netmask.  Not sure how it's treated.
    202 # 3) Customer ID.  Not handled in old IPDB
    203 # 4) Description.
    204 # 5) Invalid data which might be interpretable as an IP or something, but
    205 #    which probably shouldn't be for reasons of sanity.
    206 
    207   if ($category eq 'all') {
    208 
    209     print qq(<div class="heading">Showing all netblock and static-IP allocations</div><br>\n);
    210 
    211     # Need to assemble SQL query in this order to avoid breaking things.
    212     $sql = "select cidr,custid,type,city,description from searchme";
    213     my $count = countRows("select count(*) from ($sql) foo");
    214     $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
    215     queryResults($sql, $webvar{page}, $count);
    216 
    217   } elsif ($category eq 'cust') {
    218 
    219     print qq(<div class="heading">Searching for Customer IDs containing '$query'</div><br>\n);
    220 
    221     # Query for a customer ID.  Note that we can't restrict to "numeric-only"
    222     # as we have non-numeric custIDs in the legacy data.  :/
    223     $sql = "select cidr,custid,type,city,description from searchme where custid ilike '%$query%'";
    224     my $count = countRows("select count(*) from ($sql) foo");
    225     $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
    226     queryResults($sql, $webvar{page}, $count);
    227 
    228   } elsif ($category eq 'desc') {
    229 
    230     print qq(<div class="heading">Searching for descriptions containing '$query'</div><br>\n);
    231     # Query based on description (includes "name" from old DB).
    232     $sql = "select cidr,custid,type,city,description from searchme where description ilike '%$query%'";
    233     my $count = countRows("select count(*) from ($sql) foo");
    234     $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
    235     queryResults($sql, $webvar{page}, $count);
    236 
    237   } elsif ($category =~ /ipblock/) {
    238 
    239     # Query is for a partial IP, a CIDR block in some form, or a flat IP.
    240     print qq(<div class="heading">Searching for IP-based matches on '$query'</div><br>\n);
    241 
    242     $query =~ s/\s+//g;
    243     if ($query =~ /\//) {
    244       # 209.91.179/26 should show all /26 subnets in 209.91.179
    245       my ($net,$maskbits) = split /\//, $query;
    246       if ($query =~ /^(\d{1,3}\.){3}\d{1,3}\/\d{2}$/) {
    247         # /0->/9 are silly to worry about right now.  I don't think
    248         # we'll be getting a class A anytime soon.  <g>
    249         $sql = "select cidr,custid,type,city,description from searchme where cidr='$query'";
    250         queryResults($sql, $webvar{page}, 1);
    251       } else {
    252         print "Finding all blocks with netmask /$maskbits, leading octet(s) $net<br>\n";
    253         # Partial match;  beginning of subnet and maskbits are provided
    254         $sql = "select cidr,custid,type,city,description from searchme where ".
    255                 "text(cidr) like '$net%' and text(cidr) like '%$maskbits'";
    256         my $count = countRows("select count(*) from ($sql) foo");
    257         $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
    258         queryResults($sql, $webvar{page}, $count);
    259       }
    260     } elsif ($query =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
    261       # Specific IP address match
    262       my $sfor = new NetAddr::IP $query;
    263 # We do this convoluted roundabout way of finding things in order
    264 # to bring up matches for single IPs that are within a static block;
    265 # we want to show both the "container" block and the static IP itself.
    266       $sth = $ip_dbh->prepare("select cidr from searchme where cidr >>= '$sfor'");
    267       $sth->execute;
    268       while (my @data = $sth->fetchrow_array()) {
    269         my $cidr = new NetAddr::IP $data[0];
    270         queryResults("select cidr,custid,type,city,description from searchme where ".
    271                 "cidr='$cidr'", $webvar{page}, 1);
    272       }
    273     } elsif ($query =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.?$/) {
    274       print "Finding matches where the first three octets are $query<br>\n";
    275       $sql = "select cidr,custid,type,city,description from searchme where ".
    276                 "text(cidr) like '$query%'";
    277       my $count = countRows("select count(*) from ($sql) foo");
    278       $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
    279       queryResults($sql, $webvar{page}, $count);
    280     } else {
    281       # This shouldn't happen, but if it does, whoever gets it deserves what they get...
    282       printError("Invalid query.");
    283     }
    284   } else {
    285     # This shouldn't happen, but if it does, whoever gets it deserves what they get...
    286     printError("Invalid searchfor.");
    287   }
    288 } # viewBy
    289 
    290 
    291182# args are: a reference to an array with the row to be printed and the
    292183# class(stylesheet) to use for formatting.
    … …  
    313204
    314205
    315 # Display certain types of search query.  Note that this can't be
    316 # cleanly reused much of anywhere else as the data isn't neatly tabulated.
    317 # This is tied to the search sub tightly enough I may just gut it and provide
    318 # more appropriate tables directly as needed.
    319 sub queryResults($$$) {
    320   my ($sql, $pageNo, $rowCount) = @_;
    321   my $offset = 0;
    322   $offset = $1 if($sql =~ m/.*limit\s+(.*),.*/);
    323 
    324   my $sth = $ip_dbh->prepare($sql);
    325   $sth->execute();
    326 
    327   startTable('Allocation','CustID','Type','City','Description/Name');
    328   my $count = 0;
    329 
    330   while (my @data = $sth->fetchrow_array) {
    331     # cidr,custid,type,city,description
    332     # Prefix subblocks with "Sub "
    333     my @row = ( (($data[2] =~ /^.r$/) ? 'Sub ' : '').
    334         qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
    335         $data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]);
    336     # Allow listing of pool if desired/required.
    337     if ($data[2] =~ /^.[pd]$/) {
    338       $row[0] .= ' &nbsp; <a href="/ip/cgi-bin/main.cgi?action=listpool'.
    339         "&pool=$data[0]\">List IPs</a>";
    340     }
    341     printRow(\@row, 'color1', 1) if ($count%2==0);
    342     printRow(\@row, 'color2', 1) if ($count%2!=0);
    343     $count++;
    344   }
    345 
    346   # Have to think on this call, it's primarily to clean up unfetched rows from a select.
    347   # In this context it's probably a good idea.
    348   $sth->finish();
    349 
    350   my $upper = $offset+$count;
    351   print "<tr><td colspan=10 bgcolor=white class=regular>Records found: $rowCount<br><i>Displaying: $offset - $upper</i></td></tr>\n";
    352   print "</table></center>\n";
    353 
    354   # print the page thing..
    355   if ($rowCount > $RESULTS_PER_PAGE) {
    356     my $pages = ceil($rowCount/$RESULTS_PER_PAGE);
    357     print qq(<div class="center"> Page: );
    358     for (my $i = 1; $i <= $pages; $i++) {
    359       if ($i == $pageNo) {
    360         print "<b>$i&nbsp;</b>\n";
    361       } else {
    362         print qq(<a href="/ip/cgi-bin/main.cgi?page=$i&input=$webvar{input}&action=search&searchfor=$webvar{searchfor}">$i</a>&nbsp;\n);
    363       }
    364     }
    365     print "</div>";
    366   }
    367 } # queryResults
    368 
    369 
    370206# Prints table headings.  Accepts any number of arguments;
    371207# each argument is a table heading.
    … …  
    380216
    381217
    382 # Return first element of passed SQL query
    383 sub countRows($) {
    384   my $sth = $ip_dbh->prepare($_[0]);
    385   $sth->execute();
    386   my @a = $sth->fetchrow_array();
    387   $sth->finish();
    388   return $a[0];
    389 }
    390 
    391 
    392218# Initial display:  Show master blocks with total allocated subnets, total free subnets
    393219sub showSummary {
    394   # this is horrible-ugly-bad and will Go Away real soon now(TM)
    395   print "Content-type: text/html\n\n";
    396220
    397221  startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',
    … …  
    420244
    421245  # Count the free blocks.
    422   $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ?");
     246  $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ? and ".
     247        "(routed='y' or routed='n')");
    423248  foreach my $master (@masterblocks) {
    424249    $sth->execute("$master");
    … …  
    428253
    429254  # Find the largest free block in each master
    430   $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? order by maskbits limit 1");
     255  $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? and ".
     256        "(routed='y' or routed='n') order by maskbits limit 1");
    431257  foreach my $master (@masterblocks) {
    432258    $sth->execute("$master");
    … …  
    448274  }
    449275  print "</table>\n";
    450   print qq(<a href="/ip/addmaster.shtml">Add new master block</a><br><br>\n);
     276  if ($IPDBacl{$authuser} =~ /a/) {
     277    print qq(<a href="/ip/cgi-bin/main.cgi?action=addmaster">Add new master block</a><br><br>\n);
     278  }
    451279  print "Note:  Free blocks noted here include both routed and unrouted blocks.\n";
    452280
    … …  
    460288# else should follow.  YMMV.)
    461289sub showMaster {
    462   printHeader('');
    463290
    464291  print qq(<center><div class="heading">Summarizing routed blocks for ).
    … …  
    502329
    503330    # Count the free blocks.
    504     $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ?");
     331    $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ? and ".
     332        "(routed='y' or routed='n')");
    505333    foreach my $master (@localmasters) {
    506334      $sth->execute("$master");
    … …  
    510338
    511339    # Get the size of the largest free block
    512     $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? order by maskbits limit 1");
     340    $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? and ".
     341        "(routed='y' or routed='n') order by maskbits limit 1");
    513342    foreach my $master (@localmasters) {
    514343      $sth->execute("$master");
    … …  
    534363    print qq(<hr width="60%"><center><div class="heading">No allocations in ).
    535364        qq($master.</div>\n).
    536         qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
    537         qq(<input type=hidden name=action value="delete">\n).
    538         qq(<input type=hidden name=block value="$master">\n).
    539         qq(<input type=hidden name=alloctype value="mm">\n).
    540         qq(<input type=submit value=" Remove this master ">\n).
    541         qq(</form></center>\n);
     365        ($IPDBacl{$authuser} =~ /d/ ?
     366                qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
     367                qq(<input type=hidden name=action value="delete">\n).
     368                qq(<input type=hidden name=block value="$master">\n).
     369                qq(<input type=hidden name=alloctype value="mm">\n).
     370                qq(<input type=submit value=" Remove this master ">\n).
     371                qq(</form></center>\n) :
     372                '');
    542373
    543374  } # end check for existence of routed blocks in master
    … …  
    573404# not have anything useful to spew.
    574405sub showRBlock {
    575   printHeader('');
    576406
    577407  my $master = new NetAddr::IP $webvar{block};
    … …  
    621451    print qq(<hr width="60%"><center><div class="heading">No allocations in ).
    622452        qq($master.</div></center>\n).
    623         qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
    624         qq(<input type=hidden name=action value="delete">\n).
    625         qq(<input type=hidden name=block value="$master">\n).
    626         qq(<input type=hidden name=alloctype value="rm">\n).
    627         qq(<input type=submit value=" Remove this block ">\n).
    628         qq(</form>\n);
     453        ($IPDBacl{$authuser} =~ /d/ ?
     454                qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
     455                qq(<input type=hidden name=action value="delete">\n).
     456                qq(<input type=hidden name=block value="$master">\n).
     457                qq(<input type=hidden name=alloctype value="rm">\n).
     458                qq(<input type=submit value=" Remove this block ">\n).
     459                qq(</form>\n) :
     460                '');
    629461  }
    630462
    … …  
    645477    # Include some HairyPerl(TM) to prefix subblocks with "Sub "
    646478    my @row = ((($data[1] ne 'y' && $data[1] ne 'n') ? 'Sub ' : '').
    647         qq(<a href="/ip/cgi-bin/main.cgi?action=assign&block=$cidr&fbtype=$data[1]">$cidr</a>),
     479        ($IPDBacl{$authuser} =~ /a/ ? qq(<a href="/ip/cgi-bin/main.cgi?action=assign&block=$cidr&fbtype=$data[1]">$cidr</a>) : $cidr),
    648480        $cidr->range);
    649481    printRow(\@row, 'color1') if ($count%2 == 0);
    … …  
    658490# List the IPs used in a pool
    659491sub listPool {
    660   printHeader('');
    661492
    662493  my $cidr = new NetAddr::IP $webvar{pool};
    … …  
    704535    my @row = ( qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
    705536        $data[1],$data[2],$data[3],
    706         ( ($data[2] eq 'n') ?
     537        ( (($data[2] eq 'n') && ($IPDBacl{$authuser} =~ /d/)) ?
    707538          ("<a href=\"/ip/cgi-bin/main.cgi?action=delete&block=$data[0]&".
    708539           "alloctype=$data[4]\">Unassign this IP</a>") :
    … …  
    721552# be one of two templates, and the lists come from the database.
    722553sub assignBlock {
    723   printHeader('');
     554
     555  if ($IPDBacl{$authuser} !~ /a/) {
     556    printError("You shouldn't have been able to get here.  Access denied.");
     557    return;
     558  }
    724559
    725560  my $html;
    … …  
    799634# Take info on requested IP assignment and see what we can provide.
    800635sub confirmAssign {
    801   printHeader('');
     636  if ($IPDBacl{$authuser} !~ /a/) {
     637    printError("You shouldn't have been able to get here.  Access denied.");
     638    return;
     639  }
    802640
    803641  my $cidr;
    … …  
    958796# Do the work of actually inserting a block in the database.
    959797sub insertAssign {
     798  if ($IPDBacl{$authuser} !~ /a/) {
     799    printError("You shouldn't have been able to get here.  Access denied.");
     800    return;
     801  }
    960802  # Some things are done more than once.
    961   printHeader('');
    962803  return if !validateInput();
    963804
    … …  
    973814      print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div></div>);
    974815      # Notify tech@example.com
    975       mailNotify('tech@example.com',"ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
    976         "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
    977         "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
     816#      mailNotify('tech@example.com',"ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
     817#       "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
     818#       "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
    978819    } else {
    979820      print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
    … …  
    981822    }
    982823    syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
    983         "'$webvar{alloctype}'";
     824        "'$webvar{alloctype}' ($msg)";
    984825  } else {
    985826    syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
    … …  
    1057898# action=edit
    1058899sub edit {
    1059   printHeader('');
    1060900
    1061901  my $sql;
    … …  
    1064904  # because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
    1065905  if ($webvar{block} =~ /\/32$/) {
    1066     $sql = "select ip,custid,type,city,circuitid,description,notes from poolips where ip='$webvar{block}'";
     906    $sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp from poolips where ip='$webvar{block}'";
    1067907  } else {
    1068     $sql = "select cidr,custid,type,city,circuitid,description,notes from allocations where cidr='$webvar{block}'"
     908    $sql = "select cidr,custid,type,city,circuitid,description,notes,modifystamp from allocations where cidr='$webvar{block}'"
    1069909  }
    1070910
    … …  
    1076916  # Clean up extra whitespace on alloc type
    1077917  $data[2] =~ s/\s//;
    1078 
    1079 ##fixme LEGACY CODE
    1080   # Postfix "i" on pool IP types
    1081   if ($data[2] =~ /^[cdsmw]$/) {
    1082     $data[2] .= "i";
    1083   }
    1084918
    1085919  open (HTML, "../editDisplay.html")
    … …  
    1093927# Needs thinking.  Have to allow changes to city to correct errors, no?
    1094928  $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
    1095   $html =~ s/\$\$CITY\$\$/$data[3]/g;
     929
     930  if ($IPDBacl{$authuser} =~ /c/) {
     931    $html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/;
    1096932
    1097933# Screw it.  Changing allocation types gets very ugly VERY quickly- especially
    … …  
    1102938
    1103939##fixme The check here should be built from the database
    1104   if ($data[2] =~ /^.[ne]$/) {
    1105     # Block that can be changed
    1106     my $blockoptions = "<select name=alloctype><option".
     940    if ($data[2] =~ /^.[ne]$/) {
     941      # Block that can be changed
     942      my $blockoptions = "<select name=alloctype><option".
    1107943        (($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option".
    1108         (($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".  (($data[2] eq 'dc') ? ' selected' : '') ." value='dc'>Dynamic cable netblock</option>\n<option".
    1109         (($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".        (($data[2] eq 'dc') ? ' selected' : '') ." value='dc'>Dynamic cable netblock</option>\n<option".
    1110         (($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option".     (($data[2] eq 'dc') ? ' selected' : '') ." value='dc'>Dynamic cable netblock</option>\n<option".
     944        (($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".
     945        (($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".
     946        (($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option".
    1111947        (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
    1112948        (($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option".
    1113949        (($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
    1114950        "</select>\n";
    1115     $html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
     951      $html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
     952    } else {
     953      $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
     954    }
     955    $html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g;
     956    $html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g;
     957    $html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g;
     958    $html =~ s|\$\$NOTES\$\$|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>|g;
    1116959  } else {
    1117     $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
    1118   }
    1119 
    1120   # These can be modified, although CustID changes may get ignored.
    1121   $html =~ s/\$\$CUSTID\$\$/$data[1]/g;
    1122   $html =~ s/\$\$TYPE\$\$/$data[2]/g;
    1123   $html =~ s/\$\$CIRCID\$\$/$data[4]/g;
    1124   $html =~ s/\$\$DESC\$\$/$data[5]/g;
    1125   $html =~ s/\$\$NOTES\$\$/$data[6]/g;
     960    $html =~ s/\$\$CUSTID\$\$/$data[1]/g;
     961    $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
     962    $html =~ s/\$\$CITY\$\$/$data[3]/g;
     963    $html =~ s/\$\$CIRCID\$\$/$data[4]/g;
     964    $html =~ s/\$\$DESC\$\$/$data[5]/g;
     965    $html =~ s/\$\$NOTES\$\$/$data[6]/g;
     966  }
     967  my ($lastmod,undef) = split /\s+/, $data[7];
     968  $html =~ s/\$\$LASTMOD\$\$/$lastmod/g;
     969
     970  # Allows us to "correctly" colour backgrounds in table
     971  my $i=1;
     972
     973  # More ACL trickery - we can live with forms that don't submit,
     974  # but we can't leave the extra table rows there, and we *really*
     975  # can't leave the submit buttons there.
     976  my $updok = '';
     977  if ($IPDBacl{$authuser} =~ /c/) {
     978    $updok = qq(<tr class="color$i"><td colspan=2><div class="center">).
     979        qq(<input type="submit" value=" Update this block " class="regular">).
     980        "</div></td></tr></form>\n";
     981    $i++;
     982  }
     983  $html =~ s/\$\$UPDOK\$\$/$updok/g;
     984
     985  my $delok = '';
     986  if ($IPDBacl{$authuser} =~ /d/) {
     987    $delok = qq(<form method="POST" action="main.cgi">
     988        <tr class="color$i"><td colspan=2 class="regular"><div class=center>
     989        <input type="hidden" name="action" value="delete">
     990        <input type="hidden" name="block" value="$webvar{block}">
     991        <input type="hidden" name="alloctype" value="$data[2]">
     992        <input type=submit value=" Delete this block ">
     993        </div></td></tr>);
     994  }
     995  $html =~ s/\$\$DELOK\$\$/$delok/;
    1126996
    1127997  print $html;
    … …  
    11331003# action=update
    11341004sub update {
    1135   printHeader('');
    11361005
    11371006  # Make sure incoming data is in correct format - custID among other things.
    1138   validateInput;
     1007  return if !validateInput;
    11391008
    11401009  # SQL transaction wrapper
    … …  
    11431012    my $sql;
    11441013    if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
    1145       # Note the hack ( available='n' ) to work around "update" additions
    1146       # to static IP space.  Eww.
    11471014      $sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
    1148         "circuitid='$webvar{circid}',description='$webvar{desc}',available='n' ".
     1015        "circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}' ".
    11491016        "where ip='$webvar{block}'";
    11501017    } else {
    … …  
    11941061# Delete an allocation.
    11951062sub remove {
    1196   printHeader('');
     1063  if ($IPDBacl{$authuser} !~ /d/) {
     1064    printError("You shouldn't have been able to get here.  Access denied.");
     1065    return;
     1066  }
     1067
    11971068  #show confirm screen.
    11981069  open HTML, "../confirmRemove.html"
    … …  
    12841155# Remove IPs from pool listing if necessary
    12851156sub finalDelete {
    1286   printHeader('');
     1157  if ($IPDBacl{$authuser} !~ /d/) {
     1158    printError("You shouldn't have been able to get here.  Access denied.");
     1159    return;
     1160  }
    12871161
    12881162  my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
    … …  
    12921166    syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}";
    12931167    # Notify tech@ when a block/IP is deallocated
    1294     mailNotify('tech@example.com',"REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
    1295         "$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n");
     1168#    mailNotify('tech@example.com',"REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
     1169#       "$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n");
    12961170  } else {
    12971171    if ($webvar{alloctype} =~ /^.i$/) {
    … …  
    13071181
    13081182
     1183sub exitError {
     1184  my $errStr = $_[0];
     1185  printHeader('','');
     1186  print qq(<center><p class="regular"> $errStr </p>
     1187<input type="button" value="Back" onclick="history.go(-1)">
     1188</center>
     1189);
     1190  printFooter();
     1191  exit;
     1192} # errorExit
     1193
     1194
    13091195# Just in case we manage to get here.
    13101196exit 0;
Note: See TracChangeset for help on using the changeset viewer.