#!/usr/local/bin/perl
use Socket;
print "Content-type: text/html\n\n";
my($from)     = 'jonl@hyve.com';
my($reply)     = 'jonl@hyve.com';
my($to)     = 'jonl@hyve.com';
my($smtp)     = 'localhost';
my($subject)     = 'subject';\
my($message)     = 'message';
print sendmail();
print "Hello, worlda!\n";
sub sendmail {
#my ($from, $reply, $to, $smtp, $subject, $message) = @_;
my ($fromaddr) = $from;
my ($replyaddr) = $reply;
$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; }
my($proto) = (getprotobyname('tcp'))[2];
print $proto;
my($port) = (getservbyname('smtp', 'tcp'))[2];
print $port;
my($smtpaddr) = ($smtp =~/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)? pack('C4',$1,$2,$3,$4): (gethostbyname($smtp))[4];
print $smtpaddr;
print "dd";
if (!defined($smtpaddr)) { return -1; }
if (!socket(S, AF_INET, SOCK_STREAM, $proto)) { return-2; }
if (!connect(S, pack('Sna4x8', AF_INET, $port, $smtpaddr))) { return-3; }
my($oldfh) = select(S); $| = 1; select($oldfh);
$_ = <S>; if (/^[45]/) { close S; return -4; }
print S "helo localhost\r\n";
$_ = <S>; if (/^[45]/) { close S; return -5; }
print S "mail from: <$fromaddr>\r\n";
$_ = <S>; if (/^[45]/) { close S; return -5; }
foreach (split(/, /, $to)) {
print S "rcpt to: <$_>\r\n";
$_ = <S>; if (/^[45]/) { close S; return -6; }
}
print S "data\r\n";
$_ = <S>; if (/^[45]/) { close S; return -5; }
print S "To: $to\r\n";
print S "From: $from\r\n";
print S "Reply-to: $replyaddr\r\n" if $replyaddr;
print S "X-Mailer: Perl Sendmail Version 1.21 Christian Mallwitz
Germany\r\n";
print S "Subject: $subject\r\n\r\n";
print S "$message";
print S "\r\n.\r\n";
$_ = <S>; if (/^[45]/) { close S; return -7; }
print S "quit\r\n";
$_ = <S>;
close S;
return 1;
}

Back to Perl

Add new attachment

Only authorized users are allowed to upload new attachments.
« This page (revision-1) was last changed on 24-May-2017 15:30 by UnknownAuthor
G’day (anonymous guest) My Prefs
  • View Page Source
  • This clear IPSec security association,
    clear ipsec sa peer X.X.X.X
    

All Pages

Page views: 1664

Private Tomcat

Linux

MySQL

Email

SQL Server

ASP

JSP

C#

Web Mail

Windows Plesk

Linux Plesk

PHP

Gaming

ASP.NET

Persits ASPUpload

Wiki Help

Referring Pages:
...nobody

JSPWiki v2.8.1