[ViewVC] Diff of: cvs/deliantra/server/ext/login.ext

Comparing deliantra/server/ext/login.ext (file contents):
Revision 1.52 by root, Sun Jun 10 03:16:54 2007 UTC vs.
Revision 1.67 by root, Fri Jul 20 16:11:10 2007 UTC

…		…
1	#! perl # MANDATORY	1	#! perl # mandatory
2		2
3	# login handling	3	# login handling
4		4
5	use Fcntl;	5	use Fcntl;
6	use Coro::AIO;	6	use Coro::AIO;
7	use List::Util qw(min max);	7
		8	our $MAX_DISCONNECT_TIME = $cf::CFG{max_disconnect_time} \|\| 3600;
8		9
9	# paranoia function to overwrite a string-in-place	10	# paranoia function to overwrite a string-in-place
10	sub nuke_str {	11	sub nuke_str {
11	substr $_[0], 0, (length $_[0]), "x" x length $_[0]	12	substr $_[0], 0, (length $_[0]), "x" x length $_[0]
12	}	13	}
39	return unless cf::player::find_active $user;	40	return unless cf::player::find_active $user;
40		41
41	$ns->send_drawinfo (	42	$ns->send_drawinfo (
42	"That player is already logged in on this server. "	43	"That player is already logged in on this server. "
43	. "If you want to create a new player, choose another name. "	44	. "If you want to create a new player, choose another name. "
44	. "If you are already a registered player, make sure nobody "	45	. "If you have already a registered, make sure nobody "
45	. "else is using your account at this time. If you lost your conenction "	46	. "else is using your account at this time. If you lost your connection "
46	. "then the server will likely timeout within a minute. If you still "	47	. "then the server will likely timeout within a minute. If you still "
47	. "cannot log-in after a minute, you are still logged in. Make sure "	48	. "cannot log-in after a minute, you are still logged in. Make sure "
48	. "you do not have another client running. If you use windows, reboot, "	49	. "you do not have another client running. If you use windows, reboot, "
49	. "this will fix anything.",	50	. "this will fix anything.",
50	cf::NDI_RED	51	cf::NDI_RED
…		…
54	}	55	}
55		56
56	sub enter_map {	57	sub enter_map {
57	my ($pl) = @_;	58	my ($pl) = @_;
58		59
		60	my $ob = $pl->ob;
		61
59	my ($map, $x, $y)	62	my ($map, $x, $y)
60	= $pl->ob->{_link_pos}	63	= $ob->{_link_pos}
61	? @{delete $pl->ob->{_link_pos}}	64	? @{delete $ob->{_link_pos}}
62	: ($pl->maplevel, $pl->ob->x, $pl->ob->y);	65	: ($pl->maplevel, $ob->x, $ob->y);
63		66
64	$pl->ob->enter_link;	67	$ob->enter_link;
65		68
66	if (my $time = delete $pl->{unclean_save}) {	69	if (my $time = delete $pl->{unclean_save}) {
67	if (my $m = cf::map::find $map) {	70	if (my $m = cf::map::find $map) {
68	if ($time < $m->{instantiate_time}) {	71	if ($time < $m->{instantiate_time}) {
69	# the map was reset in the meantime	72	# the map was reset in the meantime
70	my $age = $cf::RUNTIME - $time;	73	my $age = $cf::RUNTIME - $time;
		74
71	warn $pl->ob->name, " map reset after logout, logout age $age\n";#d#	75	warn $ob->name, " map reset after logout, logout age $age (>= $MAX_DISCONNECT_TIME)\n";#d#
72		76
73	# for now, just go back to savebed	77	# for now, just go back to savebed
74	($map, $x, $y) = $pl->savebed;	78	($map, $x, $y) = $pl->savebed;
75		79
76	$pl->ns->send_drawinfo (	80	if ($age >= $MAX_DISCONNECT_TIME) {
		81	$ob->message (
77	"You didn't use a bed to reality to leave this realm, leaving your body in great danger. "	82	"You didn't use a bed to reality to leave this realm, leaving your body in great danger. "
		83	. "Unfortunately, nobody was near to help you when the monsters arrived to eat you. "
		84	. "Maybe you can find comfort in the thought that your body was quite satisfying in taste... "
		85	. "H<You disconnected too long without having used a savebed.>",
		86	cf::NDI_RED
		87	);
		88	# kill them.
		89	# reminds me of the famous badness 10000 syndrome...
		90	$ob->stats->hp (-10000); #] if they survive this they deserved to live
		91	$pl->killer ("a cave-in");
		92	} else {
		93	$ob->message (
		94	"You didn't use a bed to reality to leave this realm, leaving your body in great danger. "
78	. "Fortunately, some friendly dwellers found you, checked your passport, and brought you to safety. "	95	. "Fortunately, some friendly dwellers found you, checked your passport, and brought you to safety. "
79	. "Better use a savebed next time, much worse things could have happened...",	96	. "Better use a savebed next time, much worse things could have happened... "
		97	. "H<You disconnected without having used a savebed. When you do that for too long, you might die.>",
		98	cf::NDI_RED
		99	);
		100	}
		101	} else {
		102	$ob->message (
		103	"You didn't use a bed to reality to leave this realm. This is very dangerous, "
		104	. "as lots of things could happen when you leave by other means, such as cave-ins, "
		105	. "or monsters suddenly snapping your body. Better use a savebed next time. "
		106	. "H<Always apply a bed of reality to disconnect from the server.>",
80	cf::NDI_RED	107	cf::NDI_RED
81	);	108	);
82	} else {
83	$pl->ns->send_drawinfo (
84	"You didn't use a bed to reality to leave this realm. This is very dangerous, "
85	. "as lots of things could happen when you leave by other means, such as cave-ins, "
86	. "or monsters suddenly snapping your body. Better use a savebed next time.",
87	cf::NDI_RED
88	);
89	}	109	}
90	}	110	}
91	}	111	}
92		112
93	$pl->ob->goto ($map, $x, $y);	113	$ob->goto ($map, $x, $y);
94	}	114	}
95		115
96	# delete a player directory, be non-blocking AND synchronous...	116	# delete a player directory, be non-blocking AND synchronous...
97	# (thats hard, so we crap out and fork).	117	# (thats hard, so we crap out and fork).
98	sub nuke_playerdir {	118	sub nuke_playerdir {
…		…
102	system "cd \Q$PLAYERDIR\E "	122	system "cd \Q$PLAYERDIR\E "
103	. "&& mv \Q$user\E ~\Q$Coro::current\E~deleting~ 2>/dev/null "	123	. "&& mv \Q$user\E ~\Q$Coro::current\E~deleting~ 2>/dev/null "
104	. "&& (rm -rf ~\Q$Coro::current\E~deleting~ &)";	124	. "&& (rm -rf ~\Q$Coro::current\E~deleting~ &)";
105	}	125	}
106		126
107	sub send_capabilities {	127	cf::client->attach (on_addme => sub {
108	my ($ns) = @_;	128	my ($ns) = @_;
109		129
110	return unless $ns->extcmd;
111
112	$ns->ext_event (capabilities =>
113	# id, name, flags (1 == 2d), edge length
114	tileset => [[1, "default 64x64 faceset", 1, 64], [0, "default 32x32 faceset", 1, 32]],
115	);
116	}
117
118	sub setup {
119	my ($ns, $args) = @_;
120
121	# run through the cmds of setup
122	# syntax is setup <cmdname1> <parameter> <cmdname2> <parameter> ...
123	#
124	# we send the status of the cmd back, or a FALSE is the cmd is the server unknown
125	# The client then must sort this out
126
127	my %setup = split / +/, $args;
128	while (my ($k, $v) = each %setup) {
129	if ($k eq "sound") {
130	$ns->sound ($v);
131
132	} elsif ($k eq "exp64") {
133	$setup{$k} = 1;
134
135	} elsif ($k eq "spellmon") {
136	$ns->monitor_spells ($v);
137
138	} elsif ($k eq "darkness") {
139	$ns->darkness ($v);
140
141	} elsif ($k eq "map1cmd") {
142	$ns->mapmode (cf::Map1Cmd) if $v > 0;
143
144	} elsif ($k eq "map1acmd") {
145	$ns->mapmode (cf::Map1aCmd) if $v > 0;
146
147	} elsif ($k eq "map2cmd") {
148	# gcfclient bug, map1acmd is sent too late
149	$ns->mapmode (cf::Map1aCmd);
150	$setup{$k} = "FALSE";
151
152	} elsif ($k eq "newmapcmd") {
153	$ns->newmapcmd ($v);
154
155	} elsif ($k eq "mapinfocmd") {
156	$ns->mapinfocmd ($v);
157
158	} elsif ($k eq "extcmd") {
159	$ns->extcmd ($v > 0);
160	send_capabilities $ns;
161
162	} elsif ($k eq "extmap") {
163	$ns->extmap ($v);
164
165	} elsif ($k eq "facecache") {
166	if (!$v) {
167	$v = 1;
168	$setup{$k} = $v;
169	$ns->send_drawinfo ("(trying to forcefully enable facecaching)", cf::NDI_RED);
170	}
171
172	$ns->facecache ($v);
173
174	} elsif ($k eq "faceset") {
175	$ns->faceset (0);
176	$setup{$k} = 0;
177	# $ns->image2 (1)
178
179	} elsif ($k eq "tileset") {
180	$setup{$k} = $ns->faceset ($v & 1);
181
182	} elsif ($k eq "itemcmd") {
183	# Version of the item protocol command to use. Currently,
184	# only supported versions are 1 and 2. Using a numeric
185	# value will make it very easy to extend this in the future.
186	$ns->itemcmd ($v) if $v >= 1 && $v <= 2;
187
188	$setup{$k} = $ns->itemcmd;
189
190	} elsif ($k eq "mapsize") {
191	my ($x, $y) = split /x/, $v;
192
193	$ns->mapx ($x = max 9, min cf::MAP_CLIENT_X, ($x - 1) \| 1);
194	$ns->mapy ($y = max 9, min cf::MAP_CLIENT_Y, ($y - 1) \| 1);
195
196	$setup{$k} = "${x}x${y}";
197
198	} elsif ($k eq "extendedMapInfos") {
199	$ns->ext_mapinfos ($v);
200
201	} elsif ($k eq "extendedTextInfos") {
202	$ns->has_readable_type ($v);
203
204	} elsif ($k eq "smoothing") { # cfplus-style smoothing
205	$ns->smoothing ($v);
206
207	} elsif ($k eq "fxix") {
208	$ns->fxix ($v);
209
210	} elsif ($k eq "msg") {
211	$ns->can_msg ($v);
212
213	} elsif ($k eq "excmd") {
214	# we support it
215
216	} else {
217	# other commands:
218	# sexp: no idea, probably for oudated servers
219	# tick: more stupidity, server should send a tick per tick
220
221	$setup{$k} = "FALSE";
222	}
223	}
224
225	$ns->send_packet (join " ", setup => %setup);
226
227	cf::datalog setup =>
228	request => $args,
229	reply => \%setup,
230	client => $ns->version,
231	;
232	}
233
234	sub addme {
235	my ($ns) = @_;
236
237	if (!$ns->facecache)	130	if (!$ns->facecache)
238	{	131	{
239	$ns->send_drawinfo (<<EOF, cf::NDI_RED);	132	$ns->send_drawinfo (<<EOF, cf::NDI_RED);
240		133
241		134
242	***	135	***
243	*** WARNING:	136	*** WARNING:
244	*** Your client does not support face/image caching,	137	*** Your client does not support face/image caching,
…		…
312	. "(only a-z, A-Z and 0-9 are allowed), "	205	. "(only a-z, A-Z and 0-9 are allowed), "
313	. "or is not between 3 and 18 characters in length.",	206	. "or is not between 3 and 18 characters in length.",
314	cf::NDI_RED	207	cf::NDI_RED
315	);	208	);
316	}	209	}
		210	Coro::Timer::sleep 0.4;
317	}	211	}
318		212
319	check_playing $ns, $user and next;	213	check_playing $ns, $user and next;
320		214
321	$ns->send_drawinfo (	215	$ns->send_drawinfo (
…		…
332	$ns->send_drawinfo (	226	$ns->send_drawinfo (
333	"Try to use at least three characters as your password please, "	227	"Try to use at least three characters as your password please, "
334	. "that cannot be too much to ask for :)",	228	. "that cannot be too much to ask for :)",
335	cf::NDI_RED	229	cf::NDI_RED
336	);	230	);
		231	Coro::Timer::sleep 0.4;
337	}	232	}
338		233
339	# lock this username for the remainder of this login session	234	# lock this username for the remainder of this login session
340	if ($cf::LOGIN_LOCK{$user}) {	235	if ($cf::LOGIN_LOCK{$user}) {
341	$ns->send_drawinfo (	236	$ns->send_drawinfo (
…		…
422	nuke_str $pass2;	317	nuke_str $pass2;
423	$ns->send_drawinfo (	318	$ns->send_drawinfo (
424	"The passwords do not match, please try again.",	319	"The passwords do not match, please try again.",
425	cf::NDI_RED	320	cf::NDI_RED
426	);	321	);
		322	Coro::Timer::sleep 0.5;
427	next;	323	next;
428	}	324	}
429		325
430	nuke_str $pass2;	326	nuke_str $pass2;
431		327
…		…
453	$ob->swap_stats ($res - 1, $swap - 1);	349	$ob->swap_stats ($res - 1, $swap - 1);
454	}	350	}
455	} else {	351	} else {
456	$ob->roll_stats;	352	$ob->roll_stats;
457	}	353	}
		354
		355	Coro::Timer::sleep 0.2;
