#!perl
#
#-----------------------------------------------------------------------
#
# is_formmail.pl: script for sending mail via the web
#
# is_formmail.pl sends email messages to a specified email address from
# a web page. It may be accessed as a script or the HTML form that it
# uses may be copied, modified, and pasted into a web page. The form
# will run the script when it is submitted by clicking 'Submit'.
#
#-----------------------------------------------------------------------
#
# isformmail_setup (this script): installer for is_formmail.pl
#
# This install script installs and configures is_formmail.pl
# It prompts the user for configuration information (first reading in 
# any from a previous installation), and then writes the script file.
# After installation, the user should delete this install script,
# so that no unauthorized users can access it.
#
# Developers may also use this 'generic' installer' to create new
# self-installing application scripts.
#
# To create a new self-installing application script:
# 1. Copy this file to 'application_setup' where 'application' is
#    the name of the new application.
# 2. Edit the commentary above to describe the new application.
# 3. Configure the installer script information below --
#    Specify the instructions which will appear when the user
#    runs 'application_setup', the HTML output (template)
#    which the application displays, and the configuration
#    information required for the application. Modify the following
#    variables below, using the existing information as a guide
#    for what should be entered:
#
#    $is_instructions - text for application setup instructions
#    $is_config_hdr = text line for configuration table header
#    %is_config - application configuration information (see below)
#    $is_html_pre - HTML for application (shown before form)
#    $is_code - code for application
#
#
#-----------------------------------------------------------------------
#
# Version 0.54 - support multiple strings in SMTP greeting
# Version 0.53 - fix errors messages in authentication string computation
#                fix date
# Version 0.52 - fixup license statement
# Version 0.51 - commented out unused NTLM checks
#
# Version 0.50 - initial release
#                TBD:
#                - NTLM
#                - check for MD5 (and warn if not present) on installation
#   
# Copyright (C) 2003, InstantServers, Inc. All Rights Reserved.
#
# This library is free software and is provided "as is" without express
# or implied warranty.  It may be used, redistributed and/or modified
# under the terms of the Perl Artistic License (see
# http://www.perl.com/perl/misc/Artistic.html)
#


# Setup script wrapper definitions
my $VERSION = "0.53";


  



#-----------------------------------------------------------------------
# Packaged application script (setup script wrapper installs this)
#-----------------------------------------------------------------------

#
# Application script installation instructions
# (fill-in between 1st line and 'END_INSTRUCTIONS')
#
my $is_instructions = <<"END_INSTRUCTIONS";
<b>IS_FormMail $VERSION Setup Screen</b><hr>

is_formmail.pl is a CGI (Perl) script for sending messages to a preset email account from a web page.<br><br>

To configure the script, enter the values in the form below. The is_formmail.pl script will automatically be generated. The values are:<br><br>

Send Mail To: the email address to send messages<br><br>
SMTP Server Name: the SMTP server to use to send messages<br><br>
SMTP User: valid user account on the SMTP server<br><br>
SMTP Password: password for SMTP user account<br><br>

The 'SMTP User' and 'SMTP Password' are optional fields, but are required
to authenticate on many SMTP servers.

To run is_formmail.pl:<br>
http://your-domain.com/cgi-bin/is_formmail.pl<br><br>

The form's HTML code can also be pasted into a web page.
The easiest way to do this is to run is_formmail.pl, view the HTML source, and copy and past the 'form' section. Then, modify it to suit the web page's style and content.<br><br>

Copyright(C) 2003, InstantServers, Inc. All Rights Reserved.<br><br>

