ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.493 by root, Mon Oct 26 02:34:37 2009 UTC vs.
Revision 1.529 by root, Wed Apr 28 11:28:22 2010 UTC

1# 1#
2# This file is part of Deliantra, the Roguelike Realtime MMORPG. 2# This file is part of Deliantra, the Roguelike Realtime MMORPG.
3# 3#
4# Copyright (©) 2006,2007,2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team 4# Copyright (©) 2006,2007,2008,2009,2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
5# 5#
6# Deliantra is free software: you can redistribute it and/or modify it under 6# Deliantra is free software: you can redistribute it and/or modify it under
7# the terms of the Affero GNU General Public License as published by the 7# the terms of the Affero GNU General Public License as published by the
8# Free Software Foundation, either version 3 of the License, or (at your 8# Free Software Foundation, either version 3 of the License, or (at your
9# option) any later version. 9# option) any later version.
… …
53use Coro::Util (); 53use Coro::Util ();
54 54
55use JSON::XS 2.01 (); 55use JSON::XS 2.01 ();
56use BDB (); 56use BDB ();
57use Data::Dumper; 57use Data::Dumper;
58use Digest::MD5;
59use Fcntl; 58use Fcntl;
60use YAML::XS (); 59use YAML::XS ();
61use IO::AIO (); 60use IO::AIO ();
62use Time::HiRes; 61use Time::HiRes;
63use Compress::LZF; 62use Compress::LZF;
… …
109our $PIDFILE = "$LOCALDIR/pid"; 108our $PIDFILE = "$LOCALDIR/pid";
110our $RUNTIMEFILE = "$LOCALDIR/runtime"; 109our $RUNTIMEFILE = "$LOCALDIR/runtime";
111 110
112our %RESOURCE; 111our %RESOURCE;
113 112
113our $OUTPUT_RATE_MIN = 3000;
114our $OUTPUT_RATE_MAX = 1000000;
115
116our $MAX_LINKS = 32; # how many chained exits to follow
117our $VERBOSE_IO = 1;
118
114our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 119our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
115our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 120our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
116our $NEXT_TICK; 121our $NEXT_TICK;
117our $USE_FSYNC = 1; # use fsync to write maps - default on 122our $USE_FSYNC = 1; # use fsync to write maps - default on
118 123
… …
163 168
164our $EMERGENCY_POSITION; 169our $EMERGENCY_POSITION;
165 170
166sub cf::map::normalise; 171sub cf::map::normalise;
167 172
173sub in_main() {
174 $Coro::current == $Coro::main
175}
176
168############################################################################# 177#############################################################################
169 178
170%REFLECT = (); 179%REFLECT = ();
171for (@REFLECT) { 180for (@REFLECT) {
172 my $reflect = JSON::XS::decode_json $_; 181 my $reflect = JSON::XS::decode_json $_;
… …
259$Coro::State::DIEHOOK = sub { 268$Coro::State::DIEHOOK = sub {
260 return unless $^S eq 0; # "eq", not "==" 269 return unless $^S eq 0; # "eq", not "=="
261 270
262 warn Carp::longmess $_[0]; 271 warn Carp::longmess $_[0];
263 272
264 if ($Coro::current == $Coro::main) {#d# 273 if (in_main) {#d#
265 warn "DIEHOOK called in main context, Coro bug?\n";#d# 274 warn "DIEHOOK called in main context, Coro bug?\n";#d#
266 return;#d# 275 return;#d#
267 }#d# 276 }#d#
268 277
269 # kill coroutine otherwise 278 # kill coroutine otherwise
… …
397} 406}
398 407
399=item cf::periodic $interval, $cb 408=item cf::periodic $interval, $cb
400 409
401Like EV::periodic, but randomly selects a starting point so that the actions 410Like EV::periodic, but randomly selects a starting point so that the actions
402get spread over timer. 411get spread over time.
403 412
404=cut 413=cut
405 414
406sub periodic($$) { 415sub periodic($$) {
407 my ($interval, $cb) = @_; 416 my ($interval, $cb) = @_;
… …
424 433
425=cut 434=cut
426 435
427our @SLOT_QUEUE; 436our @SLOT_QUEUE;
428our $SLOT_QUEUE; 437our $SLOT_QUEUE;
438our $SLOT_DECAY = 0.9;
429 439
430$SLOT_QUEUE->cancel if $SLOT_QUEUE; 440$SLOT_QUEUE->cancel if $SLOT_QUEUE;
431$SLOT_QUEUE = Coro::async { 441$SLOT_QUEUE = Coro::async {
432 $Coro::current->desc ("timeslot manager"); 442 $Coro::current->desc ("timeslot manager");
433 443
434 my $signal = new Coro::Signal; 444 my $signal = new Coro::Signal;
445 my $busy;
435 446
436 while () { 447 while () {
437 next_job: 448 next_job:
449
438 my $avail = cf::till_tick; 450 my $avail = cf::till_tick;
439 if ($avail > 0.01) { 451
440 for (0 .. $#SLOT_QUEUE) { 452 for (0 .. $#SLOT_QUEUE) {
441 if ($SLOT_QUEUE[$_][0] < $avail) { 453 if ($SLOT_QUEUE[$_][0] <= $avail) {
454 $busy = 0;
442 my $job = splice @SLOT_QUEUE, $_, 1, (); 455 my $job = splice @SLOT_QUEUE, $_, 1, ();
443 $job->[2]->send; 456 $job->[2]->send;
444 Coro::cede; 457 Coro::cede;
445 goto next_job; 458 goto next_job;
446 } 459 } else {
460 $SLOT_QUEUE[$_][0] *= $SLOT_DECAY;
447 } 461 }
448 } 462 }
449 463
450 if (@SLOT_QUEUE) { 464 if (@SLOT_QUEUE) {
451 # we do not use wait_for_tick() as it returns immediately when tick is inactive 465 # we do not use wait_for_tick() as it returns immediately when tick is inactive
452 push @cf::WAIT_FOR_TICK, $signal; 466 push @cf::WAIT_FOR_TICK, $signal;
453 $signal->wait; 467 $signal->wait;
454 } else { 468 } else {
469 $busy = 0;
455 Coro::schedule; 470 Coro::schedule;
456 } 471 }
457 } 472 }
458}; 473};
459 474
460sub get_slot($;$$) { 475sub get_slot($;$$) {
461 return if tick_inhibit || $Coro::current == $Coro::main; 476 return if tick_inhibit || $Coro::current == $Coro::main;
462 477
463 my ($time, $pri, $name) = @_; 478 my ($time, $pri, $name) = @_;
464 479
465 $time = $TICK * .6 if $time > $TICK * .6; 480 $time = clamp $time, 0.01, $TICK * .6;
481
466 my $sig = new Coro::Signal; 482 my $sig = new Coro::Signal;
467 483
468 push @SLOT_QUEUE, [$time, $pri, $sig, $name]; 484 push @SLOT_QUEUE, [$time, $pri, $sig, $name];
469 @SLOT_QUEUE = sort { $b->[1] <=> $a->[1] } @SLOT_QUEUE; 485 @SLOT_QUEUE = sort { $b->[1] <=> $a->[1] } @SLOT_QUEUE;
470 $SLOT_QUEUE->ready; 486 $SLOT_QUEUE->ready;
… …
497 513
498sub sync_job(&) { 514sub sync_job(&) {
499 my ($job) = @_; 515 my ($job) = @_;
500 516
501 if ($Coro::current == $Coro::main) { 517 if ($Coro::current == $Coro::main) {
502 my $time = EV::time; 518 my $time = AE::time;
503 519
504 # this is the main coro, too bad, we have to block 520 # this is the main coro, too bad, we have to block
505 # till the operation succeeds, freezing the server :/ 521 # till the operation succeeds, freezing the server :/
506 522
507 LOG llevError, Carp::longmess "sync job";#d# 523 LOG llevError, Carp::longmess "sync job";#d#
… …
524 } else { 540 } else {
525 EV::loop EV::LOOP_ONESHOT; 541 EV::loop EV::LOOP_ONESHOT;
526 } 542 }
527 } 543 }
528 544
529 my $time = EV::time - $time; 545 my $time = AE::time - $time;
530 546
531 $TICK_START += $time; # do not account sync jobs to server load 547 $TICK_START += $time; # do not account sync jobs to server load
532 548
533 wantarray ? @res : $res[0] 549 wantarray ? @res : $res[0]
534 } else { 550 } else {
… …
578 reset_signals; 594 reset_signals;
579 &$cb 595 &$cb
580 }, @args; 596 }, @args;
581 597
582 wantarray ? @res : $res[-1] 598 wantarray ? @res : $res[-1]
599}
600
601sub objinfo {
602 (
603 "counter value" => cf::object::object_count,
604 "objects created" => cf::object::create_count,
605 "objects destroyed" => cf::object::destroy_count,
606 "freelist size" => cf::object::free_count,
607 "allocated objects" => cf::object::objects_size,
608 "active objects" => cf::object::actives_size,
609 )
583} 610}
584 611
585=item $coin = coin_from_name $name 612=item $coin = coin_from_name $name
586 613
587=cut 614=cut
… …
1168 1195
1169 sync_job { 1196 sync_job {
1170 if (length $$rdata) { 1197 if (length $$rdata) {
1171 utf8::decode (my $decname = $filename); 1198 utf8::decode (my $decname = $filename);
1172 warn sprintf "saving %s (%d,%d)\n", 1199 warn sprintf "saving %s (%d,%d)\n",
1173 $decname, length $$rdata, scalar @$objs; 1200 $decname, length $$rdata, scalar @$objs
1201 if $VERBOSE_IO;
1174 1202
1175 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) { 1203 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
1176 aio_chmod $fh, SAVE_MODE; 1204 aio_chmod $fh, SAVE_MODE;
1177 aio_write $fh, 0, (length $$rdata), $$rdata, 0; 1205 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
1178 if ($cf::USE_FSYNC) { 1206 if ($cf::USE_FSYNC) {
… …
1235 $av = $st->{objs}; 1263 $av = $st->{objs};
1236 } 1264 }
1237 1265
1238 utf8::decode (my $decname = $filename); 1266 utf8::decode (my $decname = $filename);
1239 warn sprintf "loading %s (%d,%d)\n", 1267 warn sprintf "loading %s (%d,%d)\n",
1240 $decname, length $data, scalar @{$av || []}; 1268 $decname, length $data, scalar @{$av || []}
1269 if $VERBOSE_IO;
1241 1270
1242 ($data, $av) 1271 ($data, $av)
1243} 1272}
1244 1273
1245=head2 COMMAND CALLBACKS 1274=head2 COMMAND CALLBACKS
… …
1304} 1333}
1305 1334
1306use File::Glob (); 1335use File::Glob ();
1307 1336
1308cf::player->attach ( 1337cf::player->attach (
1309 on_command => sub { 1338 on_unknown_command => sub {
1310 my ($pl, $name, $params) = @_; 1339 my ($pl, $name, $params) = @_;
1311 1340
1312 my $cb = $COMMAND{$name} 1341 my $cb = $COMMAND{$name}
1313 or return; 1342 or return;
1314 1343
… …
1393 . "\n};\n1"; 1422 . "\n};\n1";
1394 1423
1395 $todo{$base} = \%ext; 1424 $todo{$base} = \%ext;
1396 } 1425 }
1397 1426
1427 my $pass = 0;
1398 my %done; 1428 my %done;
1399 while (%todo) { 1429 while (%todo) {
1400 my $progress; 1430 my $progress;
1401 1431
1432 ++$pass;
1433
1434 ext:
1402 while (my ($k, $v) = each %todo) { 1435 while (my ($k, $v) = each %todo) {
1403 for (split /,\s*/, $v->{meta}{depends}) { 1436 for (split /,\s*/, $v->{meta}{depends}) {
1404 goto skip 1437 next ext
1405 unless exists $done{$_}; 1438 unless exists $done{$_};
1406 } 1439 }
1407 1440
1408 warn "... loading '$k' into '$v->{pkg}'\n"; 1441 warn "... pass $pass, loading '$k' into '$v->{pkg}'\n";
1409 1442
1410 unless (eval $v->{source}) { 1443 my $active = eval $v->{source};
1444
1445 if (length $@) {
1411 my $msg = $@ ? "$v->{path}: $@\n" 1446 warn "$v->{path}: $@\n";
1412 : "$v->{base}: extension inactive.\n";
1413 1447
1414 if (exists $v->{meta}{mandatory}) {
1415 warn $msg;
1416 cf::cleanup "mandatory extension failed to load, exiting."; 1448 cf::cleanup "mandatory extension '$k' failed to load, exiting."
1417 } 1449 if exists $v->{meta}{mandatory};
1418 1450
1419 warn $msg; 1451 warn "$v->{base}: optional extension cannot be loaded, skipping.\n";
1452 delete $todo{$k};
1453 } else {
1454 $done{$k} = delete $todo{$k};
1455 push @EXTS, $v->{pkg};
1456 $progress = 1;
1457
1458 warn "$v->{base}: extension inactive.\n"
1459 unless $active;
1420 } 1460 }
1421
1422 $done{$k} = delete $todo{$k};
1423 push @EXTS, $v->{pkg};
1424 $progress = 1;
1425 } 1461 }
1426 1462
1427 skip: 1463 unless ($progress) {
1428 die "cannot load " . (join ", ", keys %todo) . ": unable to resolve dependencies\n" 1464 warn "cannot load " . (join ", ", keys %todo) . ": unable to resolve dependencies\n";
1429 unless $progress; 1465
1466 while (my ($k, $v) = each %todo) {
1467 cf::cleanup "mandatory extension '$k' has unresolved dependencies, exiting."
1468 if exists $v->{meta}{mandatory};
1469 }
1470 }
1430 } 1471 }
1431 }; 1472 };
1432} 1473}
1433 1474
1434############################################################################# 1475#############################################################################
… …
1518 $cf::PLAYER{$login} = $pl 1559 $cf::PLAYER{$login} = $pl
1519 } 1560 }
1520 } 1561 }
1521} 1562}
1522 1563
1564cf::player->attach (
1565 on_load => sub {
1566 my ($pl, $path) = @_;
1567
1568 # restore slots saved in save, below
1569 my $slots = delete $pl->{_slots};
1570
1571 $pl->ob->current_weapon ($slots->[0]);
1572 $pl->combat_ob ($slots->[1]);
1573 $pl->ranged_ob ($slots->[2]);
1574 },
1575);
1576
1523sub save($) { 1577sub save($) {
1524 my ($pl) = @_; 1578 my ($pl) = @_;
1525 1579
1526 return if $pl->{deny_save}; 1580 return if $pl->{deny_save};
1527 1581
… …
1532 1586
1533 aio_mkdir playerdir $pl, 0770; 1587 aio_mkdir playerdir $pl, 0770;
1534 $pl->{last_save} = $cf::RUNTIME; 1588 $pl->{last_save} = $cf::RUNTIME;
1535 1589
1536 cf::get_slot 0.01; 1590 cf::get_slot 0.01;
1591
1592 # save slots, to be restored later
1593 local $pl->{_slots} = [$pl->ob->current_weapon, $pl->combat_ob, $pl->ranged_ob];
1537 1594
1538 $pl->save_pl ($path); 1595 $pl->save_pl ($path);
1539 cf::cede_to_tick; 1596 cf::cede_to_tick;
1540} 1597}
1541 1598
… …
1578 $pl->password ("*"); # this should lock out the player until we have nuked the dir 1635 $pl->password ("*"); # this should lock out the player until we have nuked the dir
1579 1636
1580 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active; 1637 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1581 $pl->deactivate; 1638 $pl->deactivate;
1582 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy; 1639 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy;
1583 $pl->ob->check_score;
1584 $pl->invoke (cf::EVENT_PLAYER_QUIT); 1640 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1585 $pl->ns->destroy if $pl->ns; 1641 $pl->ns->destroy if $pl->ns;
1586 1642
1587 my $path = playerdir $pl; 1643 my $path = playerdir $pl;
1588 my $temp = "$path~$cf::RUNTIME~deleting~"; 1644 my $temp = "$path~$cf::RUNTIME~deleting~";
… …
1643 \@logins 1699 \@logins
1644} 1700}
1645 1701
1646=item $player->maps 1702=item $player->maps
1647 1703
1704=item cf::player::maps $login
1705
1648Returns an arrayref of map paths that are private for this 1706Returns an arrayref of map paths that are private for this
1649player. May block. 1707player. May block.
1650 1708
1651=cut 1709=cut
1652 1710
… …
1714=cut 1772=cut
1715 1773
1716sub find_by_path($) { 1774sub find_by_path($) {
1717 my ($path) = @_; 1775 my ($path) = @_;
1718 1776
1777 $path =~ s/^~[^\/]*//; # skip ~login
1778
1719 my ($match, $specificity); 1779 my ($match, $specificity);
1720 1780
1721 for my $region (list) { 1781 for my $region (list) {
1722 if ($region->{match} && $path =~ $region->{match}) { 1782 if ($region->{match} && $path =~ $region->{match}) {
1723 ($match, $specificity) = ($region, $region->specificity) 1783 ($match, $specificity) = ($region, $region->specificity)
… …
1754 my $lock = cf::lock_acquire "generate_random_map"; # the random map generator is NOT reentrant ATM 1814 my $lock = cf::lock_acquire "generate_random_map"; # the random map generator is NOT reentrant ATM
1755 1815
1756 # mit "rum" bekleckern, nicht 1816 # mit "rum" bekleckern, nicht
1757 $self->_create_random_map ( 1817 $self->_create_random_map (
1758 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle}, 1818 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1759 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, 1819 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, $rmp->{miningstyle},
1760 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map}, 1820 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1761 $rmp->{exit_on_final_map}, 1821 $rmp->{exit_on_final_map},
1762 $rmp->{xsize}, $rmp->{ysize}, 1822 $rmp->{xsize}, $rmp->{ysize},
1763 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3}, 1823 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1764 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase}, 1824 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
… …
1786 1846
1787 $EXT_MAP{$pkg} = [$prio, qr<$regex>]; 1847 $EXT_MAP{$pkg} = [$prio, qr<$regex>];
1788} 1848}
1789 1849
1790# also paths starting with '/' 1850# also paths starting with '/'
1791$EXT_MAP{"cf::map"} = [0, qr{^(?=/)}]; 1851$EXT_MAP{"cf::map::wrap"} = [0, qr{^(?=/)}];
1792 1852
1793sub thawer_merge { 1853sub thawer_merge {
1794 my ($self, $merge) = @_; 1854 my ($self, $merge) = @_;
1795 1855
1796 # we have to keep some variables in memory intact 1856 # we have to keep some variables in memory intact
… …
2010 2070
2011 $cf::MAP{$path} = $map 2071 $cf::MAP{$path} = $map
2012 } 2072 }
2013} 2073}
2014 2074
2015sub pre_load { } 2075sub pre_load { }
2016sub post_load { } 2076#sub post_load { } # XS
2017 2077
2018sub load { 2078sub load {
2019 my ($self) = @_; 2079 my ($self) = @_;
2020 2080
2021 local $self->{deny_reset} = 1; # loading can take a long time 2081 local $self->{deny_reset} = 1; # loading can take a long time
… …
2078 } 2138 }
2079 2139
2080 $self->post_load; 2140 $self->post_load;
2081} 2141}
2082 2142
2143# customize the map for a given player, i.e.
2144# return the _real_ map. used by e.g. per-player
2145# maps to change the path to ~playername/mappath
2083sub customise_for { 2146sub customise_for {
2084 my ($self, $ob) = @_; 2147 my ($self, $ob) = @_;
2085 2148
2086 return find "~" . $ob->name . "/" . $self->{path} 2149 return find "~" . $ob->name . "/" . $self->{path}
2087 if $self->per_player; 2150 if $self->per_player;
… …
2103 or next; 2166 or next;
2104 $neigh = find $neigh, $map 2167 $neigh = find $neigh, $map
2105 or next; 2168 or next;
2106 $neigh->load; 2169 $neigh->load;
2107 2170
2171 # now find the diagonal neighbours
2108 push @neigh, 2172 push @neigh,
2109 [$neigh->tile_path (($_ + 3) % 4), $neigh], 2173 [$neigh->tile_path (($_ + 3) % 4), $neigh],
2110 [$neigh->tile_path (($_ + 1) % 4), $neigh]; 2174 [$neigh->tile_path (($_ + 1) % 4), $neigh];
2111 } 2175 }
2112 2176
… …
2164 $MAP_PREFETCHER->prio (6); 2228 $MAP_PREFETCHER->prio (6);
2165 2229
2166 () 2230 ()
2167} 2231}
2168 2232
2233# common code, used by both ->save and ->swapout
2169sub save { 2234sub _save {
2170 my ($self) = @_; 2235 my ($self) = @_;
2171
2172 my $lock = cf::lock_acquire "map_data:$self->{path}";
2173 2236
2174 $self->{last_save} = $cf::RUNTIME; 2237 $self->{last_save} = $cf::RUNTIME;
2175 2238
2176 return unless $self->dirty; 2239 return unless $self->dirty;
2177 2240
… …
2197 } else { 2260 } else {
2198 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 2261 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
2199 } 2262 }
2200} 2263}
2201 2264
2265sub save {
2266 my ($self) = @_;
2267
2268 my $lock = cf::lock_acquire "map_data:$self->{path}";
2269
2270 $self->_save;
2271}
2272
2202sub swap_out { 2273sub swap_out {
2203 my ($self) = @_; 2274 my ($self) = @_;
2204 2275
2205 # save first because save cedes
2206 $self->save;
2207
2208 my $lock = cf::lock_acquire "map_data:$self->{path}"; 2276 my $lock = cf::lock_acquire "map_data:$self->{path}";
2209 2277
2210 return if $self->players;
2211 return if $self->in_memory != cf::MAP_ACTIVE; 2278 return if $self->in_memory != cf::MAP_ACTIVE;
2212 return if $self->{deny_save}; 2279 return if $self->{deny_save};
2280 return if $self->players;
2213 2281
2282 # first deactivate the map and "unlink" it from the core
2283 $self->deactivate;
2284 $_->clear_links_to ($self) for values %cf::MAP;
2214 $self->in_memory (cf::MAP_SWAPPED); 2285 $self->in_memory (cf::MAP_SWAPPED);
2286
2287 # then atomically save
2288 $self->_save;
2289
2290 # then free the map
2291 $self->clear;
2292}
2293
2294sub reset_at {
2295 my ($self) = @_;
2296
2297 # TODO: safety, remove and allow resettable per-player maps
2298 return 1e99 if $self->{deny_reset};
2299
2300 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
2301 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
2302
2303 $time + $to
2304}
2305
2306sub should_reset {
2307 my ($self) = @_;
2308
2309 $self->reset_at <= $cf::RUNTIME
2310}
2311
2312sub reset {
2313 my ($self) = @_;
2314
2315 my $lock = cf::lock_acquire "map_data:$self->{path}";
2316
2317 return if $self->players;
2318
2319 warn "resetting map ", $self->path, "\n";
2320
2321 $self->in_memory (cf::MAP_SWAPPED);
2322
2323 # need to save uniques path
2324 unless ($self->{deny_save}) {
2325 my $uniq = $self->uniq_path; utf8::encode $uniq;
2326
2327 $self->_save_objects ($uniq, cf::IO_UNIQUES)
2328 if $uniq;
2329 }
2330
2331 delete $cf::MAP{$self->path};
2215 2332
2216 $self->deactivate; 2333 $self->deactivate;
2217 $_->clear_links_to ($self) for values %cf::MAP; 2334 $_->clear_links_to ($self) for values %cf::MAP;
2218 $self->clear; 2335 $self->clear;
2219}
2220
2221sub reset_at {
2222 my ($self) = @_;
2223
2224 # TODO: safety, remove and allow resettable per-player maps
2225 return 1e99 if $self->{deny_reset};
2226
2227 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
2228 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
2229
2230 $time + $to
2231}
2232
2233sub should_reset {
2234 my ($self) = @_;
2235
2236 $self->reset_at <= $cf::RUNTIME
2237}
2238
2239sub reset {
2240 my ($self) = @_;
2241
2242 my $lock = cf::lock_acquire "map_data:$self->{path}";
2243
2244 return if $self->players;
2245
2246 warn "resetting map ", $self->path, "\n";
2247
2248 $self->in_memory (cf::MAP_SWAPPED);
2249
2250 # need to save uniques path
2251 unless ($self->{deny_save}) {
2252 my $uniq = $self->uniq_path; utf8::encode $uniq;
2253
2254 $self->_save_objects ($uniq, cf::IO_UNIQUES)
2255 if $uniq;
2256 }
2257
2258 delete $cf::MAP{$self->path};
2259
2260 $self->deactivate;
2261 $_->clear_links_to ($self) for values %cf::MAP;
2262 $self->clear;
2263 2336
2264 $self->unlink_save; 2337 $self->unlink_save;
2265 $self->destroy; 2338 $self->destroy;
2266} 2339}
2267 2340
… …
2275 2348
2276 delete $cf::MAP{$self->path}; 2349 delete $cf::MAP{$self->path};
2277 2350
2278 $self->unlink_save; 2351 $self->unlink_save;
2279 2352
2280 bless $self, "cf::map"; 2353 bless $self, "cf::map::wrap";
2281 delete $self->{deny_reset}; 2354 delete $self->{deny_reset};
2282 $self->{deny_save} = 1; 2355 $self->{deny_save} = 1;
2283 $self->reset_timeout (1); 2356 $self->reset_timeout (1);
2284 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++)); 2357 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++));
2285 2358
… …
2515 2588
2516Freezes the player and moves him/her to a special map (C<{link}>). 2589Freezes the player and moves him/her to a special map (C<{link}>).
2517 2590
2518The player should be reasonably safe there for short amounts of time (e.g. 2591The player should be reasonably safe there for short amounts of time (e.g.
2519for loading a map). You I<MUST> call C<leave_link> as soon as possible, 2592for loading a map). You I<MUST> call C<leave_link> as soon as possible,
2520though, as the palyer cannot control the character while it is on the link 2593though, as the player cannot control the character while it is on the link
2521map. 2594map.
2522 2595
2523Will never block. 2596Will never block.
2524 2597
2525=item $player_object->leave_link ($map, $x, $y) 2598=item $player_object->leave_link ($map, $x, $y)
… …
2546sub cf::object::player::enter_link { 2619sub cf::object::player::enter_link {
2547 my ($self) = @_; 2620 my ($self) = @_;
2548 2621
2549 $self->deactivate_recursive; 2622 $self->deactivate_recursive;
2550 2623
2624 ++$self->{_link_recursion};
2625
2551 return if UNIVERSAL::isa $self->map, "ext::map_link"; 2626 return if UNIVERSAL::isa $self->map, "ext::map_link";
2552 2627
2553 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y] 2628 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
2554 if $self->map && $self->map->{path} ne "{link}"; 2629 if $self->map && $self->map->{path} ne "{link}";
2555 2630
2556 $self->enter_map ($LINK_MAP || link_map, 10, 10); 2631 $self->enter_map ($LINK_MAP || link_map, 3, 3);
2557} 2632}
2558 2633
2559sub cf::object::player::leave_link { 2634sub cf::object::player::leave_link {
2560 my ($self, $map, $x, $y) = @_; 2635 my ($self, $map, $x, $y) = @_;
2561 2636
… …
2586 $map->load_neighbours; 2661 $map->load_neighbours;
2587 2662
2588 return unless $self->contr->active; 2663 return unless $self->contr->active;
2589 2664
2590 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2665 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2591 $self->enter_map ($map, $x, $y); 2666 if ($self->enter_map ($map, $x, $y)) {
2592 2667 # entering was successful
2668 delete $self->{_link_recursion};
2593 # only activate afterwards, to support waiting in hooks 2669 # only activate afterwards, to support waiting in hooks
2594 $self->activate_recursive; 2670 $self->activate_recursive;
2595} 2671 }
2596 2672
2673}
2674
2597=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]]) 2675=item $player_object->goto ($path, $x, $y[, $check->($map, $x, $y, $player)[, $done->($player)]])
2598 2676
2599Moves the player to the given map-path and coordinates by first freezing 2677Moves the player to the given map-path and coordinates by first freezing
2600her, loading and preparing them map, calling the provided $check callback 2678her, loading and preparing them map, calling the provided $check callback
2601that has to return the map if sucecssful, and then unfreezes the player on 2679that has to return the map if sucecssful, and then unfreezes the player on
2602the new (success) or old (failed) map position. In either case, $done will 2680the new (success) or old (failed) map position. In either case, $done will
… …
2609 2687
2610our $GOTOGEN; 2688our $GOTOGEN;
2611 2689
2612sub cf::object::player::goto { 2690sub cf::object::player::goto {
2613 my ($self, $path, $x, $y, $check, $done) = @_; 2691 my ($self, $path, $x, $y, $check, $done) = @_;
2692
2693 if ($self->{_link_recursion} >= $MAX_LINKS) {
2694 warn "FATAL: link recursion exceeded, ", $self->name, " goto $path $x $y, redirecting.";
2695 $self->failmsg ("Something went wrong inside the server - please contact an administrator!");
2696 ($path, $x, $y) = @$EMERGENCY_POSITION;
2697 }
2614 2698
2615 # do generation counting so two concurrent goto's will be executed in-order 2699 # do generation counting so two concurrent goto's will be executed in-order
2616 my $gen = $self->{_goto_generation} = ++$GOTOGEN; 2700 my $gen = $self->{_goto_generation} = ++$GOTOGEN;
2617 2701
2618 $self->enter_link; 2702 $self->enter_link;
… …
2642 my $map = eval { 2726 my $map = eval {
2643 my $map = defined $path ? cf::map::find $path : undef; 2727 my $map = defined $path ? cf::map::find $path : undef;
2644 2728
2645 if ($map) { 2729 if ($map) {
2646 $map = $map->customise_for ($self); 2730 $map = $map->customise_for ($self);
2647 $map = $check->($map) if $check && $map; 2731 $map = $check->($map, $x, $y, $self) if $check && $map;
2648 } else { 2732 } else {
2649 $self->message ("The exit to '$path' is closed.", cf::NDI_UNIQUE | cf::NDI_RED); 2733 $self->message ("The exit to '$path' is closed.", cf::NDI_UNIQUE | cf::NDI_RED);
2650 } 2734 }
2651 2735
2652 $map 2736 $map
… …
2660 if ($gen == $self->{_goto_generation}) { 2744 if ($gen == $self->{_goto_generation}) {
2661 delete $self->{_goto_generation}; 2745 delete $self->{_goto_generation};
2662 $self->leave_link ($map, $x, $y); 2746 $self->leave_link ($map, $x, $y);
2663 } 2747 }
2664 2748
2665 $done->() if $done; 2749 $done->($self) if $done;
2666 })->prio (1); 2750 })->prio (1);
2667} 2751}
2668 2752
2669=item $player_object->enter_exit ($exit_object) 2753=item $player_object->enter_exit ($exit_object)
2670 2754
… …
2785sub cf::client::send_drawinfo { 2869sub cf::client::send_drawinfo {
2786 my ($self, $text, $flags) = @_; 2870 my ($self, $text, $flags) = @_;
2787 2871
2788 utf8::encode $text; 2872 utf8::encode $text;
2789 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text); 2873 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text);
2874}
2875
2876=item $client->send_big_packet ($pkt)
2877
2878Like C<send_packet>, but tries to compress large packets, and fragments
2879them as required.
2880
2881=cut
2882
2883our $MAXFRAGSIZE = cf::MAXSOCKBUF - 64;
2884
2885sub cf::client::send_big_packet {
2886 my ($self, $pkt) = @_;
2887
2888 # try lzf for large packets
2889 $pkt = "lzf " . Compress::LZF::compress $pkt
2890 if 1024 <= length $pkt and $self->{can_lzf};
2891
2892 # split very large packets
2893 if ($MAXFRAGSIZE < length $pkt and $self->{can_lzf}) {
2894 $self->send_packet ("frag $_") for unpack "(a$MAXFRAGSIZE)*", $pkt;
2895 $pkt = "frag";
2896 }
2897
2898 $self->send_packet ($pkt);
2790} 2899}
2791 2900
2792=item $client->send_msg ($channel, $msg, $color, [extra...]) 2901=item $client->send_msg ($channel, $msg, $color, [extra...])
2793 2902
2794Send a drawinfo or msg packet to the client, formatting the msg for the 2903Send a drawinfo or msg packet to the client, formatting the msg for the
… …
2946 my $pkt = "msg " 3055 my $pkt = "msg "
2947 . $self->{json_coder}->encode ( 3056 . $self->{json_coder}->encode (
2948 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra] 3057 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]
2949 ); 3058 );
2950 3059
2951 # try lzf for large packets
2952 $pkt = "lzf " . Compress::LZF::compress $pkt
2953 if 1024 <= length $pkt and $self->{can_lzf};
2954
2955 # split very large packets
2956 if (8192 < length $pkt and $self->{can_lzf}) {
2957 $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt;
2958 $pkt = "frag";
2959 }
2960
2961 $self->send_packet ($pkt); 3060 $self->send_big_packet ($pkt);
2962} 3061}
2963 3062
2964=item $client->ext_msg ($type, @msg) 3063=item $client->ext_msg ($type, @msg)
2965 3064
2966Sends an ext event to the client. 3065Sends an ext event to the client.
… …
2969 3068
2970sub cf::client::ext_msg($$@) { 3069sub cf::client::ext_msg($$@) {
2971 my ($self, $type, @msg) = @_; 3070 my ($self, $type, @msg) = @_;
2972 3071
2973 if ($self->extcmd == 2) { 3072 if ($self->extcmd == 2) {
2974 $self->send_packet ("ext " . $self->{json_coder}->encode ([$type, @msg])); 3073 $self->send_big_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
2975 } elsif ($self->extcmd == 1) { # TODO: remove 3074 } elsif ($self->extcmd == 1) { # TODO: remove
2976 push @msg, msgtype => "event_$type"; 3075 push @msg, msgtype => "event_$type";
2977 $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg})); 3076 $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
2978 } 3077 }
2979} 3078}
2980 3079
2981=item $client->ext_reply ($msgid, @msg) 3080=item $client->ext_reply ($msgid, @msg)
2982 3081
… …
2986 3085
2987sub cf::client::ext_reply($$@) { 3086sub cf::client::ext_reply($$@) {
2988 my ($self, $id, @msg) = @_; 3087 my ($self, $id, @msg) = @_;
2989 3088
2990 if ($self->extcmd == 2) { 3089 if ($self->extcmd == 2) {
2991 $self->send_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg])); 3090 $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
2992 } elsif ($self->extcmd == 1) { 3091 } elsif ($self->extcmd == 1) {
2993 #TODO: version 1, remove 3092 #TODO: version 1, remove
2994 unshift @msg, msgtype => "reply", msgid => $id; 3093 unshift @msg, msgtype => "reply", msgid => $id;
2995 $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg})); 3094 $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
2996 } 3095 }
2997} 3096}
2998 3097
2999=item $success = $client->query ($flags, "text", \&cb) 3098=item $success = $client->query ($flags, "text", \&cb)
3000 3099
… …
3101 3200
3102 $coro 3201 $coro
3103} 3202}
3104 3203
3105cf::client->attach ( 3204cf::client->attach (
3106 on_destroy => sub { 3205 on_client_destroy => sub {
3107 my ($ns) = @_; 3206 my ($ns) = @_;
3108 3207
3109 $_->cancel for values %{ (delete $ns->{_coro}) || {} }; 3208 $_->cancel for values %{ (delete $ns->{_coro}) || {} };
3110 }, 3209 },
3111); 3210);
… …
3127our $safe_hole = new Safe::Hole; 3226our $safe_hole = new Safe::Hole;
3128 3227
3129$SIG{FPE} = 'IGNORE'; 3228$SIG{FPE} = 'IGNORE';
3130 3229
3131$safe->permit_only (Opcode::opset qw( 3230$safe->permit_only (Opcode::opset qw(
3132 :base_core :base_mem :base_orig :base_math 3231 :base_core :base_mem :base_orig :base_math :base_loop
3133 grepstart grepwhile mapstart mapwhile 3232 grepstart grepwhile mapstart mapwhile
3134 sort time 3233 sort time
3135)); 3234));
3136 3235
3137# here we export the classes and methods available to script code 3236# here we export the classes and methods available to script code
… …
3189 $qcode =~ s/"/‟/g; # not allowed in #line filenames 3288 $qcode =~ s/"/‟/g; # not allowed in #line filenames
3190 $qcode =~ s/\n/\\n/g; 3289 $qcode =~ s/\n/\\n/g;
3191 3290
3192 %vars = (_dummy => 0) unless %vars; 3291 %vars = (_dummy => 0) unless %vars;
3193 3292
3293 my @res;
3194 local $_; 3294 local $_;
3195 local @safe::cf::_safe_eval_args = values %vars;
3196 3295
3197 my $eval = 3296 my $eval =
3198 "do {\n" 3297 "do {\n"
3199 . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n" 3298 . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n"
3200 . "#line 0 \"{$qcode}\"\n" 3299 . "#line 0 \"{$qcode}\"\n"
3201 . $code 3300 . $code
3202 . "\n}" 3301 . "\n}"
3203 ; 3302 ;
3204 3303
3304 if ($CFG{safe_eval}) {
3205 sub_generation_inc; 3305 sub_generation_inc;
3306 local @safe::cf::_safe_eval_args = values %vars;
3206 my @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval); 3307 @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval);
3207 sub_generation_inc; 3308 sub_generation_inc;
3309 } else {
3310 local @cf::_safe_eval_args = values %vars;
3311 @res = wantarray ? eval eval : scalar eval $eval;
3312 }
3208 3313
3209 if ($@) { 3314 if ($@) {
3210 warn "$@"; 3315 warn "$@";
3211 warn "while executing safe code '$code'\n"; 3316 warn "while executing safe code '$code'\n";
3212 warn "with arguments " . (join " ", %vars) . "\n"; 3317 warn "with arguments " . (join " ", %vars) . "\n";
… …
3231=cut 3336=cut
3232 3337
3233sub register_script_function { 3338sub register_script_function {
3234 my ($fun, $cb) = @_; 3339 my ($fun, $cb) = @_;
3235 3340
3236 no strict 'refs'; 3341 $fun = "safe::$fun" if $CFG{safe_eval};
3237 *{"safe::$fun"} = $safe_hole->wrap ($cb); 3342 *$fun = $safe_hole->wrap ($cb);
3238} 3343}
3239 3344
3240=back 3345=back
3241 3346
3242=cut 3347=cut
… …
3263 3368
3264 $facedata->{version} == 2 3369 $facedata->{version} == 2
3265 or cf::cleanup "$path: version mismatch, cannot proceed."; 3370 or cf::cleanup "$path: version mismatch, cannot proceed.";
3266 3371
3267 # patch in the exptable 3372 # patch in the exptable
3373 my $exp_table = $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]);
3268 $facedata->{resource}{"res/exp_table"} = { 3374 $facedata->{resource}{"res/exp_table"} = {
3269 type => FT_RSRC, 3375 type => FT_RSRC,
3270 data => $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]), 3376 data => $exp_table,
3377 hash => (Digest::MD5::md5 $exp_table),
3271 }; 3378 };
3272 cf::cede_to_tick; 3379 cf::cede_to_tick;
3273 3380
3274 { 3381 {
3275 my $faces = $facedata->{faceinfo}; 3382 my $faces = $facedata->{faceinfo};
… …
3277 while (my ($face, $info) = each %$faces) { 3384 while (my ($face, $info) = each %$faces) {
3278 my $idx = (cf::face::find $face) || cf::face::alloc $face; 3385 my $idx = (cf::face::find $face) || cf::face::alloc $face;
3279 3386
3280 cf::face::set_visibility $idx, $info->{visibility}; 3387 cf::face::set_visibility $idx, $info->{visibility};
3281 cf::face::set_magicmap $idx, $info->{magicmap}; 3388 cf::face::set_magicmap $idx, $info->{magicmap};
3282 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32}; 3389 cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32};
3283 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64}; 3390 cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64};
3284 3391
3285 cf::cede_to_tick; 3392 cf::cede_to_tick;
3286 } 3393 }
3287 3394
3288 while (my ($face, $info) = each %$faces) { 3395 while (my ($face, $info) = each %$faces) {
… …
3312 3419
3313 cf::anim::invalidate_all; # d'oh 3420 cf::anim::invalidate_all; # d'oh
3314 } 3421 }
3315 3422
3316 { 3423 {
3317 # TODO: for gcfclient pleasure, we should give resources
3318 # that gcfclient doesn't grok a >10000 face index.
3319 my $res = $facedata->{resource}; 3424 my $res = $facedata->{resource};
3320 3425
3321 while (my ($name, $info) = each %$res) { 3426 while (my ($name, $info) = each %$res) {
3322 if (defined $info->{type}) { 3427 if (defined $info->{type}) {
3323 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3428 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3324 my $data;
3325 3429
3326 if ($info->{type} & 1) { 3430 cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
3327 # prepend meta info
3328
3329 my $meta = $enc->encode ({
3330 name => $name,
3331 %{ $info->{meta} || {} },
3332 });
3333
3334 $data = pack "(w/a*)*", $meta, $info->{data};
3335 } else {
3336 $data = $info->{data};
3337 }
3338
3339 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
3340 cf::face::set_type $idx, $info->{type}; 3431 cf::face::set_type $idx, $info->{type};
3341 } else { 3432 } else {
3342 $RESOURCE{$name} = $info; 3433 $RESOURCE{$name} = $info;
3343 } 3434 }
3344 3435
… …
3436 or return; 3527 or return;
3437 3528
3438 local $/; 3529 local $/;
3439 *CFG = YAML::XS::Load scalar <$fh>; 3530 *CFG = YAML::XS::Load scalar <$fh>;
3440 3531
3441 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3532 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_104_115", 49, 38];
3442 3533
3443 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3534 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3444 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3535 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
3445 3536
3446 if (exists $CFG{mlockall}) { 3537 if (exists $CFG{mlockall}) {
… …
3487 3578
3488 LOG llevInfo, "Welcome to Deliantra, v" . VERSION; 3579 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3489 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team."; 3580 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3490 LOG llevInfo, "Copyright (C) 1994 Mark Wedel."; 3581 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3491 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen."; 3582 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3492
3493 cf::init_experience;
3494 cf::init_anim;
3495 cf::init_attackmess;
3496 cf::init_dynamic;
3497 3583
3498 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3584 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3499 3585
3500 # we must not ever block the main coroutine 3586 # we must not ever block the main coroutine
3501 local $Coro::idle = sub { 3587 local $Coro::idle = sub {
… …
3507 }; 3593 };
3508 3594
3509 evthread_start IO::AIO::poll_fileno; 3595 evthread_start IO::AIO::poll_fileno;
3510 3596
3511 cf::sync_job { 3597 cf::sync_job {
3598 cf::init_experience;
3599 cf::init_anim;
3600 cf::init_attackmess;
3601 cf::init_dynamic;
3602
3603 cf::load_settings;
3604 cf::load_materials;
3605
3512 reload_resources; 3606 reload_resources;
3513 reload_config; 3607 reload_config;
3514 db_init; 3608 db_init;
3515 3609
3516 cf::load_settings;
3517 cf::load_materials;
3518 cf::init_uuid; 3610 cf::init_uuid;
3519 cf::init_signals; 3611 cf::init_signals;
3520 cf::init_commands;
3521 cf::init_skills; 3612 cf::init_skills;
3522 3613
3523 cf::init_beforeplay; 3614 cf::init_beforeplay;
3524 3615
3525 atomic; 3616 atomic;
… …
3532 use POSIX (); 3623 use POSIX ();
3533 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD}; 3624 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD};
3534 3625
3535 (pop @POST_INIT)->(0) while @POST_INIT; 3626 (pop @POST_INIT)->(0) while @POST_INIT;
3536 }; 3627 };
3628
3629 cf::object::thawer::errors_are_fatal 0;
3630 warn "parse errors in files are no longer fatal from this point on.\n";
3537 3631
3538 main_loop; 3632 main_loop;
3539} 3633}
3540 3634
3541############################################################################# 3635#############################################################################
… …
3543 3637
3544# install some emergency cleanup handlers 3638# install some emergency cleanup handlers
3545BEGIN { 3639BEGIN {
3546 our %SIGWATCHER = (); 3640 our %SIGWATCHER = ();
3547 for my $signal (qw(INT HUP TERM)) { 3641 for my $signal (qw(INT HUP TERM)) {
3548 $SIGWATCHER{$signal} = EV::signal $signal, sub { 3642 $SIGWATCHER{$signal} = AE::signal $signal, sub {
3549 cf::cleanup "SIG$signal"; 3643 cf::cleanup "SIG$signal";
3550 }; 3644 };
3551 } 3645 }
3552} 3646}
3553 3647
3554sub write_runtime_sync { 3648sub write_runtime_sync {
3649 my $t0 = AE::time;
3650
3555 # first touch the runtime file to show we are still running: 3651 # first touch the runtime file to show we are still running:
3556 # the fsync below can take a very very long time. 3652 # the fsync below can take a very very long time.
3557 3653
3558 IO::AIO::aio_utime $RUNTIMEFILE, undef, undef; 3654 IO::AIO::aio_utime $RUNTIMEFILE, undef, undef;
3559 3655
3560 my $guard = cf::lock_acquire "write_runtime"; 3656 my $guard = cf::lock_acquire "write_runtime";
3561 3657
3562 my $fh = aio_open "$RUNTIMEFILE~", O_WRONLY | O_CREAT, 0644 3658 my $fh = aio_open "$RUNTIMEFILE~", O_WRONLY | O_CREAT | O_TRUNC, 0644
3563 or return; 3659 or return;
3564 3660
3565 my $value = $cf::RUNTIME + 90 + 10; 3661 my $value = $cf::RUNTIME + 90 + 10;
3566 # 10 is the runtime save interval, for a monotonic clock 3662 # 10 is the runtime save interval, for a monotonic clock
3567 # 60 allows for the watchdog to kill the server. 3663 # 60 allows for the watchdog to kill the server.
… …
3580 or return; 3676 or return;
3581 3677
3582 aio_rename "$RUNTIMEFILE~", $RUNTIMEFILE 3678 aio_rename "$RUNTIMEFILE~", $RUNTIMEFILE
3583 and return; 3679 and return;
3584 3680
3585 warn "runtime file written.\n"; 3681 warn sprintf "runtime file written (%gs).\n", AE::time - $t0;
3586 3682
3587 1 3683 1
3588} 3684}
3589 3685
3590our $uuid_lock; 3686our $uuid_lock;
… …
3716 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH}; 3812 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
3717 for my $name (keys %$leaf_symtab) { 3813 for my $name (keys %$leaf_symtab) {
3718 _gv_clear *{"$pkg$name"}; 3814 _gv_clear *{"$pkg$name"};
3719# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"}; 3815# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"};
3720 } 3816 }
3721 warn "cleared package $pkg\n";#d#
3722} 3817}
3723 3818
3724sub do_reload_perl() { 3819sub do_reload_perl() {
3725 # can/must only be called in main 3820 # can/must only be called in main
3726 if ($Coro::current != $Coro::main) { 3821 if (in_main) {
3727 warn "can only reload from main coroutine"; 3822 warn "can only reload from main coroutine";
3728 return; 3823 return;
3729 } 3824 }
3730 3825
3731 return if $RELOAD++; 3826 return if $RELOAD++;
3732 3827
3733 my $t1 = EV::time; 3828 my $t1 = AE::time;
3734 3829
3735 while ($RELOAD) { 3830 while ($RELOAD) {
3736 warn "reloading..."; 3831 warn "reloading...";
3737 3832
3738 warn "entering sync_job"; 3833 warn "entering sync_job";
… …
3841 3936
3842 warn "reloaded"; 3937 warn "reloaded";
3843 --$RELOAD; 3938 --$RELOAD;
3844 } 3939 }
3845 3940
3846 $t1 = EV::time - $t1; 3941 $t1 = AE::time - $t1;
3847 warn "reload completed in ${t1}s\n"; 3942 warn "reload completed in ${t1}s\n";
3848}; 3943};
3849 3944
3850our $RELOAD_WATCHER; # used only during reload 3945our $RELOAD_WATCHER; # used only during reload
3851 3946
… …
3854 # coro crashes during coro_state_free->destroy here. 3949 # coro crashes during coro_state_free->destroy here.
3855 3950
3856 $RELOAD_WATCHER ||= cf::async { 3951 $RELOAD_WATCHER ||= cf::async {
3857 Coro::AIO::aio_wait cache_extensions; 3952 Coro::AIO::aio_wait cache_extensions;
3858 3953
3859 $RELOAD_WATCHER = EV::timer $TICK * 1.5, 0, sub { 3954 $RELOAD_WATCHER = AE::timer $TICK * 1.5, 0, sub {
3860 do_reload_perl; 3955 do_reload_perl;
3861 undef $RELOAD_WATCHER; 3956 undef $RELOAD_WATCHER;
3862 }; 3957 };
3863 }; 3958 };
3864} 3959}
… …
3881 3976
3882our @WAIT_FOR_TICK; 3977our @WAIT_FOR_TICK;
3883our @WAIT_FOR_TICK_BEGIN; 3978our @WAIT_FOR_TICK_BEGIN;
3884 3979
3885sub wait_for_tick { 3980sub wait_for_tick {
3886 return if tick_inhibit || $Coro::current == $Coro::main; 3981 return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
3887 3982
3888 my $signal = new Coro::Signal; 3983 my $signal = new Coro::Signal;
3889 push @WAIT_FOR_TICK, $signal; 3984 push @WAIT_FOR_TICK, $signal;
3890 $signal->wait; 3985 $signal->wait;
3891} 3986}
3892 3987
3893sub wait_for_tick_begin { 3988sub wait_for_tick_begin {
3894 return if tick_inhibit || $Coro::current == $Coro::main; 3989 return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
3895 3990
3896 my $signal = new Coro::Signal; 3991 my $signal = new Coro::Signal;
3897 push @WAIT_FOR_TICK_BEGIN, $signal; 3992 push @WAIT_FOR_TICK_BEGIN, $signal;
3898 $signal->wait; 3993 $signal->wait;
3899} 3994}
… …
3904 unless ++$bug_warning > 10; 3999 unless ++$bug_warning > 10;
3905 return; 4000 return;
3906 } 4001 }
3907 4002
3908 cf::server_tick; # one server iteration 4003 cf::server_tick; # one server iteration
4004
4005 #for(1..3e6){} AE::now_update; $NOW=AE::now; # generate load #d#
3909 4006
3910 if ($NOW >= $NEXT_RUNTIME_WRITE) { 4007 if ($NOW >= $NEXT_RUNTIME_WRITE) {
3911 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.; 4008 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
3912 Coro::async_pool { 4009 Coro::async_pool {
3913 $Coro::current->{desc} = "runtime saver"; 4010 $Coro::current->{desc} = "runtime saver";
… …
3936} 4033}
3937 4034
3938{ 4035{
3939 # configure BDB 4036 # configure BDB
3940 4037
3941 BDB::min_parallel 8; 4038 BDB::min_parallel 16;
3942 BDB::max_poll_reqs $TICK * 0.1; 4039 BDB::max_poll_reqs $TICK * 0.1;
3943 $AnyEvent::BDB::WATCHER->priority (1); 4040 $AnyEvent::BDB::WATCHER->priority (1);
3944 4041
3945 unless ($DB_ENV) { 4042 unless ($DB_ENV) {
3946 $DB_ENV = BDB::db_env_create; 4043 $DB_ENV = BDB::db_env_create;

Diff Legend

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