cgibin/0040755000000000000000000000000007151133116011011 5ustar rootrootcgibin/files/0040755000000000000000000000000007151132024012110 5ustar rootrootcgibin/files/banner.gif0100644000000000000000000000711207151132740014047 0ustar rootrootGIF89aW߲ٜ֛۠ٛՓԌІυyfzsl:]TUMLLF?@: 5 -%+%#* ߐԆӅ́zzqom]N~KvFi>Y5T2>%&&&$ Z ! NETSCAPE2.0!,W3f333f3333f3ffffff3f̙3f3f333f333333333f33333333f33f3ff3f3f3f3333f33̙33333f3333333f3333f3ffffff3f33ff3f3f3f3fff3ffffffffffff3ffff̙fff3fffffff3ffffff3f333f3333f3ffffff3f̙̙3̙f̙̙̙̙3f3f̙333f3̙333f3fff̙fff3f̙̙3f̙3f̙3f333f3333f3ffffff3f̙3f3fH*\ȰÇ Kċ3A/thI"G:dX! W @Jd)0Slshϟ0_Y P7lp/2,,R_8z+t)clVnY]Kgx,Zt8@8іA,挚:<^pfb 2f4<%]uf;$rM"DI2x橧8L&>hV:e~9ff\3˚r'+@)ea*璚٩":W+װkȬ׬AWȬl5rה%J-+Ѭij4mzPH[5Zk#[+%J)&/+dn4+ m{J,H[ckY.z@떫L;rbItjŷ'(ȩJm@{An1%< r,\m winְ 4M+TS^ӊRj&!2+~ӭPJnt/۝79}5 ,5a|b_}'1AfN~UJP(V@4r,{̞-+<# RBۺҽB)@ Q&*X*ioӻŸq?2M^b &``5X8N%x—0x$@! IHAꭄ+ '@"[I@!,H*\ȰÇ#JH1 !,IX@ -(1$$*(`0Th$T!  X M5o\Q'K)'O B)50 :XX *XcE 3 H1 R )! 1bAL0->\)TUDM!!,Cx)SFJAPL(*JY 0E *PdP!F Z`F 2fLB@!QPH)1h (YЀUVPs TB @hAg %8D2^`pa!A 7GHE 2T`tYAExzAT!,Rb 0@a (A@`!F/c0@,#C ^`*HH%'*P@0hQ*. Q+1肜ap $>" D%Z,TCɐ!u5%!T..lB *k  ŭK(^[ l!,#52'N TxFͩ!@B"5X /k +AP- Ɛ!n,a'0ċ!RH@0jDFBt aCV̬)d`ZD?5TkJ5MI An 1Q ^tLp/="%<(Hlp@"E!o,# dth89, 8DH@ÁT$Q"d@'zYa%cG29$p‹OPAQN Tx"d!(A@,8 ` 9Q$K'ARȣ>0`&# )+JND Y$EP䀠ώ% *&3($$t2OgF%;cgibin/CGI_LIB.pm0100644000000000000000000001503707151132751012446 0ustar rootroot# # CGI_LIB package. # package CGI_LIB; #=============================================================================== # # Constructor: # $obj = new CGI_LIB; # # Methods: # $obj->getFormMethod(); # $obj->getSubmittedData(); # $obj->processData(); # $obj->processURLEncodedData(); # $obj->processMultiPartData(); # # *p/s: For more details, please refer to the description below. # #=============================================================================== use strict; use vars qw($FormMethod $VERSION); $VERSION = '1.01'; #=============================================================================== # # CONSTRUCTOR: $obj = new CGI_LIB; # # DESCRIPTION: This is the constructor of the CGI_LIB object. # The constructor will process the data according to the form # method used, and set the data into the object. # #=============================================================================== sub new { my($pkg) = shift; my($self) = {}; bless $self, $pkg; $FormMethod = $self->getFormMethod(); $self->processData(); return $self; } #=============================================================================== # # METHOD: $obj->getFormMethod(); # # DESCRIPTION: This method will return the form method that has been used. # #=============================================================================== sub getFormMethod { my($self) = shift; return $ENV{'REQUEST_METHOD'}; } #=============================================================================== # # METHOD: $obj->getSubmittedData(); # # DESCRIPTION: This method will return the submitted form data. # #=============================================================================== sub getSubmittedData { my($self) = shift; if ($FormMethod eq "POST") { my($buffer); read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); return $buffer; } elsif ($FormMethod eq "GET") { return $ENV{'QUERY_STRING'}; } else { return $ENV{'QUERY_STRING'}; } } #=============================================================================== # # METHOD: $obj->processData(); # # DESCRIPTION: According to different type of submitted data, this method will # call different subroutine to process the data and set them into # the object. # #=============================================================================== sub processData { my($self) = shift; if ($ENV{'CONTENT_TYPE'} =~ /^multipart\/form-data;/) { $self->processMultiPartData(); } elsif ($ENV{'CONTENT_TYPE'} =~ /^application\/x-www-form-urlencoded$/) { $self->processURLEncodedData(); } else { $self->processURLEncodedData(); } if ($FormMethod ne "GET" && $ENV{'QUERY_STRING'} ne "") { $FormMethod = "GET"; $self->processURLEncodedData(); } } #=============================================================================== # # METHOD: $obj->processURLEncodedData(); # # DESCRIPTION: The submitted data is in application/x-www-form-urlencoded # format. # #=============================================================================== sub processURLEncodedData { my($self) = shift; my($submittedData) = $self->getSubmittedData(); my(@fields) = split('&', $submittedData); for (@fields) { tr/+/ /; my($fieldName, $fieldValue) = split('=', $_, 2); # The %xx hex numbers are converted to alphanumeric. $fieldName =~ s/%(..)/pack("C", hex($1))/eg; $fieldValue =~ s/%(..)/pack("C", hex($1))/eg; if (exists $self->{$fieldName}) { if (ref($self->{$fieldName}) eq "ARRAY") { push(@{$self->{$fieldName}}, $fieldValue); } else { my($tempValue) = $self->{$fieldName}; delete $self->{$fieldName}; push(@{$self->{$fieldName}}, $tempValue); push(@{$self->{$fieldName}}, $fieldValue); } } else { $self->{$fieldName} = $fieldValue; } } } #=============================================================================== # # METHOD: $obj->processMultiPartData(); # # DESCRIPTION: The submitted data is in multipart/form-data format. # We only using this format when we want to do HTTP file upload. # #=============================================================================== sub processMultiPartData { my($self) = shift; my($submittedData) = $self->getSubmittedData(); my($boundary) = $ENV{'CONTENT_TYPE'} =~ /^.*boundary=(.*)$/; my(@partsArray) = split(/--$boundary/, $submittedData); @partsArray = splice(@partsArray, 1, (scalar(@partsArray) - 2)); my($aPart); foreach $aPart (@partsArray) { $aPart =~ s/(\r|)\n$//g; my($dump, $firstline, $fieldValue) = split(/[\r]\n/, $aPart, 3); next if $firstline =~ /filename=\"\"/; $firstline =~ s/^Content-Disposition: form-data; //; my(@columns) = split(/;\s+/, $firstline); my($fieldName) = $columns[0] =~ /^name=\"([^\"]+)\"$/; my(%dataHash); if (scalar(@columns) > 1) { my($contentType, $blankline); ($contentType, $blankline, $fieldValue) = split(/[\r]\n/, $fieldValue, 3); ($dataHash{'content-type'}) = $contentType =~ /^Content-Type: ([^\s]+)$/; } else { my($blankline); ($blankline, $fieldValue) = split(/[\r]\n/, $fieldValue, 2); if (exists $self->{$fieldName}) { if (ref($self->{$fieldName}) eq "ARRAY") { push(@{$self->{$fieldName}}, $fieldValue); } else { my($tempValue) = $self->{$fieldName}; delete $self->{$fieldName}; push(@{$self->{$fieldName}}, $tempValue); push(@{$self->{$fieldName}}, $fieldValue); } } else { next if $fieldValue =~ /^\s*$/; $self->{$fieldName} = $fieldValue; } next; } my($currentColumn); for $currentColumn (@columns) { my($currentHeader, $currentValue) = $currentColumn =~ /^([^=]+)="([^"]+)"$/; $dataHash{"$currentHeader"} = $currentValue; } $dataHash{'contents'} = $fieldValue; $dataHash{'size'} = length($fieldValue); $self->{$fieldName} = \%dataHash; } } 1; __END__ =head1 NAME CGI_LIB -- This is a perl module which will help you to manipulate the CGI input. =head1 SYNOPSIS use CGI_LIB; $obj = new CGI_LIB(); =head1 DESCRIPTION For more details about this module, please visit to http://www.tneoh.zoneit.com/perl/CGI_LIB/ =head1 AUTHOR Simon Tneoh Chee-Boon tneohcb@pc.jaring.my Copyright (c) 1998 Simon Tneoh Chee-Boon. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 VERSION Version 1.01 21 August 1999 cgibin/SendMail.pm0100644000000000000000000007435707151132763013067 0ustar rootroot# # This is the name of the current module. # package SendMail; #=============================================================================== # # Constructor: # $obj = new SendMail; # $obj = new SendMail($smtpserver); # $obj = new SendMail($smtpserver, $smtpport); # # Methods: # $obj->Attach($filename, [\$data]); # $obj->Bcc($bccemailadd1, [$bccemailadd2, ...]); # $obj->Cc($ccemailadd1, [$ccemailadd2, ...]); # $obj->ErrorsTo($errorstoadd1, [$errorstoadd2, ...]); # $obj->From($sender); # $obj->Inline($filename, [\$data]); # $obj->OFF; # $obj->ON; # $obj->ReplyTo($replytoadd1, [$replytoadd2, ...]); # $obj->Subject($subject); # $obj->To($recipient1, [$recipient2, ...]); # $obj->attach(\%hash); # $obj->createMailData(); # $obj->getEmailAddress($emailaddstr); # $obj->getRcptLists(); # $obj->isMailReady(); # $obj->receiveFromServer(\*SOCKET); # $obj->reset(); # $obj->sendMail(); # $obj->sendToServer(\*SOCKET, $message); # $obj->setDebug($obj->ON); # $obj->setError($errormessage); # $obj->setMailBody($mailbody); # $obj->setMailHeader($mailheader, $mailheadervalue); # $obj->setSMTPPort($smtpport); # $obj->setSMTPServer($smtpserver); # $obj->version; # # *p/s: For more details, please refer to the description below. # #=============================================================================== # # We are using Socket.pm to connect to the SMTP port. # use Socket; # # We are using MIME::Base64 and MIME::QuotedPrint to encode MIME data. # use MIME::Base64; use MIME::QuotedPrint; use Exporter; use strict; use vars qw($_LOCALHOST $VERSION $_MAILER @ISA @EXPORT @EXPORT_OK $_ERR); use vars qw($_DEFAULT_SMTP_PORT); @EXPORT = qw(); @EXPORT_OK = qw(); $VERSION = "2.01"; $_MAILER = "Perl SendMail Module $VERSION"; $_DEFAULT_SMTP_PORT = 25; # # Some of the SMTP server needs to say "HELO domain.address". # eval { require Sys::Hostname; Sys::Hostname::import('hostname'); $_LOCALHOST = hostname(); }; $_LOCALHOST = $_MAILER if $@; #=============================================================================== # # CONSTRUCTOR: $obj = new SendMail; # $obj = new SendMail($smtpserver); # $obj = new SendMail($smtpserver, $smtpport); # # DESCRIPTION: This is the constructor of the SendMail object. # #=============================================================================== sub new { my($pkg) = shift; my($smtpserver) = shift; my($smtpport) = shift; my($self) = {}; bless $self, $pkg; # # The mail server. # $self->{'smtpserver'} = ($smtpserver && $smtpserver =~ /^\s*$/) ? "localhost" : $smtpserver; # # The port number for smtp. # $self->{'smtpport'} = ($smtpport && $smtpport =~ /^\d+$/) ? $smtpport : $_DEFAULT_SMTP_PORT; # # The default debug mode is "OFF". # $self->{'debugmode'} = $self->OFF; # # Set the default mailer. # $self->setMailHeader("X-MAILER", $_MAILER); # # Create empty attachment array. # $self->{'attachmentArr'} = []; return $self; } #=============================================================================== # # METHOD: $obj->Attach($filename, [\$data]); # # DESCRIPTION: This method will attach file to the mail. If the data has been # specified, will use the filename and the data, instead of # reading from the file. # #=============================================================================== sub Attach ($;$) { my($self) = shift; my($filename) = shift; my($dataRef) = shift; my(%hash, $dump); return $self->setError("No attachment has been specified.") if $filename =~ /^\s*$/; if ($filename =~ /(\\|\/)/) { ($hash{'filename'}) = $filename =~ /^.*[\\\/]([^\\\/]+)$/; } else { $hash{'filename'} = $filename; } $hash{'filepath'} = $filename; $hash{'dataref'} = $dataRef if (ref($dataRef) eq "SCALAR" || ref($dataRef) eq "GLOB"); $hash{'attachtype'} = "attachment"; return $self->attach(\%hash); return 0; } #=============================================================================== # # METHOD: $obj->Bcc($bccemailadd1, [$bccemailadd2, ...]); # # DESCRIPTION: Add a list of the name/email address to the blind carbon copy # list. # #=============================================================================== sub Bcc ($) { my($self) = shift; my(@bcc) = @_; my($currEmail) = undef; for $currEmail (@bcc) { push(@{$self->{'mailheaders'}->{'BCC'}}, $currEmail) if ($self->getEmailAddress($currEmail) !~ /^\s*$/); } return 0; } #=============================================================================== # # METHOD: $obj->Cc($ccemailadd1, [$ccemailadd2, ...]); # # DESCRIPTION: Add a list of the name/email address to the carbon copy list. # #=============================================================================== sub Cc ($) { my($self) = shift; my(@cc) = @_; my($currEmail) = undef; for $currEmail (@cc) { push(@{$self->{'mailheaders'}->{'CC'}}, $currEmail) if ($self->getEmailAddress($currEmail) !~ /^\s*$/); } return 0; } #=============================================================================== # # METHOD: $obj->ErrorsTo($errorstoadd1, [$errorstoadd2, ...]); # # DESCRIPTION: Add a list of the name/email address into the "Errors-To" list. # #=============================================================================== sub ErrorsTo ($) { my($self) = shift; my(@errorsto) = @_; my($currEmail) = undef; for $currEmail (@errorsto) { push(@{$self->{'mailheaders'}->{'ERRORS-TO'}}, $currEmail) if ($self->getEmailAddress($currEmail) !~ /^\s*$/); } return 0; } #=============================================================================== # # METHOD: $obj->From($sender); # # DESCRIPTION: Set the sender of the email. # #=============================================================================== sub From ($) { my($self) = shift; my($from) = shift; $self->{'mailheaders'}->{'FROM'} = $from; return 0; } #=============================================================================== # # METHOD: $obj->Inline($filename, [\$data]); # # DESCRIPTION: This method will attach file to the mail. If the data has been # specified, will use the filename and the data, instead of # reading from the file. # #=============================================================================== sub Inline ($;$) { my($self) = shift; my($filename) = shift; my($dataRef) = shift; my(%hash, $dump); return $self->setError("No attachment has been specified.") if $filename =~ /^\s*$/; if ($filename =~ /(\\|\/)/) { ($hash{'filename'}) = $filename =~ /^.*[\\\/]([^\\\/]+)$/; } else { $hash{'filename'} = $filename; } $hash{'filepath'} = $filename; $hash{'dataref'} = $dataRef if (ref($dataRef) eq "SCALAR" || ref($dataRef) eq "GLOB"); $hash{'attachtype'} = "inline"; return $self->attach(\%hash); return 0; } #=============================================================================== # # METHOD: $obj->OFF; # # DESCRIPTION: Will return 0. Basically, it is used to set the debug mode OFF. # Eg. $obj->setDebug($obj->OFF); # #=============================================================================== sub OFF () { return 0; } #=============================================================================== # # METHOD: $obj->ON; # # DESCRIPTION: Will return 1. Basically, it is used to set the debug mode ON. # Eg. $obj->setDebug($obj->ON); # #=============================================================================== sub ON () { return 1; } #=============================================================================== # # METHOD: $obj->ReplyTo($replytoadd1, [$replytoadd2, ...]); # # DESCRIPTION: Add a list of the name/email address into the "Reply-To" list. # #=============================================================================== sub ReplyTo ($;@) { my($self) = shift; my(@replyto) = @_; push(@{$self->{'mailheaders'}->{'REPLY-TO'}}, @replyto); return 0; } #=============================================================================== # # METHOD: $obj->Subject($subject); # # DESCRIPTION: Set the subject of the email. # #=============================================================================== sub Subject ($) { $_[0]->{'mailheaders'}->{'SUBJECT'} = $_[1]; return 0; } #=============================================================================== # # METHOD: $obj->To($recipient1, [$recipient2, ...]); # # DESCRIPTION: Add a list of the name/email address to the recipient list. # #=============================================================================== sub To ($;@) { my($self) = shift; my(@to) = @_; for (@to) { my($currEmail) = $_; push(@{$self->{'mailheaders'}->{'TO'}}, $currEmail) if ($self->getEmailAddress($currEmail) !~ /^\s*$/); } return 0; } #=============================================================================== # # METHOD: $obj->attach(\%hash); # # DESCRIPTION: This method will attach file to the mail. If the data has been # specified, will use the filename and the data, instead of # reading from the file. # #=============================================================================== sub attach ($) { my($self) = shift; my($dataRef) = shift; return $self->setError("No attachment has been specified.") if $dataRef->{'filename'} =~ /^\s*$/; push(@{$self->{'attachmentArr'}}, $dataRef); return 0; } #=============================================================================== # # METHOD: $obj->createMailData(); # # DESCRIPTION: This method will create the mail data which will be sent to the # SMTP server. It will contain some mail headers and mail body. # #=============================================================================== sub createMailData () { my($self) = shift; my($currHeader) = undef; return -1 if $self->isMailReady() != 0; $self->{'maildata'} = undef; $self->{'maildata'} = "To: "; $self->{'maildata'} .= join(",\n\t", @{$self->{'mailheaders'}->{'TO'}}); $self->{'maildata'} .= "\nFrom: ".$self->{'mailheaders'}->{'FROM'}."\n"; $self->{'maildata'} .= "Subject: ".$self->{'mailheaders'}->{'SUBJECT'}."\n"; if (defined $self->{'mailheaders'}->{'CC'} && @{$self->{'mailheaders'}->{'CC'}} > 0) { $self->{'maildata'} .= "Cc: "; $self->{'maildata'} .= join(",\n\t", @{$self->{'mailheaders'}->{'CC'}}); $self->{'maildata'} .= "\n"; } if (defined $self->{'mailheaders'}->{'REPLY-TO'} && @{$self->{'mailheaders'}->{'REPLY-TO'}} > 0) { $self->{'maildata'} .= "Reply-To: "; $self->{'maildata'} .= join(",\n\t", @{$self->{'mailheaders'}->{'REPLY-TO'}})."\n"; } if (defined $self->{'mailheaders'}->{'ERRORS-TO'} && @{$self->{'mailheaders'}->{'ERRORS-TO'}} > 0) { $self->{'maildata'} .= "Errors-To: "; $self->{'maildata'} .= join(",\n\t", @{$self->{'mailheaders'}->{'ERRORS-TO'}})."\n"; } for $currHeader (sort keys %{$self->{'mailheaders'}->{'OTHERS'}}) { my($currMailHeader) = undef; ($currMailHeader = $currHeader) =~ s/\b(\w)(\w+)\b/$1\L$2/g; $self->{'maildata'} .= "$currMailHeader: "; $self->{'maildata'} .= $self->{'mailheaders'}->{'OTHERS'}->{$currHeader}; $self->{'maildata'} .= "\n"; } if (scalar(@{$self->{'attachmentArr'}}) > 0) { my($currHash); srand(time ^ $$); my($boundary) = "==__SENDMAIL__". join("", ('a'..'z','A'..'Z', 0..9)[map rand $_, (62)x25]). "__=="; $self->{'maildata'} .= "MIME-Version: 1.0\n"; $self->{'maildata'} .= "Content-Type: multipart/mixed; "; $self->{'maildata'} .= "boundary=\"$boundary\"\n"; $self->{'maildata'} .= "\n"; if (defined $self->{'mailbody'}) { $self->{'maildata'} .= "\-\-$boundary\n"; $self->{'maildata'} .= "Content-Type: text/plain; charset=\"iso-8859-1\"\n"; $self->{'maildata'} .= "Content-Transfer-Encoding: quoted-printable\n\n"; $self->{'maildata'} .= encode_qp($self->{'mailbody'})."\n\n"; } for $currHash (@{$self->{'attachmentArr'}}) { $currHash->{'content-type'} = $self->getMIMEType($currHash->{'filename'}); $self->{'maildata'} .= "\-\-$boundary\n"; $self->{'maildata'} .= "Content-Type: $currHash->{'content-type'}; name=\"$currHash->{'filename'}\"\n"; $self->{'maildata'} .= "Content-Transfer-Encoding: base64\n"; $self->{'maildata'} .= "Content-Disposition: $currHash->{'attachtype'}; filename=\"$currHash->{'filename'}\"\n"; $self->{'maildata'} .= "\n"; if (defined $currHash->{'dataref'}) { if (ref($currHash->{'dataref'}) eq "SCALAR") { $self->{'maildata'} .= encode_base64(${$currHash->{'dataref'}}); } else { my($data) = undef; my($buff) = ""; my($pos) = 0; (defined ($pos = tell($currHash->{'dataref'}))) || return $self->setError("Error in tell(): $!"); while (read($currHash->{'dataref'}, $buff, 1024)) { $data .= $buff; } $self->{'maildata'} .= encode_base64($data); seek($currHash->{'dataref'}, $pos, 0) || return $self->setError("Error in seek(): $!"); } } elsif (-f $currHash->{'filepath'}) { my($data) = undef; my($buff) = ""; open(FILE, $currHash->{'filepath'}); # In Windows platform, non-text file should use binmode() function. if (! -T $currHash->{'filepath'}) { binmode(FILE); } while (sysread(FILE, $buff, 1024)) { $data .= $buff; } close(FILE); $self->{'maildata'} .= encode_base64($data); } else { $self->{'maildata'} .= encode_base64(""); } $self->{'maildata'} .= "\n"; } $self->{'maildata'} .= "\-\-${boundary}\-\-\n"; } else { $self->{'maildata'} .= "\n"; $self->{'maildata'} .= "$self->{'mailbody'}\n"; } return 0; } #=============================================================================== # # METHOD: $obj->getEmailAddress($emailaddstr); # # DESCRIPTION: Get the email address from the email address string which might # contain email account owner's name, what we want is the email # address only. # #=============================================================================== sub getEmailAddress ($) { my($self) = shift; my($value) = shift; my($retvalue) = undef; if ($value =~ /^\<([^\>\@]+\@[\w\-]+(\.[\w\-]+)+)\>/) { ($retvalue = $1) =~ tr/[A-Z]/[a-z]/; return $retvalue; } if ($value =~ /^[^\<]+\<([^\>\@]+\@[\w\-]+(\.[\w\-]+)+)\>/) { ($retvalue = $1) =~ tr/[A-Z]/[a-z]/; return $retvalue; } return "" if $value =~ /\s+/; $value =~ tr/[A-Z]/[a-z]/; return $value if $value =~ /^[^\@]+\@[\w\-]+(\.[\w\-]+)+$/; return ""; } #=============================================================================== # # METHOD: $obj->getMIMEType($filename); # # DESCRIPTION: This will return MIME type for $filename. # #=============================================================================== sub getMIMEType ($) { my($self) = shift; my($filename) = shift; my($ext, %MIMEHash); %MIMEHash = ( 'au' => 'audio/basic', 'avi' => 'video/x-msvideo', 'class' => 'application/octet-stream', 'cpt' => 'application/mac-compactpro', 'dcr' => 'application/x-director', 'dir' => 'application/x-director', 'doc' => 'application/msword', 'exe' => 'application/octet-stream', 'gif' => 'image/gif', 'gtx' => 'application/x-gentrix', 'jpeg' => 'image/jpeg', 'jpg' => 'image/jpeg', 'js' => 'application/x-javascript', 'hqx' => 'application/mac-binhex40', 'htm' => 'text/html', 'html' => 'text/html', 'mid' => 'audio/midi', 'midi' => 'audio/midi', 'mov' => 'video/quicktime', 'mp2' => 'audio/mpeg', 'mp3' => 'audio/mpeg', 'mpeg' => 'video/mpeg', 'mpg' => 'video/mpeg', 'pdf' => 'application/pdf', 'pm' => 'text/plain', 'pl' => 'text/plain', 'ppt' => 'application/powerpoint', 'ps' => 'application/postscript', 'qt' => 'video/quicktime', 'ram' => 'audio/x-pn-realaudio', 'rtf' => 'application/rtf', 'tar' => 'application/x-tar', 'tif' => 'image/tiff', 'tiff' => 'image/tiff', 'txt' => 'text/plain', 'wav' => 'audio/x-wav', 'xbm' => 'image/x-xbitmap', 'zip' => 'application/zip', ); ($ext) = $filename =~ /\.([^\.]+)$/; $ext =~ tr/[A-Z]/[a-z]/; return defined $MIMEHash{$ext} ? $MIMEHash{$ext} : "application/octet-stream"; } #=============================================================================== # # METHOD: $obj->getRcptLists(); # # DESCRIPTION: This will generate an array of the recipients' email address. # Basically, this method only called by $obj->sendMail() method, # which needs to send "RCPT TO:" request to the SMTP server. # #=============================================================================== sub getRcptLists () { my($self) = shift; my(@rcptLists) = (); my($currEmail) = undef; for $currEmail (@{$self->{'mailheaders'}->{'TO'}}) { my($currEmail) = $self->getEmailAddress($currEmail); push(@rcptLists, $currEmail) if ($currEmail !~ /^\s*$/ && (! grep(/^$currEmail$/, @rcptLists))); } if (defined $self->{'mailheaders'}->{'BCC'} && @{$self->{'mailheaders'}->{'BCC'}} > 0) { for $currEmail (@{$self->{'mailheaders'}->{'BCC'}}) { my($currEmail) = $self->getEmailAddress($currEmail); push(@rcptLists, $currEmail) if ($currEmail !~ /^\s*$/ && (! grep(/^$currEmail$/, @rcptLists))); } } if (defined $self->{'mailheaders'}->{'CC'} && @{$self->{'mailheaders'}->{'CC'}} > 0) { for $currEmail (@{$self->{'mailheaders'}->{'CC'}}) { my($currEmail) = $self->getEmailAddress($currEmail); push(@rcptLists, $currEmail) if ($currEmail !~ /^\s*$/ && (! grep(/^$currEmail$/, @rcptLists))); } } return \@rcptLists; } #=============================================================================== # # METHOD: $obj->isMailReady(); # # DESCRIPTION: Check if the basic mail headers and the mail body have been set # or not. # p/s: The "From:", "To:" and "Subject:" mail headers are required # here, I feel that a mail should contain these headers. It is # just a personal opinion, if you do not think so, just comment # them out. # #=============================================================================== sub isMailReady () { my($self) = shift; return $self->setError("No sender has been specified.") if ! defined $self->{'mailheaders'}->{'FROM'}; return $self->setError("No recipient has been specified.") if ((! defined $self->{'mailheaders'}->{'TO'}) || (defined @{$self->{'mailheaders'}->{'TO'}} && @{$self->{'mailheaders'}->{'TO'}} < 1)); return $self->setError("No subject has been specified.") if ! defined $self->{'mailheaders'}->{'SUBJECT'}; return $self->setError("No mail body has been set.") if ((! defined $self->{'mailbody'}) && (scalar(@{$self->{'attachmentArr'}}) < 1)); return 0; } #=============================================================================== # # METHOD: $obj->receiveFromServer(\*SOCKET); # # DESCRIPTION: This will receive the data replied from the server. # #=============================================================================== sub receiveFromServer ($) { my($self) = shift; my($socket) = shift; my($reply); # # We keep receiveing the data from the server until # it waits for next command. # while ($socket && ($reply = <$socket>)) { return $self->setError($reply) if $reply =~ /^5/; print $reply if $self->{'debugmode'}; last if $reply =~ /^\d+ /; } return 0; } #=============================================================================== # # METHOD: $obj->reset(); # # DESCRIPTION: This will clear the data that have been set before. # #=============================================================================== sub reset () { my($self) = shift; $self->{'debugmode'} = $self->OFF; $self->{'mailbody'} = undef; $self->{'maildata'} = undef; $self->{'mailheaders'} = undef; $self->{'sender'} = undef; $self->{'attachmentArr'} = []; return 0; } #=============================================================================== # # METHOD: $obj->sendMail(); # # DESCRIPTION: This will use the Socket to connect to the SMTP port to send the# mail. # #=============================================================================== sub sendMail () { my($self) = shift; my($iaddr, $paddr, $proto, $rcptlistRef, $currEmail) = undef; # # Get the sender's email address, this will be used in "MAIL FROM:" request. # $self->{'sender'} = $self->getEmailAddress($self->{'mailheaders'}->{'FROM'}); # # Invalid email address format. # return $self->setError("Please check the sender's email address setting.") if $self->{'sender'} =~ /^\s*$/; # # We create the mail data here. # return -1 if $self->createMailData() != 0; # # We get the recipients' email addresses. # $rcptlistRef = $self->getRcptLists(); # # If no recipient has been specified, this is an error. # return $self->setError("No recipient has been specified.") if @{$rcptlistRef} == 0; # # Please refer to Socket module manual. (perldoc Socket) # $iaddr = inet_aton($self->{'smtpserver'}) || return $self->setError("no host: $self->{'smtpserver'}"); $paddr = sockaddr_in($self->{'smtpport'}, $iaddr); $proto = getprotobyname('tcp'); socket(SOCK, PF_INET, SOCK_STREAM, $proto) || return $self->setError("Socket error: $!"); connect(SOCK, $paddr) || return $self->setError("Error in connecting to $self->{'smtpserver'} at port $self->{'smtpport'}: $!"); return -1 if $self->receiveFromServer(\*SOCK) != 0; return -1 if $self->sendToServer(\*SOCK, "HELO $_LOCALHOST") != 0; return -1 if $self->receiveFromServer(\*SOCK) != 0; return -1 if $self->sendToServer(\*SOCK, "MAIL FROM: <$self->{'sender'}>") != 0; return -1 if $self->receiveFromServer(\*SOCK) != 0; for $currEmail (@{$rcptlistRef}) { return -1 if $self->sendToServer(\*SOCK, "RCPT TO: <$currEmail>") != 0; return -1 if $self->receiveFromServer(\*SOCK) != 0; } return -1 if $self->sendToServer(\*SOCK, "DATA") != 0; return -1 if $self->receiveFromServer(\*SOCK) != 0; return -1 if $self->sendToServer(\*SOCK, "$self->{'maildata'}\r\n.") != 0; return -1 if $self->receiveFromServer(\*SOCK) != 0; return -1 if $self->sendToServer(\*SOCK, "QUIT") != 0; return -1 if $self->receiveFromServer(\*SOCK) != 0; close(SOCK) || return $self->setError("Fail close connectiong socket: $!"); print "The mail has been sent to ".scalar(@{$rcptlistRef}) if $self->{'debugmode'}; print " person/s successfully.\n" if $self->{'debugmode'}; return 0; } #=============================================================================== # # METHOD: $obj->sendToServer(\*SOCKET, $message); # # DESCRIPTION: This will send the message to the SMTP server. # #=============================================================================== sub sendToServer ($$) { my($self) = shift; my($socket) = shift; my($message) = shift; print "$message\n" if $self->{'debugmode'}; # # Sending data to the server. # send($socket, "$message\r\n", 0) || return $self->setError("Fail to send $message: $!"); return 0; } #=============================================================================== # # METHOD: $obj->setDebug($obj->ON); # $obj->setDebug($obj->OFF); # # DESCRIPTION: Set the debug mode as ON/OFF. # Also see: $obj->ON and $obj->OFF methods. # #=============================================================================== sub setDebug ($) { my($self) = shift; $self->{'debugmode'} = shift; return 0; } #=============================================================================== # # METHOD: $obj->setError($errormessage); # # DESCRIPTION: This will set the error message to "error" attribute in the # object and return -1 value. # #=============================================================================== sub setError ($) { my($self) = shift; my($errorMsg) = shift; $self->{'error'} = $errorMsg if $errorMsg !~ /^\s*$/; return -1; } #=============================================================================== # # METHOD: $obj->setMailBody($mailbody); # # DESCRIPTION: Set the mail body content. # #=============================================================================== sub setMailBody ($) { my($self) = shift; my($mailbody) = shift; $self->{'mailbody'} = $mailbody; return 0; } #=============================================================================== # # METHOD: $obj->setMailHeader($mailheader, $mailheadervalue); # # DESCRIPTION: This method is used for setting custom email headers. # #=============================================================================== sub setMailHeader ($$) { my($self) = shift; my($mailheader) = shift; my($mailheadervalue) = shift; $mailheader =~ tr/[a-z]/[A-Z]/; $self->{'mailheaders'}->{'OTHERS'}->{$mailheader} = $mailheadervalue; return 0; } #=============================================================================== # # METHOD: $obj->setSMTPPort($smtpport); # # DESCRIPTION: Set the SMTP port. # #=============================================================================== sub setSMTPPort ($) { my($self) = shift; my($smtpport) = shift; $self->{'smtpport'} = $smtpport if $smtpport =~ /^\d+$/; return 0; } #=============================================================================== # # METHOD: $obj->setSMTPServer($smtpserver); # # DESCRIPTION: Set the SMTP server. # #=============================================================================== sub setSMTPServer ($) { my($self) = shift; my($smtpserver) = shift; $smtpserver =~ s/\s*//g; $self->{'smtpserver'} = $smtpserver if $smtpserver !~ /^\s*$/; return 0; } #=============================================================================== # # METHOD: $obj->version; # # DESCRIPTION: Get the version of the module. # #=============================================================================== sub version () { my($self) = shift; return $VERSION; } #=============================================================================== # # END of the module. # #=============================================================================== 1; __END__ =head1 NAME SendMail -- This is a perl module which is using Socket to connect the SMTP port to send mails. =head1 SYNOPSIS use SendMail; $smtpserver = "mail.server.com"; $smtpport = 25; $sender = "Sender "; $subject = "Subject of the mail."; $recipient = "Recipient "; $recipient2 = "Recipient 2 "; @recipients = ($recipient, $recipient2); $administrator = "Administrator "; $administrator2 = "Administrator 2 "; $replyto = $sender; $replyto2 = $recipient; @replytos = ($replyto, $replyto2); $header = "X-Mailer"; $headervalue = "Perl SendMail Module 1.05"; $mailbodydata = "This is a testing mail."; $obj = new SendMail(); $obj = new SendMail($smtpserver); $obj = new SendMail($smtpserver, $smtpport); $obj->setDebug($obj->ON); $obj->setDebug($obj->OFF); $obj->From($sender); $obj->Subject($subject); $obj->To($recipient); $obj->To($recipient, $recipient2); $obj->To(@recipients); $obj->Cc($recipient); $obj->Cc($recipient, $recipient2); $obj->Cc(@recipients); $obj->Bcc($recipient); $obj->Bcc($recipient, $recipient2); $obj->Bcc(@recipients); $obj->ErrorsTo($administrator); $obj->ErrorsTo($administrator, $administrator2); $obj->ErrorsTo(@administrators); $obj->ReplyTo($replyto); $obj->ReplyTo($replyto, $replyto2); $obj->ReplyTo(@replytos); $obj->setMailHeader($header, $headervalue); $obj->setMailBody($mailbodydata); $obj->Attach($file); $obj->Attach($file, \$filedata); $obj->Attach($file, \*FILEHANDLE); $obj->Inline($file); $obj->Inline($file, \$filedata); $obj->Inline($file, \*FILEHANDLE); if ($obj->sendMail() != 0) { print $obj->{'error'}."\n"; } $obj->reset(); =head1 EXAMPLE http://www.tneoh.zoneit.com/perl/SendMail/testSendMail.pl =head1 DESCRIPTION This module is written so that user can easily use it to send mailing list. Please do not abuse it. And it can be used in any perl script to send a mail similar to sending mail by using /usr/lib/sendmail program. I have tested this module on Unix and Windows platforms, it works fine. Of course you need perl version 5. With the example script, testSendMail.pl, you can simply a testing on it. Errors, comments or questions are welcome. =head1 CHANGES 1.00->1.01 Recipients with email address contains a "-" in the hostname, will be able to receive the email now. 1.01->1.02 Module now not only expecting one line reply from the server, it can receive multiple lines until the server waiting for next command. 1.02->1.03 Repeat declaration of "$currEmail" will give an error in NT system. 1.03->1.04 Email addresses are enclosed in < and > after "MAIL FROM" and "RCPT TO" commands.(RFC821) For Microsoft Exchange 4, email addresses not enclosed in < and > will get an error from the system. 1.04->1.05 getEmailAddress() subroutine should accept email address in just "" format. 1.05->2.00b Simple MIME supported. attach(), Attach() and Inline() subroutines added. 2.00b->2.00 Attach() and Inline() supports for filehandle which is easier for users who are using CGI.pm. Prototypes are added. And we send "\r\n" to the SMTP server instead of only "\n". 2.00->2.01 After sending the maildata, supposed to be "\r\n" instead of just "\n". =head1 CREDITS laurens van alphen http://craxx.com/ Dag ien Juliano, Sylvia, CON, OASD(HA)/TMA Tony Simopoulos =head1 SOURCE http://www.tneoh.zoneit.com/perl/SendMail/SendMail.pm =head1 AUTHOR Simon Tneoh Chee-Boon tneohcb@pc.jaring.my Copyright (c) 1998,1999,2000 Simon Tneoh Chee-Boon. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 VERSION Version 2.01 06 April 2000 =head1 SEE ALSO Socket.pm, MIME::Base64.pm, MIME::QuotedPrint.pm =cut cgibin/configure.cgi0100644000000000000000000000310307151132752013455 0ustar rootroot#!/usr/bin/perl #################################################################################################### # MIME MAILER Version 2.2 # Copyright 2000 Psybercore.com, Inc. webmaster@superscripts.com # Created 6/12/99 Last Modified 8/18/00 #################################################################################################### # COPYRIGHT NOTICE # Copyright 2000 Psybercore.com, Inc - All Rights Reserved. # http://www.superscripts.com # Selling the code for this program, modifying or redistributing this software over the Internet or # in any other medium is forbidden. Copyright and header may not be modified # # My name is DREW STAR... and I am FUNKY... http://www.drewstar.com/ # #################################################################################################### sub configure { $sendmailpm = "/full/path/to/cgi-bin/mimemailer"; $smtpserver = "name of your mail SMTP server"; $formurla = "FULL URL TO YOUR FORM (OR MAY LEAVE BLANK)"; $formurlb = "ALTERNATE URL TO YOUR FORM (OR MAY LEAVE BLANK)"; $formurlc = ""; $formurld = ""; $mailprogram = '/path/to/sendmail'; $filedirectory = "/full/path/to/cgi-bin/mimemailer/files"; $replyaddress = "YOURNAME "; $emailsubject = "SUBJECT LINE OF EMAIL!"; } 1; # Return true cgibin/sendmail.cgi0100644000000000000000000001722207151132756013303 0ustar rootroot#!/usr/bin/perl #################################################################################################### # MIME MAILER Version 2.2 # Copyright 2000 Psybercore.com, Inc. webmaster@superscripts.com # Created 6/12/99 Last Modified 8/18/00 #################################################################################################### # COPYRIGHT NOTICE # Copyright 2000 Psybercore.com, Inc - All Rights Reserved. # http://www.superscripts.com # Selling the code for this program, modifying or redistributing this software over the Internet or # in any other medium is forbidden. Copyright and header may not be modified # # My name is DREW STAR... and I am FUNKY... http://www.drewstar.com/ # #################################################################################################### ############################################################ # GET OUR BASIC VARIABLES TOGETHER ############################################################ require "configure.cgi"; &configure; $referingurl = "$ENV{'HTTP_REFERER'}"; $host = "$ENV{'REMOTE_HOST'}"; $addr = "$ENV{'REMOTE_ADDR'}"; $cookie ="$ENV{'HTTP_COOKIE'}"; $scripthost ="$ENV{'HTTP_HOST'}"; chop($date = &ctime(time)); ($weekday,$month,$day,$time,$zone,$year)=split(/ /,$date); if ($day eq ""){ $day = $time; } $shortdate = "$month $day 2000"; use lib "$sendmailpm"; $| = 1; print "Set-Cookie: MIMESCRIPT=FIRED; path=/;\n"; print "Content-Type: text/html\n\n"; &checkformurl; &nukespammers; ############################################################ # MAIN ROUTINE ############################################################ use CGI_LIB; use SendMail; my($sm) = new SendMail("$smtpserver"); my($cgiObj) = new CGI_LIB; my($sender) = $replyaddress; my($errorsto) = $replyaddress; my($replyto) = $replyaddress; my($subject) = $emailsubject; my($recipient) = "$cgiObj->{'email'}"; my($filerequested) = "$cgiObj->{'filename'}"; $filename = "$cgiObj->{'filename'}"; $recipientala = "$cgiObj->{'email'}"; &hackfu; ############################################################ # FORMAT THE EMAIL BODY ############################################################ my($mailbody) = <{'email'} FILE: $cgiObj->{'filename'} DATE: $shortdate REFERURL: $referingurl HOST: $host IP ADDRESS OF SENDER: $addr COOKIE: $cookie ==================================================== ENDMAILBODY ############################################################ # SEND MESSAGE AND SCRIPT ############################################################ $sm->From($sender); $sm->To($recipient); $sm->ReplyTo($sender); $sm->ErrorsTo($errorsto); $sm->Subject($subject); $sm->setMailBody($mailbody); $sm->Attach("$filedirectory/$filename"); if ($sm->sendMail() != 0) { printError($sm->{'error'}); exit; } &printthankyouscreen; $sm->reset(); exit 0; ############################################################ # PRINT THANK YOU SCREEN ############################################################ sub printthankyouscreen{ print < THANK YOU!


