#!/usr/bin/perl
#======================================================================
# guestbook.cgi
#-----------
# This web application will display and maintain a guestbook
#======================================================================
use strict;
use CGI qw(:standard :html);
use CGI::Carp qw( fatalsToBrowser );
use Mail::Sendmail;
use Mail::CheckUser qw( check_email );

# Identify the files to be used
#------------------------------------------------------------
my $F_TMPL = "gb_template.dat";
my $F_ENTR = "gb_entries.dat";

my $CGI_HDR = "Content-type: text/html\n\n";

# Load data from the template file
#------------------------------------------------------------
my %site = load_tmpl( $F_TMPL );

# Load data from the entries file
#------------------------------------------------------------
my( %entries ) = load_entr( $F_ENTR );

# Capture a passed argument
#------------------------------------------------------------
my( $arg, undef ) = @ARGV;

# Send a new admin key to the owner when requested
#----------------------------------------------------------------------
if ( $arg eq "admin" ) {
  print $CGI_HDR . send_adky( $site{'title'}, $site{'template'}, $site{'owner_email'} );
}

# Invoke the admin page
#----------------------------------------------------------------------
elsif ( $arg =~ m/^adky:/ ) {
  print $CGI_HDR . admin( $site{'title'}, $site{'template'}, $arg );
}

# Display the complete message
#----------------------------------------------------------------------
elsif ( ( $arg ne "" ) and ( $arg != 0 ) ) {
  print $CGI_HDR . detail( $site{'title'}, $site{'template'}, $entries{ $arg } );
}

# Define the action button names
#----------------------------------------------------------------------
my %button_from_page = ( display    => "Sign",
                         enter_item => "Add New Signature" );

# The sign button has been pressed on the display page
#----------------------------------------------------------------------
if ( param( 'action' ) eq $button_from_page{ 'display' } ) {
  print $CGI_HDR
      . enter_item( $site{'title'}, $site{'template'},
                    "Add new signature",
                    $button_from_page{ 'enter_item' } );
}

# The add button has been pressed on the enter page
#----------------------------------------------------------------------
elsif ( param( 'action' ) eq $button_from_page{ 'enter_item' } ) {
  print $CGI_HDR
      . add_item( $site{'title'}, $F_ENTR, $site{'owner_email'}, $site{'notify'}, $site{'approval'}, $site{'template'} );
}

# Default to summarized display of entries
#----------------------------------------------------------------------
else {
  print $CGI_HDR
      . display( $site{'title'},
                 $site{'template'},
		 $button_from_page{ 'display' },
                 $site{'font'},
		 %entries );
}

