#!/usr/bin/perl
#
########################################################################
##                d-mail.pl                                           ##
##                                                                    ##
##       Author:  Dan Kaplan                                          ##
##        Email:  rundown@run-down.com                                ##
##                design@abledesign.com                               ##
##     Web Site:  http://run-down.com/                                ##
##                http://AbleDesign.com/                              ##
##  Description:  A simple way to make newsletter/discussion list     ##
##                email subscribe/unsubscribe links function as a     ##
##                handy form selection box.                           ##
##       Version: 1.01                                                ##
## Last Modified: 9/21/00                                             ##
##                                                                    ##
## COPYRIGHT NOTICE:                                                  ##
##                                                                    ##
## Copyright 2000 Run-Down & AbleDesign.  All Rights Reserved.        ##
##                                                                    ##
## This program is distributed as freeware.  It may be used and       ##
## modified free of charge, so long as this copyright notice and      ##
## the header above remain intact.  Please also send me an email,     ##
## and let me know where you are using this script. By using this     ##
## program you agree to indemnify Run-Down and AbleDesign from any    ##
## liability.                                                         ##
##                                                                    ##
########################################################################
##
## Instructions:
## 
## 1) Change the first line of this file to the correct path to Perl, if required.
## 2) Set the User Information variables in the next section.
## 3) Upload d-mail.pl (this file) into your cgi-bin in ASCII mode and set the permissions to 755.
## 4) Use the following subscribe/unsubscribe form in your HTML (do not change the NAME/VALUE items):
##
## <FORM ACTION="/cgi-bin/d-mail.pl" METHOD="POST">
##	 <CENTER>
##	 <TABLE WIDTH="200" BORDER="2" cellpadding="2">
##		<TR><TD WIDTH="100%" ALIGN="CENTER">
##			<B>Mailing List:</B>
##			<INPUT TYPE="TEXT" SIZE="15" NAME="email" VALUE=""><BR>
##			<INPUT TYPE="RADIO" NAME="subscribe" VALUE="subscribe" CHECKED>
##			<FONT size="1">Subscribe &nbsp; <INPUT TYPE="RADIO" NAME="subscribe" VALUE="unsubscribe">Unsubscribe</FONT><BR>
##			<INPUT TYPE="SUBMIT" VALUE="Submit"><BR>
##		</TD></TR>
##	 </TABLE>
##	 </CENTER>
## </FORM>
##
## 5) You're done!
##
########################################################################

########################################################################
# EDIT USER INFORMATION BELOW
########################################################################

# Type the full path to your Mail program
$mailprog = "|/usr/lib/sendmail -t -oeq";

# Type your email address between the quotes.  Make sure to place a \ in front of the @
# As an example:  d-mail\@dankaplan.com
$admin_email = "you\@domain.com";

# Email addresses to send subscribe and unsubscribe requests to.
# Make sure to place a \ in front of the @
$subscribe = "sign-on\@listaddress.com";
$unsubscribe = "sign-off\@listaddress.com";

# Type the name of your mailing list
$list_name = "Your List Name";

# Type your website URL (example: http://www.yoursite.com)
$site_url = "http://www.yoursite.com/";

#########################################################################
# Optional (page_header and page_footer subs)
#########################################################################

sub page_header {
# --------------------------------------------------------
# This section allows you to format your output pages (put all HTML between
# "print qq|" and "|;") Do not remove the &html_print_headers line.  
#
# If you have a header file that you would like included, uncomment (remove the
# "#" at the beginning of the line) the three lines below and change the file names
# and paths in the "open" lines.  If you do not wish to include a header file, leave
# the lines commented out.  You may add additional page layout to this area.

    &html_print_headers;

    print qq|
      <html><head><title>$list_name: $page_title</title>
	  </head>
      <body background="" bgcolor="#FFFFFF">
	|;
	open (FILE, "/path/to/top.txt") or die "can't open: top.txt ($!)";
		print <FILE>;
	close FILE;
}

