#!/usr/bin/perl
##############################################################
# Instant Messenger v1.0
#
# Copyright: 2000 Stringer Software Solutions
# All Rights Reserved
# URL: http://strin.virtualave.net/scripts/
# e-mail: rstringer@rocketmail.com
##############################################################
# Copyright Notice
##############################################################
# Any redistribution of this script without the expressed
# written consent of Stringer Software Solutions is strictly
# prohibited.
# Copying any of the code contained within this script and
# claiming it as your own is also prohibited. You may not
# remove any of these header notices. By using this code you
# agree to indemnify Stringer Software Solutions from any
# liability that might arise from its use.
##############################################################
# Installation
##############################################################
# 1. Change the first line to point to where the perl
# interpreter is stored to on your server
# On some servers it's:
# #!/user/local/bin/perl
# On others it's:
# #!/user/bin/perl
# 2. Rename im.txt to im.pl
# 3. Configure the variables (using a text editor like
# Notepad) below and save in ASCII (text)
# 4. Upload to server in ASCII (text)
# 5. CHMOD script 0755 (rwxr_xr_x)
# 6. Create subdirectory data and chmod 0777 (drwxrwxrwx)
# 7. Go inside the data subdirectory
# 8. Create subdirectory messages and chmod 0777 (drwxrwxrwx)
##############################################################
# Operation
##############################################################
# The script is called as follows:
#
##############################################################
# Configuration
##############################################################
# Directory path for script data files (userpass.dat,
# messages directory). Create this directory in advance
# and chmod (0777 or drwxrwxrwx). NO trailing slash at end of path.
# $data_dir = "/full/path/to/cgi-bin/data";
$data_dir = "/usr/sulima/im/data";
# Change any instances of [YOUR_URL] to the url of the site
# where you are placing im.pl
# GLOBALS
my $database = "$data_dir/userpass.dat";
my $messages = "$data_dir/messages/";
my $thisURL = "http://www.sulima.com/im/im.pl";
my $joinURL = "http://www.sulima.com/im/im.pl?action=join";
#######################################################################
# You should not have to change anything below here to get it to work.#
#######################################################################
use strict 'vars';
use CGI qw(:standard);
my ($action, $subaction, $step, $user, $pass, $userID, @lines, $logged, $error, $to, $message);
my ($data, $line, $check);
## BEGIN SCRIPT ###
&gatherVars();
&performAction;
### PERFORM ACTION ###
sub performAction{
my %possibleAction = ( "join", 1,
"manage", 1);
if($possibleAction{$action}){
&printCommonHeader();
if ($action eq "join") {
&actionAdd();
}
if ($action eq "manage") {
&actionManage();
}
&printCommonFooter();
}
else{
## there was no action, then the main page is displayed
&printCommonHeader();
&actionHome();
&printCommonFooter();
}
}
sub actionHome{
print "| \n";
print " | \n";
print "\n";
print "\n";
print "
\n";
print " | \n";
print "\n";
print " | \n";
print "\n";
print "\n";
print "| \n";
print " | \n";
print "\n";
print "\n";
print "| \n";
print "\n";
print "\n";
print "[login]\n";
print " \n";
print " | \n";
print "\n";
print " \n";
print "\n";
print "[register]\n";
print " | \n";
print " \n";
print " | \n";
print "\n";
print " | \n";
}
sub actionManage {
my ($tmpuser, $tmppass, $tmpmessage, $tmpfrom, $tmpmess, @messes, $mess);
if ($user eq "") {
&error("Missing UserName");
}
if ($pass eq "") {
&error("Missing Password");
}
open(DATA,"$database");
$data = ;
close(DATA);
@lines = split(/&/,$data);
$logged = "OUT";
foreach $line (@lines) {
($tmpuser,$tmppass) = split(/\|/,$line);
if ($user eq $tmpuser) {
if ($pass eq $tmppass) {
$logged = "IN";
}
}
}
if ($logged eq "OUT") {
&error("Login Info not Correct");
}
if ($error == 0) {
if ($subaction eq "send") {
open(SEND,">>$messages$to");
print SEND "$user|$message&";
close(SEND);
}
print "\n";
print " | \n";
print "\n";
print "\n";
print "
\n";
print " | \n";
print "\n";
print " | \n";
print "
\n";
print "\n";
print "| \n";
print " | \n";
print "\n";
print "\n";
open(MESSAGES,"$messages$user");
$tmpmess = ;
close(MESSAGES);
@messes = split(/&/,$tmpmess);
foreach $mess (@messes) {
($tmpfrom,$tmpmessage) = split(/\|/,$mess);
print "\n";
print "| \n";
print "$tmpfrom :\n";
print " | \n";
print "\n";
print "$tmpmessage\n";
print " | \n";
print " \n";
}
open(DEL,">$messages$user");
print DEL "";
close(DEL);
print " \n";
print " | \n";
print "\n";
print " | \n";
}
}
sub actionAdd {
my ($tmp, $tmpa);
if ($step == "1") {
print "\n";
print " | \n";
print "\n";
print "\n";
print "
\n";
print " | \n";
print "\n";
print " | \n";
print "
\n";
print "\n";
print "| \n";
print " | \n";
print "\n";
print "\n";
print "| \n";
print "\n";
print "\n";
print "[join]\n";
print " \n";
print " | \n";
print "\n";
print " \n";
print " | \n";
print " \n";
print " | \n";
print "\n";
print " | \n";
}
if ($step == "2") {
if ($user eq "") {
print "Missing Username"; ++$error;
}
if ($pass eq "") {
print "Missing Password"; ++$error;
}
open(CHECK,"$database");
$check = ;
close(CHECK);
@lines = split(/&/,$check);
foreach $line (@lines) {
($tmp,$tmpa) = split(/\|/,$line);
if ($user eq $tmp) {
print "username taken"; ++$error;
}
}
if ($error == 0) {
open(ADD,">>$database");
print ADD "$user|$pass&";
close(ADD);
print "\n";
print " | \n";
print "\n";
print "\n";
print "
\n";
print " | \n";
print "\n";
print " | \n";
print "
\n";
print "\n";
print "| \n";
print " | \n";
print "\n";
print "\n";
print "| \n";
print "\n";
print "\n";
print "[login]\n";
print " \n";
print " | \n";
print "\n";
print " \n";
print " | \n";
print " \n";
print " | \n";
print "\n";
print " | \n";
}
}
}
sub printCommonHeader {
my ($theUserID);
print "Content-type: text/html\n\n";
print "\n";
print "\n";
print "\n";
print "\n";
print "\n";
print "\n";
print "\n";
print " \n";
print " \n";
print "\t\t\t\t\t\t\n";
}
sub printCommonFooter {
print "\t\t\t\t\t\t\n";
print "\t\t\t\t\t\t\n";
print "\t\t\t\t\t
\n";
print "\t\t\t\t
\n";
print "\t\t\t\n";
print "\t\t
\n";
print "\t\n";
print "\n";
print "\n";
print "\n";
print "\n";
}
sub error {
my $msg = shift(@_);
++$error;
if ($error == 1) {
print "ERROR:
\n";
print "
\n";
print "