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.404 by root, Mon Dec 17 07:27:58 2007 UTC vs.
Revision 1.418 by root, Fri Apr 11 21:09:53 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
… …
69our $TMPDIR = "$LOCALDIR/" . tmpdir; 87our $TMPDIR = "$LOCALDIR/" . tmpdir;
70our $UNIQUEDIR = "$LOCALDIR/" . uniquedir; 88our $UNIQUEDIR = "$LOCALDIR/" . uniquedir;
71our $PLAYERDIR = "$LOCALDIR/" . playerdir; 89our $PLAYERDIR = "$LOCALDIR/" . playerdir;
72our $RANDOMDIR = "$LOCALDIR/random"; 90our $RANDOMDIR = "$LOCALDIR/random";
73our $BDBDIR = "$LOCALDIR/db"; 91our $BDBDIR = "$LOCALDIR/db";
92our %RESOURCE;
74 93
75our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 94our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
76our $TICK_WATCHER;
77our $AIO_POLL_WATCHER; 95our $AIO_POLL_WATCHER;
78our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 96our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
79our $NEXT_TICK; 97our $NEXT_TICK;
80our $USE_FSYNC = 1; # use fsync to write maps - default off 98our $USE_FSYNC = 1; # use fsync to write maps - default off
81 99
… …
98# 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 ∕
99our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons 117our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
100 118
101our $LOAD; # a number between 0 (idle) and 1 (too many objects) 119our $LOAD; # a number between 0 (idle) and 1 (too many objects)
102our $LOADAVG; # same thing, but with alpha-smoothing 120our $LOADAVG; # same thing, but with alpha-smoothing
121our $JITTER; # average jitter
103our $tick_start; # for load detecting purposes 122our $TICK_START; # for load detecting purposes
104 123
105binmode STDOUT; 124binmode STDOUT;
106binmode STDERR; 125binmode STDERR;
107 126
108# read virtual server time, if available 127# read virtual server time, if available
… …
192 $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;
193 212
194 LOG llevError, $msg; 213 LOG llevError, $msg;
195 }; 214 };
196} 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#?
197 231
198@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 232@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
199@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 233@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
200@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable'; 234@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
201@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable'; 235@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable';
… …
326 360
327 ! ! $LOCK{$key} 361 ! ! $LOCK{$key}
328} 362}
329 363
330sub freeze_mainloop { 364sub freeze_mainloop {
331 return unless $TICK_WATCHER->is_active; 365 tick_inhibit_inc;
332 366
333 my $guard = Coro::guard { 367 Coro::guard \&tick_inhibit_dec;
334 $TICK_WATCHER->start;
335 };
336 $TICK_WATCHER->stop;
337 $guard
338} 368}
339 369
340=item cf::periodic $interval, $cb 370=item cf::periodic $interval, $cb
341 371
342Like 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
… …
443 # this is the main coro, too bad, we have to block 473 # this is the main coro, too bad, we have to block
444 # till the operation succeeds, freezing the server :/ 474 # till the operation succeeds, freezing the server :/
445 475
446 LOG llevError, Carp::longmess "sync job";#d# 476 LOG llevError, Carp::longmess "sync job";#d#
447 477
448 # TODO: use suspend/resume instead
449 # (but this is cancel-safe)
450 my $freeze_guard = freeze_mainloop; 478 my $freeze_guard = freeze_mainloop;
451 479
452 my $busy = 1; 480 my $busy = 1;
453 my @res; 481 my @res;
454 482
… …
465 } else { 493 } else {
466 EV::loop EV::LOOP_ONESHOT; 494 EV::loop EV::LOOP_ONESHOT;
467 } 495 }
468 } 496 }
469 497
470 $time = EV::time - $time; 498 my $time = EV::time - $time;
471 499
472 LOG llevError | logBacktrace, Carp::longmess "long sync job"
473 if $time > $TICK * 0.5 && $TICK_WATCHER->is_active;
474
475 $tick_start += $time; # do not account sync jobs to server load 500 $TICK_START += $time; # do not account sync jobs to server load
476 501
477 wantarray ? @res : $res[0] 502 wantarray ? @res : $res[0]
478 } else { 503 } else {
479 # we are in another coroutine, how wonderful, everything just works 504 # we are in another coroutine, how wonderful, everything just works
480 505
… …
522 reset_signals; 547 reset_signals;
523 &$cb 548 &$cb
524 }, @args; 549 }, @args;
525 550
526 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
527} 579}
528 580
529=item $value = cf::db_get $family => $key 581=item $value = cf::db_get $family => $key
530 582
531Returns a single value from the environment database. 583Returns a single value from the environment database.
… …
968 } 1020 }
969 1021
970 0 1022 0
971} 1023}
972 1024
973=item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...) 1025=item $bool = cf::global->invoke (EVENT_CLASS_XXX, ...)
974 1026
975=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...) 1027=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...)
976 1028
977Generate an object-specific event with the given arguments. 1029Generate an object-specific event with the given arguments.
978 1030
… …
1303 my $msg = $@ ? "$v->{path}: $@\n" 1355 my $msg = $@ ? "$v->{path}: $@\n"
1304 : "$v->{base}: extension inactive.\n"; 1356 : "$v->{base}: extension inactive.\n";
1305 1357
1306 if (exists $v->{meta}{mandatory}) { 1358 if (exists $v->{meta}{mandatory}) {
1307 warn $msg; 1359 warn $msg;
1308 warn "mandatory extension failed to load, exiting.\n"; 1360 cf::cleanup "mandatory extension failed to load, exiting.";
1309 exit 1;
1310 } 1361 }
1311 1362
1312 warn $msg; 1363 warn $msg;
1313 } 1364 }
1314 1365
… …
1724our $MAX_RESET = 3600; 1775our $MAX_RESET = 3600;
1725our $DEFAULT_RESET = 3000; 1776our $DEFAULT_RESET = 3000;
1726 1777
1727sub generate_random_map { 1778sub generate_random_map {
1728 my ($self, $rmp) = @_; 1779 my ($self, $rmp) = @_;
1780
1781 my $lock = cf::lock_acquire "generate_random_map"; # the random map generator is NOT reentrant ATM
1782
1729 # mit "rum" bekleckern, nicht 1783 # mit "rum" bekleckern, nicht
1730 $self->_create_random_map ( 1784 $self->_create_random_map (
1731 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle}, 1785 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1732 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, 1786 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1733 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map}, 1787 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
… …
2325 ? normalise $_ 2379 ? normalise $_
2326 : () 2380 : ()
2327 } @{ aio_readdir $UNIQUEDIR or [] } 2381 } @{ aio_readdir $UNIQUEDIR or [] }
2328 ] 2382 ]
2329} 2383}
2330
2331package cf;
2332 2384
2333=back 2385=back
2334 2386
2335=head3 cf::object 2387=head3 cf::object
2336 2388
… …
3149 { 3201 {
3150 my $faces = $facedata->{faceinfo}; 3202 my $faces = $facedata->{faceinfo};
3151 3203
3152 while (my ($face, $info) = each %$faces) { 3204 while (my ($face, $info) = each %$faces) {
3153 my $idx = (cf::face::find $face) || cf::face::alloc $face; 3205 my $idx = (cf::face::find $face) || cf::face::alloc $face;
3206
3154 cf::face::set_visibility $idx, $info->{visibility}; 3207 cf::face::set_visibility $idx, $info->{visibility};
3155 cf::face::set_magicmap $idx, $info->{magicmap}; 3208 cf::face::set_magicmap $idx, $info->{magicmap};
3156 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32}; 3209 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32};
3157 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64}; 3210 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64};
3158 3211
3159 cf::cede_to_tick; 3212 cf::cede_to_tick;
3160 } 3213 }
3161 3214
3162 while (my ($face, $info) = each %$faces) { 3215 while (my ($face, $info) = each %$faces) {
3163 next unless $info->{smooth}; 3216 next unless $info->{smooth};
3217
3164 my $idx = cf::face::find $face 3218 my $idx = cf::face::find $face
3165 or next; 3219 or next;
3220
3166 if (my $smooth = cf::face::find $info->{smooth}) { 3221 if (my $smooth = cf::face::find $info->{smooth}) {
3167 cf::face::set_smooth $idx, $smooth; 3222 cf::face::set_smooth $idx, $smooth;
3168 cf::face::set_smoothlevel $idx, $info->{smoothlevel}; 3223 cf::face::set_smoothlevel $idx, $info->{smoothlevel};
3169 } else { 3224 } else {
3170 warn "smooth face '$info->{smooth}' not found for face '$face'"; 3225 warn "smooth face '$info->{smooth}' not found for face '$face'";
… …
3188 { 3243 {
3189 # TODO: for gcfclient pleasure, we should give resources 3244 # TODO: for gcfclient pleasure, we should give resources
3190 # that gcfclient doesn't grok a >10000 face index. 3245 # that gcfclient doesn't grok a >10000 face index.
3191 my $res = $facedata->{resource}; 3246 my $res = $facedata->{resource};
3192 3247
3193 my $soundconf = delete $res->{"res/sound.conf"};
3194
3195 while (my ($name, $info) = each %$res) { 3248 while (my ($name, $info) = each %$res) {
3249 if (defined $info->{type}) {
3196 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3250 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3197 my $data; 3251 my $data;
3198 3252
3199 if ($info->{type} & 1) { 3253 if ($info->{type} & 1) {
3200 # prepend meta info 3254 # prepend meta info
3201 3255
3202 my $meta = $enc->encode ({ 3256 my $meta = $enc->encode ({
3203 name => $name, 3257 name => $name,
3204 %{ $info->{meta} || {} }, 3258 %{ $info->{meta} || {} },
3205 }); 3259 });
3206 3260
3207 $data = pack "(w/a*)*", $meta, $info->{data}; 3261 $data = pack "(w/a*)*", $meta, $info->{data};
3262 } else {
3263 $data = $info->{data};
3264 }
3265
3266 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
3267 cf::face::set_type $idx, $info->{type};
3208 } else { 3268 } else {
3209 $data = $info->{data}; 3269 $RESOURCE{$name} = $info;
3210 } 3270 }
3211 3271
3212 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
3213 cf::face::set_type $idx, $info->{type};
3214
3215 cf::cede_to_tick; 3272 cf::cede_to_tick;
3216 } 3273 }
3217
3218 if ($soundconf) {
3219 $soundconf = $enc->decode (delete $soundconf->{data});
3220
3221 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3222 my $sound = $soundconf->{compat}[$_]
3223 or next;
3224
3225 my $face = cf::face::find "sound/$sound->[1]";
3226 cf::sound::set $sound->[0] => $face;
3227 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3228 }
3229
3230 while (my ($k, $v) = each %{$soundconf->{event}}) {
3231 my $face = cf::face::find "sound/$v";
3232 cf::sound::set $k => $face;
3233 }
3234 }
3235 } 3274 }
3275
3276 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
3236 3277
3237 1 3278 1
3238} 3279}
3280
3281cf::global->attach (on_resource_update => sub {
3282 if (my $soundconf = $RESOURCE{"res/sound.conf"}) {
3283 $soundconf = JSON::XS->new->utf8->relaxed->decode ($soundconf->{data});
3284
3285 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3286 my $sound = $soundconf->{compat}[$_]
3287 or next;
3288
3289 my $face = cf::face::find "sound/$sound->[1]";
3290 cf::sound::set $sound->[0] => $face;
3291 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3292 }
3293
3294 while (my ($k, $v) = each %{$soundconf->{event}}) {
3295 my $face = cf::face::find "sound/$v";
3296 cf::sound::set $k => $face;
3297 }
3298 }
3299});
3239 3300
3240register_exticmd fx_want => sub { 3301register_exticmd fx_want => sub {
3241 my ($ns, $want) = @_; 3302 my ($ns, $want) = @_;
3242 3303
3243 while (my ($k, $v) = each %$want) { 3304 while (my ($k, $v) = each %$want) {
… …
3298sub reload_config { 3359sub reload_config {
3299 open my $fh, "<:utf8", "$CONFDIR/config" 3360 open my $fh, "<:utf8", "$CONFDIR/config"
3300 or return; 3361 or return;
3301 3362
3302 local $/; 3363 local $/;
3303 *CFG = YAML::Syck::Load <$fh>; 3364 *CFG = YAML::Load <$fh>;
3304 3365
3305 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3366 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
3306 3367
3307 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3368 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3308 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3369 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
… …
3328 3389
3329 reload_config; 3390 reload_config;
3330 db_init; 3391 db_init;
3331 load_extensions; 3392 load_extensions;
3332 3393
3333 $TICK_WATCHER->start;
3334 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3394 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3395 evthread_start IO::AIO::poll_fileno;
3335 EV::loop; 3396 EV::loop;
3336} 3397}
3337 3398
3338############################################################################# 3399#############################################################################
3339# initialisation and cleanup 3400# initialisation and cleanup
… …
3346 cf::cleanup "SIG$signal"; 3407 cf::cleanup "SIG$signal";
3347 }; 3408 };
3348 } 3409 }
3349} 3410}
3350 3411
3351sub write_runtime { 3412sub write_runtime_sync {
3352 my $runtime = "$LOCALDIR/runtime"; 3413 my $runtime = "$LOCALDIR/runtime";
3353 3414
3354 # first touch the runtime file to show we are still running: 3415 # first touch the runtime file to show we are still running:
3355 # the fsync below can take a very very long time. 3416 # the fsync below can take a very very long time.
3356 3417
… …
3382 and return; 3443 and return;
3383 3444
3384 warn "runtime file written.\n"; 3445 warn "runtime file written.\n";
3385 3446
3386 1 3447 1
3448}
3449
3450our $uuid_lock;
3451our $uuid_skip;
3452
3453sub write_uuid_sync($) {
3454 $uuid_skip ||= $_[0];
3455
3456 return if $uuid_lock;
3457 local $uuid_lock = 1;
3458
3459 my $uuid = "$LOCALDIR/uuid";
3460
3461 my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644
3462 or return;
3463
3464 my $value = uuid_str $uuid_skip + uuid_seq uuid_cur;
3465 $uuid_skip = 0;
3466
3467 (aio_write $fh, 0, (length $value), $value, 0) <= 0
3468 and return;
3469
3470 # always fsync - this file is important
3471 aio_fsync $fh
3472 and return;
3473
3474 close $fh
3475 or return;
3476
3477 aio_rename "$uuid~", $uuid
3478 and return;
3479
3480 warn "uuid file written ($value).\n";
3481
3482 1
3483
3484}
3485
3486sub write_uuid($$) {
3487 my ($skip, $sync) = @_;
3488
3489 $sync ? write_uuid_sync $skip
3490 : async { write_uuid_sync $skip };
3387} 3491}
3388 3492
3389sub emergency_save() { 3493sub emergency_save() {
3390 my $freeze_guard = cf::freeze_mainloop; 3494 my $freeze_guard = cf::freeze_mainloop;
3391 3495
… …
3413 warn "end emergency map save\n"; 3517 warn "end emergency map save\n";
3414 3518
3415 warn "begin emergency database checkpoint\n"; 3519 warn "begin emergency database checkpoint\n";
3416 BDB::db_env_txn_checkpoint $DB_ENV; 3520 BDB::db_env_txn_checkpoint $DB_ENV;
3417 warn "end emergency database checkpoint\n"; 3521 warn "end emergency database checkpoint\n";
3522
3523 warn "begin write uuid\n";
3524 write_uuid_sync 1;
3525 warn "end write uuid\n";
3418 }; 3526 };
3419 3527
3420 warn "leave emergency perl save\n"; 3528 warn "leave emergency perl save\n";
3421} 3529}
3422 3530
… …
3437 warn "reloading..."; 3545 warn "reloading...";
3438 3546
3439 warn "entering sync_job"; 3547 warn "entering sync_job";
3440 3548
3441 cf::sync_job { 3549 cf::sync_job {
3442 cf::write_runtime; # external watchdog should not bark 3550 cf::write_runtime_sync; # external watchdog should not bark
3443 cf::emergency_save; 3551 cf::emergency_save;
3444 cf::write_runtime; # external watchdog should not bark 3552 cf::write_runtime_sync; # external watchdog should not bark
3445 3553
3446 warn "syncing database to disk"; 3554 warn "syncing database to disk";
3447 BDB::db_env_txn_checkpoint $DB_ENV; 3555 BDB::db_env_txn_checkpoint $DB_ENV;
3448 3556
3449 # if anything goes wrong in here, we should simply crash as we already saved 3557 # if anything goes wrong in here, we should simply crash as we already saved
… …
3536 warn "leaving sync_job"; 3644 warn "leaving sync_job";
3537 3645
3538 1 3646 1
3539 } or do { 3647 } or do {
3540 warn $@; 3648 warn $@;
3541 warn "error while reloading, exiting."; 3649 cf::cleanup "error while reloading, exiting.";
3542 exit 1;
3543 }; 3650 };
3544 3651
3545 warn "reloaded"; 3652 warn "reloaded";
3546}; 3653};
3547 3654
… …
3550sub reload_perl() { 3657sub reload_perl() {
3551 # doing reload synchronously and two reloads happen back-to-back, 3658 # doing reload synchronously and two reloads happen back-to-back,
3552 # coro crashes during coro_state_free->destroy here. 3659 # coro crashes during coro_state_free->destroy here.
3553 3660
3554 $RELOAD_WATCHER ||= EV::timer 0, 0, sub { 3661 $RELOAD_WATCHER ||= EV::timer 0, 0, sub {
3662 do_reload_perl;
3555 undef $RELOAD_WATCHER; 3663 undef $RELOAD_WATCHER;
3556 do_reload_perl;
3557 }; 3664 };
3558} 3665}
3559 3666
3560register_command "reload" => sub { 3667register_command "reload" => sub {
3561 my ($who, $arg) = @_; 3668 my ($who, $arg) = @_;
… …
3575 3682
3576our @WAIT_FOR_TICK; 3683our @WAIT_FOR_TICK;
3577our @WAIT_FOR_TICK_BEGIN; 3684our @WAIT_FOR_TICK_BEGIN;
3578 3685
3579sub wait_for_tick { 3686sub wait_for_tick {
3580 return unless $TICK_WATCHER->is_active; 3687 return if tick_inhibit;
3581 return if $Coro::current == $Coro::main; 3688 return if $Coro::current == $Coro::main;
3582 3689
3583 my $signal = new Coro::Signal; 3690 my $signal = new Coro::Signal;
3584 push @WAIT_FOR_TICK, $signal; 3691 push @WAIT_FOR_TICK, $signal;
3585 $signal->wait; 3692 $signal->wait;
3586} 3693}
3587 3694
3588sub wait_for_tick_begin { 3695sub wait_for_tick_begin {
3589 return unless $TICK_WATCHER->is_active; 3696 return if tick_inhibit;
3590 return if $Coro::current == $Coro::main; 3697 return if $Coro::current == $Coro::main;
3591 3698
3592 my $signal = new Coro::Signal; 3699 my $signal = new Coro::Signal;
3593 push @WAIT_FOR_TICK_BEGIN, $signal; 3700 push @WAIT_FOR_TICK_BEGIN, $signal;
3594 $signal->wait; 3701 $signal->wait;
3595} 3702}
3596 3703
3597$TICK_WATCHER = EV::periodic_ns 0, $TICK, 0, sub { 3704sub tick {
3598 if ($Coro::current != $Coro::main) { 3705 if ($Coro::current != $Coro::main) {
3599 Carp::cluck "major BUG: server tick called outside of main coro, skipping it" 3706 Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
3600 unless ++$bug_warning > 10; 3707 unless ++$bug_warning > 10;
3601 return; 3708 return;
3602 } 3709 }
3603 3710
3604 $NOW = $tick_start = EV::now;
3605
3606 cf::server_tick; # one server iteration 3711 cf::server_tick; # one server iteration
3607
3608 $RUNTIME += $TICK;
3609 $NEXT_TICK = $_[0]->at;
3610 3712
3611 if ($NOW >= $NEXT_RUNTIME_WRITE) { 3713 if ($NOW >= $NEXT_RUNTIME_WRITE) {
3612 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.; 3714 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
3613 Coro::async_pool { 3715 Coro::async_pool {
3614 $Coro::current->{desc} = "runtime saver"; 3716 $Coro::current->{desc} = "runtime saver";
3615 write_runtime 3717 write_runtime_sync
3616 or warn "ERROR: unable to write runtime file: $!"; 3718 or warn "ERROR: unable to write runtime file: $!";
3617 }; 3719 };
3618 } 3720 }
3619 3721
3620 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) { 3722 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) {
… …
3622 } 3724 }
3623 while (my $sig = shift @WAIT_FOR_TICK) { 3725 while (my $sig = shift @WAIT_FOR_TICK) {
3624 $sig->send; 3726 $sig->send;
3625 } 3727 }
3626 3728
3627 $LOAD = ($NOW - $tick_start) / $TICK; 3729 $LOAD = ($NOW - $TICK_START) / $TICK;
3628 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25; 3730 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
3629 3731
3630 _post_tick; 3732 if (0) {
3631}; 3733 if ($NEXT_TICK) {
3632$TICK_WATCHER->priority (EV::MAXPRI); 3734 my $jitter = $TICK_START - $NEXT_TICK;
3735 $JITTER = $JITTER * 0.75 + $jitter * 0.25;
3736 warn "jitter $JITTER\n";#d#
3737 }
3738 }
3739}
3633 3740
3634{ 3741{
3635 # configure BDB 3742 # configure BDB
3636 3743
3637 BDB::min_parallel 8; 3744 BDB::min_parallel 8;

Diff Legend

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