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.406 by root, Mon Dec 17 08:27:44 2007 UTC vs.
Revision 1.414 by root, Thu Apr 10 09:10:45 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
193 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge; 211 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge;
194 212
195 LOG llevError, $msg; 213 LOG llevError, $msg;
196 }; 214 };
197} 215}
216
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
226 warn Carp::longmess $_[0];
227 Coro::terminate
228};
229
230$SIG{__DIE__} = sub { }; #d#?
198 231
199@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 232@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
200@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 233@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
201@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable'; 234@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
202@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable'; 235@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable';
327 360
328 ! ! $LOCK{$key} 361 ! ! $LOCK{$key}
329} 362}
330 363
331sub freeze_mainloop { 364sub freeze_mainloop {
332 return unless $TICK_WATCHER->is_active; 365 tick_inhibit_inc;
333 366
334 my $guard = Coro::guard { 367 Coro::guard \&tick_inhibit_dec;
335 $TICK_WATCHER->start;
336 };
337 $TICK_WATCHER->stop;
338 $guard
339} 368}
340 369
341=item cf::periodic $interval, $cb 370=item cf::periodic $interval, $cb
342 371
343Like 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
444 # this is the main coro, too bad, we have to block 473 # this is the main coro, too bad, we have to block
445 # till the operation succeeds, freezing the server :/ 474 # till the operation succeeds, freezing the server :/
446 475
447 LOG llevError, Carp::longmess "sync job";#d# 476 LOG llevError, Carp::longmess "sync job";#d#
448 477
449 # TODO: use suspend/resume instead
450 # (but this is cancel-safe)
451 my $freeze_guard = freeze_mainloop; 478 my $freeze_guard = freeze_mainloop;
452 479
453 my $busy = 1; 480 my $busy = 1;
454 my @res; 481 my @res;
455 482
466 } else { 493 } else {
467 EV::loop EV::LOOP_ONESHOT; 494 EV::loop EV::LOOP_ONESHOT;
468 } 495 }
469 } 496 }
470 497
471 $time = EV::time - $time; 498 my $time = EV::time - $time;
472 499
473 LOG llevError | logBacktrace, Carp::longmess "long sync job"
474 if $time > $TICK * 0.5 && $TICK_WATCHER->is_active;
475
476 $tick_start += $time; # do not account sync jobs to server load 500 $TICK_START += $time; # do not account sync jobs to server load
477 501
478 wantarray ? @res : $res[0] 502 wantarray ? @res : $res[0]
479 } else { 503 } else {
480 # we are in another coroutine, how wonderful, everything just works 504 # we are in another coroutine, how wonderful, everything just works
481 505
1304 my $msg = $@ ? "$v->{path}: $@\n" 1328 my $msg = $@ ? "$v->{path}: $@\n"
1305 : "$v->{base}: extension inactive.\n"; 1329 : "$v->{base}: extension inactive.\n";
1306 1330
1307 if (exists $v->{meta}{mandatory}) { 1331 if (exists $v->{meta}{mandatory}) {
1308 warn $msg; 1332 warn $msg;
1309 warn "mandatory extension failed to load, exiting.\n"; 1333 cf::cleanup "mandatory extension failed to load, exiting.";
1310 exit 1;
1311 } 1334 }
1312 1335
1313 warn $msg; 1336 warn $msg;
1314 } 1337 }
1315 1338
3308sub reload_config { 3331sub reload_config {
3309 open my $fh, "<:utf8", "$CONFDIR/config" 3332 open my $fh, "<:utf8", "$CONFDIR/config"
3310 or return; 3333 or return;
3311 3334
3312 local $/; 3335 local $/;
3313 *CFG = YAML::Syck::Load <$fh>; 3336 *CFG = YAML::Load <$fh>;
3314 3337
3315 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3338 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
3316 3339
3317 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3340 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3318 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3341 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
3338 3361
3339 reload_config; 3362 reload_config;
3340 db_init; 3363 db_init;
3341 load_extensions; 3364 load_extensions;
3342 3365
3343 $TICK_WATCHER->start;
3344 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3366 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3367 evthread_start IO::AIO::poll_fileno;
3345 EV::loop; 3368 EV::loop;
3346} 3369}
3347 3370
3348############################################################################# 3371#############################################################################
3349# initialisation and cleanup 3372# initialisation and cleanup
3546 warn "leaving sync_job"; 3569 warn "leaving sync_job";
3547 3570
3548 1 3571 1
3549 } or do { 3572 } or do {
3550 warn $@; 3573 warn $@;
3551 warn "error while reloading, exiting."; 3574 cf::cleanup "error while reloading, exiting.";
3552 exit 1;
3553 }; 3575 };
3554 3576
3555 warn "reloaded"; 3577 warn "reloaded";
3556}; 3578};
3557 3579
3560sub reload_perl() { 3582sub reload_perl() {
3561 # doing reload synchronously and two reloads happen back-to-back, 3583 # doing reload synchronously and two reloads happen back-to-back,
3562 # coro crashes during coro_state_free->destroy here. 3584 # coro crashes during coro_state_free->destroy here.
3563 3585
3564 $RELOAD_WATCHER ||= EV::timer 0, 0, sub { 3586 $RELOAD_WATCHER ||= EV::timer 0, 0, sub {
3587 do_reload_perl;
3565 undef $RELOAD_WATCHER; 3588 undef $RELOAD_WATCHER;
3566 do_reload_perl;
3567 }; 3589 };
3568} 3590}
3569 3591
3570register_command "reload" => sub { 3592register_command "reload" => sub {
3571 my ($who, $arg) = @_; 3593 my ($who, $arg) = @_;
3585 3607
3586our @WAIT_FOR_TICK; 3608our @WAIT_FOR_TICK;
3587our @WAIT_FOR_TICK_BEGIN; 3609our @WAIT_FOR_TICK_BEGIN;
3588 3610
3589sub wait_for_tick { 3611sub wait_for_tick {
3590 return unless $TICK_WATCHER->is_active; 3612 return if tick_inhibit;
3591 return if $Coro::current == $Coro::main; 3613 return if $Coro::current == $Coro::main;
3592 3614
3593 my $signal = new Coro::Signal; 3615 my $signal = new Coro::Signal;
3594 push @WAIT_FOR_TICK, $signal; 3616 push @WAIT_FOR_TICK, $signal;
3595 $signal->wait; 3617 $signal->wait;
3596} 3618}
3597 3619
3598sub wait_for_tick_begin { 3620sub wait_for_tick_begin {
3599 return unless $TICK_WATCHER->is_active; 3621 return if tick_inhibit;
3600 return if $Coro::current == $Coro::main; 3622 return if $Coro::current == $Coro::main;
3601 3623
3602 my $signal = new Coro::Signal; 3624 my $signal = new Coro::Signal;
3603 push @WAIT_FOR_TICK_BEGIN, $signal; 3625 push @WAIT_FOR_TICK_BEGIN, $signal;
3604 $signal->wait; 3626 $signal->wait;
3605} 3627}
3606 3628
3607$TICK_WATCHER = EV::periodic_ns 0, $TICK, 0, sub { 3629sub tick {
3608 if ($Coro::current != $Coro::main) { 3630 if ($Coro::current != $Coro::main) {
3609 Carp::cluck "major BUG: server tick called outside of main coro, skipping it" 3631 Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
3610 unless ++$bug_warning > 10; 3632 unless ++$bug_warning > 10;
3611 return; 3633 return;
3612 } 3634 }
3613 3635
3614 $NOW = $tick_start = EV::now;
3615
3616 cf::server_tick; # one server iteration 3636 cf::server_tick; # one server iteration
3617
3618 $RUNTIME += $TICK;
3619 $NEXT_TICK = $_[0]->at;
3620 3637
3621 if ($NOW >= $NEXT_RUNTIME_WRITE) { 3638 if ($NOW >= $NEXT_RUNTIME_WRITE) {
3622 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.; 3639 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
3623 Coro::async_pool { 3640 Coro::async_pool {
3624 $Coro::current->{desc} = "runtime saver"; 3641 $Coro::current->{desc} = "runtime saver";
3632 } 3649 }
3633 while (my $sig = shift @WAIT_FOR_TICK) { 3650 while (my $sig = shift @WAIT_FOR_TICK) {
3634 $sig->send; 3651 $sig->send;
3635 } 3652 }
3636 3653
3637 $LOAD = ($NOW - $tick_start) / $TICK; 3654 $LOAD = ($NOW - $TICK_START) / $TICK;
3638 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25; 3655 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
3639 3656
3640 _post_tick; 3657 if (0) {
3641}; 3658 if ($NEXT_TICK) {
3642$TICK_WATCHER->priority (EV::MAXPRI); 3659 my $jitter = $TICK_START - $NEXT_TICK;
3660 $JITTER = $JITTER * 0.75 + $jitter * 0.25;
3661 warn "jitter $JITTER\n";#d#
3662 }
3663 }
3664}
3643 3665
3644{ 3666{
3645 # configure BDB 3667 # configure BDB
3646 3668
3647 BDB::min_parallel 8; 3669 BDB::min_parallel 8;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines