#!/usr/bin/perl

# NOTE:  the above line must be changed to show the path to the
# Perl interpreter on your system!  Leave the #! as is, but
# the path may have to be changed if yours is different.

#########################################################################
# SFELinkAdd v1.0.2 03/07/2006						#
# Lets users continually add to an ongoing story that they can then	#
# read immediately on a web page. Can also be used as a guestbook, or   #
# even a form to add comments to different pages. Thanks to Kyle who 	#
# gave me the push I needed to convert MakeBook into a link submission	#
# program. :-)								#
#									#
# Copyright 1999-2006, Kristina Pfaff-Harris				#
# http://tesol.net/scriptmail.html					#
# All rights reserved.                                             	#
#########################################################################
##### License for SFELinkAdd 1.0.2
#####
#####  This program may be used free of charge under the following
#####  conditions:
#####
#####  1. All instructions and Copyright lines must remain unchanged.
#####
#####  2. All pages generated by the program must contain one of the
#####     following pieces of HTML code:
#####
#####     <font size=-2>
#####     <a href="http://www.tesol.net/scripts/">
#####	  Powered by SFELinkAdd v1.0.2</a></font>
#####  OR:
#####     <!-- SFELinkAdd Copyright 2004 Kristina Pfaff-Harris -->
#####     <!-- Get it at http://www.tesol.net/scripts/         -->
#####
#####  You may not remove the information described above from the script
#####  without express written permission from the author.
#####
#####  3. You may not sell or distribute this program.  You may charge
#####     a reasonable fee for installing it for a client as long as
#####     you make it clear that you are not the author, and you are
#####     not selling the program to them: only charging for installing
#####     it.
#####
#####  4. You agree that this program is offered without warranty of
#####     any kind, including warranty of fitness for a particular
#####     purpose. You further agree that the author and all sites
#####     associated in any way with this program are not liable for
#####     any damage or loss incurred as a result of using this program.
#####
#####  5. You may modify the program for your own use but you may not
#####     distribute modified copies under any circumstances without
##### 	  express written permission from the author.
#####
#####  6. Use of this program requires agreement to all the terms and
#####     conditions of this license. If you do not agree to one or
#####     more of these terms, you may not use the program.
#####
#########################################################################
##### IMPORTANT INSTRUCTIONS:                                           #
#####                                                                   #
##### In this program, I have put **CHANGE** in all the places where    #
##### you will need to modify the program to run on your server, so     #
##### that you can easily find all the places where changes are         #
##### necessary.  This program must be chmod 755 or 775 in order to     #
##### work, and the linkfile.html file must be writable by the web	#
##### server, which sometimes means 766. See the README file for more	#
##### details.
#####                                                                   #
#########################################################################
#                                                                       #
# IMPORTANT: If you FTPed this program to your server in "binary" mode, #
# it will NOT work!  If you're not sure, please go back and FTP it      #
# to your server again and make sure you use "ascii" mode.  If you get  #
# "500 Server Error", this is almost always the cause. :)               #
#                                                                       #
# Using the program:                                                    #
# This program requires the file "sfelinkadd.cgi" at a minimum in order  	#
# to work.  Please read the README.sfelinkadd file for more information. 	#
#                                                                       #
# I hope this program proves useful to you!  If you are having problems,#
# please read all the instructions carefully, and check the FAQ at      #
# http://www.tesol.net/scripts/FAQ/ . If none of this helps, please     #
# contact me (http://www.tesol.net/scriptmail.html) for any bugs or     #
# feedback.                                                             #
#########################################################################
#									#
#            BEGIN SECTION WHERE YOU NEED TO CHANGE THINGS		#
#									#
#  In this next section, there are various things that you need to	#
#  change in order to get the program to work the way you'd like it to.	#
#  Don't worry: each variable has an explanation of what it does and	#
#  what you'll need to do in order to change it.  Be careful of things	#
#  like " and ; and be sure to read the instructions.  If you do this,	#
#  then you should be fine!						#
#									#
#########################################################################

# First of all, let's determine if we want to enable some debugging
# information.  This can be very useful when you are first setting up
# the program, as it can tell you whether or not the program can find
# your "linkfile" and whether it can add entries to it.  If you're
# having problems such as no entries showing up in the linkfile, then
# **CHANGE** this to:
# $debugging = 1;
# To turn debugging off, set $debugging = 0;
# Otherwise, you should leave it as it is.

$debugging = 0;

# $linkfile is the system path to your links file. This lets the
# program know where to look for the file so that it can add entries to
# it.  This is NOT a URL, and must NOT begin with "http://". It should
# begin with "/".  **CHANGE** this to the system path to your links file.
# Sometimes, the setting I have below will work fine for you. (Try it
# and see.)  Otherwise, it should be something like:
# $linkfile = "/home/web/yourlogin/your_web_directory/linkfile.html";
# (On Unix) or something like:
# $linkfile = "c:/inetpub/wwwroot/users/yourlogin/linkfile.html";
# (On Windows).  In addition, if you choose "use form for linkfile" below,
# then this will be our "fall back" page if, for some reason, the
# system can't find the correct file.
# NOTE: If linkfile.html is in the same directory with this script, what
# I have below may work. If not, it will give you an error message, but
# is probably worth a try. Sometimes you can't have "chmod 766" files or
# any files ending in .html in the same directory as your cgi scripts.
# Ask your web hosting provider about these issues if you're not sure.

$linkfile = "./linkfile.html";

# $linkfile_url is the URL (web address) to your links file so we can send the
# user there when they're done entering their text. **CHANGE**
# this to the URL of your own linkfile.  This *is* a URL, and should
# begin with "http://".
# NOTE: On some servers, what I have below might work. Might as well give
# it a shot. If you're getting "404" or "File not found" when clicking on
# the "View the links" after submitting, it probably means this is
# not correct.

$linkfile_url = "http://$ENV{'SERVER_NAME'}/linkfile.html";

# $links_in_new_window is whether or not you want links to open in a new
# window when people click on them. If you would like links to open in a new
# window (thus leaving the window of your site open in the background), et
# $links_in_new_window = 1;
# Otherwise, leave $links_in_new_window = 0;

$links_in_new_window = 1;

# $cgi_url is the URL of this script. If you're trying to wander around
# in the Admin area, and you click a button and get "Not Found" or similar
# error, it probably means you don't have this set right. **CHANGE** this
# to the full URL of sfelinkadd.cgi on your server. For example:
# $cgi_url = "http://www.your_domain.com/cgi-bin/sfelinkadd.cgi";
# NOTE: On some servers, what I have below might work. Might as well give
# it a shot. Again, if you're getting "404" or "File not found" in the
# Admin section, take a look at what's appearing in your address bar, and
# if it doesn't look right, you'll need to fix this. :-)

$cgi_url = "http://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}";

# $admin_login and $admin_password are the username and password you
# want to use to login to the Administrative functions of this script,
# such as approving pending submissions, editing and deleting entries,
# etc. **CHANGE** these to a username and password that you find
# appropriate. Please note that if you do not change the password to
# something other than "password," the program will refuse to run.
# Please choose at least a somewhat secure password. :-)

$admin_login = "admin";

$admin_password = "password";

# $submissions_require_approval is whether or not you want all submissions
# to be held in a separate file until you personally approve them to be
# posted. If you set $submissions_require_approval = 1; then anything
# submitted will be emailed to you, and you must log into the admin
# interface to approve it before it will be posted. If you set
# $submissions_require_approval = 0; then whatever people post will just
# go right up.

$submissions_require_approval = 1;

# If you have set $submissions_require_approval = 1; above, then you will
# need to put in the full system path to a file where you want to store
# the submissions until they are approved. **CHANGE** this to the full
# system path of pending_entries.txt on your server.

$pending_entries_file = "./pending_entries.txt";

# $owner is who I want the email sent to for confirmation of
# contributions.  We'll use this later on.  IMPORTANT: Perl version 5
# requires that all @ signs be preceded by a
# backslash. (\) **CHANGE** this to your own email address, and make
# sure that the @ sign has a \ in front of it as in the example.