This library is free software and is provided "as is" without express
or implied warranty.  It may be used, redistributed and/or modified
under the terms of the Perl Artistic License (see
http://www.perl.com/perl/misc/Artistic.html)

<hr>

END_INSTRUCTIONS

#
# Default configuration
# N.B. modified to new defaults if application script file exists
#   and contains these values
#
my $is_config_header = "IS_FormMail Settings:";
my @is_config = 
  (
   {
    'Text' => 'Send Mail To',
    'Var' => 'is_formmail_to',
    'Type' => 'textfield',
    'Default' => '',
    'Display' => 1,
    'Optional' => 0,
   },
   {
    'Text' => 'SMTP Server Name',
    'Var' => 'is_formmail_smtp',
    'Type' => 'textfield',
    'Default' => '',
    'Display' => 1,
    'Optional' => 0,
   },
   {
    'Text' => 'SMTP User',
    'Var' => 'is_formmail_smtpauthuser',
    'Type' => 'textfield',
    'Default' => '',
    'Display' => 1,
    'Optional' => 1,
   },
   {
    'Text' => 'SMTP Password',
    'Var' => 'is_formmail_smtpauthpass',
    'Type' => 'textfield',
    'Default' => '',
    'Display' => 1,
    'Optional' => 1,
   },
   # Generic entry -- must be present for all applications
   {
    'Text' => 'ReplaceHTML',
    'Var' => 'is_formmail_replacehtml',
    'Type' => 'checkbox',
    'Default' => 'On',
    'Display' => 0,
    'Optional' => 0,
   },
   # Generic entry -- NO FORM DISPLAY
   # (NOT CURRENTLY USED)
   {
    'Text' => 'is_html_pre',
    'Var' => '',
    'Type' => '',
    'Default' => '',
    'Display' => 0,
    'Optional' => 0,
   },
   {
    'Text' => 'is_html_post',
    'Var' => '',
    'Type' => '',
    'Default' => '',
    'Display' => 0,
    'Optional' => 0,
   },
   {
   'Text' => 'Show Debug Information',
   'Var' => 'is_formmail_debug',
   'Type' => 'checkbox',
   'Default' => '',
   'Display' => 1,
   'Optional' => 1,
}  ,
  );

#
# Application HTML
#
my $is_html_pre = <<'END_HTML_PRE';

Please send us an email message using the form below:


END_HTML_PRE


#
# Application Code
# (paste between next line and line with 'END_CODE' at start of line)
my $is_code = <<'END_CODE';

my $is_formmail_from;
my $is_formmail_subj;
my $is_formmail_body;
my $is_formmail_use_perlmd5;

use CGI();
use Net::SMTP;
use MIME::Base64;

my ($q, $smtp, $ret);
my (%f2, $display_hdr_done);

# Display generic page header
my $display_hdr = sub {
  return if $display_hdr_done;

  print $q->header;
  print $q->start_html(-title => 'IS_Formmail');
  $display_hdr_done = 1;
};


# Emit HTML trailer info
my $display_end = sub {
  print $q->end_html;
};

my $display_error = sub {
  my $error = shift;

  &$display_hdr();
  print $error;
  &$display_end();
};

# Display the email form
my $display_email_form = sub {

  # HTML header
  &$display_hdr();

  # Show instructions for using form
  print $is_html_pre;

  # Show form
  print $q->startform();

  # -form header
  print "<table><tr><th colspan='2'>&nbsp</th></tr>\n";

  # - form items
  print "<tr><td class='1' align='right'>";
  print "From: ";
  print "</td><td class='1'>";
  print $q->textfield(-name=>'is_formmail_from',
		      -default=>$is_formmail_from,
		      -size=>40,
		      -override=>1,
		      -maxlength=>80);
  print "</td></tr>";

  print "<tr><td class='1' align='right'>";
  print "Subject: ";
  print "</td><td class='1'>";
  print $q->textfield(-name=>'is_formmail_subj',
		      -default=>$is_formmail_subj,
		      -size=>40,
		      -override=>1,
		      -maxlength=>80);
  print "</td></tr>";

  print "<tr><td class='1' align='right'>";
  print "Message: ";
  print "</td><td class='1'>";
  print $q->textarea(-name=>'is_formmail_body',
		      -default=>$is_formmail_body,
		      -rows=>10,
		      -columns=>50);
  print "</td></tr>";
  
  # - form action
  print "<tr><td class='1' align='right'>";
  print "&nbsp";
  print "</td><td class='1'>";
  print $q->submit('Action','Send');
  print "</td></tr>";

  print "</table>";

  print $q->endform;

  &$display_end();
};

my $display_message_sent = sub {
  &$display_hdr();
  print "Email message successfully sent!";
  &$display_end();
};

my $display_back = sub {
  &$display_hdr();
  print "<br><a href=\"$ENV{SCRIPT_NAME}\">Back</a> to previous page";
  &$display_end();
};



my $GetEmailDate = sub {
  my ($swday, $smon, $offset, $date);
  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
  my ($sec2, $min2, $hour2, $mday2, $mon2, $year2, $wday2, $yday2, $isdst2) = gmtime;
  $swday = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$wday];
  $smon = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$mon];
  $offset = $hour2 - $hour;
  $offset += 24 if ($yday2 > $yday);
  $offset *= 100;

  $date = sprintf "%s, %02d %s %04d %02d:%02d:%02d -%04d", 
    $swday, $mday, $smon, 1900 + $year, $hour, $min, $sec, $offset;
  return $date;
};

