#!/usr/bin/perl # Detta Script och readme filen får endast skickas vidare i oförändrat skick, omodifierad # och komplett. Scriptet är freeware. # Skapat och Copyright av Ralf Gueldemeister # den 25/12-98. # Modifierat och Översatt till Svenska av Dusan Ilic # den 07/01-99. # Konfig Del # ####################### $data_dir = "data"; # data katalog, t.ex "data" $unknowncmd_msg = "ogiltigt kommando"; # meddelande när # ogiltigt kommmando skrivs $unknownnick_msg = "ogiltigt namn"; # meddelande när ogiltigt namn skrivs $help_msg=" kommandon:
/msg namn meddelande - skickar privat meddelande till namn
/help - denna hjälptext
/about - om detta program
/me - action
/list_nicks adminlösenord - visar alla användare (online eller inte)
/clean_old_nicks adminlösenord xxx - raderar alla användare som inte besökt chatten på xxx dagar
/remove_nick adminlösenord namn - raderar namn"; # meddelande som visas på kommandot /help $about_msg = "skapat och copyright av Ralf Gueldemeister. Modifierat, ändrat och översatt till svenska av Dusan Ilic."; # meddelande som visas på kommandot /about $welcome_msg = "Välkommen till Fatal Zone's WebChat!
/help - hjälptext"; # meddelande som visas när användare loggar in $masterpassword = "lösenord"; # lösenord för speciella kommandon $wrongmasterpass_msg = "ogiltigt adminlösenord"; # meddelande som dyker upp när fel lösenord används $updatefrequence = 5; # nummer av sekunder när chatten uppdaterar sig själv $clear_old_msgs = 1; # sätt denna variabel till 1 om du vill att meddelanden ska tömmas från chatten när den töms från användare. $nocleantime_msg = "ange antal dagar i siffror"; # om inget nummer av dagar angett vid kommandot /clean_old_nicks $leave_url = "chat.cgi"; # url:en vart användaren skall gå till när han trycker på 'logga ut'-knappen $message_limit = 20; # högst antal meddelanden i chat fönstret. $new_msg_on_top = 0; # Byt ut 0 mot 1 om du vill att nya meddelanden ska klistras in längst upp i chat fönstret. # Filer - behöver inte ändras, bara om du vill ha flera scripts # som använder t.ex samma användarfil men olika meddelande filer. Så att du kan använda # scriptet för flera chatrum. $data_msg_file="messages"; $data_stillalive_file="stillalive"; $data_private_file="private"; # utan .user $data_nicks_file="nicks"; # du bör lämna denna, annars måste användaren registrera sig på varje script # HTML DEL # ######################## # WILLKOMMEN.HTML - Login sidan sub willkommen_html { print << "[END]";

TXFWO Chat - Login

registrera nytt namn

[END] } #REGISTER.HTML - Registrera användarnamn, lösenord och e-mail sub register_html { print <<"[END]";

Registrera Nytt Namn

[END] } #EXISTINGNICK.HTML - Användarnamnet är upptaget sub existingnick_html { print <<"[END]";

Namn redan registrerat

testa ett annat namn [END] } #NICKCREATED.HTML - Användarnamnet är skapat sub nickcreated_html { print <<"[END]";

Ditt namn är nu registrerat

login [END] } #WRONGPASS.HTML - Ogiltigt lösenord sub wrongpass_html { print <<"[END]";

Ogiltigt Lösenord

försök igen [END] } #NONICK.HTML - Ogiltigt användarnamn sub nonick_html { print <<"[END]";

Namn ej hittat

registrera eller
testa ett annat namn [END] } #CHATFRAMES.HTML - När du loggat in sub chatframes_html { print ""; print " "; print " "; print " "; print " "; print " "; print " "; print " "; print ""; print ""; } #CHATINPUT.HTML - Skicka meddelande, ändra inställningar och logga ut sub chatinput_html { print ""; print " "; print " "; print ""; print ""; } #BANNER.HTML - Översta framen, här ligger en annons sub banner_html { print <<"[END]";

[END] } #STILLALIVE.HTML - Listan med inloggade användare sub stillalive_html_header { print ""; print " "; print ""; } sub stillalive_html_footer { print ""; } #CHAT.HTML - Meddelandeframen sub chat_html_header { print ""; print " "; print ""; } sub chat_html_footer { print ""; } #ILLEGAL_NICK.HTML - När användarnamn innehåller ogiltiga tecken och symboler sub illegal_nick_html { print ""; print ""; print " "; print "

Ogiltigt Namn