$owner = "you\@your_domain.com";

# Define the name of the owner.  **CHANGE** this to your own
# name or appropriate alias.

$owner_name = "SFELinkAdd v1.0.2";

# Here, we will define our HTML header.  You can monkey about with the
# HTML code here so that it looks like that of your page.  WARNING:
# any " (quotes) or @ ("at" signs) must have a \ (backslash) in front
# of them.  Please be very careful if you modify the HTML code here --
# just one free " and the script will never run.  You can put anything
# you like in between the <!-- Begin HTML Header --> and <!-- End HTML
# Header --> lines. Tip: to change the font face for the entire document,
# use CSS tags.  Do not touch the "qq[" or the final "];"

$header = qq[ 
<!-- Begin HTML Header -->

<html><head><title>SFELinkAdd v1.0.2</title></head>
<body bgcolor=\"#FFFFFF\">
<h1>SFELinkAdd v1.0.2</h1><br>

<!-- End HTML Header -->
];

# Now define our HTML footer.  As before, you may change the html
# code, but be careful of " and @ signs.

$footer = qq[
<!-- Begin HTML Footer -->

<hr></body></html>

<!-- End HTML Footer -->
];

# Now, let's enter some more options.  The next few lines will let you
# control whether the program emails you with new entries or not,
# whether you'd like new entries to appear at the top of the file or
# the bottom of the file, and whether or not to print the date and
# the user's email address. You may leave these as-is, or **CHANGE**
# them to settings more appropriate to your own needs.
#
# First, $add_to_end_of_file is either "yes" or "no."
# To **CHANGE** this (it starts out as "yes"), just change
# $add_to_end_of_file = "yes"; to
# $add_to_end_of_file = "no";
# That will add the newest entries to the top of the page rather
# than the bottom.  Some people use this feature when they are
# using SFELinkAdd as a guestbook rather than as a links page.

$add_to_end_of_file = "no";

# Next, $show_date_submitted determines whether or not you'd like
# the date the person entered their submission to be shown. Again,
# this can be "yes" or "no." If you leave it at "no", then the
# dates will not be shown.  If you set it to "yes," then the dates
# will show up on the entries. **CHANGE** this to
# $show_date_submitted = "yes";
# if you would like the dates of the submissions to show up.

$show_date_submitted = "yes";

# $require_email_address is whether or not you want to force people to
# enter a valid email address into the form when they sign the guestbook.
# If you set $require_email_address = 0; then we will not require them
# to enter an email address.
# If you set $require_email_address = 1; then we WILL require them to
# enter an email address, whether we show it in the form or not.

$require_email_address = 0;

# $link_email_address tells the program whether or not to put a link
# to the contributor's email address near their submission.  By default,
# the program will put a link to the person's email address on the
# page.  However, since many people are concerned about receiving
# unsolicited email, you may **CHANGE** this to:
# $link_email_address = "no";
# and the email address will not be shown.

$link_email_address = "no";

# If you are using SFELinkAdd as an ongoing story, you might not want
# the names or email addresses of the submittors to show up, as it
# could interrrupt the "flow" of the story.  If you set
# $hide_authors_names = "yes"; then it will put the authors' names
# into HTML comment format.  This means that you will be able to
# see them ONLY if you view the source code of the linkfile, but
# they will not show up when viewing the page normally in a web
# browser.  **CHANGE** this to:
# $hide_authors_names = "yes";
# if you wish to have the entries unbroken by the name, email address,
# and date of the submission.

$hide_authors_names = "no";

# $line_between_submissions tells SFELinkAdd whether or not you want
# a line (<hr>) in between entries.  If you **CHANGE**
# $line_between_submissions = "no"; to
# $line_between_submissions = "yes";
# Then it will put that line in. Otherwise, it will not.

$line_between_submissions = "yes";

# $add_line_breaks tells SFELinkAdd whether or not you want the program
# to add code for line breaks to the text people enter. If you set
# $add_line_breaks = "yes"; then if a user puts a blank line in between
# lines in their entry, we'll add code so that blank line shows up in
# the linkfile.
# If you set $add_line_breaks = "no"; then all their text will just
# run together without linebreaks.

$add_line_breaks = "yes";

# $submission_length tells SFELinkAdd whether or not you want
# to limit what people enter to a certain length, or number of
# characters.  If you **CHANGE** $submission_length = "unlimited"; to
# $submission_length = "25"; then users may only enter a maximum of
# 25 characters (including spaces) in their entry.  You can make this
# any number you want, for example:
# $submission_length = "500";
# $submission_length = "42";
# $submission_length = "225";
# For anything other than "unlimited", SFELinkAdd will display an error
# message to the user if he or she enters something longer, and will
# not post their entry until they shorten it.

$submission_length = "200";

# $mail_me_the_submissions tells the program whether or not to
# email you a copy of each submission to the page  If you leave
# it at $mail_me_the_submissions = "no"; then it will just add to
# the page and will not notify you.  If you **CHANGE** it to
# $mail_me_the_submissions = "yes";
# then you will be sent a copy of each submission so that you
# can remove inappropriate ones.

$mail_me_the_submissions = "yes";

###################################################################
#                                                                 #
#                  Operating System Specific Stuff                #
#                      (Windows vs. Unix/Linux)                   #
#                                                                 #
###################################################################

# In this section, we're going to try to get some data that will
# help us run this script whether you're using Windows NT/95/98 as
# a web server, or a Unix/Linux-based web server.  Here, I feel
# it necessary to point out that Unix/Linux web servers tend to
# be much more flexible and robust (in my experience) than Windows
# ones.  However, if you're stuck with Windows, we'll try to get
# this working anyway. :)

# If your web server is Linux/Unix based, please set
# $opsys below to "unix" like this and go to the Unix/Linux Stuff
# Section below:
# $opsys = "unix";
# Otherwise, if it is a Windows-based platform, set $opsys to "win"
# like this and go to the Windows Stuff section:
# $opsys = "win";

$opsys = "unix";

###################################################################
#                                                                 #
#                  Unix/Linux Stuff                               #
#                                                                 #
###################################################################
# $path_to_sendmail needs to be the FULL path to sendmail on your
# server, and the name of the sendmail file itself:  You will
# probably be able to use what I have below, but sendmail
# is sometimes located in /usr/ucblib instead of /usr/lib and
# may be somewhere else altogether.  Ask your systems administrator
# where sendmail is, just to make sure, then **CHANGE** this to
# the correct path.  Note: on some systems, this is something
# totally different without the word "sendmail" at all such as
# "/var/qmail/bin/qmail-inject".

$path_to_sendmail = "/usr/sbin/sendmail";

###################################################################
#                                                                 #
#                     Windows Stuff                               #
#                                                                 #
###################################################################

# $mail_server_hostname needs to be the hostname of a mail server
# that your web server is allowed to send mail through. Generally,
# this will be something like "mail.yourdomain.com" but it may
# be something completely different, and you may not be able to
# use this at all.  If your web server is also a mail server,
# you may be able to use "localhost" (yes, just that one word,
# no ".com" or anything -- it's a special word that means "this
# machine.")  You will need to ask your local technical support
# people for your website what hostname to use for your outgoing
# mail server, then **CHANGE** this to reflect that. For example:
# $mail_server_hostname = "mail.yourdomain.com";

$mail_server_hostname = "mail.yourdomain.com";

# $this_server_hostname needs to be the hostname of your web
# server where this script will be run.  Sometimes, just the
# "www.yourdomain.com" will work, and sometimes your web
# server has its own name like "web-01.nt.somedomain.com".
# Again, you will need to get the hostname of this machine
# from the technical support people for your web server,
# and **CHANGE** this to reflect what they say. For example:
# $this_server_hostname = "www.yourdomain.com";

$this_server_hostname = "www.yourdomain.com";

#########################################################################
#									#
#            END SECTION WHERE YOU NEED TO CHANGE THINGS		#
#									#
#  You should not need to change anything beyond this point, unless	#
#  you know quite a bit about Perl and are making specific changes	#
#  to the code.								#
#									#
#########################################################################