sub page_footer {
# --------------------------------------------------------
# This section allows you to finish the formatting of your pages (put all HTML
# between "print qq|" and "|;") Do not remove the &html_print_headers line.  
#
# If you have a footer file that you would like included, uncomment (remove the
# "#" at the beginning of the line) the three lines below and change the file names
# and paths in the "open" lines.  If you do not wish to include a footer file, leave
# the lines commented out.  You may add additional page layout to this area.

	open (FILE, "/path/to/bottom.txt") or die "can't open: bottom.txt ($!)";
		print <FILE>;
	close FILE;
	print qq|
	  </body></html>
    |;
}

#########################################################################
# DO NOT EDIT SECTION BELOW 
#########################################################################

if ($ENV{'REQUEST_METHOD'} eq 'GET') {
		# Split the name-value pairs
		@pairs = split(/&/, $ENV{'QUERY_STRING'});
	}
	elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
		# Get the input
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
		# Split the name-value pairs
		@pairs = split(/&/, $buffer);
	}
	else {
		&error;
	}
foreach $pair (@pairs) {
	# Split the pair up into individual variables.
	local($name, $value) = split(/=/, $pair);

	# Decode the form encoding on the name and value variables.
	$name =~ tr/+/ /;
	$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

	# If they try to include server side includes, erase them,
	# so they aren't a security risk if the html gets returned.
	$value =~ s/<!--(.|\n)*-->//g;

	if ($INPUT{$name}) {
		$INPUT{$name} = $INPUT{$name}.",".$value;
	}
	else {
		$INPUT{$name} = $value;
	}
}

##########################################################################
# DO NOT EDIT SECTION ABOVE 
##########################################################################

##########################################################################
# Subscribe or Unsubscribe request?
#

if ($INPUT{'subscribe'} eq "subscribe") { &subscribe; }
elsif ($INPUT{'subscribe'} eq "unsubscribe")  {&unsubscribe; }
else {&error; }
exit;

sub subscribe {
# ---------------------------------------------------------------------
# Successful Subscribe request

    $page_title = "Email Address Added";
    &page_header;

print qq|
	<P><B>Subscription Success</B></P>
	<P>Your email address:  <B>$INPUT{'email'}</B> has been added to the $list_name mailing list.</P>
	<P>If at any time you wish to be removed from our list, you may do so <A HREF="$site_url">at our web site</A>.
	Please contact <A HREF="mailto:$admin_email">$admin_email</A> if you have any questions.</P>
|;

    &page_footer;

	open (MAIL, "$mailprog") || print "Can't start mail program";
		print MAIL "To: $subscribe\n";
		print MAIL "From: $INPUT{'email'}\n";
		print MAIL "Subject: Subscribe\n\n";
	close (MAIL);

	exit;
}

sub unsubscribe {
# ---------------------------------------------------------------------
# Successful Unsubscribe request

    $page_title = "Email Address Removed";
    &page_header;

print qq|
	<P><B>Unsubscription Success</B></P>
	<P>Your email address:  <B>$INPUT{'email'}</B> has been removed from the $list_name mailing list.  We are sorry to see you go.</P>
	<P>If ever you desire to be re-added to our list, you may do so <A HREF="$site_url">at our web site</A>.
	Please contact <A HREF="mailto:$admin_email">$admin_email</A> if you have any questions.</P>
|;

    &page_footer;

	open (MAIL, "$mailprog") || print "Can't start mail program";
		print MAIL "To: $unsubscribe\n";
		print MAIL "From: $INPUT{'email'}\n";
		print MAIL "Subject: Unsubscribe\n\n";
	close (MAIL);

	exit;
}

sub error {
# ---------------------------------------------------------------------
# A problem was encountered

    $page_title = "Error";
    &page_header;

print qq|
	<P><B>Error!</B></P>
	<P>Your request could not be processed.  Please go back and try again, or 
	contact <A HREF="mailto:$admin_email">$admin_email</A> for assistance.</P>
|;

    &page_footer;

	exit;
}

sub html_print_headers {
# ---------------------------------------------------------------------
# Print out the headers if they haven't already been printed.

    if (!$html_headers_printed) {		
      print "Content-type: text/html\n\n";
      $html_headers_printed = 1;
    }
}