· 9 years ago · Oct 30, 2016, 10:14 PM
1#!/usr/bin/perl
2
3=pod
4Note: This is a modified version from "Friendly Script Updater".
5/####################################################################
6# #
7# # ##### #### # # ### ##### /\_/\ #
8# # # # # # # # # ( o.o ) #
9# # ### # ##### ##### # > ^ < #
10# # # # # # # # # v1.20 #
11# ##### ##### #### # # # # # 2015-07 #
12# #
13# Installation instructions: #
14# #
15# Upload this file into your cgi-bin directory (you can rename it #
16# to whatever you want, if you prefer) and make it executable #
17# (chmod 711). If you have language data or backups you want to #
18# restore initially, you can copy that all into a textfile named #
19# "lechat.txt" and put it next to your script file on the server. #
20# Then call the script in your browser with parameter like this: #
21# #
22# http://(server)/(cgi-path)/(script-name).cgi?action=setup #
23# #
24# All necessary installation settings can be made from there. #
25# The server needs to support Perl CGI scripts, obviously. If you #
26# have trouble, make sure the file is uploaded in ASCII-mode and #
27# Perl scripts are allowed to create files and folders. #
28# Banner killers for some known hosts are built in, please report #
29# back any problems there or any other hosts you want added! #
30# #
31# If you make translations and want to share them, please send me #
32# a copy of the backup data for my website, thanks! All text can #
33# be edited conveniently as superuser on the setup page. #
34# #
35# This script comes without any warranties. Use it at your own #
36# risk, don't blame me for any modifications you make. Verify my #
37# attached PGP-signature, to make sure you got the original and #
38# not an altered copy! Really, do verify it! #
39# If you spread the script, please only give away the original, #
40# or better, just refer to: http://4fvfamdpoulu2nms.onion/lechat/ #
41# #
42# If you add your own cool features and want to share with others, #
43# feel free, but please modify at least the version tag and add #
44# your name to it, so it is clear that it is not my original code #
45# anymore. If you send me a copy of your edited script, I might #
46# use some of your ideas in future versions. Thank you! #
47# #
48# I wrote the script from scratch and all the code is my own, but #
49# as you may notice, I took some ideas from other scripts that #
50# are out there. Bug reports and feedback are very welcome. #
51# #
52# The "LE" in the name you can take as "Lucky Eddie", or since #
53# the script was meant to be lean and easy on server resources, #
54# as "Light Edition". It may even be the french word for "the" if #
55# you prefer. Translated from french to english, "le chat" means: #
56# "the cat". #
57# #
58# Other than that, enjoy! ;) #
59# #
60# Lucky Eddie #
61# #
62# Edit: This is a revision of the script added features are: #
63# -Added in-line moderation: #
64# -"/kick [message]:[user]" //Kick [user] with the [message] #
65# -"/delmess [user]" //Deletes all users messages #
66# -"/clean room" //Clears the rooms messages #
67# -"/logout [user]" //Logs out [user] #
68# -"/name [user]" // Adds user to banned name list. #
69# #
70# - Fixed some html errors to make the script a tad bit faster #
71# - Centered everything for continuity. #
72# - When the user presses delete all it will ask for comfirmation #
73# - Added Links #
74# -The /[command] only works when the user is admin or mod #
75# #
76# - Added Link Shortener #
77# - Updated Rules & Help #
78# -Included in-line moderation changes explaination #
79# -Added list of included emojis #
80# #
81# - Name fliter intergration to block unwanted names #
82# -When using the /name command it adds the name to a list #
83# -Before someone gains access to the chat it checks the name #
84# -Full number names are also blocked. #
85# #
86####################################################################/
87=cut
88
89use strict;
90use warnings;
91use Fcntl qw(:DEFAULT :flock);
92
93######################################################################
94# Data directory, could be changed, but shouldn't be necessary.
95######################################################################
96my $datadir='./lcdat';
97
98######################################################################
99# No need to change anything below. Always use: *.cgi?action=setup
100######################################################################
101my($version,$lastchanged)=('v1.20 FSU','2015-07');
102my($S,%Q)=(&GetScript,&GetQuery,&GetParam);
103my %T;# Test flags
104my %U;# this User data
105my %P;# all Present users (nick=>[hex,status,style])
106my %A;# All registered members (nick=>[hex,status,style])
107my @M;# Members: display names
108my @G;# Guests: display names
109my %F;# Fonts
110my %I;# Internal texts and error messages
111my %L;# Language editing
112my %C;# Configuration
113my %H;# HTML-stuff
114load_config();
115
116######################################################################
117# main program: decide what to do based on queries
118######################################################################
119if($Q{action}[0]eq'setup'){
120 send_init() unless -e"$datadir/admin";
121 send_alogin() unless valid_admin($Q{nick}[0],$Q{pass}[0],$Q{hexpass}[0]);
122 if($Q{do}[0]eq'config'){
123 set_config();
124 save_config();
125 }elsif($Q{do}[0]eq'chataccess'){
126 set_chat_access($Q{set}[0]);
127 }elsif($Q{do}[0]eq'backup'){
128 $I{backdat}=get_backup($Q{what}[0]);
129 }elsif($Q{do}[0]eq'restore'){
130 $I{backdat}=get_restore_results();
131 }elsif($Q{do}[0]eq'mainadmin'and$U{status}==9){
132 send_setup(change_admin_status());
133 }elsif($Q{do}[0]eq'resetlanguage'and$U{status}==9){
134 delete_file('language');
135 load_config();
136 }
137 send_setup();
138}
139elsif($Q{action}[0]eq'init' and !-e"$datadir/admin"){
140 init_chat();
141}
142elsif($Q{action}[0]eq'language'){
143 send_alogin() unless valid_admin($Q{nick}[0],$Q{pass}[0],$Q{hexpass}[0])==2;
144 save_langedit()if$Q{do}[0]eq'save';
145 $I{backdat}=get_restore_results('langedit')if$Q{do}[0]eq'restore';
146 load_langedit();
147 $I{backdat}=get_backup('langedit')if$Q{do}[0]eq'backup';
148 send_language();
149}
150elsif($T{access}==0){
151 send_suspended();
152}
153elsif($Q{action}[0]eq'redirect'){
154 send_redirect($Q{url}[0]);
155}
156elsif($T{access}!=1){
157 send_suspended();
158}
159elsif($Q{action}[0]eq'wait'){
160 check_waiting_session();
161 send_waiting_room();
162}
163elsif($Q{action}[0]eq'view'){
164 check_session();
165 send_messages();
166}
167elsif($Q{action}[0]eq'post'){
168 if($Q{message}[0]=~/^\s*$/){
169 check_session()
170 }
171 else{
172 update_session();
173 validate_input();
174 if($U{status}>=6 and $U{message}=~m/^\//){
175 send_command();
176 }
177 else{
178 add_message() unless $U{autokick}==3;
179 }
180 del_all_messages() if $U{autokick}==3;
181 kick_chatter($U{nickname},$U{kickmessage}) if $U{autokick} and $U{status}<6;
182 if($U{autokick} and $U{status}>=6){
183 $U{message}="$I{kickfilter}";
184 $U{message}.=" ($U{kickmessage})" if $U{kickmessage};
185 add_staff_message();
186 }
187 }
188 send_post();
189}
190elsif($Q{action}[0]eq'delete'){
191 check_session();
192 del_all_messages() if $Q{what}[0]eq'all';
193 del_last_message() if $Q{what}[0]eq'last';
194 if ($Q{what}[0] eq 'check'){
195 send_check();
196 }
197 else{send_post();}
198}
199elsif($Q{action}[0]eq'login'){
200 create_session();
201 send_frameset();
202}
203elsif($Q{action}[0]eq'upload'){
204 check_session();
205
206}
207elsif($Q{action}[0]eq'controls'){
208 check_session();
209 send_controls();
210}
211elsif($Q{action}[0]eq'profile'){
212 if($Q{do}[0]eq'save'){save_profile()}else{check_session()}
213 send_profile();
214}
215elsif($Q{action}[0]eq'entry'){
216 check_session();
217 send_entry();
218}
219elsif($Q{action}[0]eq'logout'){
220 kill_session();
221 send_logout();
222}
223elsif($Q{action}[0]eq'colours'){
224 check_session();
225 send_colours();
226}
227elsif($Q{action}[0]eq'help'){
228 check_session();
229 send_help();
230}
231elsif($Q{action}[0]eq'links'){
232 send_links() && check_session() if $C{linksswitch}==1;
233}
234elsif($Q{action}[0]eq'admin'){
235 check_session();
236 send_login() unless $U{status}>=6;
237 if($Q{do}[0]eq'clean'){
238 send_choose_messages() if $Q{what}[0]eq'choose';
239 clean_selected() if $Q{what}[0]eq'selected';
240 clean_room() if $Q{what}[0]eq'room';
241 send_messages();
242 }
243 elsif($Q{do}[0]eq'kick'){
244 send_admin() if $Q{name}[0]eq'bla';
245 unless(kick_chatter(pack('H*',$Q{name}[0]),$Q{kickmessage}[0])){
246 $I{errcantkick}=~s/<NICK>/pack('H*',$Q{name}[0])/e;
247 send_admin($I{errcantkick});
248 }
249 del_all_messages(pack('H*',$Q{name}[0])) if $Q{what}[0]eq'purge';
250 check_session();
251 send_messages();
252 }
253 elsif($Q{do}[0]eq'logout'){
254 send_admin() if $Q{name}[0]eq'';
255 unless(logout_chatter(pack('H*',$Q{name}[0]))){
256 $I{errcantlogout}=~s/<NICK>/pack('H*',$Q{name}[0])/e;
257 send_admin($I{errcantlogout});
258 }
259 check_session();
260 send_messages();
261 }
262 elsif($Q{do}[0]eq'sessions'){
263 send_sessions();
264 }
265 elsif($Q{do}[0]eq'guests'){
266 set_guests_access($Q{set}[0]) if($U{status}>=7 or $Q{set}[0]==0);
267 }
268 elsif($Q{do}[0]eq'register'){
269 register_guest();
270 check_session();
271 send_messages();
272 }
273 elsif($Q{do}[0]eq'status'){
274 change_status();
275 }
276 elsif($Q{do}[0]eq'regnew'){
277 register_new();
278 }
279 elsif($Q{do}[0]eq'newcomers' and $U{status}>=7){
280 edit_waiting_sessions($Q{what}[0]);
281 send_waiting_admin();
282 }
283 send_admin();
284}
285else{
286 send_login();
287}
288exit;
289
290######################################################################
291# html output subs
292######################################################################
293
294sub print_headers{print "Content-Type: text/html; charset=$H{encoding}\nContent-Language: $I{languagecode}\nPragma: no-cache\nExpires: 0\n"}
295sub print_stylesheet{print qq|\n<style type="text/css"><!--\n$C{cssglobal}\n|,$C{'css'.$_[0]},"\n$H{add_css}--></style>\n";}
296sub print_end{print $H{end_body},$H{end_html};exit}
297sub frmpst{"<$H{form}>".hidden('action',$_[0]).hidden('session',$U{session}).($_[1]?hidden('what',$_[1]).hidden('sendto',$Q{sendto}[0]).hidden('multi',$Q{multi}[0]):'')}
298sub frmlng{"<$H{form}>".hidden('action','language').hidden('nick',$Q{nick}[0]).hidden('hexpass',$Q{hexpass}[0]||unpack('H*',$Q{pass}[0])).($_[0]?hidden('do',$_[0]):'')}
299sub frmset{"<$H{form}>".hidden('action','setup').hidden('nick',$Q{nick}[0]).hidden('hexpass',$Q{hexpass}[0]||unpack('H*',$Q{pass}[0])).($_[0]?hidden('do',$_[0]):'').($_[1]?hidden('what',$_[1]):'')}
300sub frmadm{"<$H{form}>".hidden('action','admin').hidden('do',$_[0]).hidden('session',$U{session})}
301sub hidden{qq|<input type="hidden" name="$_[0]" value="$_[1]">|}
302sub submit{qq|<input type="submit" value="$_[0]"$_[1]>|}
303sub thr{'<tr><td'.($_[0]?qq| colspan="$_[0]"|:'').'><hr></td></tr>'}
304sub cfgyn{qq|<tr><td align="left">$I{$_[0]}</td><td align="right"><input type="radio" name="$_[0]" id="$_[0]1" value="1"|.($C{$_[0]}?' checked':'').qq|><label for="$_[0]1"> $I{yes}</label> <input type="radio" name="$_[0]" id="$_[0]0" value="0"|.($C{$_[0]}?'':' checked').qq|><label for="$_[0]0"> $I{no}</label></td></tr>|}
305sub cfgta{qq|<tr><td align="left" valign="top">$I{$_[0]}</td><td align="right"><textarea name="$_[0]" rows="4" cols="40" wrap="off">$C{$_[0]}</textarea></td></tr>|}
306sub cfgt{qq|<tr><td align="left">$I{$_[0]}</td><td align="right"><input type="text" name="$_[0]" value="$C{$_[0]}" size="$_[1]"|.($_[2]?qq| maxlength="$_[2]"|:'').qq|></td></tr>|}
307sub cfgts{cfgt($_[0],'7','6')}
308sub cfgtm{cfgt($_[0],'30')}
309sub cfgtb{cfgt($_[0],'50')}
310
311sub print_start{my($css,$ref,$url)=@_;
312 $url=~s/&/&/g if$url;# Don't escape "&" in URLs here, it breaks some (older) browsers!
313 print_headers();
314 print "Refresh: $ref; URL=$url\n"if$url;
315 print "$H{begin_html}<head>$H{meta_html}";
316 print qq|\n<meta http-equiv="Refresh" content="$ref; URL=$url">|if$url;
317 print_stylesheet($css);
318 print '</head>',$H{begin_body};
319}
320
321sub linkrel{
322 return unless $_[0];
323 my($itype)=($_[0]=~/(?:data:image\/|\.)(x-icon|ico|gif|png)(?:;|$)/);
324 $itype='x-icon'if'ico'eq$itype;
325 $itype=qq| type="image/$itype"|if$itype;
326 return qq|<link rel="shortcut icon" href="$_[0]"$itype>\n|;
327}
328
329sub send_redirect{my $href=$_[0];
330 # Link redirection to strip off referers and prevent session leakage.
331 if($T{access}==1 and (!$C{createlinks} or $C{useextderef})){
332 print_start('error');
333 print "<h2>$I{errnolinks}</h2>";
334 print_end();
335 }
336 # check for protocol, assume http if none given and correct the link accordingly.
337 my ($scheme)=$href=~m~^([\w]*://|mailto:)~;
338 if($scheme eq ''){$scheme='http://';$href=$scheme.$href}
339 # Only do automatic refresh on http, else just give links
340 if($scheme eq 'http://'){
341 print_start('view',0,$href);
342 print qq|<center><h2>$I{linkredirect}</h2><a href="$href">$_[0]</a></center>|;
343 }else{
344 $href=~s~^([\w]*://)?~http://~;
345 print_start('view');
346 print qq|<center><h2>$I{linknonhttp}</h2><a href="$_[0]">$_[0]</a><h2>$I{linktryhttp}</h2><a href="$href">$href</a></center>|;
347 }
348 print_end();
349}
350
351sub send_alogin{
352 print_start('admin');
353 print qq|<center><$H{form}>|,hidden('action','setup'),qq|<table><tr><td align="left">$I{aloginname}</td><td><input type="text" name="nick" size="25"></td></tr><tr><td align="left">$I{aloginpass}</td><td><input type="password" name="pass" size="25"></td></tr><tr><td colspan="2" align="right">|,submit($I{aloginbut}),qq|</td></tr></table></form></center>|;
354 print_end();
355}
356
357sub send_language{
358 print_start('admin');
359 print qq|<center><h1>$I{lngheader}</h1><br><table cellspacing="0"><tr><td align="left"><table cellspacing="0"><tr><td>|,frmlng('backup'),submit($I{lngbackup}),qq|</form></td><td> ⇓</td></tr></table></td></tr><tr><td>|,frmlng('restore'),qq|<table cellspacing="0"><tr><td><textarea name="backupdata" rows="8" cols="80" wrap="off">$I{backdat}\n</textarea></td></tr><tr><td align="right"><table cellspacing="0"><tr><td> ⇒</td><td>|,submit($I{lngload}),qq|</td></tr></table></td></tr></table></form></td></table><br>|,frmlng('save'),qq|<table cellspacing="0" cellpadding="5" width="1"><tr><td colspan="2" align="left">$I{lnghelp}</td></tr><tr><td align="left"><h2>$I{lngtoken}</h2></td><td align="left"><h2>$I{lngdeftxt}</h2></td></tr><tr><td colspan=2 align="left"><hr></td></tr>|;
360 my $start=tell(DATA);
361 while(<DATA>){
362 if($_=~/^#/){
363 my ($sect)=$_=~/^#\s*(.+)/;
364 print qq|<tr><td colspan="2" align="left"><hr></td></tr><tr><td colspan="2" align="left"><h3>$sect</h3></td></tr>|;
365 }else{
366 my($ikey,$ival)=$_=~/^([a-z_]+)\s*=(.+)/i;
367 if($ikey and 'stop_action'ne$ikey){
368 $I{$ikey}=$ival;
369 my $rows=int(length($ival)/75)+1;
370 $ival=formsafe($ival);
371 $L{$ikey}=formsafe($L{$ikey});
372 my $iinp=qq|<textarea rows="$rows" cols="75" name="$ikey" wrap="virtual">$L{$ikey}</textarea>|;
373 print qq|<tr><td valign="top" align="left">$ikey</td><td valign="top" align="left">$ival<br>$iinp</td></tr>|;
374 }
375 }
376 }
377 seek(DATA,$start,0);
378 print qq|<tr><td colspan="2" align="left"><hr></td></tr><tr><td colspan="2" align="center">|,submit($I{savechanges}),qq|</td></tr></table></form><br>$H{backtosetup}<br>$H{versiontag}</center>|;
379 print_end();
380}
381
382sub send_check{
383 $U{postid}=substr($^T,-6);
384 print_start('post');
385 print '<center><table cellspacing="4"><tr><td valign="top">Are you sure you want to delete all your messages?</td><td valign="top"></td>';
386 print '</select></td></tr></table></form></td></tr><tr><td height="4"></td></tr><tr><td align="center"><table cellspacing="10"><tr><td>',frmpst('delete','last'),submit($I{butdellast},qq| style="$C{styledellast}"|),'</form></td><td>',frmpst('delete','all'),submit($I{butdelall},qq| style="$C{styledelall}"|),'</form><td>';
387 print '</tr></table></td></tr></table></center>';
388 print_end();
389}
390
391sub send_setup{
392 read_members()if($U{status}==9);
393 print_start('admin');
394 $I{nickhelp}=~s/<MAX>/$C{maxname}/;
395 $I{passhelp}=~s/<MIN>/$C{minpass}/;
396 foreach(keys %C){next if $_ eq 'textfilters';$C{$_}=formsafe($C{$_})}
397 print qq|<center><h2>$I{chatsetup}</h2>|,frmset('chataccess'),qq|<table cellspacing="0"><tr><td><b>$I{chataccess}</b></td><td> </td><td><input type="radio" name="set" id="off" value="0"|,$T{access}==0?' checked':'',qq|></td><td><label for="off">$I{suspend}</label></td><td> </td><td><input type="radio" name="set" id="on" value="1"|,$T{access}==1?' checked':'',qq|></td><td><label for="on">$I{enabled}</label></td><td> </td><td><input type="radio" name="set" id="deref" value="2"|,$T{access}==2?' checked':'',qq|></td><td><label for="deref">$I{derefonly}</label></td><td> </td><td>|,submit($I{butset}),qq|</td></table></form><br><h2>$I{backups}</h2><table cellspacing="0"><tr><td align="left"><table cellspacing="0"><tr><td>|;
398 print frmset('backup','members'),submit($I{backmem}),qq|</form></td><td>⇓ </td><td>|,frmset('backup','config'),submit($I{backcfg}),qq|</form></td><td>⇓ </td></tr></table></td></tr><tr><td>|,frmset('restore'),qq|<table cellspacing="0"><tr><td><textarea name="backupdata" rows="8" cols="80" wrap="off">$I{backdat}\n</textarea></td></tr><tr><td align="right"><table cellspacing="0"><tr><td> ⇒</td><td>|,submit($I{restore}),qq|</td></tr></table></td></tr></table></form></td></tr></table><br>|;
399 if($U{status}==9){
400 print qq|<h2>$I{mainadmins}</h2><i>$_[0]</i><table cellspacing="0">|,thr(),qq|<tr><td align="left"><b>$I{regadmin}</b></td></tr><tr><td align="right">|,frmset('mainadmin','new'),qq|<table cellspacing="0"><tr title="$I{nickhelp}"><td> </td><td align="left">$I{nickname}</td><td><input type="text" name="admnick" size="20"></td><td> </td></tr><tr title="$I{passhelp}"><td> </td><td align="left">$I{password}</td><td><input type="text" name="admpass" size="20"></td><td>|,submit($I{butregadmin}),qq|</td></tr></table></form></td></tr>|,thr(),qq|<tr><td align="left"><b>$I{raiseadmin}</b></td></tr><tr><td align="right">|,frmset('mainadmin','up'),qq|<table cellspacing="0"><tr><td> </td><td><select name="admnick" size="1"><option value="">$I{selchoose}</option>|;
401 print_memberslist(7);
402 print qq|</select></td><td align="right">|,submit($I{butraise}),qq|</td></tr></table></form></td></tr>|,thr(),qq|<tr><td align="left"><b>$I{loweradmin}</b></td></tr><tr><td align="right">|,frmset('mainadmin','down'),qq|<table cellspacing="0"><tr><td> </td><td><select name="admnick" size="1"><option value="">$I{selchoose}</option>|;
403 print_memberslist(8);
404 print qq|</select></td><td>|,submit($I{butlower}),qq|</td></tr></table></form></td></tr>|,thr(),qq|</table><br><br><h2>$I{cfglanguage}</h2>|,frmlng(),submit($I{editlanguage}),qq|</form><br>|,frmset('resetlanguage'),submit($I{resetlanguage},-e"$datadir/language"?'':' disabled'),qq|</form><br><h2>$I{cfgsettings}</h2>$I{cfgmainadm}<br><br>|;
405 }else{
406 print "<h2>$I{cfgsettings}</h2>",frmset('config'),'<table cellspacing="0">',thr(2),cfgyn('redirifsusp'),cfgtm('redirtourl'),thr(2),cfgyn('allowfonts'),cfgyn('allowmultiline'),cfgyn('allowpms'),cfgyn('rndguestcol'),thr(2),cfgyn('createlinks'),cfgyn('useextderef'),cfgtm('extderefurl'),thr(2);
407 print_filters();
408 print thr(2),cfgts('sessionexpire'),cfgts('guestsexpire'),cfgts('messageexpire'),cfgts('kickpenalty'),cfgts('waitingexpire'),thr(2),cfgts('defaultrefresh'),cfgts('minrefresh'),cfgts('maxrefresh'),cfgts('floodlimit'),thr(2),
409 cfgts('boxwidthdef'),cfgts('boxheightdef'),cfgts('maxmessage'),cfgts('maxname'),cfgts('minpass'),thr(2),cfgtm('title'),cfgtm('favicon'),cfgtm('noguests'),cfgtm('loginbutton'),thr(2),cfgta('header'),cfgta('footer'),thr(2),cfgta('rulestxt'),cfgta('links'),cfgyn('linksswitch'),thr(2),cfgtb('nowchatting'),thr(2),cfgtb('entrymessage'),cfgtb('logoutmessage'),cfgtb('kickederror'),thr(2),
410 cfgtb('roomentry'),cfgtb('roomexit'),cfgtb('regmessage'),cfgtb('kickedmessage'),cfgtb('roomclean'),thr(2),cfgtb('mesall'),cfgtb('mesmem'),cfgtb('messtaff'),cfgtb('mespm'),thr(2),cfgts('colbg'),cfgts('coltxt'),cfgts('collnk'),cfgts('colvis'),cfgts('colact'),thr(2),
411 cfgta('cssglobal'),cfgtb('styleback'),thr(2),cfgta('csslogin'),cfgtb('stylelogintext'),cfgtb('stylecolselect'),cfgtb('styleenter'),thr(2),cfgta('csspost'),cfgtb('styleposttext'),cfgtb('stylepostsend'),cfgtb('stylesendlist'),cfgtb('styledellast'),cfgtb('styledelall'),cfgtb('styleswitch'),thr(2),
412 cfgta('cssview'),cfgtb('styledelsome'),cfgtb('stylecheckwait'),thr(2),cfgta('csswait'),cfgtb('stylewaitrel'),thr(2),cfgta('csscontrols'),cfgtb('stylerelpost'),cfgtb('stylerelmes'),cfgtb('styleprofile'),cfgtb('styleadmin'),cfgtb('stylerules'),cfgtb('styleexit'),thr(2),
413 cfgta('cssprofile'),thr(2),cfgta('cssrules'),thr(2),cfgta('cssadmin'),thr(2),cfgta('csserror'),thr(2),cfgtb('tableattributes'),cfgtb('frameattributes'),cfgtb('framesizes'),thr(2);
414 print qq|<tr><td colspan="2" align="center"><small>$I{lastchanged} $C{lastchangedat}/$C{lastchangedby}</small><br><br></td></tr><tr><td colspan="2" align="center">|,submit($I{savechanges}),'</td></tr></table></form><br>';
415 }
416 print "<$H{form}>",hidden('action','setup'),submit($I{butlogout}),"</form><br>$H{versiontag}</center>";
417 print_end();
418}
419
420sub send_admin{
421 read_members();
422 print_start('admin');
423 $I{admkick}=~s/<KICK>/$C{kickpenalty}/;
424 $I{nickhelp}=~s/<MAX>/$C{maxname}/;
425 $I{passhelp}=~s/<MIN>/$C{minpass}/;
426 my $chlist=qq|<select name="name" size="1"><option value="">$I{selchoose}</option>|;foreach(sort {lc($a) cmp lc($b)} keys %P){$chlist.=qq|<option value="$P{$_}[0]" style="$P{$_}[2]">$_</option>|if($P{$_}[1]>0 and $P{$_}[1]<$U{status})};$chlist.='</select>';
427 my @gset;$gset[$T{guests}]=' checked';$gset[4]=' disabled'if$U{status}<7;
428 print qq|<center><h2>$I{admheader}</h2><i>$_[0]</i><table cellspacing="0">|,thr(),qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{admclean}</b></td><td align="right">|,frmadm('clean'),qq|<table cellspacing="0"><tr><td> </td><td><input type="radio" name="what" id="room" value="room"></td><td align="left"><label for="room">$I{admcleanall}</label></td><td> </td><td><input type="radio" name="what" id="choose" value="choose" checked></td><td align="left"><label for="choose">$I{admcleansome}</label></td><td> </td><td>|,submit($I{butadmclean}),qq|</td></tr></table></form></td></tr></table></td></tr>|,thr(),qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{admkick}</b></td></tr><tr><td align="right">|,frmadm('kick'),qq|<table cellspacing="0"><tr><td> </td><td align="left" colspan="3">$I{admkickmes} <input type="text" name="kickmessage" size="45"></td><td> </td></tr><tr><td> </td><td align="left"><input type="checkbox" name="what" value="purge" id="purge" checked><label for="purge"> $I{admkickpurge}</label></td><td> </td><td align="right">$chlist</td><td>|,submit($I{butadmkick}),qq|</td></tr></table></form></td></tr></table></td></tr>|,thr(),qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{adminactive}</b></td><td align="right">|,frmadm('logout'),qq|<table cellspacing="0"><tr><td> </td><td valign="bottom">$chlist</td><td valign="bottom">|,submit($I{butadminactive}),qq|</td></tr></table></form></td></tr></table></td></tr>|,thr(),qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{admvsessions}</b></td><td align="right">|,frmadm('sessions'),qq|<table cellspacing="0"><tr><td> </td><td>|,submit($I{butadmview}),qq|</td></tr></table></form></td></tr></table></td></tr>|,thr(),qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{admguests}</b></td></tr><tr><td align="right">|,frmadm('guests'),qq|<table cellspacing="0"><tr><td> </td><td><input type="radio" name="set" id="set0" value="0"$gset[0]></td><td align="left"><label for="set0">$I{admguestsoff}</label></td><td> </td><td> </td></tr><tr><td> </td><td><input type="radio" name="set" id="set1" value="1"$gset[1]$gset[4]></td><td align="left"><label for="set1">$I{admguestson}</label></td><td> </td><td> </td></tr><tr><td> </td><td><input type="radio" name="set" id="set2" value="2"$gset[2]$gset[4]></td><td align="left"><label for="set2">$I{admguestsauto}</label></td><td> </td><td> </td></tr><tr><td> </td><td><input type="radio" name="set" id="set3" value="3"$gset[3]$gset[4]></td><td align="left"><label for="set3">$I{admguestsbell}</label></td><td> </td><td valign="bottom">|,submit($I{butadmset}),qq|</td></tr></table></form></table></td></tr>|,thr();
429 if($U{status}>=7){
430 print qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{admregguest}</b></td><td align="right">|,frmadm('register'),qq|<table cellspacing="0"><tr><td> </td><td valign="bottom"><select name="name" size="1"><option value="">$I{selchoose}</option>|;
431 foreach(sort {lc($a) cmp lc($b)} keys %P){print '<option value="',$P{$_}[0],'" style="',$P{$_}[2],'">',$_,'</option>'if $P{$_}[1]==1}
432 print qq|</select></td><td valign="bottom">|,submit($I{butadmreg}),qq|</td></tr></table></form></td></tr></table></td></tr>|,thr(),qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{admmembers}</b></td></tr><tr><td align="right">|,frmadm('status'),qq|<table cellspacing="0"><tr><td> </td><td valign="bottom" align="right"><select name="name" size="1"><option value="">$I{selchoose}</option>|;
433 print_memberslist();
434 print qq|</select><select name="set" size="1"><option value="">$I{selchoose}</option><option value="-">$I{selmemdelete}</option><option value="0">$I{selmemdeny} $I{symdenied}</option><option value="2">$I{selmemreg}</option><option value="6">$I{selmemmod} $I{symmod}</option>|;
435 print qq|<option value="7">$I{selmemadmin} $I{symadmin}</option>|if($U{status}==8);
436 print qq|</select></td><td valign="bottom">|,submit($I{butadmstatus}),qq|</td></tr></table></form></td></tr></table></td></tr>|,thr(),qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{admregnew}</b></td></tr><tr><td align="right">|,frmadm('regnew'),qq|<table cellspacing="0"><tr title="$I{nickhelp}"><td> </td><td align="left">$I{nickname}</td><td><input type="text" name="name" size="20"></td><td> </td></tr><tr title="$I{passhelp}"><td> </td><td align="left">$I{password}</td><td><input type="text" name="pass" size="20"></td><td valign="bottom">|,submit($I{butadmregnew}),'</td></tr></table></form></td></tr></table></td></tr>',thr();
437 }
438 print qq|</table>$H{backtochat}</center>|;
439 print_end();
440}
441
442sub send_sessions{
443 my @lines=parse_sessions(slurp_file('sessions',my$ferr));
444 send_error($ferr)if$ferr;
445 print_start('admin');
446 print qq|<center><h1>$I{admsessions}</h1><table border="0" cellpadding="5">|;
447 print qq|<thead valign="middle"><tr><th align="left"><b>$I{nicklist}</b></th><th align="center"><b>$I{timeoutin}</b></th><th align="center"><b>$I{ip}</b></th><th align="left"><b>$I{useragent}</b></th></tr></thead><tbody valign="middle">|;
448 foreach(@lines){
449 my %temp=sessionhash($_);
450 my $s=$temp{status}==2?'':' '.($temp{status}==0?$I{symdenied}:$temp{status}==1?$I{symguest}:$temp{status}==6?$I{symmod}:$temp{status}>=7?$I{symadmin}:'');
451 print '<tr><td align="left">',style_this($temp{nickname}.$s,$temp{fontinfo}),'</td><td align="center">'.get_timeout($temp{lastpost},$temp{status}),'</td><td align="center">',($U{status}>$temp{status}or$U{session}eq$temp{session})?qq|$temp{ip}</td><td align="left">$temp{useragent}|:'-</td><td align="left">-','</td></tr>';
452 }
453 print "</tbody></table><br>$H{backtochat}</center>";
454 print_end();
455}
456
457sub send_suspended{
458 print_start('error',0,$C{redirifsusp}?$C{redirtourl}:'');
459 print "<h1>$I{suspended}</h1><p>",$C{redirifsusp}?qq|<a href="|.htmlsafe($C{redirtourl}).qq|">$I{redirtext}</a>|:$I{susptext},"</p><hr>";
460 print_end();
461}
462
463sub send_frameset{
464 print_headers();
465 print "$H{begin_frames}<head>$H{meta_html}";
466 print_stylesheet('view');
467 print qq|</head>\n<frameset rows="$C{framesizes}" $C{frameattributes}><frame name="post" src="$S?action=post&session=$U{session}"><frame name="view" src="$S?action=entry&session=$U{session}"><frame name="controls" src="$S?action=controls&session=$U{session}"><noframes>$H{begin_body}$I{frames}$H{backtologin}$H{end_body}</noframes></frameset>$H{end_html}|;
468 exit;
469}
470
471sub send_messages{
472 get_waiting_count()if($T{guests}==4 and $U{status}>=7);
473 my $url="$S?action=view&session=$U{session}&nocache=";
474 print_start('view',$U{refresh},$url.substr($^T,-6));
475 print '<a name="top"></a>';
476 print_chatters();
477 # <a href="#bottom"> does not work in some older browsers, full URL is needed with anchors!
478 print qq|<table cellspacing="0" width="100%"><tr><td valign="top" align="right"><a href="$url$Q{nocache}[0]#bottom">$I{navbot}</a></td></tr></table>|;
479 print_messages();
480 print qq|<a name="bottom"></a><table cellspacing="0" width="100%"><tr><td align=right><a href="$url$Q{nocache}[0]#top">$I{navtop}</a></td></tr></table>|;
481 print_end();
482}
483
484sub send_choose_messages{
485 print_start('view');
486 print frmadm('clean'),hidden('what','selected'),submit($I{butdelsome},qq| style="$C{styledelsome}"|),'<br><br>';
487 print_messages($U{status});
488 print "</form><br>$H{backtochat}";
489 print_end();
490}
491
492sub send_links{
493 print_start('rules');
494 unless($C{links}=~/<br>/i){$C{links}=~s/\r\n/<br>/g;$C{links}=~s/\n/<br>/g;$C{links}=~s/\r/<br>/g}
495 print "$C{links}";
496 print_end();
497}
498
499sub send_post{
500 $U{postid}=substr($^T,-6);
501 print_start('post');
502 print qq|<center><table cellspacing="0"><tr><td align="center">|,frmpst('post'),hidden('postid',$U{postid}),$C{allowmultiline}?hidden('multi',$Q{multi}[0]):'';
503 print qq|<table cellspacing="0"><tr><td valign="top">$U{displayname}</td><td valign="top">:</td>|;
504 if($Q{multi}[0] and $C{allowmultiline}){print qq|<td valign="top"><textarea name="message" wrap="virtual" rows="$U{boxheight}" cols="$U{boxwidth}" style="$C{styleposttext};background-color:#$C{colbg};$U{style}">$U{rejected}</textarea></td>|}
505 else{print qq|<td valign="top"><input type="text" name="message" value="$U{rejected}" size="$U{boxwidth}" maxlength="$C{maxmessage}" style="$C{styleposttext};background-color:#$C{colbg};$U{style}"></td>|}
506 print qq|<td valign="top">|,submit($I{butsendto},qq| style="$C{stylepostsend}"|),qq|</td><td valign="top"><select name="sendto" size="1" style="$C{stylesendlist};background-color:#$C{colbg};color:#$C{coltxt}">|;
507 print '<option ',$Q{sendto}[0]eq'*'?'selected ':'','value="*">-',$I{seltoall},'-</option>';
508 print '<option ',$Q{sendto}[0]eq'?'?'selected ':'','value="?">-',$I{seltomem},'-</option>'if$U{status}>=2;
509 print '<option ',$Q{sendto}[0]eq'#'?'selected ':'','value="#">-',$I{seltoadm},'-</option>'if$U{status}>=6;
510 if($C{allowpms}){foreach(sort {lc($a) cmp lc($b)} keys %P){print '<option ',$Q{sendto}[0]eq$P{$_}[0]?'selected ':'',qq|value="$P{$_}[0]" style="$P{$_}[2]">$_</option>|unless$U{nickname}eq$_}}
511 print '</select></td></tr></table></form></td></tr><tr><td height="8"></td></tr><tr><td align="center"><table cellspacing="5"><tr><td>',frmpst('delete','last'),submit($I{butdellast},qq| style="$C{styledellast}"|),'</form></td><td>',frmpst('delete','check'),submit($I{butdelall},qq| style="$C{styledelall}"|),'</form></td><td width="10"></td><td>';
512 print frmpst('post'),hidden('sendto',$Q{sendto}[0]),hidden('multi',$Q{multi}[0]?'':'on'),submit($Q{multi}[0]?$I{butsingleline}:$I{butmultiline},qq| style="$C{styleswitch}"|),'</form></td>'if$C{allowmultiline};
513 print '</tr></table></td></tr><td></td></table></center>';
514 #<td>',frmpst('action','upload'),submit($I{butupload},qq| style="$C{styledelall}"|),'</form></td>
515 print_end();
516}
517
518sub send_help{
519 unless($C{rulestxt}=~/<br>/i){$C{rulestxt}=~s/\r\n/<br>/g;$C{rulestxt}=~s/\n/<br>/g;$C{rulestxt}=~s/\r/<br>/g}
520 $C{rulestxt}=~s/<IP>/$ENV{REMOTE_ADDR}/g;
521 print_start('rules');
522 print "<h2>$I{rules}</h2>$C{rulestxt}<br><br><hr><h2>$I{help}</h2>",$U{status}>=0?"$I{helpguests}<br>":'',$U{status}>=2?"<br>$I{helpregs}<br>":'',$U{status}>=6?"<br>$I{helpmods}<br>":'',$U{status}>=7?"<br>$I{helpadmins}<br>":'',"<br><hr><center>$H{backtochat}<br>$H{versiontag}</center>";
523 print_end();
524}
525
526sub send_profile{
527 $I{passhelp}=~s/<MIN>/$C{minpass}/;
528 $I{refreshrate}=~s/<MIN>/$C{minrefresh}/;
529 $I{refreshrate}=~s/<MAX>/$C{maxrefresh}/;
530 $I{entryrefresh}=~s/<DEFAULT>/$C{defaultrefresh}/;
531 print_start('profile');
532 print "<center><$H{form}>",hidden('action','profile'),hidden('do','save'),hidden('session',$U{session}),qq|<h2>$I{profileheader}</h2><i>$_[0]</i><table cellspacing="0">|,thr(),qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{refreshrate}</b></td><td align="right"><table cellspacing="0"><tr><td> </td><td><input type="text" name="refresh" size="3" maxlength="3" value="$U{refresh}"></td></tr></table></td></tr></table></td></tr>|,thr(),qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{fontcolour}</b> (<a href="$S?action=colours&session=$U{session}" target="view">$I{viewcolours}</a>)</td><td align="right"><table cellspacing="0"><tr><td> </td><td><input type="text" size="7" maxlength="6" value="$U{colour}" name="colour"></td></tr></table></td></tr></table></td></tr>|,thr();
533 if($U{status}>=2 and $C{allowfonts}){
534 print qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{fontface}</b></td><td align="right"><table cellspacing="0"><tr><td> </td><td><select name="font" size="1"><option value="">* $I{fontdefault} *</option>|;
535 foreach(sort keys %F){print '<option style="',get_style($F{$_}),'" ',$U{fontinfo}=~/$F{$_}/?'selected ':'','value="',$_,'">',$_,'</option>'}
536 print qq|</select></td><td> </td><td><input type="checkbox" name="bold" id="bold" value="on"|,$U{fontinfo}=~/<i?bi?>/?' checked':'',qq|></td><td><label for="bold"><b>$I{fontbold}</b></label></td><td> </td><td><input type="checkbox" name="italic" id="italic" value="on"|,$U{fontinfo}=~/<b?ib?>/?' checked':'',qq|></td><td><label for="italic"><i>$I{fontitalic}</i></label></td></tr></table></td></tr></table></td></tr>|,thr();
537 }
538 print qq|<tr><td align="center">$U{displayname} : |,style_this($I{fontexample},$U{fontinfo}),'</td></tr>',thr(),qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{boxsizes}</b></td><td align="right"><table cellspacing="0"><tr><td> </td><td>$I{boxwidth}</td><td><input type="text" name="boxwidth" size="3" maxlength="3" value="$U{boxwidth}"></td>|,$C{allowmultiline}?qq|<td> </td><td>$I{boxheight}</td><td><input type="text" name="boxheight" size="3" maxlength="3" value="$U{boxheight}"></td>|:'',qq|</tr></table></td></tr></table></td></tr>|,thr();
539 if($U{status}>=2){
540 print qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{entryrefresh}</b></td><td align="right"><table cellspacing="0"><tr><td> </td><td><input type="text" name="entryrefresh" size="3" maxlength="3" value="$U{entryrefresh}"></td></tr></table></td></tr></table></td></tr>|,thr(),qq|<tr><td><table cellspacing="0" width="100%"><tr><td align="left"><b>$I{changepass}</b></td></tr><tr><td align="right"><table cellspacing="0"><tr><td> </td><td align="left">$I{oldpass}</td><td><input type="password" name="oldpass" size="20"></td></tr><tr title="$I{passhelp}"><td> </td><td align="left">$I{newpass}</td><td><input type="password" name="newpass" size="20"></td></tr><tr title="$I{passhelp}"><td> </td><td align="left">$I{confirmpass}</td><td><input type="password" name="confirmpass" size="20"></td></tr></table></td></tr></table></td></tr>|,thr();
541 }
542 print '<tr><td align="center">',submit($I{savechanges}),"</td></tr></table></form><br>$H{backtochat}</center>";
543 print_end();
544}
545
546sub send_controls{
547 print_start('controls');
548 print '<center><table cellspacing="7"><tr>';
549 print qq|<td><$H{form} target="post">|,hidden('action','post'),hidden('session',$U{session}),submit($I{butreloadp},qq| style="$C{stylerelpost}"|),'</form></td>';
550 print qq|<td><$H{form} target="view">|,hidden('action','view'),hidden('session',$U{session}),hidden('nocache','000001'),submit($I{butreloadm},qq| style="$C{stylerelmes}"|),'</form></td>';
551 print qq|<td><$H{form} target="view">|,hidden('action','profile'),hidden('session',$U{session}),submit($I{butprofile},qq| style="$C{styleprofile}"|),'</form></td>';
552 print qq|<td><$H{form} target="view">|,hidden('action','admin'),hidden('session',$U{session}),submit($I{butadmin},qq| style="$C{styleadmin}"|),'</form></td>' if $U{status}>=6;
553 print qq|<td><$H{form} target="view">|,hidden('action','links'),hidden('session',$U{session}),submit($I{butlinks},qq| style="$C{stylerules}"|),'</form></td>' if $C{linksswitch}==1;
554 print qq|<td><$H{form} target="view">|,hidden('action','help'),hidden('session',$U{session}),submit($I{butrules},qq| style="$C{stylerules}"|),'</form></td>';
555 print qq|<td><$H{form} target="_parent">|,hidden('action','logout'),hidden('session',$U{session}),submit($I{butexit},qq| style="$C{styleexit}"|),'</form></td>';
556 print '</tr></table></center>';
557 print_end();
558}
559
560sub send_entry{
561 $C{entrymessage}=~s/<NICK>/$U{displayname}/g;
562 $I{entryhelp}=~s/<REFRESH>/$U{entryrefresh}/;
563 print_start('view',$U{entryrefresh},"$S?action=view&session=$U{session}&nocache=000000");
564
565 print "<center><h1>$C{entrymessage}</h1></center><hr><small>$I{entryhelp}</small>";
566 print_end();
567}
568
569sub send_logout{
570 $C{logoutmessage}=~s/<NICK>/$U{displayname}/g;
571 print_start('view');
572 print "<center><h1>$C{logoutmessage}</h1>$H{backtologin}</center>";
573 print_end();
574}
575
576sub send_colours{
577 print_start('profile');
578 print "<center><h2>$I{colheader}</h2><tt>";
579 for(my $red=0x00;$red<=0xFF;$red+=0x33){
580 for(my $green=0x00;$green<=0xFF;$green+=0x33){
581 for(my $blue=0x00;$blue<=0xFF;$blue+=0x33){
582 my $hcol=sprintf('%02X',$red).sprintf('%02X',$green).sprintf('%02X',$blue);
583 print qq|<font color="#$hcol"><b>$hcol</b></font> |;
584 }print '<br>';
585 }print '<br>';
586 }
587 print "</tt>$H{backtoprofile}</center>";
588 print_end();
589}
590
591sub send_login{
592 $I{nickhelp}=~s/<MAX>/$C{maxname}/;
593 $I{passhelp}=~s/<MIN>/$C{minpass}/;
594 $C{header}=~s/<IP>/$ENV{REMOTE_ADDR}/g;
595 $C{footer}=~s/<IP>/$ENV{REMOTE_ADDR}/g;
596 $C{header}=~s/<VER>/$H{versiontag}/g;
597 $C{footer}=~s/<VER>/$H{versiontag}/g;
598 print_start('login');
599 print qq|<center>$C{header}<$H{form} target="_parent">|,hidden('action','login'),qq|<table $C{tableattributes}><tr title="$I{nickhelp}"><td align="left">$I{nickname}</td><td align="right"><input type="text" name="nick" size="25" style="$C{stylelogintext}"></td></tr><tr title="$I{passhelp}"><td align="left">$I{password}</td><td align="right"><input type="password" name="pass" size="25" style="$C{stylelogintext}"></td></tr>|;
600 get_nowchatting();
601 unless($T{guestaccess}){
602 print qq|<tr><td colspan="2" align="center">$I{selcolguests}<br><select style="$C{stylecolselect};color:#$C{coltxt};background-color:#$C{colbg};" name="colour"><option value="">* |,$C{rndguestcol}?$I{selcolrandom}:$I{selcoldefault},' *</option>';
603 print_colours();
604 print '</select></td></tr>';
605 }
606 elsif($C{noguests}){
607 print qq|<tr><td colspan="2" align="center">$C{noguests}</td></tr>|;
608 }
609 print '<tr><td colspan="2" align="center">',submit($C{loginbutton},qq| style="$C{styleenter}"|),"</td></tr></table></form>$C{nowchatting}<br>$C{footer}</center>";
610 print_end();
611}
612
613sub send_error{my($err,$mes)=@_;
614 $err=~s/<NICK>/$U{displayname}/g;
615 $mes=htmlsafe($mes).'<br><br>'if$mes;
616 print_start('error');
617 print "<center><h2>$I{error} $err</h2>$mes$H{backtologin}</center>";
618 print_end();
619}
620
621sub send_fatal{
622 return if $Q{action}[0]=~/^setup|init$/;
623 set_config_defaults();
624 set_html_vars();
625 print_start('error');
626 print "<h2>$I{fatalerror}</h2>$_[0]";
627 print_end();
628}
629
630sub print_chatters{
631 print '<table cellspacing="0"><tr>';
632 print_waiting()if$T{waitings};
633 print qq|<td valign="top"><b>$I{members}</b></td><td> </td><td valign="top">|,join(' ',@M),'</td>',@G?'<td> </td>':''if@M;
634 print qq|<td valign="top"><b>$I{guests}</b></td><td> </td><td valign="top">|,join(' ',@G),'</td>'if@G;
635 print '</tr></table>';
636}
637
638sub print_waiting{
639 $I{butcheckwait}=~s/<COUNT>/$T{waitings}/;
640 print qq|<td valign="top"><$H{form}>|,hidden('action','admin'),hidden('do','newcomers'),hidden('session',$U{session}),submit($I{butcheckwait},qq| style="$C{stylecheckwait}"|),'</form></td><td> </td>';
641}
642
643sub print_memberslist{
644 foreach(sort {lc($a) cmp lc($b)} keys %A){
645 if(!$_[0] or $A{$_}[1]==$_[0]){
646 print qq|<option value="$A{$_}[0]" style="$A{$_}[2]">$_|;
647 unless($_[0]){
648 print ' ',$I{symdenied}if$A{$_}[1]==0;
649 print ' ',$I{symmod} if$A{$_}[1]==6;
650 print ' ',$I{symadmin} if$A{$_}[1]>=7;
651 }
652 print '</option>';
653 }
654 }
655}
656
657######################################################################
658# content filters
659######################################################################
660
661sub print_filters{
662 print qq|<tr><td colspan="2" align="left">$I{filterslist}</td></tr>|;
663 my $i=1;foreach(split('<>',$C{textfilters})){print_filter($i++,$_)}
664 print qq|<tr><td colspan="2" align="left">$I{filtersnew}</td></tr>|;
665 print_filter();
666}
667
668sub print_filter{my($no,$filter)=@_;
669 $no='new' unless $no;
670 my($type,$match,$action,$replace,$active)=split('"',$filter);
671 $match=htmlactive($match);
672 $replace=htmlactive($replace);
673 my $fchoose='';
674 my @selected;
675 my $rxerror;
676 if($no eq 'new'){
677 $fchoose=' selected';
678 }else{
679 $fchoose=' disabled';
680 # compile regex and check for errors
681 if($type==2){
682 my $rx='m/$match/';
683 eval $rx;
684 if($@){
685 $rxerror=$I{fregexerror};
686 $active=2;
687 }
688 }
689 $selected[$type]=' selected';
690 $selected[$action+2]=' selected';
691 $selected[$active+5]=' selected';
692 $match=htmlsafe($match);
693 $replace=htmlsafe($replace);
694 }
695 print qq|<tr><td colspan=2 align=right><select name="ftype$no"><option value="$type"$fchoose>$I{fchoosetype}</option><option value="$type" disabled>$I{fseparator}</option><option value="1"$selected[1]>$I{ftypetext}</option><option value="2"$selected[2]>$I{ftyperegex}</option></select><input type="text" name="fmatch$no" size="60" value="$match"></td></tr><tr><td colspan=2 align=right><select name="faction$no"><option value="$action"$fchoose>$I{fchooseaction}</option><option value="$action" disabled>$I{fseparator}</option><option value="1"$selected[3]>$I{factionreplace}</option><option value="2"$selected[4]>$I{factionkick}</option><option value="3"$selected[5]>$I{factionpurge}</option></select><input type="text" name="freplace$no" size="60" value="$replace"></td></tr>|;
696 print qq|<tr><td colspan=2 align=right>$rxerror <select name="factive$no"><option value="1"$selected[6]>$I{factive}</option><option value="2"$selected[7]>$I{fdisabled}</option><option value="3">$I{fdelete}</option></select></td></tr>| if $active;
697 print qq|<tr><td colspan=2> </td></tr>|;
698}
699
700sub filters_from_queries{
701# type 0: undef 1: text 2: regex
702# action 0: undef 1: replace 2: kick 3: purge
703# active 0: undef 1: active 2: disabled 3: delete
704# 'type"match"action"replacement"active<>....<>....<>'
705 my @filter;
706 for(my $i=1;;$i++){
707 last if !$Q{"ftype$i"}[0]; # empty
708 next if $Q{"factive$i"}[0]==3; # delete
709 next if $Q{"ftype$i"}[0]!~/^1|2$/;
710 next if $Q{"faction$i"}[0]!~/^1|2|3$/;
711 next if $Q{"factive$i"}[0]!~/^1|2$/;
712 foreach("fmatch$i","freplace$i"){$Q{$_}[0]=~s/^\s+|\s+$//g}
713 $Q{"factive$i"}[0]=2 unless $Q{"fmatch$i"}[0];
714 push @filter,join('"',$Q{"ftype$i"}[0],htmlsafe($Q{"fmatch$i"}[0]),$Q{"faction$i"}[0],htmlsafe($Q{"freplace$i"}[0]),$Q{"factive$i"}[0]);
715 }
716 foreach("fmatchnew","freplacenew"){$Q{$_}[0]=~s/^\s+|\s+$//g}
717 if($Q{"ftypenew"}[0]=~/^1|2$/ && $Q{"factionnew"}[0]=~/^1|2|3$/ && $Q{"fmatchnew"}[0]ne''){
718 push @filter,join('"',$Q{"ftypenew"}[0],htmlsafe($Q{"fmatchnew"}[0]),$Q{"factionnew"}[0],htmlsafe($Q{"freplacenew"}[0]),'1');
719 }
720 return join('<>',@filter);
721}
722
723sub apply_filters{
724 my $n;
725 foreach(split('<>',$C{textfilters})){
726 my($type,$match,$action,$replace,$active)=split('"',$_);
727 next unless $match;
728 if($active==1){
729 $match=htmlactive($match);
730 $replace=htmlactive($replace);
731 if($type==1){# text
732 $match=~s/\s*\|\s*/|/g;
733 $match=~s/\|+/|/g;
734 $match=~s/^\||\|$//g;
735 $match=~s/([^\w\d\s\|])/'\\x'.unpack('H*',$1)/ge;
736 my $rx='$n=($U{message}=~s/$match/$replace/ig)';
737 eval $rx;
738 }
739 elsif($type==2){# regex
740 # Evaluating arbitrary user-input is a huge security risk!!!
741 # => Escape all special characters, only allow $1,$2,.. for replacements.
742 $replace=~s/([^\w\d\s\$]|[\$](?![1-9]))/'\\x'.unpack('H*',$1)/ge;
743 my $rx='$n=($U{message}=~s/$match/qq{qq{$replace}}/igee)';
744 eval $rx;
745 }
746 if($n>0){# matches found
747 $U{autokick}=$action if $action>=2;
748 $U{kickmessage}=$replace if $action==3;
749 }
750 }
751 last if $U{autokick}==3;
752 }
753}
754
755######################################################################
756# session management
757######################################################################
758
759sub send_command(){
760 $U{message} =~ s/^.//;
761 my ($command, $subcommand) = split (/ /, $U{message}, 2);
762 if ($command eq 'kick'){
763 my ($kickmessage, $user) = split /@/, $subcommand;
764 $user =~ s/^\s+|\s+$//g;
765 kick_chatter($user,$kickmessage);
766 my $nick=$_[0]||$user;
767 my @lines=open_file_rw(my$MESSAGES,'messages',my$ferr);send_error($ferr)if$ferr;
768 while(my $line=shift@lines){
769 my %temp=messagehash($line);
770 print $MESSAGES $line unless(expiredm($temp{postdate}) or $temp{poster}eq$nick);
771 }
772 $ferr=close_file($MESSAGES,'messages');send_error($ferr)if$ferr;
773 $U{message}="$U{nickname} kicked and cleared '$user' because '$kickmessage'";
774 add_staff_message();
775 }
776 if ($command eq 'name'){
777 $subcommand =~ s/^\s+|\s+$//g;
778 kick_chatter($subcommand,"Names need to make sense, not include random letters or numbers, and not be offensive.");
779 my $nick=$_[0]||$subcommand;
780 my @lines=open_file_rw(my$MESSAGES,'messages',my$ferr);send_error($ferr)if$ferr;
781 while(my $line=shift@lines){
782 my %temp=messagehash($line);
783 print $MESSAGES $line unless(expiredm($temp{postdate}) or $temp{poster}eq$nick);
784 }
785 $ferr=close_file($MESSAGES,'messages');send_error($ferr)if$ferr;
786 open (MYFILE, '>>badnic.txt');
787 print MYFILE "$subcommand\n";
788 close (MYFILE);
789 $U{message}="$U{nickname} kicked and cleared '$subcommand' because of a bad nickname";
790 add_staff_message();
791 }
792 elsif ($command eq 'clean'){
793 if ($subcommand == 'room'){
794 clean_room()
795 }
796 }
797 elsif ($command eq 'logout'){
798 logout_chatter(pack('H*',$subcommand));
799 $U{message}.="$U{nickname} logged out '$subcommand'";
800 add_staff_message();
801 }
802 elsif ($command eq 'delmess'){
803 $subcommand =~ s/^\s+|\s+$//g;
804 my $nick=$_[0]||$subcommand;
805 my @lines=open_file_rw(my$MESSAGES,'messages',my$ferr);send_error($ferr)if$ferr;
806 while(my $line=shift@lines){
807 my %temp=messagehash($line);
808 print $MESSAGES $line unless(expiredm($temp{postdate}) or $temp{poster}eq$nick);
809 }
810 $ferr=close_file($MESSAGES,'messages');send_error($ferr)if$ferr;
811 $U{message}="$U{nickname} cleared '$subcommand' messages";
812 add_staff_message();
813 }
814}
815
816sub create_session{
817 $I{errbadnick}=~s/<MAX>/$C{maxname}/;
818 $I{errbadpass}=~s/<MIN>/$C{minpass}/;
819 $U{nickname}=cleanup_nick($Q{nick}[0]);
820 $U{passhash}=hash_this($U{nickname}.$Q{pass}[0]);
821 $U{colour}=$Q{colour}[0];
822 $U{status}=1;
823 send_error($I{errbadnick}) unless valid_nick($U{nickname});
824 check_member();# checked before allowed_nick/pass, in case character limits got changed e.g. so that registered nicks are not locked out
825 add_user_defaults();
826 if($U{status}==1){# no known member, we have a guest:
827 send_error($I{errnoguests}) unless $T{guests};
828 send_error($I{errbadnick}) unless allowed_nick($U{nickname});
829 send_error($I{errbadnick}) if onlynum($U{nickname});
830 send_error($I{errbadnick}) if specialchar($U{nickname});
831 send_error($I{errbadnick}) if consecutivechar($U{nickname});
832 send_error($I{errbadpass}) unless allowed_pass($Q{pass}[0]);
833 send_error($I{errbadpass}) if $U{nickname} eq uc $U{nickname};
834 #if (grep{/$U{nickname}/} <FILE>){
835 open(FILE,"badnic.txt");
836 while (my $line = <FILE>) {
837 send_error($I{errbadnick}) if $line =~ /$U{nickname}/
838 }
839 close FILE;
840 my $x = substr($U{nickname}, 0, 1);
841 my $c = $U{nickname} =~ /$x/g;
842 send_error($I{errbadpass}) if length($U{nickname}) eq $c;
843 create_waiting_session() if $T{guests}==4;# send guest to waiting room
844 }
845 write_new_session();
846}
847
848sub write_new_session{
849 # read and update current sessions
850 my @lines=parse_sessions(open_file_rw(my$SESSIONS,'sessions',my$ferr));send_error($ferr)if$ferr;
851 my %sids;my $reentry=0;my $inuse=0;my $kicked=0;
852 for(my $i=$#lines; $i>=0;$i--){
853 my %temp=sessionhash($lines[$i]);
854 $sids{$temp{session}}=1;# collect all existing ids
855 if($temp{nickname}eq$U{nickname}){# nick already here?
856 if($U{passhash}eq$temp{passhash}){
857 %U=%temp;
858 add_user_defaults();
859 $U{status}==0?$kicked=1:$reentry=1;
860 splice(@lines,$i,1)if$reentry;
861 }else{
862 $inuse=1;
863 }
864 }elsif(similar_nick($temp{nickname},$U{nickname})){
865 $inuse=1 if $U{status}==1;
866 }
867 }
868 # create new session:
869 unless($inuse or $kicked){
870 unless($U{status}==1 and $T{guestaccess}){
871 do{$U{session}=hash_this(time.rand().$U{nickname})}while($sids{$U{session}});# check for hash collision
872 push(@lines,sessionline(%U));
873 }
874 }
875 print $SESSIONS @lines;
876 $ferr=close_file($SESSIONS,'sessions');
877 send_error($ferr)if$ferr;
878 send_error($I{errbadlogin}) if $inuse;
879 send_error($C{kickederror},$U{kickmessage}) if $kicked;
880 send_error($I{errnoguests}) if($U{status}==1 and $T{guestaccess});
881 clean_room() unless(keys %P);
882 add_system_message($C{roomentry}) if $U{status}>3;
883}
884
885sub kick_chatter{my($name,$mes)=@_;
886 my $kickednick='';
887 my @lines=parse_sessions(open_file_rw(my$SESSIONS,'sessions',my$ferr));send_error($ferr)if$ferr;
888 foreach(@lines){
889 my %temp=sessionhash($_);
890 if($temp{nickname}eq$name and $temp{status}!=0){
891 if($U{status}>$temp{status} or $U{nickname}eq$name){# verify if status is sufficient to kick
892 $temp{status}='0';
893 $temp{lastpost}=60*($C{kickpenalty}-$C{guestsexpire})+$^T;
894 $temp{kickmessage}=$mes;
895 $_=sessionline(%temp);
896 $kickednick=style_this($temp{nickname},$temp{fontinfo});
897 }
898 }
899 }
900 print $SESSIONS @lines;
901 $ferr=close_file($SESSIONS,'sessions');send_error($ferr)if$ferr;
902 #add_system_message($C{kickedmessage},$kickednick)if$kickednick;
903 return $kickednick;
904}
905
906sub logout_chatter{my $name=$_[0];
907 my $lonick='';
908 my @lines=parse_sessions(open_file_rw(my$SESSIONS,'sessions',my$ferr));send_error($ferr)if$ferr;
909 for(my$i=$#lines; $i>=0;$i--){
910 my%temp=sessionhash($lines[$i]);
911 if($temp{nickname}eq$name and $temp{status}!=0){
912 if($U{status}>$temp{status} or $U{nickname}eq$name){# verify if status is sufficient to logout
913 splice(@lines,$i,1);
914 $lonick=style_this($temp{nickname},$temp{fontinfo});
915 }
916 }
917 }
918 print $SESSIONS @lines;
919 $ferr=close_file($SESSIONS,'sessions');send_error($ferr)if$ferr;
920 return $lonick;
921}
922
923sub update_session{
924 my @lines=parse_sessions(open_file_rw(my$SESSIONS,'sessions',my$ferr));send_error($ferr)if$ferr;
925 if($U{postid}eq$Q{postid}[0]){# ignore double post=reload from browser or proxy
926 $Q{message}[0]='';
927 }
928 elsif($^T-$U{lastpost}<=$C{floodlimit}){# time between posts too short, reject!
929 $U{rejected}=$Q{message}[0];
930 $Q{message}[0]='';
931 }
932 else{# valid post
933 $U{postid}=substr($Q{postid}[0],0,6);
934 $U{lastpost}=$^T;
935 }
936 foreach(@lines){
937 my %temp=sessionhash($_);
938 print $SESSIONS $_ unless $temp{session}eq$U{session};
939 }
940 print $SESSIONS sessionline(%U) if $U{session};
941 $ferr=close_file($SESSIONS,'sessions');send_error($ferr)if$ferr;
942 send_error($I{errexpired}) unless $U{session};
943 send_error($C{kickederror},$U{kickmessage}) if $U{status}==0;
944 send_error($I{errnoguests}) if($U{status}==1 and $T{guestaccess});
945}
946
947sub check_session{
948 parse_sessions(slurp_file('sessions',my$ferr));
949 send_error($ferr)if$ferr;
950 send_error($I{errexpired}) unless $U{session};
951 send_error($C{kickederror},$U{kickmessage}) if $U{status}==0;
952 send_error($I{errnoguests}) if($U{status}==1 and $T{guestaccess});
953}
954
955sub kill_session{
956 my @lines=parse_sessions(open_file_rw(my$SESSIONS,'sessions',my$ferr));send_error($ferr)if$ferr;
957 foreach(@lines){
958 my %temp=sessionhash($_);
959 print $SESSIONS $_ unless($temp{session}eq$U{session} and $U{status}!=0);
960 }
961 $ferr=close_file($SESSIONS,'sessions');send_error($ferr)if$ferr;
962 send_error($I{errexpired}) unless $U{session};
963 send_error($C{kickederror},$U{kickmessage}) if($U{status}==0);
964 if(scalar keys %P>1){# still chatters in room
965 add_system_message($C{roomexit}) if $U{status}>3;
966 }else{clean_room()}
967}
968
969sub get_nowchatting{
970 parse_sessions(slurp_file('sessions',my$ferr));
971 return if$ferr;
972 $C{nowchatting}=~s/<NAMES>/join(' ',(@M,@G))/eg;
973 $C{nowchatting}=~s/<COUNT>/@M+@G/eg;
974 return $C{nowchatting};
975}
976
977sub parse_sessions{my @lines=@_;
978# returns cleaned up sessions and populates global variables
979 my %temp;my $i;%P=();@G=();@M=();$T{admincount}=0;
980 # we need admincount first
981 for($i=$#lines; $i>=0;$i--){
982 %temp=sessionhash($lines[$i]);
983 if(expireds($temp{lastpost},$temp{status})){
984 splice(@lines,$i,1);
985 }
986 #elsif($temp{status}>=6){
987 # $T{modcount}++;
988 #}
989 elsif($temp{status}>=7){
990 $T{admincount}++;
991 }
992 }
993 # fill variables, clean up guests if needed
994 #$T{hasadmin}=($T{guests}=>3 and !$T{admincount})?1:0;
995 #$T{hasmod}=($T{guests}==2 and !$T{modcount})?1:0;
996 #$T{allowall}= $T{guests}==1;
997 #$T{blockguests}= $T{guests}==0;
998 #$T{guestaccess}=($T{hasmod} or $T{hasadmin} or $T{allowall} or !$T{guests});
999 $T{guestaccess}=(!$T{guests} or $T{guests}>1 and !$T{admincount})?1:0;
1000 for($i=$#lines; $i>=0;$i--){
1001 %temp=sessionhash($lines[$i]);
1002 if($temp{session}eq$Q{session}[0]){
1003 %U=%temp;
1004 add_user_defaults();
1005 }
1006 if($temp{status}>=2){
1007 $P{$temp{nickname}}=[unpack('H*',$temp{nickname}),$temp{status},get_style($temp{fontinfo})];
1008 $temp{nickname}=~s/\s+/ /g;
1009 push(@M,style_this($temp{nickname},$temp{fontinfo}));
1010 }elsif($temp{status}==1){
1011 if($T{guestaccess}){
1012 splice(@lines,$i,1);
1013 }else{
1014 $P{$temp{nickname}}=[unpack('H*',$temp{nickname}),$temp{status},get_style($temp{fontinfo})];
1015 $temp{nickname}=~s/\s+/ /g;
1016 push(@G,style_this($temp{nickname},$temp{fontinfo}));
1017 }
1018 }
1019 }
1020 return @lines;
1021}
1022
1023sub sessionhash{
1024 my @f=split('l',$_[0]);
1025 my %s=(
1026 session => $f[ 0] ,
1027 nickname =>pack('H*',$f[ 1]),
1028 status =>pack('H*',$f[ 2]),
1029 refresh =>pack('H*',$f[ 3]),
1030 fontinfo =>pack('H*',$f[ 4]),
1031 lastpost =>pack('H*',$f[ 5]),
1032 passhash => $f[ 6] ,
1033 postid =>pack('H*',$f[ 7]),
1034 entryrefresh=>pack('H*',$f[ 8]),
1035 boxwidth =>pack('H*',$f[ 9]),
1036 boxheight =>pack('H*',$f[10]),
1037 ip =>pack('H*',$f[11]),
1038 useragent =>pack('H*',$f[12]),
1039 kickmessage =>pack('H*',$f[13]),
1040 );
1041 return %s;
1042}
1043
1044sub sessionline{
1045 my %h=@_;
1046 my $s=
1047 $h{session} .'l'.
1048 unpack('H*',$h{nickname}) .'l'.
1049 unpack('H*',$h{status}) .'l'.
1050 unpack('H*',$h{refresh}) .'l'.
1051 unpack('H*',$h{fontinfo}) .'l'.
1052 unpack('H*',$h{lastpost}) .'l'.
1053 $h{passhash} .'l'.
1054 unpack('H*',$h{postid}) .'l'.
1055 unpack('H*',$h{entryrefresh}).'l'.
1056 unpack('H*',$h{boxwidth}) .'l'.
1057 unpack('H*',$h{boxheight}) .'l'.
1058 unpack('H*',$h{ip}) .'l'.
1059 unpack('H*',$h{useragent}) .'l'.
1060 unpack('H*',$h{kickmessage}) .'l'.
1061 "\n";
1062 return $s;
1063}
1064
1065######################################################################
1066# waiting room handling
1067######################################################################
1068
1069sub create_waiting_session{
1070 # check if name used in room already
1071 my @lines=parse_sessions(slurp_file('sessions',my$ferr));
1072 send_error($ferr)if$ferr;
1073 foreach(@lines){
1074 my %temp=sessionhash($_);
1075 if(similar_nick($temp{nickname},$U{nickname})){
1076 if($temp{passhash}eq$U{passhash}){# reentry, approved already
1077 %U=%temp;
1078 add_user_defaults();
1079 send_error($C{kickederror},$U{kickmessage}) if $U{status}==0;
1080 send_frameset();
1081 }
1082 else{send_error($I{errbadlogin})}# name in use
1083 }
1084 }
1085 # remove expired waiting entries
1086 @lines=parse_waitings(open_file_rw(my$WAITING,'waiting',$ferr));send_error($ferr)if$ferr;
1087 my %sids;my $reentry;my $inuse;
1088 foreach(@lines){
1089 my %temp=waitinghash($_);
1090 $sids{$temp{session}}=1;# collect all existing ids
1091 if(similar_nick($temp{nickname},$U{nickname})){# nick already waiting?
1092 if($U{passhash}eq$temp{passhash}){
1093 $reentry=1;
1094 %U=%temp;
1095 add_user_defaults();
1096 $U{status}=1 if $U{status}==2;# needs reapproval since no session in room was made
1097 }else{
1098 $inuse=1;
1099 }
1100 }
1101 }
1102 # create new waiting session:
1103 unless($inuse or $reentry or $T{guestaccess}){
1104 $U{status}=1;
1105 add_user_defaults();
1106 do{$U{session}=substr(hash_this(time.rand().$U{nickname}),16)}while($sids{$U{session}});# check for hash collision
1107 push(@lines,waitingline(%U));
1108 }
1109 print $WAITING @lines;
1110 $ferr=close_file($WAITING,'waiting');send_error($ferr)if$ferr;
1111 send_error($I{errbadlogin}) if $inuse;
1112 send_error($I{errnoguests}) if $T{guestaccess};
1113 send_error($I{erraccdenied},$U{kickmessage}) if($U{status}==0);
1114 send_waiting_room();
1115}
1116
1117sub check_waiting_session{
1118 parse_waitings(slurp_file('waiting',my$err));
1119 send_error($err)if$err;
1120 send_error($I{errexpired}) unless $U{session};
1121 send_error($I{erraccdenied},$U{kickmessage}) if($U{status}==0);
1122 if($U{status}==2){# approved: create new session, send frameset
1123 $U{status}=1;
1124 add_user_defaults();
1125 write_new_session();
1126 send_frameset();
1127 }
1128}
1129
1130sub expire_waiting_sessions{
1131 # cleanup unhandled waitings if guestroom gets opened
1132 my @lines=parse_waitings(open_file_rw(my$WAITING,'waiting',my$ferr));return if$ferr;
1133 foreach(@lines){
1134 my %temp=waitinghash($_);
1135 print $WAITING $_ if$temp{status}!=1;
1136 }
1137 $ferr=close_file($WAITING,'waiting');
1138}
1139
1140sub send_waiting_room{
1141 $I{waitmessage}=~s/<REFRESH>/$C{defaultrefresh}/;
1142 $I{waitmessage}=~s/<NICK>/$U{displayname}/;
1143 print_start('wait',$C{defaultrefresh},"$S?action=wait&session=$U{session}&nocache=".substr($^T,-6));
1144 print "<center><h2>$I{waitroom}</h2>$I{waitmessage}<br><br>";
1145 print '<hr width="',substr($^T,-2),'%">';
1146 print "<$H{form}>",hidden('action','wait'),hidden('session',$U{session}),submit($I{butreloadw},qq| style="$C{stylewaitrel}"|),'</form></center>';
1147 print_end();
1148}
1149
1150sub send_waiting_admin{
1151 my @lines=parse_waitings(slurp_file('waiting',my$ferr));
1152 send_error($ferr)if$ferr;
1153 print_start('admin');
1154 print qq|<center><h2>$I{admwaiting}</h2>|;
1155 if($T{waitings}){
1156 print qq|<$H{form}>|,hidden('action','admin'),hidden('do','newcomers'),hidden('session',$U{session}),qq|<table cellpadding="5"><thead align="left"><tr><th><b>$I{nicklist}</b></th><th><b>$I{ip}</b></th><th><b>$I{useragent}</b></th></tr></thead><tbody align="left" valign="middle">|;
1157 foreach(@lines){
1158 my %temp=waitinghash($_);
1159 next if $temp{status}!=1;
1160 print qq|<tr>|,hidden('alls',$temp{session}),qq|<td><input type="checkbox" name="csid" id="$temp{session}" value="$temp{session}"><label for="$temp{session}"> <font color="#$temp{colour}">$temp{nickname}</font></label></td><td>$temp{ip}</td><td>$temp{useragent}</td></tr>|;
1161 }
1162 print qq|</tbody></table><br><table><tr><td><input type="radio" name="what" value="allowchecked" id="allowchecked" checked></td><td><label for="allowchecked"> $I{allowchecked} </label></td><td><input type="radio" name="what" value="allowall" id="allowall"></td><td><label for="allowall"> $I{allowall} </label></td><td><input type="radio" name="what" value="denychecked" id="denychecked"></td><td><label for="denychecked"> $I{denychecked} </label></td><td><input type="radio" name="what" value="denyall" id="denyall"></td><td><label for="denyall"> $I{denyall} </label></td></tr><tr><td colspan="8" align="center">$I{denymessage} <input type="text" name="kickmessage" size="45"></td></tr><tr><td colspan="8" align="center">|,submit($I{butallowdeny}),qq|</td></tr></table></form><br>|;
1163 }else{
1164 print "$I{waitempty}<br><br>";
1165 }
1166 print "$H{backtochat}</center>";
1167 print_end();
1168}
1169
1170sub get_waiting_count{
1171 # return number of sessions to be approved, for admin-button
1172 parse_waitings(slurp_file('waiting',my$ferr));
1173 send_error($ferr)if$ferr;
1174 return $T{waitings};
1175}
1176
1177sub parse_waitings{my @lines=@_;
1178 # returns cleaned up sessions and populates global variables
1179 $T{waitings}=0;
1180 for(my $i=$#lines; $i>=0;$i--){
1181 my %temp=waitinghash($lines[$i]);
1182 if(expiredw($temp{timestamp})){
1183 splice(@lines,$i,1);
1184 }else{
1185 if($Q{session}[0]eq$temp{session}){
1186 %U=%temp;
1187 add_user_defaults();
1188 }
1189 $T{waitings}++ if $temp{status}==1;
1190 }
1191 }
1192 return @lines;
1193}
1194
1195sub edit_waiting_sessions{
1196 my %sids=();my $newstatus=1;
1197 if($_[0]eq'allowchecked'){
1198 foreach(@{$Q{csid}}){$sids{$_}=1}
1199 $newstatus=2;
1200 }elsif($_[0]eq'denychecked'){
1201 foreach(@{$Q{csid}}){$sids{$_}=1}
1202 $newstatus=0;
1203 }elsif($_[0]eq'allowall'){
1204 foreach(@{$Q{alls}}){$sids{$_}=1}
1205 $newstatus=2;
1206 }elsif($_[0]eq'denyall'){
1207 foreach(@{$Q{alls}}){$sids{$_}=1}
1208 $newstatus=0;
1209 }else{return}
1210 my @lines=parse_waitings(open_file_rw(my$WAITING,'waiting',my$ferr));send_error($ferr)if$ferr;
1211 foreach my $wait (@lines){
1212 my %temp=waitinghash($wait);
1213 if($temp{status}==1 and $sids{$temp{session}}){
1214 $temp{status}=$newstatus;
1215 $temp{kickmessage}=$Q{kickmessage}[0] if $newstatus==0;
1216 }
1217 $wait=waitingline(%temp);
1218 }
1219 print $WAITING @lines;
1220 $ferr=close_file($WAITING,'waiting');send_error($ferr)if$ferr;
1221}
1222
1223sub waitinghash{
1224 my @f=split('l',$_[0]);
1225 my %w=(
1226 session => $f[0] ,
1227 timestamp =>pack('H*',$f[1]),
1228 nickname =>pack('H*',$f[2]),
1229 passhash => $f[3] ,
1230 colour =>pack('H*',$f[4]),
1231 ip =>pack('H*',$f[5]),
1232 useragent =>pack('H*',$f[6]),
1233 status =>pack('H*',$f[7]),
1234 kickmessage=>pack('H*',$f[8]),
1235 );
1236 return %w;
1237}
1238
1239sub waitingline{
1240 my %h=@_;
1241 my $w=
1242 $h{session} .'l'.
1243 unpack('H*',$h{timestamp}) .'l'.
1244 unpack('H*',$h{nickname}) .'l'.
1245 $h{passhash} .'l'.
1246 unpack('H*',$h{colour}) .'l'.
1247 unpack('H*',$h{ip}) .'l'.
1248 unpack('H*',$h{useragent}) .'l'.
1249 unpack('H*',$h{status}) .'l'.
1250 unpack('H*',$h{kickmessage}).'l'.
1251 "\n";
1252 return $w;
1253}
1254
1255######################################################################
1256# member handling
1257######################################################################
1258
1259sub valid_admin{
1260 ($U{nickname},$U{pass},$U{hexpass})=@_;
1261 $U{pass}||=pack('H*',$U{hexpass});# masked pass on setup pages
1262 # superuser?
1263 $U{passhash}=hash_this($U{nickname}.hash_this($U{nickname}).hash_this($U{pass}).$U{pass});
1264 my($sudata)=slurp_file('admin',my$ferr);
1265 send_error($ferr)if$ferr;
1266 if($U{passhash}eq$sudata){
1267 $U{status}=9;
1268 return 2
1269 }
1270 # main admin?
1271 $U{passhash}=hash_this($U{nickname}.$U{pass});
1272 my @lines=slurp_file('members',$ferr);
1273 send_error($ferr)if$ferr;
1274 foreach(@lines){
1275 my %temp=memberhash($_);
1276 if($temp{nickname}eq$U{nickname} and $temp{passhash}eq$U{passhash} and $temp{status}==8){
1277 return 1
1278 }
1279 }
1280 # no admin
1281 return 0
1282}
1283
1284sub check_member{
1285 my @lines=slurp_file('members',my$ferr);
1286 send_error($ferr)if$ferr;
1287 my $similar=0;
1288 foreach(@lines){
1289 my %temp=memberhash($_);
1290 if($temp{nickname}eq$U{nickname}){
1291 if($temp{passhash}eq$U{passhash}){
1292 %U=%temp;
1293 last;
1294 }else{send_error($I{errbadlogin})}
1295 }
1296 $similar=1 if similar_nick($temp{nickname},$U{nickname});
1297 }
1298 send_error($I{errbadlogin}) if($U{status}==1 and $similar);
1299 send_error($I{erraccdenied}) if($U{status}==0 or $U{status}>8);
1300}
1301
1302sub read_members{
1303 my @lines=slurp_file('members',my$ferr);
1304 send_error($ferr)if$ferr;
1305 %A=();
1306 foreach(@lines){
1307 my %temp=memberhash($_);
1308 $A{$temp{nickname}}=[unpack('H*',$temp{nickname}),$temp{status},get_style("#$temp{colour} $F{$temp{fontface}} <$temp{fonttags}>")];
1309 }
1310}
1311
1312sub register_guest{
1313 send_admin() if $Q{name}[0]eq'';
1314 unless($P{pack('H*',$Q{name}[0])}[1]==1){
1315 $I{errcantreg}=~s/<NICK>/pack('H*',$Q{name}[0])/e;
1316 send_admin($I{errcantreg});
1317 }
1318 my @lines=open_file_rw(my$SESSIONS,'sessions',my$ferr);send_error($ferr)if$ferr;
1319 my %reg;
1320 foreach(@lines){
1321 my %temp=sessionhash($_);
1322 if(unpack('H*',$temp{nickname})eq$Q{name}[0] and $temp{status}==1){
1323 $temp{status}=2;
1324 %reg=%temp;
1325 ($reg{colour})=$reg{fontinfo}=~/#([a-f0-9]{6})/i;
1326 print $SESSIONS sessionline(%temp);
1327 }
1328 else{
1329 print $SESSIONS $_ unless expireds($temp{lastpost},$temp{status});
1330 }
1331 }
1332 $ferr=close_file($SESSIONS,'sessions');send_error($ferr)if$ferr;
1333 unless($reg{status}){
1334 $I{errcantreg}=~s/<NICK>/pack('H*',$Q{name}[0])/e;
1335 send_admin($I{errcantreg});
1336 }
1337 @lines=open_file_rw(my$MEMBERS,'members',$ferr);send_error($ferr)if$ferr;
1338 print $MEMBERS @lines;
1339 foreach(@lines){
1340 my %temp=memberhash($_);
1341 if(unpack('H*',$temp{nickname})eq$Q{name}[0]){
1342 $ferr=close_file($MEMBERS,'members');send_error($ferr)if$ferr;
1343 $I{erralreadyreg}=~s/<NICK>/pack('H*',$Q{name}[0])/e;
1344 send_admin($I{erralreadyreg});
1345 }
1346 }
1347 print $MEMBERS memberline(%reg);
1348 $ferr=close_file($MEMBERS,'members');send_error($ferr)if$ferr;
1349 add_system_message($C{regmessage},style_this($reg{nickname},$reg{fontinfo}));
1350}
1351
1352sub register_new{
1353 $Q{name}[0]=cleanup_nick($Q{name}[0]);
1354 send_admin() if $Q{name}[0]eq'';
1355 $I{errbadnick}=~s/<MAX>/$C{maxname}/;
1356 $I{errbadpass}=~s/<MIN>/$C{minpass}/;
1357 if($P{$Q{name}[0]}){
1358 $I{errcantregnew}=~s/<NICK>/$Q{name}[0]/;
1359 send_admin($I{errcantregnew});
1360 }
1361 send_admin($I{errbadnick}) unless valid_nick($Q{name}[0]);
1362 send_admin($I{errbadpass}) unless allowed_pass($Q{pass}[0]);
1363 my @lines=open_file_rw(my$MEMBERS,'members',my$ferr);send_error($ferr)if$ferr;
1364 print $MEMBERS @lines;
1365 foreach(@lines){
1366 my %temp=memberhash($_);
1367 if($temp{nickname}eq$Q{name}[0]){
1368 $ferr=close_file($MEMBERS,'members');send_error($ferr)if$ferr;
1369 $I{erralreadyreg}=~s/<NICK>/$Q{name}[0]/;
1370 send_admin($I{erralreadyreg});
1371 }
1372 }
1373 my %reg=(
1374 nickname =>$Q{name}[0],
1375 passhash =>hash_this($Q{name}[0].$Q{pass}[0]),
1376 status =>'2',
1377 refresh =>$C{defaultrefresh},
1378 colour =>$C{coltxt},
1379 fontface =>'',
1380 fonttags =>'',
1381 entryrefresh=>$C{defaultrefresh}
1382 );
1383 print $MEMBERS memberline(%reg);
1384 $ferr=close_file($MEMBERS,'members');send_error($ferr)if$ferr;
1385 $I{succreg}=~s/<NICK>/$Q{name}[0]/;
1386 send_admin($I{succreg});
1387}
1388
1389sub change_status{
1390 send_admin()if($Q{name}[0]eq'' or $Q{set}[0]eq'');
1391 my $nick=pack('H*',$Q{name}[0]);
1392 if($U{status}<=$Q{set}[0] or $Q{set}[0]!~/^[0267\-]$/){
1393 $I{errcantstatus}=~s/<NICK>/$nick/;
1394 send_admin($I{errcantstatus})
1395 }
1396 my $found=0;
1397 my @lines=open_file_rw(my$MEMBERS,'members',my$ferr);send_error($ferr)if$ferr;
1398 foreach(@lines){
1399 my %temp=memberhash($_);
1400 if($temp{nickname}eq$nick and $U{status}>$temp{status}){
1401 $found=1;
1402 next if $Q{set}[0]eq'-';
1403 $found=2;
1404 $temp{status}=$Q{set}[0];
1405 print $MEMBERS memberline(%temp);
1406 }
1407 else{
1408 print $MEMBERS $_;
1409 }
1410 }
1411 $ferr=close_file($MEMBERS,'members');send_error($ferr)if$ferr;
1412 if($found==1){
1413 $I{succdelmem}=~s/<NICK>/$nick/;
1414 send_admin($I{succdelmem})
1415 }
1416 elsif($found==2){
1417 $I{succstatus}=~s/<NICK>/$nick/;
1418 send_admin($I{succstatus})
1419 }else{
1420 $I{errcantstatus}=~s/<NICK>/$nick/;
1421 send_admin($I{errcantstatus})
1422 }
1423}
1424
1425sub amend_profile{
1426 foreach(qw(refresh boxwidth boxheight entryrefresh)){$Q{$_}[0]=~y/0-9//cd;$Q{$_}[0]=~s/^0+//}
1427 $U{refresh}=$Q{refresh}[0]||$C{defaultrefresh};
1428 $U{refresh}=$C{minrefresh}if$U{refresh}<$C{minrefresh};
1429 $U{refresh}=$C{maxrefresh}if$U{refresh}>$C{maxrefresh};
1430 $U{colour}=($Q{colour}[0]=~/^[a-f0-9]{6}$/i)?$Q{colour}[0]:$C{coltxt};
1431 $U{fonttags}='';
1432 $U{fonttags}.='b'if($Q{bold}[0]and$U{status}>=2);
1433 $U{fonttags}.='i'if($Q{italic}[0]and$U{status}>=2);
1434 $U{fontface}=$Q{font}[0]if($F{$Q{font}[0]}and$U{status}>=2);
1435 $U{fontinfo}="#$U{colour} $F{$U{fontface}} <$U{fonttags}>";
1436 $U{displayname}=$U{nickname};
1437 $U{displayname}=~s/\s+/ /g;
1438 $U{displayname}=style_this($U{nickname},$U{fontinfo});
1439 $U{boxwidth}=$Q{boxwidth}[0]if$Q{boxwidth}[0]>0;
1440 $U{boxheight}=$Q{boxheight}[0]if$Q{boxheight}[0]>0;
1441 $U{boxwidth}=$C{boxwidthdef}if$U{boxwidth}>=1000;
1442 $U{boxheight}=$C{boxheightdef}if$U{boxheight}>=1000;
1443 $U{entryrefresh}=$Q{entryrefresh}[0]||$C{defaultrefresh};
1444 $U{entryrefresh}=1if$U{entryrefresh}<1;
1445 $U{entryrefresh}=$C{defaultrefresh}if$U{entryrefresh}>$C{defaultrefresh};
1446}
1447
1448sub save_profile{
1449 if(!$Q{oldpass}[0]and($Q{newpass}[0]or$Q{confirmpass}[0])){
1450 check_session();
1451 send_profile($I{errwrongpass});
1452 }
1453 if($Q{newpass}[0]ne$Q{confirmpass}[0]){
1454 check_session();
1455 send_profile($I{errdiffpass});
1456 }
1457 if($Q{oldpass}[0]and!allowed_pass($Q{newpass}[0])){
1458 $I{errbadpass}=~s/<MIN>/$C{minpass}/;
1459 check_session();
1460 send_profile($I{errbadpass});
1461 }
1462 # check and rewrite session
1463 my @lines=parse_sessions(open_file_rw(my$SESSIONS,'sessions',my$ferr));send_error($ferr)if$ferr;
1464 $U{oldhash}=$Q{oldpass}[0]?hash_this($U{nickname}.$Q{oldpass}[0]):$U{passhash};
1465 $U{newhash}=$Q{newpass}[0]?hash_this($U{nickname}.$Q{newpass}[0]):$U{passhash};
1466 $U{orihash}=$U{passhash};
1467 foreach(@lines){
1468 my %temp=sessionhash($_);
1469 if($temp{session}eq$U{session} and $temp{status}>0 and $temp{passhash}eq$U{oldhash}){
1470 amend_profile();
1471 $U{passhash}=$U{newhash};
1472 print $SESSIONS sessionline(%U);
1473 }else{
1474 print $SESSIONS $_;
1475 }
1476 }
1477 $ferr=close_file($SESSIONS,'sessions');send_error($ferr)if$ferr;
1478 send_error($I{errexpired}) unless $U{session};
1479 send_error($C{kickederror},'',$U{kickmessage}) if $U{status}==0;
1480 send_error($I{errnoguests}) if($U{status}==1 and $T{guestaccess});
1481 send_profile($I{errwrongpass}) if $U{orihash}ne$U{oldhash};
1482 # rewrite member file
1483 if($U{status}>=2){
1484 my $err='';
1485 my @lines=open_file_rw(my$MEMBERS,'members',$ferr);send_error($ferr)if$ferr;
1486 foreach(@lines){
1487 my %temp=memberhash($_);
1488 if($temp{nickname}eq$U{nickname}){
1489 $U{sessionstatus}=$U{status};
1490 $U{status}=$temp{status};
1491 $err=$I{errwrongpass} unless $temp{passhash} eq $U{orihash};
1492 print $MEMBERS $err?$_:memberline(%U);
1493 $U{status}=$U{sessionstatus};
1494 }
1495 else{
1496 print $MEMBERS $_;
1497 }
1498 }
1499 $ferr=close_file($MEMBERS,'members');send_error($ferr)if$ferr;
1500 send_profile($err) if $err;
1501 }
1502 send_profile($I{succchanged});
1503}
1504
1505sub memberhash{
1506 my @f=split('l',$_[0]);
1507 my %m=(
1508 nickname =>pack('H*',$f[0]),
1509 passhash => $f[1] ,
1510 status =>pack('H*',$f[2]),
1511 refresh =>pack('H*',$f[3]),
1512 colour =>pack('H*',$f[4]),
1513 fontface =>pack('H*',$f[5]),
1514 fonttags =>pack('H*',$f[6]),
1515 entryrefresh =>pack('H*',$f[7]),
1516 boxwidth =>pack('H*',$f[8]),
1517 boxheight =>pack('H*',$f[9]),
1518 );
1519 return %m;
1520}
1521
1522sub memberline{
1523 my %h=@_;
1524 my $m=
1525 unpack('H*',$h{nickname}) .'l'.
1526 $h{passhash} .'l'.
1527 unpack('H*',$h{status}) .'l'.
1528 unpack('H*',$h{refresh}) .'l'.
1529 unpack('H*',$h{colour}) .'l'.
1530 unpack('H*',$h{fontface}) .'l'.
1531 unpack('H*',$h{fonttags}) .'l'.
1532 unpack('H*',$h{entryrefresh}).'l'.
1533 unpack('H*',$h{boxwidth}) .'l'.
1534 unpack('H*',$h{boxheight}) .'l'.
1535 "\n";
1536 return $m;
1537}
1538
1539sub add_user_defaults{
1540 $U{ip}=$ENV{REMOTE_ADDR};
1541 $U{useragent}=htmlsafe($ENV{HTTP_USER_AGENT});
1542 $U{refresh}||=$C{defaultrefresh};
1543 unless($U{fontinfo}){
1544 unless($U{colour}=~/^[a-f0-9]{6}$/i){
1545 $U{colour}=$C{coltxt};
1546 if($C{rndguestcol}){
1547 do{$U{colour}=sprintf('%02X',int(rand(256))).sprintf('%02X',int(rand(256))).sprintf('%02X',int(rand(256)))}until(abs(greyval($U{colour})-greyval($C{colbg}))>75);
1548 }
1549 }
1550 $U{fontinfo}="#$U{colour}";
1551 $U{fontinfo}.=" $F{$U{fontface}} <$U{fonttags}>" if $C{allowfonts};
1552 }
1553 ($U{colour})=$U{fontinfo}=~/#([0-9A-Fa-f]{6})/;
1554 $U{style}=get_style($U{fontinfo});
1555 $U{entryrefresh}||=$C{defaultrefresh};
1556 $U{boxwidth}||=$C{boxwidthdef};
1557 $U{boxheight}||=$C{boxheightdef};
1558 $U{timestamp}||=$^T;
1559 $U{lastpost}||=$^T;
1560 $U{postid}||='OOOOOO';
1561 $U{displayname}=$U{nickname};
1562 $U{displayname}=~s/\s+/ /g;
1563 $U{displayname}=style_this($U{displayname},$U{fontinfo});
1564}
1565
1566######################################################################
1567# message handling
1568######################################################################
1569
1570sub validate_input{
1571 $U{message}=substr($Q{message}[0],0,$C{maxmessage});
1572 $U{rejected}=substr($Q{message}[0],$C{maxmessage}) unless $U{rejected};
1573 if($U{message}=~/&[^;]{0,8}$/ and $U{rejected}=~/^([^;]{0,8};)/){
1574 $U{message}.=$1;
1575 $U{rejected}=~s/^$1//;
1576 }
1577 if($U{rejected}){
1578 $U{rejected}=htmlsafe($U{rejected});
1579 $U{rejected}=~s/<br>(<br>)+/<br><br>/g;
1580 $U{rejected}=~s/<br><br>$/<br>/;
1581 $C{allowmultiline}?$U{rejected}=~s/<br>/\n/g:$U{rejected}=~s/<br>/ /g;
1582 $U{rejected}=~s/^\s+|\s+$//g;
1583 }
1584 $U{message}=htmlsafe($U{message});
1585 apply_filters();
1586 if($C{allowmultiline} and $Q{multi}[0]){
1587 $U{message}=~s/<br>(<br>)+/<br><br>/g;
1588 $U{message}=~s/<br><br>$/<br>/;
1589 $U{message}=~s/ / /g;
1590 $U{message}=~s/<br> /<br> /g;
1591 }else{
1592 $U{message}=~s/<br>/ /g;
1593 $U{message}=~s/^\s+|\s+$//g;
1594 $U{message}=~s/\s+/ /g;
1595 }
1596 create_hotlinks();
1597 $U{delstatus}=$U{status};
1598 if($Q{sendto}[0]eq'*'){
1599 $U{poststatus}='1';
1600 $U{displaysend}=$C{mesall};
1601 }
1602 elsif($Q{sendto}[0]eq'?' and $U{status}>=2){
1603 $U{poststatus}='2';
1604 $U{displaysend}=$C{mesmem};
1605 }
1606 elsif($Q{sendto}[0]eq'#' and $U{status}>=6){
1607 $U{poststatus}='6';
1608 $U{displaysend}=$C{messtaff};
1609 }
1610 elsif($C{allowpms}){# known nick in room?
1611 foreach(keys %P){if($Q{sendto}[0]eq$P{$_}[0]){
1612 $U{recipient}=$_;
1613 $U{displayrecp}=style_this($_,$P{$_}[2]);
1614 }}
1615 if($U{recipient}){
1616 $U{poststatus}='9';
1617 $U{delstatus}='9';
1618 $U{displaysend}=$C{mespm};
1619 }
1620 else{# nick left already
1621 $U{message}='';
1622 $U{rejected}='';
1623 }
1624 }
1625 else{# invalid recipient
1626 $U{message}='';
1627 $U{rejected}='';
1628 }
1629 $U{displaysend}=~s/<NICK>/$U{displayname}/;
1630 $U{displaysend}=~s/<RECP>/$U{displayrecp}/;
1631}
1632
1633sub formsafe{my $m=$_[0];
1634 $m=~s/&/&/g;
1635 $m=~s/"/"/g;
1636 $m=~s/</</g;
1637 $m=~s/>/>/g;
1638 return $m;
1639}
1640
1641sub htmlsafe{my $m=$_[0];
1642 $m=~s/&(?![\w\d\#]{2,8};)/&/g;
1643 $m=~s/</</g;
1644 $m=~s/>/>/g;
1645 $m=~s/"/"/g;
1646 $m=~s/\r\n/<br>/g;
1647 $m=~s/\n/<br>/g;
1648 $m=~s/\r/<br>/g;
1649 return $m;
1650}
1651
1652sub htmlactive{my $m=$_[0];
1653 $m=~s/"/"/g;
1654 $m=~s/</</g;
1655 $m=~s/>/>/g;
1656 $m=~s/&/&/g;
1657 $m=~s/\r\n/\n/g;
1658 $m=~s/\r/\n/g;
1659 return $m;
1660}
1661
1662sub create_hotlinks{
1663 return unless $C{createlinks};
1664 #######################################################################################
1665 # Make hotlinks for URLs, redirect through dereferrer script to prevent session leakage
1666 #######################################################################################
1667 # 1. all explicit schemes with whatever xxx://yyyyyyy
1668 $U{message}=~s~(\w*://[^\s<>]+)~<<$1>>~ig;
1669 # 2. valid URLs without scheme:
1670 $U{message}=~s~((?:[^\s<>]*:[^\s<>]*@)?[a-z0-9\-]+(?:\.[a-z0-9\-]+)+(?::\d*)?/[^\s<>]*)(?![^<>]*>)~<<$1>>~ig; # server/path given
1671 $U{message}=~s~((?:[^\s<>]*:[^\s<>]*@)?[a-z0-9\-]+(?:\.[a-z0-9\-]+)+:\d+)(?![^<>]*>)~<<$1>>~ig; # server:port given
1672 $U{message}=~s~([^\s<>]*:[^\s<>]*@[a-z0-9\-]+(?:\.[a-z0-9\-]+)+(?::\d+)?)(?![^<>]*>)~<<$1>>~ig; # au:th@server given
1673 # 3. likely servers without any hints but not filenames like *.rar zip exe etc.
1674 $U{message}=~s~((?:[a-z0-9\-]+\.)*[a-z0-9]{16}\.onion)(?![^<>]*>)~<<$1>>~ig;# *.onion
1675 $U{message}=~s~([a-z0-9\-]+(?:\.[a-z0-9\-]+)+(?:\.(?!rar|zip|exe|gz|7z|bat|doc)[a-z]{2,}))(?=[^a-z0-9\-\.]|$)(?![^<>]*>)~<<$1>>~ig;# xxx.yyy.zzz
1676 # Convert every <<....>> into proper links:
1677 $U{message}=~s/<<([^<>]+)>>/url2hotlink($1)/ge;
1678}
1679
1680sub url2hotlink{
1681 # check for surrounding < > " " ( ) etc. and create hotlink
1682 my($pre,$url,$app)=$_[0]=~/^((?:&\w{1,7};)*)(.*?)((?:&\w{1,7};|[\{\[\(\)\]\}])*)$/;
1683 my $href= $url;
1684 my $path = substr $url, rindex($url, '/') + 1;
1685 $path = substr $path, rindex($path, '_') + 1;
1686 $url =~ s/www\.(.*\.(?:net|org|com|onion|ru|biz)).*/$1/;
1687 $url =~ s/https?\:\/\/(.*\.(?:net|org|com|onion|ru|biz)).*/$1/;
1688 $url =~ s!^https?://(?:www\.)?!!i;
1689 $url = "$url:$path" unless $url eq $path|$url or $path eq "";
1690 $href=~s/([\:\/\?\#\[\]\@\!\$\&\'\(\)\*\+\,\;\=\%])/sprintf("%%%02X",ord($1))/eg;
1691 return qq|$pre<a href="|.($C{useextderef}?$C{extderefurl}:$S).qq|?action=redirect&url=$href" target="_blank">$url</a>$app|;
1692}
1693
1694sub add_message{
1695 return unless $U{message};
1696 my %newmessage=(
1697 postdate =>$^T,
1698 postid =>$U{postid},
1699 poststatus=>$U{poststatus},
1700 poster =>$U{nickname},
1701 recipient =>$U{recipient},
1702 text =>$U{displaysend}.style_this($U{message},$U{fontinfo}),
1703 delstatus =>$U{delstatus}
1704 );
1705 write_message(%newmessage);
1706}
1707
1708sub add_staff_message{
1709 my $mes=$_[0]||$U{message};return unless $mes;
1710 my $nick=$_[1]||$U{displayname};
1711 $mes=~s/<NICK>/$nick/g;
1712 $C{messtaff}=~s/<NICK>//g;
1713 my %sysmessage=(
1714 postdate=>$^T,
1715 postid=>substr(rand(),-6),
1716 poststatus=>'6',
1717 text=>$C{messtaff}.$mes,
1718 delstatus=>'9'
1719 );
1720 write_message(%sysmessage);
1721}
1722
1723sub add_system_message{
1724 my $mes=$_[0]||$U{message};return unless $mes;
1725 my $nick=$_[1]||$U{displayname};
1726 $mes=~s/<NICK>/$nick/g;
1727 my %sysmessage=(
1728 postdate=>$^T,
1729 postid=>substr(rand(),-6),
1730 poststatus=>'1',
1731 text=>$mes,
1732 delstatus=>'9'
1733 );
1734 write_message(%sysmessage);
1735}
1736
1737sub write_message{my%message=@_;
1738 my @lines=open_file_rw(my$MESSAGES,'messages',my$ferr);send_error($ferr)if$ferr;
1739 while(my$line=shift@lines){
1740 my %temp=messagehash($line);
1741 print $MESSAGES $line unless expiredm($temp{postdate});
1742 }
1743 print $MESSAGES messageline(%message);
1744 $ferr=close_file($MESSAGES,'messages');send_error($ferr)if$ferr;
1745}
1746
1747sub clean_room{
1748 my %sysmessage=(
1749 postdate=>$^T,
1750 postid=>substr(rand(),-6),
1751 poststatus=>'1',
1752 text=>$C{roomclean},
1753 delstatus=>'9'
1754 );
1755 my $ferr=write_file('messages',messageline(%sysmessage));send_error($ferr)if$ferr;
1756}
1757
1758sub clean_selected{
1759 my %mids;foreach(@{$Q{mid}}){$mids{$_}=1}
1760 my @lines=open_file_rw(my$MESSAGES,'messages',my$ferr);send_error($ferr)if$ferr;
1761 while(my $line=shift@lines){
1762 my %temp=messagehash($line);
1763 print $MESSAGES $line unless(expiredm($temp{postdate}) or $mids{$temp{postdate}.$temp{postid}});
1764 }
1765 $ferr=close_file($MESSAGES,'messages');send_error($ferr)if$ferr;
1766}
1767
1768sub del_last_message{
1769 my @lines=open_file_rw(my$MESSAGES,'messages',my$ferr);send_error($ferr)if$ferr;
1770 for(my$i=@lines;$i>=0;$i--){
1771 my %temp=messagehash($lines[$i]);
1772 if($U{nickname}eq$temp{poster}){
1773 splice(@lines,$i,1);
1774 last;
1775 }
1776 }
1777 while(my$line=shift@lines){
1778 my %temp=messagehash($line);
1779 print $MESSAGES $line unless expiredm($temp{postdate});
1780 }
1781 $ferr=close_file($MESSAGES,'messages');send_error($ferr)if$ferr;
1782}
1783
1784sub del_all_messages{
1785 my $nick=$_[0]||$U{nickname};
1786 my @lines=open_file_rw(my$MESSAGES,'messages',my$ferr);send_error($ferr)if$ferr;
1787 while(my $line=shift@lines){
1788 my %temp=messagehash($line);
1789 print $MESSAGES $line unless(expiredm($temp{postdate}) or $temp{poster}eq$nick);
1790 }
1791 $ferr=close_file($MESSAGES,'messages');send_error($ferr)if$ferr;
1792}
1793
1794sub print_messages{my $delstatus=$_[0];
1795 my @lines=slurp_file('messages',my$ferr);
1796 return if$ferr;
1797 while(my $line=pop@lines){
1798 my %message=messagehash($line);
1799 if($delstatus){# select messages to delete
1800 if($U{status}>$message{delstatus}){
1801 print qq|<input type="checkbox" name="mid" id="$message{postdate}$message{postid}" value="$message{postdate}$message{postid}"><label for="$message{postdate}$message{postid}"> $message{text}</label><br>|unless expiredm($message{postdate});
1802 }
1803 }
1804 elsif($U{status}>=$message{poststatus} or $U{nickname}eq$message{poster} or $U{nickname}eq$message{recipient}){
1805 print "$message{text}<br>" unless expiredm($message{postdate});
1806 }
1807 }
1808}
1809
1810sub messagehash{
1811 my @fields=split('l',$_[0]);
1812 my %mes=(
1813 postdate =>pack('H*',$fields[0]),
1814 postid =>pack('H*',$fields[1]),
1815 poststatus=>pack('H*',$fields[2]),
1816 poster =>pack('H*',$fields[3]),
1817 recipient =>pack('H*',$fields[4]),
1818 text =>pack('H*',$fields[5]),
1819 delstatus =>pack('H*',$fields[6])
1820 );
1821 return %mes;
1822}
1823
1824sub messageline{
1825 my %mes=@_;
1826 my $m=
1827 unpack('H*',$mes{postdate}).'l'.
1828 unpack('H*',$mes{postid}).'l'.
1829 unpack('H*',$mes{poststatus}).'l'.
1830 unpack('H*',$mes{poster}).'l'.
1831 unpack('H*',$mes{recipient}).'l'.
1832 unpack('H*',$mes{text}).'l'.
1833 unpack('H*',$mes{delstatus})."l\n";
1834 return $m;
1835}
1836
1837######################################################################
1838# Superuser Setup
1839######################################################################
1840
1841sub send_init{
1842 my $result=create_files();
1843 $I{setsuhelp}=~s/<DATA>/$datadir/;
1844 $I{nickhelp}=~s/<MAX>/$C{maxname}/;
1845 $I{passhelp}=~s/<MIN>/$C{minpass}/;
1846 print_start('admin');
1847 print "<center><h2>LE CHAT - $I{initsetup}</h2>";
1848 print "<$H{form}>",hidden('action','init'),qq|<table cellspacing="0" width="1"><tr><td align=center><h3>$I{setsu}</h3><table cellspacing="0"><tr title="$I{nickhelp}"><td>$I{setsunick}</td><td><input type="text" name="sunick" size="15"></td></tr><tr title="$I{passhelp}"><td>$I{setsupass}</td><td><input type="text" name="supass" size="15"></td></tr><tr title="$I{passhelp}"><td>$I{setsupassconf}</td><td><input type="text" name="supassc" size="15"></td></tr></table><br><br></td></tr><tr><td align="left">$I{setsuhelp}<br><br><br></td></tr><tr><td align="center">|;
1849 print qq|<h3>$I{initback}</h3></td></tr><tr><td align="left">$I{initbackhelp}<br></td></tr><tr><td align="center"><textarea name="backupdata" rows="8" cols="80" wrap="off">$result</textarea><br><br></td></tr><tr><td align="center"><tr><td align="center"><br>|,submit($I{initbut}),"</td></tr></table></form><br>$H{versiontag}</center>";
1850 print_end();
1851}
1852
1853sub create_files{
1854 my $result='';
1855 # create directories if needed
1856 my @dirs=split('/',$datadir);my $dir='';
1857 while($_=shift@dirs){$dir.=$_;mkdir($dir,0700) unless -d$dir;$dir.='/'}
1858 chmod(0700,$datadir);
1859 # create files, keep existing ones
1860 create_file(qw(config members sessions messages waiting langedit));
1861 # check initial data in lechat.txt
1862 if(-e'./lechat.txt'){
1863 my $backupdata='';
1864 sysopen(LECHAT,'./lechat.txt',O_RDONLY) or return "$I{initlechattxt}\n$I{errfile} (lechat.txt/open)";
1865 flock(LECHAT,LOCK_SH) or return "$I{initlechattxt}\n$I{errfile} (lechat.txt/lock)";
1866 while(<LECHAT>){$backupdata.=$_};
1867 close(LECHAT);
1868 $result=get_restore_results('',$backupdata);
1869 $result="$I{initlechattxt}\n$result";
1870 unlink('./lechat.txt');
1871 load_config();
1872 }
1873 return $result;
1874}
1875
1876sub init_chat{
1877 $I{suerrbadnick}=~s/<MAX>/$C{maxname}/;
1878 $I{suerrbadpass}=~s/<MIN>/$C{minpass}/;
1879 # restore backups if given
1880 my $restore=$I{invalidbackup};
1881 $restore=get_restore_results() if $Q{backupdata}[0];
1882 $restore=~s/\n/<br>/g;
1883 # write superuser into "admin"
1884 my $suwrite;
1885 if(-e"$datadir/admin"){
1886 $suwrite=$I{suerrfileexist};
1887 }elsif(!valid_nick($Q{sunick}[0])){
1888 $suwrite=$I{suerrbadnick};
1889 }elsif(!allowed_pass($Q{supass}[0])){
1890 $suwrite=$I{suerrbadpass};
1891 }elsif($Q{supass}[0]ne$Q{supassc}[0]){
1892 $suwrite=$I{suerrbadpassc};
1893 }else{# all good data here
1894 $suwrite=write_admin(hash_this($Q{sunick}[0].hash_this($Q{sunick}[0]).hash_this($Q{supass}[0]).$Q{supass}[0]));
1895 }
1896 # Print results:
1897 print_start('admin');
1898 print "<center><h2>LE CHAT - $I{initsetup}</h2><br><h3>$I{setsu}</h3>$suwrite<br><br><br><h3>$I{initback}</h3>$restore<br><br><br>";
1899 print "<$H{form}>",hidden('action','setup'),hidden('nick',$Q{sunick}[0]),hidden('hexpass',unpack('H*',$Q{supass}[0])),submit($I{initgotosetup}),"</form><br>$H{versiontag}</center>";
1900 print_end();
1901}
1902
1903sub write_admin{
1904 write_file('admin',$_[0]);
1905 # read and verify data
1906 my($suverify)=slurp_file('admin');
1907 return $I{suwritesucc}if($_[0]eq$suverify);
1908 # delete again if not written correctly
1909 delete_file('admin');
1910 return $I{suwritefail};
1911}
1912
1913sub change_admin_status{
1914 $I{errbadnick}=~s/<MAX>/$C{maxname}/;
1915 $I{errbadpass}=~s/<MIN>/$C{minpass}/;
1916 my $err;my %temp;
1917 return $I{errnonick} unless $Q{admnick}[0];
1918 return $I{errbaddata} unless $Q{what}[0]=~/^new|up|down$/;
1919 if($Q{what}[0]eq'new'){
1920 return $I{errbadnick} unless valid_nick($Q{admnick}[0]);
1921 return $I{errbadpass} unless allowed_pass($Q{admpass}[0]);
1922 $Q{admnick}[0]=unpack('H*',cleanup_nick($Q{admnick}[0]));
1923 }
1924 my @lines=open_file_rw(my$MEMBERS,'members',my$ferr);send_error($ferr)if$ferr;
1925 foreach(@lines){
1926 %temp=memberhash($_);
1927 if(unpack('H*',$temp{nickname})eq$Q{admnick}[0]){
1928 if($Q{what}[0]eq'new'){$err=$I{errexistnick}}
1929 elsif($Q{what}[0]eq'up'){
1930 if($temp{status}==7){$temp{status}=8;$err=$I{raisemainsucc}}
1931 elsif($temp{status}==8){$err=$I{raisemaindone}}
1932 else{$err=$I{raisemainfail}}
1933 }
1934 elsif($Q{what}[0]eq'down'){
1935 if($temp{status}==8){$temp{status}=7;$err=$I{lowerregsucc}}
1936 elsif($temp{status}==7){$err=$I{lowerregdone}}
1937 else{$err=$I{lowerregfail}}
1938 }
1939 print $MEMBERS memberline(%temp);
1940 }
1941 else{
1942 print $MEMBERS $_;
1943 }
1944 $err=~s/<NICK>/$temp{nickname}/ if $err;
1945 }
1946 if($Q{what}[0]eq'new' and !$err){
1947 %temp=(nickname =>pack('H*',$Q{admnick}[0]),
1948 passhash =>hash_this(pack('H*',$Q{admnick}[0]).$Q{admpass}[0]),
1949 status =>8,
1950 refresh =>$C{defaultrefresh},
1951 colour =>$C{coltxt},
1952 entryrefresh =>$C{defaultrefresh},
1953 boxwidth =>$C{boxwidthdef},
1954 boxheight =>$C{boxheightdef});
1955 print $MEMBERS memberline(%temp);
1956 $err=$I{newmainreg};
1957 $err=~s/<NICK>/$temp{nickname}/;
1958 }
1959 $ferr=close_file($MEMBERS,'members');send_error($ferr)if$ferr;
1960 return $err;
1961}
1962
1963######################################################################
1964# backup and restore
1965######################################################################
1966
1967sub get_backup{my $fname=$_[0];
1968 my $finfo='langedit'eq$fname?'LANGUAGE':uc($fname);
1969 my $blob=join('n',slurp_file($fname,my$err)).'n';
1970 return $err if $err;
1971 my $fcomm=get_timestamp((stat("$datadir/$fname"))[9])." - $C{title}";
1972 $fcomm="Language: $I{languagename} ($I{languagecode}) - $version ($lastchanged)"if'language'eq$fname;
1973 $fcomm="Language: $L{languagename} ($L{languagecode}) - $version ($lastchanged)"if'langedit'eq$fname;
1974 $blob=~s/[^a-f0-9ln]//gi;
1975 $blob.='h'.hash_this($blob).'hi'.$finfo.'i';
1976 $blob="-----BEGIN LE CHAT $finfo-----\n$fcomm\n\n".encode_this($blob)."-----END LE CHAT $finfo-----";
1977 return $blob;
1978}
1979
1980sub get_restore_results{my($fname,$bdata)=@_;
1981 $fname||='language config members';
1982 $bdata||=$Q{backupdata}[0];
1983 $bdata=~s/\r\n/<br>/g;
1984 $bdata=~s/\n/<br>/g;
1985 $bdata=~s/\r/<br>/g;
1986 $bdata=~s/<br>/\n/g;
1987 (my $conf)=$bdata=~/-----BEGIN LE CHAT CONFIG-----.*?\n\n(.*)-----END LE CHAT CONFIG-----/s;
1988 (my $memb)=$bdata=~/-----BEGIN LE CHAT MEMBERS-----.*?\n\n(.*)-----END LE CHAT MEMBERS-----/s;
1989 (my $lang)=$bdata=~/-----BEGIN LE CHAT LANGUAGE-----.*?\n\n(.*)-----END LE CHAT LANGUAGE-----/s;
1990 return $I{invalidbackup} unless($memb or $conf or $lang);
1991 my $result='';
1992 $result.=restore_file('langedit',$lang)."\n"if$fname=~/langedit/ and$lang;
1993 $result.=restore_file('language',$lang)."\n"if$fname=~/language/ and$lang;
1994 $result.=restore_file('config' ,$conf)."\n"if$fname=~/config/ and$conf;
1995 $result.=restore_file('members' ,$memb)."\n"if$fname=~/members/ and$memb;
1996 return $result;
1997}
1998
1999sub restore_file{my($fname,$fdata)=@_;
2000 my $finfo='langedit'eq$fname?'LANGUAGE':uc($fname);
2001 my $ftype=substr($fname,0,4);
2002 my $content=decode_this($fdata);
2003 my($blob,$hash,$info)=$content=~/^([a-f0-9ln]*)h([a-f0-9]+)hi([A-Z]+)i$/;
2004 if(hash_this($blob)eq$hash and $finfo eq $info){
2005 $blob=~tr/n/\n/s;
2006 my $ferror=write_file($fname,$blob);
2007 if($ferror){return $I{$ftype.'restfail'}.' '.$ferror}
2008 load_config();
2009 return $I{$ftype.'restsucc'};
2010 }
2011 else{
2012 return $I{$ftype.'restinval'};
2013 }
2014}
2015
2016sub load_langedit{
2017 if(-e"$datadir/langedit"){
2018 my @lines=slurp_file('langedit',my$ferr);
2019 send_error($ferr)if$ferr;
2020 foreach(@lines){
2021 next unless /^[0-9a-f]/;
2022 my($ikey,$ival)=split('l',$_);
2023 $L{pack('H*',$ikey)}=pack('H*',$ival);
2024 }
2025 }
2026}
2027
2028sub save_langedit{
2029 open_file_wo(my$LANG,'langedit',my$ferr);send_error($ferr)if$ferr;
2030 my $start=tell(DATA);
2031 while(<DATA>){
2032 my($ikey,$ival)=$_=~/^([a-z_]+)\s*=(.+)/i;
2033 next unless $ikey;
2034 $ival=$Q{$ikey}[0]unless'stop_action'eq$ikey;
2035 $ival=~s/^\s*|\s*$//g;$ival=~s/\n//;$ival=~s/\r//;
2036 $ival=htmlactive($ival);
2037 print $LANG unpack('H*',$ikey),'l',unpack('H*',$ival),"l\n" if $ival;
2038 }
2039 seek(DATA,$start,0);
2040 $ferr=close_file($LANG,'langedit');send_error($ferr)if$ferr;
2041}
2042
2043######################################################################
2044# file handling
2045######################################################################
2046
2047sub get_guests_access{-s"$datadir/guests"||0}
2048sub get_chat_access{-s"$datadir/access"||0}
2049
2050sub set_guests_access{
2051 return if($_[0]<0 or $_[0]>3);
2052 write_file('guests','#'x$_[0]);
2053 expire_waiting_sessions()if$_[0]<3;
2054 $T{guests}=get_guests_access();
2055}
2056
2057sub set_chat_access{
2058 return if($_[0]<0 or $_[0]>2);
2059 write_file('access','#'x$_[0]);
2060 $T{access}=get_chat_access();
2061}
2062
2063sub slurp_file{# name,error
2064 sysopen(my$FH,"$datadir/$_[0]",O_RDONLY) or $_[1]="$I{errfile} ($_[0]/open)" and return;
2065 flock($FH,LOCK_SH) or $_[1]="$I{errfile} ($_[0]/lock)" and return;
2066 my @lines=<$FH>;
2067 close($FH) or $_[1]="$I{errfile} ($_[0]/close)" and return;
2068 return @lines;
2069}
2070
2071sub write_file{# name,text
2072 sysopen(my$FH,"$datadir/$_[0]",O_WRONLY|O_TRUNC|O_CREAT,0600) or return "$I{errfile} ($_[0]/open)";
2073 flock($FH,LOCK_EX) or return "$I{errfile} ($_[0]/lock)";
2074 print $FH $_[1] or return "$I{errfile} ($_[0]/print)";
2075 close($FH) or return "$I{errfile} ($_[0]/close)";
2076 return '';
2077}
2078
2079sub append_file{# name,text
2080 sysopen(my$FH,"$datadir/$_[0]",O_WRONLY|O_APPEND|O_CREAT,0600) or return "$I{errfile} ($_[0]/open)";
2081 flock($FH,LOCK_EX) or return "$I{errfile} ($_[0]/lock)";
2082 print $FH $_[1] or return "$I{errfile} ($_[0]/print)";
2083 close($FH) or return "$I{errfile} ($_[0]/close)";
2084 return '';
2085}
2086
2087sub open_file_rw{# FH,name,error
2088 sysopen($_[0],"$datadir/$_[1]",O_RDWR|O_CREAT,0600) or $_[2]="$I{errfile} ($_[1]/open)" and return;
2089 flock($_[0],LOCK_EX) or $_[2]="$I{errfile} ($_[1]/lock)" and return;
2090 my $FH=$_[0];
2091 my @lines=<$FH>;
2092 seek($_[0],0,0) or $_[2]="$I{errfile} ($_[1]/seek)" and return;
2093 truncate($_[0],0) or $_[2]="$I{errfile} ($_[1]/truncate)" and return;
2094 return @lines;
2095}
2096
2097sub open_file_wo{# FH,name,error
2098 sysopen($_[0],"$datadir/$_[1]",O_WRONLY|O_TRUNC|O_CREAT,0600) or $_[2]="$I{errfile} ($_[1]/open)" and return;
2099 flock($_[0],LOCK_EX) or $_[2]="$I{errfile} ($_[1]/lock)" and return;
2100}
2101
2102sub open_file_ro{# FH,name,error
2103 sysopen($_[0],"$datadir/$_[1]",O_RDONLY) or $_[2]="$I{errfile} ($_[1]/open)" and return;
2104 flock($_[0],LOCK_SH) or $_[2]="$I{errfile} ($_[1]/lock)" and return;
2105}
2106
2107sub close_file{# FH,name
2108 close($_[0]) or return "$I{errfile} ($_[1]/close)";
2109 return '';
2110}
2111
2112sub create_file{foreach(@_){write_file($_)unless(-e"$datadir/$_")}}
2113sub delete_file{foreach(@_){unlink("$datadir/$_")}}
2114
2115######################################################################
2116# this and that
2117######################################################################
2118
2119sub expiredm{($^T-$_[0]>60*$C{messageexpire})}
2120sub expireds{($^T-$_[0]>60*($_[1]>1?$C{sessionexpire}:$C{guestsexpire}))}
2121sub expiredw{($^T-$_[0]>60*$C{waitingexpire})}
2122sub valid_nick{!($_[0]=~/[^\w\d\s\(\)\[\]\{\}\=\/\-\!\@\#\$\%\?\+\*\^\.]/g or $_[0]!~/[a-z0-9]/i)}
2123sub allowed_nick{$_[0]=~/^.{4,$C{maxname}}$/}
2124sub specialchar{$_[0] =~ m/[^a-zA-Z0-9]/}
2125sub onlynum{$_[0] =~ /^(?![A-Za-z]).*/}
2126sub allowed_pass{($_[0]=~/^.{$C{minpass},}$/)}
2127sub consecutivechar{$_[0] =~ /(.)\1{2}/}
2128sub similar_nick{my$x=lc($_[0]);my$y=lc($_[1]);$x=~y/a-z0-9//cd;$y=~y/a-z0-9//cd;$x eq $y?1:0}
2129sub cleanup_nick{my$nick=$_[0];$nick=~s/^\s+//;$nick=~s/\s+$//;$nick=~s/\s+/ /g;$nick}
2130sub hash_this{require Digest::MD5;Digest::MD5::md5_hex($_[0])}
2131sub encode_this{require MIME::Base64;MIME::Base64::encode_base64($_[0])}
2132sub decode_this{require MIME::Base64;MIME::Base64::decode_base64($_[0])}
2133sub get_timestamp{my($sec,$min,$hour,$day,$mon,$year)=gmtime($_[0]||$^T);$year+=1900;$mon++;foreach($sec,$min,$hour,$day,$mon){$_=substr('0'.$_,-2,2)}return"$year-$mon-$day $hour:$min:$sec"}
2134
2135sub get_timeout{ # lastpost, status
2136 my $s=$_[0]+(60*($_[1]>1?$C{sessionexpire}:$C{guestsexpire}))-$^T;
2137 my $m=int($s/60);$s-=$m*60;
2138 my $h=int($m/60);$m-=$h*60;
2139 $s=substr('0'.$s,-2,2);
2140 $m=substr('0'.$m,-2,2)if$h;
2141 return $h?"$h:$m:$s":"$m:$s";
2142}
2143
2144sub print_colours{
2145 # Prints a short list with selected named HTML colours and filters out illegible text colours for the given background.
2146 # It's a simple comparison of weighted grey values. This is not very accurate but gets the job done well enough.
2147 # If you want more accuracy, do some research about "Delta E", though the serious math involved there is not worth the effort just for this here I guess. ;)
2148 my %colours=(Beige=>'F5F5DC',Black=>'000000',Blue=>'0000FF',BlueViolet=>'8A2BE2',Brown=>'A52A2A',Cyan=>'00FFFF',DarkBlue=>'00008B',DarkGreen=>'006400',DarkRed=>'8B0000',DarkViolet=>'9400D3',DeepSkyBlue=>'00BFFF',Gold=>'FFD700',Grey=>'808080',Green=>'008000',HotPink=>'FF69B4',Indigo=>'4B0082',LightBlue=>'ADD8E6',LightGreen=>'90EE90',LimeGreen=>'32CD32',Magenta=>'FF00FF',Olive=>'808000',Orange=>'FFA500',OrangeRed=>'FF4500',Purple=>'800080',Red=>'FF0000',RoyalBlue=>'4169E1',SeaGreen=>'2E8B57',Sienna=>'A0522D',Silver=>'C0C0C0',Tan=>'D2B48C',Teal=>'008080',Violet=>'EE82EE',White=>'FFFFFF',Yellow=>'FFFF00',YellowGreen=>'9ACD32');
2149 my $greybg=greyval($C{colbg});
2150 foreach(sort keys %colours){
2151 print qq|<option value="$colours{$_}" style="color:#$colours{$_}">$I{$_}</option>|unless(abs($greybg-greyval($colours{$_}))<75);
2152 }
2153}
2154
2155sub greyval{hex(substr($_[0],0,2))*.3+hex(substr($_[0],2,2))*.59+hex(substr($_[0],4,2))*.11}
2156
2157sub get_style{my $styleinfo="@_";
2158 (my $fbold)=$styleinfo=~/(<i?bi?>|:bold)/;
2159 (my $fitalic)=$styleinfo=~/(<b?ib?>|:italic)/;
2160 (my $fsmall)=$styleinfo=~/(size="-1"|:smaller)/;
2161 (my $fcolour)=$styleinfo=~/(#.{6})/;
2162 (my $fface)=$styleinfo=~/face="([^"]+)"/;
2163 (my $sface)=$styleinfo=~/font-family:([^;]+);/;
2164 if($fface ne ''){$sface=$fface;$sface=~s/^/'/;$sface=~s/$/'/;$sface=~s/,/','/g}
2165 else{$fface=$sface;$fface=~s/'//}
2166 my $fstyle='';
2167 $fstyle.="color:$fcolour;"if$fcolour;
2168 $fstyle.="font-family:$sface;"if$sface;
2169 $fstyle.='font-size:smaller;'if$fsmall;
2170 $fstyle.='font-style:italic;'if$fitalic;
2171 $fstyle.='font-weight:bold;'if$fbold;
2172 return $fstyle;
2173}
2174
2175sub style_this{my($text,$styleinfo)=@_;
2176 (my $fbold)=$styleinfo=~/(<i?bi?>|:bold)/;
2177 (my $fitalic)=$styleinfo=~/(<b?ib?>|:italic)/;
2178 (my $fsmall)=$styleinfo=~/(size="-1"|:smaller)/;
2179 (my $fcolour)=$styleinfo=~/(#.{6})/;
2180 (my $fface)=$styleinfo=~/face="([^"]+)"/;
2181 (my $sface)=$styleinfo=~/font-family:([^;]+);/;
2182 if($fface ne ''){$sface=$fface;$sface=~s/^/'/;$sface=~s/$/'/;$sface=~s/,/','/g}
2183 else{$fface=$sface;$fface=~s/'//}
2184 my $fstyle='';
2185 $fstyle.="color:$fcolour;"if$fcolour;
2186 $fstyle.="font-family:$sface;"if$sface;
2187 $fstyle.='font-size:smaller;'if$fsmall;
2188 $fstyle.='font-style:italic;'if$fitalic;
2189 $fstyle.='font-weight:bold;'if$fbold;
2190 my $fstart='<font';
2191 $fstart.=qq| color="$fcolour"|if$fcolour;
2192 $fstart.=qq| face="$fface"|if$fface;
2193 $fstart.=qq| size="-1"|if$fsmall;
2194 $fstart.=qq| style="$fstyle"|if$fstyle;
2195 $fstart.='>';
2196 $fstart.='<b>'if$fbold;
2197 $fstart.='<i>'if$fitalic;
2198 my $fend='';
2199 $fend.='</i>'if$fitalic;
2200 $fend.='</b>'if$fbold;
2201 $fend.='</font>';
2202 return "$fstart$text$fend";
2203}
2204
2205######################################################################
2206# configuration, defaults and internals
2207######################################################################
2208
2209sub load_config{
2210 set_internal_defaults();
2211 if(-e"$datadir/language"){# load language file
2212 open_file_ro(my$LANG,'language',my$ferr);send_fatal($ferr)if$ferr;
2213 while(<$LANG>){
2214 next unless /^[0-9a-f]/;
2215 my($ikey,$ival)=split('l',$_);
2216 $ikey=pack('H*',$ikey);
2217 $ival=pack('H*',$ival);
2218 last if('stop_action'eq$ikey and $ival=~/-$Q{action}[0]-/);# only load what we need
2219 $I{$ikey}=$ival;
2220 }
2221 $ferr=close_file($LANG,'language');send_fatal($ferr)if$ferr;
2222 }
2223 set_config_defaults();
2224 open_file_ro(my$CONFIG,'config',my$ferr);send_fatal($ferr)if$ferr;
2225 while(<$CONFIG>){
2226 next unless /^[0-9a-f]/;
2227 my($ckey,$cval)=split('l',$_);
2228 $ckey=pack('H*',$ckey);
2229 $cval=pack('H*',$cval);
2230 last if('stop_action'eq$ckey and $cval=~/-$Q{action}[0]-/);# only load what we need
2231 $C{$ckey}=$cval;
2232 }
2233 $ferr=close_file($CONFIG,'config');send_fatal($ferr)if$ferr;
2234 set_html_vars();
2235 $T{guests}=get_guests_access();# guest settings
2236 $T{access}=get_chat_access();# suspended?
2237}
2238
2239sub save_config{
2240 open_file_wo(my$CONFIG,'config',my$ferr);send_error($ferr)if$ferr;
2241 foreach(qw(redirifsusp redirtourl title favicon kickederror coltxt colbg collnk colvis colact sessionexpire guestsexpire messageexpire waitingexpire kickpenalty defaultrefresh minrefresh maxrefresh maxmessage maxname minpass floodlimit boxwidth boxheight allowmultiline allowfonts allowpms cssglobal styleback csserror cssview csswait stylecheckwait stylewaitrel roomentry useextderef createlinks linksswitch))
2242 {print $CONFIG unpack('H*',$_),'l',unpack('H*',$C{$_}),"l\n"}print $CONFIG unpack('H*','stop_action'),'l',unpack('H*','-view-wait-redirect-'),"l\n";
2243 foreach(qw(mesall mesmem mespm messtaff csspost styleposttext stylepostsend stylesendlist styledellast styledelall styleswitch extderefurl textfilters kickedmessage))
2244 {print $CONFIG unpack('H*',$_),'l',unpack('H*',$C{$_}),"l\n"}print $CONFIG unpack('H*','stop_action'),'l',unpack('H*','-post-delete-'),"l\n";
2245 foreach(qw(header footer noguests guestaccess rndguestcol loginbutton nowchatting csslogin stylelogintext stylecolselect styleenter tableattributes frameattributes framesizes))
2246 {print $CONFIG unpack('H*',$_),'l',unpack('H*',$C{$_}),"l\n"}print $CONFIG unpack('H*','stop_action'),'l',unpack('H*','--'),"l\n";
2247 foreach(qw(csscontrols stylerelpost stylerelmes styleprofile styleadmin stylerules styleexit cssprofile))
2248 {print $CONFIG unpack('H*',$_),'l',unpack('H*',$C{$_}),"l\n"}print $CONFIG unpack('H*','stop_action'),'l',unpack('H*','-controls-profile-colours-'),"l\n";
2249 foreach(qw(cssrules rulestxt links entrymessage roomexit logoutmessage roomclean))
2250 {print $CONFIG unpack('H*',$_),'l',unpack('H*',$C{$_}),"l\n"}print $CONFIG unpack('H*','stop_action'),'l',unpack('H*','-help-entry-login-logout-'),"l\n";
2251 foreach(qw(regmessage styledelsome cssadmin lastchangedby lastchangedat))
2252 {print $CONFIG unpack('H*',$_),'l',unpack('H*',$C{$_}),"l\n"}print $CONFIG unpack('H*','stop_action'),'l',unpack('H*',''),"l\n";
2253 $ferr=close_file($CONFIG,'config');send_error($ferr)if$ferr;
2254}
2255
2256sub set_config{
2257 foreach(keys %C){$C{$_}=htmlactive($Q{$_}[0]);$C{$_}=~s/^\s+|\s+$//g;}
2258 $C{textfilters}=filters_from_queries();
2259 $C{lastchangedby}=$U{nickname};
2260 $C{lastchangedat}=get_timestamp();
2261 check_config();
2262 set_html_vars();
2263}
2264
2265sub check_config{
2266 # Revert to defaults if invalid or empty
2267 foreach(qw(colbg coltxt collnk colvis colact)){$C{$_}=''if$C{$_}!~/^[a-f0-9]{6}$/i}
2268 $C{colbg} ||='000000';
2269 $C{coltxt}||='FFFFFF';
2270 $C{collnk}||='6666FF';
2271 $C{colvis}||='FF66FF';
2272 $C{colact}||='FF0033';
2273 foreach(qw(sessionexpire guestsexpire messageexpire waitingexpire kickpenalty defaultrefresh minrefresh maxrefresh maxmessage maxname minpass floodlimit boxwidthdef boxheightdef)){$C{$_}=~y/0-9//cd;$C{$_}=~s/^0+//}
2274 $C{sessionexpire} ||='15';
2275 $C{guestsexpire} ||='10';
2276 $C{messageexpire} ||='10';
2277 $C{waitingexpire} ||='5';
2278 $C{kickpenalty} ||='10';
2279 $C{defaultrefresh}||='20';
2280 $C{minrefresh} ||='15';
2281 $C{maxrefresh} ||='150';
2282 $C{maxmessage} ||='1000';
2283 $C{maxname} ||='20';
2284 $C{minpass} ||='10';
2285 $C{floodlimit} ||='1';
2286 $C{boxwidthdef} ||='40';
2287 $C{boxheightdef} ||='3';
2288 # Use language defaults if emptied
2289 $C{title}||='LE CHAT';
2290 foreach(qw(header footer noguests guestaccess loginbutton rulestxt links entrymessage logoutmessage kickederror roomentry roomexit regmessage kickedmessage roomclean nowchatting mesall mesmem mespm messtaff)){$C{$_}||=$I{"c$_"}}
2291 $C{framesizes}='100,*,80'if($C{framesizes}!~/^(?:\d+\%?|\*)\,(?:\d+\%?|\*)\,(?:\d+\%?|\*)$/);
2292}
2293
2294sub set_config_defaults{
2295 # define keys
2296 %C=();foreach(qw(
2297 lastchangedby lastchangedat
2298 redirifsusp redirtourl
2299 createlinks linksswitch useextderef extderefurl allowmultiline allowfonts allowpms
2300 title favicon
2301 header footer noguests guestaccess loginbutton rulestxt links entrymessage logoutmessage kickederror roomentry roomexit regmessage kickedmessage roomclean nowchatting
2302 mesall mesmem mespm messtaff
2303 textfilters
2304 rndguestcol sessionexpire guestsexpire messageexpire waitingexpire kickpenalty defaultrefresh minrefresh maxrefresh maxmessage maxname minpass floodlimit boxwidthdef boxheightdef
2305 coltxt colbg collnk colvis colact
2306 cssglobal styleback cssview styledelsome stylecheckwait csswait stylewaitrel csspost styleposttext stylepostsend stylesendlist styledellast styledelall styleswitch csscontrols stylerelpost stylerelmes styleprofile styleadmin stylerules styleexit csslogin stylelogintext stylecolselect styleenter csserror cssprofile cssrules cssadmin tableattributes frameattributes framesizes
2307 )){$C{$_}=''}
2308 # initial defaults
2309 $C{lastchangedby}='-';
2310 $C{lastchangedat}='-';
2311 $C{createlinks}='1';
2312 $C{linksswitch}='1';
2313 $C{allowmultiline}='1';
2314 $C{allowfonts}='1';
2315 $C{allowpms}='1';
2316 $C{rndguestcol}='1';
2317 $C{textfilters}=$I{ctextfilters};
2318 $C{favicon}='data:image/gif;base64,R0lGODlhEAAQALMAAP///wAAAEBAQICAgAAAgIAAgACAgMDAwICAgP8AAAD/AP//AAAA//8A/wD//////ywAAAAAEAAQAAAEPBAMQGW9dITB9cSVFoxBOH4SuWWbx5KTa5lrimKyDOp6KKK9FMx0Ew1ZF+Pp01PWmqoVpyaMHjOdbKcSAQA7';
2319 $C{cssglobal}="input,select,textarea{color:#FFFFFF;background-color:#000000;}\nbody{background-image:url(data:image/gif;base64,R0lGODdhCAAIALMAAAAAADMzMwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAACAAIAAAEChDISQO9OOu6dwQAOw==);}";
2320 $C{styleback}='background-color:#004400;color:#FFFFFF;';
2321 $C{styledelsome}='background-color:#660000;color:#FFFFFF;';
2322 $C{stylecheckwait}='background-color:#660000;color:#FFFFFF;';
2323 $C{stylecolselect}='text-align:center;';
2324 $C{csserror}='body{color:#FF0033;}';
2325 $C{tableattributes}='border="2" width="1" rules="none"';
2326 $C{frameattributes}='border="3" frameborder="3" framespacing="3"';
2327 # required defaults
2328 check_config();
2329}
2330
2331sub set_internal_defaults{
2332 %F=(# fonts. TODO: review these and choose some cross-platform friendly items
2333 'Arial' =>' face="Arial,Helvetica,sans-serif"',
2334 'Book Antiqua' =>' face="Book Antiqua,MS Gothic"',
2335 'Comic' =>' face="Comic Sans MS,Papyrus"',
2336 'Comic small' =>' face="Comic Sans MS,Papyrus" size="-1"',
2337 'Courier' =>' face="Courier New,Courier,monospace"',
2338 'Cursive' =>' face="Cursive,Papyrus"',
2339 'Fantasy' =>' face="Fantasy,Futura,Papyrus"',
2340 'Garamond' =>' face="Garamond,Palatino,serif"',
2341 'Georgia' =>' face="Georgia,Times New Roman,Times,serif"',
2342 'Serif' =>' face="MS Serif,New York,serif"',
2343 'System' =>' face="System,Chicago,sans-serif"',
2344 'Times New Roman'=>' face="Times New Roman,Times,serif"',
2345 'Verdana' =>' face="Verdana,Geneva,Arial,Helvetica,sans-serif"',
2346 'Verdana small' =>' face="Verdana,Geneva,Arial,Helvetica,sans-serif" size="-1"'
2347 );
2348 # Load default internal messages from __DATA__
2349 my $start=tell(DATA);
2350 while(<DATA>){
2351 my($ikey,$ival)=$_=~/^([a-z_]+)\s*=(.+)/i;
2352 next unless $ikey;
2353 last if('stop_action'eq$ikey and $ival=~/-$Q{action}[0]-/);# only load what we need
2354 $I{$ikey}=$ival;
2355 }
2356 seek(DATA,$start,0);# rewind for second use
2357}
2358
2359sub set_html_vars{
2360 %H=(# default HTML
2361 begin_html =>qq|\n<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">\n<html>\n|,
2362 begin_frames =>qq|\n<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">\n<html>\n|,
2363 begin_body =>qq|\n<body bgcolor="#$C{colbg}" text="#$C{coltxt}" link="#$C{collnk}" alink="#$C{colact}" vlink="#$C{colvis}">\n|,
2364 encoding =>'iso-8859-1',
2365 # Don't change the encoding or existing member passes with special characters will break!
2366 # Maybe I'll finally switch to utf-8 in v2.0 and break support for legacy browsers.
2367 # The whole variety of encodings, especially with passwords, is a global nightmare already. :(
2368 end_body =>"\n</body>",
2369 end_html =>"\n</html>\n\n<!-- LE CHAT $version ($lastchanged) Original script available at: http://4fvfamdpoulu2nms.onion/lechat/ -->\n\n",
2370 form =>qq|form action="$S" method="post" style="margin:0;padding:0;"|,
2371 add_css =>'',
2372 versiontag =>"<small>LE CHAT - $version</small>",
2373 );%H=(%H,
2374 meta_html =>qq|\n<title>$C{title}</title>\n|.linkrel($C{favicon}).qq|<meta name="robots" content="noindex,nofollow">\n<meta http-equiv="Content-Type" content="text/html; charset=$H{encoding}">\n<meta http-equiv="Content-Language" content="$I{languagecode}">\n<meta http-equiv="Pragma" content="no-cache">\n<meta http-equiv="expires" content="0">|,
2375 backtologin =>qq|<$H{form} target="_parent">|.submit($I{backtologin},qq| style="$C{styleback}"|).'</form>',
2376 backtochat =>qq|<$H{form}>|.hidden('action','view').hidden('session',$Q{session}[0]).submit($I{backtochat},qq| style="$C{styleback}"|).'</form>',
2377 backtoprofile=>qq|<$H{form}>|.hidden('action','profile').hidden('session',$Q{session}[0]).submit($I{backtoprofile},qq| style="$C{styleback}"|).'</form>',
2378 backtosetup =>qq|<$H{form}>|.hidden('action','setup').hidden('nick',$Q{nick}[0]).hidden('hexpass',$Q{hexpass}[0]||unpack('H*',$Q{pass}[0])).submit($I{backtosetup},qq| style="$C{styleback}"|).'</form>',
2379 );
2380 ##############################################################
2381 # add banner killers and other corrections for known servers #
2382 # to be updated regularly... tell me your favourite hosts! #
2383 ##############################################################
2384 if($ENV{SERVER_NAME}=~m/\.atpages\.jp$/){
2385 $H{add_css}.="div{display:none !important; max-width:0px; max-height:0px; overflow:hidden !important}\n";
2386 $H{begin_body}.='<div style="display:block !important; width:98%; height:98%; max-width:98%; max-height:98% ;position:absolute; top:1%; left:1%; z-index:1000; overflow:visible !important">';
2387 $H{end_body}='<noembed><noframes><xml><xmp>'.$H{end_body};
2388 foreach(qw(form backtologin backtochat backtoprofile backtosetup)){$H{$_}=~s/method="post"/method="get"/}# large IP-bans on POST requests
2389 }
2390 elsif($ENV{SERVER_NAME}=~m/\.tok2\.com$/){
2391 $H{begin_body}='<noembed><noframes><noscript><body></noscript></noframes></noembed>'.$H{begin_body};
2392 $H{end_body}='<noembed><noframes><noscript>'.$H{end_body};
2393 $ENV{REMOTE_ADDR}=$ENV{HTTP_X_FORWARDED_FOR}if($ENV{REMOTE_ADDR}eq$ENV{SERVER_ADDR}and$ENV{HTTP_X_FORWARDED_FOR});# fix for some misconfigured tok2-servers
2394 }
2395 elsif($ENV{SERVER_NAME}=~m/\.h(ut)?\d+?\.ru$/){
2396 $H{end_html}.='<div style="display:none"><noembed><xml><xmp>';
2397 }
2398 elsif($ENV{SERVER_NAME}=~m/\.fatal\.ru$/){
2399 $H{end_body}='<div style="display:none"><noembed><xml><xmp><!--'.$H{end_body};
2400 }
2401 elsif($ENV{SERVER_NAME}=~m/\.onion$/){
2402 $ENV{REMOTE_ADDR}=$I{unknownip};# there are no IPs in Torland ;)
2403 }
2404}
2405
2406######################################################################
2407# cgi stuff
2408######################################################################
2409sub GetQuery{read(STDIN,my$q,$ENV{CONTENT_LENGTH}||0);QueryHash($q)}
2410sub GetParam{QueryHash($ENV{QUERY_STRING}||'')}
2411sub QueryHash{my($n,$v,%h);foreach(split(/&|;/,$_[0])){($n,$v)=split(/=/,$_);$v=~tr/+/ /;$v=~s/%([\dA-Fa-f]{2})/pack('C',hex($1))/eg;$h{$n}||=[];push@{$h{$n}},$v}return%h}
2412sub GetScript{$0=~/([^\\\/]+)$/;$1||die}
2413######################################################################
2414# Internal messages. Don't edit here, use the setup-page as superuser
2415# and create a language file. If you want to share, send me a copy!
2416######################################################################
2417__DATA__
2418languagename=English
2419languagecode=en-gb
2420# login page
2421nickname =Nickname:
2422password =Password:
2423nickhelp =4 characters minimun, <MAX> characters maximum, no special characters allowed
2424passhelp =at least <MIN> characters required
2425selcolguests =Guests, choose a good password and a colour:
2426selcoldefault=Room Default
2427selcolrandom =Random Colour
2428unknownip =not available
2429# colour names
2430Beige =beige
2431Black =black
2432Blue =blue
2433BlueViolet =blue violet
2434Brown =brown
2435Cyan =cyan
2436DarkBlue =dark blue
2437DarkGreen =dark green
2438DarkRed =dark red
2439DarkViolet =dark violet
2440DeepSkyBlue=sky blue
2441Gold =gold
2442Grey =grey
2443Green =green
2444HotPink =hot pink
2445Indigo =indigo
2446LightBlue =light blue
2447LightGreen =light green
2448LimeGreen =lime green
2449Magenta =magenta
2450Olive =olive
2451Orange =orange
2452OrangeRed =orange red
2453Purple =purple
2454Red =red
2455RoyalBlue =royal blue
2456SeaGreen =sea green
2457Sienna =sienna
2458Silver =silver
2459Tan =tan
2460Teal =teal
2461Violet =violet
2462White =white
2463Yellow =yellow
2464YellowGreen=yellow green
2465# link redirects
2466linkredirect=Redirecting to:
2467linknonhttp =Non-http link requested:
2468linktryhttp =Try link as http:
2469errnolinks =Link redirection is disabled.
2470# suspended page
2471suspended=Suspended
2472susptext =This chat is currently not available. Please try again later!
2473redirtext=Please try this alternate address!
2474# error messages
2475fatalerror =Fatal Error!
2476error =Error:
2477errfile =file error
2478errexpired =invalid/expired session
2479erraccdenied=access denied
2480errnoguests =no guests allowed at this time
2481backtologin =Back to the login page.
2482# messages frame
2483members =Members:
2484guests =Guests:
2485butcheckwait=Check <COUNT> Newcomer(s)
2486navbot =bottom
2487navtop =top
2488# config default text
2489cheader =<h1>LE CHAT</h1>Your IP address is <IP><br><br>
2490cfooter =<br><VER>
2491cnoguests =Only members at this time!
2492cloginbutton =Enter LE CHAT
2493crulestxt =Just be nice!
2494clinks =You can change or turn off the links in settings.
2495centrymessage =Welcome <NICK> to LE CHAT
2496clogoutmessage=Bye <NICK>, visit again soon!
2497ckickederror =<NICK>, you have been kicked out of LE CHAT!
2498croomentry =<NICK> enters LE CHAT!
2499croomexit =<NICK> leaves LE CHAT.
2500cregmessage =<NICK> is now a registered member of LE CHAT.
2501ckickedmessage=<NICK> has been kicked out of LE CHAT!
2502croomclean =Messages have been cleaned.
2503cnowchatting =Currently <COUNT> chatter(s) in room:<br><NAMES>
2504cmesall =<NICK> >
2505cmesmem =<NICK> >>
2506cmespm =<font color="white">[PM to <RECP>]</font> <NICK> >>
2507cmesstaff =<font color="white">[Staff]</font> <NICK> >>
2508ctextfilters =1"fuck"1"***BEEEP!!!***"1<>2"http(s?)://"1"hxxp$1://"1
2509stop_action=--view-redirect-
2510# post box frame
2511butsendto =talk to
2512seltoall =all chatters
2513seltomem =members only
2514seltoadm =staff only
2515butdellast =Delete last message
2516butdelall =Delete all messages
2517butmultiline =Switch to multi line
2518butsingleline=Switch to single line
2519kickfilter =<NICK> has triggered an autokick filter!
2520butupload =Uploader
2521stop_action=-post-delete-
2522# waiting room
2523waitroom =Waiting Room
2524waitmessage=Welcome <NICK>, you are currently in the waiting room. Please be patient until an admin will let you into the chat room.<br><br>If this page doesn't refresh every <REFRESH> seconds, use the button below to reload it manually!
2525butreloadw =Reload Page
2526# various occasions
2527backtochat =Back to the chat.
2528savechanges=save changes
2529# error messages
2530errbadnick =invalid nickname (<MAX> characters max, 4 characters min, no special characters allowed, and name needs to make sense)
2531errnonick =No nickname given.
2532errexistnick=Nick exists already.
2533erraccdenied=access denied
2534errbadpass =invalid password (at least <MIN> characters required)
2535errbadlogin =invalid nickname/password
2536# entry page
2537entryhelp=If this frame does not reload in <REFRESH> seconds, you'll have to enable automatic redirection (meta refresh) in your browser. Also make sure no web filter, local proxy tool or browser plugin is preventing automatic refreshing! This could be for example "Polipo", "NoScript", "TorButton", "Proxomitron", etc. just to name a few.<br>As a workaround (or in case of server/proxy reload errors) you can always use the buttons at the bottom to refresh manually.
2538frames =This chat uses <b>frames</b>. Please enable frames in your browser or use a suitable one!
2539stop_action=-wait-login-entry-logout-
2540# controls frame
2541butreloadp=Reload Post Box
2542butreloadm=Reload Messages
2543butprofile=Change Profile
2544butadmin =Admin
2545butrules =Rules & Help
2546butlinks =Links
2547butexit =Exit Chat
2548stop_action=-controls-
2549# profile page
2550profileheader=Your Profile
2551refreshrate =Refresh rate (<MIN>-<MAX> seconds)
2552entryrefresh =Entry page delay (1-<DEFAULT> seconds)
2553fontcolour =Font colour
2554viewcolours =view examples
2555fontface =Font face
2556fontdefault =Room Default
2557fontbold =bold
2558fontitalic =italic
2559fontexample =example for your chosen font
2560boxsizes =Post box size
2561boxwidth =width:
2562boxheight =height:
2563changepass =Change Password
2564oldpass =old password:
2565newpass =new password:
2566confirmpass =confirm new password:
2567succchanged =Your profile was successfully saved.
2568errdiffpass =Password confirmation does not match.
2569errwrongpass =Password is wrong.
2570# colourtable
2571colheader =Colourtable
2572backtoprofile=Back to your profile.
2573stop_action=-profile-colours-
2574# rules and help page
2575rules =Rules
2576help =Help
2577helpguests=<b>Make sure you read the rules.</b> All functions are the same as every other LE CHAT. Just use the buttons. In your profile you can adjust the refresh rate, font colour and your preferred input box size.<br><u>Note:</u> This is a chat, so if you don't keep talking, you will be automatically logged out after a certain amount of time.<p>In this chat you can use Emojicons to express yourself. All you need to do is type the emoji name in between two :: Giving an example, if you wanted to do the "inlove" emoji you would type :inlove: where you wanted the emoji to go. "I was so :inlove:" <p>The list of emojis are: afk angel animated-hearts areyouthere askeye bang-your-head bat beer biker blow-kiss blush brb bye callyou castaway chicken circle-of-hearts club-me danceban dancing dracula drool dunno eyes finger flamming giveup goodjob googly-eyes greetings heart heart-wings hmm holdon imw inlove insane joint lightbulb likeavirgin lol lurk mallet mob ninja no omfg party popcorn puppybark right_on rip rofl rules sealed-shut shock shock2 shy sign_pervert sleep smile snowman spinning star sunflower swirl swirlcolor taunt teddy waiting wakka wave waytogo welcome whacky why yes
2578helpregs =<p></p><b>Members:</b> You'll have some more options in your profile. You can adjust your font face and you can change your password anytime. You also don't need to type the capcha when loggin in, just your password would do.
2579helpmods =<b>Moderators:</b> Notice the Admin-button at the bottom. It'll bring up a page where you can clean the room, kick chatters, view all active sessions and disable guest access completely if needed. To moderate please use the admin panel or type the needed command in the post box: <p></p>To clean the room text: /clean room <p></p> To kick a user: /kick [reasonforkick]@[username] <p>Use the /name [username] command to ban user names from the chat.<p></p> To completely clear users messages: /delmess [username] <p></p> To logout user: /logout [username].
2580helpadmins=<b>Admins:</b> You'll be furthermore able to register guests, edit members and register new nicks without them being in the room.
2581stop_action=-help-
2582# admin waiting room/sessions
2583admwaiting =Guests in Waiting Room
2584admsessions =Active Sessions
2585nicklist =Nickname
2586timeoutin =Timeout in
2587ip =IP-Number
2588useragent =Browser-Identification
2589allowchecked=allow checked
2590allowall =allow all
2591denychecked =deny checked
2592denyall =deny all
2593denymessage =Send message to denied:
2594butallowdeny=allow/deny
2595waitempty =No more entry requests to approve.
2596# admin page
2597admheader =Administrative Functions
2598admclean =Clean Messages
2599admcleanall =whole room
2600admcleansome =selection
2601butdelsome =delete selected messages
2602admkick =Kick Chatter (<KICK> minutes)
2603admkickmes =Send hint:
2604admkickpurge =also purge messages
2605adminactive =Logout Inactive Chatter
2606admvsessions =View Active Sessions
2607admguests =Guest Access
2608admguestsoff =always forbid
2609admguestson =always allow
2610admguestsauto =allow while an admin is present
2611admguestsmod =allow while an mod is present
2612admguestsbell =require admin approval for entry
2613admregguest =Register Guest
2614admmembers =Members
2615admregnew =Register New Member
2616selmemdelete =delete from file
2617selmemdeny =deny access
2618selmemreg =set to regular
2619selmemmod =set to moderator
2620selmemadmin =set to admin
2621selchoose =(choose)
2622symdenied =(!)
2623symguest =(G)
2624symmod =(M)
2625symadmin =(A)
2626butadmclean =clean
2627butadmkick =kick
2628butadminactive=logout
2629butadmview =view
2630butadmset =set
2631butadmreg =register
2632butadmstatus =change
2633butadmregnew =register
2634# admin messages
2635succreg ="<NICK>" successfully registered.
2636succstatus =Status of "<NICK>" successfully changed.
2637succdelmem ="<NICK>" successfully deleted from file.
2638errcantreg =cannot register "<NICK>"
2639errcantregnew=cannot register new member "<NICK>"
2640errcantkick =cannot kick "<NICK>"
2641errcantlogout=cannot logout "<NICK>"
2642erralreadyreg="<NICK>" is already registered.
2643errcantstatus=cannot change status of "<NICK>"
2644stop_action=-admin-
2645# setup login
2646aloginname=Name:
2647aloginpass=Pass:
2648aloginbut =login
2649# descriptions on setup page
2650chatsetup =Chat Setup
2651chataccess =Chat Access
2652suspend =suspended
2653enabled =enabled
2654derefonly =link redirection only
2655butset =set
2656backups =Backups
2657backmem =backup members
2658backcfg =backup configuration
2659restore =restore backup
2660backdat =Backup data to copy/paste.
2661mainadmins =Main Admins
2662regadmin =Register new Main Admin
2663raiseadmin =Raise to Main Admin
2664loweradmin =Lower to Regular Admin
2665butregadmin =register
2666butraise =raise
2667butlower =lower
2668cfglanguage =Language Settings
2669editlanguage =create/edit language files
2670resetlanguage=reset language to the default (english)
2671cfgsettings =Change Configuration Settings
2672cfgmainadm =Log in with your main admin nick instead of the superuser to change particular chat settings!
2673butlogout =log out
2674lastchanged =Last changed:
2675# redirection
2676redirifsusp =Redirect to alternate URL if suspended
2677redirtourl =Redirection URL
2678# auto hotlinks
2679createlinks =Create hotlinks from URLs
2680useextderef =Use external link redirection script
2681extderefurl =External link redirection script URL
2682# options
2683allowfonts =Allow change of font face
2684allowmultiline =Allow multiline messages
2685allowpms =Allow private messages
2686rndguestcol =Randomise default colour for guests
2687yes =yes
2688no =no
2689# text filters
2690filterslist =Content filters
2691filtersnew =Add new filter
2692factive =Filter is active.
2693fdisabled =Filter is disabled.
2694fdelete =Delete this filter!
2695fregexerror =Regular expression contains errors!
2696fchoosetype =(choose filter type)
2697ftypetext =Find exact words (separated by "|"):
2698ftyperegex =Match regular expression:
2699fchooseaction =(choose filter action)
2700factionreplace =Replace matched text with:
2701factionkick =Kick chatter, replace text with:
2702factionpurge =Kick, purge and send message:
2703fseparator =------------------------------------------------------------
2704# values
2705sessionexpire =Minutes of silence until member session expires
2706guestsexpire =Minutes of silence until guest session expires
2707messageexpire =Minutes until messages get removed
2708kickpenalty =Minutes nickname is blocked after beeing kicked
2709waitingexpire =Minutes until guest entry requests expire
2710defaultrefresh =Default refresh time (seconds)
2711minrefresh =Minimum refresh time (seconds)
2712maxrefresh =Maximum refresh time (seconds)
2713floodlimit =Minimum time between posts from same nick (seconds)
2714boxwidthdef =Default post box width
2715boxheightdef =Default post box height
2716maxmessage =Maximum message length
2717maxname =Maximum characters for nickname
2718minpass =Minimum characters for password
2719# text
2720title =Browser title / name of the chat
2721favicon =Browser icon URL (favicon)
2722noguests =Text if no guests allowed
2723loginbutton =Login button text
2724header =Login page header (<IP>=users IP-address, <VER>=version)
2725footer =Login page footer (<IP>=users IP-address, <VER>=version)
2726rulestxt =Rules (<IP> shows users IP-address)
2727links =Links (html links are supported)
2728linksswitch =Show the links button
2729nowchatting =Now chatting (<NAMES>=list, <COUNT>=number)
2730entrymessage =Entry message (use <NICK> for name)
2731logoutmessage =Logout message (use <NICK> for name)
2732kickederror =Kicked error message (use <NICK> for name)
2733roomentry =Entry notification (use <NICK> for name)
2734roomexit =Exit notification (use <NICK> for name)
2735regmessage =Register notification (use <NICK> for name)
2736kickedmessage =Kick notification (use <NICK> for name)
2737roomclean =Cleaning message
2738# message enclosures
2739mesall =Message to all (use <NICK> for name)
2740mesmem =Message to members (use <NICK> for name)
2741mespm =Private Messages (<NICK>=poster, <RECP>=recipient)
2742messtaff =Staff Messages (use <NICK> for name)
2743# default colors for body and non-CSS browsers
2744colbg =Background colour
2745coltxt =Text colour
2746collnk =Link colour
2747colvis =Visited link colour
2748colact =Active link colour
2749# styles
2750cssglobal =CSS for all pages
2751styleback =back button style
2752csslogin =CSS login page
2753stylelogintext =textfield style
2754stylecolselect =selection style
2755styleenter =login button style
2756csspost =CSS post frame
2757styleposttext =post text style
2758stylepostsend =talk to button style
2759stylesendlist =send list style
2760styledellast =delete last button style
2761styledelall =delete all button style
2762styleswitch =multiline button style
2763cssview =CSS messages frame
2764styledelsome =delete selected button style
2765stylecheckwait =check newcomers button style
2766csswait =CSS waiting room
2767stylewaitrel =reload button style
2768csscontrols =CSS controls frame
2769stylerelpost =reload post box button style
2770stylerelmes =reload messages button style
2771styleprofile =profile button style
2772styleadmin =admin button style
2773stylerules =rules button style
2774styleexit =exit button style
2775cssprofile =CSS profile page
2776cssrules =CSS rules page
2777cssadmin =CSS admin pages
2778csserror =CSS error pages
2779# layout
2780tableattributes=table attributes login page
2781frameattributes=frame attributes
2782framesizes =frame sizes
2783# initialisation stuff
2784invalidbackup =No valid backup data given.
2785membrestfail =Restoring members failed:
2786membrestsucc =Restoring members succeeded.
2787membrestinval =Invalid data for members file.
2788confrestfail =Restoring configuration failed:
2789confrestsucc =Restoring configuration succeeded.
2790confrestinval =Invalid data for configuration file.
2791langrestfail =Restoring language failed:
2792langrestsucc =Restoring language succeeded.
2793langrestinval =Invalid data for language file.
2794raisemainsucc ="<NICK>" raised to main admin.
2795raisemaindone ="<NICK>" is already main admin.
2796raisemainfail ="<NICK>" is not an admin.
2797lowerregsucc ="<NICK>" lowered to regular admin.
2798lowerregdone ="<NICK>" is already regular admin.
2799lowerregfail ="<NICK>" is not an admin.
2800newmainreg =New main admin "<NICK>" registered.
2801errbaddata =Invalid data received.
2802initsetup =Initial Setup
2803setsu =Superuser Login
2804setsunick =Superuser nickname:
2805setsupass =Superuser password:
2806setsupassconf =Confirm password:
2807setsuhelp =In case of file corruption on the server, you can still restore backups with your superuser nick. You will also need it to install main admins who will be able to make changes to the chat setup, suspend/unsuspend the chat and upgrade members to moderators and regular admins.<br>You can not alter your superuser login later, so choose a secret nick and a very strong pass here. Take a nick that will not show up in the chat room. If you ever need to reset the superuser, you will have to delete the file "<DATA>/admin" on the server and do this setup here again.
2808initback =Restore Backups
2809initbackhelp =If you want to recover files (members, config, language) from existing backup data, paste it all here:
2810initbut =initialise chat
2811suerrfileexist=A superuser file exists already!
2812suerrbadnick =Invalid nickname for superuser (<MAX> characters maximum, no special characters allowed). Try again!
2813suerrbadpass =Password too short, <MIN> characters required. Try again!
2814suerrbadpassc =Password confirmation does not match. Try again!
2815suwritesucc =Superuser file was written successfully.
2816suwritefail =Superuser file was not written correctly. Please try again!<br><br>(If this error persists, make sure the script is allowed to create files and folders. Possibly you may have to create the data folder manually first.)
2817initgotosetup =Go to the Setup-Page.
2818initlechattxt =Results of lechat.txt:
2819# language editing
2820lngheader =Language File Editor
2821lnghelp =Fill in your translations below the original texts and save your changes. Use the corresponding HTML entities to display special characters! ( '&' = '&#38;' , '<' = '&#60;' , '>' = '&#62;' )<br>To apply your edits to the chat, create a backup here and restore that on the setup page. For empty entries, the english defaults will be used.
2822lngload =restore language data from backup
2823lngbackup =create backup from saved data
2824lngtoken =Token
2825lngdeftxt =Default Text
2826backtosetup=Back to the Setup-Page.