[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.108 by root, Sun Dec 31 21:02:05 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	$self->{random} = cf::from_json $path;
		287	} else {
		288	if ($path =~ s{^~([^/]+)?}{}) {
		289	$self->{user_rel} = 1;
		290
		291	if (defined $1) {
		292	$self->{user} = $1;
		293	} elsif ($base =~ m{^~([^/]+)/}) {
		294	$self->{user} = $1;
		295	} else {
		296	warn "cannot resolve user-relative path without user <$path,$base>\n";
		297	}
		298	} elsif ($path =~ /^\//) {
		299	# already absolute
		300	} else {
		301	$base =~ s{[^/]+/?$}{};
		302	return $class->new ("$base/$path");
		303	}
		304
		305	for ($path) {
		306	redo if s{/\.?/}{/};
		307	redo if s{/[^/]+/\.\./}{/};
		308	}
		309	}
		310
		311	$self->{path} = $path;
		312
		313	$self
		314	}
		315
		316	# the name / primary key / in-game path
		317	sub as_string {
		318	my ($self) = @_;
		319
		320	$self->{user_rel} ? "~$self->{user}$self->{path}"
		321	: $self->{random} ? "?random/$self->{path}"
		322	: $self->{path}
		323	}
		324
		325	# the displayed name, this is a one way mapping
		326	sub visible_name {
		327	my ($self) = @_;
		328
		329	$self->{random} ? "?random/$self->{random}{origin_map}+$self->{random}{origin_x}+$self->{random}{origin_y}/$self->{random}{dungeon_level}"
		330	: $self->as_string
		331	}
		332
		333	# escape the /'s in the path
		334	sub _escaped_path {
		335	# ∕ is U+2215
		336	(my $path = $_[0]{path}) =~ s/\//∕/g;
		337	$path
		338	}
		339
		340	# the original (read-only) location
		341	sub load_path {
		342	my ($self) = @_;
		343
		344	sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
		345	}
		346
		347	# the temporary/swap location
		348	sub save_path {
		349	my ($self) = @_;
		350
		351	$self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
		352	: $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, Digest::MD5::md5_hex $self->{path}
		353	: sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
		354	}
		355
		356	# the unique path, might be eq to save_path
		357	sub uniq_path {
		358	my ($self) = @_;
		359
		360	$self->{user_rel} \|\| $self->{random}
		361	? undef
		362	: sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
		363	}
		364
		365	# return random map parameters, or undef
		366	sub random_map_params {
		367	my ($self) = @_;
		368
		369	$self->{random}
		370	}
		371
		372	# this is somewhat ugly, but style maps do need special treatment
		373	sub is_style_map {
		374	$_[0]{path} =~ m{^/styles/}
		375	}
		376
		377	package cf;
