[ViewVC] Diff of: cvs/deliantra/server/lib/cf.pm

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.104 by root, Sat Dec 30 16:56:16 2006 UTC vs.
Revision 1.109 by root, Sun Dec 31 22:23:12 2006 UTC

…		…
13	use Coro 3.3;	13	use Coro 3.3;
14	use Coro::Event;	14	use Coro::Event;
15	use Coro::Timer;	15	use Coro::Timer;
16	use Coro::Signal;	16	use Coro::Signal;
17	use Coro::Semaphore;	17	use Coro::Semaphore;
		18	use Coro::AIO;
18		19
		20	use Digest::MD5;
		21	use Fcntl;
19	use IO::AIO 2.3;	22	use IO::AIO 2.31 ();
20	use YAML::Syck ();	23	use YAML::Syck ();
21	use Time::HiRes;	24	use Time::HiRes;
22		25
23	use Event; $Event::Eval = 1; # no idea why this is required, but it is	26	use Event; $Event::Eval = 1; # no idea why this is required, but it is
24		27
…		…
47	our $RUNTIME;	50	our $RUNTIME;
48		51
49	our %MAP; # all maps	52	our %MAP; # all maps
50	our $LINK_MAP; # the special {link} map	53	our $LINK_MAP; # the special {link} map
51	our $FREEZE;	54	our $FREEZE;
		55	our $RANDOM_MAPS = cf::localdir . "/random";
		56	our %EXT_CORO;
52		57
53	binmode STDOUT;	58	binmode STDOUT;
54	binmode STDERR;	59	binmode STDERR;
55		60
56	# read virtual server time, if available	61	# read virtual server time, if available
…		…
62		67
63	mkdir cf::localdir;	68	mkdir cf::localdir;
64	mkdir cf::localdir . "/" . cf::playerdir;	69	mkdir cf::localdir . "/" . cf::playerdir;
65	mkdir cf::localdir . "/" . cf::tmpdir;	70	mkdir cf::localdir . "/" . cf::tmpdir;
66	mkdir cf::localdir . "/" . cf::uniquedir;	71	mkdir cf::localdir . "/" . cf::uniquedir;
		72	mkdir $RANDOM_MAPS;
67		73
68	our %EXT_CORO;	74	# a special map that is always available
		75	our $LINK_MAP;
69		76
70	#############################################################################	77	#############################################################################
71		78
72	=head2 GLOBAL VARIABLES	79	=head2 GLOBAL VARIABLES
73		80
…		…
172	sub to_json($) {	179	sub to_json($) {
173	$JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs	180	$JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
174	JSON::Syck::Dump $_[0]	181	JSON::Syck::Dump $_[0]
175	}	182	}
176		183
		184	=item cf::sync_job { BLOCK }
		185
		186	The design of crossfire+ requires that the main coro ($Coro::main) is
		187	always able to handle events or runnable, as crossfire+ is only partly
		188	reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.
		189
		190	If it must be done, put the blocking parts into C<sync_job>. This will run
		191	the given BLOCK in another coroutine while waiting for the result. The
		192	server will be frozen during this time, so the block should either finish
		193	fast or be very important.
		194
		195	=cut
		196
		197	sub sync_job(&) {
		198	my ($job) = @_;
		199
		200	my $busy = 1;
		201	my @res;
		202
		203	# TODO: use suspend/resume instead
		204	local $FREEZE = 1;
		205
		206	my $coro = Coro::async {
		207	@res = eval { $job->() };
		208	warn $@ if $@;
		209	undef $busy;
		210	};
		211
		212	if ($Coro::current == $Coro::main) {
		213	$coro->prio (Coro::PRIO_MAX);
		214	while ($busy) {
		215	Coro::cede_notself;
		216	Event::one_event unless Coro::nready;
		217	}
		218	} else {
		219	$coro->join;
		220	}
		221
		222	wantarray ? @res : $res[0]
		223	}
		224