458	}	356	}
459		357
460	$ob->set_animation (2);	358	$ob->set_animation (2);
461	$ob->add_statbonus;	359	$ob->add_statbonus;
462		360
463	while () {	361	while () {
464	$ns->send_msg (-1, "chargen-race-title", ucfirst $pl->title);	362	$ns->send_msg ("chargen-race-title", ucfirst $pl->title, -1);
465	my $msg = $ob->msg;	363	my $msg = $ob->msg;
466	$msg =~ s/(?<=\S)\n(?=\S)/ /g;	364	$msg =~ s/(?<=\S)\n(?=\S)/ /g;
467	$ns->send_msg (cf::NDI_BLUE, "chargen-race-description", $msg);	365	$ns->send_msg ("chargen-race-description", $msg, cf::NDI_BLUE);
468		366
469	my $res = query $ns, cf::CS_QUERY_SINGLECHAR,	367	my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
470	"Now choose a character.\nPress any key to change outlook.\nPress `d' when you're pleased.\n";	368	"Now choose a character.\nPress any key to change outlook.\nPress `d' when you're pleased.\n";
471		369
472	last if $res =~ /[dD]/;	370	last if $res =~ /[dD]/;
473		371
474	$pl->chargen_race_next;	372	$pl->chargen_race_next;
		373	Coro::Timer::sleep 0.2;
475	}	374	}
476		375
477	$pl->chargen_race_done;	376	$pl->chargen_race_done;
		377
		378	while () {
		379	my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
		380	"Now choose a gender.\nPress 'f' to become female, and 'm' to become male.\n";
		381
		382	if ($res =~ /^[fF]/) {
		383	$pl->gender (1);
		384	last;
		385	} elsif ($res =~ /^[mM]/) {
		386	$pl->gender (0);
		387	last;
		388	}
		389	Coro::Timer::sleep 0.2;
		390	}
		391
		392	$ob->reply (undef, "Welcome to Crossfire!");