# Set up some stuff that most CGI programs need...
# Output buffering
$| = 1;

# Print the "content-type" header so the server and the browser knows
# to display HTML
print "Content-type: text/html\n\n";

# Grab whatever was entered into the form.
%data = &get_data();

# If you remove this link, without replacing it with a similar
# HTML comment (as above in the License section) you are in violation
# of the license for this program. No, I don't have the resources to
# enforce this, and I know that some people will remove it anyway.
# But honestly, since you didn't have to pay for this, is the link
# really too much to ask? :)

$footer = "<br><a href=\"$linkfile_url\">View the Links!</a>
<hr><font size=-2><a href=\"http://tesol.net/scripts/\">
Powered by SFELinkAdd v1.0.2</a></font><br>$footer";

# Make sure that everything is configured so we can run. This will give
# an error and exit if it can't find the linkfile and so forth.

&check_errors();
$cgi_url =~ s/\/\/\//\//g;

# Now, if debugging is on, we'll show other stuff.

&debug(
    "<b>IMPORTANT:</b> Be sure to set \$debugging to 0 when this script
       is working. If you are having problems, please copy all of this
       debugging info into an email and send it to me along with a detailed
       explanation of what you were doing to get the error."
      );
foreach $key ( keys(%ENV) ) {

    # &debug("$key $ENV{$key}");
}

$fa = $data{'FA'};
my $error = "";
if ( $fa eq "Admin" ) {
    &admin_login_screen();
    exit();
}
elsif ( $fa eq "Login" ) {
    &check_auth();
    &admin_menu();
    exit();
}
elsif ( $fa eq "Edit/Delete Entries" ) {
    &check_auth();
    &edit_del();
    exit();
}
elsif ( $fa eq "Update" ) {
    &check_auth();
    &update();
    exit();
}
elsif ( $fa eq "Delete" ) {
    &check_auth();
    &delete();
    exit();
}
elsif ( $fa eq "Del" ) {
    &check_auth();
    &del_pending();
    exit();
}
elsif ( $fa eq "Approve" ) {
    &check_auth();
    &approve_pending();
    exit();
}
elsif ( $fa eq "Approve Pending" ) {
    &check_auth();
    &approve();
    exit();
}
elsif (    $data{'LinkURL'}
        || $data{'LinkTitle'}
        || $data{'Text'}
        || $data{'Name'}
        || $data{'Email'} )
{
    if ( !$data{'LinkURL'} ) {
        $error .= "<b>You must enter a link URL.</b><br>";
    }
    if ( !$data{'Name'} ) {
        $error .= "<b>Please enter your name.</b><br>";
    }
    if ( !$data{'Email'} ) {
        $error .= "<b>Please enter your email address.</b><br>";
    }
    if ( !$data{'Text'} ) {
        $error .= "<b>Please enter a description.</b><br>";
    }
    if ( !$data{'LinkTitle'} ) {
        $error .= "<b>You must enter a title for your link.</b><br>";
    }
    if ($error) {
        $error = "<b>ERROR:</b><blockquote>$error</blockquote>";
        &print_submission_form;
        exit();
    }
    &post;
    exit();
}
else {
    &print_submission_form;
    exit();
}

sub post {

    # Now we assign some variables:  whatever is in "" marks must correspond
    # to a name="(something)" tag in one of your form fields.  You should
    # not have to modify this unless you change the input fields on the
    # form.
    # Names can only have letters, numbers, -, _, ' or space.
    $name    = $data{"Name"};
    $ok_name = 'A-Za-z0-9-_.\' ';

    # Email can only have letters, numbers, _, -, ., or @
    $email    = $data{"Email"};
    $ok_email = 'A-Za-z0-9-_.@';    # Sorry, no intnl chars.

    # Strip out the "not ok" characters.
    $name  =~ s/[^$ok_name]//g;
    $email =~ s/[^$ok_email]//g;
    $text = $data{"Text"};

    # Link URL can only have letters, numbers, _, -, ., :, /
    $linkurl    = $data{"LinkURL"};
    $ok_linkurl = 'A-Za-z0-9:-_.\'\/';
    if ( $linkurl !~ /^http:\/\// || $linkurl !~ /\w+\.\w{2,3}/ ) {
        $error
            = "<b><font color=\"#FF0000\">ERROR:</font> $linkurl does not appear to be a valid link.
		  Please <a href=\"$linkurl\">click here to test it</a>.
		  If it works, please contact the webmaster for help
		  with submission.</b><br>";
        &print_submission_form;
        exit();
    }

    # Link URL can only have letters, numbers, _, -, ., :, / or space
    $linktitle    = $data{"LinkTitle"};
    $ok_linktitle = 'A-Za-z0-9:-_.\' \/';

    if ( $add_line_breaks !~ /^no$/i ) {
        $text =~ s/\r\n/\n/sg;
        $text =~ s/\r/\n/sg;
        $text =~ s/\n\n/<br>\n<br>\n/sg;
    }
    $date = &get_date();

    if ( $submission_length ne "unlimited" ) { &check_length; }

    # Run the "check_email" subroutine.  This helps to weed out messages
    # from people who don't enter a correct email address, for example,
    # they leave out an "@" sign, or they just put in a local-type
    # address like "bob@bobsite".  The minimum email address we will accept
    # is something like "x@x.xx".

    if ( $require_email_address =~ /^yes$/ || $require_email_address == 1 ) {
        &check_email;
        $fromname     = $owner;
        $fromemail    = $owner;
        $replytoname  = $name;
        $replytoemail = $email;
    }
    else {
        $fromname     = $owner_name;
        $fromemail    = $owner;
        $replytoname  = $owner_name;
        $replytoemail = $owner;
    }

    # If they forget to enter their name, send them a page with the following
    # HTML stuff. The "back" link takes them to the page they're accessing
    # this form from so they can go back if necessary.  This message
    # says what they need to do and gives them the opportunity
    # to try again.

    if ( $name eq "" ) {

        $error
            = "<b><font color=\"#FF0000\">ERROR:</font> Cannot Process Your 
	Submission! You need to enter your name.</b><br>";
        &print_submission_form();
        exit();
    }

    # On the other hand, if they entered their name and address but forgot
    # to put any text in, the below text will be sent to them with a
    # slightly different message.

    elsif ( $text eq "" ) {

        $error
            = "<b><font color=\"#FF0000\">ERROR:</font> Cannot Process Your Submission! You need
           to enter a description of the link.
           </b><br>";
        &print_submission_form();
        exit();
    }

    # If they get past the "if" and the "elsif" watchdogs, then let's
    # go ahead and do the add

    else {

        # The subroutine "send_mail" sends you email with the submission if
        # you have chosen that option above.

        if (    $mail_me_the_submissions =~ /yes/i
             || $mail_me_the_submissions == 1 )
        {
            &mail_owner;
        }

        # Strip HTML from the text and other things entered for safety
        $text      =~ s/</&lt;/sg;
        $text      =~ s/>/&gt;/sg;
        $name      =~ s/</&lt;/sg;
        $name      =~ s/>/&gt;/sg;
        $email     =~ s/</&lt;/sg;
        $email     =~ s/>/&gt;/sg;
        $linkurl   =~ s/</&lt;/sg;
        $linkurl   =~ s/>/&gt;/sg;
        $linktitle =~ s/</&lt;/sg;
        $linktitle =~ s/>/&gt;/sg;

        # Then, we want to put in a line in the text that says who the
        # contribution came from with a link to their email address, if
        # desired. We'll also see if we should print the date of the
        # submission, and whether we should just hide the names altogether.

        if ( $link_email_address =~ /no/i ) {

            $text = "\n\n(Submitted by $name)<P>\n$text<P>\n";
        }
        else {
            $text
                = "\n\n(Submitted by <a href=mailto:$email>$name</a>)<P>\n$text<P>\n";
        }
        if ( $show_date_submitted =~ /yes/i ) {

            $text =~ s/Submitted/Submitted $date/;
        }

        if ( $hide_authors_names =~ /yes/i ) {

            $text =~ s/\(Submitted/<!-- Submitted/;
            $text =~ s/\)/ -->/;
            $text =~ s/<a href=mailto://;
            $text =~ s/$email>/$email /;
            $text =~ s/<\/a>/ /;
        }

        # The subroutine "write_to_linkfile" adds the entry to the linkfile.
        # The subroutine "handle_pending_additions" adds it to the pending
        # entries file for approval by the moderator. Depending on whether
        # or not submissions require approval, we'll call the appropriate
        # subroutine, then print out a confirmation message and return it
        # to the person. Again, you can put any HTML code relevant to your
        # site in this message after the word "print" but you MUST
        # put a \ before any "s, or @s or the program will get
        # confused.  And that's all she wrote!

        if ( $submissions_require_approval == 1 ) {
            &handle_pending_additions;
            print "$header <h2>Success!</h2><P> Your submission has been 
		posted and is awaiting approval by the webmaster.
        	Thanks for your contribution to this site! You will be 
		able to see your addition if it is approved.<br><br>
		You may <a href=\"$linkfile_url\">now view other links
 		by clicking here</a>. $footer";
        }
        else {
            &write_to_linkfile;
            print "$header <h2>Success!</h2><P> Your Link has been added. 
        	Thanks for your contribution to this site! You can 
		<a href=\"$linkfile_url\">now view your link
 		by clicking here</a>. $footer";
        }
    }
    exit();

}

