We purchased a Customer Control Panel script, all functions are working fine except for the mail functions (i.e. retrieve lost password, new account confirmation, etc.). Prefer to use smtp but tried that and sendmail without any luck. We paid script owner to solve the issue ... they took our money and never tried.
smtp server name is correct (is working in other scripts on the site). When configured with smpt, the script runs as if everything is ok, no error messages, but mail never arrives.
ISP is Interland. Web server is Windows NT ... mail server is Unix. Deadline is looming on this so any help is greatly appreciated. Below is a the main perl file (control.pl). Following that is the library file with the mail functions (function.pl):
CONTROL.PL:
#!/usr/bin/perl
#######################################
#
# Control Panel
#
# by Alex Habibulin, http://www.mycgiscripts.com
#
# Control panel script. Allow signup, login, lostpassword and members features
#
# Contact us for quote if you need to add instant payment mechanism here.
#
# Also this script can be manage one multiply login info for all your scripts,
# but it requied some cgi work. Contact our cgi service for this.
#
# Warning! Script is using cookies for login!
#######################################################################
eval {
($0 =~ m,(.*)/[^/]+,) && unshift (@INC, "$1"); # Get the script location: UNIX /
($0 =~ m,(.*)\\[^\\]+,) && unshift (@INC, "$1"); # Get the script location: Windows \
require "admin/config.pl";
require "admin/functions.pl";
use CGI;
};
if ($@) {
print "Content-type: text/html \n\n";
print "Error including libraries: $@\n";
print "Make sure they exist, permissions are set properly, and paths are set correctly.";
exit;
}
%in=&parse;
if ($smtp_server) {&init_smtp;};
#This operations not require login/pass
if ($craccount) {
if ($in{'signup1'}) {&signup1;exit;}
if ($in{'signup'}) {
%in=();
show_control_panel_signup_form();
exit;
}
if ($in{'validate'}) {&process_validate;exit;}
}
if ($in{'lostpassword1'}) {&process_lostpassword;exit;}
if ($in{'lostpassword'}) {&show_control_panel_lostpassword;exit;}
if ($in{'logout'}) {&process_logout;exit;}
#Check password
$ok=0;
my $AUTH = CGI->cookie('CPMember');
if ($AUTH || $in{'login'}) {
if ($in{'login'}) { ($login, $password) = ($in{'login'}, $in{'password'});
}else{
($login, $password) = split /:/, $AUTH; }
open (IN, "$db_members") or cgierr("Cannot open $db_members : Reason $!");
while (<IN>) {
chomp; $s=$_;
@d=split(/\|/,$s);
if ($login eq $d[0]) {
if ($in{'login'}) {
if ($password eq $d[1]) { $ok++; $email=$d[3];$name=$d[2]; $okmem=$s;}
}else{
if ($password eq crypt($d[1], "AA") ) {$ok++; $email=$d[3];$name=$d[2]; $okmem=$s;}
}
}
}
close IN;
if ($ok) {
if ($in{'login'}) {
print CGI->header( -cookie => CGI->cookie ( -name => 'CPMember', -value => ($login .':'. crypt($password, "AA")), path => '/' ) );
$html_headers_printed = 1;
#Log file
$tm=time(); $tm1=unixdate($tm);
open (OUT, ">>$upath/data/$d[0].log") or error("Cannot create log file! : $!");
print OUT "$tm1 ($tm) : Login from $ENV{'REMOTE_ADDR'} , Referer $in{'ref'}\n";
close OUT;
}
}
}
if (!$ok) {&html_print_headers;&show_control_panel_login_form;exit;}
if ($in{'action'} eq 'edit_details') {&edit_details;exit;}
if ($in{'dl'}) {&download;exit;}
if ($in{'show'}) {&showtemplate;exit;}
#OK. From this we can work with logged user
#His name in $login; - THIS NOT FOR ADMIN - only for members
$user=$login;
&html_print_headers;
$action = $in{'action'};
if ($action eq 'logout') {&process_logout;}
#Show all files and personal message
open (IN, "$upath/data/$login.msg");
@msg = <IN>;
close IN;
$message=join "", @msg;
#$okmem containing record about this customer
@minfo=split(/\|/,$okmem);
%mf=();
$ftotal=0;
$tot=$#minfo + 1;
for ($i=11;$i<$tot;$i+=2) {
if ($minfo[$i] eq '0') {$minfo[$i]="";}
if ($minfo[$i]) {$ftotal++;$mf{$minfo[$i]}=$minfo[$i+1];}
}
#Reading files DB;
@files=();
open (IN, "$db_files") or error("Cannot open files list! Please upload empty file to $db_files and chmod to 666 (NT - CHANGE READ WRITE)");
while(<IN>)
{
chomp;
@t=split(/\|/,$_);
push @files, $t[0],$t[1],$t[2],$t[3];
}
close IN;
$link="";
$total=$#files + 1;
for ($i=0;$i<$total;$i+=4) {
if (exists($mf{$files[$i]})) {
$regnum="";
$rg=$mf{$files[$i]};
if ($rg eq '0') {$rg="";}
if ($rg) {$regnum = "Reg number : $rg";}
$files[$i+3] =~ s/~~/\|/g;
$files[$i+3] =~ s/''/<br>\n/g;
$link.=load_template("filelink.html", {
id => $files[$i],
title => $files[$i+1],
descr => $files[$i+3],
regnum => $regnum,
url => "$cgiurl/control.pl?dl=$files[$i]"});
}
}
print load_template("control-panel.html", {
links => $link,
total => $ftotal,
message => $message,
login => $login,
email => $email,
name => $name});
exit;
sub process_logout{
use CGI;
print CGI->header( -cookie => CGI->cookie ( -name => 'CPMember', -value => '', expires => '-1s', path => '/' ) );
$html_headers_printed = 1;
print load_template("logout.html", { });
exit;
}
sub signup1{
$login=$in{'login'};
$pass=$in{'password'};
$pass1=$in{'ppassword'};
$name=$in{'name'};
$email=$in{'email'};
#We not checking address info.
$address=$in{'address'};
$province=$in{'province'};
$state=$in{'state'};
$country=$in{'country'};
$phone=$in{'phone'};
#Check all this.
&html_print_headers;
#1. to correct format of values
if (!$login) {show_control_panel_signup_form("Error: <b>login</b> cannot be empty");exit;}
if (!$pass) {show_control_panel_signup_form("Error: <b>password</b> cannot be empty");exit;}
if (!$name) {show_control_panel_signup_form("Error: <b>name</b> cannot be empty");exit;}
if ($pass ne $pass1) {show_control_panel_signup_form("Error: <b>passwords</b> not same");exit;}
if (length ($pass) <5 ) {show_control_panel_signup_form("Error: <b>password</b> must be more 5 chars");exit;}
if (length ($login) <3 ) {show_control_panel_signup_form("Error: <b>login</b> must be more 3 chars");exit;}
if ($email !~ /.+@.+\..+/) {show_control_panel_signup_form("Error: <b>email</b> not correct");exit;}
if ($login =~ /\s/is) {show_control_panel_signup_form("Error: <b>login</b> cannot contain spaces");exit;}
if ($reqaddress) {
if (!$address) {show_control_panel_signup_form("Error: <b>address</b> cannot be empty");exit;}
if (!$state) {show_control_panel_signup_form("Error: <b>state</b> cannot be empty");exit;}
if (!$country) {show_control_panel_signup_form("Error: <b>country</b> cannot be empty");exit;}
if (!$phone) {show_control_panel_signup_form("Error: <b>phone</b> cannot be empty");exit;}
}
#2. Check if login exists
open (IN, "$db_members") or error("Cannot open $db_members : Reason $!");
while (<IN>) {
chomp;
@d=split(/\|/,$_);
if ($d[0] eq $login) {close IN; &show_control_panel_signup_form("Error: <b>login - $login</b> already exists");exit;}
if ($d[3] eq $email) {close IN; &show_control_panel_signup_form("Error: <b>account for $email</b> already exists");exit;}
}
close IN;
open (IN, "$db_umembers") or error("Cannot open $db_members : Reason $!");
while (<IN>) {
chomp;
@d=split(/\|/,$_);
if ($d[0] eq $login) {close IN; &show_control_panel_signup_form("Error: <b>login - $login</b> already exists");exit;}
if ($d[3] eq $email) {close IN; &show_control_panel_signup_form("Error: <b>account for $email</b> already exists");exit;}
}
close IN;
#Generation of validate code
$tm=time();
@passch = ('a'..'z');
for ($l = 0; $l < 2; $l+=1) {
$randnum = int(rand($#passch + 1)); $salt1 .= @passch[$randnum];}
$valid=crypt("$tm$login$pass", $salt1);
#3. Ok. Adding profile and sending email
open (OUT, ">>$db_umembers") or cgierr("Cannot write to $db_members : $!");
print OUT "$login|$pass|$name|$email|$valid|$address|$province|$state|$country|$phone\n";
close OUT;
$msg_mod = &load_template("email-unc_createprofile.txt", {validate => $valid, cgi_url => $cgiurl, %in});
sendmail($sendmail,$smtpserv,"Please confirm new account creation",$email,$adminemail,$adminemail,"New account",$msg_mod,0);
&show_controlpanel_signup_validation;
exit;
}
sub process_lostpassword{
$email=$in{'lostpassword1'};
&html_print_headers;
open (IN, "$db_members") or error("Cannot open $db_members : Reason $!");
while (<IN>) {
chomp;
@d=split(/\|/,$_);
if ($d[3] eq $email) { close IN;
$msg_mod = &load_template("email-lostpassword.txt",
{name => $d[2],
validate => "",
email => $d[3],
login => $d[0],
password => $d[1]}, cgi_url => $cgiurl);
&sendmail($sendmail,$smtpserv,"Account password",$email,$adminemail,$adminemail,"Account password",$msg_mod,0);
&show_control_panel_lostpassword_status("Password is sent");exit;
}
}
close IN;
&show_control_panel_lostpassword_status("Cannot find user account with same email");
exit;
}
sub process_validate{
$num=$in{'validate'};
$ok=0;$str="";
#&html_print_headers; print "OK";
@all=();
$tm=time();
open (IN, "$db_umembers") or error("Cannot open $db_umembers : Reason $!");
while (<IN>) {
chomp;
$s=$_;
@d=split(/\|/,$s);
if ($d[4] eq $num) {$login=$d[0];$password=$d[1];$str=$s;$ok++;}else{push @all , $s;}
}
close IN;
if (!$ok) {error("Validation code is incorrect");}
#Read default files
@df=();
open (IN, "$db_def_files") or error("Cannot open default files list!");
while(<IN>) {chomp; $s=$_;
push @df, $s;}
close IN;
open (OUT, ">>$db_members") or error("Cannot write to $db_members ; $!");
print OUT "$str|$tm";
if ($#df >= 0) {print OUT "|";print OUT join "|", @df;}
print OUT "\n";
close OUT;
#Remove record with this validation code
open(OUT, ">$db_umembers") or error("Cannot open $db_umembers : Reason $!");
foreach $e (@all) {print OUT "$e\n";}
close OUT;
$tm=time(); $tm1=unixdate($tm);
open (OUT, ">>$upath/data/$login.log");
print OUT "$tm1 ($tm) : Account created & confirmed : IP $ENV{'REMOTE_ADDR'}\n";
close OUT;
&show_control_panel_signup_ok;
exit;
}
sub edit_details{
#User string - $okmem
@d=split(/\|/,$okmem);
&html_print_headers;
if ($in{'step'} eq '2') {&storedetails;exit;}
print &load_template("edit_details.html", {
loginn => $login,
pass => $d[1],
name => $d[2],
email => $d[3],
address => $d[5],
province => $d[6],
state => $d[7],
country => $d[8],
phone => $d[9]});
exit;
}
sub storedetails{
#Read members file and looking for this record.
$id=$login;
$password=$in{'pass'};
$name=$in{'name'};
$email=$in{'email'};
$address=$in{'address'};
$province=$in{'province'};
$state=$in{'state'};
$country=$in{'country'};
$phone=$in{'phone'};
foreach $bb (keys %in) {if ($in{$bb}=~ /\|/i) {error("| symbol is disabled!");}}
if (!$login) {error("Error: <b>login</b> cannot be empty");exit;}
if (length ($login) <3 ) {error("Error: <b>login</b> must be more 3 chars");exit;}
if ($login =~ /\s/is) {error("Error: <b>login</b> cannot contain spaces");exit;}
if (!$password) {error("Error: <b>password</b> cannot be empty");exit;}
if (!$name) {error("Error: <b>name</b> cannot be empty");exit;}
if (length ($password) <5 ) {error("Error: <b>password</b> must be more 5 chars");exit;}
if ($email !~ /.+@.+\..+/) {error("Error: <b>email</b> not correct");exit;}
if ($reqaddress) {
if (!$address) {error("Error: <b>address</b> cannot be empty");exit;}
if (!$state) {error("Error: <b>state</b> cannot be empty");exit;}
if (!$country) {error("Error: <b>country</b> cannot be empty");exit;}
if (!$phone) {error("Error: <b>phone</b> cannot be empty");exit;}
}
@d=split(/\|/,$okmem);
$tm=time();
$d[1]=$password;$d[2]=$name;$d[3]=$email;$d[4]="USER_CHANGED";
$d[5]=$address;$d[6]=$province;$d[7]=$state;$d[8]=$country;$d[9]=$phone;
$rec=join "|", @d; @db=();
open (IN, "$db_members") or error("Cannot open $db_members : Reason $!");
while (<IN>) {
chomp;$s=$_;
@d=split(/\|/,$s);
if ($d[0] ne $login) {push @db,$s;}
}
close IN;
open (OUT,">$db_members") or error("Cannot modify - Error : $!");
if ($db_use_flock) { flock (OUT, 2) or error ("unable to get exclusive lock. Reason: $!"); }
print OUT "$rec\n";
foreach $x (@db) {print OUT "$x\n";}
close OUT;
$tm=time(); $tm1=unixdate($tm);
open (OUT, ">>$upath/data/$login.log");
print OUT "$tm1 ($tm) : User $login : $ENV{'REMOTE_ADDR'} MODIFED account info.\n";
close OUT;
&html_print_headers;
print &load_template("account_modifed.html", {%in});
exit;
}
sub download{
#Script retrive via libwww binary file, and send it back to customer if defined
#or if low level of security specifed - simply redirect to it.
$tm=time(); $tm1=unixdate($tm);
#Checking for permission for this user download this file.
#$memok
@d=split(/\|/,$okmem);
$fid=$in{'dl'};
if (!$fid) {error("You cannot download this file : id not specifed");}
$tot=$#d + 1; $ok=0;
for ($i=11;$i<$tot;$i+=2) {
if ($d[$i] eq '0') {$d[$i]="";}
if ($d[$i] eq $fid) {$ok++;}
}
if (!$ok) {error("You cannot download this file!");}
#Ok. Looking files db for real file location
$furl="";
open (IN, "$db_files") or error("Cannot open files list! Please upload empty file to $db_files and chmod to 666 (NT - CHANGE READ WRITE)");
while(<IN>)
{
chomp;
@t=split(/\|/,$_);
if ($t[0] eq $fid) {$url=$t[2];$ft=$t[1];last;}
}
close IN;
#Ok. Return results for user (antileech)
if (!$antileech) {
open (OUT, ">>$upath/data/$login.log");
print OUT "$tm1 ($tm) : User from IP $ENV{'REMOTE_ADDR'} downloaded file $ft\n";
close OUT;
print "Location: $url \n\n";exit;}
#If high level - retrive file, generating of headers and send it to user.
$file=fetch($url);
if (!$file) {error("Network troubles with file access. Try later please!");}
#Content type.
#If you need add other type - call us or check http://www.oac.uci.edu/indiv/ehood/MIME/MIME.html
SWITCH:
{
$content_type = "audio/mpeg" and last if $url =~ /\.mp3$/i;
$content_type = "image/jpeg" and last if $url =~ /\.jpeg$/i;
$content_type = "image/jpeg" and last if $url =~ /\.jpg$/i;
$content_type = "image/gif" and last if $url =~ /\.gif$/i;
$content_type = "text/html" and last if $url =~ /\.html$/i;
$content_type = "text/html" and last if $url =~ /\.shtml$/i;
$content_type = "text/html" and last if $url =~ /\.shtm$/i;
$content_type = "application/pdf" and last if $url =~ /\.pdf$/i;
$content_type = "text/html" and last if $url =~ /\shtm$/i;
$content_type = "text/plain" and last if $url =~ /\.txt$/i;
$content_type = "application/x-zip-compressed" and last if $url =~ /\.zip$/i;
}
if (!$content_type) { $content_type = "application/x-msdownload"; }
#Determine file name! Must be filename with extension!!!!
@t=split(/\//,$url);
$tt=$#t; $filename=$t[$tt];
#Bad - MSIE not support filenames, and only parse it from URL
#http://msdn.microsoft.com/workshop/networking/moniker/overview/appendix_a.asp
#print "Content-type: $content_type; filename=$filename\n\n";
print "Content-type: $content_type\n\n";
print $file;
open (OUT, ">>$upath/data/$login.log");
print OUT "$tm1 ($tm) : IP $ENV{'REMOTE_ADDR'} downloaded file $ft\n";
close OUT;
exit;
}
sub fetch
{
my ($url) = @_;
my $page_returned = "";
eval{ require LWP::UserAgent; };
$ua = new LWP::UserAgent;
$ua->timeout(600);
$ua->agent('Mozilla/4.0');
my $req = new HTTP::Request GET => "$url";
my $res = $ua->request($req);
if ($res->is_success) { $page_returned = $res->content; }
return $page_returned;
}
sub showtemplate{
$file=$in{'show'};
$file =~ s/\///g;
$file =~ s/\\//g;
$file =~ s/\>//g;
$file =~ s/\<//g;
$file =~ s/\s//g;
@d=split(/\|/,$okmem);
&html_print_headers;
print &load_template($file, {
login => $login,
pass => $d[1],
name => $d[2],
email => $d[3],
address => $d[5],
city => $d[6],
state => $d[7],
country => $d[8],
phone => $d[9]});
exit;
}
-----------------------------------------------
FUNCTIONS.PL:
#######################################
#
# Remote suite
#
# by Alex Habibulin, http://www.mycgiscripts.com
#
# This is library file. It cannot be runned via web
#######################################################################
$DELIMITER='|';
sub init_smtp{$smtp_server=shift;use Socket;$proto = (getprotobyname('tcp'))[2];$port = getservbyname('smtp', 'tcp');$smtp_server =~ s/^\s+//g;$smtp_server =~ s/\s+$//g;$smtpaddr = ($smtp_server =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) ? pack('C4',$1,$2,$3,$4) : (gethostbyname($smtp_server))[4]; if (!$smtpaddr) {return "SMTP host not found!";}return "ok";}
sub sendmail{ my @send_to; my $answer;@send_to = @_;if ($send_to[0]) { $answer=sendmail_smail($send_to[0],@send_to[2..8]); return $answer; }if ($send_to[1]) { if (!$smtpaddr) { $answer=init_smtp($send_to[1]); if ($answer ne "ok") {return "$answer";} } $answer=sendmail_smtp(@send_to[2..8]); return $answer; }return "Error! Must be specifed one from emailing methods!";}
sub sendmail_smail{my @send_to;@send_to = @_; open (SM, "|$send_to[0] -oeq -t") or return "Error sending mail! Reason : $!";print SM "From: $send_to[3]\n"; print SM "To: $send_to[2]\n";print SM "Reply-to: $send_to[3]\n"; print SM "X-Mailer: Control panel script (http://www.mycgiscripts.com/)\n"; print SM "Subject: $send_to[5]\n\n";$send_to[6] =~ s/\r/$CRLF/g; print SM $send_to[6]; print SM "\n\n.\n"; close SM;return "ok";}
sub sendmail_smtp{my @send_to;@send_to = @_;$CRLF = "\015\012";socket(SOCK, AF_INET, SOCK_STREAM, $proto) or return "Socket operation failed : Reason $!";connect(SOCK, pack('Sna4x8', AF_INET, $port, $smtpaddr)) or return "Connection failed : Reason $!";my($oldfh) = select(SOCK); $| = 1; select($oldfh);$_ = <SOCK>; if (/^[45]/) { close SOCK; return "Service not available : Reason $!"; } print SOCK "helo localhost$CRLF"; $_ = <SOCK>; if (/^[45]/) { close SOCK; return "Communication error : Reason $!"; } print SOCK "mail from: <", $send_to[2], ">$CRLF"; $_ = <SOCK>; if (/^[45]/) { close SOCK; return "Communication error : Reason $!"; } foreach (split(/,/, $send_to[1])) {(/<(.*)>/) ? print SOCK "rcpt to: $1$CRLF" : print SOCK "rcpt to: <$_>$CRLF"; $_ = <SOCK>; if (/^[45]/) { close SOCK;return "Unknown user. Email address not valid"; } }print SOCK "data$CRLF";$_ = <SOCK>; if (/^[45]/) { close SOCK; return "Communication error : Reason $!"; }print SOCK "To: $send_to[0] <$send_to[1]>", $CRLF;print SOCK "From: $send_to[2]",$CRLF;print SOCK "Reply-to: $send_to[3]",$CRLF;print SOCK "Content-Type: text/plain; charset=us-ascii\n";print SOCK "X-Mailer: Control panel script (http://www.mycgiscripts.com/)$CRLF";print SOCK "Content-Type: text/html\n" if ($send_to[6]);print SOCK "Subject: $send_to[4]",$CRLF,$CRLF;
$send_to[5] =~ s/\r/$CRLF/g;print SOCK $send_to[5];print SOCK $CRLF, '.', $CRLF;$_ = <SOCK>; if (/^[45]/) { close SOCK;return "Transfer failed : Reason $!"; }print SOCK "quit", $CRLF;$_ = <SOCK>;close SOCK;return"ok";}
sub parse{my (@pairs, %in);my (@pairs, %in);my ($buffer, $pair, $name, $value);if ($ENV{'REQUEST_METHOD'} eq 'GET') {@pairs = split(/&/, $ENV{'QUERY_STRING'});}elsif($ENV{'REQUEST_METHOD'} eq 'POST') {read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});@pairs = split(/&/, $buffer);}PAIR: foreach $pair (@pairs) {($name, $value) = split(/=/, $pair);$name =~ tr/+/ /;$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;$value =~ tr/+/ /;$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;($value eq "---") and next PAIR;exists $in{$name} ? ($in{$name} .= "~~$value") : ($in{$name} = $value);}return %in;}
sub checkemail{$te=shift;if ($te =~ /.+@.+\..+/) {return $te;}else{return "";}}
sub show{my $text;$text = shift;$logo = qq~<p align=center><font face="Verdana" size="2">Powered by <a href="http://www.mycgiscripts.com/">mycgiscripts.com</a></font></p></html>~;if ($text !~ /mycgiscripts\.com/i) { if ($text !~ /\<\/HTML\>/i || $text !~ /\<\/html\>/i) {$text.=$logo;}else{$text =~ s/<\/html>/$logo/;}}return $text;}
sub error{$mes=shift;&html_print_headers;print qq~<html><font face="Verdana" size="2"><center><b>Error</b> : $mes<br><br><a href="javascript:history.go(-1)">Back</a>.<br><br><br><small>(c)-2001 <a href="http://www.mycgiscripts.com">www.mycgiscripts.com</a>~;exit;}
sub load_template{my ($filename,$text,%values,$name,$value);$filename=shift;$name=shift;%values=%$name;$text="";open(IN,"<$templates/$filename") or error("Cannot open $templates/$filename : Reason $!");while(<IN>){chomp;$text.=$_;}close IN;while($text =~ m/\<\%(.*?)\%\>/gsi) {$name=$1;if (exists($values{$name})) {$value=$values{$name};}else{$value="";}$text =~ s/<\%$name\%>/$value/g;}return $text;}
sub fromw{ my ($temp);$temp=shift;$temp =~ s/\n/``/g;$temp =~ s/\r//g;return $temp;}
sub unixdate { my $time = shift; my ($sec, $min, $hour, $day, $mon, $year, $dweek, $dyear, $tz) = localtime $time; my @months = qw!Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec!; $year = $year + 1900; return "$day-$months[$mon]-$year";}
sub tow{ my ($temp);$temp=shift;$temp =~ s/``/\n/g;return $temp;}
sub html_print_headers{if ($html_headers_printed) {return;}print "Content-type: text/html \n\n";$html_headers_printed++;return;}
sub split_decode { my ($input) = shift; my (@array) = split (/\Q\|\E/o, $input ); foreach (@array) { s/~~/\|/g; s/``/\n/g; } return @array;}
sub adminloginform{
&html_print_headers;
print qq~
<html><head>
<title>Links control panel</title>
</head>
<body bgcolor="#DDDDDD">
<p align="center"><b><font size="2" face="Verdana">Control Panel admin </font></b></p>
<p align="center"><b><font size="2" face="Verdana">Please login:</font></b></p>
<center>
<table border="0" width="30%">
<form method="post" action="admin.pl">
$hidden
<tr>
<td width="30%"><font size="2" face="Verdana">Login</font></td>
<td width="70%"><input type="text" name="login" size="20"></td>
</tr>
<tr>
<td width="30%"><font size="2" face="Verdana">Password</font></td>
<td width="70%"><input type="password" name="password" size="20"></td>
</tr>
<tr>
<td width="30%"></td>
<td width="70%"><input type="submit" value="Login" name="B1"></td>
</tr>
</form>
</table>
</center>
<p align="center"><font size="1" face="Verdana"><b>(c)-2001, Control panel by <a href="http://www.mycgiscripts.com/">MyCgiScripts.com</a></b></font></p>
</body>
</html>
~;
}
sub showframes{
&html_print_headers;
print qq~
<html>
<head>
<title>Control panel admin</title>
</head>
<frameset cols="150,*" frameborder="0">
<frame name="contents" target="main" src="admin.pl?action=showleft">
<frame name="main" src="admin.pl?action=users">
<noframes>
<body>
<p>This page uses frames, but your browser doesn't support them.</p>
Click here to visit <a href="http://www.mycgiscripts.com">MyCGiScripts.com</a>!
</body>
</noframes>
</frameset>
</html>
~;
}
sub showadminleft{
#Navigation frame. List of supported features in this version of script
&html_print_headers;
print qq~
<base target="main">
<html><body bgcolor="#DDDDDD">
<font face="Verdana" size="2">
<p><b>Control panel</b></p>
<p><b>Accounts</b><br>
<a href="admin.pl?action=adduser">Add user</a><br>
<a href="admin.pl?action=users">Users</a>
</p>
<p><b>Files</b><br>
<a href="admin.pl?action=urls">Files List</a><br>
</p>
<p><b>Mailing</b><br>
<a href="admin.pl?action=mailing">Emailing</a><br>
</p>
<p><b>Tools</b><br>
<a href="admin.pl?action=defaults">Default user files</a><br>
<a href="admin.pl?action=backup">Backup</a><br>
<a href="admin.pl?action=logout">LogOut</a>
</p>
</font>
<font face="Verdana" size="1">(c)-2001, <a href="http://www.mycgiscripts.com">mycgiscripts.com</a></form>
</html>
~;
}
sub process{
#You can add some functions here. Example of calling :
# control.pl?action=something. It will be send to this routine
$action=shift;
if ($action eq 'newcounter') {&newcounter;}
exit;
}
#TEMPLATES definition
sub show_control_panel_login_form{
&html_print_headers;
print &load_template ('user_login.html', {
%in,
%globals
});
}
sub show_control_panel_signup_form{
$msg=shift;
&html_print_headers;
print &load_template ('signup_form.html', {
msg => $msg,
%in,
%globals
});
}
sub show_control_panel_lostpassword{
&html_print_headers;
print &load_template ('lostpassword.html', {
%in,
%globals
});
}
sub show_control_panel_lostpassword_status{
$msg=shift;
&html_print_headers;
print &load_template ('lostpassword-status.html', {
msg => $msg,
%in,
%globals
});
}
sub show_controlpanel_signup_validation{
&html_print_headers;
print &load_template ('signupok-validation.html', {
%in,
%globals
});
}
sub show_control_panel_signup_ok{
&html_print_headers;
print &load_template ('signup-success.html', {
login => $login,
pass => $password,
%in,
%globals
});
}
smtp server name is correct (is working in other scripts on the site). When configured with smpt, the script runs as if everything is ok, no error messages, but mail never arrives.
ISP is Interland. Web server is Windows NT ... mail server is Unix. Deadline is looming on this so any help is greatly appreciated. Below is a the main perl file (control.pl). Following that is the library file with the mail functions (function.pl):
CONTROL.PL:
#!/usr/bin/perl
#######################################
#
# Control Panel
#
# by Alex Habibulin, http://www.mycgiscripts.com
#
# Control panel script. Allow signup, login, lostpassword and members features
#
# Contact us for quote if you need to add instant payment mechanism here.
#
# Also this script can be manage one multiply login info for all your scripts,
# but it requied some cgi work. Contact our cgi service for this.
#
# Warning! Script is using cookies for login!
#######################################################################
eval {
($0 =~ m,(.*)/[^/]+,) && unshift (@INC, "$1"); # Get the script location: UNIX /
($0 =~ m,(.*)\\[^\\]+,) && unshift (@INC, "$1"); # Get the script location: Windows \
require "admin/config.pl";
require "admin/functions.pl";
use CGI;
};
if ($@) {
print "Content-type: text/html \n\n";
print "Error including libraries: $@\n";
print "Make sure they exist, permissions are set properly, and paths are set correctly.";
exit;
}
%in=&parse;
if ($smtp_server) {&init_smtp;};
#This operations not require login/pass
if ($craccount) {
if ($in{'signup1'}) {&signup1;exit;}
if ($in{'signup'}) {
%in=();
show_control_panel_signup_form();
exit;
}
if ($in{'validate'}) {&process_validate;exit;}
}
if ($in{'lostpassword1'}) {&process_lostpassword;exit;}
if ($in{'lostpassword'}) {&show_control_panel_lostpassword;exit;}
if ($in{'logout'}) {&process_logout;exit;}
#Check password
$ok=0;
my $AUTH = CGI->cookie('CPMember');
if ($AUTH || $in{'login'}) {
if ($in{'login'}) { ($login, $password) = ($in{'login'}, $in{'password'});
}else{
($login, $password) = split /:/, $AUTH; }
open (IN, "$db_members") or cgierr("Cannot open $db_members : Reason $!");
while (<IN>) {
chomp; $s=$_;
@d=split(/\|/,$s);
if ($login eq $d[0]) {
if ($in{'login'}) {
if ($password eq $d[1]) { $ok++; $email=$d[3];$name=$d[2]; $okmem=$s;}
}else{
if ($password eq crypt($d[1], "AA") ) {$ok++; $email=$d[3];$name=$d[2]; $okmem=$s;}
}
}
}
close IN;
if ($ok) {
if ($in{'login'}) {
print CGI->header( -cookie => CGI->cookie ( -name => 'CPMember', -value => ($login .':'. crypt($password, "AA")), path => '/' ) );
$html_headers_printed = 1;
#Log file
$tm=time(); $tm1=unixdate($tm);
open (OUT, ">>$upath/data/$d[0].log") or error("Cannot create log file! : $!");
print OUT "$tm1 ($tm) : Login from $ENV{'REMOTE_ADDR'} , Referer $in{'ref'}\n";
close OUT;
}
}
}
if (!$ok) {&html_print_headers;&show_control_panel_login_form;exit;}
if ($in{'action'} eq 'edit_details') {&edit_details;exit;}
if ($in{'dl'}) {&download;exit;}
if ($in{'show'}) {&showtemplate;exit;}
#OK. From this we can work with logged user
#His name in $login; - THIS NOT FOR ADMIN - only for members
$user=$login;
&html_print_headers;
$action = $in{'action'};
if ($action eq 'logout') {&process_logout;}
#Show all files and personal message
open (IN, "$upath/data/$login.msg");
@msg = <IN>;
close IN;
$message=join "", @msg;
#$okmem containing record about this customer
@minfo=split(/\|/,$okmem);
%mf=();
$ftotal=0;
$tot=$#minfo + 1;
for ($i=11;$i<$tot;$i+=2) {
if ($minfo[$i] eq '0') {$minfo[$i]="";}
if ($minfo[$i]) {$ftotal++;$mf{$minfo[$i]}=$minfo[$i+1];}
}
#Reading files DB;
@files=();
open (IN, "$db_files") or error("Cannot open files list! Please upload empty file to $db_files and chmod to 666 (NT - CHANGE READ WRITE)");
while(<IN>)
{
chomp;
@t=split(/\|/,$_);
push @files, $t[0],$t[1],$t[2],$t[3];
}
close IN;
$link="";
$total=$#files + 1;
for ($i=0;$i<$total;$i+=4) {
if (exists($mf{$files[$i]})) {
$regnum="";
$rg=$mf{$files[$i]};
if ($rg eq '0') {$rg="";}
if ($rg) {$regnum = "Reg number : $rg";}
$files[$i+3] =~ s/~~/\|/g;
$files[$i+3] =~ s/''/<br>\n/g;
$link.=load_template("filelink.html", {
id => $files[$i],
title => $files[$i+1],
descr => $files[$i+3],
regnum => $regnum,
url => "$cgiurl/control.pl?dl=$files[$i]"});
}
}
print load_template("control-panel.html", {
links => $link,
total => $ftotal,
message => $message,
login => $login,
email => $email,
name => $name});
exit;
sub process_logout{
use CGI;
print CGI->header( -cookie => CGI->cookie ( -name => 'CPMember', -value => '', expires => '-1s', path => '/' ) );
$html_headers_printed = 1;
print load_template("logout.html", { });
exit;
}
sub signup1{
$login=$in{'login'};
$pass=$in{'password'};
$pass1=$in{'ppassword'};
$name=$in{'name'};
$email=$in{'email'};
#We not checking address info.
$address=$in{'address'};
$province=$in{'province'};
$state=$in{'state'};
$country=$in{'country'};
$phone=$in{'phone'};
#Check all this.
&html_print_headers;
#1. to correct format of values
if (!$login) {show_control_panel_signup_form("Error: <b>login</b> cannot be empty");exit;}
if (!$pass) {show_control_panel_signup_form("Error: <b>password</b> cannot be empty");exit;}
if (!$name) {show_control_panel_signup_form("Error: <b>name</b> cannot be empty");exit;}
if ($pass ne $pass1) {show_control_panel_signup_form("Error: <b>passwords</b> not same");exit;}
if (length ($pass) <5 ) {show_control_panel_signup_form("Error: <b>password</b> must be more 5 chars");exit;}
if (length ($login) <3 ) {show_control_panel_signup_form("Error: <b>login</b> must be more 3 chars");exit;}
if ($email !~ /.+@.+\..+/) {show_control_panel_signup_form("Error: <b>email</b> not correct");exit;}
if ($login =~ /\s/is) {show_control_panel_signup_form("Error: <b>login</b> cannot contain spaces");exit;}
if ($reqaddress) {
if (!$address) {show_control_panel_signup_form("Error: <b>address</b> cannot be empty");exit;}
if (!$state) {show_control_panel_signup_form("Error: <b>state</b> cannot be empty");exit;}
if (!$country) {show_control_panel_signup_form("Error: <b>country</b> cannot be empty");exit;}
if (!$phone) {show_control_panel_signup_form("Error: <b>phone</b> cannot be empty");exit;}
}
#2. Check if login exists
open (IN, "$db_members") or error("Cannot open $db_members : Reason $!");
while (<IN>) {
chomp;
@d=split(/\|/,$_);
if ($d[0] eq $login) {close IN; &show_control_panel_signup_form("Error: <b>login - $login</b> already exists");exit;}
if ($d[3] eq $email) {close IN; &show_control_panel_signup_form("Error: <b>account for $email</b> already exists");exit;}
}
close IN;
open (IN, "$db_umembers") or error("Cannot open $db_members : Reason $!");
while (<IN>) {
chomp;
@d=split(/\|/,$_);
if ($d[0] eq $login) {close IN; &show_control_panel_signup_form("Error: <b>login - $login</b> already exists");exit;}
if ($d[3] eq $email) {close IN; &show_control_panel_signup_form("Error: <b>account for $email</b> already exists");exit;}
}
close IN;
#Generation of validate code
$tm=time();
@passch = ('a'..'z');
for ($l = 0; $l < 2; $l+=1) {
$randnum = int(rand($#passch + 1)); $salt1 .= @passch[$randnum];}
$valid=crypt("$tm$login$pass", $salt1);
#3. Ok. Adding profile and sending email
open (OUT, ">>$db_umembers") or cgierr("Cannot write to $db_members : $!");
print OUT "$login|$pass|$name|$email|$valid|$address|$province|$state|$country|$phone\n";
close OUT;
$msg_mod = &load_template("email-unc_createprofile.txt", {validate => $valid, cgi_url => $cgiurl, %in});
sendmail($sendmail,$smtpserv,"Please confirm new account creation",$email,$adminemail,$adminemail,"New account",$msg_mod,0);
&show_controlpanel_signup_validation;
exit;
}
sub process_lostpassword{
$email=$in{'lostpassword1'};
&html_print_headers;
open (IN, "$db_members") or error("Cannot open $db_members : Reason $!");
while (<IN>) {
chomp;
@d=split(/\|/,$_);
if ($d[3] eq $email) { close IN;
$msg_mod = &load_template("email-lostpassword.txt",
{name => $d[2],
validate => "",
email => $d[3],
login => $d[0],
password => $d[1]}, cgi_url => $cgiurl);
&sendmail($sendmail,$smtpserv,"Account password",$email,$adminemail,$adminemail,"Account password",$msg_mod,0);
&show_control_panel_lostpassword_status("Password is sent");exit;
}
}
close IN;
&show_control_panel_lostpassword_status("Cannot find user account with same email");
exit;
}
sub process_validate{
$num=$in{'validate'};
$ok=0;$str="";
#&html_print_headers; print "OK";
@all=();
$tm=time();
open (IN, "$db_umembers") or error("Cannot open $db_umembers : Reason $!");
while (<IN>) {
chomp;
$s=$_;
@d=split(/\|/,$s);
if ($d[4] eq $num) {$login=$d[0];$password=$d[1];$str=$s;$ok++;}else{push @all , $s;}
}
close IN;
if (!$ok) {error("Validation code is incorrect");}
#Read default files
@df=();
open (IN, "$db_def_files") or error("Cannot open default files list!");
while(<IN>) {chomp; $s=$_;
push @df, $s;}
close IN;
open (OUT, ">>$db_members") or error("Cannot write to $db_members ; $!");
print OUT "$str|$tm";
if ($#df >= 0) {print OUT "|";print OUT join "|", @df;}
print OUT "\n";
close OUT;
#Remove record with this validation code
open(OUT, ">$db_umembers") or error("Cannot open $db_umembers : Reason $!");
foreach $e (@all) {print OUT "$e\n";}
close OUT;
$tm=time(); $tm1=unixdate($tm);
open (OUT, ">>$upath/data/$login.log");
print OUT "$tm1 ($tm) : Account created & confirmed : IP $ENV{'REMOTE_ADDR'}\n";
close OUT;
&show_control_panel_signup_ok;
exit;
}
sub edit_details{
#User string - $okmem
@d=split(/\|/,$okmem);
&html_print_headers;
if ($in{'step'} eq '2') {&storedetails;exit;}
print &load_template("edit_details.html", {
loginn => $login,
pass => $d[1],
name => $d[2],
email => $d[3],
address => $d[5],
province => $d[6],
state => $d[7],
country => $d[8],
phone => $d[9]});
exit;
}
sub storedetails{
#Read members file and looking for this record.
$id=$login;
$password=$in{'pass'};
$name=$in{'name'};
$email=$in{'email'};
$address=$in{'address'};
$province=$in{'province'};
$state=$in{'state'};
$country=$in{'country'};
$phone=$in{'phone'};
foreach $bb (keys %in) {if ($in{$bb}=~ /\|/i) {error("| symbol is disabled!");}}
if (!$login) {error("Error: <b>login</b> cannot be empty");exit;}
if (length ($login) <3 ) {error("Error: <b>login</b> must be more 3 chars");exit;}
if ($login =~ /\s/is) {error("Error: <b>login</b> cannot contain spaces");exit;}
if (!$password) {error("Error: <b>password</b> cannot be empty");exit;}
if (!$name) {error("Error: <b>name</b> cannot be empty");exit;}
if (length ($password) <5 ) {error("Error: <b>password</b> must be more 5 chars");exit;}
if ($email !~ /.+@.+\..+/) {error("Error: <b>email</b> not correct");exit;}
if ($reqaddress) {
if (!$address) {error("Error: <b>address</b> cannot be empty");exit;}
if (!$state) {error("Error: <b>state</b> cannot be empty");exit;}
if (!$country) {error("Error: <b>country</b> cannot be empty");exit;}
if (!$phone) {error("Error: <b>phone</b> cannot be empty");exit;}
}
@d=split(/\|/,$okmem);
$tm=time();
$d[1]=$password;$d[2]=$name;$d[3]=$email;$d[4]="USER_CHANGED";
$d[5]=$address;$d[6]=$province;$d[7]=$state;$d[8]=$country;$d[9]=$phone;
$rec=join "|", @d; @db=();
open (IN, "$db_members") or error("Cannot open $db_members : Reason $!");
while (<IN>) {
chomp;$s=$_;
@d=split(/\|/,$s);
if ($d[0] ne $login) {push @db,$s;}
}
close IN;
open (OUT,">$db_members") or error("Cannot modify - Error : $!");
if ($db_use_flock) { flock (OUT, 2) or error ("unable to get exclusive lock. Reason: $!"); }
print OUT "$rec\n";
foreach $x (@db) {print OUT "$x\n";}
close OUT;
$tm=time(); $tm1=unixdate($tm);
open (OUT, ">>$upath/data/$login.log");
print OUT "$tm1 ($tm) : User $login : $ENV{'REMOTE_ADDR'} MODIFED account info.\n";
close OUT;
&html_print_headers;
print &load_template("account_modifed.html", {%in});
exit;
}
sub download{
#Script retrive via libwww binary file, and send it back to customer if defined
#or if low level of security specifed - simply redirect to it.
$tm=time(); $tm1=unixdate($tm);
#Checking for permission for this user download this file.
#$memok
@d=split(/\|/,$okmem);
$fid=$in{'dl'};
if (!$fid) {error("You cannot download this file : id not specifed");}
$tot=$#d + 1; $ok=0;
for ($i=11;$i<$tot;$i+=2) {
if ($d[$i] eq '0') {$d[$i]="";}
if ($d[$i] eq $fid) {$ok++;}
}
if (!$ok) {error("You cannot download this file!");}
#Ok. Looking files db for real file location
$furl="";
open (IN, "$db_files") or error("Cannot open files list! Please upload empty file to $db_files and chmod to 666 (NT - CHANGE READ WRITE)");
while(<IN>)
{
chomp;
@t=split(/\|/,$_);
if ($t[0] eq $fid) {$url=$t[2];$ft=$t[1];last;}
}
close IN;
#Ok. Return results for user (antileech)
if (!$antileech) {
open (OUT, ">>$upath/data/$login.log");
print OUT "$tm1 ($tm) : User from IP $ENV{'REMOTE_ADDR'} downloaded file $ft\n";
close OUT;
print "Location: $url \n\n";exit;}
#If high level - retrive file, generating of headers and send it to user.
$file=fetch($url);
if (!$file) {error("Network troubles with file access. Try later please!");}
#Content type.
#If you need add other type - call us or check http://www.oac.uci.edu/indiv/ehood/MIME/MIME.html
SWITCH:
{
$content_type = "audio/mpeg" and last if $url =~ /\.mp3$/i;
$content_type = "image/jpeg" and last if $url =~ /\.jpeg$/i;
$content_type = "image/jpeg" and last if $url =~ /\.jpg$/i;
$content_type = "image/gif" and last if $url =~ /\.gif$/i;
$content_type = "text/html" and last if $url =~ /\.html$/i;
$content_type = "text/html" and last if $url =~ /\.shtml$/i;
$content_type = "text/html" and last if $url =~ /\.shtm$/i;
$content_type = "application/pdf" and last if $url =~ /\.pdf$/i;
$content_type = "text/html" and last if $url =~ /\shtm$/i;
$content_type = "text/plain" and last if $url =~ /\.txt$/i;
$content_type = "application/x-zip-compressed" and last if $url =~ /\.zip$/i;
}
if (!$content_type) { $content_type = "application/x-msdownload"; }
#Determine file name! Must be filename with extension!!!!
@t=split(/\//,$url);
$tt=$#t; $filename=$t[$tt];
#Bad - MSIE not support filenames, and only parse it from URL
#http://msdn.microsoft.com/workshop/networking/moniker/overview/appendix_a.asp
#print "Content-type: $content_type; filename=$filename\n\n";
print "Content-type: $content_type\n\n";
print $file;
open (OUT, ">>$upath/data/$login.log");
print OUT "$tm1 ($tm) : IP $ENV{'REMOTE_ADDR'} downloaded file $ft\n";
close OUT;
exit;
}
sub fetch
{
my ($url) = @_;
my $page_returned = "";
eval{ require LWP::UserAgent; };
$ua = new LWP::UserAgent;
$ua->timeout(600);
$ua->agent('Mozilla/4.0');
my $req = new HTTP::Request GET => "$url";
my $res = $ua->request($req);
if ($res->is_success) { $page_returned = $res->content; }
return $page_returned;
}
sub showtemplate{
$file=$in{'show'};
$file =~ s/\///g;
$file =~ s/\\//g;
$file =~ s/\>//g;
$file =~ s/\<//g;
$file =~ s/\s//g;
@d=split(/\|/,$okmem);
&html_print_headers;
print &load_template($file, {
login => $login,
pass => $d[1],
name => $d[2],
email => $d[3],
address => $d[5],
city => $d[6],
state => $d[7],
country => $d[8],
phone => $d[9]});
exit;
}
-----------------------------------------------
FUNCTIONS.PL:
#######################################
#
# Remote suite
#
# by Alex Habibulin, http://www.mycgiscripts.com
#
# This is library file. It cannot be runned via web
#######################################################################
$DELIMITER='|';
sub init_smtp{$smtp_server=shift;use Socket;$proto = (getprotobyname('tcp'))[2];$port = getservbyname('smtp', 'tcp');$smtp_server =~ s/^\s+//g;$smtp_server =~ s/\s+$//g;$smtpaddr = ($smtp_server =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) ? pack('C4',$1,$2,$3,$4) : (gethostbyname($smtp_server))[4]; if (!$smtpaddr) {return "SMTP host not found!";}return "ok";}
sub sendmail{ my @send_to; my $answer;@send_to = @_;if ($send_to[0]) { $answer=sendmail_smail($send_to[0],@send_to[2..8]); return $answer; }if ($send_to[1]) { if (!$smtpaddr) { $answer=init_smtp($send_to[1]); if ($answer ne "ok") {return "$answer";} } $answer=sendmail_smtp(@send_to[2..8]); return $answer; }return "Error! Must be specifed one from emailing methods!";}
sub sendmail_smail{my @send_to;@send_to = @_; open (SM, "|$send_to[0] -oeq -t") or return "Error sending mail! Reason : $!";print SM "From: $send_to[3]\n"; print SM "To: $send_to[2]\n";print SM "Reply-to: $send_to[3]\n"; print SM "X-Mailer: Control panel script (http://www.mycgiscripts.com/)\n"; print SM "Subject: $send_to[5]\n\n";$send_to[6] =~ s/\r/$CRLF/g; print SM $send_to[6]; print SM "\n\n.\n"; close SM;return "ok";}
sub sendmail_smtp{my @send_to;@send_to = @_;$CRLF = "\015\012";socket(SOCK, AF_INET, SOCK_STREAM, $proto) or return "Socket operation failed : Reason $!";connect(SOCK, pack('Sna4x8', AF_INET, $port, $smtpaddr)) or return "Connection failed : Reason $!";my($oldfh) = select(SOCK); $| = 1; select($oldfh);$_ = <SOCK>; if (/^[45]/) { close SOCK; return "Service not available : Reason $!"; } print SOCK "helo localhost$CRLF"; $_ = <SOCK>; if (/^[45]/) { close SOCK; return "Communication error : Reason $!"; } print SOCK "mail from: <", $send_to[2], ">$CRLF"; $_ = <SOCK>; if (/^[45]/) { close SOCK; return "Communication error : Reason $!"; } foreach (split(/,/, $send_to[1])) {(/<(.*)>/) ? print SOCK "rcpt to: $1$CRLF" : print SOCK "rcpt to: <$_>$CRLF"; $_ = <SOCK>; if (/^[45]/) { close SOCK;return "Unknown user. Email address not valid"; } }print SOCK "data$CRLF";$_ = <SOCK>; if (/^[45]/) { close SOCK; return "Communication error : Reason $!"; }print SOCK "To: $send_to[0] <$send_to[1]>", $CRLF;print SOCK "From: $send_to[2]",$CRLF;print SOCK "Reply-to: $send_to[3]",$CRLF;print SOCK "Content-Type: text/plain; charset=us-ascii\n";print SOCK "X-Mailer: Control panel script (http://www.mycgiscripts.com/)$CRLF";print SOCK "Content-Type: text/html\n" if ($send_to[6]);print SOCK "Subject: $send_to[4]",$CRLF,$CRLF;
$send_to[5] =~ s/\r/$CRLF/g;print SOCK $send_to[5];print SOCK $CRLF, '.', $CRLF;$_ = <SOCK>; if (/^[45]/) { close SOCK;return "Transfer failed : Reason $!"; }print SOCK "quit", $CRLF;$_ = <SOCK>;close SOCK;return"ok";}
sub parse{my (@pairs, %in);my (@pairs, %in);my ($buffer, $pair, $name, $value);if ($ENV{'REQUEST_METHOD'} eq 'GET') {@pairs = split(/&/, $ENV{'QUERY_STRING'});}elsif($ENV{'REQUEST_METHOD'} eq 'POST') {read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});@pairs = split(/&/, $buffer);}PAIR: foreach $pair (@pairs) {($name, $value) = split(/=/, $pair);$name =~ tr/+/ /;$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;$value =~ tr/+/ /;$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;($value eq "---") and next PAIR;exists $in{$name} ? ($in{$name} .= "~~$value") : ($in{$name} = $value);}return %in;}
sub checkemail{$te=shift;if ($te =~ /.+@.+\..+/) {return $te;}else{return "";}}
sub show{my $text;$text = shift;$logo = qq~<p align=center><font face="Verdana" size="2">Powered by <a href="http://www.mycgiscripts.com/">mycgiscripts.com</a></font></p></html>~;if ($text !~ /mycgiscripts\.com/i) { if ($text !~ /\<\/HTML\>/i || $text !~ /\<\/html\>/i) {$text.=$logo;}else{$text =~ s/<\/html>/$logo/;}}return $text;}
sub error{$mes=shift;&html_print_headers;print qq~<html><font face="Verdana" size="2"><center><b>Error</b> : $mes<br><br><a href="javascript:history.go(-1)">Back</a>.<br><br><br><small>(c)-2001 <a href="http://www.mycgiscripts.com">www.mycgiscripts.com</a>~;exit;}
sub load_template{my ($filename,$text,%values,$name,$value);$filename=shift;$name=shift;%values=%$name;$text="";open(IN,"<$templates/$filename") or error("Cannot open $templates/$filename : Reason $!");while(<IN>){chomp;$text.=$_;}close IN;while($text =~ m/\<\%(.*?)\%\>/gsi) {$name=$1;if (exists($values{$name})) {$value=$values{$name};}else{$value="";}$text =~ s/<\%$name\%>/$value/g;}return $text;}
sub fromw{ my ($temp);$temp=shift;$temp =~ s/\n/``/g;$temp =~ s/\r//g;return $temp;}
sub unixdate { my $time = shift; my ($sec, $min, $hour, $day, $mon, $year, $dweek, $dyear, $tz) = localtime $time; my @months = qw!Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec!; $year = $year + 1900; return "$day-$months[$mon]-$year";}
sub tow{ my ($temp);$temp=shift;$temp =~ s/``/\n/g;return $temp;}
sub html_print_headers{if ($html_headers_printed) {return;}print "Content-type: text/html \n\n";$html_headers_printed++;return;}
sub split_decode { my ($input) = shift; my (@array) = split (/\Q\|\E/o, $input ); foreach (@array) { s/~~/\|/g; s/``/\n/g; } return @array;}
sub adminloginform{
&html_print_headers;
print qq~
<html><head>
<title>Links control panel</title>
</head>
<body bgcolor="#DDDDDD">
<p align="center"><b><font size="2" face="Verdana">Control Panel admin </font></b></p>
<p align="center"><b><font size="2" face="Verdana">Please login:</font></b></p>
<center>
<table border="0" width="30%">
<form method="post" action="admin.pl">
$hidden
<tr>
<td width="30%"><font size="2" face="Verdana">Login</font></td>
<td width="70%"><input type="text" name="login" size="20"></td>
</tr>
<tr>
<td width="30%"><font size="2" face="Verdana">Password</font></td>
<td width="70%"><input type="password" name="password" size="20"></td>
</tr>
<tr>
<td width="30%"></td>
<td width="70%"><input type="submit" value="Login" name="B1"></td>
</tr>
</form>
</table>
</center>
<p align="center"><font size="1" face="Verdana"><b>(c)-2001, Control panel by <a href="http://www.mycgiscripts.com/">MyCgiScripts.com</a></b></font></p>
</body>
</html>
~;
}
sub showframes{
&html_print_headers;
print qq~
<html>
<head>
<title>Control panel admin</title>
</head>
<frameset cols="150,*" frameborder="0">
<frame name="contents" target="main" src="admin.pl?action=showleft">
<frame name="main" src="admin.pl?action=users">
<noframes>
<body>
<p>This page uses frames, but your browser doesn't support them.</p>
Click here to visit <a href="http://www.mycgiscripts.com">MyCGiScripts.com</a>!
</body>
</noframes>
</frameset>
</html>
~;
}
sub showadminleft{
#Navigation frame. List of supported features in this version of script
&html_print_headers;
print qq~
<base target="main">
<html><body bgcolor="#DDDDDD">
<font face="Verdana" size="2">
<p><b>Control panel</b></p>
<p><b>Accounts</b><br>
<a href="admin.pl?action=adduser">Add user</a><br>
<a href="admin.pl?action=users">Users</a>
</p>
<p><b>Files</b><br>
<a href="admin.pl?action=urls">Files List</a><br>
</p>
<p><b>Mailing</b><br>
<a href="admin.pl?action=mailing">Emailing</a><br>
</p>
<p><b>Tools</b><br>
<a href="admin.pl?action=defaults">Default user files</a><br>
<a href="admin.pl?action=backup">Backup</a><br>
<a href="admin.pl?action=logout">LogOut</a>
</p>
</font>
<font face="Verdana" size="1">(c)-2001, <a href="http://www.mycgiscripts.com">mycgiscripts.com</a></form>
</html>
~;
}
sub process{
#You can add some functions here. Example of calling :
# control.pl?action=something. It will be send to this routine
$action=shift;
if ($action eq 'newcounter') {&newcounter;}
exit;
}
#TEMPLATES definition
sub show_control_panel_login_form{
&html_print_headers;
print &load_template ('user_login.html', {
%in,
%globals
});
}
sub show_control_panel_signup_form{
$msg=shift;
&html_print_headers;
print &load_template ('signup_form.html', {
msg => $msg,
%in,
%globals
});
}
sub show_control_panel_lostpassword{
&html_print_headers;
print &load_template ('lostpassword.html', {
%in,
%globals
});
}
sub show_control_panel_lostpassword_status{
$msg=shift;
&html_print_headers;
print &load_template ('lostpassword-status.html', {
msg => $msg,
%in,
%globals
});
}
sub show_controlpanel_signup_validation{
&html_print_headers;
print &load_template ('signupok-validation.html', {
%in,
%globals
});
}
sub show_control_panel_signup_ok{
&html_print_headers;
print &load_template ('signup-success.html', {
login => $login,
pass => $password,
%in,
%globals
});
}