"; print "Ditt namn \"$query{'name'}\" innehåller förbjudna tecken
Ett namn får inte innehålla \" \", \";\", tabs eller returns."; print "försök igen"; print " "; } #ILLEGAL_PASS.HTML - När lösenord innehåller ogiltiga tecken och symboler sub illegal_pass_html { print <<"[END]";

Ogiltigt Lösenord

försök igen [END] } #OPTIONS.HTML - Inställningar sub options_html { print ""; print ""; print " "; print "

Inställningar

"; print "

"; print " "; print " "; print " "; print " "; print " "; print " "; print " "; print "

Uppdaterings Intervall (sek):
Textfärg:
Meddelande Ordning

"; print " "; print "

"; print " "; } # HTML DEL SLUT # ####################### # HUVUDDEL - ÄNDRA INGET HÄR! # ####################### $version = "0.9"; # don't change $lastmodified = "24.04.99"; # don't change $about_msg = "created and copyright by Ralf Gueldemeister \<ralfg\@bigfoot.com> on 25.12.98; last modified on $lastmodified; Version $version"; # msg printed on /about &getquery; &action; # Fuehrt je nach action variable gegebene sub aus # action im FORM definieren! exit; sub action { if ($qs eq "") { # Wenn query_string leer sprung zum &welcome; # welcome-teil, 1st visit seite } elsif ($query{'action'} eq "register") { ®ister; } elsif ($query{'action'} eq "login") { &login; } elsif ($query{'action'} eq "create_nick") { &create_nick; } elsif ($query{'action'} eq "chatinput_html") { &header; &chatinput_html; } elsif ($query{'action'} eq "stillalive") { &stillalive; } elsif ($query{'action'} eq "chat") { &chat; } elsif ($query{'action'} eq "postmsg") { &postmsg; } elsif ($query{'action'} eq "banner") { &header; &banner_html; } elsif ($query{'action'} eq "options_html") { &header; &options_html; } elsif ($query{'action'} eq "setoptions") { &setoptions; } elsif ($query{'action'} eq "gotourl") { &gotourl; } else { &error; } } sub extract_qs { # einzelne variablen aus query_string extrahieren und in hash $query uebergeben @split = split (/&/, $qs); foreach $split (@split) { ($query_key, $query_value) = split (/=/, $split); $query_value =~ tr/+/ /; $query_value =~ s/%([\dA-Fa-f][\dA-Fa-f])/ pack ("C", hex ($1))/eg; $query{$query_key} = $query_value; } } sub welcome { # Aufruf beim ersten Programmstart &header; &willkommen_html; } sub login { # Loginprozedur # check login name+password if (-e "$data_dir/$data_nicks_file") { # wenn nickfile existiert dann oeffnen open (NICKFILE, "<$data_dir/$data_nicks_file") || &error("::open $data_dir/$data_nicks_file failed::"); } else { # sonst nonick_html &header; &nonick_html; exit; } my @nickfile = ; # Daten aus nickfile an @nickfile uebergeben close NICKFILE; # nickfile schliessen &make_matrix(@nickfile); # nickfile -> matrix for ($i=0; $i<=$#matrix; $i++) { if ($matrix[$i][0] eq $query{'name'}) { if ($matrix[$i][1] eq $query{'password'}) { # update last visited var $matrix[$i][4] = time; open (NICKFILE, ">$data_dir/$data_nicks_file"); flock(NICKFILE,2); for ($i2=0; $i2<=$#matrix; $i2++) { print NICKFILE &join_matrix."\n"; } # flock(NICKFILE,8); close NICKFILE; if ($clear_old_msgs == 1) { &clear_old_msgs_sub; } if ($matrix[$i][5] ne "") { $query{'updatefrequence'} = $matrix[$i][5]; $query{'color'} = $matrix[$i][6]; $query{'new_msg_on_top'} = $matrix[$i][9]; } else { $query{'updatefrequence'} = $updatefrequence; $query{'color'} = "standard"; $query{'new_msg_on_top'} = $new_msg_on_top; } &enterchat; # wenn beides richtig goto chat if ($welcome_msg ne "") { &postprivatemsg($query{'name'}, "WELCOME", $welcome_msg); } exit; # danach prozedur verlassen } else { &header; &wrongpass_html; exit; } } } # falls nick falsch nonick_html &header; &nonick_html; } sub enterchat { &header; &chatframes_html; } sub register { # neuen Nick + password + email abfragen &header; ®ister_html; } sub validate_string { # params: 0: string to validate # alle strings die spaces, semikolons oder steuerzeichen enthalten if ($_[0] =~ /[ ;\s]/ || $_[0] eq "") { return 1; # illegal string } else { return 0; # legal string } } sub create_nick { # neuen nick anlegen + weiterleiten zum chat if (&validate_string($query{'name'}) == 1) { # ueberpruefen ob nick illegale Zeichen enthaelt &header; &illegal_nick_html; exit; }; if (&validate_string($query{'password'}) == 1) { # ueberpruefen ob password illegale Zeichen enthaelt &header; &illegal_pass_html; exit; }; if (-e "$data_dir/$data_nicks_file") { # wenn nickfile existiert dann oeffnen open (NICKFILE, "<$data_dir/$data_nicks_file") || &error("::open $data_dir/$data_nicks_file failed::"); } else { # sonst erstellen &create_file("$data_dir/$data_nicks_file"); open (NICKFILE, "<$data_dir/$data_nicks_file") || &error("::open Nickfile failed::"); # und dann oeffnen } my @nickfile = ; # Daten aus nickfile an @nickfile uebergeben close NICKFILE; # nickfile schliessen &make_matrix(@nickfile); # does nick already exist? for ($i=0; $i<=$#matrix; $i++) { if ($matrix[$i][0] eq $query{'name'}) { &header; # wenn ja dann ausgabe existingnick.htm &existingnick_html; exit; } } # sonst fortfuehren der prozedur open (NICKFILE, ">>$data_dir/$data_nicks_file") || &error("open nickfile failed"); flock(NICKFILE,2); $nickdata[0] = $query{'name'}; # nickdaten zusammenfuehren $nickdata[1] = $query{'password'}; $nickdata[2] = $query{'email'}; $zeit = time(); $nickdata[3] = localtime($zeit); $nickdata[4] = time; $nickdata[5] = $updatefrequence; $nickdata[6] = "standard"; $nickdata[9] = $new_msg_on_top; $nickentry = join(';;', @nickdata); print NICKFILE "$nickentry\n"; # flock(NICKFILE,8); close NICKFILE; if (-e "$data_dir/$data_private_file.$query{'name'}") { } else { &create_file("$data_dir/$data_private_file.$query{'name'}"); } &header; &nickcreated_html; } sub create_file { # Datei erstellen (in Klammern als parameter zu uebergeben) $file2create = $_[0]; open (CREATEFILE, ">$file2create") || &error("creating $file2create failed"); close (CREATEFILE); } sub stillalive { # stillalive/who prozedur if (-e "$data_dir/$data_stillalive_file") { # SAfile oeffnen/erstellen } else { &create_file("$data_dir/$data_stillalive_file"); } open (SAFILE, "<$data_dir/$data_stillalive_file") || &error("opening safile failed"); flock(SAFILE,2); my $safile = ; # Daten aus safile an $safile uebergeben # flock(SAFILE,8); close SAFILE; @sa = split (/;;/, $safile); @sa = &repair_safile(@sa) if (($#sa+1) % 2 == 1); # wenn safile fehlerhaft -> repair $ownsaexists=0; for ($i=0; $i<=$#sa; $i+=2) { # eigenen Eintrag erneuern if ($sa[$i] eq $query{'name'}) { $sa[$i+1] = time; $ownsaexists=1; } } # Eintraege nach ueberfaelligen (aelter als 50s) durchsuchen und diese entfernen for ($i=1; $i<=$#sa; $i+=2) { if ($sa[$i] < (time - 50)) { # ist zeitstempel schon aelter als 50s? $sa[$i] = "//2delete"; $sa[$i-1] = "//2delete"; # zu loeschende eintraege mit //2delete ersetzten } } # alle Felder mit //2delete entfernen $templsa = $#sa; # Laenge von @sa wird in templsa gespeichert; for ($i=0; $i<=$templsa; $i++) { $temp = shift(@sa); if ($temp ne "//2delete") { push(@sa,$temp); } } # if no own sa entry exists -> add if ($ownsaexists != 1) { $sa[++$#sa] = $query{'name'}; $sa[++$#sa] = time; } $safile = join(';;', @sa); open (SAFILE, ">$data_dir/$data_stillalive_file") || &error("opening safile failed"); flock(SAFILE,2); print SAFILE $safile; # flock(SAFILE,8); close SAFILE; &header; &stillalive_html_header; $nrusers = ($#sa+1) / 2; $nrusers > 1 ? $s = "s" : $s=""; print "

