Make your own free website on Tripod.com
#!/usr/local/bin/perl #set the line above this to your perl path. Usually fine as is # or /usr/local/bin/perl /sbin/perl # make certain that the first line stays the first line! ################################################################## # (C)1998-9 Bignosebird.com cardcgi v2.0 # 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! use Socket; $|=1; #### PROGRAM CONFIGURATION SECTION ############################ # # Modify each item below to meet your needs. # # DAYS: 21 # SMTP_SERVER: AOL # IF NOT- SET THE SEND_MAIL VARIABLE! # BASEDIR /desktop/Lindsay's Stuff/Virtual Cards # BASEURL http://jumpingbean144.tripod.com/virtualcards.htm # # SITEURL http://jumpingbean144.tripod.com/Twisted.html # SITENAME Twisted Tree Farm # EXT htm # PROGNAME http://jumpingbean144.tripod.com/cards.htm # MAILLOG emails # FOR SECURITY REASONS: mailaddies # okaydomains are (if specified, the ONLY domains that the script # can be run from. If left empty, anyone could run your script, # but they wouldn't see any graphics!!! If your site answers to # both www.domain.com and domain.com, then use both! # @okaydomains=("http://bignosebird.com", "http://www.bignosebird.com"); $DAYS=21; #$SEND_MAIL="/usr/lib/sendmail -t"; $BASEDIR="/desktop/Lindsay's Stuff/Virtual Cards"; $BASEURL="http://jumpingbean144.tripod.com/virtualcards.htm"; $SITEURL="http://jumpingbean144.tripod.com/Twisted.html"; $SITENAME="Twisted Tree Farm"; $EXT=".htm"; $PROGNAME="/cgi-bin/card.cgi"; $MAILLOG="emails"; $SUBJECT ="You have been sent a virtual card!!"; ############################################################### &main_driver; ############################################################### # # Now go thru the program looking for the string "BNB SAYS!" # to locate other changes you should make, such as wording of # the notification e-mail and "plug" for the site. # # to keep things simple, the field names are hard coded in. # you can of course modify what you wish. ############################################################### sub thank_you { if ($MAILLOG ne "") { open (ML,">>$BASEDIR/$MAILLOG"); print ML "$fields{'recip_email'}\n"; print ML "$fields{'sender_email'}\n"; close(ML); } print "Content-type: text/html\n\n"; print <<__STOP_OF_THANKS__;

THANKS!

Your card notification has been sent to $fields{'recip_name'}
The URL of this card is

$URL_NAME

RETURN TO CARD CREATOR

__STOP_OF_THANKS__ } # BNB SAYS! # THIS IS WHERE YOU CAN CUSTOMIZE YOUR NOTIFICATION LETTER # DO NOT TOUCH THE TWO LINES WITH __STOP_OF_MESSAGE__ ON # THEM!!!! sub setup_letter { $msgtext =<<__STOP_OF_MESSAGE__; Hi, $fields{'sender_name'} stopped by my site, $SITENAME and created a Virtual Card just for you! To pick up your card, simply point your browser at the page listed below. $URL_NAME The card will remain on the server for about three weeks, so please print it out or save it as soon as you can. __STOP_OF_MESSAGE__ } # BNB SAYS! # This is what makes up the body of your card. DO NOT REMOVE OR # MODIFY THE LINES ABOVE THE WORD $param or the $param line # itself. Doing so will cause the script to fail. sub make_body { $cardbody =<<__END_OF_CARD_BODY__; $BODYTAG $params

$fields{'the_title'}
$fields{'the_message'}

$fields{'sig_line'}

This card was created by $fields{'sender_name'} ( $fields{'sender_email'}) expressly for $fields{'recip_name'}. If you would like to send a card to a person you really care for, just go to $SITEURL and create your own free virtual cards.

$SITENAME BNB SAYS! DESCRIBE YOUR SITE HERE! 




Card Creator Script byBigNoseBird.com


Everything for the webmaster, for free!


  		
  







