The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
   
use strict;
use warnings;
use Template;
use CGI;
use Data::Dumper;
use BGPmon::CPM::Demo;
use BGPmon::CPM::PList qw( all );
use BGPmon::CPM::Domain;
use BGPmon::CPM::PList::Manager qw( all );
use BGPmon::CPM::Prefix::Finder;


my $_ACTION_STRING = "action";
my $_LIST_STRING   = "list";
my $_INPUT_TYPE_STRING = "type";
my $_INPUT_VALUE_STRING   = "value";

# INPUTS
my $_STOCK_TICKER_INPUT = "ticker";
my $_COMPANY_NAME_INPUT = "company";
my $_DOMAIN_NAME_INPUT  = "domain";
my $_DOMAIN_LIST_INPUT  = "domainlist";
my $_PREFIX_NAME_INPUT = "prefix";

my $_TEMPLATE_CONFIG = {
	INTERPOLATE  => 1,               # expand "$var" in plain text
	POST_CHOMP   => 1,               # cleanup whitespace 
	EVAL_PERL    => 1,               # evaluate Perl code blocks
	INCLUDE_PATH => [ '../tmpl', '../html' ],
};

# main state machine
my $FSM = {
 'error'            => \&ErrorHandler,           # Error handler
 'undevelop'        => \&UnDevelopHandler,       # Under development handler
 'welcome'          => \&SelectListHandler,      # SelectListHandler subroutine
 'newlist'          => \&NewListRequestHandler,  # Request a new list name 
 'createlist'       => \&CreateListHandler,      # add new list to the database
 'loadlist'         => \&LoadListHandler,        # LoadListHandler subroutine
 'view'             => \&ListDetailsHandler,     # ListDetailsHanlder subroutine
 'add'              => \&AddHandler,             # Add Handler subrouting
 'addinput'         => \&AddInputHandler,        # Add Input subrouting
 'adddomain'        => \&AddDomainHandler,       # Add Input subrouting
 'expand'           => \&WhoisExpansionHandler,
 'insertfromexpand' => \&InsertExpansionHandler,
 'showticker'       => \&ShowTickerHandler,      # Show Ticker Handler
 'processticker'    => \&ProcessTickerHandler,
 'showcompany'      => \&ShowCompanyHandler,
 'processcompany'   => \&ProcessCompanyHandler,
 'remove'           =>  \&ShowDeleteHandler,     # DELETE UNDERS DEVEL
 'processremove'    => \&ProcessDeleteHandler,
 'export'           => \&ExportListHandler
};

# get input value
my $cgi = CGI->new();
my $value = $cgi->param($_ACTION_STRING);
# convert to lowercase
$value =~ tr/A-Z/a-z/;

# 
if (!defined($FSM->{$value}))
{
  # create error html page that has a back button
  $cgi = { MESSAGE => "Invalid action"};
  $value = 'error';
}

# execute FSM, pass template config and cgi parameters
my ($template, %data) = &{$FSM->{$value}}($cgi);

# TODO: this is not a good way to do this
if($value =~ /export/){
  print "Content-Type: text/plain\n\n";
}else{
  print "Content-Type: text/html\n\n";
}
my $tt = Template->new($_TEMPLATE_CONFIG);
$tt->process($template, \%data) || die $tt->error( );


#
# Error Handler template
#
sub ErrorHandler
{
  my $data = shift;
  return ('error.tt', %$data);
}

#
# SelectListHandler template
#
sub SelectListHandler
{
  return 'welcome.tt';
}

###############################################################################
# This handler requests the name of a list from the user
###############################################################################
sub NewListRequestHandler
{
  my $cgi = shift;
  my $message = shift;
  my $tmpl = 'newlist.tt';

  my %data = (MESSAGE => $message);
  return ($tmpl, %data);
}

###############################################################################
# This handler requests the name of a list from the user
###############################################################################
sub CreateListHandler
{
  my $cgi = shift;
  my $message = shift;

  my $listName = $cgi->param($_LIST_STRING);

  my $ret_val = BGPmon::CPM::PList::Manager->createListByName($listName);
  if($ret_val){
    return ListDetailsHandler($cgi, "The new list has been created.");
  }
  return NewListRequestHandler($cgi,"Error: Name is not unique " );
}


