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.395 by root, Sat Nov 10 22:41:59 2007 UTC vs.
Revision 1.401 by root, Mon Dec 17 06:45:53 2007 UTC

… …
4use strict; 4use strict;
5 5
6use Symbol; 6use Symbol;
7use List::Util; 7use List::Util;
8use Socket; 8use Socket;
9use Event; 9use EV;
10use Opcode; 10use Opcode;
11use Safe; 11use Safe;
12use Safe::Hole; 12use Safe::Hole;
13use Storable (); 13use Storable ();
14 14
15use Coro 4.1 (); 15use Coro 4.32 ();
16use Coro::State; 16use Coro::State;
17use Coro::Handle; 17use Coro::Handle;
18use Coro::Event; 18use Coro::EV;
19use Coro::Timer; 19use Coro::Timer;
20use Coro::Signal; 20use Coro::Signal;
21use Coro::Semaphore; 21use Coro::Semaphore;
22use Coro::AIO; 22use Coro::AIO;
23use Coro::BDB;
23use Coro::Storable; 24use Coro::Storable;
24use Coro::Util (); 25use Coro::Util ();
25 26
26use JSON::XS (); 27use JSON::XS 2.01 ();
27use BDB (); 28use BDB ();
28use Data::Dumper; 29use Data::Dumper;
29use Digest::MD5; 30use Digest::MD5;
30use Fcntl; 31use Fcntl;
31use YAML::Syck (); 32use YAML::Syck ();
… …
37# configure various modules to our taste 38# configure various modules to our taste
38# 39#
39$Storable::canonical = 1; # reduce rsync transfers 40$Storable::canonical = 1; # reduce rsync transfers
40Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator 41Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator
41Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later 42Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later
42
43$Event::Eval = 1; # no idea why this is required, but it is
44 43
45# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode? 44# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
46$YAML::Syck::ImplicitUnicode = 1; 45$YAML::Syck::ImplicitUnicode = 1;
47 46
48$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority 47$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
… …
76our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 75our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
77our $TICK_WATCHER; 76our $TICK_WATCHER;
78our $AIO_POLL_WATCHER; 77our $AIO_POLL_WATCHER;
79our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 78our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
80our $NEXT_TICK; 79our $NEXT_TICK;
81our $NOW;
82our $USE_FSYNC = 1; # use fsync to write maps - default off 80our $USE_FSYNC = 1; # use fsync to write maps - default off
83 81
84our $BDB_POLL_WATCHER; 82our $BDB_POLL_WATCHER;
85our $BDB_DEADLOCK_WATCHER; 83our $BDB_DEADLOCK_WATCHER;
86our $BDB_CHECKPOINT_WATCHER; 84our $BDB_CHECKPOINT_WATCHER;
… …
89 87
90our %CFG; 88our %CFG;
91 89
92our $UPTIME; $UPTIME ||= time; 90our $UPTIME; $UPTIME ||= time;
93our $RUNTIME; 91our $RUNTIME;
92our $NOW;
94 93
95our (%PLAYER, %PLAYER_LOADING); # all users 94our (%PLAYER, %PLAYER_LOADING); # all users
96our (%MAP, %MAP_LOADING ); # all maps 95our (%MAP, %MAP_LOADING ); # all maps
97our $LINK_MAP; # the special {link} map, which is always available 96our $LINK_MAP; # the special {link} map, which is always available
98 97
… …
215)) { 214)) {
216 no strict 'refs'; 215 no strict 'refs';
217 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; 216 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
218} 217}
219 218
220$Event::DIED = sub { 219$EV::DIED = sub {
221 warn "error in event callback: @_"; 220 warn "error in event callback: @_";
222}; 221};
223 222
224############################################################################# 223#############################################################################
225 224
… …
248 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge; 247 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
249 $d 248 $d
250 } || "[unable to dump $_[0]: '$@']"; 249 } || "[unable to dump $_[0]: '$@']";
251} 250}
252 251
253=item $ref = cf::from_json $json 252=item $ref = cf::decode_json $json
254 253
255Converts a JSON string into the corresponding perl data structure. 254Converts a JSON string into the corresponding perl data structure.
256 255
257=item $json = cf::to_json $ref 256=item $json = cf::encode_json $ref
258 257
259Converts a perl data structure into its JSON representation. 258Converts a perl data structure into its JSON representation.
260 259
261=cut 260=cut
262 261
263our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max 262our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
264 263
265sub to_json ($) { $json_coder->encode ($_[0]) } 264sub encode_json($) { $json_coder->encode ($_[0]) }
266sub from_json ($) { $json_coder->decode ($_[0]) } 265sub decode_json($) { $json_coder->decode ($_[0]) }
267 266
268=item cf::lock_wait $string 267=item cf::lock_wait $string
269 268
270Wait until the given lock is available. See cf::lock_acquire. 269Wait until the given lock is available. See cf::lock_acquire.
271 270
… …
334 my $guard = Coro::guard { 333 my $guard = Coro::guard {
335 $TICK_WATCHER->start; 334 $TICK_WATCHER->start;
336 }; 335 };
337 $TICK_WATCHER->stop; 336 $TICK_WATCHER->stop;
338 $guard 337 $guard
338}
339
340=item cf::periodic $interval, $cb
341
342Like EV::periodic, but randomly selects a starting point so that the actions
343get spread over timer.
344
345=cut
346
347sub periodic($$) {
348 my ($interval, $cb) = @_;
349
350 my $start = rand List::Util::min 180, $interval;
351
352 EV::periodic $start, $interval, 0, $cb
339} 353}
340 354
341=item cf::get_slot $time[, $priority[, $name]] 355=item cf::get_slot $time[, $priority[, $name]]
342 356
343Allocate $time seconds of blocking CPU time at priority C<$priority>: 357Allocate $time seconds of blocking CPU time at priority C<$priority>:
… …
422 436
423sub sync_job(&) { 437sub sync_job(&) {
424 my ($job) = @_; 438 my ($job) = @_;
425 439
426 if ($Coro::current == $Coro::main) { 440 if ($Coro::current == $Coro::main) {
427 my $time = Event::time; 441 my $time = EV::time;
428 442
429 # this is the main coro, too bad, we have to block 443 # this is the main coro, too bad, we have to block
430 # till the operation succeeds, freezing the server :/ 444 # till the operation succeeds, freezing the server :/
431 445
432 LOG llevError, Carp::longmess "sync job";#d# 446 LOG llevError, Carp::longmess "sync job";#d#
… …
447 461
448 while ($busy) { 462 while ($busy) {
449 if (Coro::nready) { 463 if (Coro::nready) {
450 Coro::cede_notself; 464 Coro::cede_notself;
451 } else { 465 } else {
452 Event::one_event; 466 EV::loop EV::LOOP_ONESHOT;
453 } 467 }
454 } 468 }
455 469
456 $time = Event::time - $time; 470 $time = EV::time - $time;
457 471
458 LOG llevError | logBacktrace, Carp::longmess "long sync job" 472 LOG llevError | logBacktrace, Carp::longmess "long sync job"
459 if $time > $TICK * 0.5 && $TICK_WATCHER->is_active; 473 if $time > $TICK * 0.5 && $TICK_WATCHER->is_active;
460 474
461 $tick_start += $time; # do not account sync jobs to server load 475 $tick_start += $time; # do not account sync jobs to server load
… …
491=item fork_call { }, $args 505=item fork_call { }, $args
492 506
493Executes the given code block with the given arguments in a seperate 507Executes the given code block with the given arguments in a seperate
494process, returning the results. Everything must be serialisable with 508process, returning the results. Everything must be serialisable with
495Coro::Storable. May, of course, block. Note that the executed sub may 509Coro::Storable. May, of course, block. Note that the executed sub may
496never block itself or use any form of Event handling. 510never block itself or use any form of event handling.
497 511
498=cut 512=cut
499 513
500sub fork_call(&@) { 514sub fork_call(&@) {
501 my ($cb, @args) = @_; 515 my ($cb, @args) = @_;
… …
1042cf::attachable->attach ( 1056cf::attachable->attach (
1043 prio => -1000000, 1057 prio => -1000000,
1044 on_instantiate => sub { 1058 on_instantiate => sub {
1045 my ($obj, $data) = @_; 1059 my ($obj, $data) = @_;
1046 1060
1047 $data = from_json $data; 1061 $data = decode_json $data;
1048 1062
1049 for (@$data) { 1063 for (@$data) {
1050 my ($name, $args) = @$_; 1064 my ($name, $args) = @$_;
1051 1065
1052 $obj->attach ($name, %{$args || {} }); 1066 $obj->attach ($name, %{$args || {} });
… …
2625 $rmp->{origin_y} = $exit->y; 2639 $rmp->{origin_y} = $exit->y;
2626 } 2640 }
2627 2641
2628 $rmp->{random_seed} ||= $exit->random_seed; 2642 $rmp->{random_seed} ||= $exit->random_seed;
2629 2643
2630 my $data = cf::to_json $rmp; 2644 my $data = cf::encode_json $rmp;
2631 my $md5 = Digest::MD5::md5_hex $data; 2645 my $md5 = Digest::MD5::md5_hex $data;
2632 my $meta = "$RANDOMDIR/$md5.meta"; 2646 my $meta = "$RANDOMDIR/$md5.meta";
2633 2647
2634 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) { 2648 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) {
2635 aio_write $fh, 0, (length $data), $data, 0; 2649 aio_write $fh, 0, (length $data), $data, 0;
… …
3306 # we must not ever block the main coroutine 3320 # we must not ever block the main coroutine
3307 local $Coro::idle = sub { 3321 local $Coro::idle = sub {
3308 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 3322 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
3309 (async { 3323 (async {
3310 $Coro::current->{desc} = "IDLE BUG HANDLER"; 3324 $Coro::current->{desc} = "IDLE BUG HANDLER";
3311 Event::one_event; 3325 EV::loop EV::LOOP_ONESHOT;
3312 })->prio (Coro::PRIO_MAX); 3326 })->prio (Coro::PRIO_MAX);
3313 }; 3327 };
3314 3328
3315 reload_config; 3329 reload_config;
3316 db_init; 3330 db_init;
3317 load_extensions; 3331 load_extensions;
3318 3332
3319 $TICK_WATCHER->start; 3333 $TICK_WATCHER->start;
3334 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3320 Event::loop; 3335 EV::loop;
3321} 3336}
3322 3337
3323############################################################################# 3338#############################################################################
3324# initialisation and cleanup 3339# initialisation and cleanup
3325 3340
3326# install some emergency cleanup handlers 3341# install some emergency cleanup handlers
3327BEGIN { 3342BEGIN {
3343 our %SIGWATCHER = ();
3328 for my $signal (qw(INT HUP TERM)) { 3344 for my $signal (qw(INT HUP TERM)) {
3329 Event->signal ( 3345 $SIGWATCHER{$signal} = EV::signal $signal, sub {
3330 reentrant => 0,
3331 data => WF_AUTOCANCEL,
3332 signal => $signal,
3333 prio => 0,
3334 cb => sub {
3335 cf::cleanup "SIG$signal"; 3346 cf::cleanup "SIG$signal";
3336 },
3337 ); 3347 };
3338 } 3348 }
3339} 3349}
3340 3350
3341sub write_runtime { 3351sub write_runtime {
3342 my $runtime = "$LOCALDIR/runtime"; 3352 my $runtime = "$LOCALDIR/runtime";
… …
3436 warn "syncing database to disk"; 3446 warn "syncing database to disk";
3437 BDB::db_env_txn_checkpoint $DB_ENV; 3447 BDB::db_env_txn_checkpoint $DB_ENV;
3438 3448
3439 # if anything goes wrong in here, we should simply crash as we already saved 3449 # if anything goes wrong in here, we should simply crash as we already saved
3440 3450
3441 warn "cancelling all WF_AUTOCANCEL watchers";
3442 for (Event::all_watchers) {
3443 $_->cancel if $_->data & WF_AUTOCANCEL;
3444 }
3445
3446 warn "flushing outstanding aio requests"; 3451 warn "flushing outstanding aio requests";
3447 for (;;) { 3452 for (;;) {
3448 BDB::flush; 3453 BDB::flush;
3449 IO::AIO::flush; 3454 IO::AIO::flush;
3450 Coro::cede_notself; 3455 Coro::cede_notself;
… …
3544 3549
3545sub reload_perl() { 3550sub reload_perl() {
3546 # doing reload synchronously and two reloads happen back-to-back, 3551 # doing reload synchronously and two reloads happen back-to-back,
3547 # coro crashes during coro_state_free->destroy here. 3552 # coro crashes during coro_state_free->destroy here.
3548 3553
3549 $RELOAD_WATCHER ||= Event->timer ( 3554 $RELOAD_WATCHER ||= EV::timer 0, 0, sub {
3550 reentrant => 0,
3551 after => 0,
3552 data => WF_AUTOCANCEL,
3553 cb => sub {
3554 do_reload_perl;
3555 undef $RELOAD_WATCHER; 3555 undef $RELOAD_WATCHER;
3556 }, 3556 do_reload_perl;
3557 ); 3557 };
3558} 3558}
3559 3559
3560register_command "reload" => sub { 3560register_command "reload" => sub {
3561 my ($who, $arg) = @_; 3561 my ($who, $arg) = @_;
3562 3562
… …
3592 my $signal = new Coro::Signal; 3592 my $signal = new Coro::Signal;
3593 push @WAIT_FOR_TICK_BEGIN, $signal; 3593 push @WAIT_FOR_TICK_BEGIN, $signal;
3594 $signal->wait; 3594 $signal->wait;
3595} 3595}
3596 3596
3597$TICK_WATCHER = Event->timer ( 3597$TICK_WATCHER = EV::periodic_ns 0, $TICK, 0, sub {
3598 reentrant => 0,
3599 parked => 1,
3600 prio => 0,
3601 at => $NEXT_TICK || $TICK,
3602 data => WF_AUTOCANCEL,
3603 cb => sub {
3604 if ($Coro::current != $Coro::main) { 3598 if ($Coro::current != $Coro::main) {
3605 Carp::cluck "major BUG: server tick called outside of main coro, skipping it" 3599 Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
3606 unless ++$bug_warning > 10; 3600 unless ++$bug_warning > 10;
3607 return; 3601 return;
3608 } 3602 }
3609 3603
3610 $NOW = $tick_start = Event::time; 3604 $NOW = $tick_start = EV::now;
3611 3605
3612 cf::server_tick; # one server iteration 3606 cf::server_tick; # one server iteration
3613 3607
3614 $RUNTIME += $TICK; 3608 $RUNTIME += $TICK;
3615 $NEXT_TICK += $TICK; 3609 $NEXT_TICK += $TICK;
3616 3610
3617 if ($NOW >= $NEXT_RUNTIME_WRITE) { 3611 if ($NOW >= $NEXT_RUNTIME_WRITE) {
3618 $NEXT_RUNTIME_WRITE = $NOW + 10; 3612 $NEXT_RUNTIME_WRITE = $NOW + 10;
3619 Coro::async_pool { 3613 Coro::async_pool {
3620 $Coro::current->{desc} = "runtime saver"; 3614 $Coro::current->{desc} = "runtime saver";
3621 write_runtime 3615 write_runtime
3622 or warn "ERROR: unable to write runtime file: $!"; 3616 or warn "ERROR: unable to write runtime file: $!";
3623 };
3624 } 3617 };
3618 }
3625 3619
3626 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) { 3620 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) {
3627 $sig->send; 3621 $sig->send;
3628 } 3622 }
3629 while (my $sig = shift @WAIT_FOR_TICK) { 3623 while (my $sig = shift @WAIT_FOR_TICK) {
3630 $sig->send; 3624 $sig->send;
3631 } 3625 }
3632 3626
3633 $NOW = Event::time;
3634
3635 # if we are delayed by four ticks or more, skip them all
3636 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
3637
3638 $TICK_WATCHER->at ($NEXT_TICK);
3639 $TICK_WATCHER->start;
3640
3641 $LOAD = ($NOW - $tick_start) / $TICK; 3627 $LOAD = ($NOW - $tick_start) / $TICK;
3642 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25; 3628 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
3643 3629
3644 _post_tick; 3630 _post_tick;
3645 }, 3631};
3646); 3632$TICK_WATCHER->priority (EV::MAXPRI);
3647 3633
3648{ 3634{
3635 # configure BDB
3636
3649 BDB::min_parallel 8; 3637 BDB::min_parallel 8;
3650 BDB::max_poll_time $TICK * 0.1; 3638 BDB::max_poll_reqs $TICK * 0.1;
3651 $BDB_POLL_WATCHER = Event->io (
3652 reentrant => 0,
3653 fd => BDB::poll_fileno,
3654 poll => 'r',
3655 prio => 0,
3656 data => WF_AUTOCANCEL,
3657 cb => \&BDB::poll_cb,
3658 );
3659
3660 BDB::set_sync_prepare {
3661 my $status;
3662 my $current = $Coro::current;
3663 (
3664 sub {
3665 $status = $!;
3666 $current->ready; undef $current;
3667 },
3668 sub {
3669 Coro::schedule while defined $current;
3670 $! = $status;
3671 },
3672 )
3673 };
3674 3639
3675 unless ($DB_ENV) { 3640 unless ($DB_ENV) {
3676 $DB_ENV = BDB::db_env_create; 3641 $DB_ENV = BDB::db_env_create;
3677 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC 3642 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC
3678 | BDB::LOG_AUTOREMOVE, 1); 3643 | BDB::LOG_AUTOREMOVE, 1);
… …
3693 3658
3694 cf::cleanup "db_env_open(db): $@" if $@; 3659 cf::cleanup "db_env_open(db): $@" if $@;
3695 }; 3660 };
3696 } 3661 }
3697 3662
3698 $BDB_DEADLOCK_WATCHER = Event->timer ( 3663 $BDB_DEADLOCK_WATCHER = EV::periodic 0, 3, 0, sub {
3699 after => 3,
3700 interval => 1,
3701 hard => 1,
3702 prio => 0,
3703 data => WF_AUTOCANCEL,
3704 cb => sub {
3705 BDB::db_env_lock_detect $DB_ENV, 0, BDB::LOCK_DEFAULT, 0, sub { }; 3664 BDB::db_env_lock_detect $DB_ENV, 0, BDB::LOCK_DEFAULT, 0, sub { };
3706 },
3707 ); 3665 };
3708 $BDB_CHECKPOINT_WATCHER = Event->timer ( 3666 $BDB_CHECKPOINT_WATCHER = EV::periodic 0, 60, 0, sub {
3709 after => 11,
3710 interval => 60,
3711 hard => 1,
3712 prio => 0,
3713 data => WF_AUTOCANCEL,
3714 cb => sub {
3715 BDB::db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { }; 3667 BDB::db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { };
3716 },
3717 ); 3668 };
3718 $BDB_TRICKLE_WATCHER = Event->timer ( 3669 $BDB_TRICKLE_WATCHER = EV::periodic 0, 10, 0, sub {
3719 after => 5,
3720 interval => 10,
3721 hard => 1,
3722 prio => 0,
3723 data => WF_AUTOCANCEL,
3724 cb => sub {
3725 BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { }; 3670 BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { };
3726 },
3727 ); 3671 };
3728} 3672}
3729 3673
3730{ 3674{
3675 # configure IO::AIO
3676
3731 IO::AIO::min_parallel 8; 3677 IO::AIO::min_parallel 8;
3732
3733 undef $Coro::AIO::WATCHER;
3734 IO::AIO::max_poll_time $TICK * 0.1; 3678 IO::AIO::max_poll_time $TICK * 0.1;
3735 $AIO_POLL_WATCHER = Event->io (
3736 reentrant => 0,
3737 data => WF_AUTOCANCEL,
3738 fd => IO::AIO::poll_fileno,
3739 poll => 'r',
3740 prio => 0,
3741 cb => \&IO::AIO::poll_cb,
3742 );
3743} 3679}
3744 3680
3745my $_log_backtrace; 3681my $_log_backtrace;
3746 3682
3747sub _log_backtrace { 3683sub _log_backtrace {

Diff Legend

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