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

Comparing deliantra/server/ext/login.ext (file contents):
Revision 1.97 by root, Sat Dec 27 01:25:00 2008 UTC vs.
Revision 1.122 by root, Thu Nov 15 07:08:15 2012 UTC

…		…
1	#! perl # mandatory	1	#! perl # mandatory depends=highscore
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 Deliantra::Util ();
7		8
8	our $MAX_DISCONNECT_TIME = $cf::CFG{max_disconnect_time} \|\| 3600;	9	CONF MAX_DISCONNECT_TIME = 3600;
9
10	# paranoia function to overwrite a string-in-place
11	sub nuke_str {
12	substr $_[0], 0, (length $_[0]), "x" x length $_[0]
13	}
14		10
15	sub query {	11	sub query {
16	my ($ns, $flags, $text) = @_;	12	my ($ns, $flags, $text) = @_;
17		13
18	$ns->query ($flags, $text, Coro::rouse_cb);	14	$ns->query ($flags, $text, Coro::rouse_cb);
59	my $m = $ob->map	55	my $m = $ob->map
60	or return;	56	or return;
61	my $x = $ob->x;	57	my $x = $ob->x;
62	my $y = $ob->y;	58	my $y = $ob->y;
63		59
64	# return 0;#d#	60	# never happens normally, but helps when shell users make mistakes
65	# warn join ":", $m->at ($x, $y);#d#	61	$m->linkable
66	# warn "FOO$m { ".scalar ($m->at ($x, $y))." }\n";	62	or return 1;
67	# return 0;
68		63
69	scalar grep $_->type == cf::SAVEBED, $m->at ($x, $y)	64	scalar grep $_->type == cf::SAVEBED, $m->at ($x, $y)
70	}	65	}
71		66
72	sub enter_map {	67	sub enter_map {
73	my ($pl) = @_;	68	my ($pl) = @_;
74		69
75	warn $pl->ob->name, ": enter map 1\n";#d#
76	my $ob = $pl->ob;	70	my $ob = $pl->ob;
77		71
78	my ($map, $x, $y)	72	my ($map, $x, $y)
79	= $ob->{_link_pos}	73	= $ob->{_link_pos}
80	? @{delete $ob->{_link_pos}}	74	? @{delete $ob->{_link_pos}}
81	: ($pl->maplevel, $ob->x, $ob->y);	75	: ($pl->maplevel, $ob->x, $ob->y);
82		76
83	warn $pl->ob->name, ": enter map 2\n";#d#
84	$ob->enter_link;	77	$ob->enter_link;
85	warn $pl->ob->name, ": enter map 3\n";#d#
86		78
87	my $m = cf::map::find $map;	79	my $m = cf::map::find $map;
88	my $time = delete $pl->{unclean_save};	80	my $time = delete $pl->{unclean_save};
89	warn $pl->ob->name, ": enter map 4\n";#d#
90		81
91	if ($time && $m) {	82	if ($time && $m) {
92	if ($time < $m->{instantiate_time}) {	83	if ($time < $m->{instantiate_time}) {
93	# the map was reset in the meantime	84	# the map was reset in the meantime
94	my $age = $cf::RUNTIME - $time;	85	my $age = $cf::RUNTIME - $time;
95		86
96	warn $ob->name, " map reset after logout, logout age $age (>= $MAX_DISCONNECT_TIME)\n";#d#	87	cf::info $ob->name, " map reset after logout, logout age $age (>= $MAX_DISCONNECT_TIME)\n";#d#
97		88
98	if ($age >= $MAX_DISCONNECT_TIME) {	89	if ($age >= $MAX_DISCONNECT_TIME) {
99	$ob->message (	90	$ob->message (
100	"You didn't use a bed to reality to leave this realm, leaving your body in great danger. "	91	"You didn't use a bed to reality to leave this realm, leaving your body in great danger. "
101	. "Unfortunately, nobody was near to help you when the monsters arrived to eat you. "	92	. "Unfortunately, nobody was near to help you when the monsters arrived to eat you. "
…		…
127	cf::NDI_RED	118	cf::NDI_RED
128	);	119	);
129	}	120	}
130	}	121	}
131		122
132	warn $pl->ob->name, ": enter map 5\n";#d#
133	#$ob->goto ($map, $x, $y);	123	$ob->goto ($map, $x, $y);
134	$ob->goto ($map, $x, $y, sub {	124	}
135	warn $pl->ob->name, ": enter map check\n";#d#	125
136	$_[0]	126	sub encode_password($) {
137	}, sub {	127	"!" . unpack "H*", $_[0]
138	warn $pl->ob->name, ": enter map done\n";#d#	128	}
		129
		130	sub compare_password($$) {
		131	my ($pass, $token) = @_;
		132
		133	if ($token =~ /!!(.*)/) {
		134	return +(substr $pass, 0, 8) eq pack "H*", $1;
		135	} elsif ($token =~ /!(.*)/) {
		136	return $pass eq pack "H*", $1;
		137	} else {
		138	return $token eq crypt $pass, $token;
139	});	139	}
140	warn $pl->ob->name, ": enter map 6\n";#d#
141
142	}	140	}
143		141
144	# delete a player directory, be non-blocking AND synchronous...	142	# delete a player directory
145	# (that's hard, so we crap out and fork).
146	sub nuke_playerdir {	143	sub nuke_playerdir {
147	my ($user) = @_;	144	my ($user) = @_;
148		145
		146	my $lock = cf::lock_acquire "ext::login::nuke_playerdir";
		147
149	my $temp = "$PLAYERDIR/~$Coro::current~deleting~";	148	my $temp = "$PLAYERDIR/~$Coro::current~deleting~";
150
151	cf::fork_call {
152	rename "$PLAYERDIR/$user", $temp;	149	aio_rename "$PLAYERDIR/$user", $temp;
153	system "rm", "-rf", $temp;	150	IO::AIO::aio_rmtree $temp;
		151	}
		152
		153	sub login_done {
		154	my ($pl) = @_;
		155
		156	if (0 < Coro::AIO::aio_load "$cf::CONFDIR/motd", my $motd) {
		157	$pl->ns->send_msg ("c/motd" => $motd, cf::NDI_CLEAR);
154	};	158	}
		159	}
		160
		161	sub chargen {
		162	my ($ns, $user, $pass) = @_;
		163
		164	# the rest of this function is character creation
		165	$Coro::current->{desc} = "addme($user) chargen";
		166
		167	# just to make sure nothing is left over
		168	# normally, nothing is there.
		169	nuke_playerdir $user;
		170
		171	my $pl = cf::player::new $user;
		172	$pl->password (encode_password $pass);
		173	$pl->connect ($ns);
		174	my $ob = $pl->ob;
		175
		176	$ob->goto ($pl->maplevel, $ob->x, $ob->y);
		177
		178	while () {
		179	$ob->update_stats;
		180	$pl->save_stats;
		181
		182	my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
		183	"[y] to roll new stats [n] to use stats\n[1-7] [1-7] to swap stats.\nRoll again (y/n/1-7)?";
		184
		185	if ($res =~ /^[Nn]/) {
		186	last;
		187	} elsif ($res > 0 && $res <= 7) {
		188	my $swap = query $ns, cf::CS_QUERY_SINGLECHAR, "Swap stat with (will not roll new stats) [1-7]?";
		189
		190	if ($swap > 0 && $swap <= 7) {
		191	$ob->swap_stats ($res - 1, $swap - 1);
		192	}
		193	} else {
		194	$ob->roll_stats;
		195	}
		196
		197	Coro::Timer::sleep 0.05;
		198	}
		199
		200	$ob->set_animation (2);
		201	$ob->add_statbonus;
		202
		203	while () {
		204	$ns->send_msg ("chargen-race-title", ucfirst $pl->title, -1);
		205	my $msg = $ob->msg;
		206	$msg =~ s/(?<=\S)\n(?=\S)/ /g;
		207	$ns->send_msg ("chargen-race-description", $msg, cf::NDI_BLUE);
		208
		209	my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
		210	"Now choose a character.\nPress any key to change outlook.\nPress `d' when you're pleased.\n";
		211
		212	last if $res =~ /[dD]/;
		213
		214	$pl->chargen_race_next;
		215	Coro::Timer::sleep 0.05;
		216	}
		217
		218	# create the playerdir, if necessary, as chargen_race_done did it before
		219	# presumably because of unique maps
		220	aio_mkdir playerdir $pl, 0770;
		221	$pl->chargen_race_done;
		222
		223	while () {
		224	my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
		225	"Now choose a gender.\nPress 'f' to become female, and 'm' to become male.\n";
		226
		227	if ($res =~ /^[fF]/) {
		228	$pl->gender (1);
		229	last;
		230	} elsif ($res =~ /^[mM]/) {
		231	$pl->gender (0);
		232	last;
		233	}
		234	Coro::Timer::sleep 0.05;
		235	}
		236
		237	$ob->reply (undef, "Welcome to Deliantra!");
		238
		239	# XXX: Workaround for delayed client ext protocol handshake
		240	$pl->esrv_new_player;
		241
		242	delete $pl->{deny_save};
155	}	243	}
156		244
157	cf::client->attach (on_addme => sub {	245	cf::client->attach (on_addme => sub {
158	my ($ns) = @_;	246	my ($ns) = @_;
159		247
…		…
237		325
238	# try to read the user file and check the password	326	# try to read the user file and check the password
239	if (my $pl = cf::player::find $user) {	327	if (my $pl = cf::player::find $user) {
240	aio_stat $pl->path and next;	328	aio_stat $pl->path and next;
241	my $mtime = (stat _)[9];	329	my $mtime = (stat _)[9];
242	my $hash = $pl->password;	330	my $token = $pl->password;
243		331
244	if ($cf::CFG{ext_login_nocheck} or $hash eq crypt $pass, $hash) {	332	if ($cf::CFG{ext_login_nocheck} or compare_password $pass, $token) {
245	nuke_str $pass;	333	# player exists and passwords match - we can proceed
		334
246	# password matches, wonderful	335	# password matches, wonderful
247	my $pl = cf::player::find $user or next;	336	my $pl = cf::player::find $user or next;
248	$pl->connect ($ns);	337	$pl->connect ($ns);
249	$pl->ob->flag (cf::FLAG_DEBUG, 1);#d# temp
250	enter_map $pl;	338	enter_map $pl;
		339	login_done $pl;
251	last;	340	return;
252	} elsif (can_cleanup $pl, $mtime) {	341	} elsif (can_cleanup $pl, $mtime) {
253	Coro::Timer::sleep 1;	342	Coro::Timer::sleep 1;
254		343
255	$ns->send_drawinfo (	344	$ns->send_drawinfo (
256	"Player exists, but password does not match. If this is your account, "	345	"Player exists, but password does not match. If this is your account, "
257	. "please try again. If not, you can now decide to take over this account "	346	. "please try again. If not, you can now decide to take over this account "
258	. "because it has not been in-use for some time.",	347	. "because it has not been in-use for some time.",
259	cf::NDI_RED	348	cf::NDI_RED
260	);	349	);
261		350
262	#TODO: nuke_str
263	(query $ns, cf::CS_QUERY_SINGLECHAR, "Delete existing account and create a new one (Y/N)?") =~ /^[yY]/	351	(query $ns, cf::CS_QUERY_SINGLECHAR, "Delete existing account and create a new one (Y/N)?") =~ /^[yY]/
264	or next;	352	or next;
265		353
266	# check if the file hasn't changed	354	# check if the file hasn't changed
267	aio_stat cf::player::path $user and next;	355	aio_stat cf::player::path $user and next;
…		…
269		357
270	$pl->quit_character;	358	$pl->quit_character;
271		359
272	# fall through to creation	360	# fall through to creation
273	} else {	361	} else {
274	nuke_str $pass;
275
276	Coro::Timer::sleep 1;	362	Coro::Timer::sleep 1;
277		363
278	$ns->send_drawinfo (	364	$ns->send_drawinfo (
279	"Wrong username or password. Please try again "	365	"Wrong username or password. Please try again "
280	. "(check for Numlock and other semi-obvious error sources).",	366	. "(check for Numlock and other semi-obvious error sources).",
…		…
282	);	368	);
283	next;	369	next;
284	}	370	}
285	} else {	371	} else {
286	# unable to load the playerfile:	372	# unable to load the playerfile:
287	# check wether the player dir exists, which means the file is corrupted or	373	# check whether the player dir exists, which means the file is corrupted or
288	# something very similar.	374	# something very similar.
289	if (!aio_stat cf::player::playerdir $user) {	375	if (!aio_stat cf::player::playerdir $user) {
290	$ns->send_drawinfo (	376	$ns->send_drawinfo (
291	"Unable to retrieve this player. It might be a locked or broken account. "	377	"Unable to retrieve this player. It might be a locked or broken account. "
292	. "If this is your account, ask a dungeon master for assistance. "	378	. "If this is your account, ask a dungeon master for assistance. "
…		…
295	);	381	);
296	next;	382	next;
297	}	383	}
298	}	384	}
299		385
300	# the rest of this function is character creation
301	$Coro::current->{desc} = "addme($user) chargen";
302
303	# just to make sure nothing is left over
304	nuke_playerdir $user;
305
306	my $pass2 = query $ns, cf::CS_QUERY_HIDEINPUT, "Please type your password again.";	386	my $pass2 = query $ns, cf::CS_QUERY_HIDEINPUT, "Please type your password again.";
307		387
308	if ($pass2 ne $pass) {	388	if ($pass2 ne $pass) {
309	nuke_str $pass;
310	nuke_str $pass2;
311	$ns->send_drawinfo (	389	$ns->send_drawinfo (
312	"The passwords do not match, please try again.",	390	"The passwords do not match, please try again.",
313	cf::NDI_RED	391	cf::NDI_RED
314	);	392	);
315	Coro::Timer::sleep 0.5;	393	Coro::Timer::sleep 0.5;
316	next;	394	next;
317	}	395	}
318		396
319	nuke_str $pass2;
320
321	my $pl = cf::player::new $user;
322	$pl->password (crypt $pass, join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]);
323	nuke_str $pass;
324	$pl->connect ($ns);
325	my $ob = $pl->ob;
326
327	$ob->goto ($pl->maplevel, $ob->x, $ob->y);
328
329	while () {
330	$ob->update_stats;
331	$pl->save_stats;
332
333	my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
334	"[y] to roll new stats [n] to use stats\n[1-7] [1-7] to swap stats.\nRoll again (y/n/1-7)?";
335
336	if ($res =~ /^[Nn]/) {
337	last;
338	} elsif ($res > 0 && $res <= 7) {
339	my $swap = query $ns, cf::CS_QUERY_SINGLECHAR, "Swap stat with (will not roll new stats) [1-7]?";
340
341	if ($swap > 0 && $swap <= 7) {
342	$ob->swap_stats ($res - 1, $swap - 1);
343	}
344	} else {
345	$ob->roll_stats;
346	}
347
348	Coro::Timer::sleep 0.05;
349	}
350
351	$ob->set_animation (2);
352	$ob->add_statbonus;
353
354	while () {
355	$ns->send_msg ("chargen-race-title", ucfirst $pl->title, -1);
356	my $msg = $ob->msg;
357	$msg =~ s/(?<=\S)\n(?=\S)/ /g;
358	$ns->send_msg ("chargen-race-description", $msg, cf::NDI_BLUE);
359
360	my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
361	"Now choose a character.\nPress any key to change outlook.\nPress `d' when you're pleased.\n";
362
363	last if $res =~ /[dD]/;
364
365	$pl->chargen_race_next;
366	Coro::Timer::sleep 0.2;
367	}
368
369	# create the playerdir, if necessary, as chargen_race_done did it before
370	# presumably because of unique maps
371	aio_mkdir playerdir $pl, 0770;
372	$pl->chargen_race_done;
373
374	while () {
375	my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
376	"Now choose a gender.\nPress 'f' to become female, and 'm' to become male.\n";
377
378	if ($res =~ /^[fF]/) {
379	$pl->gender (1);
380	last;
381	} elsif ($res =~ /^[mM]/) {
382	$pl->gender (0);
383	last;
384	}
385	Coro::Timer::sleep 0.2;
386	}
387
388	$ob->reply (undef, "Welcome to Deliantra!");
389
390	# XXX: Workaround for delayed client ext protocol handshake
391	$pl->esrv_new_player;
392
393	delete $pl->{deny_save};
394
395	last;	397	last;
396	}	398	}
		399
		400	# lock again, too layz to make this nicer
		401	local $cf::LOGIN_LOCK{$user} = 1;
		402
		403	chargen $ns, $user, $pass;
		404	login_done $ns->pl;
397	});	405	});
398	});	406	});
		407
		408	cf::client->attach (
		409	on_version => sub {
		410	my ($ns, $arg) = @_;
		411
		412	$ns->ext_msg (nonces => map { join "", map { chr rand 256 } 0..63 } 1..2);
		413	},
		414	);
		415
		416	#cf::register_async_exticmd create_login => sub {
		417	# my ($ns, $reply, $user, $pass) = @_;
		418	#
		419	# $ns->pl and return $ns->destroy;
		420	#};
		421
		422	cf::register_async_exticmd login => sub {
		423	my ($ns, $reply, $user, $hash) = @_;
		424
		425	$ns->pl and return $ns->destroy;
		426	};
		427
		428	cf::register_command password => sub {
		429	my ($pl, $arg) = @_;
		430
		431	unless ($pl->flag (cf::FLAG_WIZ)) {
		432	$pl->message (
		433	"The password can currently only changed by a DM.",
		434	cf::NDI_UNIQUE \| cf::NDI_REPLY);
		435	return;
		436	}
		437
		438	my (@args) = split /\s+/, $arg;
		439	my ($player, $new_pw) = @args;
		440
		441	if ($pl->flag (cf::FLAG_WIZ) && $player eq '') {
		442	$pl->message (
		443	"Usage: password <player> [<new password>]",
		444	cf::NDI_UNIQUE \| cf::NDI_REPLY);
		445	return;
		446	}
		447
		448	if ($new_pw eq '') {
		449	$new_pw =
		450	join '',
		451	map { ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[(cf::rndm 64)] }
		452	1..9;
		453	}
		454
		455	cf::async {
		456	my $plc = cf::player::find $player;
		457	if ($plc) {
		458	$plc->password (encode_password $new_pw);
		459	$pl->message (
		460	"Ok, changed password of '$player' to '$new_pw'!",
		461	cf::NDI_UNIQUE \| cf::NDI_RED \| cf::NDI_REPLY);
		462	} else {
		463	$pl->message (
		464	"Fail! Couldn't set password for '$player', "
		465	. "he doesn't seem to exist!",
		466	cf::NDI_UNIQUE \| cf::NDI_RED \| cf::NDI_REPLY);
		467	}
		468	};
		469	};
