| 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/baberankings.com.bak/cgi-bin/ |
Upload File : |
#
################################################################################
# #
# File : PBM Main Subroutines #
# Description : Contains All The Main Subroutines Used By Our Applications #
# Version : 1.02 #
# Created : 22nd September 1998 by Steve #
# Last Updated : 4th October 1998 #
# #
# Copyright (c) 1998 Purely By Magic. All rights reserved. #
# WWW : http://www.geocites.com/purelybymagic/ #
# Email : purelybymagic@yahoo.co.uk #
# #
################################################################################
# #
# Version History #
# #
# 22/09/98 : 1.00 : Script Created : steve #
# 30/09/98 : 1.01 : Added GetIpKey Function : steve #
# 04/10/98 : 1.02 : If Password File Does Not Exist Default To 'PBM' : steve #
# #
################################################################################
# #
# Conditions for use of this application #
# #
# This application is free software and can be redistributed and/or modified #
# if the following conditions are met: #
# #
# a) This copyright notice and the header are neither modified or removed #
# b) The application is not sold to a third party #
# c) The application is not used for financial gain #
# #
# This application is distributed in the hope that it will be useful #
# but without any warranty. The use of this application removes any liability #
# from Purely By Magic and it's employees, that may arise from the #
# installation, implementation, modification and/or its use. #
# #
################################################################################
################################################################################
#
# Subroutine Used To Send Out The HTML Header
#
sub InitializeHtml
{
# Print Out The HTML Header
print "Content-Type: text/html\n\n";
}
#
################################################################################
#
# Subroutine Used To Send Out The GIF Header
#
sub InitializeGif
{
# Print Out The GIF Header
print "Content-Type: image/gif\n\n";
}
#
################################################################################
#
# Subroutine Used To Send Out The JPG Header
#
sub InitializeJpg
{
# Print Out The GIF Header
print "Content-Type: image/jpg\n\n";
}
#
################################################################################
#
# Subroutine Used To Show The List Of Errors And Exit
#
sub ShowErrors
{
# Write Out The Error Information
print "<HTML>\n";
print "<HEAD><TITLE>Application Has Failed</TITLE></HEAD>\n";
print "<BODY>\n";
print "<H2>The Application Has Failed</H2>\n";
print "The Application Failed For The Following Reasons : <BR><BR>\n";
print "<I>\n";
print "$error_string<BR>";
print "</I>\n";
print "Please contact the Webmaster for this site for assistance\n";
print "</BODY>\n";
print "</HTML>\n";
# Leave The Application
exit;
}
#
################################################################################
#
# Subroutine Used To Add An Error String To The List Of Errors
#
sub AddError
{
# Get The Error String Off The Stack
my ($current_error) = @_;
# Add The String To The List Of Errors And Set The Error Flag
$error_string = "$error_string$current_error<BR>\n";
$data_error = 1;
}
#
################################################################################
#
# Subroutine Used To Handle File Errors
#
sub FileError
{
# Get The File Name Off The Stack
my ($error_file) = @_;
# Print The Error
print "<HTML>\n";
print "<HEAD><TITLE>File Error</TITLE></HEAD>\n";
print "<BODY>\n";
print "There was an error when trying to access the file : $error_file<BR>\n";
print "Please contact the Webmaster for this site for assistance\n";
print "</BODY>\n";
print "</HTML>\n";
# Leave The Script
exit;
}
#
################################################################################
#
# Subroutine Used To Parse And Decode The Input Data From A Form Or From
# The Script Command Line And Plug Any Security Holes That May Arise
#
sub GetInputData
{
# Declare The Local Variables
my(@pairs, $buffer, $request_type);
# Get The Request Type From The Appropriate Environment Variable
$request_type = $ENV{'REQUEST_METHOD'};
# If We Are Reading The Data From A Form
if($request_type eq 'POST')
{
# Then Read In The Form Data And Split It Into Pairs
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
}
# And If We Are Reading From The Command Line
elsif($request_type eq 'GET')
{
# Then Read In The Command Line And Split It Into Pairs
@pairs = split(/&/, $ENV{'QUERY_STRING'});
}
# Otherwise Their Is An Error
else
{
# So Tell The User About The Problem
AddError("The Form Request Method Has Not Been Configured Correctly");
&ShowErrors();
}
# Process Each Pair
foreach $pair (@pairs)
{
# Split The Pair Into Name And Value
my ($name, $value) = split(/=/, $pair);
# Convert The Name To Uppercase
$name = uc($name);
# Ignore The Submit Button
if($name eq "SUBMIT") { next; }
# Remove Plus Signs And Decode %-Encoding In Parameter Name
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Remove Plus Signs And Decode %-Encoding In Parameter Value
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Remove Any Possible System Shell Commands Or SSI's Etc.
$name =~ s/~!/ ~!/g;
$name =~ s/<!--(.|\n)*-->//g;
$value =~ s/~!/ ~!/g;
$value =~ s/<!--(.|\n)*-->//g;
# Check If The Current Field Is A Configutation Field
if(defined($config_fields{$name}) && !$demo)
{
# If So Then Store The Configuration Value
$CONFIG{$name} = $value;
}
else
{
# Else Store The Input Value
$INPUT{$name} = $value;
# And Store The Field Order
push(@field_order, $name);
}
}
}
#
################################################################################
#
# Subroutine Used To Get The Host Address Of The User If Available
# Else Get The IP Address Of The User
#
sub GetHostAddress
{
# If We Have A Blank Host Address Then Set It To The IP Address
if(length($ENV{'REMOTE_HOST'}) le 0)
{
$ENV{'REMOTE_HOST'} = $ENV{'REMOTE_ADDR'};
}
# Check To See If We Only Have A Valid IP Address
if (($ENV{'REMOTE_HOST'} eq $ENV{'REMOTE_ADDR'}) &&
($ENV{'REMOTE_ADDR'} =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/))
{
# If So Then Pack It
my $ip_address = pack('C4', $1, $2, $3, $4);
# And Try And Get The Hostaddress
my $res_address = (gethostbyaddr($ip_address, 2))[0];
# If We Got A Resolved Hostaddress Then Return That
$ENV{'REMOTE_HOST'} = $res_address if $res_address;
}
# Now Return The Address String
return $ENV{'REMOTE_HOST'};
}
#
################################################################################
#
# Subroutine Used To Get A User Unique Key Based On Their IP Address
#
sub GetIpKey
{
# Get The User's IP Address
my $ip_address = $ENV{'REMOTE_ADDR'};
# Strip Out The Full Stops
$ip_address =~ tr/\./_/;
# Return This Key
return $ip_address;
}
#
################################################################################
#
# Subroutine Used To Redirect User To A Link
#
sub RedirectUser
{
# Get The New URL
my ($new_url) = @_;
# Redirect To Link
print "Location: $new_url\n\n";
}
#
################################################################################
#
# Subroutine Used To Encode A Password Using A Simple One Way Encryption Method
# And Compare The Checksum With That Stored In The Password File
#
sub CheckPassword
{
# Initialize The Password File Flag And Checksum Variable
my $no_password = 0;
my $checksum = 0;
# Get The Password String
my ($supplied_password) = @_;
# Get The Checksum Of This Password
my $user_checksum = EncryptPassword($supplied_password);
# Open The Password File
open(PASSWORD, "<$password_file") || $no_password++;
# Check To See If We Found A Password File
if(!$no_password)
{
# If So Then Read In The Stored Checksum Value
$checksum = <PASSWORD>;
}
else
{
# And If Not Assume The Default Password
$checksum = 49849;
}
# Remove Any Newline Characters
chomp($checksum);
# Close The Password File
close(PASSWORD);
# If Checksum Is Correct Return 0 Else Return 1
if($checksum eq $user_checksum) { return $checksum; } else { return 0; }
}
#
################################################################################
#
# Subroutine Used Generate A Password Checksum
#
sub EncryptPassword
{
# Get The Password String
my ($password_string) = @_;
# Initialize The Checksum And Counter
my $user_checksum = 1;
my $counter = 0;
# Parse Each Character In The String
for( ; $counter < length($password_string); $counter++ )
{
# Get A Character From The String
my $character = substr($password_string, $counter, 1);
# Recalculate Checksum Using Character
$user_checksum = ($user_checksum * ord($character)) / ($counter + 2);
}
# Round Down The Checksum Value
$user_checksum = int($user_checksum);
# Return The Checksum Value
return $user_checksum;
}
################################################################################
#
# Subroutine Used Check And Store A New Password
#
sub StoreNewPassword
{
# Call The Edit Record Routine With Appropriate Data
if(length($INPUT{'NEW_PASSWORD_1'}) le 0) { return 0; }
if($INPUT{'NEW_PASSWORD_1'} ne $INPUT{'NEW_PASSWORD_2'}) { return 0; }
# Get The Checksum Of This Password
my $new_checksum = EncryptPassword($INPUT{'NEW_PASSWORD_1'});
# Open The Password File
open(PASSWORD, ">$password_file") || FileError($password_file);
# Write Out The New Checksum Value
print PASSWORD "$new_checksum\n";
# Close The Password File
close(PASSWORD);
# Setup The Password Field
$INPUT{'PASSWORD'} = $INPUT{'NEW_PASSWORD_1'};
}
#
################################################################################
################################################################################
# Stop The 'require' Complaining
1;