177	=item $coro = cf::coro { BLOCK }	225	=item $coro = cf::coro { BLOCK }
178		226
179	Creates and returns a new coro. This coro is automcatially being canceled	227	Creates and returns a new coro. This coro is automcatially being canceled
180	when the extension calling this is being unloaded.	228	when the extension calling this is being unloaded.
181		229
…		…
197	$EXT_CORO{$coro+0} = $coro;	245	$EXT_CORO{$coro+0} = $coro;
198		246
199	$coro	247	$coro
200	}	248	}
201		249
		250	sub write_runtime {
		251	my $runtime = cf::localdir . "/runtime";
		252
		253	my $fh = aio_open "$runtime~", O_WRONLY \| O_CREAT, 0644
		254	or return;
		255
		256	my $value = $cf::RUNTIME;
		257	(aio_write $fh, 0, (length $value), $value, 0) <= 0
		258	and return;
		259
		260	aio_fsync $fh
		261	and return;
		262
		263	close $fh
		264	or return;
		265
		266	aio_rename "$runtime~", $runtime
		267	and return;
		268
		269	1
		270	}
		271
202	=back	272	=back
203		273
204	=cut	274	=cut
		275
		276	#############################################################################
		277
		278	package cf::path;
		279
		280	sub new {
		281	my ($class, $path, $base) = @_;
		282
		283	my $self = bless { }, $class;
		284
		285	if ($path =~ s{^\?random/}{}) {
		286	Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
		287	$self->{random} = cf::from_json $data;
		288	} else {
		289	if ($path =~ s{^~([^/]+)?}{}) {
		290	$self->{user_rel} = 1;
		291
		292	if (defined $1) {
		293	$self->{user} = $1;
		294	} elsif ($base =~ m{^~([^/]+)/}) {
		295	$self->{user} = $1;
		296	} else {
		297	warn "cannot resolve user-relative path without user <$path,$base>\n";
		298	}
		299	} elsif ($path =~ /^\//) {
		300	# already absolute
		301	} else {
		302	$base =~ s{[^/]+/?$}{};
		303	return $class->new ("$base/$path");
		304	}
		305
		306	for ($path) {
		307	redo if s{/\.?/}{/};
		308	redo if s{/[^/]+/\.\./}{/};
		309	}
		310	}
		311
		312	$self->{path} = $path;
		313
		314	$self
		315	}
		316
		317	# the name / primary key / in-game path
		318	sub as_string {
		319	my ($self) = @_;
		320
		321	$self->{user_rel} ? "~$self->{user}$self->{path}"
		322	: $self->{random} ? "?random/$self->{path}"
		323	: $self->{path}
		324	}
		325
		326	# the displayed name, this is a one way mapping
		327	sub visible_name {
		328	my ($self) = @_;
		329
		330	# if (my $rmp = $self->{random}) {
		331	# # todo: be more intelligent about this
		332	# "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
		333	# } else {
		334	$self->as_string
		335	# }
		336	}
		337
		338	# escape the /'s in the path
		339	sub _escaped_path {
		340	# ∕ is U+2215
		341	(my $path = $_[0]{path}) =~ s/\//∕/g;
		342	$path
		343	}
		344
		345	# the original (read-only) location
		346	sub load_path {
		347	my ($self) = @_;
		348
		349	sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
		350	}
		351
		352	# the temporary/swap location
		353	sub save_path {
		354	my ($self) = @_;
		355
		356	$self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
		357	: $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
		358	: sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
		359	}
		360
		361	# the unique path, might be eq to save_path
		362	sub uniq_path {
		363	my ($self) = @_;
		364
		365	$self->{user_rel} \|\| $self->{random}
		366	? undef
		367	: sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
		368	}
		369
		370	# return random map parameters, or undef
		371	sub random_map_params {
		372	my ($self) = @_;
		373
		374	$self->{random}
		375	}
		376
		377	# this is somewhat ugly, but style maps do need special treatment
		378	sub is_style_map {
		379	$_[0]{path} =~ m{^/styles/}
		380	}
		381
		382	package cf;