###
### # The edit button has been pressed on the general listing page
### #----------------------------------------------------------------------
### elsif ( param( 'action' ) eq "Edit" ) {
###   print identify( "Select items to edit", "Edit Selected Items", %conn_args );
### }
###
### # The edit button has been pressed on the identify page
### #----------------------------------------------------------------------
### elsif ( param( 'action' ) eq "Edit Selected Items" ) {
###   print edit( %conn_args );
### }
###
### # The save button has been pressed on the edit page
### #----------------------------------------------------------------------
### elsif ( param( 'action' ) eq "Save Changes" ) {
###   print update_items( $JNLPFILE, $jnlp_prefix, $jnlp_suffix, %conn_args );
### }
###
### # The delete button has been pressed on the general listing page
### #----------------------------------------------------------------------
### elsif ( param( 'action' ) eq "Delete" ) {
###   print identify( "Select items to delete", "Delete Selected Items",
###     %conn_args );
### }
###
### # The delete button has been pressed on the identify page
### #----------------------------------------------------------------------
### elsif ( param( 'action' ) eq "Delete Selected Items" ) {
###   print verify( "Verify items to delete", %conn_args );
### }
###
### # The confirm button has been pressed on the verify page
### #----------------------------------------------------------------------
### elsif ( param( 'action' ) eq "Confirm Delete" ) {
###   print delete_items(
###     $email_address, $smtp_server, $JNLPFILE,
###     $jnlp_prefix,   $jnlp_suffix, %conn_args
###   );
### }
###
### # Default to summarized display of entries
### #----------------------------------------------------------------------
### else {
###   print display( $page, %entries );
### }
### }
#======================================================================
# add_item.pl
#--------------
# This subroutine reads the new entry information from a parameter in
# the web page, adds it to the guestbook entries file
#
#  $ENV{'HTTP_REFERER'}
#
# The parameters expected are:
#   string - title
#   string - the name of the entries file
#   string - owner's email address
#   flag   - notify the owner
#   string - web page template
#
# The returned value are:
#   web page to show that the jnlp file has been updated.
#
# Other data output (conditional):
#   An email to owner about the new post
#======================================================================
sub add_item {

  my( $title, $F_ENTR, $owner_email, $notify, $approval, $tmpl ) = @_;
  my $content = "";
  my $body    = "";

  # Get the entered data
  #------------------------------------------------------------
  my $name      = param( 'name' );
  my $address   = param( 'address' );
  my $hide_addr = param( 'hide_addr' );
  my $hide      = "no";
  if ( param( 'hide_addr' ) ) {
    $hide = "yes";
  }
  my $webpage = param( 'webpage' );
  $webpage =~ s/..*\/\///;
  my $message = param( 'message' );
  my $msg     = $message;
  $message =~ s/\n/<br>/g;
  $msg     =~ s/\n//g;

  my $error_pre = "<font color=red>ERROR</font> - ";
  my $error_msg = "";
  if ( $name eq "" ) {
    $error_msg .= $error_pre . "Name is required<br>\n";
  }
  if ( $address eq "" ) {
    $error_msg .= $error_pre . "Email address is required<br>\n";
  }
  else {
    if ( not check_email( $address ) ) {
      $error_msg .= $error_pre . "Email address is invalid<br>\n";
    }
  }
  if ( $message eq "" ) {
    $error_msg .= $error_pre . "A message is required<br>\n";
  }

  if ( $error_msg eq "" ) {

    # add the new entry to the file
    #------------------------------------------------------------
    my $ENTRFMT = "%d
%d
%s
%s
%d
%s
%s\n";
    open( ENTR, ">> $F_ENTR" )
        or die "Could not open $F_ENTR - $!";
    print ENTR sprintf( $ENTRFMT,
                        time(), ( not $approval ), $name, $address,
                        ( $hide_addr eq "on" ),
                        $webpage, $msg );
    close ENTR;

    # Assemble and send the email
    #------------------------------------------------------------
    $body =
          "<body bgcolor=\"#D1A1F6\" text=\"#000000\">\n"
        . "<h3>New addition to your Guest Book</h3>\n"
        . "<table cellspacing=5>"
        . mytr( mytd( "align=right", "Name" ),          mytd( $name ) )
        . mytr( mytd( "align=right", "Email address" ), mytd( $address ) )
        . mytr( mytd( "align=right", "Hide address" ),  mytd( $hide ) )
        . mytr( mytd( "align=right", "Web page" ),      mytd( $webpage ) )
        . mytr( mytd( "valign=top align=right", "Message" ), mytd( $message ) )
        . "</table></body>";

    my %mail = ( 'content-type' => 'text/html; charset="iso=8859-1"',
                 from           => $ENV{ 'SERVER_ADMIN' },
                 to             => $owner_email,
                 subject        => "New addition to your guestbook",
                 body           => $body );
    sendmail( %mail ) or die $Mail::Sendmail::error;

    $content = "<h3>Thank you</h3>";
  }
  else {
    $content =
          "<h3>Errors were detected</h3>\n"
        . $error_msg
        . "<br>Please use the \"Back\" button and correct these issues";
  }

  $tmpl =~ s/:::TITLE:::/$title/;
  $tmpl =~ s/:::SUBTITLE:::/Guest Book/;
  $tmpl =~ s/:::CONTENT:::/$content/;
  $tmpl;
}

#======================================================================
# cohdr.pl
#----------
# This subroutine returns an html page header tailored for FutureTrade.
#
# The parameters expected are:
#  string - page title
#  string - display name for support
#  string - email address for support
#
# The returned values are:
#  html page header
#======================================================================
sub cohdr {

  my( $title, $name, $address ) = @_;

  # Create a default title
  #------------------------------------------------------------
  if ( $title eq "" ) {
    $title = "Engineering";
  }

  # Create a default support name
  #------------------------------------------------------------
  if ( $name eq "" ) {
    $name = "CBR";
  }

  # Create a default support email address
  #------------------------------------------------------------
  if ( $address eq "" ) {
    $address = "builder\@engweb.futuretrade.com";
  }

  # Create the html link
  #------------------------------------------------------------
  my $link =
      "<a href=\"mailto:$address?subject='" . $title . "'\">" . $name . "</a>";

  # Return the html code
  #------------------------------------------------------------
  "<HTML>
  <HEAD>
    <TITLE>$title</TITLE>
  </HEAD>
  <BODY BGCOLOR=white>
    <IMG SRC=/ftt_images/ftt_logo.jpg ALT=\"FutureTrade Technologies\" HSPACE=25 ALIGN=LEFT>
  <H3>$title</H3>
  <CENTER>
    <P>Please forward any questions or comments to <I>$link</I></P>
  </CENTER>
<HR>";

}