###############################################################################
# This handler loads the list of list names from the database
###############################################################################
sub LoadListHandler
{
  my $cgi = shift;
  my $tmpl = 'loadlist.tt';

  # load
  my @lists = BGPmon::CPM::PList::Manager->getListNames();
  if(scalar(@lists) == 0){
    return &NewListRequestHandler($cgi,"No lists were found: please create a new one");
  }
  my %data = ( LISTNAMES => \@lists);
  return ($tmpl, %data);
}

###############################################################################
###############################################################################
sub InsertExpansionHandler{
  my $cgi = shift;
  my $list_name = $cgi->param($_LIST_STRING);
  my $submit = $cgi->param("submit");
  my @prefixes = $cgi->param("prefix");
  if($submit eq "Back"){
    return &ListDetailsHandler($cgi);
  }

  ## get the list object for the list we are currently workingon
  my $list = BGPmon::CPM::PList::Manager->getListByName($list_name);

  ## go through each one and determine if it can be added to the list
  foreach my $prefix (@prefixes){
    my @search_paths;
    my $key = $cgi->param($prefix.'IP');
    push @search_paths,{path=>"Whois Expansion",param_prefix=>{prefix=>$key,
                                                        watch_more_specifics=>1,
                                                        watch_covering=>1}};

    $list->add_or_edit_prefixes({prefix=>$prefix,watch_more_specifics=>1,
                         watch_covering=>1,
                         search_paths=>\@search_paths});
  }
  $list->save;

  return &ListDetailsHandler($cgi);
}

###############################################################################
# this handler will allow the user to view the containing net and decide
# if additional nets should be included based on ownership
###############################################################################
sub WhoisExpansionHandler{
  my $cgi = shift;
  my @prefixes = $cgi->param($_PREFIX_NAME_INPUT);
  my $tmpl = "whoisExpansion.tt";

  my %var = ('NUM' => scalar(@prefixes),'DATA'=>[],'LIST' => $cgi->param($_LIST_STRING));

  my @ranges;

  foreach my $p (@prefixes){
    ## figure out if we have expanded a previous prefix that covers this one.
    ## don't do the same range twice
    my $covered = 0;
    my $elligible = 1;
    foreach my $range (@ranges){
      use Net::IP qw(ip_prefix_to_range ip_bincomp ip_iptobin);
      my ($start,$end) = ip_prefix_to_range($range);
      my $binp = ip_iptobin($p); 
      if(ip_bincomp($binp,'le',$end) && ip_bincomp($binp,'ge',$start)){
        $covered = $range;
        $elligible = 0;
        last;
      }
    }
    if($p =~ /(\d+\.\d+\.\d+\.\d+)\/(\d+)/){
      if($2 == 32){
        $p = $1;
      }else{
        next;
      }
    }

    my %ipExpanded;
    if(!$covered && $elligible){
      %ipExpanded = BGPmon::CPM::Prefix::Finder::expandIP($p);
      if(defined($ipExpanded{'orghandle'})){
        $ipExpanded{'orgid'} = $ipExpanded{'orghandle'};
        my @nets = BGPmon::CPM::Prefix::Finder::orghandle2nets($ipExpanded{'orghandle'});
        my @new_prefixes;
        foreach my $net (@nets){
          push @new_prefixes,BGPmon::CPM::Prefix::Finder::inetnum2prefixes($net);
        }
        $ipExpanded{'nets'} = \@new_prefixes;
      }
      my @new_ranges = BGPmon::CPM::Prefix::Finder::inetnum2prefixes($ipExpanded{'inetnum'});
      push @ranges,@new_ranges;
      $ipExpanded{'range'} = \@new_ranges;
      $ipExpanded{'ip'} = $p;
    }elsif($covered){
      $ipExpanded{'msg'} = "$p is covered by $covered (above)";
      $ipExpanded{'ip'} = $p;
    }else{
      $ipExpanded{'msg'} = "$p is not elligible for expansion";
    }
    push @{$var{'DATA'}},\%ipExpanded;
  }

  return ($tmpl, %var);  
}