sub check_email {

    if (    $email !~ /(.{1,})(\@)(.{1,})(\.)(.{2,})/
         || $email =~ /\@.*\@/
         || $email =~ /\.$/
         || $email eq ""
         || $email =~ /\@\./
         || $email =~ /\s+/s )
    {
        print "$header<h2>Error: Incorrect email address</h2></center><P>\n
	Sorry, you didn't enter a proper email address.  Your \n
	address must consist of \"yourlogin\@yourhost.yourdomain.\"\n
	If you're getting this message, you may have forgotten the\n
	\"\@\" sign in your email address, or you may have left off\n
	part of the address.  <P>\n
	You entered: \"$email\" <P>\n
	If this is incorrect, please <a href=\"javascript:history.back();\">
	go back to the form and enter your email address again.</a>
        $footer";
        exit();
    }
}

sub mail_owner {

    if ( $submissions_require_approval == 1 ) {
        $subject = "Approve SFELinkAdd Addition";
        $message = "
The following has been submitted to SFELinkAdd and is waiting for your approval.
You may approve this addition by going to:

$cgi_url?FA=Admin
-----------------------------------------------------------------

Link Title: $data{'LinkTitle'}
Link URL:   $data{'LinkURL'}
Link Description:
$text
	";
    }
    else {
        $subject = "Approve SFELinkAdd Addition";
        $message = "
The following has been submitted to SFELinkAdd and has been posted. You may
delete this entry by going to:

$cgi_url?FA=Admin
-----------------------------------------------------------------

Link Title: $data{'LinkTitle'}
Link URL:   $data{'LinkURL'}
Link Description:
$text
	";

    }
    &send_mail( $owner,                $owner,
                $owner,                $owner,
                $replytoemail,         $replytoname,
                "$subject",            $message,
                $mail_server_hostname, $this_server_hostname,
                $opsys,                $htmlmail
              );
}

sub write_to_linkfile {

    # Okay, now, we're going to open up our links file and append this to
    # it.  IMPORTANT:  this depends on your having put the
    # <!-- LINKADD TEXT START --> and <!-- LINKADD TEXT END --> tags in the
    # html file so that it can find where to put the new entries.

    # First, get the whole contents of the file so we can get rid of the
    # footer temporarily...

    if (    $data{'admlogin'} eq $admin_login
         && $data{'admlogin'} ne ""
         && $data{'admpassword'} eq $admin_password
         && $data{'admpassword'} ne "" )
    {
        $is_admin = 1;
    }
    if ( $line_between_submissions eq "yes" ) { $br = "<hr>"; }
    else { $br = "<br>"; }
    if ( -f "$linkfile" ) {
        undef $/;
        open( FILE, "+<$linkfile" )
            || &debug("Oops, I cannot read the linkfile $linkfile: $!");
        if ( $opsys eq "unix" ) { flock( FILE, 2 ); }
        else { binmode(FILE); }
        $linkfile_contents = <FILE>;
        $/                 = "\n";

        # Make sure there is an appropriate header and footer...

        if (    $linkfile_contents =~ /<!-- LINKADD TEXT START -->/
             && $linkfile_contents =~ /<!-- LINKADD TEXT END -->/ )
        {
            ( $top, $contents, $bottom )
                = split( /<!-- LINKADD .*? -->/, $linkfile_contents );
            $top    .= "\n";
            $bottom .= "\n";
            $top    =~ s/\r\n+/\n/sg;
            $bottom =~ s/\r\n+/\n/sg;
            $top    =~ s/\r+/\n/sg;
            $bottom =~ s/\r+/\n/sg;
            $top    =~ s/\n+/\n/sg;
            $bottom =~ s/\n+/\n/sg;

        # Now, we remove the footer from the linkfile contents so we can stick
        # the new text in there. BUT, not if this is admin because presumably
        # admin approved it already. :-)
            $contents =~ s/\n+$/\n\n\n/s;
            $text     =~ s/\r\n+/\n/sg;
            $text     =~ s/\r+/\n/sg;
            $text     =~ s/\n+$//sg;

            # But, if we WANT the email in there, put it back. Silly me.
            if ( $link_email_address =~ /yes/i ) {
                $text
                    =~ s/\(a href=mailto:(.*?\@.*?)\)(.*?)\(\/a\)/<a href=mailto:$1>$2<\/a>/s;
            }
            if ( $links_in_new_window == 1 ) { $tg = " target=\"_blank\""; }
            $text
                = "<a href=\"$linkurl\"$tg>$linktitle</a><br><dd><blockquote>$text</blockquote>$br";
            if ( $add_to_end_of_file =~ /yes/i ) {
                $linkfile_contents
                    = "$top<!-- LINKADD TEXT START -->\n$contents$text\n\n\n<!-- LINKADD TEXT END -->\n$bottom";
            }
            else {
                $linkfile_contents
                    = "$top<!-- LINKADD TEXT START -->\n$text\n\n\n$contents<!-- LINKADD TEXT END -->\n$bottom";
            }

            # Okay.  Now we just open up the linkfile for writing, print the
            # new linkfile contents to the file and close up the file.

            truncate( FILE, length($linkfile_contents) );
            seek( FILE, 0, 0 );
            print FILE "$linkfile_contents";
            close(FILE);
        }
    }
    else {
        print "$header
	   Error: could not find $linkfile to add entry. Please
	   <a href=\"mailto:$owner_email\">notify the administrator</a>.
	   $footer";
        exit();
    }
}

sub get_date {

    @months = ( 'January',   'February', 'March',    'April',
                'May',       'June',     'July',     'August',
                'September', 'October',  'November', 'December'
              );

    ( $sec, $min, $hour, $mday, $mon, $year )
        = ( localtime(time) )[ 0, 1, 2, 3, 4, 5 ];
    $min  = sprintf( "%0.2d", $min );
    $sec  = sprintf( "%0.2d", $sec );
    $hour = sprintf( "%0.2d", $hour );
    $year += 1900;

    $date = "$months[$mon] $mday, $year $hour\:$min\:$sec";
    $date;

}

sub debug {

    if ( $debugging == 1 ) {
        print "DEBUGGING INFO: $_[0] <br>";
    }
}