#======================================================================
# confirm.pl
#--------------
# This subroutine collects and validates the newly entered parameters
# and creates a confirmation web page.
#
# The parameter expected is a hash keyed data structure - conn_args
#
# The returned values are:
#  web page requesting a confirmation from the user
#======================================================================
sub confirm {

  my( %conn_args ) = @_;

  # Retrieve the previous form parameters
  #------------------------------------------------------------
  my $save_button = "";
  my $protocol    = param( 'protocol' );
  my $address     = param( 'address' );
  my $port        = param( 'port' );
  my $description = param( 'description' );

  # make sure that the field separator is not input by the user
  #------------------------------------------------------------
  $address     =~ s/://g;
  $port        =~ s/://g;
  $description =~ s/://g;

  # Check for a blank address
  #------------------------------------------------------------
  my $errormsg = "";
  if ( $address eq "" ) {
    $errormsg .= "<br><font color=red>Error</font> - System address required";
  }
  elsif ( $address =~ m/[^[:alnum:]\.]/ ) {
    $errormsg .= "<br><font color=red>Error</font> - Invalid System Address";
  }

  # Check for a non-numeric port
  #------------------------------------------------------------
  if ( $port eq "" ) {
    $errormsg .= "<br><font color=red>Error</font> - Port Number Required";
  }
  elsif ( $port =~ m/[^[:digit:]]/ ) {
    $errormsg .= "<br><font color=red>Error</font> - Invalid Port Number";
  }

  # Check for a blank description
  #------------------------------------------------------------
  if ( $description eq "" ) {
    $errormsg .= "<br><font color=red>Error</font> - Description required";
  }

  # No errors - allow save
  #------------------------------------------------------------
  if ( $errormsg eq "" ) {
    $save_button = submit( -name => 'action', -value => "Save" );
  }

  # Create a hash index for the new entry
  #------------------------------------------------------------
  my $index = "";
  if ( $address =~ m/\d+\.\d+\.\d+\.\d+/ ) {
    my @tmp = split( /\./, $address );
    $index = sprintf( "%05d%05d%05d%05d%06d",
                      $tmp[ 0 ], $tmp[ 1 ], $tmp[ 2 ], $tmp[ 3 ], $port );
  }
  else {
    $index = sprintf( "%s%06d", $address, $port );
  }

  # Check for a pre-existing entry
  #------------------------------------------------------------
  my $act = "Addition";
  if ( defined $conn_args{ $index } ) {
    $act = "Replacement";
  }
  my $page_instructions = "Confirm $act";

  # Generate a confirmation web page
  #------------------------------------------------------------
  my $page =
        header()
      . cohdr( "Connectivity Check" )
      . "<h3>$page_instructions</h3>"
      . $errormsg
      . start_form()
      . "<center><table width=80% cellpadding=5 cellspacing=0 border=0>\n"
      . mytr( myth( "bgcolor=cyan", "Protocol" ),
              myth( "bgcolor=cyan", "System address" ),
              myth( "bgcolor=cyan", "Port" ),
              myth( "bgcolor=cyan", "Description" ) )
      . mytr( mytd( $protocol ),
              mytd( $address ),
              mytd( $port ),
              mytd( $description ) );

  # Append the old value if there is one
  #------------------------------------------------------------
  if ( $act eq "Replacement" ) {
    $page .= mytr( mytd( "colspan=4", "Will replace" ) )
        . mytr( mytd( $conn_args{ $index }{ 'protocol' } ),
                mytd( $conn_args{ $index }{ 'address' } ),
                mytd( $conn_args{ $index }{ 'port' } ),
                mytd( $conn_args{ $index }{ 'description' } ) );
  }

  $page .= "</table></center>\n" . $save_button
      . hidden( 'new_item',
                $protocol . "
" . $address . "
" . $port . "
" . $description )
      . end_form()
      . end_html();
}

#======================================================================
# delete_items.pl
#-----------------
# This subroutine reads the deleted entries information from a
# parameter in the identify web page, compares the list to each item
# in the arguments data structure, deleting those that match.
#
# The parameters expected are:
#    the path/filename of the conn_check.jnlp
#    the contents of the jnlp prior to the arguments list
#    the contents of the jnlp after the arguments list
#    hash indexed arguments data structure
#
# The returned value are:
#   web page to show that the jnlp file has been updated.
#
# Other data output:
#   An email to the SCM group with the newly updated jnlp file attached
#======================================================================
sub delete_items {

  my( $email_address, $smtp_server, $JNLPFILE,
      $jnlp_prefix,   $jnlp_suffix, %conn_args )
      = @_;

  # Initialize some local variables
  #------------------------------------------------------------
  my $deleted_items = "";
  my $itemfmt       = "  %6s %s:%d %s\n";
  my $item_list     = param( 'item_list' );

  # Check argument entries against the deleted list
  #------------------------------------------------------------
  foreach my $item ( sort keys %conn_args ) {
    if ( $item_list =~ m/$item/ ) {
      $deleted_items .= sprintf( $itemfmt,
                                 $conn_args{ $item }{ 'protocol' },
                                 $conn_args{ $item }{ 'address' },
                                 $conn_args{ $item }{ 'port' },
                                 $conn_args{ $item }{ 'description' } );
      delete $conn_args{ $item };
    }
  }

  # Write the new jnlp file
  #------------------------------------------------------------
  save_jnlp( $smtp_server, $JNLPFILE, $jnlp_prefix, $jnlp_suffix, %conn_args );

  # Assemble and send the email
  #------------------------------------------------------------
  my %mail = (
    smtp           => $smtp_server,
    'content-type' => "text/plain; charset=\"iso-8859-1\"",
    from           => "conck.cgi\@" . &hostname . ".futuretrade.com",
    to             => $email_address,
    subject        => "Update of connectivity check jnlp",
    body           =>
"Updated conn_check.jnlp\n\nRemoved the following items:\n$deleted_items" );
  sendmail( %mail ) or die $Mail::Sendmail::error;

  # Return notification web page
  #------------------------------------------------------------
  my $page =
        header()
      . cohdr( "Connectivity Check" )
      . "<h3>conn_check.jnlp Updated</h3>"
      . "An email has been sent with the new jnlp file to SCM"
      . end_html();
}

#======================================================================
# display.pl
#------------
# This subroutine formats an html table of the guestbook entries
#
# The parameters expected:
#   string - title
#   string - page template
#   hash indexed entries data structure
#
# The returned value are:
#   web page
#======================================================================
sub display {

  my( $title, $tmpl, $button, $font, %entries ) = @_;

  # Assemble the web page header and the table header
  #------------------------------------------------------------
  my $content = start_form();

  $content .= submit( -name => 'action', -value => $button );

  # Create a table row for each argument
  #------------------------------------------------------------
  my $cntr = 0;
  foreach my $item ( reverse sort keys %entries ) {
    if ( $entries{ $item }{ 'approved' } ) {
      $cntr++;
      my $name = "<font $font>" . $entries{ $item }{ 'name' } . "</font>";
      if ( not $entries{ $item }{ 'hide' } ) {
        my $addr = $entries{ $item }{ 'email' };
        my $subj = "subject='" . $title . " Guest Book'";
        $name = "<a href=\"mailto:$addr?$subj\">$name</a>";
      }
      my $web_link = "";
      if ( $entries{ $item }{ 'webpage' } ne "" ) {
        $web_link =
            "<a href=\"http://$entries{ $item }{'webpage'}\"><font $font>Web Page</font></a>";
      }
      my $msg = "<font $font>" . $entries{ $item }{ 'message' } . "</font>";
      $msg =~ s//<br>/g;

      $content .= "<table border=0 cellpadding=5 width=80%>"
          . mytr( mytd( "width=40%",              $name ),
                  mytd( "width=20% align=center", $web_link ),
                  mytd( "width=40% align=right",  "<font $font>" . format_date( $item ) . "</font>" ) )
          . mytr( mytd( "colspan=3", $msg ) )
          . "</table>\n";
      if ( scalar( keys %entries ) > 1 ) {
        $content .= "<hr width=90%>";
      }
    }
  }

  # Close the table and append the page footer
  #------------------------------------------------------------
  if ( $cntr > 5 ) {
    $content .= "<center>"
        . submit( -name => 'action', -value => $button )
        . "</center>\n";
  }
  $content .= end_form();
  $tmpl =~ s/:::TITLE:::/$title/;
  $tmpl =~ s/:::SUBTITLE:::/Guest Book/;
  $tmpl =~ s/:::CONTENT:::/$content/;

  $tmpl;
}

#======================================================================
# enter_item.pl
#---------------
# This subroutine creates a fill-in form to enter a new guestbook entry
#
# The parameters expected are:
#   string - title
#   string - page template
#   string - the subtitle - instruction for the page
#   string - the name of the action to be processed by the submit button
#
# The returned value are:
#   web form to enter new argument values
#======================================================================
sub enter_item {

  my( $title, $tmpl, $page_instructions, $action ) = @_;

  my $content =
      "<h3>$page_instructions</h3>" . start_form() . "<center><table>\n"
      . mytr( mytd( "align=right", "Name" ),
              mytd( "colspan=2",
                    textfield( -name    => 'name',
                               -default => "",
                               -size    => 35 ) ) )
      . mytr( mytd( "align=right", "Email Address" ),
              mytd( textfield( -name    => 'address',
                               -default => "",
                               -size    => 35 ) ),
              mytd( " ",
                    checkbox( -name    => 'hide_addr',
                              -checked => 0,
                              -label   => "" ),
                    "Hide your address" ) )
      . mytr( mytd( "align=right", "Web Page" ),
              mytd( "colspan=2",
                    "http://",
                    textfield( -name    => 'webpage',
                               -default => "",
                               -size    => 60 ) ) )
      . mytr( mytd( "valign=top align=right", "Message" ),
              mytd( "colspan=2",
                    textarea( -name    => 'message',
                              -default => "",
                              -rows    => 10,
                              -columns => 50 ) ) )
      . "</table></center>\n"
      . submit( -name => 'action', -value => $action )
      . end_form();

  # foreach my $item ( sort keys %ENV ) {
  #   $content .= "$item -> $ENV{$item}<br>\n";
  # }
  $tmpl =~ s/:::TITLE:::/$title/;
  $tmpl =~ s/:::SUBTITLE:::/Guest Book/;
  $tmpl =~ s/:::CONTENT:::/$content/;
  $tmpl;
}

#======================================================================
# format_date
#======================================================================
sub format_date {
  my( $date ) = @_;
  my @months = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun",
                 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );
  if ( $date != 0 ) {
    my( $sc, $mn, $hr, $dy, $mon, $yr, $wday, $ydat, $isdst ) =
        localtime( $date );
    $yr += 1900;
    my $ampm = "am";
    if ( $hr == 0 ) {
      $hr = 12;
    }
    elsif ( $hr == 12 ) {
      $ampm = "pm";
    }
    elsif ( $hr > 12 ) {
      $hr -= 12;
      $ampm = "pm";
    }
    $date = sprintf( "%s %d, %d %2d:%02d %s",
                     $months[ $mon ],
                     $dy, $yr, $hr, $mn, $ampm );
  }
  else {
    $date = "";
  }
  $date;
}