my $check_message = sub {
  my $r = shift;
  my %f2 = %$r;

  my $from = $f2{'is_formmail_from'};
  if ($from !~ /(.+)\@(.+)/) {
    &$display_error("Please enter a valid email address<br>\n");
    return 0;
  }
  return 1;
};

#
# SMTP Authentication
#

# Check for an MD5 library
my $find_md5 = sub {
  if (!defined($is_formmail_use_perlmd5)) {
    eval { require Digest::MD5; };
    if ($@) {
      eval { require Win32::ApConf; };
      if ($@) {
	return 0;

      } else {
	my $ap = new Win32::ApConf;
	my $path = $ap->getserverdir();
	eval { require "$path/adm_perl/ISApacheCoreDll.pm" };
	if ($@) {
	  return 0;

	} else {
	  $is_formmail_use_perlmd5 = 0;
	}
      }

    } else {
      $is_formmail_use_perlmd5 = 1;
    }
  }
  return 1;
};

my $is_md5 = sub {

  if ($is_formmail_use_perlmd5) {
    require Digest::MD5;
    my @args = @_;
    my $ret = Digest::MD5::md5(@args);
    return $ret;

  } else {
    require Win32::ApConf;
    my $ap = new Win32::ApConf;
    my $path = $ap->getserverdir();
    require "$path/adm_perl/ISApacheCoreDll.pm";

    my ($acd, $str, $strlen, $digest);
    my (@state, @count, @buffer);
    my %context = (
		   'state' => \@state,
		   'count' => \@count,
		   'buffer' => \@buffer,
		   );

    $acd = new ISApacheCoreDll;
    $acd->ap_MD5Init(\%context);
    while (scalar(@_)) {
      $str = shift;
      $strlen = length($str);
      $acd->ap_MD5Update(\%context, $str, $strlen);
    }
    $acd->ap_MD5Final(\$digest, \%context);
    $digest = pack("H32", $digest);
    return $digest;
  }
};

# Generate an authentication string
my $smtp_auth_str = sub {
  my $klen = 64;
  my $x;
  my $ipad = '6' x $klen;
  my $opad = '\\' x $klen;

  my $method = shift;
  my $user = shift;
  my $pwd = shift;
  my $shared = shift;

  return "" if length $pwd > $klen;

### TEST CASE: WORKS
#$pwd = chr(11) x 16;
#$shared = "Hi There";
# result should be '0x9294727a3638bb1c13f48ef8158bfc9d'
### TEST CASE: WORKS

  my ($ret);

  $method = lc($method);
# N.B. pwd must be < ipad bytes
  if ($method eq 'cram-md5') {
    $x = $pwd ^ $ipad;
    my $md1 = &$is_md5($x, $shared);

    $x = $pwd ^ $opad;
    my $md2 = &$is_md5($x, $md1);

    my $inter = unpack("H32", $md2);
    $ret = encode_base64($user . ' ' . $inter);

#  } elsif ($method eq 'ntlm') {

  } elsif ($method eq 'login') {
    if ($user) {
      $ret = encode_base64($user);
    } elsif ($pwd) {
      $ret = encode_base64($pwd);
    }

  } elsif ($method eq 'plain') {
    $ret = encode_base64("\000$user\000$pwd");
  }

  return $ret;
};