205		383
206	#############################################################################	384	#############################################################################
207		385
208	=head2 ATTACHABLE OBJECTS	386	=head2 ATTACHABLE OBJECTS
209		387
…		…
563	);	741	);
564		742
565	sub object_freezer_save {	743	sub object_freezer_save {
566	my ($filename, $rdata, $objs) = @_;	744	my ($filename, $rdata, $objs) = @_;
567		745
		746	sync_job {
568	if (length $$rdata) {	747	if (length $$rdata) {
569	warn sprintf "saving %s (%d,%d)\n",	748	warn sprintf "saving %s (%d,%d)\n",
570	$filename, length $$rdata, scalar @$objs;	749	$filename, length $$rdata, scalar @$objs;
571		750
572	if (open my $fh, ">:raw", "$filename~") {	751	if (my $fh = aio_open "$filename~", O_WRONLY \| O_CREAT, 0600) {
573	chmod SAVE_MODE, $fh;
574	syswrite $fh, $$rdata;
575	close $fh;
576
577	if (@$objs && open my $fh, ">:raw", "$filename.pst~") {
578	chmod SAVE_MODE, $fh;	752	chmod SAVE_MODE, $fh;
579	syswrite $fh, Storable::nfreeze { version => 1, objs => $objs };	753	aio_write $fh, 0, (length $$rdata), $$rdata, 0;
		754	aio_fsync $fh;
580	close $fh;	755	close $fh;
		756
		757	if (@$objs) {
		758	if (my $fh = aio_open "$filename.pst~", O_WRONLY \| O_CREAT, 0600) {
		759	chmod SAVE_MODE, $fh;
		760	my $data = Storable::nfreeze { version => 1, objs => $objs };
		761	aio_write $fh, 0, (length $data), $data, 0;
		762	aio_fsync $fh;
		763	close $fh;
581	rename "$filename.pst~", "$filename.pst";	764	aio_rename "$filename.pst~", "$filename.pst";
		765	}
		766	} else {
		767	aio_unlink "$filename.pst";
		768	}
		769
		770	aio_rename "$filename~", $filename;
582	} else {	771	} else {
583	unlink "$filename.pst";	772	warn "FATAL: $filename~: $!\n";
584	}	773	}
585
586	rename "$filename~", $filename;
587	} else {	774	} else {
588	warn "FATAL: $filename~: $!\n";
589	}
590	} else {
591	unlink $filename;	775	aio_unlink $filename;
592	unlink "$filename.pst";	776	aio_unlink "$filename.pst";
		777	}
593	}	778	}
594	}	779	}
595		780
596	sub object_freezer_as_string {	781	sub object_freezer_as_string {
597	my ($rdata, $objs) = @_;	782	my ($rdata, $objs) = @_;
…		…
602	}	787	}
603		788
604	sub object_thawer_load {	789	sub object_thawer_load {
605	my ($filename) = @_;	790	my ($filename) = @_;
606		791
607	local $/;	792	my ($data, $av);
608		793
609	my $av;	794	(aio_load $filename, $data) >= 0
		795	or return;
610		796
611	#TODO: use sysread etc.	797	unless (aio_stat "$filename.pst") {
612	if (open my $data, "<:raw:perlio", $filename) {	798	(aio_load "$filename.pst", $av) >= 0
613	$data = <$data>;	799	or return;
614	if (open my $pst, "<:raw:perlio", "$filename.pst") {
615	$av = eval { (Storable::thaw <$pst>)->{objs} };	800	$av = eval { (Storable::thaw <$av>)->{objs} };
616	}	801	}
		802
617	return ($data, $av);	803	return ($data, $av);
618	}
619
620	()
621	}	804	}
622		805
623	#############################################################################	806	#############################################################################
624	# command handling &c	807	# command handling &c
625		808
…		…
1224	local $/;	1407	local $/;
1225	*CFG = YAML::Syck::Load <$fh>;	1408	*CFG = YAML::Syck::Load <$fh>;
1226	}	1409	}
1227		1410
1228	sub main {	1411	sub main {
		1412	# we must not ever block the main coroutine
		1413	local $Coro::idle = sub {
		1414	Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
		1415	(Coro::unblock_sub {
		1416	Event::one_event;
		1417	})->();
		1418	};
		1419
1229	cfg_load;	1420	cfg_load;
1230	db_load;	1421	db_load;
1231	load_extensions;	1422	load_extensions;
1232	Event::loop;	1423	Event::loop;
1233	}	1424	}
1234		1425
1235	#############################################################################	1426	#############################################################################
1236	# initialisation	1427	# initialisation
1237		1428
1238	sub _perl_reload() {	1429	sub perl_reload() {
		1430	# can/must only be called in main
		1431	if ($Coro::current != $Coro::main) {
		1432	warn "can only reload from main coroutine\n";
		1433	return;
		1434	}
		1435
1239	warn "reloading...";	1436	warn "reloading...";
1240		1437
		1438	local $FREEZE = 1;
		1439	cf::emergency_save;
		1440
1241	eval {	1441	eval {
1242	local $FREEZE = 1;	1442	# if anything goes wrong in here, we should simply crash as we already saved
1243
1244	cf::emergency_save;
1245		1443
1246	# cancel all watchers	1444	# cancel all watchers
1247	for (Event::all_watchers) {	1445	for (Event::all_watchers) {
1248	$_->cancel if $_->data & WF_AUTOCANCEL;	1446	$_->cancel if $_->data & WF_AUTOCANCEL;
1249	}	1447	}
…		…
1308		1506
1309	# reattach attachments to objects	1507	# reattach attachments to objects
1310	warn "reattach";	1508	warn "reattach";
1311	_global_reattach;	1509	_global_reattach;
1312	};	1510	};
1313	warn $@ if $@;
1314		1511
1315	warn "reloaded";	1512	if ($@) {
		1513	warn $@;
		1514	warn "error while reloading, exiting.";
		1515	exit 1;
		1516	}
		1517
		1518	warn "reloaded successfully";
1316	};	1519	};
1317		1520
1318	sub perl_reload() {	1521	#############################################################################
1319	_perl_reload;	1522
		1523	unless ($LINK_MAP) {
		1524	$LINK_MAP = cf::map::new;
		1525
		1526	$LINK_MAP->width (41);
		1527	$LINK_MAP->height (41);
		1528	$LINK_MAP->alloc;
		1529	$LINK_MAP->path ("{link}");
		1530	$LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
		1531	$LINK_MAP->in_memory (MAP_IN_MEMORY);
1320	}	1532	}
1321		1533
1322	register "<global>", __PACKAGE__;	1534	register "<global>", __PACKAGE__;
1323		1535
1324	register_command "perl-reload" => sub {	1536	register_command "perl-reload" => sub {
1325	my ($who, $arg) = @_;	1537	my ($who, $arg) = @_;
1326		1538
1327	if ($who->flag (FLAG_WIZ)) {	1539	if ($who->flag (FLAG_WIZ)) {
1328	$who->message ("reloading...");	1540	$who->message ("start of reload.");
1329	_perl_reload;	1541	perl_reload;
		1542	$who->message ("end of reload.");
1330	}	1543	}
1331	};	1544	};
1332		1545
1333	unshift @INC, $LIBDIR;	1546	unshift @INC, $LIBDIR;
1334		1547
…		…
1353	},	1566	},
1354	);	1567	);
1355		1568
1356	IO::AIO::max_poll_time $TICK * 0.2;	1569	IO::AIO::max_poll_time $TICK * 0.2;
1357		1570
		1571	Event->io (
1358	Event->io (fd => IO::AIO::poll_fileno,	1572	fd => IO::AIO::poll_fileno,
1359	poll => 'r',	1573	poll => 'r',
1360	prio => 5,	1574	prio => 5,
1361	data => WF_AUTOCANCEL,	1575	data => WF_AUTOCANCEL,
1362	cb => \&IO::AIO::poll_cb);	1576	cb => \&IO::AIO::poll_cb,
		1577	);
1363		1578
1364	# we must not ever block the main coroutine	1579	Event->timer (
1365	$Coro::idle = sub {	1580	data => WF_AUTOCANCEL,
1366	#Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#	1581	after => 0,
1367	warn "FATAL: Coro::idle was called, major BUG\n";	1582	interval => 10,
		1583	cb => sub {
1368	(Coro::unblock_sub {	1584	(Coro::unblock_sub {
1369	Event::one_event;	1585	write_runtime
		1586	or warn "ERROR: unable to write runtime file: $!";
1370	})->();	1587	})->();
1371	};	1588	},
		1589	);
1372		1590
1373	1	1591	1
1374		1592

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.104 by root, Sat Dec 30 16:56:16 2006 UTC vs. Revision 1.109 by root, Sun Dec 31 22:23:12 2006 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.104 by root, Sat Dec 30 16:56:16 2006 UTC vs.
Revision 1.109 by root, Sun Dec 31 22:23:12 2006 UTC