#======================================================================
# hostname.pl
#-------------
# This subroutine retrieves the hostname from the system
#
# The returned value is:
#   string - hostname
#======================================================================
sub hostname {

  # Check the perl environment variable
  #------------------------------------------------------------
  my $hostname = $ENV{ 'HOSTNAME' };

  # Retrieve the hostname from the system uname utility
  #------------------------------------------------------------
  if ( $hostname eq "" ) {
    open( CMDOUT, "uname -n |" )
        or die "Could not execute 'uname -n' - $!";
    $hostname = <CMDOUT>;
    chomp $hostname;
    close CMDOUT;
  }

  # Remove up potential extra trailing characters
  #------------------------------------------------------------
  $hostname =~ s/\..*//;
  $hostname =~ tr/A-Z/a-z/;

  $hostname;
}

#======================================================================
# html_tables.pl
#----------------
# This file contains a few minor subroutines to make generating html
# tables with a perl script a little easier to read
#======================================================================
#------------------------------------------------------------
# myth
#   embed all of the parameters within a html table row field
#------------------------------------------------------------
sub mytr {
  "<tr>" . join( '', @_ ) . "</tr>\n";
}

#------------------------------------------------------------
# myth
#   embed the parameter within a html table header field
#   if there are more than one parameters - use the first as
#   a characteristic modification to the header field
#------------------------------------------------------------
sub myth {
  my( $p1, @tmp ) = @_;
  my( $char, $val ) = ( "", "" );
  if ( @tmp == 0 ) {
    $val = $p1;
  }
  else {
    $char = " $p1";
    $val = join( '', @tmp );
  }
  "<th$char>" . $val . "</th>\n";
}