# Authenticate based on method passed
my $smtp_do_authenticate = sub {
  return if scalar(@_) < 2;

  my ($ret, $msg, $dmsg, $ok, $len);

  my $smtp = shift;
  my $method = shift;
  $method = lc($method);

  # Auth command
  $ret = $smtp->command('AUTH', $method);
  return 0 if !defined($ret);

  # Auth command response
  $ret = $smtp->response;
  print "DEBUG: Code: $ret<br>\n" if $is_formmail_debug;
  $msg = $smtp->message;
  chomp $msg;
  if (($method ne 'login') and ($method ne 'cram-md5')) {
    $dmsg = $msg;
  } else {
    $dmsg = decode_base64($msg);
  }
  print "DEBUG: auth message: $dmsg<br>\n" if $is_formmail_debug;

  # Check for valid response
  return 0 if $ret != 3;

  # Send Uname/pwd or uname
  $ret = &$smtp_auth_str($method, $is_formmail_smtpauthuser, $is_formmail_smtpauthpass, $dmsg);
  print "DEBUG: Sending: $ret<br>\n" if $is_formmail_debug;
  # N.B. bypass Net::SMTP to avoid mangling auth response
  chomp $ret;
  $ret .= "\015\012";
  $len = length $ret;
  $ret = syswrite($smtp, $ret, $len);
  return 0 if !defined($ret) or ($ret != $len);

  # response
  $ret = $smtp->response;
  print "DEBUG: Return: $ret<br>\n" if $is_formmail_debug;
  $msg = $smtp->message;
  $dmsg = $msg if $method ne 'login';
  $dmsg = decode_base64($msg) if $method eq 'login';
  print "DEBUG: Message: $dmsg<br>\n" if $is_formmail_debug;

  # Send pwd (if needed by auth method)
  if ($method eq 'login') {
    $ret = &$smtp_auth_str($method, 0, $is_formmail_smtpauthpass);
    print "DEBUG: Sending: $ret<br>\n" if $is_formmail_debug;
    chomp $ret;
    $ret .= "\015\012";
    $len = length $ret;
    $ret = syswrite($smtp, $ret, $len);
    if (defined($ret) and ($ret == $len)) {
      print("DEBUG: auth: $ret<br>\n") if $is_formmail_debug;
    } else {
      print("DEBUG: auth failed<br>\n") if $is_formmail_debug;
      return 0;
    }

    # pwd response
    $ret = $smtp->response;
    print "DEBUG: Return: $ret<br>\n" if $is_formmail_debug;
    $msg = $smtp->message;
    print "DEBUG: Message: $msg<br>\n" if $is_formmail_debug;
  }

  $ok = 1 if ($ret eq '2');

  return $ok;
};


# SMTP Authentication (quick and dirty since do not have packages)
my $smtp_authenticate = sub {
  my ($msg);
  my $ret = 0;
  my $smtp = shift;

  # Get greeting and check for authentication capabilities (in order)
  $msg = $smtp->message;
  if ($msg =~ /(.*)AUTH(.*)\n/m) {
    if ($msg =~ /.*\s+(cram-md5).*/mi and &$find_md5()) {
      $ret = &$smtp_do_authenticate($smtp, $1);

#    } elsif ($msg =~ /.*\s+(ntlm).*/mi) {
#      $ret = &$smtp_do_authenticate($smtp, $1);

    } elsif ($msg =~ /.*\s+(login).*/mi) {
      $ret = &$smtp_do_authenticate($smtp, 'login');

    } elsif ($msg =~ /.*\s+(plain).*/mi) {
      $ret = &$smtp_do_authenticate($smtp, $1);
    }
  }
  print "DEBUG: authenticate returned: $ret<br>\n" if $is_formmail_debug;
  return $ret;
};

# Send the email message
my $send_message = sub {
  my $ret;
  my $r = shift;
  my %f2 = %$r;

  my $to_address = $is_formmail_to;
  my $smtp_server = $is_formmail_smtp;

  my $from_address = $f2{'is_formmail_from'};
  my $subject = $f2{'is_formmail_subj'};
  my $body = $f2{'is_formmail_body'};

  $smtp = Net::SMTP->new($smtp_server, Timeout => 30);
  print "DEBUG: SMTP server: timed out" if !defined($smtp) and $is_formmail_debug;
  return 0 if !defined($smtp);

  $ret = 1;
  $ret = &$smtp_authenticate($smtp)
    if ($is_formmail_smtpauthuser and $is_formmail_smtpauthpass);
  return 0 if !$ret;
  
  $ret = $smtp->mail($from_address);
  return 0 if !defined($ret) or !$ret;

  $ret = $smtp->to($to_address);
  return 0 if !defined($ret) or !$ret;
  
  $ret = $smtp->data();
  return 0 if !defined($ret) or !$ret;

  my $date = &$GetEmailDate();
  $ret = $smtp->datasend("Date: $date\n");
  return 0 if !defined($ret) or !$ret;

  $ret = $smtp->datasend("To: $to_address\n");
  return 0 if !defined($ret) or !$ret;

  $ret = $smtp->datasend("From: $from_address\n");
  return 0 if !defined($ret) or !$ret;

  $ret = $smtp->datasend("Subject: $subject\n");
  return 0 if !defined($ret) or !$ret;

  $ret = $smtp->datasend("\n");
  return 0 if !defined($ret) or !$ret;

  $ret = $smtp->datasend($body);
  return 0 if !defined($ret) or !$ret;

  $ret = $smtp->dataend();    
  return 0 if !defined($ret) or !$ret;

  $ret = $smtp->quit;
  return 0 if !defined($ret) or !$ret;

  return 1;
};