478		393
479	delete $pl->{deny_save};	394	delete $pl->{deny_save};
480		395
481	last;	396	last;
482	}	397	}
483	});	398	});
484	}	399	});
485		400
486	cf::register_command quit => sub {	401	cf::register_command quit => sub {
487	my ($ob, $arg) = @_;	402	my ($ob, $arg) = @_;
488		403
489	$ob->reply (undef,	404	$ob->reply (undef,
…		…
560	$pl->{unclean_save} = $cf::RUNTIME;	475	$pl->{unclean_save} = $cf::RUNTIME;
561	}	476	}
562	},	477	},
563	);	478	);
564		479
565	cf::client->attach (
566	on_addme => \&addme,
567	on_setup => \&setup,
568	);
569
570	#############################################################################	480	#############################################################################
571		481
572	our $SCHEDULE_INTERVAL = 10; # time the player scheduler sleeps between runs	482	our $SCHEDULE_INTERVAL = 10; # time the player scheduler sleeps between runs
573	our $SAVE_TIMEOUT = 20; # save players every n seconds	483	our $SAVE_TIMEOUT = 20; # save players every n seconds
574		484
…		…
606		516
607	# remove from sight and get fresh "copies"	517	# remove from sight and get fresh "copies"
608	$pl = delete $cf::PLAYER{$ob->name};	518	$pl = delete $cf::PLAYER{$ob->name};
609	$ob = $pl->ob;	519	$ob = $pl->ob;
610		520
611	$ob->destroy;
612	$pl->destroy;	521	$pl->destroy; # destroys $ob
613	} else {	522	} else {
614	my $a_ = $pl->refcnt;#d#	523	my $a_ = $pl->refcnt;#d#
615	my $b_ = $ob->refcnt;#d#	524	my $b_ = $ob->refcnt;#d#
616		525
617	warn "player-scheduler refcnt ", $ob->name, " pl $pl_ref ob $ob_ref (C pl $a_ ob $b_)\n";#d#	526	warn "player-scheduler refcnt ", $ob->name, " pl $pl_ref ob $ob_ref (C pl $a_ ob $b_)\n";#d#

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing deliantra/server/ext/login.ext (file contents): Revision 1.52 by root, Sun Jun 10 03:16:54 2007 UTC vs. Revision 1.67 by root, Fri Jul 20 16:11:10 2007 UTC

Diff Legend

Comparing deliantra/server/ext/login.ext (file contents):
Revision 1.52 by root, Sun Jun 10 03:16:54 2007 UTC vs.
Revision 1.67 by root, Fri Jul 20 16:11:10 2007 UTC