#------------------------------------------------------------
# mytd
#   embed the parameter within a html table data field
#   if there are more than one parameters - use the first as
#   a characteristic modification to the data field
#------------------------------------------------------------
sub mytd {
  my( $p1, @tmp ) = @_;
  my( $char, $val ) = ( "", "" );
  if ( @tmp == 0 ) {
    $val = $p1;
  }
  else {
    $char = " $p1";
    $val = join( '', @tmp );
  }
  "<td$char>" . $val . "</td>\n";
}

#======================================================================
# identify.pl
#--------------
# This subroutine creates a web form with checkboxes so the user can
# select arguments
#
# The parameters expected are:
#   the subtitle - instruction for the page
#   the name of the action to be processed by the submit button
#   hash indexed arguments data structure
#
# The returned value are:
#   web form to select argument entries
#======================================================================
sub identify {

  my( $page_instructions, $action, %conn_args ) = @_;

  # Assemble the web page header and the table header
  #------------------------------------------------------------
  my $page =
        header()
      . cohdr( "Connectivity Check" )
      . "<h3>$page_instructions</h3>"
      . start_form()
      . "<center><table width=80% cellpadding=5 cellspacing=0 border=0>\n"
      . mytr( myth( "bgcolor=cyan colspan=2", " " ),
              myth( "bgcolor=cyan",           "Protocol" ),
              myth( "bgcolor=cyan",           "System address" ),
              myth( "bgcolor=cyan",           "Port" ),
              myth( "bgcolor=cyan",           "Description" ) );

  # Create a table row for each argument with a checkbox
  #------------------------------------------------------------
  my $cntr = 0;
  foreach my $item ( sort keys %conn_args ) {
    $cntr++;
    $page .= mytr( mytd( checkbox( -name    => $item,
                                   -checked => 0,
                                   -label   => "" ) ),
                   mytd( "align=right", $cntr ),
                   mytd( $conn_args{ $item }{ 'protocol' } ),
                   mytd( $conn_args{ $item }{ 'address' } ),
                   mytd( $conn_args{ $item }{ 'port' } ),
                   mytd( $conn_args{ $item }{ 'description' } ) );
    if ( $cntr % 5 == 0 ) {
      $page .= mytr( mytd( "colspan=6", "<hr>" ) );
    }
  }

  # Close the table and add the page footer
  #------------------------------------------------------------
  $page .=
        "</table></center>\n"
      . submit( -name => 'action', -value => $action )
      . end_form()
      . end_html();
}

