#!/usr/bin/perl
use Socket;
$|=1;
##################################################################  
#  birdcast.cgi Version 2.1
#  updated Nov 2, 2002
#  (C)1998-2002 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!  http://bignosebird.com/carchive/birdcast.shtml
##################################################################  

# 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="localhost";
#
#     OR
#
   $SEND_MAIL="/usr/sbin/sendmail -t"; 
#
#      BUT NEVER BOTH!!!!!!

 #  @okaydomains=("http://www.doctor.co.th", "http://www.yourdomain.com");

   $SCRIPT_NAME="http://www.doctor.co.th/cgi-bin/MailThisPage/sendthispage.cgi";
   $SITE_NAME="@ - =Doctor San= - @ ::: Sex & Health and Beauty";
   $SITE_URL="http://www.doctor.co.th/";
   $ENDLINE="                                :: Doctor San Skin Center ::\n ??????????? ?????? ???????????? ??? ??? ??? ?????????????  ????????????? ???????????\n            ?????????????????????? ?????????????? 7 ?????? ??????? \n***??????????????????? ?????????????????????????????????????? 60 ??? ???????? ??????????? 120 ???***\n                                    ???.  02-446-0282 ,02-446-0875";
   $MAXNUM=5;
   $LOGFILE="reflog.txt";

   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 = "????????????  ??? $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__;            
??????  ??? $fields{$recipname},

???????? ??? $fields{'send_name'} ????????????????  $SITE_NAME 
????????????????????????????????????????:

 $JUMP_TO   

__STOP_OF_MAIL__

      if ($fields{'message'} ne "")
       {
         $msgtxt .= "???????????????????????????....\n=====+++++=====+++++=====+++++=====+++++=====+++++=====\n";
         $msgtxt .= "$fields{'message'}\n=====+++++=====+++++=====+++++=====+++++=====+++++=====\n\n";
       }
       $msgtxt .= "$SITE_NAME\n\n=====+++++=====+++++=====+++++=====+++++=====+++++=====+++++\n";
       $msgtxt .= "$ENDLINE\n=====+++++=====+++++=====+++++=====+++++=====+++++=====+++++\n";
       $msgtxt .= "$SITE_URL\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 NOT SENT. SMTP ERROR: $mailresult\n";
       exit
      }

    }
 }

##################################################################
sub draw_request
 {
print qq~Content-type: text/html\n\n~;
print qq~<html><head><meta http-equiv="Content-Type" content="text/html; charset=tis-620">
<META http-equiv="Content-Type" content="text/html; charset=windows-874">
<title>?????????????????? .:: www.Doctor.co.th ::.</title>
<style type="text/css">
TD            { font-family: Ms Sans Serif, Verdana, Krungthep, Thonburi, Helvetica, Arial; color: #000000; font-size:11px; }
.sansendthispage           { font-family: Verdana, Krungthep, Thonburi, Helvetica, Ms Sans Serif, Arial; font-size: 13px; font-weight: normal; }
</style></head>~;

#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__;
<body bgcolor="#dfFFaa" text="#052008" class"sansendthispage">                                                           
<TABLE width="500" border="0">
 <TR>
 <TD width="490">
 <FONT SIZE="4" COLOR="#000059" face="MS Sans Serif, Default Font"><B> ??????????????????????????????</B></FONT>
  <P> <A HREF="$ENV{'HTTP_REFERER'}">$ENV{'HTTP_REFERER'}</A></TD>
  <TD width="10">&nbsp;</TD>
  </TR>
   <TR>
   <TD colspan="2"><br><br>
  <BLOCKQUOTE>
 <FONT SIZE="2" COLOR="#000000">
  ?????????????????? E-mail ???????????? ????????? ???? Click  <B>SEND</B>
 <p> ??????????????????????????????????	????????????????????????????????
 <p>???????????????????  <b>$SITE_NAME</b></FONT>
 <P><font color="red">???????????? ???????????????????????????????????? ?????????? ?????</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">????</TD>
    <TD ALIGN="CENTER">??????? E-Mail</TD>
    </TR>
    <TR>
    <TD>????</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>??????????? $i</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>
   ????????????<BR>
 <textarea name="message" wrap=virtual rows=5 cols=35></textarea>
    <BR>
    <INPUT TYPE="submit" VALUE="SEND">
    </TD>
    </TR>
  </TABLE>
    </FORM>
  </BLOCKQUOTE>   
  </TD>
  </TR>
  </TABLE>
__REQUEST2__
print qq~<br><CENTER><SCRIPT LANGUAGE="javascript1.1"> page="Mail This Page";</SCRIPT><SCRIPT LANGUAGE="javascript1.1" src="http://truehits1.gits.net.th/data/c0003407.js"></SCRIPT></CENTER>
</body></html>~;
 }

##################################################################
#  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;
	$content =~s~\^~\-~isg;		
	#$content =~s~ ~\-~isg;	
	#$content =~s~\%~'~isg;
	$content =~ s~\[.+?\]~~isg;
	$content =~ s~\<.+?\>~~isg;
	$content =~ s/\cM//g;
	$content =~ s~\[([^\]]{0,30})\n([^\]]{0,30})\]~\[$1$2\]~g;
	$content =~ s~\[/([^\]]{0,30})\n([^\]]{0,30})\]~\[/$1$2\]~g;
	$content =~ s~(\w+://[^<>\s\n\"\]\[]+)\n([^<>\s\n\"\]\[]+)~$1\n$2~g;		
	$content =~ s~\t~ \&nbsp; \&nbsp; \&nbsp;~g;
	$content =~ s~\n~<br>~g;
    $fields{$key}=$content;
   }
   if ($fields{'call_by'} eq "")
    {
     $JUMP_TO = $ENV{'HTTP_REFERER'};
    }
   else
   {
     $JUMP_TO = $fields{'call_by'};
    }
}

##################################################################
sub valid_address 
 {
  $testmail = $fields{$recipemail};
  if ($testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||
  $testmail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,4}|[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 Sorry, cant run it from here....";    
      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";
	 #$logline="";
     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);
}