my $get_form2_params = sub {
  my ($q, $r);

  $q = shift;
  $r = shift;

  $$r{'is_formmail_from'} = '';
  $$r{'is_formmail_from'} = $q->param('is_formmail_from') if defined($q->param('is_formmail_from'));
  $$r{'is_formmail_subj'} = '';
  $$r{'is_formmail_subj'} = $q->param('is_formmail_subj') if defined($q->param('is_formmail_subj'));
  $$r{'is_formmail_body'} = '';
  $$r{'is_formmail_body'} = $q->param('is_formmail_body') if defined($q->param('is_formmail_body'));
};

#
# Main code
#

$display_hdr_done = 0;

$q = new CGI;
$action ='';
$action = $q->param('Action') if defined($q->param('Action'));

# Check if sending message
if ($action eq 'Send') {
  &$display_hdr() if $is_formmail_debug;
  &$get_form2_params($q, \%f2);
  $ret = &$check_message(\%f2);
  $ret = &$send_message(\%f2) if $ret;
  if ($ret) {
    &$display_message_sent();
  } else {
    &$display_error("Message could not be sent. Please try again later<br>\n");
  }
  &$display_back();


# Must be displaying form
} else {
  &$display_email_form();
}

END_CODE


#-----------------------------------------------------------------------
# End of packaged application script
#-----------------------------------------------------------------------



#-----------------------------------------------------------------------
# Setup script wrapper
#-----------------------------------------------------------------------

use CGI();

my ($q);
my (%config);
my ($is_setup_script_name, $is_setup_script_filename);
my ($is_script_name, $is_script_filename);

my ($action, $script_filename);

my $is_use_html_filename = 0;
my ($is_html_filename);
  
# Script and other file names
my $get_script_names = sub 
{
  my $name = $0;
  my $tmpname;
  my $fname;

  $tmpname = $name;
  if (defined($ENV{SCRIPT_NAME})) {
    $name = $ENV{SCRIPT_NAME};
  } else {
    require Cwd;
    my $dir = Cwd::getcwd();
    $name = $dir . '/' . $tmpname;
    $name =~ s/\\/\//g;
    if ($name =~ /.*(\/(.*)\/(.*))/) {
      $name = $1;
    }
  }
  $is_setup_script_name = $name;
  $is_script_name = $name;
  $is_script_name =~ s/_setup.*//;
  $is_script_name .= '.pl' if ($is_script_name) !~ /\.pl$/i;

  if (defined($ENV{SCRIPT_FILENAME})) {
    $fname = $ENV{SCRIPT_FILENAME};
  } else {
    require Cwd;
    my $dir = Cwd::getcwd();
    $fname = $dir . '/' . $tmpname;
    $fname =~ s/\\/\//g;
  }
  $is_setup_script_filename = $fname;
  $is_script_filename = $fname;
  $is_script_filename =~ s/_setup.*//;
  $is_script_filename .= '.pl' if ($is_script_filename) !~ /\.pl$/i;

  $is_html_filename = $is_script_filename;
  $is_html_filename =~ s/\.pl/\.html/;

  return;
};



# Display generic page header
my $display_hdr = sub {
  print $q->header;
  print $q->start_html(-title => 'IS_FormMail Setup');
};

my $display_form_elt = sub {
  my $cr = shift;

  my $type = $$cr{'Type'};
  my $var = $$cr{'Var'};
  my $default = $$cr{'Default'};
  if ($type eq 'textfield') {
    print $q->textfield(-name=>$var,
			-default=>$default,
			-size=>40,
			-override=>1,
			-maxlength=>80);
  } elsif ($type eq 'checkbox') {
    print $q->checkbox(-name=>$var,
		       -checked=>$default ? 'checked' : '',
		       -override=>1,
		       -label=>'');
  }
  print "&nbsp;(optional)" if $$cr{'Optional'};
};

# Emit HTML trailer info
my $display_end = sub {
  print $q->end_html;
};

# Display form asking for FormMail configuration values
my $display_ask = sub {
  my ($cr, $text, $var, $i, $display);

  print $is_instructions;
  print "<br>";

  print $q->startform(-action=>$is_setup_script_name);

  print "<table><tr><th colspan='2'>$is_config_header</th></tr>\n";

  $i = 1;
  foreach $cr (@is_config) {
    $text = $$cr{'Text'};
    $display = $$cr{'Display'};
    next if !$display;
    print "<tr><td class='$i' align='right'>$text </td><td class='$i'>";
    &$display_form_elt($cr);
    print "</td></tr>\n";
    $i = 1 if (++$i > 2);
  }

  print "<tr><td class='1' align='right'>";
  print "&nbsp";
  print "</td><td class='1'>";
  print $q->submit('Action','Save');
  print $q->submit('Action','Cancel');
  print $q->reset('View Defaults');
  print "</td></tr>";

  print "</table>";

  print $q->endform;
};