#======================================================================
# load_entr.pl
#--------------
# This subroutine reads the gb_entries.dat file
#
# The parameter expected is the path/filename of the entries file
#
# The returned values are:
#   hash keyed structure - entries
#======================================================================
sub load_entr {

  my( $F_ENTR ) = @_;

  # Initialize the return variable
  #------------------------------------------------------------
  my %entries = ();

  # Open the entries file and process each line
  #------------------------------------------------------------
  if ( -f $F_ENTR ) {
    open( ENTR, "< $F_ENTR" )
        or die "Cound not open $F_ENTR - $!";
    foreach my $item ( <ENTR> ) {
      my( $index, $approved, $name, $email, $hide, $webpage, $message ) =
          split( /
/, $item );
      $entries{ $index } = { 'approved' => $approved,
                             'name'     => $name,
                             'email'    => $email,
                             'hide'     => $hide,
                             'webpage'  => $webpage,
                             'message'  => $message };

    }
    close ENTR;
  }

  %entries;
}

#======================================================================
# load_tmpl.pl
#--------------
# This subroutine reads the gb_template.dat file
#
# The parameter expected is the path/filename of the template file
#
# The returned values are:
#   hash structure of: 
#     title       => string - site title
#     owner_email => string - owner's email address
#     admin_email => string - admin's email address
#     notify      => flag   - owner notification required
#     approval    => flag   - owner notification required
#     font        => string - display font
#     template    => string - web page template
#======================================================================
sub load_tmpl {

  my( $F_TMPL ) = @_;

  # Initialize the return variables
  #------------------------------------------------------------
  my %site = ();
  $site{'title'}       = "";
  $site{'owner_email'} = "";
  $site{'admin_email'} = "";
  $site{'notify'}      = 0;
  $site{'approval'}    = 0;
  $site{'font'}        = "";
  $site{'template'}    = "";


  # Open the template file and process each line
  #------------------------------------------------------------
  open( TMPL, "< $F_TMPL" )
      or die "Cound not open $F_TMPL - $!";
  foreach my $item ( <TMPL> ) {

    # check for specific attributes
    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    if ( $item =~ m/^<! TITLE: / ) {
      chomp $item;
      $site{'title'} = $item;
      $site{'title'} =~ s/..*: //;
      $site{'title'} =~ s/\s*>//;
    }
    elsif ( $item =~ m/^<! OWNER: / ) {
      chomp $item;
      $site{'owner_email'} = $item;
      $site{'owner_email'} =~ s/..*: //;
      $site{'owner_email'} =~ s/\s*>//;
    }
    elsif ( $item =~ m/^<! ADMIN: / ) {
      chomp $item;
      $site{'admin_email'} = $item;
      $site{'admin_email'} =~ s/..*: //;
      $site{'admin_email'} =~ s/\s*>//;
    }
    elsif ( $item =~ m/^<! NOTIFY: / ) {
      chomp $item;
      $site{'notify'} = $item;
      $site{'notify'} =~ s/..*: //;
      $site{'notify'} =~ s/\s*>//;
      $site{'notify'} =~ tr/A-Z/a-z/;
      if ( $site{'notify'} eq "on" ) {
        $site{'notify'} = 1;
      }
    }
    elsif ( $item =~ m/^<! APPROVAL: / ) {
      chomp $item;
      $site{'approval'} = $item;
      $site{'approval'} =~ s/..*: //;
      $site{'approval'} =~ s/\s*>//;
      $site{'approval'} =~ tr/A-Z/a-z/;
      if ( $site{'approval'} eq "on" ) {
        $site{'approval'} = 1;
      }
      else {
        $site{'approval'} = 0;
      }
    }
    elsif ( $item =~ m/^<! FONT: / ) {
      chomp $item;
      $site{'font'} = $item;
      $site{'font'} =~ s/..*: //;
      $site{'font'} =~ s/\s*>//;
    }
    else {
      $site{'template'} .= $item;
    }
  }
  close TMPL;

  %site;
}