###############################################################################
# This handler takes the domain name given and expands it to a list
# of prefixes, which are then added to the DB
###############################################################################
sub AddDomainHandler{
  my $cgi = shift;

  my $list_name = $cgi->param($_LIST_STRING);
  my $domain = $cgi->param($_DOMAIN_NAME_INPUT);
  my $domainlist_str = $cgi->param($_DOMAIN_LIST_INPUT);
  my @domainlist = split /\s+/,$domainlist_str;

  ## get the list object for the list we are currently workingon
  my $list = BGPmon::CPM::PList::Manager->getListByName($list_name);

  ## check to see that they entered something
  if(!defined($domain) or $domain eq ""){
    if(scalar(@domainlist) == 0){
     return ErrorHandler({MESSAGE => "No Domain Specified"}); 
    }
  }else{
    push @domainlist,$domain;
  }

  my %ip_list = BGPmon::CPM::Prefix::Finder::expandDomainToIPs(\@domainlist);
  foreach my $prefix (keys %ip_list){
    ## add the search paths to the DB
    my @search_paths;
    foreach my $sp ( uniq( @{$ip_list{$prefix}{'search'}})){
      push @search_paths,{path=>$sp};
    }

    my @domains;
    foreach my $d (keys %{$ip_list{$prefix}{'domain'}}){
      push @domains,{domain=>$d};
    }
 
    my @authoritative_for;
    foreach my $sp ( uniq( @{$ip_list{$prefix}{'search'}})){
      if($sp =~ /(.*)\sNS/){
        push @authoritative_for,{domain=>$1};
      }
    } 

    if(@authoritative_for){
      $list->add_or_edit_prefixes({prefix=>$prefix,watch_more_specifics=>0,
                                   watch_covering=>1,
                                   search_paths=>\@search_paths,
                                   authoritative_for=>\@authoritative_for,
                                   domains=>\@domains});
      $list->save;
    }else{
      $list->add_or_edit_prefixes({prefix=>$prefix,watch_more_specifics=>0,
                                     watch_covering=>1,
                                     search_paths=>\@search_paths,
                                     domains=>\@domains});
      $list->save;
    }
  }

  return &ListDetailsHandler($cgi);
}
###############################################################################
# This handler displays the information about the specified list
###############################################################################
sub ListDetailsHandler{

  my $cgi = shift;
  my $list_name = $cgi->param($_LIST_STRING);
  my $tmpl = 'view.tt';
  
  # get the requested list
  my $list = BGPmon::CPM::PList::Manager->getListByName($list_name);
  # get an array of prefixes from the list
  my @prefixes = $list->prefixes;
  my @formattedPrefixes;
  foreach my $prefix (@prefixes){
    my $reason = "";
    my @adomains = $prefix->authoritative_for;
    if(scalar(@adomains) > 0){
      $reason .= " DNS authority for: (";
      foreach my $res($prefix->authoritative_for){
        $reason .= " " . $res->domain;
      }
      $reason .= ")";
    }
    my @searches = $prefix->search_paths;
    my $search = "";
    foreach my $s (@searches){
      $s = $s->path;
      $s =~ s/^\s*//;
      $s =~ s/\s*$//;
      $search .= $s . " ";
    }
    my @domains = $prefix->domains;
    my $domain = "";
    foreach my $d (@domains){
      $domain .= $d->domain . " ";
    }
    push @formattedPrefixes,{prefix=>$prefix->prefix,
                             watch_more_specifics=>$prefix->watch_more_specifics,
                             watch_covering => $prefix->watch_covering,
                             domain => $domain,
                             search => $search,
                             reason => $reason};
  }
  my @sortedPrefixes = sort { 
                         if (($a->{'search'} cmp $b->{'search'}) == 0){
                           return (lc($a->{'reason'}) cmp lc ($b->{'reason'}));
                         }
                         return ($a->{'search'} cmp $b->{'search'});
                       } @formattedPrefixes;

  my %var = (  'LIST' => $list_name,
               'DATA' => \@sortedPrefixes,
            );
  return ($tmpl, %var);  
}

#
# Add Handler template
#
sub AddHandler
{
  my $cgi = shift;
  my $list = $cgi->param($_LIST_STRING);
  my $tmpl =  'add.tt';
  my %var = ('LIST' => $list);
  return ($tmpl, %var);  
}

#
# Add Stock Ticker Handler template
#
sub AddInputHandler
{
  my $cgi = shift;
  my $type= $cgi->param($_INPUT_TYPE_STRING);
  my $list = $cgi->param($_LIST_STRING);
  
  my %var = ('LIST' => $list );
  # check type
  if ($type eq $_STOCK_TICKER_INPUT)
  {
    my $tmpl =  'addticker.tt';
    return ($tmpl, %var);  
  }
  elsif ($type eq $_COMPANY_NAME_INPUT)
  {
    my $tmpl = 'addcompany.tt';
    return ($tmpl, %var);  
  }
  elsif ($type eq $_DOMAIN_NAME_INPUT)
  {
    my $tmpl = 'adddomain.tt';
    return ($tmpl, %var);  
  }
  else
  {
    return 'error.tt'; 
  }
}

