#!/usr/bin/perl
use Socket;
$|=1;
##################################################################
#  birdcast.cgi Version 2.0
#  updated May 2, 1999
#  (C)1998, 1999 Bignosebird.com
#  This software is FREEWARE! Do with it as you wish. It is yours
#  to share and enjoy. Modify it, improve it, and have fun with it!
#  It is distributed strictly as a learning aid and bignosebird.com
#  disclaims all warranties- including but not limited to:
#  fitness for a particular purpose, merchantability, loss of
#  business, harm to your system, etc... ALWAYS BACK UP YOUR
#  SYSTEM BEFORE INSTALLING ANY SCRIPT OR PROGRAM FROM ANY
#  SOURCE!
##################################################################

# CONFIGURATION NOTES

#
# $SCRIPT_NAME is the full URL of this script, including the
# http part, ie, "http://domainname.com/cgi-bin/birdcast.cgi";
#
# $SITE_NAME is the "name" of your web site.
# $SITE_URL is the URL of your site (highest level)
# $END_LINE is the very last line printed in the e-mail.
#
# $MAXNUM is the number of possible people a person can refer
# your URL to at one time. If you call the script using the
# GET method, then this is also the number of entry blanks
# created for recipient names and addresses.
#
# $SMTP_SERVER is the name of your e-mail gateway server, or
# SMTP host. On most systems, "localhost" will work just fine.
# If not, change "localhost" to whatever your ISP's SMTP
# server name is, ie, smtp.isp.net or mail.isp.net

# $SEND_MAIL is the full path to your server's sendmail program
# If you do not wish to use Sockets for some reason and need
# to use sendmail, uncomment the $SEND_MAIL line and comment
# the $SMTP_SERVER line.

# okaydomains is a list of domains from which you want to allow
# the script to be called from.  Leave it commented to leave the
# script unrestricted. If you choose to use it, be sure to list
# your site URL with and without the www.

#  Use either $SMTP_SERVER
   $SMTP_SERVER="mail.turbix.com";
#
#     OR
#
#   $SEND_MAIL="/usr/lib/sendmail -t";
#
#      BUT NEVER BOTH!!!!!!

   @okaydomains=("http://www.turbix.com", "http://turbix.com");

   $SCRIPT_NAME="http://www.turbix.com/cgi_shl/birdcast.cgi";
   $SITE_NAME="TURBIX";
   $SITE_URL="http://www.turbix.com/";
   $ENDLINE="TURBIX, confort hygiène et santé grace à l'aspiration centralisée!";
   $MAXNUM=5;
   $LOGFILE="reflog.txt";
##################################################
# Renvoi vers une page de remerciements
   $merci="../merci.htm";
##################################################

   if ($SENDMAIL ne "")
     {&test_sendmail;}


#   &valid_page;    #if script is called from offsite, bounce it!
   &decode_vars;
   if ( $ENV{'REQUEST_METHOD'} ne "POST")
    {
      &draw_request;
      exit;
    }
   &do_log;
   &process_mail;
   print "Location: $JUMP_TO\n\n";

##################################################################
sub process_mail
 {
for ($i=1;$i<$MAXNUM+1;$i++)
    {
      $recipname="recipname_$i";
      $recipemail="recipemail_$i";
      if ($fields{$recipemail} eq "")
        {
         next;
        }
      if (&valid_address == 0)
        {
         next;
        }

#BNB SAYS! You can modify the Subject line below.

$subject = "Message de $fields{'send_name'}";

#BNB SAYS! Modify the lines below between the lines marked
# with __STOP_OF_MAIL__ to customize your e-mail message
# DO NOT remove the lines that contain __STOP_OF_MAIL__!
# If you enter any hardcoded e-mail addresses, BE SURE TO
# put the backslash before the at sign, ie, me\@here.net

$msgtxt = <<__STOP_OF_MAIL__;
Bonjour  $fields{$recipname},

$fields{'send_name'} a visité le site $SITE_NAME et suggère que vous vous rendiez à cette adresse:

   $SITE_URL

__STOP_OF_MAIL__

      if ($fields{'message'} ne "")
       {
         $msgtxt .= "Voici son message....\n";
         $msgtxt .= "$fields{'message'}\n\n";
       }
#       $msgtxt .= "$SITE_NAME\n";
       $msgtxt .= "$ENDLINE\n";
#       $msgtxt .= "$SITE_URL\n\n";
       $mailresult=&sendmail($fields{send_email}, $fields{send_email}, $fields{$recipemail}, $SMTP_SERVER, $subject, $msgtxt);

      if ($mailresult ne "1")
      {print "Content-type: text/html\n\n";
       print "MAIL non envoyé. Erreur SMTP: $mailresult\n";
       exit
      }

    }
 }