#======================================================================
# save_jnlp.pl
#--------------
# This subroutine archives the existing conn_check.jnlp file then
# writes the updated arguments into a new conn_check.jnlp file
#
# The parameters expected are:
#    the path/filename of the conn_check.jnlp
#    the contents of the jnlp prior to the arguments list
#    the contents of the jnlp after the arguments list
#    hash indexed arguments data structure
#
# There are no returned values
#
# Other data output:
#   An email to the SCM group with the newly updated jnlp file attached
#======================================================================

sub save_jnlp {

  my( $smtp_server, $JNLPFILE, $jnlp_prefix, $jnlp_suffix, %conn_args ) = @_;

  # Get the date/time from the system for an archive file name
  #------------------------------------------------------------
  my( $sc, $mn, $hr, $dy, $mon, $yr, $wday, $ydat, $isdst ) = localtime();
  my $date_suffix = sprintf( "%4d%02d%02d_%02d%02d",
                             ( $yr + 1900 ),
                             ( $mon + 1 ),
                             $dy, $hr, $mn );
  my $new_filename = $JNLPFILE;
  $new_filename =~ s/\.jnlp$//;
  $new_filename = $new_filename . "_$date_suffix" . ".jnlp";

  # Move the existing file out of the way
  #------------------------------------------------------------
  rename $JNLPFILE, $new_filename
      or die "Could not rename $JNLPFILE to new_filename - $!";

  # Limit the number of archived files
  #------------------------------------------------------------
  my $jnlpdir = ".";
  if ( $JNLPFILE =~ m/\// ) {
    $jnlpdir = $JNLPFILE;
    $jnlpdir =~ s/\/[^\/]*//;
  }
  opendir( JDIR, $jnlpdir )
      or die "Could not read directory $jnlpdir - $!";
  my @jnlp_filelist = grep( /conn_check_/, sort readdir( JDIR ) );
  closedir JDIR;
  while ( @jnlp_filelist > 10 ) {
    my $killfile = shift @jnlp_filelist;
    unlink "$jnlpdir/$killfile"
        or die "Could not remove $jnlpdir/$killfile - $!";
  }

  # Assemble the contents of the new jnlp file
  #------------------------------------------------------------
  my $argfmt = "    <argument>%s:%s:%s:%s</argument>\n";
  my $jnlp   = $jnlp_prefix;
  foreach my $item ( sort keys %conn_args ) {
    $jnlp .= sprintf( $argfmt,
                      $conn_args{ $item }{ 'protocol' },
                      $conn_args{ $item }{ 'address' },
                      $conn_args{ $item }{ 'port' },
                      $conn_args{ $item }{ 'description' } );
  }
  $jnlp .= $jnlp_suffix;

  # Create a new jnlp file
  #------------------------------------------------------------
  open( NEWJNLP, "> $JNLPFILE" )
      or die "Could not open $JNLPFILE to write - $!";
  print NEWJNLP $jnlp;
  close NEWJNLP;
  chmod 0666, $JNLPFILE;

  # Tidy up the contents to be attached to an email
  # NOTE: This step is necessary because of the manipulation
  #       of the attached file.  Some of the contents get
  #       mangled.
  #------------------------------------------------------------
  $jnlp =~ s/="/=\\\\"/g;

  # Assemble the email message and the attachement
  #------------------------------------------------------------
  my $boundary = "====" . time() . "====";
  my %mail = ( smtp           => $smtp_server,
               'content-type' => "multipart/mixed; boundary=\"$boundary\"",
               from           => "conck.cgi\@" . &hostname . ".futuretrade.com",
               to             => "vpeets\@futuretrade.com",
               subject        => "Update of connectivity check jnlp", );
  $boundary = '--' . $boundary;
  $mail{ body } = <<EOB;
$boundary
Content-Type: text/plain; charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable

Updated conn_check.jnlp

$boundary
Content-Type: text/plain; name="conn_check.jnlp"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment; filename="conn_check.jnlp"

$jnlp
$boundary--
EOB

  # Send the email
  #------------------------------------------------------------
  sendmail( %mail ) or die $Mail::Sendmail::error;

}