Thank you!
Your file has been sent to $cgiObj->{'email'}

====================================================
THIS EMAIL WAS SENT TO YOU BY
====================================================
FILE SENT:				$cgiObj->{'filename'}
DATE SENT: 				$shortdate
FILE SENT FROM:			$referingurl
IP ADDRESS OF SENDER:		$addr
SCRIPT HOSTED BY:			$scripthost
COOKIE:				$cookie
====================================================

ENDTHANKYOUSCREEN } ############################################################ # VALIDATE FORM URL IS OK ############################################################ sub checkformurl { if ($referingurl ne $formurla){ if ($referingurl ne $formurlb){ if ($referingurl ne $formurlc){ if ($referingurl ne $formurld){ print "ERROR! This submission is not from a valid url."; exit; } } } } } ############################################################ # STOP PEOPLE FROM SPAMMING THROUGH THIS DEMO ############################################################ sub hackfu { if ($recipientala =~ /psybercore/i){ print "NICE TRY LAME ASS - TRY TO SPAM ME AND I WILL HUNT YOU DOWN FOR 4 DECADES
"; print "$addr"; exit; } if ($recipientala =~ /psybercore/i){ print "NICE TRY LAME ASS - TRY TO SPAM ME AND I WILL HUNT YOU DOWN FOR 4 DECADES
"; print "$addr"; exit; } if ($recipientala =~ /superscripts/i){ print "NICE TRY LAME ASS - TRY TO SPAM ME AND I WILL HUNT YOU DOWN FOR 4 DECADES
"; print "$addr"; exit; } if ($recipientala =~ /blacklist/i){ print "NICE TRY LAME ASS - TRY TO SPAM ME AND I WILL HUNT YOU DOWN FOR 4 DECADES
"; print "$addr"; exit; } if ($recipientala =~ /perlmodules/i){ print "NICE TRY LAME ASS - TRY TO SPAM ME AND I WILL HUNT YOU DOWN FOR 4 DECADES
"; print "$addr"; exit; } if ($recipientala =~ /rosary/i){ print "NICE TRY LAME ASS - TRY TO SPAM ME AND I WILL HUNT YOU DOWN FOR 4 DECADES
"; print "$addr"; exit; } if ($recipientala =~ /evilscripts/i){ print "NICE TRY LAME ASS - TRY TO SPAM ME AND I WILL HUNT YOU DOWN FOR 4 DECADES
"; print "$addr"; exit; } } ############################################################ # MAIL ERROR ############################################################ sub printError { my($error) = shift; print <Error

Error


$error

Please click here to try again.


ENDERROR return 0; } ############################################################ # BLOCK MULTIPLE ATTEMPTS TO SEND FILES ############################################################ sub nukespammers{ ($trash,$status) = split(/MIMESCRIPT=/,$cookie); if ($status=~ /;/){ ($status,$trash) = split(/;/,$status); } if ($status eq ""){ return; } if ($status eq "FIRED"){ print "ERROR! Repeat form submisssions are blocked."; exit; } } ############################################################ # TIME ROUTINE ############################################################ sub ctime { @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); @MoY = ('Jan','Feb','Mar','Apr','May','Jun', 'Jul','Aug','Sep','Oct','Nov','Dec'); local($time) = @_; local($[) = 0; local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst); $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : ''; ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = ($TZ eq 'GMT') ? gmtime($time) : localtime($time); if($TZ=~/^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/){ $TZ = $isdst ? $4 : $1; } $TZ .= ' ' unless $TZ eq ''; $year += 1900; sprintf("%s %s %2d %2d:%02d:%02d %s%4d\n", $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZ, $year); } index.html0100644000000000000000000000270307304610513011553 0ustar rootroot Thank You!

 

 

Simply fill in your email address and choose a file that you would like to receive. 

Your Email Address
Choose a File