sub ShowTickerHandler
{
  my $cgi = shift;
  my $list = $cgi->param($_LIST_STRING);
  my $value = $cgi->param($_INPUT_VALUE_STRING);
  
  # convert stock ticker to company
  my $company, my $domain;
  ($company, $domain) = BGPmon::CPM::Demo::getConvertStockTicker($value);
  
  my $tmpl = 'showticker.tt';

  my %var = (  'LIST' => $list,
               'TICKER' => $value,
               'COMPANY' => $company,
	       'DOMAIN' => $domain
            );
  
  return ($tmpl, %var);  
}
	
sub ProcessTickerHandler
{
  my $cgi = shift;
  my $list = $cgi->param($_LIST_STRING);
  my $company = $cgi->param($_COMPANY_NAME_INPUT);
  my $newdomain =  $cgi->param($_DOMAIN_NAME_INPUT);
  my $tmpl = 'processticker.tt';

  # add domain prefixes
  if (defined($newdomain))
  {
    BGPmon::CPM::Demo::addNewDomain($list, $newdomain);
  }
  
  # get list of available company names
  my @companies =   BGPmon::CPM::Demo::getCompanies($company);

  my %var = (  'LIST' => $list,
	       'COMPANIES' => \@companies
            );
  
  return ($tmpl, %var);  
}

sub ShowCompanyHandler
{
  my $cgi = shift;
  my $tmpl = 'showcompany.tt';
  
  my $list = $cgi->param($_LIST_STRING);
  my $company = $cgi->param($_INPUT_VALUE_STRING);
  
  # get list of available company names
  my @companies =   BGPmon::CPM::Demo::getCompanies($company);

  my %var = (  'LIST' => $list,
	       'COMPANIES' => \@companies
            );
  
  return ($tmpl, %var);  
}

sub ProcessCompanyHandler
{
  my $cgi = shift;
  my $tmpl = 'processcompany.tt';
  
  my $value = "Example LTD";
  my @prefix_array = BGPmon::CPM::Demo::getDomainPrefixes();
  my $num = scalar (@prefix_array);
  
  my %var = (  'NUM' => $num,
               'COMPANY' => $value,
	       'DATA' => \@prefix_array
            );
  
  return ($tmpl, %var);  
}
 
sub ShowDeleteHandler
{
  my $cgi = shift;
  my $tmpl = 'showdelete.tt';
  
  my $list = $cgi->param($_LIST_STRING);
  my $params = $cgi->Vars;
  my @prefixes;
  if ($params)
  {
    @prefixes = split("\0", $params->{$_PREFIX_NAME_INPUT});
  }
  my $num = scalar(@prefixes);
  
  my %var = (  'LIST' => $list,
               'NUM' => $num,
	       'PREFIXES' => \@prefixes
            );
  
  return ($tmpl, %var);  
}

sub ProcessDeleteHandler
{
  my $cgi = shift;
  my $tmpl = 'processdelete.tt'; # go to view page
  my $list = $cgi->param($_LIST_STRING);
  
  my $num;
  my $params = $cgi->Vars;
  if ($params)
  {
    my @prefixes = split("\0", $params->{$_PREFIX_NAME_INPUT});
    if (@prefixes)
    {
      $num = scalar(@prefixes);
      foreach my $pref (@prefixes)
      {
        BGPmon::CPM::Demo::deletePrefix($list, $pref); 
      }    
    }
  }

  my %var = (  'LIST' => $list,
            );
  
  return ($tmpl, %var);  
}

sub ExportListHandler
{
  my $cgi = shift;
  my $tmpl = 'exportcsv.tt';
  my $list = $cgi->param($_LIST_STRING);
  
  my @arr = BGPmon::CPM::PList::Manager->export2CSV($list);

  my %var = (  'LIST' => $list,
  	       'DATA'  => \@arr
            );
  
  return ($tmpl,%var);  
}

sub UnDevelopHandler
{
    return 'undevelop.tt'; 
}

sub uniq{
  return keys %{{ map { $_ => 1 } @_ }};
}