#======================================================================
# verify.pl
#--------------
# This subroutine creates a list of arguments and creates a web page
# for verification.
#
# The parameters expected are:
#    the subtitle - instruction for the page
#    hash indexed arguments data structure
#
# The returned value are:
#   web page requesting verification
#======================================================================
sub verify {

  my( $page_instructions, %conn_args ) = @_;

  # Examine the check boxes for selected items
  #------------------------------------------------------------
  my $selected_count = 0;
  my $cntr           = 0;
  my $item_list      = "";
  my $selected_items = "";
  foreach my $item ( sort keys %conn_args ) {
    $cntr++;
    if ( param( $item ) ne "" ) {
      $selected_count++;
      $selected_items .= mytr( mytd( "align=right", $cntr ),
                               mytd( $conn_args{ $item }{ 'protocol' } ),
                               mytd( $conn_args{ $item }{ 'address' } ),
                               mytd( $conn_args{ $item }{ 'port' } ),
                               mytd( $conn_args{ $item }{ 'description' } ) );
      if ( $item_list eq "" ) {
        $item_list = $item;
      }
      else {
        $item_list .= "
$item";
      }
    }
  }

  # Assemble the web page header and the table header
  #------------------------------------------------------------
  my $page = header() . cohdr( "Connectivity Check" );

  if ( $selected_count == 0 ) {
    $page .= "<h3>No arguments selected</h3>";
  }
  else {
    $page .=
          "<h3>$page_instructions</h3>"
        . start_form()
        . "<center><table width=80% cellpadding=5 cellspacing=0 border=0>\n"
        . mytr( myth( "bgcolor=cyan", " " ),
                myth( "bgcolor=cyan", "Protocol" ),
                myth( "bgcolor=cyan", "System address" ),
                myth( "bgcolor=cyan", "Port" ),
                myth( "bgcolor=cyan", "Description" ) )
        . $selected_items
        . "</table></center>\n"
        . submit( -name => 'action', -value => "Confirm Delete" )
        . hidden( 'item_list', $item_list )
        . end_form();

  }

  # Add the page footer
  #------------------------------------------------------------
  $page .= end_html();
}