205		378
206	#############################################################################	379	#############################################################################
207		380
208	=head2 ATTACHABLE OBJECTS	381	=head2 ATTACHABLE OBJECTS
209		382
…		…
563	);	736	);
564		737
565	sub object_freezer_save {	738	sub object_freezer_save {
566	my ($filename, $rdata, $objs) = @_;	739	my ($filename, $rdata, $objs) = @_;
567		740
		741	sync_job {
568	if (length $$rdata) {	742	if (length $$rdata) {
569	warn sprintf "saving %s (%d,%d)\n",	743	warn sprintf "saving %s (%d,%d)\n",
570	$filename, length $$rdata, scalar @$objs;	744	$filename, length $$rdata, scalar @$objs;
571		745
572	if (open my $fh, ">:raw", "$filename~") {	746	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;	747	chmod SAVE_MODE, $fh;
579	syswrite $fh, Storable::nfreeze { version => 1, objs => $objs };	748	aio_write $fh, 0, (length $$rdata), $$rdata, 0;
		749	aio_fsync $fh;
580	close $fh;	750	close $fh;
		751
		752	if (@$objs) {
		753	if (my $fh = aio_open "$filename.pst~", O_WRONLY \| O_CREAT, 0600) {
		754	chmod SAVE_MODE, $fh;
		755	my $data = Storable::nfreeze { version => 1, objs => $objs };
		756	aio_write $fh, 0, (length $data), $data, 0;
		757	aio_fsync $fh;
		758	close $fh;
581	rename "$filename.pst~", "$filename.pst";	759	aio_rename "$filename.pst~", "$filename.pst";
		760	}
		761	} else {
		762	aio_unlink "$filename.pst";
		763	}
		764
		765	aio_rename "$filename~", $filename;
582	} else {	766	} else {
583	unlink "$filename.pst";	767	warn "FATAL: $filename~: $!\n";
584	}	768	}
585
586	rename "$filename~", $filename;
587	} else {	769	} else {
588	warn "FATAL: $filename~: $!\n";
589	}
590	} else {
591	unlink $filename;	770	aio_unlink $filename;
592	unlink "$filename.pst";	771	aio_unlink "$filename.pst";
		772	}
593	}	773	}
594	}	774	}
595		775
596	sub object_freezer_as_string {	776	sub object_freezer_as_string {
597	my ($rdata, $objs) = @_;	777	my ($rdata, $objs) = @_;
…		…
602	}	782	}
603		783
604	sub object_thawer_load {	784	sub object_thawer_load {
605	my ($filename) = @_;	785	my ($filename) = @_;
606		786
607	local $/;	787	my ($data, $av);
608		788
609	my $av;	789	(aio_load $filename, $data) >= 0
		790	or return;
610		791
611	#TODO: use sysread etc.	792	unless (aio_stat "$filename.pst") {
612	if (open my $data, "<:raw:perlio", $filename) {	793	(aio_load "$filename.pst", $av) >= 0
613	$data = <$data>;	794	or return;
614	if (open my $pst, "<:raw:perlio", "$filename.pst") {
615	$av = eval { (Storable::thaw <$pst>)->{objs} };	795	$av = eval { (Storable::thaw <$av>)->{objs} };
616	}	796	}
		797
617	return ($data, $av);	798	return ($data, $av);
618	}
619
620	()
621	}	799	}
622		800
623	#############################################################################	801	#############################################################################
624	# command handling &c	802	# command handling &c
625		803
…		…
1224	local $/;	1402	local $/;
1225	*CFG = YAML::Syck::Load <$fh>;	1403	*CFG = YAML::Syck::Load <$fh>;
1226	}	1404	}
1227		1405
1228	sub main {	1406	sub main {
		1407	# we must not ever block the main coroutine
		1408	local $Coro::idle = sub {
		1409	Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
		1410	(Coro::unblock_sub {
		1411	Event::one_event;
		1412	})->();
		1413	};
		1414
1229	cfg_load;	1415	cfg_load;
1230	db_load;	1416	db_load;
1231	load_extensions;	1417	load_extensions;
1232	Event::loop;	1418	Event::loop;
1233	}	1419	}
1234		1420
1235	#############################################################################	1421	#############################################################################
1236	# initialisation	1422	# initialisation
1237		1423
1238	sub _perl_reload() {	1424	sub perl_reload() {
		1425	# can/must only be called in main
		1426	if ($Coro::current != $Coro::main) {
		1427	warn "can only reload from main coroutine\n";
		1428	return;
		1429	}
		1430
1239	warn "reloading...";	1431	warn "reloading...";
1240		1432
		1433	local $FREEZE = 1;
		1434	cf::emergency_save;
		1435
1241	eval {	1436	eval {
1242	local $FREEZE = 1;	1437	# if anything goes wrong in here, we should simply crash as we already saved
1243
1244	cf::emergency_save;
1245		1438
1246	# cancel all watchers	1439	# cancel all watchers
1247	for (Event::all_watchers) {	1440	for (Event::all_watchers) {
1248	$_->cancel if $_->data & WF_AUTOCANCEL;	1441	$_->cancel if $_->data & WF_AUTOCANCEL;
1249	}	1442	}
…		…
1308		1501
1309	# reattach attachments to objects	1502	# reattach attachments to objects
1310	warn "reattach";	1503	warn "reattach";
1311	_global_reattach;	1504	_global_reattach;
1312	};	1505	};
1313	warn $@ if $@;
1314		1506
1315	warn "reloaded";	1507	if ($@) {
		1508	warn $@;
		1509	warn "error while reloading, exiting.";
		1510	exit 1;
		1511	}
		1512
		1513	warn "reloaded successfully";
1316	};	1514	};
1317		1515
1318	sub perl_reload() {	1516	#############################################################################
1319	_perl_reload;	1517
		1518	unless ($LINK_MAP) {
		1519	$LINK_MAP = cf::map::new;
		1520
		1521	$LINK_MAP->width (41);
		1522	$LINK_MAP->height (41);
		1523	$LINK_MAP->alloc;
		1524	$LINK_MAP->path ("{link}");
		1525	$LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
		1526	$LINK_MAP->in_memory (MAP_IN_MEMORY);
1320	}	1527	}
1321		1528
1322	register "<global>", __PACKAGE__;	1529	register "<global>", __PACKAGE__;
1323		1530
1324	register_command "perl-reload" => sub {	1531	register_command "perl-reload" => sub {
1325	my ($who, $arg) = @_;	1532	my ($who, $arg) = @_;
1326		1533
1327	if ($who->flag (FLAG_WIZ)) {	1534	if ($who->flag (FLAG_WIZ)) {
1328	$who->message ("reloading...");	1535	$who->message ("start of reload.");
1329	_perl_reload;	1536	perl_reload;
		1537	$who->message ("end of reload.");
1330	}	1538	}
1331	};	1539	};
1332		1540
1333	unshift @INC, $LIBDIR;	1541	unshift @INC, $LIBDIR;
1334		1542
…		…
1353	},	1561	},
1354	);	1562	);
1355		1563
1356	IO::AIO::max_poll_time $TICK * 0.2;	1564	IO::AIO::max_poll_time $TICK * 0.2;
1357		1565
		1566	Event->io (
1358	Event->io (fd => IO::AIO::poll_fileno,	1567	fd => IO::AIO::poll_fileno,
1359	poll => 'r',	1568	poll => 'r',
1360	prio => 5,	1569	prio => 5,
1361	data => WF_AUTOCANCEL,	1570	data => WF_AUTOCANCEL,
1362	cb => \&IO::AIO::poll_cb);	1571	cb => \&IO::AIO::poll_cb,
		1572	);
1363		1573
1364	# we must not ever block the main coroutine	1574	Event->timer (
1365	$Coro::idle = sub {	1575	data => WF_AUTOCANCEL,
1366	#Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#	1576	after => 0,
1367	warn "FATAL: Coro::idle was called, major BUG\n";	1577	interval => 10,
		1578	cb => sub {
1368	(Coro::unblock_sub {	1579	(Coro::unblock_sub {
1369	Event::one_event;	1580	write_runtime
		1581	or warn "ERROR: unable to write runtime file: $!";
1370	})->();	1582	})->();
1371	};	1583	},
		1584	);
1372		1585
1373	1	1586	1
1374		1587

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.108 by root, Sun Dec 31 21:02:05 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.108 by root, Sun Dec 31 21:02:05 2006 UTC