sub get_data {
    local ($string);

    # get data
    if ( $ENV{'REQUEST_METHOD'} eq 'GET' ) {
        $string = $ENV{'QUERY_STRING'};
    }
    else { read( STDIN, $string, $ENV{'CONTENT_LENGTH'} ); }

    # split data into name=value pairs
    @data = split( /&/, $string );

    # split into name=value pairs in associative array
    foreach (@data) {
        split( /=/, $_ );
        $_[0] =~ s/\+/ /g;          # plus to space
        $_[0] =~ s/%00//g;          # We don' need no steenking nulls :)
        $_[0] =~ s/%0a/newline/g;
        $_[0] =~ s/%(..)/pack("c", hex($1))/ge;    # hex to alphanumeric
        if ( defined( $data{ $_[0] } ) ) {   # In case we have checkboxes. :-)
            $data{ $_[0] } .= "\0";
            $data{ $_[0] } .= "$_[1]";
        }
        else {
            $data{"$_[0]"} = $_[1];
        }
    }

    # translate special characters
    foreach ( keys %data ) {
        $data{"$_"} =~ s/\+/ /g;          # plus to space
        $data{"$_"} =~ s/%00//g;          # We don' need no steenking nulls :)
        $data{"$_"} =~ s/%0a/newline/g;
        $data{"$_"} =~ s/%(..)/pack("c", hex($1))/ge;    # hex to alphanumeric
    }

    %data;    # return associative array of name=value
}

sub dokill {
    kill 9, $child if $child;
}

sub send_mail {

    local ( $toemail,              $toname,
            $fromemail,            $fromname,
            $replytoemail,         $replytoname,
            $subject,              $message,
            $mail_server_hostname, $this_server_hostname,
            $opsys,                $htmlmail
          ) = @_;

    if (    $ENV{'SERVER_NAME'} =~ /tesol.net$/i
         || $ENV{'HTTP_HOST'}   =~ /tesol.net$/i
         || $ENV{'SERVER_NAME'} =~ /linguistic-funland.com$/i
         || $ENV{'HTTP_HOST'}   =~ /linguistic-funland.com$/i )
    {
        print "<b>Sorry, email function disabled in this demo.</b>";
        return;
    }
    &debug("Attempting to send message \"$subject\" to $toemail");
    my ($boundary) = crypt( "blah", time . $$ ) . time . $$;
    foreach $var ( 'toemail',      'toname',
                   'fromemail',    'fromname',
                   'replytoemail', 'replytoname',
                   'subject'
                 )
    {
        ${$var} =~ s/\0/ /sg;
        ${$var} =~ s/\015//sg;
        ${$var} =~ s/\012//sg;
        ${$var} =~ s/\015\012//sg;
        ${$var} =~ s/\s+/ /sg;
    }

    if ( $opsys eq "win" ) {
        my ( $port,     $them, $child,    $sockaddr,
             $hostname, $name, $aliases,  $proto,
             $type,     $len,  $thisaddr, $thataddr
           );
        $port        = 25;
        $them        = "$mail_server_hostname";
        $AF_INET     = 2;
        $SOCK_STREAM = 1;

        $SIG{'INT'} = 'dokill';

        $sockaddr = 'S n a4 x8';

        $hostname = "$this_server_hostname";

        ( $name, $aliases, $proto ) = getprotobyname('tcp');
        ( $name, $aliases, $port ) = getservbyname( $port, 'tcp' )
            unless $port =~ /^\d+$/;
        ( $name, $aliases, $type, $len, $thisaddr )
            = gethostbyname($hostname);
        ( $name, $aliases, $type, $len, $thataddr ) = gethostbyname($them);

        $this = pack( $sockaddr, $AF_INET, 0, $thisaddr );
        $that = pack( $sockaddr, $AF_INET, $port, $thataddr );

        if ( socket( S, $AF_INET, $SOCK_STREAM, $proto ) ) {
        }
        else { &debug("Could not create socket for mail: $!"); }

        if ( bind( S, $this ) ) {
        }
        else {
            &debug("Could not bind to socket (this may be okay anyway): $!");
        }

        if ( connect( S, $that ) ) {
        }
        else { &debug("Could not connect to socket: $!"); }

        select(S);
        $| = 1;
        select(STDOUT);

        $a = <S>;
        print S "HELO $this_server_hostname\n";
        $a = <S>;
        &debug("Mail server responded: $a");
        print S "MAIL FROM:<$fromemail>\r\n";
        $a = <S>;
        &debug("Mail server responded: $a");
        print S "RCPT TO:<$toemail>\r\n";
        $a = <S>;
        &debug("Mail server responded: $a");
        print S "DATA \r\n";
        $a = <S>;
        &debug("Mail server responded: $a");
        print S "To: $toname <$toemail>\n";
        print S "From: $fromname <$fromemail>\n";

        if ( $replytoemail ne "" ) {
            print S "Reply-to: $replytoname <$replytoemail>\n";
        }
        print S "Subject: $subject\n";
        if ( $htmlmail eq "yes" ) {
            print S "MIME-Version: 1.0\n";
            print S "Content-type: MULTIPART/MIXED; BOUNDARY=\"$boundary\"\n";
            print S "--$boundary\n";
            print S "Content-type: text/html;\n\n";
            print S "$message\n";
            print S "\n\n";
            print S "--$boundary\n";
            print S "Content-type: TEXT/PLAIN; charset=US-ASCII\n\n";
            print S "$message--$boundary--\n";
        }
        else {
            print S "\n";
            print S "$message\n";
        }
        print S ".\n";
        $a = <S>;
        &debug("Mail server responded: $a");
        print S "QUIT";
        &debug("Sending mail done.");

    }

    elsif ( $opsys eq "unix" ) {

        # Allow for qmail-inject ~sigh~
        # Most other mailer thingies do use the -t option like
        # sendmail in order to be compatible, but apparently
        # qmail-inject does not. Oh well...

        if ( $path_to_sendmail !~ /qmail-inject/ ) {
            $path_to_sendmail = "$path_to_sendmail -t";
        }

        open( MAIL, "|$path_to_sendmail" )
            || &debug("Could not open sendmail: $!");
        print MAIL "To: \"$toname\" <$toemail>\n";
        print MAIL "From: \"$fromname\" <$fromemail>\n";
        if ( $replytoemail ne "" ) {
            print MAIL "Reply-to: \"$replytoname\" <$replytoemail>\n";
        }
        print MAIL "Subject: $subject\n";
        if ( $htmlmail eq "yes" ) {
            print MAIL "MIME-Version: 1.0\n";
            print MAIL
                "Content-type: MULTIPART/MIXED; BOUNDARY=\"$boundary\"\n";
            print MAIL "--$boundary\n";
            print MAIL "Content-type: text/html;\n\n";
            print MAIL "$message\n";
            print MAIL "\n\n";
            print MAIL "--$boundary\n";
            print MAIL "Content-type: TEXT/PLAIN; charset=US-ASCII\n\n";
            print MAIL "$message--$boundary--\n";
        }
        else {
            print MAIL "\n";
            print MAIL "$message\n";
        }
        close(MAIL) || &debug("Sending mail got an error: $! $?");
        &debug("Sending mail done.");
    }

    else {

        &debug(
            "Cannot send mail. '$opsys' is not a valid operating sytem.
           Please set \$opsys to either 'unix' or 'win' in the script
           and try this again."
              );
    }
}

sub check_length {

    my $len = length( $data{'Text'} );
    if ( $len > $submission_length ) {
        print "$header<h2>Error: Cannot Process Your Submission!</h2><P> 
	   Sorry, but entries are limited to a length of $submission_length
	   characters. You have entered $len characters. Please 
           <a onClick=\"javascript:history.back();\"
	   href=\"$ENV{'HTTP_REFERER'}\">Click 
           here to go back and shorten your entry.</a> $footer";
        exit();
    }

}

sub handle_pending_additions {

    # linkfile|linkfile_url|Name|Email|LinkURL|LinkTitle|LinkDescription
    open( PA, ">>$pending_entries_file" )
        || &debug(
        "Could not open pending entries file ($pending_entries_file) to add submission: $!"
        );
    if ( $opsys eq "unix" ) { flock( PA, 2 ); }
    else { binmode(PA); }
    $text     =~ s/\s+/ /sg;
    $name     =~ s/\s+/ /sg;
    $email    =~ s/\s+/ /sg;
    $linkfile =~ s/\s+/ /sg;
    $linkurl  =~ s/\s+/ /sg;
    $text     =~ s/\s+/ /sg;
    print PA
        "$linkfile|$linkfile_url|$name|$email|$linkurl|$linktitle|$text\n";
    close(PA);
}