# Display 'Installation Done' information
my $display_create_done = sub {
  &$display_hdr();
  print "<b>IS_FormMail Setup Complete</b>:<br>\n";
  print "$is_script_name was successfully created!<br><br>\n";
  print "This installation script should now be deleted by removing the file:<br>$is_setup_script_filename<br><br>\n";
  print "If you need to reconfigure the script, re-install and re-run this installation file<br><br>\n";

  
  &$display_end();
};


# Create setup page to get configuration parameters
my $ask = sub {
  my ($line, $cr, $var, $val);

  # Use existing configuration, if present
  if (open(FH, "< $is_script_filename")) {
    while (<FH>) {
      $line = $_;
      foreach $cr (@is_config) {
	$var = $$cr{'Var'};
	if ($line =~ /^\$$var\s*=\s*(.*)/) {
	  $val = $1;
	  if (defined($val)) {
	    $val =~ s/;$//;
	    $val =~ s/^'//;
	    $val =~ s/'$//;
	    $$cr{'Var'} = $val;
	  }
	}
      }
    }
    close(FH);
  }

  &$display_hdr();
  &$display_ask();
  &$display_end();
};


# Configuration parameters -- passed from 'Create' phase
my $get_form2_params = sub {
  my ($q, $r, $cr, $var);

  $q = shift;
  $r = shift;

  foreach $cr (@is_config) {
    $var = $$cr{'Var'};
    $$r{$var} = $$cr{'Default'};
    $$r{$var} = $q->param($var) if defined($q->param($var));
  }
};



#
# Generate IS_FormMail.pl script
#
# Generate configuration parameters
my $create_config  = sub {
  my ($cr, $var, $display);
  my $fname = $is_script_filename . ".new";

  open(FH, "> $fname") or return;

  print FH "#!perl\n";
  print FH "# WARNING: DO NOT EDIT - THIS IS MACHINE GENERATED CODE!!!\n";
  print FH "\n# 1. Configuration variables generated from installation\n";
  foreach $cr (@is_config) {
    $display = $$cr{'Display'};
    next if !$display;

    $var = $$cr{'Var'};
    print FH "my \$";
    print FH $var;
    print FH " = '$config{$var}';\n";
  }

  close(FH);

  unlink($is_script_filename) if (-e $is_script_filename and -f $is_script_filename);
  rename($fname, $is_script_filename);
};

my $create_HTML = sub {
  my ($cr, $var, $replacehtml);

  $replacehtml = 0;
  foreach $cr (@is_config) {
    if ($$cr{'Text'} eq 'ReplaceHTML') {
      $var = $$cr{'Var'};
      $replacehtml = $config{$var};
      last;
    }
  }
  return if (-e $is_html_filename and !$replacehtml);

  unlink ($is_html_filename) if (-e $is_html_filename and -f $is_html_filename);

  if ($is_use_html_filename and open(FH, "> $is_html_filename")) {
    print FH "\n# 2. HTML user instructions\n";
    print FH $is_html;
    close(FH);
  } else {

###
# Add HTML to script
    open(FH, ">> $is_script_filename") or return;
    print FH "\n# 2. HTML user instructions\n";
    print FH "my \$";
    print FH "is_html_pre = '";
    print FH $is_html_pre;
    print FH "';\n";
    close(FH);
  }
};

# Generate script code
my $create_script = sub {
  open(FH, ">> $is_script_filename") or return;
  print FH "# 3. Unmodified code";
  print FH $is_code;
  close(FH);
};

my $create = sub {
  &$create_config();
  &$create_HTML();
  &$create_script();

  &$display_create_done();
};


#
# Main code
#
$q = new CGI;
$action ='';
$action = $q->param('Action') if defined($q->param('Action'));

&$get_script_names();

# Check if creating FormMail script
if ($action eq 'Save') {
  &$get_form2_params($q, \%config);
  &$create();

# Must be setting up FormMail setup
} else {
  &$ask();
}

#-----------------------------------------------------------------------
# End of setup script wrapper
#-----------------------------------------------------------------------