399		470
400	cf::register_command quit => sub {	471	cf::register_command quit => sub {
401	my ($ob, $arg) = @_;	472	my ($ob, $arg) = @_;
402		473
403	$ob->send_msg (undef,	474	$ob->send_msg (undef,
…		…
414	$pl->ns->query (cf::CS_QUERY_SINGLECHAR, "Do you want to PERMANENTLY delete your character and all associated data (y/n)?", sub {	485	$pl->ns->query (cf::CS_QUERY_SINGLECHAR, "Do you want to PERMANENTLY delete your character and all associated data (y/n)?", sub {
415	if ($_[0] !~ /^[yY]/) {	486	if ($_[0] !~ /^[yY]/) {
416	$ob->send_msg (undef, "Ok, not not quitting then.", cf::NDI_UNIQUE \| cf::NDI_RED \| cf::NDI_REPLY);	487	$ob->send_msg (undef, "Ok, not not quitting then.", cf::NDI_UNIQUE \| cf::NDI_RED \| cf::NDI_REPLY);
417	} else {	488	} else {
418	$ob->send_msg (undef, "Ok, quitting, hope to see you again.", cf::NDI_UNIQUE \| cf::NDI_RED \| cf::NDI_REPLY);	489	$ob->send_msg (undef, "Ok, quitting, hope to see you again.", cf::NDI_UNIQUE \| cf::NDI_RED \| cf::NDI_REPLY);
419	$pl->ns->flush;	490	cf::async {
420	cf::async { $pl->quit_character };	491	$pl->quit_character;
		492	};
421	}	493	}
422	});	494	});
423	};	495	};
424		496
425	cf::object->attach (	497	cf::object->attach (
…		…
431		503
432	my $pl = $ob->contr;	504	my $pl = $ob->contr;
433		505
434	# update respawn position	506	# update respawn position
435	$pl->savebed ($bed->map->path, $bed->x, $bed->y);	507	$pl->savebed ($bed->map->path, $bed->x, $bed->y);
436	cf::async { $pl->save };
437		508
		509	cf::async {
438	my $killer = cf::arch::get "killer_logout"; $pl->killer ($killer); $killer->destroy;	510	my $killer = cf::arch::get "killer_logout"; $pl->killer ($killer); $killer->destroy;
439	$ob->check_score;	511	ext::highscore::check $ob;
440		512
		513	$pl->save;
		514
441	$ob->send_msg ($cf::SAY_CHANNEL => "In the future, you will wake up here when you die.", cf::NDI_DEF \| cf::NDI_REPLY);	515	$ob->send_msg ($cf::SAY_CHANNEL => "In the future, you will wake up here when you die.", cf::NDI_DEF \| cf::NDI_REPLY);
442		516
		517	my $ns = $pl->ns
		518	or return;
		519
443	$pl->ns->query (cf::CS_QUERY_SINGLECHAR, "Do you want to continue playing (y/n)?", sub {	520	$ns->query (cf::CS_QUERY_SINGLECHAR, "Do you want to continue playing (y/n)?", sub {
444	if ($_[0] !~ /^[yY]/) {	521	if ($_[0] !~ /^[yY]/) {
445	$pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1);	522	$pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1);
446	$pl->deactivate;	523	$pl->deactivate;
447	$pl->ns->destroy;	524	$pl->ns->destroy;
448	} else {	525	}
449	cf::async { $pl->save };
450	}	526	});
451	});	527	};
452	},	528	},
453	);	529	);
454		530
455	cf::player->attach (	531	cf::player->attach (
456	on_login => sub {	532	on_login => sub {
…		…
471	unless safe_spot $pl;	547	unless safe_spot $pl;
472	}	548	}
473	},	549	},
474	);	550	);
475		551
476

Diff Legend

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

Comparing deliantra/server/ext/login.ext (file contents): Revision 1.97 by root, Sat Dec 27 01:25:00 2008 UTC vs. Revision 1.122 by root, Thu Nov 15 07:08:15 2012 UTC

Diff Legend

Comparing deliantra/server/ext/login.ext (file contents):
Revision 1.97 by root, Sat Dec 27 01:25:00 2008 UTC vs.
Revision 1.122 by root, Thu Nov 15 07:08:15 2012 UTC