scorpion975
IS-IT--Management
These scripts have several they work off of, i want to modify them so i can make an input on my admin page when adding users, and set a time to expire by hours, so it would have to be tracked, whats the best way?
<b>Login.Cgi</b>
#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
require "common.cgi";
require "cookie.lib";
&get_input;
&get_template;
&GetCookies('Custom-CGI_pass','Custom-CGI_id');
if ($Cookies{'Custom-CGI_pass'} ne "" && $Cookies{'Custom-CGI_id'} ne "") {
print "Location: main.cgi\n\n";
exit;
}
else {
if ($in{'action'} eq "") {
&login_screen;
exit;
}
if ($in{'action'} eq "login") {
&check_login;
}
if ($in{'action'} eq "logout") {
&loggout;
}
}
######### Login Screen ########
sub login_screen {
# just a simply login screen
print "Content-type: text/html\n\n";
print "<img src=\"/new13.jpg\">\n";
print "$header\n";
print "<h1><TITLE>I CENTER</TITLE><body bgcolor=E2DEB8> Training Login\n";
print "$header\n";
print "<h4>Please make sure your system is <a href=\"/config.html\" TARGET=\"Main\">configured correctly</a> before signing in.</h4>\n";
print "$newheader\n";
print "<h4><a href=\"/email.html\" TARGET=\"Main\">Forgot your password?</a></h4>\n";
print "<h4>Please login with your username and password.\n";
# this checks if cookies have been set.
if ($in{'cookies'} eq "turned_off") {
print "<b><font color=\"#FF0000\">Error:</font></b> Cookies seem to be disabled. You cannot login until, \n";
print "these are turned on.\n";
}
print "<form action=\"$ENV{'SCRIPT_NAME'}\" method=\"POST\">\n";
print " <table border=\"0\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#E2DEB8\" width=\"400\"> \n";
print " <tr> \n";
print " <td> \n";
print " <table cellpadding=8 border=0 width=\"100%\">\n";
print " <tr><td bgcolor=\"#E2DEB8\">\n";
print " <table cellpadding=8 border=1 width=\"100%\">\n";
print " <tr><td >\n";
print " User Name: \n";
print " </td><td>\n";
print " <input type=text name=my_user size=28 value=\"\">\n";
print " </td></tr>\n";
print " <tr bgcolor=\"#E2DEB8\"><td>\n";
print " Password:\n";
print " </td><td>\n";
print " <input type=password name=my_pass size=28>\n";
print " </td></tr>\n";
print " </table>\n";
print " </td></tr>\n";
print " <tr><td bgcolor=\"#E2DEB8\">\n";
print " <input type=hidden name=action value=login>\n";
print " <input type=submit value=\"Submit Login\">\n";
print " <input type=\"reset\" value=\"Reset\">\n";
print " </td></tr>\n";
print " </table>\n";
print " </td></tr>\n";
print " </table>\n";
print ' </form>';
print $footer;
}
######### check Login #######
sub check_login {
# make sure no 'bad' characters where submitted (this includes white space)
if ($in{'my_user'} =~ s/[^a-z0-9\_]//g || $in{'my_user'} eq "") {
$error = "<li> Invalid character in username.\n";
}
if ($in{'my_pass'} =~ s/[^a-z0-9\_]//g) {
$error .= "<li> Invalid character in password.\n";
}
# if $error has a value, then they submited bad characters which could
# be a security risk if used further.
if ($error eq "") {
if (-e "$setup_base_dir/members.txt") {
open(CF, "$setup_base_dir/members.txt");
# get all th info in the file
@all = <CF>;
close(CF);
# loop for number of elements
for($i = 0; $i <= @all; $i++){
# split (explode) each line
($mem_name,$mem_password,$mem__encrypted_password,$mem_email) = split(':',$all[$i]);
# check to see if submited info matches existing info
if ($in{'my_user'} eq $mem_name && $in{'my_pass'} eq $mem_password) {
# found, the visitor identiy is verified.
$found = 1;
# inside a loop so have to store info in another var.
$c1 = $mem_name;
$c2 = $mem__encrypted_password;
}
}
} else {
# if members.txt doesnt exist.
print "Content-type: text/html\n\n";
print "<body bgcolor=\"#E2DEB8\">\n";
print "Error: Unable to open members file";
exit;
}
}
# this is what happens if user is not found
if ($found ne 1){
$error .= "<li> No such username / password combination.\n";
}
# if erros ocured then tell visitor
if ($error) {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Error</h1>\n";
print "Error(s) ocured while loggin you in, please go back and fix there error(s),\n";
print "<p><table width=\"300\"><tr><td>$error</td></tr></table><P>\n";
print "<a href=\"javascript:history.go(-1)\"><< Back</a>\n";
print $footer;
exit;
} else {
# now print out the cookies
# setcookie ('cookie_name','Cookie_value')
&SetCookies('Custom-CGI_id',$c1);
&SetCookies('Custom-CGI_pass',$c2);
# send out last header
print "Location: login.cgi?cookies=turned_off\n\n";
exit;
}
}
<b>main.cgi</b>
#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
require "cookie.lib";
&GetCookies('Custom-CGI_pass','Custom-CGI_id');
# check to see if cookies are present
if ($Cookies{'Custom-CGI_pass'} eq "" || $Cookies{'Custom-CGI_id'} eq "") {
print "Location: login.cgi\n\n";
exit;
}
&get_input;
# this is the menu
if ($in{'action'} eq "") {
&mainpage;
exit;
}
if ($in{'action'} eq "logout") {
&loggout;
}
else {
&mainpage;
exit;
}
##############
# End Menu selection!
##############
# if everything is a ok, then print logged in page
sub mainpage {
open (FILE,"main.txt");
$mainpage = '';
while (<FILE>)
{
$mainpage .= $_;
}
close (FILE);
print "Content-type: text/html\n\n";
print "<!-- Thank you for signing up for a Course. -->\n";
print "<!-- We hope you come back and take more courses online. -->\n";
print $mainpage;
}
####### this is the log out section
sub loggout {
# this is a simple operation, to delete cookies (ie. loggout member)
# all you hav to do is set the cookies to a bull ("") value.
&SetCookies('Custom-CGI_id',"");
&SetCookies('Custom-CGI_pass',"");
&get_template;
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Logged Out</h1>\n";
print "You have been successfully logged out, you can log back in by clicking \n";
print "<a href=\"login.cgi\">here</a>.\n";
print $footer;
exit;
}
Common.cgi
#!/usr/bin/perl
# this is the BASE PATH (Not URL) where all the scripts are located.
# there should be NO trailing slash
$setup_base_dir = '/
# this is the location of Sendmail on your server.
$setup_sendmail = "/usr/sbin/sendmail";
# this is the admin email (this is address given when users are emailed on signup
# dont forget to escape the @ (i.e. @ -> \@)
$setup_email_admin = "guest@guest.com";
# this is a list of usernames that cannot be used.
# this is case insenceitive and checks username for ANY existance of each element
# (ie. if 'admin' is banned, it will not allow, 'email_admin' because it contains admin.)
@banned_users = ('admin','support','webmaster','info');
# admin login
$admin_login = "guest";
# admin password
$admin_password = "access";
# This is the directory where the "protected" files are stored (NO trailing slash).
$base_protected_dir = "/guest";
# This is the URL of where login.cgi is (no trailing slash).
$weburl = "
<b>cookie.lib</b>
##############################################################################
# HTTP Cookie Library Version 2.1 #
# Copyright 1996 Matt Wright mattw@worldwidemart.com #
# Created 07/14/96 Last Modified 12/23/96 #
# Script Archive at: #
# Extensive Documentation found in README file.#
##############################################################################
# COPYRIGHT NOTICE #
# Copyright 1996 Matthew M. Wright. All Rights Reserved. #
# #
# HTTP Cookie Library may be used and modified free of charge by anyone so #
# long as this copyright notice and the comments above remain intact. By #
# using this code you agree to indemnify Matthew M. Wright from any #
# liability that might arise from it's use. #
# #
# Selling the code for this program without prior written consent is #
# expressly forbidden. In other words, please ask first before you try and #
# make money off of my program. #
# #
# Obtain permission before redistributing this software over the Internet or #
# in any other medium. In all cases copyright and header must remain intact.#
##############################################################################
# Define variables for this library. #
# This is an optional variable. If not defined, the cookie will expire #
# when a user's session ends. #
# Should be defined as: Wdy, DD-Mon-YYYY HH:MM:SS GMT #
$Cookie_Exp_Date = '';
# By default this will be set to the same path as the document being #
# described by the header which contains the cookie. #
$Cookie_Path = '';
# By default this will be set to the domain host name of the server #
# which generated the cookie response. #
$Cookie_Domain = '';
# This should be set to 0 if the cookie is safe to send across over #
# unsecured channels. If set to 1 the cookie will only be transferred #
# if the communications channel with the host is a secure one. Currently #
# this means that secure cookies will only be sent to HTTPS (HTTP over #
# SSL) servers. According to Netscape docs at least. #
$Secure_Cookie = '0';
# These are the characters which the HTTP Cookie Library will translate #
# to url encoded (hex characters) when it sets individual or compressed #
# cookies. The array holds the order in which these should be #
# translated (as we wouldn't want to translate spaces into pluses and #
# then pluses into the URL encoded form, but rather the other way #
# around) and the associative array holds the values to translate #
# characters into. The decoded set will reverse the process. Feel free #
# to add any other characters here, but it shouldn't be necessary. #
# This is a correction in version 2.1 which makes this library adhere #
# more to the Netscape specifications. #
@Cookie_Encode_Chars = ('\%', '\+', '\;', '\,', '\=', '\&', '\:\:', '\s');
%Cookie_Encode_Chars = ('\%', '%25',
'\+', '%2B',
'\;', '%3B',
'\,', '%2C',
'\=', '%3D',
'\&', '%26',
'\:\:', '%3A%3A',
'\s', '+');
@Cookie_Decode_Chars = ('\+', '\%3A\%3A', '\%26', '\%3D', '\%2C', '\%3B', '\%2B', '\%25');
%Cookie_Decode_Chars = ('\+', ' ',
'\%3A\%3A', '::',
'\%26', '&',
'\%3D', '=',
'\%2C', ',',
'\%3B', ';',
'\%2B', '+',
'\%25', '%');
# Done #
##############################################################################
##############################################################################
# Subroutine: &GetCookies() #
# Description: This subroutine can be called with or without arguments. If #
# arguments are specified, only cookies with names matching #
# those specified will be set in %Cookies. Otherwise, all #
# cookies sent to this script will be set in %Cookies. #
# Usage: &GetCookies([cookie_names]) #
# Variables: cookie_names - These are optional (depicted with []) and #
# specify the names of cookies you wish to set.#
# Can also be called with an array of names. #
# Ex. 'name1','name2' #
# Returns: 1 - If successful and at least one cookie is retrieved. #
# 0 - If no cookies are retrieved. #
##############################################################################
sub GetCookies {
# Localize the variables and read in the cookies they wish to have #
# returned. #
local(@ReturnCookies) = @_;
local($cookie_flag) = 0;
local($cookie,$value);
# If the HTTP_COOKIE environment variable has been set by the call to #
# this script, meaning the browser sent some cookies to us, continue. #
if ($ENV{'HTTP_COOKIE'}) {
# If specific cookies have have been requested, meaning the #
# @ReturnCookies array is not empty, proceed. #
if ($ReturnCookies[0] ne '') {
# For each cookie sent to us: #
foreach (split(/; /,$ENV{'HTTP_COOKIE'})) {
# Split the cookie name and value pairs, separated by '='. #
($cookie,$value) = split(/=/);
# Decode any URL encoding which was done when the compressed #
# cookie was set. #
foreach $char (@Cookie_Decode_Chars) {
$cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
}
# For each cookie to be returned in the @ReturnCookies array:#
foreach $ReturnCookie (@ReturnCookies) {
# If the $ReturnCookie is equal to the current cookie we #
# are analyzing, set the cookie name in the %Cookies #
# associative array equal to the cookie value and set #
# the cookie flag to a true value. #
if ($ReturnCookie eq $cookie) {
$Cookies{$cookie} = $value;
$cookie_flag = "1";
}
}
}
}
# Otherwise, if no specific cookies have been requested, obtain all #
# cookied and place them in the %Cookies associative array. #
else {
# For each cookie that was sent to us by the browser, split the #
# cookie name and value pairs and set the cookie name key in the #
# associative array %Cookies equal to the value of that cookie. #
# Also set the coxokie flag to 1, since we set some cookies. #
foreach (split(/; /,$ENV{'HTTP_COOKIE'})) {
($cookie,$value) = split(/=/);
# Decode any URL encoding which was done when the compressed #
# cookie was set. #
foreach $char (@Cookie_Decode_Chars) {
$cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
}
$Cookies{$cookie} = $value;
}
$cookie_flag = 1;
}
}
# Return the value of the $cookie_flag, true or false, to indicate #
# whether we succeded in reading in a cookie value or not. #
return $cookie_flag;
}
##############################################################################
# Subroutine: &SetCookieExpDate() #
# Description: Sets the expiration date for the cookie. #
# Usage: &SetCookieExpDate('date') #
# Variables: date - The date you wish for the cookie to expire, in the #
# format: Wdy, DD-Mon-YYYY HH:MM:SS GMT #
# Ex. 'Wed, 09-Nov-1999 00:00:00 GMT' #
# Returns: 1 - If successful and date passes regular expression check #
# for format errors and the new ExpDate is set. #
# 0 - If new ExpDate was not set. Check format of date. #
##############################################################################
sub SetCookieExpDate {
# If the date string is formatted as: Wdy, DD-Mon-YYYY HH:MM:SS GMT, set #
# the $Cookie_Exp_Date to the new value and return 1 to signal success. #
# Otherwise, return 0, as the date was not successfully changed. #
# The date can also be set null value by calling: SetCookieExpDate(''). #
if ($_[0] =~ /^\w{3}\,\s\d{2}\-\w{3}-\d{4}\s\d{2}\:\d{2}\:\d{2}\sGMT$/ ||
$_[0] eq '') {
$Cookie_Exp_Date = $_[0];
return 1;
}
else {
return 0;
}
}
##############################################################################
# Subroutine: &SetCookiePath() #
# Description: Sets the path for the cookie to be sent to. #
# Usage: &SetCookiePath('path') #
# Variables: path - The path to which this cookie should be sent. #
# Ex. '/' or '/path/to/file' #
# Returns: Nothing. #
##############################################################################
sub SetCookiePath {
# Set the new Cookie Path, assuming it is correct. No error checking is #
# done. #
$Cookie_Path = $_[0];
}
##############################################################################
# Subroutine: &SetCookieDomain() #
# Description: Sets the domain for the cookie to be sent to. You can only #
# specify a domain within the current domain. Must have 2 or #
# 3 periods, depending on type of domain. e.g., .domain.com #
# or .k12.co.us. #
# Usage: &SetCookieDomain('domain') #
# Variables: domain - The domain to set the cookie for. #
# Ex. '.host.com' #
# Returns: 1 - If successful and value of $Cookie_Domain was set. #
# 0 - If unsuccessful and value was not changed. #
##############################################################################
sub SetCookieDomain {
# Following Netscape specifications, if the domain specified is one of 7 #
# top level domains, only require it to contain two periods, and if it #
# is not, require that there be three. If the new domain passes error #
# checking, set the new domain and return a true value. Otherwise, #
# return 0. Trying to set a domain other than the current one is futile,#
# since the browser won't allow it. But if people may be accessing the #
# page from or host.xxx, you may wish to set it to .host.xxx#
# so that either host the access will have access to the cookie. #
if ($_[0] =~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i &&
$_[0] =~ /\..+\.\w{3}$/) {
$Cookie_Domain = $_[0];
return 1;
}
elsif ($_[0] !~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i &&
$_[0] =~ /\..+\..+\..+/) {
$Cookie_Domain = $_[0];
return 1;
}
else {
return 0;
}
}
##############################################################################
# Subroutine: &SetSecureCookie() #
# Description: This subroutine will set the cookie to be either secure, #
# meaning the cookie will only be passed over a secure HTTP #
# channel, or unsecure, meaning it is safe to pass unsecured. #
# Usage: &SetSecureCookie('flag') #
# Variables: flag - 0 or 1 depending whether you want it secure or not #
# secure. By default, it is set to unsecure, unless #
# $Secure_Cookie was changed at the top. #
# Ex. 1 #
# Returns: 1 - If successful and value of $Secure_Cookie was set. #
# 0 - If unsuccessful and value was not changed. #
##############################################################################
sub SetSecureCookie {
# If the value passed to this script is a 1 or 0, set $Secure_Cookie #
# accordingly and return a true value. Otherwise, return a false value. #
if ($_[0] =~ /^[01]$/) {
$Secure_Cookie = $_[0];
return 1;
}
else {
return 0;
}
}
##############################################################################
# Subroutine: &SetCookies() #
# Description: Sets one or more cookies by printing out the Set-Cookie #
# HTTP header to the browser, based on cookie information #
# passed to subroutine. #
# Usage: &SetCookies(name1,value1,...namen,valuen) #
# Variables: name - Name of the cookie to be set. #
# Ex. 'count' #
# value - Value of the cookie to be set. #
# Ex. '3' #
# n - This is tacked on to the last of the name and value #
# pairs in the usage instructions just to show you #
# you can have as many name/value pairs as you wish. #
# ** You can specify as many name/value pairs as you wish, and #
# &SetCookies will set them all. Just string them out, one #
# after the other. You must also have already printed out #
# the Content-type header, with only one new line following #
# it so that the header has not been ended. Then after the #
# &SetCookies call, you can print the final new line. #
# Returns: Nothing. #
##############################################################################
sub SetCookies {
# Localize variables and read in cookies to be set. #
local(@cookies) = @_;
local($cookie,$value,$char);
# While there is a cookie and a value to be set in @cookies, that hasn't #
# yet been set, proceed with the loop. #
while( ($cookie,$value) = @cookies ) {
# We must translate characters which are not allowed in cookies. #
foreach $char (@Cookie_Encode_Chars) {
$cookie =~ s/$char/$Cookie_Encode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Encode_Chars{$char}/g;
}
# Begin the printing of the Set-Cookie header with the cookie name #
# and value, followed by semi-colon. #
print 'Set-Cookie: ' . $cookie . '=' . $value . ';';
# If there is an Expiration Date set, add it to the header. #
if ($Cookie_Exp_Date) {
print ' expires=' . $Cookie_Exp_Date . ';';
}
# If there is a path set, add it to the header. #
if ($Cookie_Path) {
print ' path=' . $Cookie_Path . ';';
}
# If a domain has been set, add it to the header. #
if ($Cookie_Domain) {
print ' domain=' . $Cookie_Domain . ';';
}
# If this cookie should be sent only over secure channels, add that #
# to the header. #
if ($Secure_Cookie) {
print ' secure';
}
# End this line of the header, setting the cookie. #
print "\n";
# Remove the first two values of the @cookies array since we just #
# used them. #
shift(@cookies); shift(@cookies);
}
}
##############################################################################
# Subroutine: &SetCompressedCookies #
# Description: This routine does much the same thing that &SetCookies does #
# except that it combines multiple cookies into one. #
# Usage: &SetCompressedCookies(cname,name1,value1,...,namen,valuen) #
# Variables: cname - Name of the compressed cookie to be set. #
# Ex. 'CC' #
# name - Name of the individual cookie to be set. #
# Ex. 'count' #
# value - Value of the individual cookie to be set. #
# Ex. '3' #
# n - This is tacked on to the last of the name and value #
# pairs in the usage instructions just to show you #
# you can have as many name/value pairs as you wish. #
# Returns: Nothing. #
##############################################################################
sub SetCompressedCookies {
# Localize input into the compressed cookie name and the cookies to be #
# set. #
local($cookie_name,@cookies) = @_;
local($cookie,$value,$cookie_value);
# While there is a cookie and a value to be set in @cookies, that hasn't #
# yet been set, proceed with the loop. #
while ( ($cookie,$value) = @cookies ) {
# We must translate characters which are not allowed in cookies, or #
# which might interfere with the compression. #
foreach $char (@Cookie_Encode_Chars) {
$cookie =~ s/$char/$Cookie_Encode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Encode_Chars{$char}/g;
}
# Prepare the cookie value. If a current cookie value exists, use #
# an ampersand (&) to separate the cookies and instead of using = to #
# separate the name and the value, use double colons
, so it #
# won't confuse the browser. #
if ($cookie_value) {
$cookie_value .= '&' . $cookie . '::' . $value;
}
else {
$cookie_value = $cookie . '::' . $value;
}
# Remove the first two values of the @cookies array since we just #
# used them. #
shift(@cookies); shift(@cookies);
}
# Use the &SetCookies array to set the compressed cookie and value. #
&SetCookies("$cookie_name","$cookie_value");
}
##############################################################################
# Subroutine: &GetCompressedCookies() #
# Description: This subroutine takes the compressed cookie names, and #
# optionally the names of specific cookies you want returned #
# and uncompressed them, setting the values into %Cookies. #
# Specific names of cookies are optional and if not specified #
# all cookies found in the compressed cookie will be set. #
# Usage: &GetCompressedCookies(cname,[names]) #
# Variables: cname - Name of the compressed cookie to be uncompressed. #
# Ex. 'CC' #
# names - Optional names of cookies to be returned from the #
# compressed cookie if you don't want them all. The #
# [] depict a list of optional names, don't use []. #
# Ex. 'count' #
# Returns: 1 - If successful and at least one cookie is retrieved. #
# 0 - If no cookies are retrieved. #
##############################################################################
sub GetCompressedCookies {
# Localize variables used in this subroutine as well as the compressed #
# cookie name and the cookies to retrieve from the compressed cookie. #
local($cookie_name,@ReturnCookies) = @_;
local($cookie_flag) = 0;
local($ReturnCookie,$cookie,$value);
# If we can get the compressed cookie, proceed. #
if (&GetCookies($cookie_name)) {
# If there are specific cookies which we should set, rather than all #
# cookies found in the compressed cookie, then only retrieve them. #
if ($ReturnCookies[0] ne '') {
# For each cookie that was found in the compressed cookie: #
foreach (split(/&/,$Cookies{$cookie_name})) {
# Split the cookie name and value pair. #
($cookie,$value) = split(/::/);
# Decode any URL encoding which was done when the compressed #
# cookie was set. #
foreach $char (@Cookie_Decode_Chars) {
$cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
}
# For each cookie in the specified cookies we should set, #
# check to see if it matches the cookie we are looking at #
# right now. If so, set that cookie in the %Cookies array #
# and set the cookie flag to 1. #
foreach $ReturnCookie (@ReturnCookies) {
if ($ReturnCookie eq $cookie) {
$Cookies{$cookie} = $value;
$cookie_flag = 1;
}
}
}
}
# Otherwise, if there are no specific cookies to set, we will set #
# all cookies we find in the compressed cookie. #
else {
# Split the compressed cookie and split the cookie name/value #
# pairs, setting them in %Cookies. Also set cookie flag to 1. #
foreach (split(/&/,$Cookies{$cookie_name})) {
($cookie,$value) = split(/::/);
# Decode any URL encoding which was done when the compressed #
# cookie was set. #
foreach $char (@Cookie_Decode_Chars) {
$cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
}
$Cookies{$cookie} = $value;
}
$cookie_flag = 1;
}
# Delete the compressed cookie from the %Cookies array. #
delete($Cookies{$cookie_name});
}
# Return the cookie flag, which tells whether any cookies have been set. #
return $cookie_flag;
}
sub check_refers {
if ($ENV{'HTTP_REFERER'})
{
foreach $dom (@domains)
{
if ($ENV{'HTTP_REFERER'} =~ m|https?://([^/]*)$dom|i)
{
$referer = "1";
last;
}
}
if ($referer != "1")
{
$title = "Error: Invalid Location";
$content = "<H1>Error</h1>
Sorry but you cannot access this script from that location.";
$print_content =~ s/<!-- Header Here -->/$title/g;
$print_content =~ s/<!-- Content Here -->/$content/g;
print "Content-type: text/html\n\n";
print "$print_content";
exit;
}
}
}
sub get_template {
open (FILE,"template.txt");
$print_content = '';
while (<FILE>)
{
$print_content .= $_;
}
close (FILE);
if ($print_content =~ m/<HTML>(.*)<!-- Content Here -->(.*)/is)
{
$header = "$1";
$footer = "$2";
}else {
$header = "<HTML><head></head><body>";
$footer = "</body></html>";
}
}
sub get_date{
@days = ('Sunday','Monday','Tuesday','Wednesday','Thursday',
'Friday','Saturday');
@months = ('January','February','March','April','May','June','July',
'August','September','October','November','December');
# Use the localtime command to get the current time, splitting it into
# variables.
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
# Format the variables and assign them to the final $date variable.
if ($hour < 10) { $hour = "0$hour"; }
if ($min < 10) { $min = "0$min"; }
if ($sec < 10) { $sec = "0$sec"; }
$year += 1900;
$new_date = "$days[$wday], $months[$mon] $mday, $year";
}
sub get_input {
$request_method = $ENV{'REQUEST_METHOD'};
if ($request_method eq "GET") {
$form_info = $ENV{'QUERY_STRING'};
} else {
$size_of_form_information = $ENV{'CONTENT_LENGTH'};
read (STDIN, $form_info, $size_of_form_information);
}
@key_value_pairs = split (/&/, $form_info);
foreach $key_value (@key_value_pairs) {
($key, $value) = split (/=/, $key_value);
$value =~ tr/+/ /;
$value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
if (defined($FORM_DATA{$key})) {
$in{$key} = join (", ", $FORM_DATA{$key}, $value);
} else {
$in{$key} = $value;
}
}
}
#################################
#end my sub programmes
#################################
# This statement must be left in so that when perl requires this script as a #
# library it will do so without errors. This tells perl it has successfully #
# required the library. #
1;
<b>Protect.cgi</b>
#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
require "common.cgi";
require "cookie.lib";
&get_input;
&get_template;
if (&GetCookies('Custom-CGI_pass','Custom-CGI_id')){
&logged_in;
exit;
} else {
¬_logged_in;
exit;
}
sub logged_in {
print "Content-type: text/html\n\n";
if ($in{'page'} eq "" || $in{'page'} =~ s/[^a-z0-9\_\-\.]//g) {
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Error</h1>\n";
print "Sorry <b>$Cookies{'Custom-CGI_id'}</b> but you can't do that, please return, \n";
print "<a href=\"javascript:history.go(-1)\">here</a></a>\n";
print $footer;
exit;
}
if (-e "$base_protected_dir/$in{'page'}"){
open (FILE,"$base_protected_dir/$in{'page'}") || print "Unable to open the file";
while (<FILE>)
{
print $_;
}
close (FILE);
} else {
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>404 Error</h1>\n";
print "You are looking for the page <b>$in{'page'}</b> but it\n";
print "does not seem to exist. Please make sure you have the correct address.\n";
print $footer;
exit;
}
}
sub not_logged_in {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "Sorry, but you are not logged in, you must \n";
print "<a href=\"$weburl\">login</a> before you can view this page\n";
print $footer;
exit;
}
Members.txt File
guest:0295:mnk5khq:guest@quest.com
<b>Admin.cgi</b>
#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
require '../cookie.lib';
require '../common.cgi';
&get_input;
&GetCookies('admin_pass','admin_id');
if ($Cookies{'admin_pass'} eq "" || $Cookies{'admin_pass'} eq "") {
if ($in{'action'} eq '') {
&login;
} elsif ($in{'action'} eq 'login') {
&check_pass;
print "Location: admin.cgi?cookies=turned_off\n\n";
exit;
}
} else {
if ($in{'cookies'} eq "turned_off") {
print "Location: admin.cgi\n\n";
exit;
}
if ($in{'action'} eq "") {
&editmembers;
exit;
}
if ($in{'action'} eq "delete_mem") {
&delete_mem;
}
if ($in{'action'} eq "delete_user_confirm") {
&delete_user_confirm;
}
if ($in{'action'} eq "mail_selected_display") {
&mail_selected_display;
}
if ($in{'action'} eq "mass_mail1") {
&mail_selected_display;
}
if ($in{'action'} eq "send_mail") {
if ($demo ne "on") {
&send_mail;
&mail_sent;
exit;
} else {
&mail_sent;
exit;
}
}
}
exit;
######## The Subroutines ########
sub login {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1><TITLE>TRAINING CENTER</TITLE><body bgcolor=E2DEB8>Please Login</h1>\n";
print "Please login with your username and password.<P>\n";
# this checks if cookies have been set.
if ($in{'cookies'} eq "turned_off") {
print "<b><font color=\"#FF0000\">Error:</font></b> Cookies seem to be disabled. You cannot login until, \n";
print "these are turned on.\n";
}
print "<form action=\"$ENV{'SCRIPT_NAME'}\" method=\"POST\">\n";
print " <table border=\"0\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#000000\" width=\"400\"> \n";
print " <tr> \n";
print " <td> \n";
print " <table cellpadding=8 border=0 width=\"100%\">\n";
print " <tr><td bgcolor=\"#E2DEB8\">\n";
print " <table cellpadding=8 border=0 width=\"100%\">\n";
print " <tr><td >\n";
print " User Name: \n";
print " </td><td>\n";
print " <input type=text name=username size=28 value=\"";
if ($demo eq "on") {
print "demo";
}
print "\">\n";
print " </td></tr>\n";
print " <tr bgcolor=\"#E2DEB8\"><td>\n";
print " Password:\n";
print " </td><td>\n";
print " <input type=password name=password size=28 value=\"";
if ($demo eq "on") {
print "demo";
}
print "\">\n";
print " </td></tr>\n";
print " </table>\n";
print " </td></tr>\n";
print " <tr><td bgcolor=\"#E2DEB8\">\n";
print " <input type=hidden name=action value=login>\n";
print " <input type=submit value=\"Submit Login\">\n";
print " <input type=\"reset\" value=\"Reset\">\n";
print " </td></tr>\n";
print " </table>\n";
print " </td></tr>\n";
print " </table>\n";
print ' </form>';
print $footer;
}
sub editmembers {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Admin Menu</h1><P>\n";
print "This is the admin area for Cookie Login System. You email selected, all or \n";
print "an individual member.<P><center><form action=\"$ENV{'SCRIPT_NAME'}\" method =\"POST\">\n";
print "<table width=\"400\" border=\"0\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#000000\">\n";
print " <tr>\n";
print " <td>\n";
print " <table width=\"400\" border=\"0\" cellspacing=\"1\" cellpadding=\"6\">\n";
print " <tr bgcolor=\"#E2DEB8\"> \n";
print " <td>Member Name</td>\n";
print " <td> \n";
print " <div align=\"center\">Email</div>\n";
print " </td>\n";
print " </tr>\n";
open(CF, "$setup_base_dir/members.txt");
# get all th info in the file
@all = <CF>;
close(CF);
@all = sort(@all);
# loop for number of elements
for($i = 0; $i <= @all; $i++){
# split (explode) each line
($mem_name,$mem_password,$mem__encrypted_password,$mem_email) = split(':',$all[$i]);
if ($mem_name ne "") {
# check to see if submited info matches existing info
$mem_email =~ s/\n//g;
print " <tr><td bgcolor=\"#E2DEB8\"> \n";
print " <b>$mem_name</b>\n";
print " </td><td bgcolor=\"#E2DEB8\">\n";
print " <input type=\"checkbox\" name=\"email_$i\" value=\"$mem_email\">\n";
print " </td></tr>\n";
$total++;
}
}
if ($total eq "") {
print " <tr bgcolor=\"#E2DEB8\"><td colspan=\"2\" align=\"center\"><b>No Members</b></td></tr>\n";
}
print " <tr bgcolor=\"#E2DEB8\"> \n";
print " <td colspan=\"2\">\n";
print " <input type=\"hidden\" name=\"total\" value=\"$total\">\n";
print " <input type=\"hidden\" name=\"action\" value=\"mail_selected_display\">\n";
print " <input type=submit value=\"Mail Selected\"></td>\n";
print " </tr>\n";
print " </table>\n";
print " </td>\n";
print " </tr>\n";
print "</table></form>\n";
print "<p>\ </p>\n";
print "<table width=\"450\" border=\"0\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#E2DEB8\">\n";
print " <tr> \n";
print " <td colspan=\"3\">\n";
print " <table width=\"450\" border=\"0\" cellspacing=\"1\" cellpadding=\"6\">\n";
print " <tr bgcolor=\"#E2DEB8\" valign=\"bottom\"> \n";
print " <td> \n";
print " <form action=\"$ENV{'SCRIPT_NAME'}\" method =\"POST\">\n";
print " <select name=\"member\">\n";
open(CF, "$setup_base_dir/members.txt");
# get all th info in the file
@all = <CF>;
close(CF);
# sort the array
@all = sort(@all);
# now store sorted array
open (SIGNUP, ">$setup_base_dir/members.txt");
# loop for number of elements
for($i = 0; $i <= @all; $i++){
# split (explode) each line
($mem_name,$mem_password,$mem__encrypted_password,$mem_email) = split(':',$all[$i]);
if ($mem_name ne "") {
# check to see if submited info matches existing info
$mem_email =~ s/\n//g;
print " <option value=\"$mem_name\">$mem_name</option>\n";
$total++;
# update member file with sorted array
print SIGNUP ("@all[$i]");
}
}
# close member file
close (SIGNUP);
if ($total == "") {
print " <option value=\"\">\> No Mumbers</option>\n";
}
print " </select>\n";
print " <input type=\"hidden\" name=\"action\" value=\"delete_mem\">\n";
print " <input type=submit value=\"Delete Member\">\n";
print " </form>\n";
print " </td>\n";
print " <td> \n";
print " <form action=\"$ENV{'SCRIPT_NAME'}\" method =\"POST\">\n";
print " <input type=\"hidden\" name=\"action\" value=\"mass_mail1\">\n";
print " <input type=\"submit\" value=\"Email all members\">\n";
print " </form>\n";
print " </td>\n";
print " </tr>\n";
print " </table>\n";
print " </td>\n";
print " </tr>\n";
print "</table></center>\n";
@name_array = sort(@name_array);
for($i = 0; $i <= $#name_array; $i++){
print "My name is: <b>@name_array[$i]</b><br>\n";
}
print $footer;
exit;
}
sub check_pass {
if ($in{'username'} ne "$admin_login" || $in{'password'} ne "$admin_password") {
&login_fail;
} else {
$crypted = crypt("$in{'password'}",'£mHgF*&');
$crypted =~ s/[^a-z0-9\_]//g;
&SetCookies('admin_id',$in{'username'});
&SetCookies('admin_pass',$crypted);
}
}
sub login_fail {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h2>Error</h2>\n";
print "<P>Sorry that was the wrong login.\n";
print $footer;
exit;
}
sub delete_mem {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Delete member</h1>\n";
print "Once you delete a user, there is <b>no</b> turning back. Please be sure \n";
print "you're deleting the right user before you hit that delete button!<P>\n";
print " <FORM ACTION=\"$ENV{'SCRIPT_NAME'}\" METHOD=\"POST\">\n";
print " <input type=hidden name=action value=delete_user_confirm>\n";
print "<P> Delete member, <b>$in{'member'}</b><P>\n";
print "<input type=checkbox name=member value=$in{'member'}>\n";
print "Yes Delete member <b>$in{'member'}</b>.";
print " <input type=submit value=\"Confirm Delete\"></form>\n";
print "<P><i>You must check the box to delete the member</i>.\n";
print $footer;
}
sub delete_user_confirm {
if ($in{'member'} eq "") {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Error</h1>\n";
print "You must check the checkbox to confirm deleting the member.\n";
print $footer;
exit;
}
open(CF, "$setup_base_dir/members.txt");
# get all th info in the file
@all = <CF>;
close(CF);
# loop for number of elements
open (SIGNUP, ">$setup_base_dir/members.txt");
for($i = 0; $i <= @all; $i++){
# split (explode) each line
($mem_name,$mem_password,$mem__encrypted_password,$mem_email) = split(':',$all[$i]);
if ($mem_name ne "$in{'member'}" && $all[$i] ne "") {
print SIGNUP ("$all[$i]");
}
}
close (SIGNUP);
print "Content-type: text/html\n\n";
print $header;
print "<h1>Member Deleted</h1>\n";
print "Member has been successfully deleted. Press 'Retun' to go back to the main menu.\n";
print "<FORM ACTION=\"$ENV{'SCRIPT_NAME'}\" METHOD=\"POST\">\n";
print "<input type=submit value=\" Return \">\n";
print "</form>";
print $footer;
}
sub mail_selected_display {
print "Content-type: text/html\n\n";
print $header;
#print "You are send an email to <b>$in{'total'}</b> members<P>\n";
print "<FORM ACTION=\"$ENV{'SCRIPT_NAME'}\" METHOD=\"POST\">\n";
if ($in{'action'} eq "mass_mail1") {
print "<input type=\"hidden\" name=\"email\" value=\"all\">\n";
print "<h1>Email All Members</h1>\n";
} else {
print "<h1>Email Selected</h1>\n";
}
$count = $in{'total'};
$v = 0;
for ($i=0;$i<=$count;$i++)
{
if ($in{"email_$i"} ne "") {
print "<input type=\"hidden\" name=\"email_$i\" value=\"$in{\"email_$i\"}\">\n";
$v++;
}
}
print "From: <br><input type=text name=from size=45 value=\"$setup_email_admin\"><P>\n";
print "Subject: <BR><input type=text name=subject size=45>\n";
print "<BR><BR>Body of Message<BR>\n";
print "<TEXTAREA NAME=body ROWS=14 COLS=50></TEXTAREA>\n";
print "<input type=hidden name=action value=\"send_mail\"><br>\n";
print "<input type=hidden name=total value=\"$v\">\n";
print "<input type=submit value=\"Send this message\">\n";
print "</form>";
print $footer;
}
sub send_mail {
if ($in{'email'} eq "all") {
open(CF, "$setup_base_dir/members.txt");
# get all th info in the file
@all = <CF>;
close(CF);
# loop for number of elements
open (SIGNUP, "$setup_base_dir/members.txt") or die "Unable to open $setup_base_dir"."members.txt";
for($i = 0; $i <= $#all; $i++){
# split (explode) each line
($mem_name,$mem_password,$mem__encrypted_password,$mem_email) = split(':',$all[$i]);
open(MAIL, "|$setup_sendmail -t") || die;
print MAIL "To: $mem_email \n";
print MAIL "From: $setup_email_admin\n";
print MAIL "Return-Path: $setup_email_admin\n";
print MAIL "Subject: $in{'subject'}\n\n";
print MAIL "$in{'body'}\n";
print MAIL "\n\n";
print MAIL "============================================================\n";
print MAIL "ACCESS TEAM\n";
close (MAIL);
}
close (SIGNUP);
}
else {
for ($i=0;$i<=$in{'total'};$i++)
{
if ($in{"email_$i"} ne "") {
open(MAIL, "|$setup_sendmail -t") || die;
print MAIL "To: $mem_email \n";
print MAIL "From: $setup_email_admin\n";
print MAIL "Return-Path: $setup_email_admin\n";
print MAIL "Subject: $in{'subject'}\n\n";
print MAIL "$in{'body'}\n";
print MAIL "\n\n";
print MAIL "============================================================\n";
print MAIL "ACCESS TEAM\n";
close (MAIL);
}
}
}
}
sub mail_sent {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Email Sent</h1>\n";
print "Your email has been successfully sent. Press 'Retun' to go back to the main menu.\n";
if ($demo eq "on") {
print "<P><i>Email disabled in demo.</i><P>\n";
}
print "<FORM ACTION=\"$ENV{'SCRIPT_NAME'}\" METHOD=\"POST\">\n";
print "<input type=submit value=\" Return \">\n";
print "</form>";
print $footer;
exit;
}
<b>Login.Cgi</b>
#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
require "common.cgi";
require "cookie.lib";
&get_input;
&get_template;
&GetCookies('Custom-CGI_pass','Custom-CGI_id');
if ($Cookies{'Custom-CGI_pass'} ne "" && $Cookies{'Custom-CGI_id'} ne "") {
print "Location: main.cgi\n\n";
exit;
}
else {
if ($in{'action'} eq "") {
&login_screen;
exit;
}
if ($in{'action'} eq "login") {
&check_login;
}
if ($in{'action'} eq "logout") {
&loggout;
}
}
######### Login Screen ########
sub login_screen {
# just a simply login screen
print "Content-type: text/html\n\n";
print "<img src=\"/new13.jpg\">\n";
print "$header\n";
print "<h1><TITLE>I CENTER</TITLE><body bgcolor=E2DEB8> Training Login\n";
print "$header\n";
print "<h4>Please make sure your system is <a href=\"/config.html\" TARGET=\"Main\">configured correctly</a> before signing in.</h4>\n";
print "$newheader\n";
print "<h4><a href=\"/email.html\" TARGET=\"Main\">Forgot your password?</a></h4>\n";
print "<h4>Please login with your username and password.\n";
# this checks if cookies have been set.
if ($in{'cookies'} eq "turned_off") {
print "<b><font color=\"#FF0000\">Error:</font></b> Cookies seem to be disabled. You cannot login until, \n";
print "these are turned on.\n";
}
print "<form action=\"$ENV{'SCRIPT_NAME'}\" method=\"POST\">\n";
print " <table border=\"0\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#E2DEB8\" width=\"400\"> \n";
print " <tr> \n";
print " <td> \n";
print " <table cellpadding=8 border=0 width=\"100%\">\n";
print " <tr><td bgcolor=\"#E2DEB8\">\n";
print " <table cellpadding=8 border=1 width=\"100%\">\n";
print " <tr><td >\n";
print " User Name: \n";
print " </td><td>\n";
print " <input type=text name=my_user size=28 value=\"\">\n";
print " </td></tr>\n";
print " <tr bgcolor=\"#E2DEB8\"><td>\n";
print " Password:\n";
print " </td><td>\n";
print " <input type=password name=my_pass size=28>\n";
print " </td></tr>\n";
print " </table>\n";
print " </td></tr>\n";
print " <tr><td bgcolor=\"#E2DEB8\">\n";
print " <input type=hidden name=action value=login>\n";
print " <input type=submit value=\"Submit Login\">\n";
print " <input type=\"reset\" value=\"Reset\">\n";
print " </td></tr>\n";
print " </table>\n";
print " </td></tr>\n";
print " </table>\n";
print ' </form>';
print $footer;
}
######### check Login #######
sub check_login {
# make sure no 'bad' characters where submitted (this includes white space)
if ($in{'my_user'} =~ s/[^a-z0-9\_]//g || $in{'my_user'} eq "") {
$error = "<li> Invalid character in username.\n";
}
if ($in{'my_pass'} =~ s/[^a-z0-9\_]//g) {
$error .= "<li> Invalid character in password.\n";
}
# if $error has a value, then they submited bad characters which could
# be a security risk if used further.
if ($error eq "") {
if (-e "$setup_base_dir/members.txt") {
open(CF, "$setup_base_dir/members.txt");
# get all th info in the file
@all = <CF>;
close(CF);
# loop for number of elements
for($i = 0; $i <= @all; $i++){
# split (explode) each line
($mem_name,$mem_password,$mem__encrypted_password,$mem_email) = split(':',$all[$i]);
# check to see if submited info matches existing info
if ($in{'my_user'} eq $mem_name && $in{'my_pass'} eq $mem_password) {
# found, the visitor identiy is verified.
$found = 1;
# inside a loop so have to store info in another var.
$c1 = $mem_name;
$c2 = $mem__encrypted_password;
}
}
} else {
# if members.txt doesnt exist.
print "Content-type: text/html\n\n";
print "<body bgcolor=\"#E2DEB8\">\n";
print "Error: Unable to open members file";
exit;
}
}
# this is what happens if user is not found
if ($found ne 1){
$error .= "<li> No such username / password combination.\n";
}
# if erros ocured then tell visitor
if ($error) {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Error</h1>\n";
print "Error(s) ocured while loggin you in, please go back and fix there error(s),\n";
print "<p><table width=\"300\"><tr><td>$error</td></tr></table><P>\n";
print "<a href=\"javascript:history.go(-1)\"><< Back</a>\n";
print $footer;
exit;
} else {
# now print out the cookies
# setcookie ('cookie_name','Cookie_value')
&SetCookies('Custom-CGI_id',$c1);
&SetCookies('Custom-CGI_pass',$c2);
# send out last header
print "Location: login.cgi?cookies=turned_off\n\n";
exit;
}
}
<b>main.cgi</b>
#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
require "cookie.lib";
&GetCookies('Custom-CGI_pass','Custom-CGI_id');
# check to see if cookies are present
if ($Cookies{'Custom-CGI_pass'} eq "" || $Cookies{'Custom-CGI_id'} eq "") {
print "Location: login.cgi\n\n";
exit;
}
&get_input;
# this is the menu
if ($in{'action'} eq "") {
&mainpage;
exit;
}
if ($in{'action'} eq "logout") {
&loggout;
}
else {
&mainpage;
exit;
}
##############
# End Menu selection!
##############
# if everything is a ok, then print logged in page
sub mainpage {
open (FILE,"main.txt");
$mainpage = '';
while (<FILE>)
{
$mainpage .= $_;
}
close (FILE);
print "Content-type: text/html\n\n";
print "<!-- Thank you for signing up for a Course. -->\n";
print "<!-- We hope you come back and take more courses online. -->\n";
print $mainpage;
}
####### this is the log out section
sub loggout {
# this is a simple operation, to delete cookies (ie. loggout member)
# all you hav to do is set the cookies to a bull ("") value.
&SetCookies('Custom-CGI_id',"");
&SetCookies('Custom-CGI_pass',"");
&get_template;
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Logged Out</h1>\n";
print "You have been successfully logged out, you can log back in by clicking \n";
print "<a href=\"login.cgi\">here</a>.\n";
print $footer;
exit;
}
Common.cgi
#!/usr/bin/perl
# this is the BASE PATH (Not URL) where all the scripts are located.
# there should be NO trailing slash
$setup_base_dir = '/
# this is the location of Sendmail on your server.
$setup_sendmail = "/usr/sbin/sendmail";
# this is the admin email (this is address given when users are emailed on signup
# dont forget to escape the @ (i.e. @ -> \@)
$setup_email_admin = "guest@guest.com";
# this is a list of usernames that cannot be used.
# this is case insenceitive and checks username for ANY existance of each element
# (ie. if 'admin' is banned, it will not allow, 'email_admin' because it contains admin.)
@banned_users = ('admin','support','webmaster','info');
# admin login
$admin_login = "guest";
# admin password
$admin_password = "access";
# This is the directory where the "protected" files are stored (NO trailing slash).
$base_protected_dir = "/guest";
# This is the URL of where login.cgi is (no trailing slash).
$weburl = "
<b>cookie.lib</b>
##############################################################################
# HTTP Cookie Library Version 2.1 #
# Copyright 1996 Matt Wright mattw@worldwidemart.com #
# Created 07/14/96 Last Modified 12/23/96 #
# Script Archive at: #
# Extensive Documentation found in README file.#
##############################################################################
# COPYRIGHT NOTICE #
# Copyright 1996 Matthew M. Wright. All Rights Reserved. #
# #
# HTTP Cookie Library may be used and modified free of charge by anyone so #
# long as this copyright notice and the comments above remain intact. By #
# using this code you agree to indemnify Matthew M. Wright from any #
# liability that might arise from it's use. #
# #
# Selling the code for this program without prior written consent is #
# expressly forbidden. In other words, please ask first before you try and #
# make money off of my program. #
# #
# Obtain permission before redistributing this software over the Internet or #
# in any other medium. In all cases copyright and header must remain intact.#
##############################################################################
# Define variables for this library. #
# This is an optional variable. If not defined, the cookie will expire #
# when a user's session ends. #
# Should be defined as: Wdy, DD-Mon-YYYY HH:MM:SS GMT #
$Cookie_Exp_Date = '';
# By default this will be set to the same path as the document being #
# described by the header which contains the cookie. #
$Cookie_Path = '';
# By default this will be set to the domain host name of the server #
# which generated the cookie response. #
$Cookie_Domain = '';
# This should be set to 0 if the cookie is safe to send across over #
# unsecured channels. If set to 1 the cookie will only be transferred #
# if the communications channel with the host is a secure one. Currently #
# this means that secure cookies will only be sent to HTTPS (HTTP over #
# SSL) servers. According to Netscape docs at least. #
$Secure_Cookie = '0';
# These are the characters which the HTTP Cookie Library will translate #
# to url encoded (hex characters) when it sets individual or compressed #
# cookies. The array holds the order in which these should be #
# translated (as we wouldn't want to translate spaces into pluses and #
# then pluses into the URL encoded form, but rather the other way #
# around) and the associative array holds the values to translate #
# characters into. The decoded set will reverse the process. Feel free #
# to add any other characters here, but it shouldn't be necessary. #
# This is a correction in version 2.1 which makes this library adhere #
# more to the Netscape specifications. #
@Cookie_Encode_Chars = ('\%', '\+', '\;', '\,', '\=', '\&', '\:\:', '\s');
%Cookie_Encode_Chars = ('\%', '%25',
'\+', '%2B',
'\;', '%3B',
'\,', '%2C',
'\=', '%3D',
'\&', '%26',
'\:\:', '%3A%3A',
'\s', '+');
@Cookie_Decode_Chars = ('\+', '\%3A\%3A', '\%26', '\%3D', '\%2C', '\%3B', '\%2B', '\%25');
%Cookie_Decode_Chars = ('\+', ' ',
'\%3A\%3A', '::',
'\%26', '&',
'\%3D', '=',
'\%2C', ',',
'\%3B', ';',
'\%2B', '+',
'\%25', '%');
# Done #
##############################################################################
##############################################################################
# Subroutine: &GetCookies() #
# Description: This subroutine can be called with or without arguments. If #
# arguments are specified, only cookies with names matching #
# those specified will be set in %Cookies. Otherwise, all #
# cookies sent to this script will be set in %Cookies. #
# Usage: &GetCookies([cookie_names]) #
# Variables: cookie_names - These are optional (depicted with []) and #
# specify the names of cookies you wish to set.#
# Can also be called with an array of names. #
# Ex. 'name1','name2' #
# Returns: 1 - If successful and at least one cookie is retrieved. #
# 0 - If no cookies are retrieved. #
##############################################################################
sub GetCookies {
# Localize the variables and read in the cookies they wish to have #
# returned. #
local(@ReturnCookies) = @_;
local($cookie_flag) = 0;
local($cookie,$value);
# If the HTTP_COOKIE environment variable has been set by the call to #
# this script, meaning the browser sent some cookies to us, continue. #
if ($ENV{'HTTP_COOKIE'}) {
# If specific cookies have have been requested, meaning the #
# @ReturnCookies array is not empty, proceed. #
if ($ReturnCookies[0] ne '') {
# For each cookie sent to us: #
foreach (split(/; /,$ENV{'HTTP_COOKIE'})) {
# Split the cookie name and value pairs, separated by '='. #
($cookie,$value) = split(/=/);
# Decode any URL encoding which was done when the compressed #
# cookie was set. #
foreach $char (@Cookie_Decode_Chars) {
$cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
}
# For each cookie to be returned in the @ReturnCookies array:#
foreach $ReturnCookie (@ReturnCookies) {
# If the $ReturnCookie is equal to the current cookie we #
# are analyzing, set the cookie name in the %Cookies #
# associative array equal to the cookie value and set #
# the cookie flag to a true value. #
if ($ReturnCookie eq $cookie) {
$Cookies{$cookie} = $value;
$cookie_flag = "1";
}
}
}
}
# Otherwise, if no specific cookies have been requested, obtain all #
# cookied and place them in the %Cookies associative array. #
else {
# For each cookie that was sent to us by the browser, split the #
# cookie name and value pairs and set the cookie name key in the #
# associative array %Cookies equal to the value of that cookie. #
# Also set the coxokie flag to 1, since we set some cookies. #
foreach (split(/; /,$ENV{'HTTP_COOKIE'})) {
($cookie,$value) = split(/=/);
# Decode any URL encoding which was done when the compressed #
# cookie was set. #
foreach $char (@Cookie_Decode_Chars) {
$cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
}
$Cookies{$cookie} = $value;
}
$cookie_flag = 1;
}
}
# Return the value of the $cookie_flag, true or false, to indicate #
# whether we succeded in reading in a cookie value or not. #
return $cookie_flag;
}
##############################################################################
# Subroutine: &SetCookieExpDate() #
# Description: Sets the expiration date for the cookie. #
# Usage: &SetCookieExpDate('date') #
# Variables: date - The date you wish for the cookie to expire, in the #
# format: Wdy, DD-Mon-YYYY HH:MM:SS GMT #
# Ex. 'Wed, 09-Nov-1999 00:00:00 GMT' #
# Returns: 1 - If successful and date passes regular expression check #
# for format errors and the new ExpDate is set. #
# 0 - If new ExpDate was not set. Check format of date. #
##############################################################################
sub SetCookieExpDate {
# If the date string is formatted as: Wdy, DD-Mon-YYYY HH:MM:SS GMT, set #
# the $Cookie_Exp_Date to the new value and return 1 to signal success. #
# Otherwise, return 0, as the date was not successfully changed. #
# The date can also be set null value by calling: SetCookieExpDate(''). #
if ($_[0] =~ /^\w{3}\,\s\d{2}\-\w{3}-\d{4}\s\d{2}\:\d{2}\:\d{2}\sGMT$/ ||
$_[0] eq '') {
$Cookie_Exp_Date = $_[0];
return 1;
}
else {
return 0;
}
}
##############################################################################
# Subroutine: &SetCookiePath() #
# Description: Sets the path for the cookie to be sent to. #
# Usage: &SetCookiePath('path') #
# Variables: path - The path to which this cookie should be sent. #
# Ex. '/' or '/path/to/file' #
# Returns: Nothing. #
##############################################################################
sub SetCookiePath {
# Set the new Cookie Path, assuming it is correct. No error checking is #
# done. #
$Cookie_Path = $_[0];
}
##############################################################################
# Subroutine: &SetCookieDomain() #
# Description: Sets the domain for the cookie to be sent to. You can only #
# specify a domain within the current domain. Must have 2 or #
# 3 periods, depending on type of domain. e.g., .domain.com #
# or .k12.co.us. #
# Usage: &SetCookieDomain('domain') #
# Variables: domain - The domain to set the cookie for. #
# Ex. '.host.com' #
# Returns: 1 - If successful and value of $Cookie_Domain was set. #
# 0 - If unsuccessful and value was not changed. #
##############################################################################
sub SetCookieDomain {
# Following Netscape specifications, if the domain specified is one of 7 #
# top level domains, only require it to contain two periods, and if it #
# is not, require that there be three. If the new domain passes error #
# checking, set the new domain and return a true value. Otherwise, #
# return 0. Trying to set a domain other than the current one is futile,#
# since the browser won't allow it. But if people may be accessing the #
# page from or host.xxx, you may wish to set it to .host.xxx#
# so that either host the access will have access to the cookie. #
if ($_[0] =~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i &&
$_[0] =~ /\..+\.\w{3}$/) {
$Cookie_Domain = $_[0];
return 1;
}
elsif ($_[0] !~ /(.com|.edu|.net|.org|.gov|.mil|.int)$/i &&
$_[0] =~ /\..+\..+\..+/) {
$Cookie_Domain = $_[0];
return 1;
}
else {
return 0;
}
}
##############################################################################
# Subroutine: &SetSecureCookie() #
# Description: This subroutine will set the cookie to be either secure, #
# meaning the cookie will only be passed over a secure HTTP #
# channel, or unsecure, meaning it is safe to pass unsecured. #
# Usage: &SetSecureCookie('flag') #
# Variables: flag - 0 or 1 depending whether you want it secure or not #
# secure. By default, it is set to unsecure, unless #
# $Secure_Cookie was changed at the top. #
# Ex. 1 #
# Returns: 1 - If successful and value of $Secure_Cookie was set. #
# 0 - If unsuccessful and value was not changed. #
##############################################################################
sub SetSecureCookie {
# If the value passed to this script is a 1 or 0, set $Secure_Cookie #
# accordingly and return a true value. Otherwise, return a false value. #
if ($_[0] =~ /^[01]$/) {
$Secure_Cookie = $_[0];
return 1;
}
else {
return 0;
}
}
##############################################################################
# Subroutine: &SetCookies() #
# Description: Sets one or more cookies by printing out the Set-Cookie #
# HTTP header to the browser, based on cookie information #
# passed to subroutine. #
# Usage: &SetCookies(name1,value1,...namen,valuen) #
# Variables: name - Name of the cookie to be set. #
# Ex. 'count' #
# value - Value of the cookie to be set. #
# Ex. '3' #
# n - This is tacked on to the last of the name and value #
# pairs in the usage instructions just to show you #
# you can have as many name/value pairs as you wish. #
# ** You can specify as many name/value pairs as you wish, and #
# &SetCookies will set them all. Just string them out, one #
# after the other. You must also have already printed out #
# the Content-type header, with only one new line following #
# it so that the header has not been ended. Then after the #
# &SetCookies call, you can print the final new line. #
# Returns: Nothing. #
##############################################################################
sub SetCookies {
# Localize variables and read in cookies to be set. #
local(@cookies) = @_;
local($cookie,$value,$char);
# While there is a cookie and a value to be set in @cookies, that hasn't #
# yet been set, proceed with the loop. #
while( ($cookie,$value) = @cookies ) {
# We must translate characters which are not allowed in cookies. #
foreach $char (@Cookie_Encode_Chars) {
$cookie =~ s/$char/$Cookie_Encode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Encode_Chars{$char}/g;
}
# Begin the printing of the Set-Cookie header with the cookie name #
# and value, followed by semi-colon. #
print 'Set-Cookie: ' . $cookie . '=' . $value . ';';
# If there is an Expiration Date set, add it to the header. #
if ($Cookie_Exp_Date) {
print ' expires=' . $Cookie_Exp_Date . ';';
}
# If there is a path set, add it to the header. #
if ($Cookie_Path) {
print ' path=' . $Cookie_Path . ';';
}
# If a domain has been set, add it to the header. #
if ($Cookie_Domain) {
print ' domain=' . $Cookie_Domain . ';';
}
# If this cookie should be sent only over secure channels, add that #
# to the header. #
if ($Secure_Cookie) {
print ' secure';
}
# End this line of the header, setting the cookie. #
print "\n";
# Remove the first two values of the @cookies array since we just #
# used them. #
shift(@cookies); shift(@cookies);
}
}
##############################################################################
# Subroutine: &SetCompressedCookies #
# Description: This routine does much the same thing that &SetCookies does #
# except that it combines multiple cookies into one. #
# Usage: &SetCompressedCookies(cname,name1,value1,...,namen,valuen) #
# Variables: cname - Name of the compressed cookie to be set. #
# Ex. 'CC' #
# name - Name of the individual cookie to be set. #
# Ex. 'count' #
# value - Value of the individual cookie to be set. #
# Ex. '3' #
# n - This is tacked on to the last of the name and value #
# pairs in the usage instructions just to show you #
# you can have as many name/value pairs as you wish. #
# Returns: Nothing. #
##############################################################################
sub SetCompressedCookies {
# Localize input into the compressed cookie name and the cookies to be #
# set. #
local($cookie_name,@cookies) = @_;
local($cookie,$value,$cookie_value);
# While there is a cookie and a value to be set in @cookies, that hasn't #
# yet been set, proceed with the loop. #
while ( ($cookie,$value) = @cookies ) {
# We must translate characters which are not allowed in cookies, or #
# which might interfere with the compression. #
foreach $char (@Cookie_Encode_Chars) {
$cookie =~ s/$char/$Cookie_Encode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Encode_Chars{$char}/g;
}
# Prepare the cookie value. If a current cookie value exists, use #
# an ampersand (&) to separate the cookies and instead of using = to #
# separate the name and the value, use double colons
, so it ## won't confuse the browser. #
if ($cookie_value) {
$cookie_value .= '&' . $cookie . '::' . $value;
}
else {
$cookie_value = $cookie . '::' . $value;
}
# Remove the first two values of the @cookies array since we just #
# used them. #
shift(@cookies); shift(@cookies);
}
# Use the &SetCookies array to set the compressed cookie and value. #
&SetCookies("$cookie_name","$cookie_value");
}
##############################################################################
# Subroutine: &GetCompressedCookies() #
# Description: This subroutine takes the compressed cookie names, and #
# optionally the names of specific cookies you want returned #
# and uncompressed them, setting the values into %Cookies. #
# Specific names of cookies are optional and if not specified #
# all cookies found in the compressed cookie will be set. #
# Usage: &GetCompressedCookies(cname,[names]) #
# Variables: cname - Name of the compressed cookie to be uncompressed. #
# Ex. 'CC' #
# names - Optional names of cookies to be returned from the #
# compressed cookie if you don't want them all. The #
# [] depict a list of optional names, don't use []. #
# Ex. 'count' #
# Returns: 1 - If successful and at least one cookie is retrieved. #
# 0 - If no cookies are retrieved. #
##############################################################################
sub GetCompressedCookies {
# Localize variables used in this subroutine as well as the compressed #
# cookie name and the cookies to retrieve from the compressed cookie. #
local($cookie_name,@ReturnCookies) = @_;
local($cookie_flag) = 0;
local($ReturnCookie,$cookie,$value);
# If we can get the compressed cookie, proceed. #
if (&GetCookies($cookie_name)) {
# If there are specific cookies which we should set, rather than all #
# cookies found in the compressed cookie, then only retrieve them. #
if ($ReturnCookies[0] ne '') {
# For each cookie that was found in the compressed cookie: #
foreach (split(/&/,$Cookies{$cookie_name})) {
# Split the cookie name and value pair. #
($cookie,$value) = split(/::/);
# Decode any URL encoding which was done when the compressed #
# cookie was set. #
foreach $char (@Cookie_Decode_Chars) {
$cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
}
# For each cookie in the specified cookies we should set, #
# check to see if it matches the cookie we are looking at #
# right now. If so, set that cookie in the %Cookies array #
# and set the cookie flag to 1. #
foreach $ReturnCookie (@ReturnCookies) {
if ($ReturnCookie eq $cookie) {
$Cookies{$cookie} = $value;
$cookie_flag = 1;
}
}
}
}
# Otherwise, if there are no specific cookies to set, we will set #
# all cookies we find in the compressed cookie. #
else {
# Split the compressed cookie and split the cookie name/value #
# pairs, setting them in %Cookies. Also set cookie flag to 1. #
foreach (split(/&/,$Cookies{$cookie_name})) {
($cookie,$value) = split(/::/);
# Decode any URL encoding which was done when the compressed #
# cookie was set. #
foreach $char (@Cookie_Decode_Chars) {
$cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
$value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
}
$Cookies{$cookie} = $value;
}
$cookie_flag = 1;
}
# Delete the compressed cookie from the %Cookies array. #
delete($Cookies{$cookie_name});
}
# Return the cookie flag, which tells whether any cookies have been set. #
return $cookie_flag;
}
sub check_refers {
if ($ENV{'HTTP_REFERER'})
{
foreach $dom (@domains)
{
if ($ENV{'HTTP_REFERER'} =~ m|https?://([^/]*)$dom|i)
{
$referer = "1";
last;
}
}
if ($referer != "1")
{
$title = "Error: Invalid Location";
$content = "<H1>Error</h1>
Sorry but you cannot access this script from that location.";
$print_content =~ s/<!-- Header Here -->/$title/g;
$print_content =~ s/<!-- Content Here -->/$content/g;
print "Content-type: text/html\n\n";
print "$print_content";
exit;
}
}
}
sub get_template {
open (FILE,"template.txt");
$print_content = '';
while (<FILE>)
{
$print_content .= $_;
}
close (FILE);
if ($print_content =~ m/<HTML>(.*)<!-- Content Here -->(.*)/is)
{
$header = "$1";
$footer = "$2";
}else {
$header = "<HTML><head></head><body>";
$footer = "</body></html>";
}
}
sub get_date{
@days = ('Sunday','Monday','Tuesday','Wednesday','Thursday',
'Friday','Saturday');
@months = ('January','February','March','April','May','June','July',
'August','September','October','November','December');
# Use the localtime command to get the current time, splitting it into
# variables.
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
# Format the variables and assign them to the final $date variable.
if ($hour < 10) { $hour = "0$hour"; }
if ($min < 10) { $min = "0$min"; }
if ($sec < 10) { $sec = "0$sec"; }
$year += 1900;
$new_date = "$days[$wday], $months[$mon] $mday, $year";
}
sub get_input {
$request_method = $ENV{'REQUEST_METHOD'};
if ($request_method eq "GET") {
$form_info = $ENV{'QUERY_STRING'};
} else {
$size_of_form_information = $ENV{'CONTENT_LENGTH'};
read (STDIN, $form_info, $size_of_form_information);
}
@key_value_pairs = split (/&/, $form_info);
foreach $key_value (@key_value_pairs) {
($key, $value) = split (/=/, $key_value);
$value =~ tr/+/ /;
$value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
if (defined($FORM_DATA{$key})) {
$in{$key} = join (", ", $FORM_DATA{$key}, $value);
} else {
$in{$key} = $value;
}
}
}
#################################
#end my sub programmes
#################################
# This statement must be left in so that when perl requires this script as a #
# library it will do so without errors. This tells perl it has successfully #
# required the library. #
1;
<b>Protect.cgi</b>
#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
require "common.cgi";
require "cookie.lib";
&get_input;
&get_template;
if (&GetCookies('Custom-CGI_pass','Custom-CGI_id')){
&logged_in;
exit;
} else {
¬_logged_in;
exit;
}
sub logged_in {
print "Content-type: text/html\n\n";
if ($in{'page'} eq "" || $in{'page'} =~ s/[^a-z0-9\_\-\.]//g) {
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Error</h1>\n";
print "Sorry <b>$Cookies{'Custom-CGI_id'}</b> but you can't do that, please return, \n";
print "<a href=\"javascript:history.go(-1)\">here</a></a>\n";
print $footer;
exit;
}
if (-e "$base_protected_dir/$in{'page'}"){
open (FILE,"$base_protected_dir/$in{'page'}") || print "Unable to open the file";
while (<FILE>)
{
print $_;
}
close (FILE);
} else {
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>404 Error</h1>\n";
print "You are looking for the page <b>$in{'page'}</b> but it\n";
print "does not seem to exist. Please make sure you have the correct address.\n";
print $footer;
exit;
}
}
sub not_logged_in {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "Sorry, but you are not logged in, you must \n";
print "<a href=\"$weburl\">login</a> before you can view this page\n";
print $footer;
exit;
}
Members.txt File
guest:0295:mnk5khq:guest@quest.com
<b>Admin.cgi</b>
#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
require '../cookie.lib';
require '../common.cgi';
&get_input;
&GetCookies('admin_pass','admin_id');
if ($Cookies{'admin_pass'} eq "" || $Cookies{'admin_pass'} eq "") {
if ($in{'action'} eq '') {
&login;
} elsif ($in{'action'} eq 'login') {
&check_pass;
print "Location: admin.cgi?cookies=turned_off\n\n";
exit;
}
} else {
if ($in{'cookies'} eq "turned_off") {
print "Location: admin.cgi\n\n";
exit;
}
if ($in{'action'} eq "") {
&editmembers;
exit;
}
if ($in{'action'} eq "delete_mem") {
&delete_mem;
}
if ($in{'action'} eq "delete_user_confirm") {
&delete_user_confirm;
}
if ($in{'action'} eq "mail_selected_display") {
&mail_selected_display;
}
if ($in{'action'} eq "mass_mail1") {
&mail_selected_display;
}
if ($in{'action'} eq "send_mail") {
if ($demo ne "on") {
&send_mail;
&mail_sent;
exit;
} else {
&mail_sent;
exit;
}
}
}
exit;
######## The Subroutines ########
sub login {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1><TITLE>TRAINING CENTER</TITLE><body bgcolor=E2DEB8>Please Login</h1>\n";
print "Please login with your username and password.<P>\n";
# this checks if cookies have been set.
if ($in{'cookies'} eq "turned_off") {
print "<b><font color=\"#FF0000\">Error:</font></b> Cookies seem to be disabled. You cannot login until, \n";
print "these are turned on.\n";
}
print "<form action=\"$ENV{'SCRIPT_NAME'}\" method=\"POST\">\n";
print " <table border=\"0\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#000000\" width=\"400\"> \n";
print " <tr> \n";
print " <td> \n";
print " <table cellpadding=8 border=0 width=\"100%\">\n";
print " <tr><td bgcolor=\"#E2DEB8\">\n";
print " <table cellpadding=8 border=0 width=\"100%\">\n";
print " <tr><td >\n";
print " User Name: \n";
print " </td><td>\n";
print " <input type=text name=username size=28 value=\"";
if ($demo eq "on") {
print "demo";
}
print "\">\n";
print " </td></tr>\n";
print " <tr bgcolor=\"#E2DEB8\"><td>\n";
print " Password:\n";
print " </td><td>\n";
print " <input type=password name=password size=28 value=\"";
if ($demo eq "on") {
print "demo";
}
print "\">\n";
print " </td></tr>\n";
print " </table>\n";
print " </td></tr>\n";
print " <tr><td bgcolor=\"#E2DEB8\">\n";
print " <input type=hidden name=action value=login>\n";
print " <input type=submit value=\"Submit Login\">\n";
print " <input type=\"reset\" value=\"Reset\">\n";
print " </td></tr>\n";
print " </table>\n";
print " </td></tr>\n";
print " </table>\n";
print ' </form>';
print $footer;
}
sub editmembers {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Admin Menu</h1><P>\n";
print "This is the admin area for Cookie Login System. You email selected, all or \n";
print "an individual member.<P><center><form action=\"$ENV{'SCRIPT_NAME'}\" method =\"POST\">\n";
print "<table width=\"400\" border=\"0\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#000000\">\n";
print " <tr>\n";
print " <td>\n";
print " <table width=\"400\" border=\"0\" cellspacing=\"1\" cellpadding=\"6\">\n";
print " <tr bgcolor=\"#E2DEB8\"> \n";
print " <td>Member Name</td>\n";
print " <td> \n";
print " <div align=\"center\">Email</div>\n";
print " </td>\n";
print " </tr>\n";
open(CF, "$setup_base_dir/members.txt");
# get all th info in the file
@all = <CF>;
close(CF);
@all = sort(@all);
# loop for number of elements
for($i = 0; $i <= @all; $i++){
# split (explode) each line
($mem_name,$mem_password,$mem__encrypted_password,$mem_email) = split(':',$all[$i]);
if ($mem_name ne "") {
# check to see if submited info matches existing info
$mem_email =~ s/\n//g;
print " <tr><td bgcolor=\"#E2DEB8\"> \n";
print " <b>$mem_name</b>\n";
print " </td><td bgcolor=\"#E2DEB8\">\n";
print " <input type=\"checkbox\" name=\"email_$i\" value=\"$mem_email\">\n";
print " </td></tr>\n";
$total++;
}
}
if ($total eq "") {
print " <tr bgcolor=\"#E2DEB8\"><td colspan=\"2\" align=\"center\"><b>No Members</b></td></tr>\n";
}
print " <tr bgcolor=\"#E2DEB8\"> \n";
print " <td colspan=\"2\">\n";
print " <input type=\"hidden\" name=\"total\" value=\"$total\">\n";
print " <input type=\"hidden\" name=\"action\" value=\"mail_selected_display\">\n";
print " <input type=submit value=\"Mail Selected\"></td>\n";
print " </tr>\n";
print " </table>\n";
print " </td>\n";
print " </tr>\n";
print "</table></form>\n";
print "<p>\ </p>\n";
print "<table width=\"450\" border=\"0\" cellspacing=\"0\" cellpadding=\"0\" bgcolor=\"#E2DEB8\">\n";
print " <tr> \n";
print " <td colspan=\"3\">\n";
print " <table width=\"450\" border=\"0\" cellspacing=\"1\" cellpadding=\"6\">\n";
print " <tr bgcolor=\"#E2DEB8\" valign=\"bottom\"> \n";
print " <td> \n";
print " <form action=\"$ENV{'SCRIPT_NAME'}\" method =\"POST\">\n";
print " <select name=\"member\">\n";
open(CF, "$setup_base_dir/members.txt");
# get all th info in the file
@all = <CF>;
close(CF);
# sort the array
@all = sort(@all);
# now store sorted array
open (SIGNUP, ">$setup_base_dir/members.txt");
# loop for number of elements
for($i = 0; $i <= @all; $i++){
# split (explode) each line
($mem_name,$mem_password,$mem__encrypted_password,$mem_email) = split(':',$all[$i]);
if ($mem_name ne "") {
# check to see if submited info matches existing info
$mem_email =~ s/\n//g;
print " <option value=\"$mem_name\">$mem_name</option>\n";
$total++;
# update member file with sorted array
print SIGNUP ("@all[$i]");
}
}
# close member file
close (SIGNUP);
if ($total == "") {
print " <option value=\"\">\> No Mumbers</option>\n";
}
print " </select>\n";
print " <input type=\"hidden\" name=\"action\" value=\"delete_mem\">\n";
print " <input type=submit value=\"Delete Member\">\n";
print " </form>\n";
print " </td>\n";
print " <td> \n";
print " <form action=\"$ENV{'SCRIPT_NAME'}\" method =\"POST\">\n";
print " <input type=\"hidden\" name=\"action\" value=\"mass_mail1\">\n";
print " <input type=\"submit\" value=\"Email all members\">\n";
print " </form>\n";
print " </td>\n";
print " </tr>\n";
print " </table>\n";
print " </td>\n";
print " </tr>\n";
print "</table></center>\n";
@name_array = sort(@name_array);
for($i = 0; $i <= $#name_array; $i++){
print "My name is: <b>@name_array[$i]</b><br>\n";
}
print $footer;
exit;
}
sub check_pass {
if ($in{'username'} ne "$admin_login" || $in{'password'} ne "$admin_password") {
&login_fail;
} else {
$crypted = crypt("$in{'password'}",'£mHgF*&');
$crypted =~ s/[^a-z0-9\_]//g;
&SetCookies('admin_id',$in{'username'});
&SetCookies('admin_pass',$crypted);
}
}
sub login_fail {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h2>Error</h2>\n";
print "<P>Sorry that was the wrong login.\n";
print $footer;
exit;
}
sub delete_mem {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Delete member</h1>\n";
print "Once you delete a user, there is <b>no</b> turning back. Please be sure \n";
print "you're deleting the right user before you hit that delete button!<P>\n";
print " <FORM ACTION=\"$ENV{'SCRIPT_NAME'}\" METHOD=\"POST\">\n";
print " <input type=hidden name=action value=delete_user_confirm>\n";
print "<P> Delete member, <b>$in{'member'}</b><P>\n";
print "<input type=checkbox name=member value=$in{'member'}>\n";
print "Yes Delete member <b>$in{'member'}</b>.";
print " <input type=submit value=\"Confirm Delete\"></form>\n";
print "<P><i>You must check the box to delete the member</i>.\n";
print $footer;
}
sub delete_user_confirm {
if ($in{'member'} eq "") {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Error</h1>\n";
print "You must check the checkbox to confirm deleting the member.\n";
print $footer;
exit;
}
open(CF, "$setup_base_dir/members.txt");
# get all th info in the file
@all = <CF>;
close(CF);
# loop for number of elements
open (SIGNUP, ">$setup_base_dir/members.txt");
for($i = 0; $i <= @all; $i++){
# split (explode) each line
($mem_name,$mem_password,$mem__encrypted_password,$mem_email) = split(':',$all[$i]);
if ($mem_name ne "$in{'member'}" && $all[$i] ne "") {
print SIGNUP ("$all[$i]");
}
}
close (SIGNUP);
print "Content-type: text/html\n\n";
print $header;
print "<h1>Member Deleted</h1>\n";
print "Member has been successfully deleted. Press 'Retun' to go back to the main menu.\n";
print "<FORM ACTION=\"$ENV{'SCRIPT_NAME'}\" METHOD=\"POST\">\n";
print "<input type=submit value=\" Return \">\n";
print "</form>";
print $footer;
}
sub mail_selected_display {
print "Content-type: text/html\n\n";
print $header;
#print "You are send an email to <b>$in{'total'}</b> members<P>\n";
print "<FORM ACTION=\"$ENV{'SCRIPT_NAME'}\" METHOD=\"POST\">\n";
if ($in{'action'} eq "mass_mail1") {
print "<input type=\"hidden\" name=\"email\" value=\"all\">\n";
print "<h1>Email All Members</h1>\n";
} else {
print "<h1>Email Selected</h1>\n";
}
$count = $in{'total'};
$v = 0;
for ($i=0;$i<=$count;$i++)
{
if ($in{"email_$i"} ne "") {
print "<input type=\"hidden\" name=\"email_$i\" value=\"$in{\"email_$i\"}\">\n";
$v++;
}
}
print "From: <br><input type=text name=from size=45 value=\"$setup_email_admin\"><P>\n";
print "Subject: <BR><input type=text name=subject size=45>\n";
print "<BR><BR>Body of Message<BR>\n";
print "<TEXTAREA NAME=body ROWS=14 COLS=50></TEXTAREA>\n";
print "<input type=hidden name=action value=\"send_mail\"><br>\n";
print "<input type=hidden name=total value=\"$v\">\n";
print "<input type=submit value=\"Send this message\">\n";
print "</form>";
print $footer;
}
sub send_mail {
if ($in{'email'} eq "all") {
open(CF, "$setup_base_dir/members.txt");
# get all th info in the file
@all = <CF>;
close(CF);
# loop for number of elements
open (SIGNUP, "$setup_base_dir/members.txt") or die "Unable to open $setup_base_dir"."members.txt";
for($i = 0; $i <= $#all; $i++){
# split (explode) each line
($mem_name,$mem_password,$mem__encrypted_password,$mem_email) = split(':',$all[$i]);
open(MAIL, "|$setup_sendmail -t") || die;
print MAIL "To: $mem_email \n";
print MAIL "From: $setup_email_admin\n";
print MAIL "Return-Path: $setup_email_admin\n";
print MAIL "Subject: $in{'subject'}\n\n";
print MAIL "$in{'body'}\n";
print MAIL "\n\n";
print MAIL "============================================================\n";
print MAIL "ACCESS TEAM\n";
close (MAIL);
}
close (SIGNUP);
}
else {
for ($i=0;$i<=$in{'total'};$i++)
{
if ($in{"email_$i"} ne "") {
open(MAIL, "|$setup_sendmail -t") || die;
print MAIL "To: $mem_email \n";
print MAIL "From: $setup_email_admin\n";
print MAIL "Return-Path: $setup_email_admin\n";
print MAIL "Subject: $in{'subject'}\n\n";
print MAIL "$in{'body'}\n";
print MAIL "\n\n";
print MAIL "============================================================\n";
print MAIL "ACCESS TEAM\n";
close (MAIL);
}
}
}
}
sub mail_sent {
print "Content-type: text/html\n\n";
print $header;
print "<body bgcolor=\"#E2DEB8\">\n";
print "<h1>Email Sent</h1>\n";
print "Your email has been successfully sent. Press 'Retun' to go back to the main menu.\n";
if ($demo eq "on") {
print "<P><i>Email disabled in demo.</i><P>\n";
}
print "<FORM ACTION=\"$ENV{'SCRIPT_NAME'}\" METHOD=\"POST\">\n";
print "<input type=submit value=\" Return \">\n";
print "</form>";
print $footer;
exit;
}