##################################################################
sub draw_request
 {
print "Content-type: text/html\n\n";

#BNB SAYS! Here is the part that draws the page that asks the
#reader to enter e-mail addresses and names. Tailor it to meet
# your needs if necessary. DO NOT disturb the lines with
# __REQUEST__ on them.

print <<__REQUEST__;
<head>
<meta name="title" content="Recommendez ce site &agrave; vos amis !" />
<meta name="robots" content="NOINDEX, NOFOLLOW" />
<link href="../style.css" rel="stylesheet" type="text/css">
</head>
<BODY BGCOLOR="#FFFFFF">
<CENTER>
<P>
<TABLE WIDTH=500 BGCOLOR="FFFFFF">
 <TR>
    <TD background=""> <FONT FACE="ARIAL" SIZE=4 COLOR="#009900">&nbsp;
      </FONT><FONT FACE="ARIAL" SIZE=3 COLOR="#000099"><B><CENTER>
        <font color="#000099"><img src="/images/logo_400.gif" width="200" height="56"><br><br>
        Suggérer cette page à des amis...
        </font><P>
  </CENTER>
      </B> </FONT> <FONT FACE="ARIAL" SIZE=2 COLOR="#000000"> Vous pouvez recommander
      notre site à vos amis en utilisant ce formulaire.
      <P>
 Nous vous en remercions.!
 </FONT>
<FORM METHOD="POST" ACTION="$SCRIPT_NAME">
   <INPUT TYPE="HIDDEN" NAME="call_by" VALUE=$ENV{'HTTP_REFERER'}>
   <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 >
    <TR>
    <TD>&nbsp;</TD>
    <TD ALIGN=CENTER><B>Nom</B></TD>
    <TD ALIGN=CENTER><B>Adresse E-Mail</B><TD>
    </TR>
    <TR>
    <TD><B>Vous</B></TD>
    <TD><INPUT TYPE="TEXT" NAME="send_name"></TD>
    <TD><INPUT TYPE="TEXT" NAME="send_email"></TD>
    </TR>
__REQUEST__
    for ($i=1;$i<$MAXNUM+1;$i++)
     {
    print <<__STOP_OF_ROW__;
    <TR>
    <TD><B>Ami n° $i</B></TD>
    <TD><INPUT TYPE="TEXT" NAME="recipname_$i"></TD>
    <TD><INPUT TYPE="TEXT" NAME="recipemail_$i"></TD>
    </TR>
__STOP_OF_ROW__
     }
    print <<__REQUEST2__;
   <TR>
   <TD>&nbsp;</TD>
   <TD ALIGN=CENTER COLSPAN=2>
   <B>Votre message</B><BR>
 <textarea name="message" wrap=virtual rows=5 cols=35></textarea>
    <BR>
    <INPUT TYPE="submit" VALUE="Envoyer">
    </TD>
    </TR>
  </TABLE>
    </FORM>
   </CENTER>
  </TD>
  </TR>
  </TABLE>
__REQUEST2__
 }

##################################################################
#  NOTHING TO MESS WITH BEYOND THIS POINT!!!!
##################################################################
sub decode_vars
 {
 $i=0;
  if ( $ENV{'REQUEST_METHOD'} eq "GET")
   {
     $temp=$ENV{'QUERY_STRING'};
   }
   else
    {
      read(STDIN,$temp,$ENV{'CONTENT_LENGTH'});
    }
  @pairs=split(/&/,$temp);
  foreach $item(@pairs)
   {
    ($key,$content)=split(/=/,$item,2);
    $content=~tr/+/ /;
    $content=~s/%(..)/pack("c",hex($1))/ge;
    $content=~s/\012//gs;
    $content=~s/\015/ /gs;
    $fields{$key}=$content;
   }
   if ($fields{'call_by'} eq "")
    {
     $JUMP_TO = $ENV{'HTTP_REFERER'};
    }
   else
    {
#     $JUMP_TO = $fields{'call_by'};
    $JUMP_TO = $merci;
    }
}

##################################################################
sub valid_address
 {
  $testmail = $fields{$recipemail};
  if ($testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||
  $testmail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/)
   {
     return 0;
   }
   else
    {
        return 1;
    }
}

sub valid_page
 {
 if (@okaydomains == 0) {return;}
  $DOMAIN_OK=0;
  $RF=$ENV{'HTTP_REFERER'};
  $RF=~tr/A-Z/a-z/;
  foreach $ts (@okaydomains)
   {
     if ($RF =~ /$ts/)
      { $DOMAIN_OK=1; }
   }
   if ( $DOMAIN_OK == 0)
     { print "Content-type: text/html\n\n Désolé, ce script ne peut fonctionner d'ici....";
      exit;
     }
}