__END_OF_CARD_BODY__
}
sub pass_params
{
$params=<<__END_OF_PARAMS__;




 

 
 
 To send your creation, click on the SEND-CARD button. To return
    the card creation screen without sending, please press your
    browser's BACK button.
 
 



















   




 		
 



__END_OF_PARAMS__
}
###################################################################
#Sendmail.pm routine below by Milivoj Ivkovic 
###################################################################
sub sendmail  {
# error codes below for those who bother to check result codes 
# 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);
    $_ = ;
    if (/^[45]/)
    {
	close(MAIL);
	return(-4);
    }
    print MAIL "helo $SMTP_SERVER\r\n";
    $_ = ;
    if (/^[45]/)
    {
	close(MAIL);
	return(-5);
    }
    print MAIL "mail from: <$fromaddr>\r\n";
    $_ = ;
    if (/^[45]/)
    {
	close(MAIL);
	return(-5);
    }
    foreach (split(/, /, $to))
    {
	print MAIL "rcpt to: <$_>\r\n";
	$_ = ;
	if (/^[45]/)
	{
	    close(MAIL);
	    return(-6);
	}
    }
    print MAIL "data\r\n";
    $_ = ;
    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 "")
  {
    $_ = ;
    if (/^[45]/)
    {
	close(MAIL);
	return(-7);
    }
    print MAIL "quit\r\n";
    $_ = ;
  }
    close(MAIL);
    return(1);
}
sub no_email
{
print <<__STOP_OF_NOMAIL__;
Content-type: text/html


SORRY! Your request could not be processed because of missing
e-mail address(es). Please use your browser's back button to
return to the card entry page.


__STOP_OF_NOMAIL__
}
sub send_mail
{
&setup_letter;
$mailresult=&sendmail($fields{sender_email}, $fields{sender_email}, $fields{recip_email}, $SMTP_SERVER, $SUBJECT, $msgtext); 
}
sub card_expire
 {
  local(@items, $item);
  opendir(CARDDIR, "$BASEDIR");
  @items = grep(/[0-9]$EXT/,readdir(CARDDIR));
  closedir(CARDDIR);
  foreach $item (@items)
   {
    if (-M "$BASEDIR/$item" > $DAYS)
     {
      unlink("$BASEDIR/$item");
     }
   }
 }
##################################################################
sub valid_address 
 {
  $testmail = $fields{'recip_email'};
  if ($testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||
  $testmail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/)
   {
     return 0;
   }
   else 
    {
      return 1;
    }
}
sub bad_email
{
print <<__STOP_OF_BADMAIL__;
Content-type: text/html


SORRY! Your request could not be processed because of an improper
recipient's e-mail address. Please use your back button to return
to the card screen and try again!


__STOP_OF_BADMAIL__
}
sub test_basedir
{
  if (not -w $BASEDIR)
   {
print <<__STOP_OF_BADBASE__;
Content-type: text/html


The script cannot either find or write to the

$BASEDIR directory. Please check this setting if
the BASEDIR variable, and the permissions of the
directory. If you have them set to 755, please 
change them to 777.


__STOP_OF_BADBASE__
exit;
   }
}
##################################################################
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 decode_vars
{
#This part of the program splits up our data and gets it
#ready for formatting.
  $i=0;
  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///g;
    $fields{$key}=$content;
    $i++;
    $item{$i}=$key;
    $response{$i}=$content;
   }
}
sub get_file_name
{
   $proc=$$;
   $newnum=time;
   $newnum=substr($newnum,4,5);
   $date=localtime(time);  
   ($day, $month, $num, $time, $year) = split(/\s+/,$date); 
   $month=~tr/A-Z/a-z/;
   $PREF = "$month$num-";
   $FILE_NAME="$BASEDIR/$PREF$newnum$proc$EXT";
   $URL_NAME="$BASEURL/$PREF$newnum$proc$EXT";
}
#Write out our HTML FILE
sub create_file
{
  open(OUTFILE,">$FILE_NAME") ;
  print OUTFILE "$cardbody\n";
  close (OUTFILE);
}
#Set up our HTML Preview Form
sub do_preview
{
$fields{'the_message'} =~s/\"/\'/g;
  &pass_params;
  &make_body;
print "Content-type: text/html\n\n";
print "$cardbody\n";
}
sub main_driver
{
   &valid_page;
   &test_basedir;
   &decode_vars;
   if ($fields{'recip_email'} eq "")
     { &no_email; exit; } 
   if (&valid_address == 0)
    { &bad_email; exit; }
   if ($fields{'sender_email'} eq "")
     { &no_email; exit; }
   if ($fields{'background'} ne "")
    { $BODYTAG="";}
     else { $BODYTAG=""; }
   if ($fields{'action_code'} eq "NEW") 
     { &do_preview; }
   if ($fields{'action_code'} eq "SENDCARD") 
     {                             
      &make_body;
      &get_file_name;
      &create_file;
      &setup_letter;
      $mailresult=&sendmail($fields{sender_email}, $fields{sender_email}, $fields{recip_email}, $SMTP_SERVER, $SUBJECT, $msgtext); 
      &thank_you;
      if ($DAYS > 0)
       {&card_expire;}
     }
}