sub check_auth {

    my ($login)    = $data{'admlogin'};
    my ($password) = $data{'admpassword'};

    if (    $login ne $admin_login
         || $login eq ""
         || $password ne $admin_password
         || $password eq "" )
    {
        $error
            = "<b><font color=\"#FF0000\">Error: Invalid login or password.</font>
             </b><br><br>";
        &admin_login_screen();
        exit();
    }
    $footer = qq[
  <hr>
  <table border=0>
  <form method="POST" action="$cgi_url">
  <input type=hidden name=admlogin value="$login">
  <input type=hidden name=admpassword value="$password">
  <input type=hidden name=FA value="Login">
  <tr><td><input type=submit value="Admin Menu"></td>
  </form>
  </tr></table></form>
  <hr>
  $footer
  ];
}

sub admin_login_screen {

    print qq[
        $header
        $error
        <b>Please log in for administrative functions</b>
        <form method="POST" action="$cgi_url">
        <table border=1 cellspacing=0>
        <tr>
        <td>Username:</td>
        <td><input type=text name="admlogin" value="$data{'admlogin'}"></td>
        </tr><tr>
        <td>Password:</td>
        <td><input type=password name="admpassword" value="$data{'admpassword'}"></td>
        </tr><tr>
        <td colspan=2>
        <input type=hidden name="FA" value="Login">
        <input type=submit value="Log In"></td>
        </tr></table>
        </form>
        $footer
        ];
    exit();

}

sub admin_menu {

    print qq[
$header
$error
<form method="POST" action="$cgi_url">
<b>Welcome to the Administration Section</b>
<br>
Please choose from one of the following options
<table border=0>
<input type=hidden name="admpassword" value="$data{'admpassword'}">
<input type=hidden name="admlogin" value="$data{'admlogin'}">
<tr><td><input type=submit name=FA value="Approve Pending"></td>
<td><input type=submit name=FA value="Edit/Delete Entries"></td>
</tr>
</table>
</form>
$footer
];
    exit();
}