$nrusers user$s online"; for ($i=0; $i<=$#sa; $i+=2) { print "$sa[$i]
"; } &stillalive_html_footer; } sub chat { # Chatprocedure: show Messages if (-e "$data_dir/$data_msg_file") { # CHATFILE oeffnen/erstellen } else { &create_file("$data_dir/$data_msg_file"); } &header; &chat_html_header; open (CHATFILE, "<$data_dir/$data_msg_file") || &error("opening chatfile failed"); flock(CHATFILE,2); my @chatfile = ; # flock(CHATFILE,8); close CHATFILE; # Ausgabe Messages foreach(@chatfile) { while ($_ =~ /"; # flock(CHATFILE,8); close CHATFILE; } sub checkpass { if (-e "$data_dir/$data_nicks_file") { # wenn nickfile existiert dann oeffnen open (NICKFILE, "<$data_dir/$data_nicks_file") || &error("::open Nickfile failed::"); } else { # else print nonick_html &header; &nonick_html; exit; } my @nickfile = ; close NICKFILE; &make_matrix(@nickfile); for ($i=0; $i<=$#matrix; $i++) { if ($matrix[$i][0] eq $query{'name'}) { $nickok = 1; if ($matrix[$i][1] ne $query{'password'}) { &header; &wrongpass_html; exit; } } } if ($nickok != 1) { &header; &nonick_html; exit; } } sub help { &postprivatemsg($query{'name'}, "HELP", $help_msg); } sub me_action { # parameter 0: wer 1: was open (CHATFILE, ">>$data_dir/$data_msg_file"); flock(CHATFILE,2); print CHATFILE "* $_[0] $_[1]\n"; # flock(CHATFILE,8); close CHATFILE; } sub about { &postprivatemsg($query{'name'}, "ABOUT", $about_msg); } sub list_nicks { open (NICKFILE, "<$data_dir/$data_nicks_file") || &error("::open Nickfile failed::"); my @nickfile = ; # Daten aus nickfile an @nickfile uebergeben close NICKFILE; # nickfile schliessen $nicklist = " "; for (@nickfile) { $_ =~ s/\n//g; my @nickfileentry = split(/;;/, $_); $nicklist = $nicklist." "; } $nicklist = $nicklist."

