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.407 by root, Sun Jan 13 09:53:53 2008 UTC vs.
Revision 1.416 by root, Fri Apr 11 13:59:06 2008 UTC

1#
2# This file is part of Deliantra, the Roguelike Realtime MMORPG.
3#
4# Copyright (©) 2006,2007,2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
5#
6# Deliantra is free software: you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation, either version 3 of the License, or
9# (at your option) any later version.
10#
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with this program. If not, see <http://www.gnu.org/licenses/>.
18#
19# The authors can be reached via e-mail to <support@deliantra.net>
20#
21
1package cf; 22package cf;
2 23
3use utf8; 24use utf8;
4use strict; 25use strict;
5 26
6use Symbol; 27use Symbol;
7use List::Util; 28use List::Util;
8use Socket; 29use Socket;
9use EV 1.86; 30use EV 3.2;
10use Opcode; 31use Opcode;
11use Safe; 32use Safe;
12use Safe::Hole; 33use Safe::Hole;
13use Storable (); 34use Storable ();
14 35
15use Coro 4.32 (); 36use Coro 4.50 ();
16use Coro::State; 37use Coro::State;
17use Coro::Handle; 38use Coro::Handle;
18use Coro::EV; 39use Coro::EV;
19use Coro::Timer; 40use Coro::Timer;
20use Coro::Signal; 41use Coro::Signal;
… …
27use JSON::XS 2.01 (); 48use JSON::XS 2.01 ();
28use BDB (); 49use BDB ();
29use Data::Dumper; 50use Data::Dumper;
30use Digest::MD5; 51use Digest::MD5;
31use Fcntl; 52use Fcntl;
32use YAML::Syck (); 53use YAML ();
33use IO::AIO 2.51 (); 54use IO::AIO 2.51 ();
34use Time::HiRes; 55use Time::HiRes;
35use Compress::LZF; 56use Compress::LZF;
36use Digest::MD5 (); 57use Digest::MD5 ();
37 58
38# configure various modules to our taste 59# configure various modules to our taste
39# 60#
40$Storable::canonical = 1; # reduce rsync transfers 61$Storable::canonical = 1; # reduce rsync transfers
41Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator 62Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator
42Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later 63Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later
43
44# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
45$YAML::Syck::ImplicitUnicode = 1;
46 64
47$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority 65$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
48 66
49sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 67sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
50 68
… …
72our $RANDOMDIR = "$LOCALDIR/random"; 90our $RANDOMDIR = "$LOCALDIR/random";
73our $BDBDIR = "$LOCALDIR/db"; 91our $BDBDIR = "$LOCALDIR/db";
74our %RESOURCE; 92our %RESOURCE;
75 93
76our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 94our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
77our $TICK_WATCHER;
78our $AIO_POLL_WATCHER; 95our $AIO_POLL_WATCHER;
79our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 96our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
80our $NEXT_TICK; 97our $NEXT_TICK;
81our $USE_FSYNC = 1; # use fsync to write maps - default off 98our $USE_FSYNC = 1; # use fsync to write maps - default off
82 99
… …
99# used to convert map paths into valid unix filenames by replacing / by ∕ 116# used to convert map paths into valid unix filenames by replacing / by ∕
100our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons 117our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
101 118
102our $LOAD; # a number between 0 (idle) and 1 (too many objects) 119our $LOAD; # a number between 0 (idle) and 1 (too many objects)
103our $LOADAVG; # same thing, but with alpha-smoothing 120our $LOADAVG; # same thing, but with alpha-smoothing
121our $JITTER; # average jitter
104our $tick_start; # for load detecting purposes 122our $TICK_START; # for load detecting purposes
105 123
106binmode STDOUT; 124binmode STDOUT;
107binmode STDERR; 125binmode STDERR;
108 126
109# read virtual server time, if available 127# read virtual server time, if available
… …
195 LOG llevError, $msg; 213 LOG llevError, $msg;
196 }; 214 };
197} 215}
198 216
199$Coro::State::DIEHOOK = sub { 217$Coro::State::DIEHOOK = sub {
218 return unless $^S eq 0; # "eq", not "=="
219
220 if ($Coro::current == $Coro::main) {#d#
221 warn "DIEHOOK called in main context, Coro bug?\n";#d#
222 return;#d#
223 }#d#
224
225 # kill coroutine otherwise
200 warn Carp::longmess $_[0]; 226 warn Carp::longmess $_[0];
201 Coro::terminate; 227 Coro::terminate
202}; 228};
229
230$SIG{__DIE__} = sub { }; #d#?
203 231
204@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 232@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
205@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 233@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
206@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable'; 234@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
207@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable'; 235@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable';
… …
332 360
333 ! ! $LOCK{$key} 361 ! ! $LOCK{$key}
334} 362}
335 363
336sub freeze_mainloop { 364sub freeze_mainloop {
337 return unless $TICK_WATCHER->is_active; 365 tick_inhibit_inc;
338 366
339 my $guard = Coro::guard { 367 Coro::guard \&tick_inhibit_dec;
340 $TICK_WATCHER->start;
341 };
342 $TICK_WATCHER->stop;
343 $guard
344} 368}
345 369
346=item cf::periodic $interval, $cb 370=item cf::periodic $interval, $cb
347 371
348Like EV::periodic, but randomly selects a starting point so that the actions 372Like EV::periodic, but randomly selects a starting point so that the actions
… …
449 # this is the main coro, too bad, we have to block 473 # this is the main coro, too bad, we have to block
450 # till the operation succeeds, freezing the server :/ 474 # till the operation succeeds, freezing the server :/
451 475
452 LOG llevError, Carp::longmess "sync job";#d# 476 LOG llevError, Carp::longmess "sync job";#d#
453 477
454 # TODO: use suspend/resume instead
455 # (but this is cancel-safe)
456 my $freeze_guard = freeze_mainloop; 478 my $freeze_guard = freeze_mainloop;
457 479
458 my $busy = 1; 480 my $busy = 1;
459 my @res; 481 my @res;
460 482
… …
471 } else { 493 } else {
472 EV::loop EV::LOOP_ONESHOT; 494 EV::loop EV::LOOP_ONESHOT;
473 } 495 }
474 } 496 }
475 497
476 $time = EV::time - $time; 498 my $time = EV::time - $time;
477 499
478 LOG llevError | logBacktrace, Carp::longmess "long sync job"
479 if $time > $TICK * 0.5 && $TICK_WATCHER->is_active;
480
481 $tick_start += $time; # do not account sync jobs to server load 500 $TICK_START += $time; # do not account sync jobs to server load
482 501
483 wantarray ? @res : $res[0] 502 wantarray ? @res : $res[0]
484 } else { 503 } else {
485 # we are in another coroutine, how wonderful, everything just works 504 # we are in another coroutine, how wonderful, everything just works
486 505
… …
528 reset_signals; 547 reset_signals;
529 &$cb 548 &$cb
530 }, @args; 549 }, @args;
531 550
532 wantarray ? @res : $res[-1] 551 wantarray ? @res : $res[-1]
552}
553
554=item $coin = coin_from_name $name
555
556=cut
557
558our %coin_alias = (
559 "silver" => "silvercoin",
560 "silvercoin" => "silvercoin",
561 "silvercoins" => "silvercoin",
562 "gold" => "goldcoin",
563 "goldcoin" => "goldcoin",
564 "goldcoins" => "goldcoin",
565 "platinum" => "platinacoin",
566 "platinumcoin" => "platinacoin",
567 "platinumcoins" => "platinacoin",
568 "platina" => "platinacoin",
569 "platinacoin" => "platinacoin",
570 "platinacoins" => "platinacoin",
571 "royalty" => "royalty",
572 "royalties" => "royalty",
573);
574
575sub coin_from_name($) {
576 $coin_alias{$_[0]}
577 ? cf::arch::find $coin_alias{$_[0]}
578 : undef
533} 579}
534 580
535=item $value = cf::db_get $family => $key 581=item $value = cf::db_get $family => $key
536 582
537Returns a single value from the environment database. 583Returns a single value from the environment database.
… …
1309 my $msg = $@ ? "$v->{path}: $@\n" 1355 my $msg = $@ ? "$v->{path}: $@\n"
1310 : "$v->{base}: extension inactive.\n"; 1356 : "$v->{base}: extension inactive.\n";
1311 1357
1312 if (exists $v->{meta}{mandatory}) { 1358 if (exists $v->{meta}{mandatory}) {
1313 warn $msg; 1359 warn $msg;
1314 warn "mandatory extension failed to load, exiting.\n"; 1360 cf::cleanup "mandatory extension failed to load, exiting.";
1315 exit 1;
1316 } 1361 }
1317 1362
1318 warn $msg; 1363 warn $msg;
1319 } 1364 }
1320 1365
… …
2331 ? normalise $_ 2376 ? normalise $_
2332 : () 2377 : ()
2333 } @{ aio_readdir $UNIQUEDIR or [] } 2378 } @{ aio_readdir $UNIQUEDIR or [] }
2334 ] 2379 ]
2335} 2380}
2336
2337package cf;
2338 2381
2339=back 2382=back
2340 2383
2341=head3 cf::object 2384=head3 cf::object
2342 2385
… …
3313sub reload_config { 3356sub reload_config {
3314 open my $fh, "<:utf8", "$CONFDIR/config" 3357 open my $fh, "<:utf8", "$CONFDIR/config"
3315 or return; 3358 or return;
3316 3359
3317 local $/; 3360 local $/;
3318 *CFG = YAML::Syck::Load <$fh>; 3361 *CFG = YAML::Load <$fh>;
3319 3362
3320 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3363 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
3321 3364
3322 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3365 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3323 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3366 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
… …
3343 3386
3344 reload_config; 3387 reload_config;
3345 db_init; 3388 db_init;
3346 load_extensions; 3389 load_extensions;
3347 3390
3348 $TICK_WATCHER->start;
3349 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3391 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3392 evthread_start IO::AIO::poll_fileno;
3350 EV::loop; 3393 EV::loop;
3351} 3394}
3352 3395
3353############################################################################# 3396#############################################################################
3354# initialisation and cleanup 3397# initialisation and cleanup
… …
3397 and return; 3440 and return;
3398 3441
3399 warn "runtime file written.\n"; 3442 warn "runtime file written.\n";
3400 3443
3401 1 3444 1
3445}
3446
3447our $uuid_lock;
3448our $uuid_skip;
3449
3450sub write_uuid_sync($) {
3451 $uuid_skip ||= $_[0];
3452
3453 return if $uuid_lock;
3454 local $uuid_lock = 1;
3455
3456 my $uuid = "$LOCALDIR/uuid";
3457
3458 my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644
3459 or return;
3460
3461 my $value = uuid_str $uuid_skip + uuid_seq uuid_cur;
3462 $uuid_skip = 0;
3463
3464 (aio_write $fh, 0, (length $value), $value, 0) <= 0
3465 and return;
3466
3467 # always fsync - this file is important
3468 aio_fsync $fh
3469 and return;
3470
3471 close $fh
3472 or return;
3473
3474 aio_rename "$uuid~", $uuid
3475 and return;
3476
3477 warn "uuid file written ($value).\n";
3478
3479 1
3480
3481}
3482
3483sub write_uuid($$) {
3484 my ($skip, $sync) = @_;
3485
3486 $sync ? write_uuid_sync $skip
3487 : async { write_uuid_sync $skip };
3402} 3488}
3403 3489
3404sub emergency_save() { 3490sub emergency_save() {
3405 my $freeze_guard = cf::freeze_mainloop; 3491 my $freeze_guard = cf::freeze_mainloop;
3406 3492
… …
3428 warn "end emergency map save\n"; 3514 warn "end emergency map save\n";
3429 3515
3430 warn "begin emergency database checkpoint\n"; 3516 warn "begin emergency database checkpoint\n";
3431 BDB::db_env_txn_checkpoint $DB_ENV; 3517 BDB::db_env_txn_checkpoint $DB_ENV;
3432 warn "end emergency database checkpoint\n"; 3518 warn "end emergency database checkpoint\n";
3519
3520 warn "begin write uuid\n";
3521 write_uuid_sync 1;
3522 warn "end write uuid\n";
3433 }; 3523 };
3434 3524
3435 warn "leave emergency perl save\n"; 3525 warn "leave emergency perl save\n";
3436} 3526}
3437 3527
… …
3551 warn "leaving sync_job"; 3641 warn "leaving sync_job";
3552 3642
3553 1 3643 1
3554 } or do { 3644 } or do {
3555 warn $@; 3645 warn $@;
3556 warn "error while reloading, exiting."; 3646 cf::cleanup "error while reloading, exiting.";
3557 exit 1;
3558 }; 3647 };
3559 3648
3560 warn "reloaded"; 3649 warn "reloaded";
3561}; 3650};
3562 3651
… …
3565sub reload_perl() { 3654sub reload_perl() {
3566 # doing reload synchronously and two reloads happen back-to-back, 3655 # doing reload synchronously and two reloads happen back-to-back,
3567 # coro crashes during coro_state_free->destroy here. 3656 # coro crashes during coro_state_free->destroy here.
3568 3657
3569 $RELOAD_WATCHER ||= EV::timer 0, 0, sub { 3658 $RELOAD_WATCHER ||= EV::timer 0, 0, sub {
3659 do_reload_perl;
3570 undef $RELOAD_WATCHER; 3660 undef $RELOAD_WATCHER;
3571 do_reload_perl;
3572 }; 3661 };
3573} 3662}
3574 3663
3575register_command "reload" => sub { 3664register_command "reload" => sub {
3576 my ($who, $arg) = @_; 3665 my ($who, $arg) = @_;
… …
3590 3679
3591our @WAIT_FOR_TICK; 3680our @WAIT_FOR_TICK;
3592our @WAIT_FOR_TICK_BEGIN; 3681our @WAIT_FOR_TICK_BEGIN;
3593 3682
3594sub wait_for_tick { 3683sub wait_for_tick {
3595 return unless $TICK_WATCHER->is_active; 3684 return if tick_inhibit;
3596 return if $Coro::current == $Coro::main; 3685 return if $Coro::current == $Coro::main;
3597 3686
3598 my $signal = new Coro::Signal; 3687 my $signal = new Coro::Signal;
3599 push @WAIT_FOR_TICK, $signal; 3688 push @WAIT_FOR_TICK, $signal;
3600 $signal->wait; 3689 $signal->wait;
3601} 3690}
3602 3691
3603sub wait_for_tick_begin { 3692sub wait_for_tick_begin {
3604 return unless $TICK_WATCHER->is_active; 3693 return if tick_inhibit;
3605 return if $Coro::current == $Coro::main; 3694 return if $Coro::current == $Coro::main;
3606 3695
3607 my $signal = new Coro::Signal; 3696 my $signal = new Coro::Signal;
3608 push @WAIT_FOR_TICK_BEGIN, $signal; 3697 push @WAIT_FOR_TICK_BEGIN, $signal;
3609 $signal->wait; 3698 $signal->wait;
3610} 3699}
3611 3700
3612$TICK_WATCHER = EV::periodic_ns 0, $TICK, 0, sub { 3701sub tick {
3613 if ($Coro::current != $Coro::main) { 3702 if ($Coro::current != $Coro::main) {
3614 Carp::cluck "major BUG: server tick called outside of main coro, skipping it" 3703 Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
3615 unless ++$bug_warning > 10; 3704 unless ++$bug_warning > 10;
3616 return; 3705 return;
3617 } 3706 }
3618 3707
3619 $NOW = $tick_start = EV::now;
3620
3621 cf::server_tick; # one server iteration 3708 cf::server_tick; # one server iteration
3622
3623 $RUNTIME += $TICK;
3624 $NEXT_TICK = $_[0]->at;
3625 3709
3626 if ($NOW >= $NEXT_RUNTIME_WRITE) { 3710 if ($NOW >= $NEXT_RUNTIME_WRITE) {
3627 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.; 3711 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
3628 Coro::async_pool { 3712 Coro::async_pool {
3629 $Coro::current->{desc} = "runtime saver"; 3713 $Coro::current->{desc} = "runtime saver";
… …
3637 } 3721 }
3638 while (my $sig = shift @WAIT_FOR_TICK) { 3722 while (my $sig = shift @WAIT_FOR_TICK) {
3639 $sig->send; 3723 $sig->send;
3640 } 3724 }
3641 3725
3642 $LOAD = ($NOW - $tick_start) / $TICK; 3726 $LOAD = ($NOW - $TICK_START) / $TICK;
3643 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25; 3727 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
3644 3728
3645 _post_tick; 3729 if (0) {
3646}; 3730 if ($NEXT_TICK) {
3647$TICK_WATCHER->priority (EV::MAXPRI); 3731 my $jitter = $TICK_START - $NEXT_TICK;
3732 $JITTER = $JITTER * 0.75 + $jitter * 0.25;
3733 warn "jitter $JITTER\n";#d#
3734 }
3735 }
3736}
3648 3737
3649{ 3738{
3650 # configure BDB 3739 # configure BDB
3651 3740
3652 BDB::min_parallel 8; 3741 BDB::min_parallel 8;

Diff Legend

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