sub approve {
    unless ( -f $pending_entries_file ) {
        print "$header
		<b>Error: Pending entries file $pending_entries_file does
		not exist. Please check your \$pending_entries_file setting
		in the script.</b>
		$footer";
        exit();
    }
    open( FILE, "<$pending_entries_file" )
        || &debug(
        "could not read pending entries file ($pending_entries_file).
		Server said: $!" );
    print "$header$error
		<table>
		<tr><td colspan=3 height=2 bgcolor=#000000></td></tr>
		<tr><th>File Name</th>
		<th>Entry Text</th>
		<th>Action</th></tr>
		<tr><td colspan=3 height=2 bgcolor=#000000></td></tr>
		";
    while (<FILE>) {
        (  $linkfile, $linkfile_url, $name, $email, $linkurl, $linktitle,
           $text
        )
            = split( /\|/, $_ );
        $line          = $_;
        $linkfile_link = $linkfile;
        $linkfile_link =~ s/$filepath//sg;
        chomp( $htmlline = $line );
        $htmlline =~ s/\"/&quot;/sg;
        $htmlline =~ s/</&lt;/sg;
        $htmlline =~ s/>/&gt;/sg;
        $text     =~ s/\"/&quot;/sg;
        $text     =~ s/</&lt;/sg;
        $text     =~ s/>/&gt;/sg;
        print qq[
		<tr>
                <td>
		<a target="_blank" href="$linkfile_url">$linkfile_link</a>
		</td>
		<td bgcolor="#FFFFee">
		<a href=\"$linkurl\">$linktitle</a><br>
		<dd><blockquote>$text</blockquote></dd></td>
		<form method=POST action="$cgi_url">
		<input type=hidden name=ApproveLine value="$htmlline">
		<td>
                <input type=hidden name="admlogin" value="$data{'admlogin'}">
                <input type=hidden name="admpassword" value="$data{'admpassword'}">
		<input type=submit name=FA style="width: 75px" value="Approve"><br>
		<input type=submit name=FA style="width: 75px" value="Del"></td>
		</form>
		</tr>
		<tr><td colspan=3 height=5 bgcolor=#000000></td></tr>
		];

    }
    print "</table>$footer";
    close(FILE);
    exit();
}

sub del_pending {

    $approveline = $data{'ApproveLine'};
    $approveline =~ s/&quot;/\"/sg;
    $approveline =~ s/&lt;/</sg;
    $approveline =~ s/&gt;/>/sg;
    $approveline =~ s/^\s+//sg;
    $approveline =~ s/\s+$//sg;
    open( FILE, "+<$pending_entries_file" )
        || &debug(
        "could not read pending entries file ($pending_entries_file).
		Server said: $!" );
    while (<FILE>) {
        chomp( $line = $_ );
        $origline = $line;
        $line        =~ s/^\s+//sg;
        $line        =~ s/\s+$//sg;
        $line        =~ s/&quot;/\"/sg;
        $line        =~ s/&lt;/</sg;
        $line        =~ s/&gt;/>/sg;
        $line        =~ s/^\s+//sg;
        $approveline =~ s/\s+$//sg;

        if ( $line ne $approveline ) {
            $newfile .= "$origline\n";
        }
    }
    truncate( FILE, length($newfile) );
    seek( FILE, 0, 0 );
    print FILE $newfile;
    close(FILE);
    $error = "Line deleted.";
    &approve;
    exit();
}

sub approve_pending {
    $approveline = $data{'ApproveLine'};
    $approveline =~ s/&quot;/\"/sg;
    $approveline =~ s/&lt;/</sg;
    $approveline =~ s/&gt;/>/sg;
    $approveline =~ s/^\s+//sg;
    $approveline =~ s/\s+$//sg;
    open( FILE, "<$pending_entries_file" )
        || &debug(
        "could not read pending entries file ($pending_entries_file).
		Server said: $!" );
    while (<FILE>) {
        chomp();
        $origline = $_;
        $testline = $_;
        $testline =~ s/&quot;/\"/sg;
        $testline =~ s/&lt;/</sg;
        $testline =~ s/&gt;/>/sg;
        $testline =~ s/^\s+//sg;
        $testline =~ s/\s+$//sg;

        if ( $testline eq $approveline ) {
            (  $linkfile, $linkfile_url, $name, $email, $linkurl, $linktitle,
               $text
            ) = split( /\|/, $origline );
            last;
        }
    }
    close(FILE);

    # Write to linkfile
    &write_to_linkfile;

    # Remove from pending
    open( FILE, "+<$pending_entries_file" )
        || &debug(
        "could not read pending entries file ($pending_entries_file).
		Server said: $!" );
    while (<FILE>) {
        chomp( $line = $_ );
        $origline = $line;
        $line        =~ s/^\s+//sg;
        $line        =~ s/\s+$//sg;
        $line        =~ s/&quot;/\"/sg;
        $line        =~ s/&lt;/</sg;
        $line        =~ s/&gt;/>/sg;
        $line        =~ s/^\s+//sg;
        $approveline =~ s/\s+$//sg;

        if ( $line ne $approveline ) {
            $newfile .= "$origline\n";
        }
    }
    truncate( FILE, length($newfile) );
    seek( FILE, 0, 0 );
    print FILE $newfile;
    close(FILE);
    $error = "Okay, Added to <a href=$linkfile_url>$linkfile</a>";
    &approve();

}

sub edit_del {
    $linkfile_to_use = $linkfile;
    undef $/;
    open( FILE, "<$linkfile_to_use" )
        || &debug(
        "could not open $linkfile_to_use (\$linkfile_to_use) for reading. The server said: $!"
        );
    $linkfile_contents = <FILE>;
    close(FILE);

    if (    $linkfile_contents =~ /<!-- LINKADD TEXT START -->/
         && $linkfile_contents =~ /<!-- LINKADD TEXT END -->/ )
    {
        ( $top, $contents, $bottom )
            = split( /<!-- LINKADD .*? -->/, $linkfile_contents );
        $top    =~ s/\r\n+/\n/sg;
        $bottom =~ s/\r\n+/\n/sg;
        $top    =~ s/\r+/\n/sg;
        $bottom =~ s/\r+/\n/sg;
        $top    =~ s/\n+/\n/sg;
        $bottom =~ s/\n+/\n/sg;
    }
    else {
        print "$header
		Not a linkfile: could not find LINKADD TEXT tags.
		$footer";
        exit();
    }
    @entries = split( /\n\n\n+/, $contents );
    $/       = "\n";
    $i       = 0;
    print "$header
	<font size=+2>To update an entry, simply make changes in the field
	and hit \"Update.\" To delete an entry, simply click \"Delete\".
	</font><table>";
    foreach $entry (@entries) {
        $htmlentry = $entry;
        $htmlentry =~ s/\"/&quot;/sg;
        $htmlentry =~ s/>/&gt;/sg;
        $htmlentry =~ s/</&lt;/sg;
        print qq[
                <form name="sfelinkadd_$i" method=POST action="$cgi_url">
                <tr>
                <td colspan=2 valign=bottom>
                  <textarea name="NewEntry" rows=5 cols=50>$entry</textarea>
                </td>
                <input type=hidden name="OrigEntry" value="$htmlentry">
                <input type=hidden name="admlogin" value="$data{'admlogin'}">
                <input type=hidden name="admpassword" value="$data{'admpassword'}">
                <input type=hidden name="linkfile" value="$linkfile_to_use">
                <td valign=bottom><input type=submit name="FA" value="Update" style="width: 67 px"><br>
                  <input type=submit onClick="return confirm('WARNING!\\n\\nAre you sure you want to totally delete this entry:\\n\\n' + document.sfelinkadd_$i.OrigEntry.value + '\\n\\nClick OK to completely delete this entry.\\n\\nClick Cancel to cancel deletion.');" name="FA" value ="Delete" style="width: 67px"></td></tr>
                </form>
                <tr><td colspan=3 height=15 bgcolor="#EEEEFF"></td></tr>
                ];
        $i++;
    }
    print "</table>$footer";
    exit();

}

sub check_errors {

    unless ( -f $linkfile ) {
        $errors
            = "Error: Cannot find \$linkfile ($linkfile). This may mean that
		the path to the file is not correct, or there is another error.
		please double-check this and, if necessary, 
		fix it in the script.<br><br>";
    }
    unless ( -w $linkfile ) {
        $errors .= "Error: I cannot write to \$linkfile ($linkfile).
		    Please check the permissions and
		    make sure that the file exists and is writeable by the web
		    server. (Sometimes, this means 'chmod 766 $linkfile'.)<br><br>";
    }
    unless ( -x $path_to_sendmail ) {
        if ( $opsys eq "unix"
             && (    $mail_me_the_submissions eq "yes"
                  || $mail_me_the_submissions == 1 )
           )
        {
            $errors
                .= "Error: you said \$path_to_sendmail was \"$path_to_sendmail\"
			but I can't find that file, or I can't run it. This means
			that I won't be able to email you submissions to the links page.
			Please fix the path to sendmail or qmail-inject
			(make sure you didn't add \"-t\" or other options to it), or
			set \$mail_me_the_submissions = \"no\"; in the script and
			I won't try to find it anymore.<br><br>";
        }
    }
    if ( $submissions_require_approval == 1 ) {
        unless ( -f $pending_entries_file && -w $pending_entries_file ) {
            $errors .= "Error: You have set \$submissions_require_approval = 1
		but the file you designated as \$pending_entries_file 
		($pending_entries_file) either doesn't exist, isn't a regular
		file, and/or I can't write to it. Please either make sure
		the file exists where you said it did, and that it is writeable
		(usually chmod 766).<br><br>\n";
        }
    }
    if (    $admin_password =~ /^password$/i
         && $ENV{'SERVER_NAME'} !~ /tesol.net$/i
         && $ENV{'HTTP_HOST'} !~ /tesol.net$/i
         && $ENV{'SERVER_NAME'} !~ /linguistic-funland.com$/i
         && $ENV{'HTTP_HOST'} !~ /linguistic-funland.com$/i )
    {
        $errors .= "Error: You have not changed the admin password
		(\$admin_password) from \"password\" to something else.
		This is a serious security risk, so the script will not
		run until you change the password. :-) <br><br>";
    }
    if ($errors) {
        print "$header<br><br>
		<b>Oops! Configuration Error!</b><br><br>
		I found the following problems in your configuration. Until these
		are corrected, the SFELinkAdd program can't run:<br><br>
		$errors
		The following information may be helpful in finding paths and
		so forth:<br><br>";
        print "Path Translated: $ENV{'PATH_TRANSLATED'}<br>"
            if $ENV{'PATH_TRANSLATED'};
        print "Document Root: $ENV{'DOCUMENT_ROOT'}<br>"
            if $ENV{'DOCUMENT_ROOT'};
        print "HTTP_HOST: $ENV{'HTTP_HOST'}<br>" if $ENV{'HTTP_HOST'};
        print "Server Software: $ENV{'SERVER_SOFTWARE'}<br>"
            if $ENV{'SERVER_SOFTWARE'};
        print "Operating System: $^O<br>" if $^O;
        print "Perl Version: $]<br>"      if $];
        print "Script Name: $ENV{'SCRIPT_FILENAME'}<br>"
            if $ENV{'SCRIPT_FILENAME'};

        print
            "<br>If you're not sure what to make of all this, don't worry! Just
		copy and paste all this into an email to me using
		<a href=\"http://tesol.net/scripts/scriptmail.html\">this form</a>
		and let me know a little bit about what you were doing, and I'll
		try to help you! --Kristina<br>
		$footer";
        exit();
    }

}

sub update {
    $origentry       = $data{'OrigEntry'};
    $newentry        = $data{'NewEntry'};
    $linkfile_to_use = $data{'linkfile'};
    unless ( -f $linkfile_to_use ) {
        print "Could not update: $linkfile_to_use not found.<br>";
        &edit_del;
        exit();
    }
    undef $/;
    open( FILE, "+<$linkfile_to_use" )
        || &debug(
        "could not open $linkfile_to_use (\$linkfile_to_use) for reading. The server said: $!"
        );
    if ( $opsys eq "unix" ) { flock( FILE, 2 ); }
    else { binmode(FILE); }

    $linkfile_contents = <FILE>;

    if (    $linkfile_contents =~ /<!-- LINKADD TEXT START -->/s
         && $linkfile_contents =~ /<!-- LINKADD TEXT END -->/s )
    {
        ( $top, $contents, $bottom )
            = split( /<!-- LINKADD .*? -->/, $linkfile_contents );
    }
    else {
        print
            "Not a linkfile ($linkfile_to_use): could not find LINKADD TEXT tags.";
        close(FILE);
        exit();
    }
    @entries = split( /\n\n\n+/, $contents );
    $i = 0;
    print "\n";
    $newfile = "$top\n<!-- LINKADD TEXT START -->\n";
    foreach $entry (@entries) {
        $origentry =~ s/&quot;/\"/sg;
        $origentry =~ s/&gt;/>/sg;
        $origentry =~ s/&lt;/</sg;
        $origentry =~ s/^\s+//sg;
        $origentry =~ s/\s+$//sg;
        $origentry =~ s/\r\n/\n/sg;
        $origentry =~ s/\r/\n/sg;
        $entry     =~ s/^\s+//sg;
        $entry     =~ s/\s+$//sg;
        $entry     =~ s/\r\n/\n/sg;
        $entry     =~ s/\r/\n/sg;

        if ( $origentry eq $entry ) {
            $newfile .= "$newentry\n\n\n";
        }
        else {
            $newfile .= "$entry\n\n\n";
        }
    }
    $newfile .= "<!-- LINKADD TEXT END -->\n$bottom";
    truncate( FILE, length($newfile) );
    seek( FILE, 0, 0 );
    print FILE $newfile;
    close(FILE);
    print "Updated.<br>";
    &edit_del;
    exit();

}

sub delete {
    $origentry       = $data{'OrigEntry'};
    $newentry        = $data{'NewEntry'};
    $linkfile_to_use = $data{'linkfile'};
    unless ( -f $linkfile_to_use ) {
        print "Could not update: $linkfile_to_use not found.<br>";
        &edit_del;
        exit();
    }
    undef $/;
    open( FILE, "+<$linkfile_to_use" )
        || &debug(
        "could not open $linkfile_to_use (\$linkfile_to_use) for reading. The server said: $!"
        );
    if ( $opsys eq "unix" ) { flock( FILE, 2 ); }
    else { binmode(FILE); }

    $linkfile_contents = <FILE>;

    if (    $linkfile_contents =~ /<!-- LINKADD TEXT START -->/
         && $linkfile_contents =~ /<!-- LINKADD TEXT END -->/ )
    {
        ( $top, $contents, $bottom )
            = split( /<!-- LINKADD .*? -->/, $linkfile_contents );
        $top    =~ s/\r\n+/\n/sg;
        $bottom =~ s/\r\n+/\n/sg;
        $top    =~ s/\r+/\n/sg;
        $bottom =~ s/\r+/\n/sg;
        $top    =~ s/\n+/\n/sg;
        $bottom =~ s/\n+/\n/sg;
    }
    else {
        print
            "Not a linkfile ($linkfile_to_use): could not find LINKADD TEXT tags.";
        close(FILE);
        exit();
    }
    @entries = split( /\n\n\n+/, $contents );
    $i       = 0;
    $newfile = "$top\n<!-- LINKADD TEXT START -->\n";
    foreach $entry (@entries) {
        $origentry =~ s/&quot;/\"/sg;
        $origentry =~ s/&gt;/>/sg;
        $origentry =~ s/&lt;/</sg;
        $origentry =~ s/^\s+//sg;
        $origentry =~ s/\s+$//sg;
        $origentry =~ s/\r\n/\n/sg;
        $origentry =~ s/\r/\n/sg;
        $entry     =~ s/&quot;/\"/sg;
        $entry     =~ s/&gt;/>/sg;
        $entry     =~ s/&lt;/</sg;
        $entry     =~ s/^\s+//sg;
        $entry     =~ s/\s+$//sg;
        $entry     =~ s/\r\n/\n/sg;
        $entry     =~ s/\r/\n/sg;

        if ( $entry ne $origentry ) {
            $newfile .= "$entry\n\n\n";
        }
    }
    $newfile .= "<!-- LINKADD TEXT END -->\n$bottom";
    truncate( FILE, length($newfile) );
    seek( FILE, 0, 0 );
    print FILE $newfile;
    close(FILE);
    print "Updated.<br>";
    &edit_del;
    exit();

}

sub strip_text {

    my ($text) = $_[0];
    my ( @allowed_tags_raw, @allowed_tags_escaped, $escaped_tags, $i );

    # If they want us to strip HTML, do it.
    # First, if they put in &lt; or &gt; on purpose, make it < and >
    if ( $strip_html ne "no" ) {
        $text =~ s/&gt;/>/isg;
        $text =~ s/&lt;/</isg;
        $text =~ s/&quot;/\"/isg;
    }

    # Now, go through each of the allowed tags, and change <br> to &lt;br&gt;
    # etc. When we get done with this, any < or > that we want to keep will
    # be escaped.
    if ( $allow_certain_tags ne "" ) {
        @allowed_tags_raw = split( /,/, $allow_certain_tags );
        $escaped_tags = $allow_certain_tags;
        $escaped_tags =~ s/</&lt;/isg;
        $escaped_tags =~ s/>/&gt;/isg;
        $escaped_tags =~ s/\"/&quot;/isg;
        @allowed_tags_escaped = split( /,/, $escaped_tags );
        $i = 0;
        foreach (@allowed_tags_escaped) {

            if (    $allowed_tags_raw[$i] =~ /script/is
                 || $allowed_tags_raw[$i] =~ /href/is
                 || $allowed_tags_raw[$i] =~ /img/is
                 || $allowed_tags_raw[$i] =~ /!--#/is )
            {
                $i++;
                next;
            }
            $text =~ s/$allowed_tags_raw[$i]/$allowed_tags_escaped[$i]/isg;
            $i++;
        }
    }

    # Now, we just blatantly remove all those < >
    if ( $strip_html ne "no" ) {
        $text =~ s/>/\)/sg;
        $text =~ s/</\(/sg;
        $text =~ s/\"//sg;
    }

    # And whatever is left is what we want.
    $text =~ s/&gt;/>/sg;
    $text =~ s/&lt;/</sg;
    $text =~ s/&quot;/\"/sg;
    return $text;

}

sub print_submission_form {

    if ( -f "$path_to_submission_form_file" ) {
        open( F, "<$path_to_submission_form_file" );
        while (<F>) {
            print;
        }
        close(F);
        exit();
    }
    debug(
        "Could not find \$path_to_submission_form_file ($path_to_submission_form_file). Using default submission form."
    );

    if ( $hide_authors_names =~ /^yes$/i ) {
        $name_public = "(won't be shown)";
    }
    else {
        $name_public = "(will be public)";
    }
    if ( $link_email_address =~ /no/i ) {
        $email_public = "(won't be shown)";
    }
    else {
        $email_public = "(will be public)";
    }
    if ( $submission_length eq "unlimited" ) {
        $sltext = "(Unlimited text)";
    }
    elsif ( $submission_length =~ /^\d+$/ ) {
        $sltext    = "(Max $submission_length characters including spaces)";
        $maxlength = " maxlength=\"$submission_length\"";
    }
    else {
        $sltext = "";
    }

    print <<EOF;
<html>
<head>
<title>
Link Submission Form
</title>
</head>
<body bgcolor="#FFFFFF">
<center>
<h1>Link Submission Form</h1>
</center>
$error
<!-- You'll need to **CHANGE** the line below so that it 	-->
<!-- points to the URL of where you have put the makebook.cgi	-->
<!-- program.  You will NOT be able to run the one on my	-->
<!-- server, so if you don't change the line below, this script	-->
<!-- will never work.  Make sure you use the full URL, http and	-->
<!-- all: e.g. "http://www.yoursite.edu/cgi-bin" etc.		-->


<form method=POST action="$cgi_url">

<!-- You can obviously change the text below to something more	-->
<!-- suitable to your form.  The script doesn't depend on any	-->
<!-- particular format of HTML, but the "input" lines should 	-->
<!-- stay exactly as they are.					-->

Please fill out the form below to submit a link to our directory. You
may also <a href="$linkfile_url">click here to view the links directory</a>.
<P>
<center>
<table border=0>
<tr>
  <th align="left">Your Name $name_public:</th><td>
  <input name="Name" type=text size=20 value="$data{'Name'}"> </td></tr>
  <tr><th align="left">Your email address $email_public:</th><td>
  <input name="Email" type=text size=20 value="$data{'Email'}"> </td></tr>
  <tr><th align="left">Link Title (short title):</th><td>
  <input name="LinkTitle" type=text size=20 value="$data{'LinkTitle'}"> </td></tr>
  <tr><th align="left">Link URL (include http://):</th><td>
  <input name="LinkURL" type=text size=20 value="$data{'LinkURL'}"> </td></tr>
<tr><td colspan=2>
<b>Description of this link $sltext:</b><br>

<textarea wrap=hard name="Text" rows=5 cols=50$maxlength>$data{'Text'}</textarea>

<P><INPUT TYPE=submit value="Send this!">|
<INPUT TYPE=reset value="Reset Form!"> </form>

</table>
</center>
<hr> </body> </html>
EOF

}