##################################################################
sub test_sendmail
 {
  @ts=split(/ /,$MAIL_PROGRAM);
  if ( -e $ts[0] )
   {
    return;
   }
   print "Content-type: text/html\n\n";
   print "<H2>$ts[0] NOTFOUND. PLEASE CHECK YOUR SCRIPT'S MAIL_PROGRAM VARIABLE</H2>";
   exit;
 }

sub do_log
{
open (ZL,">>$LOGFILE");
$date=localtime(time);
for ($i=1;$i<$MAXNUM+1;$i++)
    {
      $recipname="recipname_$i";
      $recipemail="recipemail_$i";
      if ($fields{$recipemail} eq "")
        {
         next;
        }
      if (&valid_address == 0)
        {
         next;
        }
     $logline="$date\|$JUMP_TO\|$fields{'send_email'}\|$fields{$recipemail}\|\n";
     print ZL $logline;
   }
  close(ZL);
}

###################################################################
###################################################################
sub sendmail  {

# error codes below for those who bother to check result codes <gr>

# 1 success
# -1 $smtphost unknown
# -2 socket() failed
# -3 connect() failed
# -4 service not available
# -5 unspecified communication error
# -6 local user $to unknown on host $smtp
# -7 transmission of message failed
# -8 argument $to empty
#
#  Sample call:
#
# &sendmail($from, $reply, $to, $smtp, $subject, $message );
#
#  Note that there are several commands for cleaning up possible bad inputs - if you
#  are hard coding things from a library file, so of those are unnecesssary
#

    my ($fromaddr, $replyaddr, $to, $smtp, $subject, $message) = @_;

    $to =~ s/[ \t]+/, /g; # pack spaces and add comma
    $fromaddr =~ s/.*<([^\s]*?)>/$1/; # get from email address
    $replyaddr =~ s/.*<([^\s]*?)>/$1/; # get reply email address
    $replyaddr =~ s/^([^\s]+).*/$1/; # use first address
    $message =~ s/^\./\.\./gm; # handle . as first character
    $message =~ s/\r\n/\n/g; # handle line ending
    $message =~ s/\n/\r\n/g;
    $smtp =~ s/^\s+//g; # remove spaces around $smtp
    $smtp =~ s/\s+$//g;

    if (!$to)
    {
	return(-8);
    }

 if ($SMTP_SERVER ne "")
  {
    my($proto) = (getprotobyname('tcp'))[2];
    my($port) = (getservbyname('smtp', 'tcp'))[2];

    my($smtpaddr) = ($smtp =~
		     /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
	? pack('C4',$1,$2,$3,$4)
	    : (gethostbyname($smtp))[4];

    if (!defined($smtpaddr))
    {
	return(-1);
    }

    if (!socket(MAIL, AF_INET, SOCK_STREAM, $proto))
    {
	return(-2);
    }

    if (!connect(MAIL, pack('Sna4x8', AF_INET, $port, $smtpaddr)))
    {
	return(-3);
    }

    my($oldfh) = select(MAIL);
    $| = 1;
    select($oldfh);

    $_ = <MAIL>;
    if (/^[45]/)
    {
	close(MAIL);
	return(-4);
    }

    print MAIL "helo $SMTP_SERVER\r\n";
    $_ = <MAIL>;
    if (/^[45]/)
    {
	close(MAIL);
	return(-5);
    }

    print MAIL "mail from: <$fromaddr>\r\n";
    $_ = <MAIL>;
    if (/^[45]/)
    {
	close(MAIL);
	return(-5);
    }

    foreach (split(/, /, $to))
    {
	print MAIL "rcpt to: <$_>\r\n";
	$_ = <MAIL>;
	if (/^[45]/)
	{
	    close(MAIL);
	    return(-6);
	}
    }

    print MAIL "data\r\n";
    $_ = <MAIL>;
    if (/^[45]/)
    {
	close MAIL;
	return(-5);
    }

   }

  if ($SEND_MAIL ne "")
   {
     open (MAIL,"| $SEND_MAIL");
   }

    print MAIL "To: $to\n";
    print MAIL "From: $fromaddr\n";
    print MAIL "Reply-to: $replyaddr\n" if $replyaddr;
    print MAIL "X-Mailer: Perl Powered Socket Mailer\n";
    print MAIL "Subject: $subject\n\n";
    print MAIL "$message";
    print MAIL "\n.\n";

 if ($SMTP_SERVER ne "")
  {
    $_ = <MAIL>;
    if (/^[45]/)
    {
	close(MAIL);
	return(-7);
    }

    print MAIL "quit\r\n";
    $_ = <MAIL>;
  }

    close(MAIL);
    return(1);
}