Check the link button for the correct page url!");
}
}
if ($windows eq "Yes") {
&send_mailw();
}else {
&send_mailx();
}
} # end of sub
###
##################### Send mail for Unix #############################
###
sub send_mailx {
open MAIL, "|$mailprog" || die &error("Can't open Sendmail: $mailprog!");
print MAIL "MIME-Version: 1.0\n" if ($method eq "attach");
print MAIL "Content-type: multipart/mixed; boundary=\"----=_NextPart_000_000D_01C2B843.C7118910\"\n" if ($method eq "attach");
print MAIL "To: $to_email ($to_name)\n";
print MAIL "From: $from_email ($from_name)\n";
print MAIL "Subject: $from_name has sent you a Link!\n";
print MAIL "Subject: $from_name has sent you a Link!\n";
print MAIL "X-Priority: 1\n";
print MAIL "X-MSMail-Priority: High\n";
print MAIL "X-Mailer: SPADS - World of Perl (c)\n\n" if ($method eq "attach");
print MAIL "X-Mailer: SPADS - World of Perl (c)\n" if ($method ne "attach");
print MAIL "Content-type: text/html\n\n" if ($method ne "attach");
if ($method eq "attach") {
print MAIL "------=_NextPart_000_000D_01C2B843.C7118910\n";
print MAIL "Content-Type: text/html; charset=US-ASCII\n";
print MAIL "Content-Transfer-Encoding: 7bit\n\n";
print MAIL "$message_attach\n";
print MAIL "------=_NextPart_000_000D_01C2B843.C7118910\n";
print MAIL "Content-Type: text/html\;name=\"SAL.html\"\n";
print MAIL "Content-Transfer-Encoding: 7bit\n";
print MAIL "Content-Disposition: attachment\;filename=\"SAL.html\"\n\n";
print MAIL "$message_page\n";
print MAIL "------=_NextPart_000_000D_01C2B843.C7118910\n";
}
elsif ($method eq "body")
{
print MAIL "$message_page\n";
}
elsif ($method eq "link")
{
print MAIL "$message_link\n";
}
print MAIL "\n\n";
unless (close(MAIL)) {
die &error("Couldn't close sendmail pipe: $!
This means you may have the wrong sendmail location in the set up!");
}
&main_page("Success Page Sent to: $to_email");
} # end of sub
###
##################### Send mail for windows #############################
###
sub send_mailw {
my ($name, $aliases, $proto, $type, $len, $thisaddr, $thataddr);
my $CRLF = "\015\012";
local *S;
my $port = 25;
my $AF_INET = 2;
my $SOCK_STREAM = 1;
$SMTP_SERVER =~ s/^\s+//g; # remove spaces around smtp_server
$SMTP_SERVER =~ s/\s+$//g;
($name, $aliases, $proto) = getprotobyname ('tcp');
($name, $aliases, $port) = getservbyname ($port,'tcp') unless $port =~ /^\d+$/;
($name, $aliases, $type, $len, $thataddr) = gethostbyname ($SMTP_SERVER);
socket (S, $AF_INET, $SOCK_STREAM, $proto) || die &error("Socket to mail Server failed: $SMTP_SERVER ($!)\n Check if $SMTP_SERVER is vaild with Your ISP!\n");
bind (S, pack('S n a4 x8', $AF_INET, 0, "\0\0\0\0")) || die &error("Bind Socket to mail Server failed: $SMTP_SERVER ($!)\n Check if $SMTP_SERVER is vaild with Your ISP!\n");
connect (S, pack('S n a4 x8', $AF_INET, $port, $thataddr)) || die &error("Connection to mail Server failed: $SMTP_SERVER ($!) \n Check if $SMTP_SERVER is vaild with Your ISP!\n");
select (S); $| = 1; select (STDOUT);
return -1 unless (&wait_for (*S, '220'));
print "Content-Type: text/html\n\n" if ($verbose);
print "S: HELO $SMTP_SERVER$CRLF" if ($verbose);
print S "HELO $SMTP_SERVER$CRLF";
return -2 unless (&wait_for (*S, '250'));
print "S: MAIL FROM: $webmaster$CRLF" if ($verbose);
print S "MAIL FROM:<$webmaster>$CRLF";
return -3 unless (&wait_for (*S, '250'));
print "S: RCPT TO: $to_email$CRLF" if ($verbose);
print S "RCPT TO:<$to_email>$CRLF";
return -4 unless (&wait_for (*S, '250'));
print "S: DATA $CRLF" if $verbose;
print S "DATA $CRLF";
return -5 unless (&wait_for (*S, '354'));
print "S: To: $to_email$CRLF" if ($verbose);
print "S: From: $webmaster$CRLF" if ($verbose);
print "S: Subject: $from_name has sent you a Link!$CRLF" if ($verbose);
print "S: Reply-To: $from_email$CRLF" if ($verbose);
print "S: X-Priority: 1$CRLF" if ($verbose);
print "S: X-MSMail-Priority: High$CRLF" if ($verbose);
print "S: X-Mailer: SPADS - World of Perl (c)$CRLF" if ($verbose);
print "S: MIME-Version: 1.0$CRLF" if ($verbose);
print "S: Content-Type: multipart/mixed; boundary=\"----=_NextPart_000_000D_01C2B843.C7118910\"$CRLF$CRLF" if ($verbose);
print S "To: $to_email$CRLF";
print S "From: $webmaster$CRLF";
print S "Reply-To: $from_email$CRLF";
print S "Subject: $from_name has sent you a Link!$CRLF";
print S "X-Priority: 1$CRLF";
print S "X-MSMail-Priority: High$CRLF";
print S "X-Mailer: SPADS - World of Perl (c)$CRLF";
print S "MIME-Version: 1.0$CRLF" if ($method eq "attach");
print S "Content-Type: multipart/mixed; boundary=\"----=_NextPart_000_000D_01C2B843.C7118910\"$CRLF$CRLF" if ($method eq "attach");
if ($method eq "attach") {
print S "------=_NextPart_000_000D_01C2B843.C7118910$CRLF";
print "S: Content-Type: text/html; charset=\"US-ASCII\"$CRLF" if ($verbose);
print "S: Content-Transfer-Encoding: 7bit$CRLF$CRLF" if ($verbose);
print "S: $message_attach$CRLF";
print S "Content-Type: text/html; charset=\"US-ASCII\"$CRLF";
print S "Content-Transfer-Encoding: 7bit$CRLF$CRLF";
print S "$message_attach$CRLF";
print S "$CRLF";
print S "------=_NextPart_000_000D_01C2B843.C7118910$CRLF";
print "S: Content-Type: text/html; name=\"$pagen\"$CRLF" if ($verbose);
print "S: Content-Transfer-Encoding: 7bit$CRLF" if ($verbose);
print "S: Content-Disposition: attachment; filename=\"$pagen\"$CRLF$CRLF" if ($verbose);
print "S: $message_page$CRLF" if ($verbose);
print S "Content-Type: text/html; name=\"$pagen$CRLF";
print S "Content-Transfer-Encoding: 7bit$CRLF";
print S "Content-Disposition: attachment; filename=\"$pagen\"$CRLF$CRLF";
print S "$message_page$CRLF";
print S "$CRLF";
print S "------=_NextPart_000_000D_01C2B843.C7118910$CRLF";
$status = 1;
}
elsif ($method eq "body")
{
print "S: Content-Type: text/html; charset=\"US-ASCII\"$CRLF" if ($verbose);
print "S: Content-Transfer-Encoding: 7bit$CRLF" if ($verbose);
print S "Content-Type: text/html; charset=\"US-ASCII\"$CRLF";
print S "Content-Transfer-Encoding: 7bit$CRLF$CRLF";
print S "$message_page$CRLF";
print S "$CRLF";
}
elsif ($method eq "link")
{
print "S: Content-Type: text/html; charset=\"US-ASCII\"$CRLF" if ($verbose);
print "S: Content-Transfer-Encoding: 7bit$CRLF" if ($verbose);
print S "Content-Type: text/html; charset=\"US-ASCII\"$CRLF";
print S "Content-Transfer-Encoding: 7bit$CRLF$CRLF";
print S "$message_link$CRLF";
print S "$CRLF";
}
print S "$CRLF.$CRLF";
return -6 unless (&wait_for (*S, '250'));
print "S: QUIT$CRLF" if ($verbose);
print S "QUIT$CRLF";
shutdown (S, 2);
close S;
&main_page("Success Page Sent to: $to_email", $status);
} # end of sub
###
################## Wait_for sub needed for send_mailw ######################
###
sub wait_for {
local (*S) = $_[0];
my ($exp) = $_[1];
my ($str) = "";
my ($cc) = "";
my ($err) = 0; # Errors reading socket
my $line_end = "\n";
OUTER:
while ($err < 500) {
do { $err++; next OUTER; }
if (sysread (S, $cc, 1, 0) != 1);
$err = 0; do { $str .= $cc; next OUTER; }
if ($cc ne $line_end);
print "R: $str\n" if $verbose;
if ($str =~ /^(\d+)\s+(.*)/) { # get xxx from 'xxx text' response
if ($1 == $exp) { # if xxx the expected response
return 1;
} else {
return 0;
}
}
$str = "";
}
return 0;
} # end Wait_for sub
###
### ERROR
###
sub error
{
my ($msg) = @_;
print header ();
print start_html ("Error"), start_form (-action => url ()),
blockquote (br (), h2("Error: "),
blockquote (h3("$msg")), br (),
"");
print end_form ();
print qq|