Nickname eMail Created on last visited
".$nickfileentry[0]." ".$nickfileentry[2]." ".$nickfileentry[3]." ".localtime($nickfileentry[4])."
"; &postprivatemsg($query{'name'}, "LIST_NICKS", $nicklist); } sub error { # Irgendein Fehler ist aufgetreten &header; print "
An error occured
"; print "Query_String: $qs
"; print "Errormessage: $_[0]"; exit; } sub header { # Gibt standard html header aus print "Content-type: text/html\n\n"; } sub clear_old_msgs_sub { # safile einlesen if (-e "$data_dir/$data_stillalive_file") { # SAfile oeffnen open (SAFILE, "<$data_dir/$data_stillalive_file") || &error("opening safile failed"); my $safile = ; # Daten aus safile an $safile uebergeben close SAFILE; @sa = split (/;;/, $safile); # Eintraege nach ueberfaelligen (> 50) durchsuchen und diese entfernen my $coms_i = 0; for ($coms_i=1; $coms_i<=$#sa; $coms_i+=2) { if ($sa[$coms_i] < (time - 50)) { # ist zeitstempel schon aelter als 50s? $sa[$coms_i] = "//2delete"; $sa[$coms_i-1] = "//2delete"; # zu loeschende eintraege mit //2delete ersetzten } } # alle Felder mit //2delete entfernen $templsa = $#sa; # Laenge von @sa wird in templsa gespeichert; for ($coms_i=0; $coms_i<=$templsa; $coms_i++) { $temp = shift(@sa); if ($temp ne "//2delete") { push(@sa,$temp); } } # wenn laenge von safile < 0 (chat empty) dann chatfile leeren if ($#sa < 0) { if (-e "$data_dir/$data_msg_file") { # CHATFILE oeffnen open (CHATFILE, ">$data_dir/$data_msg_file") || &error("opening chatfile failed"); print CHATFILE ""; close CHATFILE; } } } } sub clean_old_nicks { # clear all old nicks older than $_[0] open (NICKFILE, "<$data_dir/$data_nicks_file") || &error("::open $data_dir/$data_nicks_file failed::"); my @nickfile = ; close NICKFILE; &make_matrix(@nickfile); $removed_users=0; for ($i=0; $i<=$#matrix; $i++) { if ($matrix[$i][4] < (time - $_[0]6060*24)) { # ist zeitstempel schon aelter als $_[0] tage &postprivatemsg("$query{'name'}","CLEAN_OLD_NICKS","User $_[0] removed"); system 'rm', "$data_dir/$data_private_file.$matrix[$i][0]"; # deletes private file $removed_users++; $matrix[$i] = "//2delete"; } } # alle Felder mit //2delete entfernen $templmatrix = $#matrix; # Laenge von @sa wird in templsa gespeichert; for ($i=0; $i<=$templmatrix; $i++) { $temp = shift(@matrix); if ($temp ne "//2delete") { push(@matrix,$temp); } } open (NICKFILE, ">$data_dir/$data_nicks_file"); flock(NICKFILE,2); for ($i2=0; $i2<=$#matrix/2; $i2++) { print NICKFILE &join_matrix."\n"; } # flock(NICKFILE,8); close NICKFILE; &postprivatemsg("$query{'name'}","CLEAN_OLD_NICKS","$removed_users users removed"); } sub setoptions { if ($query{'updatefrequence'}<1 || $query{'updatefrequence'} eq "") { $query{'updatefrequence'}=$updatefrequence; } open (NICKFILE, "<$data_dir/$data_nicks_file") || &error("::open $data_dir/$data_nicks_file failed::"); my @nickfile = ; # Daten aus nickfile an @nickfile uebergeben close NICKFILE; # nickfile schliessen &make_matrix(@nickfile); for ($i=0; $i<=$#matrix; $i++) { if ($matrix[$i][0] eq $query{'name'}) { $matrix[$i][5] = $query{'updatefrequence'}; $matrix[$i][6] = $query{'color'}; $matrix[$i][9] = $query{'new_msg_on_top'}; open (NICKFILE, ">$data_dir/$data_nicks_file"); flock(NICKFILE,2); for ($i2=0; $i2<=$#matrix; $i2++) { print NICKFILE &join_matrix."\n"; } # flock(NICKFILE,8); close NICKFILE; } } &header; &chatframes_html; } sub remove_nick { # $_[0] = nick to remove open (NICKFILE, "<$data_dir/$data_nicks_file") || &error("::open $data_dir/$data_nicks_file failed::"); my @nickfile = ; close NICKFILE; &make_matrix(@nickfile); for ($i=0; $i<=$#matrix; $i++) { if ($matrix[$i][0] eq $_[0]) { # ist nick = nick to remove $matrix[$i] = "//2delete"; $userfound=1; } } # alle Felder mit //2delete entfernen $templmatrix = $#matrix; # Laenge von @sa wird in templsa gespeichert; for ($i=0; $i<=$templmatrix; $i++) { $temp = shift(@matrix); if ($temp ne "//2delete") { push(@matrix,$temp); } } open (NICKFILE, ">$data_dir/$data_nicks_file"); flock(NICKFILE,2); for ($i2=0; $i2<=$#matrix/2; $i2++) { print NICKFILE &join_matrix."\n"; } if ($userfound == 1) { system 'rm', "$data_dir/$data_private_file.$_[0]"; # deletes private file &postprivatemsg("$query{'name'}","REMOVE_NICK","User $_[0] removed"); } else { &postprivatemsg("$query{'name'}","REMOVE_NICK","User $_[0] doesnot exist"); } } sub getquery { if ($ENV{'REQUEST_METHOD'} eq "GET") { $qs= $ENV{'QUERY_STRING'}; # Wert vom query_string wird in $qs gespeichert } elsif ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $qs, $ENV{'CONTENT_LENGTH'}); } &extract_qs; # einzelne variablen aus querystring auslesen } sub gotourl { &header; print ""; print " "; print "please wait

"; print ""; } sub extract_string { @split = split (/&/, $_[0]); foreach $split (@split) { ($string_key, $string_value) = split (/=/, $split); $extract_string{$string_key} = $string_value; } } sub make_matrix { $i = 0; foreach (@_) { $i++; chomp; push @matrix, [split(/;;/, $_)]; } return $i; } sub join_matrix { join(';;', $matrix[$i2][0],$matrix[$i2][1],$matrix[$i2][2],$matrix[$i2][3],$matrix[$i2][4],$matrix[$i2][5],$matrix[$i2][6],$matrix[$i2][7],$matrix[$i2][8],$matrix[$i2][9],$matrix[$i2][10]); } sub repair_safile { $i=0; for (@sa) { if (/[A-Za-z]/) { $satemp[$i]=$_; $i++; } } $i=0; for (@satemp) { $satemp2[$i*2] = $satemp[$i]; $satemp2[$i*2+1] = time; $i++; } @sa = @satemp2; $#sa % 2 == 1 ? return @sa : &error("safile corrupt"); } # END Main Part # ##############################