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.394 by root, Thu Nov 8 19:43:25 2007 UTC vs.
Revision 1.412 by root, Wed Apr 2 11:13:55 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 Event; 30use EV 1.86;
10use Opcode; 31use Opcode;
11use Safe; 32use Safe;
12use Safe::Hole; 33use Safe::Hole;
13use Storable (); 34use Storable ();
14 35
15use Coro 4.1 (); 36use Coro 4.32 ();
16use Coro::State; 37use Coro::State;
17use Coro::Handle; 38use Coro::Handle;
18use Coro::Event; 39use Coro::EV;
19use Coro::Timer; 40use Coro::Timer;
20use Coro::Signal; 41use Coro::Signal;
21use Coro::Semaphore; 42use Coro::Semaphore;
22use Coro::AIO; 43use Coro::AIO;
44use Coro::BDB;
23use Coro::Storable; 45use Coro::Storable;
24use Coro::Util (); 46use Coro::Util ();
25 47
26use JSON::XS (); 48use JSON::XS 2.01 ();
27use BDB (); 49use BDB ();
28use Data::Dumper; 50use Data::Dumper;
29use Digest::MD5; 51use Digest::MD5;
30use Fcntl; 52use Fcntl;
31use YAML::Syck (); 53use YAML ();
32use IO::AIO 2.51 (); 54use IO::AIO 2.51 ();
33use Time::HiRes; 55use Time::HiRes;
34use Compress::LZF; 56use Compress::LZF;
35use Digest::MD5 (); 57use Digest::MD5 ();
36 58
37# configure various modules to our taste 59# configure various modules to our taste
38# 60#
39$Storable::canonical = 1; # reduce rsync transfers 61$Storable::canonical = 1; # reduce rsync transfers
40Coro::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
41Compress::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
42
43$Event::Eval = 1; # no idea why this is required, but it is
44
45# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
46$YAML::Syck::ImplicitUnicode = 1;
47 64
48$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
49 66
50sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 67sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
51 68
… …
70our $TMPDIR = "$LOCALDIR/" . tmpdir; 87our $TMPDIR = "$LOCALDIR/" . tmpdir;
71our $UNIQUEDIR = "$LOCALDIR/" . uniquedir; 88our $UNIQUEDIR = "$LOCALDIR/" . uniquedir;
72our $PLAYERDIR = "$LOCALDIR/" . playerdir; 89our $PLAYERDIR = "$LOCALDIR/" . playerdir;
73our $RANDOMDIR = "$LOCALDIR/random"; 90our $RANDOMDIR = "$LOCALDIR/random";
74our $BDBDIR = "$LOCALDIR/db"; 91our $BDBDIR = "$LOCALDIR/db";
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 $NOW;
82our $USE_FSYNC = 1; # use fsync to write maps - default off 98our $USE_FSYNC = 1; # use fsync to write maps - default off
83 99
84our $BDB_POLL_WATCHER; 100our $BDB_POLL_WATCHER;
85our $BDB_DEADLOCK_WATCHER; 101our $BDB_DEADLOCK_WATCHER;
86our $BDB_CHECKPOINT_WATCHER; 102our $BDB_CHECKPOINT_WATCHER;
… …
89 105
90our %CFG; 106our %CFG;
91 107
92our $UPTIME; $UPTIME ||= time; 108our $UPTIME; $UPTIME ||= time;
93our $RUNTIME; 109our $RUNTIME;
110our $NOW;
94 111
95our (%PLAYER, %PLAYER_LOADING); # all users 112our (%PLAYER, %PLAYER_LOADING); # all users
96our (%MAP, %MAP_LOADING ); # all maps 113our (%MAP, %MAP_LOADING ); # all maps
97our $LINK_MAP; # the special {link} map, which is always available 114our $LINK_MAP; # the special {link} map, which is always available
98 115
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
… …
162 180
163The raw value load value from the last tick. 181The raw value load value from the last tick.
164 182
165=item %cf::CFG 183=item %cf::CFG
166 184
167Configuration for the server, loaded from C</etc/crossfire/config>, or 185Configuration for the server, loaded from C</etc/deliantra-server/config>, or
168from wherever your confdir points to. 186from wherever your confdir points to.
169 187
170=item cf::wait_for_tick, cf::wait_for_tick_begin 188=item cf::wait_for_tick, cf::wait_for_tick_begin
171 189
172These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only 190These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only
… …
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';
… …
215)) { 248)) {
216 no strict 'refs'; 249 no strict 'refs';
217 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; 250 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
218} 251}
219 252
220$Event::DIED = sub { 253$EV::DIED = sub {
221 warn "error in event callback: @_"; 254 warn "error in event callback: @_";
222}; 255};
223 256
224############################################################################# 257#############################################################################
225 258
… …
248 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge; 281 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
249 $d 282 $d
250 } || "[unable to dump $_[0]: '$@']"; 283 } || "[unable to dump $_[0]: '$@']";
251} 284}
252 285
253=item $ref = cf::from_json $json 286=item $ref = cf::decode_json $json
254 287
255Converts a JSON string into the corresponding perl data structure. 288Converts a JSON string into the corresponding perl data structure.
256 289
257=item $json = cf::to_json $ref 290=item $json = cf::encode_json $ref
258 291
259Converts a perl data structure into its JSON representation. 292Converts a perl data structure into its JSON representation.
260 293
261=cut 294=cut
262 295
263our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max 296our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
264 297
265sub to_json ($) { $json_coder->encode ($_[0]) } 298sub encode_json($) { $json_coder->encode ($_[0]) }
266sub from_json ($) { $json_coder->decode ($_[0]) } 299sub decode_json($) { $json_coder->decode ($_[0]) }
267 300
268=item cf::lock_wait $string 301=item cf::lock_wait $string
269 302
270Wait until the given lock is available. See cf::lock_acquire. 303Wait until the given lock is available. See cf::lock_acquire.
271 304
… …
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; 368}
336 }; 369
337 $TICK_WATCHER->stop; 370=item cf::periodic $interval, $cb
338 $guard 371
372Like EV::periodic, but randomly selects a starting point so that the actions
373get spread over timer.
374
375=cut
376
377sub periodic($$) {
378 my ($interval, $cb) = @_;
379
380 my $start = rand List::Util::min 180, $interval;
381
382 EV::periodic $start, $interval, 0, $cb
339} 383}
340 384
341=item cf::get_slot $time[, $priority[, $name]] 385=item cf::get_slot $time[, $priority[, $name]]
342 386
343Allocate $time seconds of blocking CPU time at priority C<$priority>: 387Allocate $time seconds of blocking CPU time at priority C<$priority>:
… …
422 466
423sub sync_job(&) { 467sub sync_job(&) {
424 my ($job) = @_; 468 my ($job) = @_;
425 469
426 if ($Coro::current == $Coro::main) { 470 if ($Coro::current == $Coro::main) {
427 my $time = Event::time; 471 my $time = EV::time;
428 472
429 # this is the main coro, too bad, we have to block 473 # this is the main coro, too bad, we have to block
430 # till the operation succeeds, freezing the server :/ 474 # till the operation succeeds, freezing the server :/
431 475
432 LOG llevError, Carp::longmess "sync job";#d# 476 LOG llevError, Carp::longmess "sync job";#d#
433 477
434 # TODO: use suspend/resume instead
435 # (but this is cancel-safe)
436 my $freeze_guard = freeze_mainloop; 478 my $freeze_guard = freeze_mainloop;
437 479
438 my $busy = 1; 480 my $busy = 1;
439 my @res; 481 my @res;
440 482
… …
447 489
448 while ($busy) { 490 while ($busy) {
449 if (Coro::nready) { 491 if (Coro::nready) {
450 Coro::cede_notself; 492 Coro::cede_notself;
451 } else { 493 } else {
452 Event::one_event; 494 EV::loop EV::LOOP_ONESHOT;
453 } 495 }
454 } 496 }
455 497
456 $time = Event::time - $time; 498 my $time = EV::time - $time;
457 499
458 LOG llevError | logBacktrace, Carp::longmess "long sync job"
459 if $time > $TICK * 0.5 && $TICK_WATCHER->is_active;
460
461 $tick_start += $time; # do not account sync jobs to server load 500 $TICK_START += $time; # do not account sync jobs to server load
462 501
463 wantarray ? @res : $res[0] 502 wantarray ? @res : $res[0]
464 } else { 503 } else {
465 # we are in another coroutine, how wonderful, everything just works 504 # we are in another coroutine, how wonderful, everything just works
466 505
… …
491=item fork_call { }, $args 530=item fork_call { }, $args
492 531
493Executes the given code block with the given arguments in a seperate 532Executes the given code block with the given arguments in a seperate
494process, returning the results. Everything must be serialisable with 533process, returning the results. Everything must be serialisable with
495Coro::Storable. May, of course, block. Note that the executed sub may 534Coro::Storable. May, of course, block. Note that the executed sub may
496never block itself or use any form of Event handling. 535never block itself or use any form of event handling.
497 536
498=cut 537=cut
499 538
500sub fork_call(&@) { 539sub fork_call(&@) {
501 my ($cb, @args) = @_; 540 my ($cb, @args) = @_;
… …
954 } 993 }
955 994
956 0 995 0
957} 996}
958 997
959=item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...) 998=item $bool = cf::global->invoke (EVENT_CLASS_XXX, ...)
960 999
961=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...) 1000=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...)
962 1001
963Generate an object-specific event with the given arguments. 1002Generate an object-specific event with the given arguments.
964 1003
… …
1042cf::attachable->attach ( 1081cf::attachable->attach (
1043 prio => -1000000, 1082 prio => -1000000,
1044 on_instantiate => sub { 1083 on_instantiate => sub {
1045 my ($obj, $data) = @_; 1084 my ($obj, $data) = @_;
1046 1085
1047 $data = from_json $data; 1086 $data = decode_json $data;
1048 1087
1049 for (@$data) { 1088 for (@$data) {
1050 my ($name, $args) = @$_; 1089 my ($name, $args) = @$_;
1051 1090
1052 $obj->attach ($name, %{$args || {} }); 1091 $obj->attach ($name, %{$args || {} });
… …
1289 my $msg = $@ ? "$v->{path}: $@\n" 1328 my $msg = $@ ? "$v->{path}: $@\n"
1290 : "$v->{base}: extension inactive.\n"; 1329 : "$v->{base}: extension inactive.\n";
1291 1330
1292 if (exists $v->{meta}{mandatory}) { 1331 if (exists $v->{meta}{mandatory}) {
1293 warn $msg; 1332 warn $msg;
1294 warn "mandatory extension failed to load, exiting.\n"; 1333 cf::cleanup "mandatory extension failed to load, exiting.";
1295 exit 1;
1296 } 1334 }
1297 1335
1298 warn $msg; 1336 warn $msg;
1299 } 1337 }
1300 1338
… …
2625 $rmp->{origin_y} = $exit->y; 2663 $rmp->{origin_y} = $exit->y;
2626 } 2664 }
2627 2665
2628 $rmp->{random_seed} ||= $exit->random_seed; 2666 $rmp->{random_seed} ||= $exit->random_seed;
2629 2667
2630 my $data = cf::to_json $rmp; 2668 my $data = cf::encode_json $rmp;
2631 my $md5 = Digest::MD5::md5_hex $data; 2669 my $md5 = Digest::MD5::md5_hex $data;
2632 my $meta = "$RANDOMDIR/$md5.meta"; 2670 my $meta = "$RANDOMDIR/$md5.meta";
2633 2671
2634 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) { 2672 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) {
2635 aio_write $fh, 0, (length $data), $data, 0; 2673 aio_write $fh, 0, (length $data), $data, 0;
… …
3135 { 3173 {
3136 my $faces = $facedata->{faceinfo}; 3174 my $faces = $facedata->{faceinfo};
3137 3175
3138 while (my ($face, $info) = each %$faces) { 3176 while (my ($face, $info) = each %$faces) {
3139 my $idx = (cf::face::find $face) || cf::face::alloc $face; 3177 my $idx = (cf::face::find $face) || cf::face::alloc $face;
3178
3140 cf::face::set_visibility $idx, $info->{visibility}; 3179 cf::face::set_visibility $idx, $info->{visibility};
3141 cf::face::set_magicmap $idx, $info->{magicmap}; 3180 cf::face::set_magicmap $idx, $info->{magicmap};
3142 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32}; 3181 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32};
3143 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64}; 3182 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64};
3144 3183
3145 cf::cede_to_tick; 3184 cf::cede_to_tick;
3146 } 3185 }
3147 3186
3148 while (my ($face, $info) = each %$faces) { 3187 while (my ($face, $info) = each %$faces) {
3149 next unless $info->{smooth}; 3188 next unless $info->{smooth};
3189
3150 my $idx = cf::face::find $face 3190 my $idx = cf::face::find $face
3151 or next; 3191 or next;
3192
3152 if (my $smooth = cf::face::find $info->{smooth}) { 3193 if (my $smooth = cf::face::find $info->{smooth}) {
3153 cf::face::set_smooth $idx, $smooth; 3194 cf::face::set_smooth $idx, $smooth;
3154 cf::face::set_smoothlevel $idx, $info->{smoothlevel}; 3195 cf::face::set_smoothlevel $idx, $info->{smoothlevel};
3155 } else { 3196 } else {
3156 warn "smooth face '$info->{smooth}' not found for face '$face'"; 3197 warn "smooth face '$info->{smooth}' not found for face '$face'";
… …
3174 { 3215 {
3175 # TODO: for gcfclient pleasure, we should give resources 3216 # TODO: for gcfclient pleasure, we should give resources
3176 # that gcfclient doesn't grok a >10000 face index. 3217 # that gcfclient doesn't grok a >10000 face index.
3177 my $res = $facedata->{resource}; 3218 my $res = $facedata->{resource};
3178 3219
3179 my $soundconf = delete $res->{"res/sound.conf"};
3180
3181 while (my ($name, $info) = each %$res) { 3220 while (my ($name, $info) = each %$res) {
3221 if (defined $info->{type}) {
3182 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3222 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3183 my $data; 3223 my $data;
3184 3224
3185 if ($info->{type} & 1) { 3225 if ($info->{type} & 1) {
3186 # prepend meta info 3226 # prepend meta info
3187 3227
3188 my $meta = $enc->encode ({ 3228 my $meta = $enc->encode ({
3189 name => $name, 3229 name => $name,
3190 %{ $info->{meta} || {} }, 3230 %{ $info->{meta} || {} },
3191 }); 3231 });
3192 3232
3193 $data = pack "(w/a*)*", $meta, $info->{data}; 3233 $data = pack "(w/a*)*", $meta, $info->{data};
3234 } else {
3235 $data = $info->{data};
3236 }
3237
3238 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
3239 cf::face::set_type $idx, $info->{type};
3194 } else { 3240 } else {
3195 $data = $info->{data}; 3241 $RESOURCE{$name} = $info;
3196 } 3242 }
3197 3243
3198 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
3199 cf::face::set_type $idx, $info->{type};
3200
3201 cf::cede_to_tick; 3244 cf::cede_to_tick;
3202 } 3245 }
3203
3204 if ($soundconf) {
3205 $soundconf = $enc->decode (delete $soundconf->{data});
3206
3207 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3208 my $sound = $soundconf->{compat}[$_]
3209 or next;
3210
3211 my $face = cf::face::find "sound/$sound->[1]";
3212 cf::sound::set $sound->[0] => $face;
3213 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3214 }
3215
3216 while (my ($k, $v) = each %{$soundconf->{event}}) {
3217 my $face = cf::face::find "sound/$v";
3218 cf::sound::set $k => $face;
3219 }
3220 }
3221 } 3246 }
3247
3248 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
3222 3249
3223 1 3250 1
3224} 3251}
3252
3253cf::global->attach (on_resource_update => sub {
3254 if (my $soundconf = $RESOURCE{"res/sound.conf"}) {
3255 $soundconf = JSON::XS->new->utf8->relaxed->decode ($soundconf->{data});
3256
3257 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3258 my $sound = $soundconf->{compat}[$_]
3259 or next;
3260
3261 my $face = cf::face::find "sound/$sound->[1]";
3262 cf::sound::set $sound->[0] => $face;
3263 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3264 }
3265
3266 while (my ($k, $v) = each %{$soundconf->{event}}) {
3267 my $face = cf::face::find "sound/$v";
3268 cf::sound::set $k => $face;
3269 }
3270 }
3271});
3225 3272
3226register_exticmd fx_want => sub { 3273register_exticmd fx_want => sub {
3227 my ($ns, $want) = @_; 3274 my ($ns, $want) = @_;
3228 3275
3229 while (my ($k, $v) = each %$want) { 3276 while (my ($k, $v) = each %$want) {
… …
3284sub reload_config { 3331sub reload_config {
3285 open my $fh, "<:utf8", "$CONFDIR/config" 3332 open my $fh, "<:utf8", "$CONFDIR/config"
3286 or return; 3333 or return;
3287 3334
3288 local $/; 3335 local $/;
3289 *CFG = YAML::Syck::Load <$fh>; 3336 *CFG = YAML::Load <$fh>;
3290 3337
3291 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3338 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
3292 3339
3293 $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};
3294 $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};
… …
3306 # we must not ever block the main coroutine 3353 # we must not ever block the main coroutine
3307 local $Coro::idle = sub { 3354 local $Coro::idle = sub {
3308 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 3355 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
3309 (async { 3356 (async {
3310 $Coro::current->{desc} = "IDLE BUG HANDLER"; 3357 $Coro::current->{desc} = "IDLE BUG HANDLER";
3311 Event::one_event; 3358 EV::loop EV::LOOP_ONESHOT;
3312 })->prio (Coro::PRIO_MAX); 3359 })->prio (Coro::PRIO_MAX);
3313 }; 3360 };
3314 3361
3315 reload_config; 3362 reload_config;
3316 db_init; 3363 db_init;
3317 load_extensions; 3364 load_extensions;
3318 3365
3319 $TICK_WATCHER->start; 3366 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3367 evthread_start;
3320 Event::loop; 3368 EV::loop;
3321} 3369}
3322 3370
3323############################################################################# 3371#############################################################################
3324# initialisation and cleanup 3372# initialisation and cleanup
3325 3373
3326# install some emergency cleanup handlers 3374# install some emergency cleanup handlers
3327BEGIN { 3375BEGIN {
3376 our %SIGWATCHER = ();
3328 for my $signal (qw(INT HUP TERM)) { 3377 for my $signal (qw(INT HUP TERM)) {
3329 Event->signal ( 3378 $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"; 3379 cf::cleanup "SIG$signal";
3336 },
3337 ); 3380 };
3338 } 3381 }
3339} 3382}
3340 3383
3341sub write_runtime { 3384sub write_runtime {
3342 my $runtime = "$LOCALDIR/runtime"; 3385 my $runtime = "$LOCALDIR/runtime";
… …
3436 warn "syncing database to disk"; 3479 warn "syncing database to disk";
3437 BDB::db_env_txn_checkpoint $DB_ENV; 3480 BDB::db_env_txn_checkpoint $DB_ENV;
3438 3481
3439 # if anything goes wrong in here, we should simply crash as we already saved 3482 # if anything goes wrong in here, we should simply crash as we already saved
3440 3483
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"; 3484 warn "flushing outstanding aio requests";
3447 for (;;) { 3485 for (;;) {
3448 BDB::flush; 3486 BDB::flush;
3449 IO::AIO::flush; 3487 IO::AIO::flush;
3450 Coro::cede_notself; 3488 Coro::cede_notself;
… …
3531 warn "leaving sync_job"; 3569 warn "leaving sync_job";
3532 3570
3533 1 3571 1
3534 } or do { 3572 } or do {
3535 warn $@; 3573 warn $@;
3536 warn "error while reloading, exiting."; 3574 cf::cleanup "error while reloading, exiting.";
3537 exit 1;
3538 }; 3575 };
3539 3576
3540 warn "reloaded"; 3577 warn "reloaded";
3541}; 3578};
3542 3579
… …
3544 3581
3545sub reload_perl() { 3582sub reload_perl() {
3546 # doing reload synchronously and two reloads happen back-to-back, 3583 # doing reload synchronously and two reloads happen back-to-back,
3547 # coro crashes during coro_state_free->destroy here. 3584 # coro crashes during coro_state_free->destroy here.
3548 3585
3549 $RELOAD_WATCHER ||= Event->timer ( 3586 $RELOAD_WATCHER ||= EV::timer 0, 0, sub {
3550 reentrant => 0,
3551 after => 0,
3552 data => WF_AUTOCANCEL,
3553 cb => sub {
3554 do_reload_perl; 3587 do_reload_perl;
3555 undef $RELOAD_WATCHER; 3588 undef $RELOAD_WATCHER;
3556 },
3557 ); 3589 };
3558} 3590}
3559 3591
3560register_command "reload" => sub { 3592register_command "reload" => sub {
3561 my ($who, $arg) = @_; 3593 my ($who, $arg) = @_;
3562 3594
… …
3575 3607
3576our @WAIT_FOR_TICK; 3608our @WAIT_FOR_TICK;
3577our @WAIT_FOR_TICK_BEGIN; 3609our @WAIT_FOR_TICK_BEGIN;
3578 3610
3579sub wait_for_tick { 3611sub wait_for_tick {
3580 return unless $TICK_WATCHER->is_active; 3612 return if tick_inhibit;
3581 return if $Coro::current == $Coro::main; 3613 return if $Coro::current == $Coro::main;
3582 3614
3583 my $signal = new Coro::Signal; 3615 my $signal = new Coro::Signal;
3584 push @WAIT_FOR_TICK, $signal; 3616 push @WAIT_FOR_TICK, $signal;
3585 $signal->wait; 3617 $signal->wait;
3586} 3618}
3587 3619
3588sub wait_for_tick_begin { 3620sub wait_for_tick_begin {
3589 return unless $TICK_WATCHER->is_active; 3621 return if tick_inhibit;
3590 return if $Coro::current == $Coro::main; 3622 return if $Coro::current == $Coro::main;
3591 3623
3592 my $signal = new Coro::Signal; 3624 my $signal = new Coro::Signal;
3593 push @WAIT_FOR_TICK_BEGIN, $signal; 3625 push @WAIT_FOR_TICK_BEGIN, $signal;
3594 $signal->wait; 3626 $signal->wait;
3595} 3627}
3596 3628
3597$TICK_WATCHER = Event->timer ( 3629sub tick {
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) { 3630 if ($Coro::current != $Coro::main) {
3605 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"
3606 unless ++$bug_warning > 10; 3632 unless ++$bug_warning > 10;
3607 return; 3633 return;
3608 } 3634 }
3609 3635
3610 $NOW = $tick_start = Event::time;
3611
3612 cf::server_tick; # one server iteration 3636 cf::server_tick; # one server iteration
3613 3637
3614 $RUNTIME += $TICK;
3615 $NEXT_TICK += $TICK;
3616
3617 if ($NOW >= $NEXT_RUNTIME_WRITE) { 3638 if ($NOW >= $NEXT_RUNTIME_WRITE) {
3618 $NEXT_RUNTIME_WRITE = $NOW + 10; 3639 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
3619 Coro::async_pool { 3640 Coro::async_pool {
3620 $Coro::current->{desc} = "runtime saver"; 3641 $Coro::current->{desc} = "runtime saver";
3621 write_runtime 3642 write_runtime
3622 or warn "ERROR: unable to write runtime file: $!"; 3643 or warn "ERROR: unable to write runtime file: $!";
3623 };
3624 } 3644 };
3645 }
3625 3646
3626 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) { 3647 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) {
3627 $sig->send; 3648 $sig->send;
3628 } 3649 }
3629 while (my $sig = shift @WAIT_FOR_TICK) { 3650 while (my $sig = shift @WAIT_FOR_TICK) {
3630 $sig->send; 3651 $sig->send;
3631 } 3652 }
3632 3653
3633 $NOW = Event::time; 3654 $LOAD = ($NOW - $TICK_START) / $TICK;
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;
3642 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25; 3655 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
3643 3656
3644 _post_tick; 3657 if (0) {
3658 if ($NEXT_TICK) {
3659 my $jitter = $TICK_START - $NEXT_TICK;
3660 $JITTER = $JITTER * 0.75 + $jitter * 0.25;
3661 warn "jitter $JITTER\n";#d#
3662 }
3645 }, 3663 }
3646); 3664}
3647 3665
3648{ 3666{
3667 # configure BDB
3668
3649 BDB::min_parallel 8; 3669 BDB::min_parallel 8;
3650 BDB::max_poll_time $TICK * 0.1; 3670 BDB::max_poll_reqs $TICK * 0.1;
3651 $BDB_POLL_WATCHER = Event->io ( 3671 $Coro::BDB::WATCHER->priority (1);
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 3672
3675 unless ($DB_ENV) { 3673 unless ($DB_ENV) {
3676 $DB_ENV = BDB::db_env_create; 3674 $DB_ENV = BDB::db_env_create;
3677 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC 3675 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC
3678 | BDB::LOG_AUTOREMOVE, 1); 3676 | BDB::LOG_AUTOREMOVE, 1);
… …
3693 3691
3694 cf::cleanup "db_env_open(db): $@" if $@; 3692 cf::cleanup "db_env_open(db): $@" if $@;
3695 }; 3693 };
3696 } 3694 }
3697 3695
3698 $BDB_DEADLOCK_WATCHER = Event->timer ( 3696 $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 { }; 3697 BDB::db_env_lock_detect $DB_ENV, 0, BDB::LOCK_DEFAULT, 0, sub { };
3706 },
3707 ); 3698 };
3708 $BDB_CHECKPOINT_WATCHER = Event->timer ( 3699 $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 { }; 3700 BDB::db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { };
3716 },
3717 ); 3701 };
3718 $BDB_TRICKLE_WATCHER = Event->timer ( 3702 $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 { }; 3703 BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { };
3726 },
3727 ); 3704 };
3728} 3705}
3729 3706
3730{ 3707{
3708 # configure IO::AIO
3709
3731 IO::AIO::min_parallel 8; 3710 IO::AIO::min_parallel 8;
3732
3733 undef $Coro::AIO::WATCHER;
3734 IO::AIO::max_poll_time $TICK * 0.1; 3711 IO::AIO::max_poll_time $TICK * 0.1;
3735 $AIO_POLL_WATCHER = Event->io ( 3712 $Coro::AIO::WATCHER->priority (1);
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} 3713}
3744 3714
3745my $_log_backtrace; 3715my $_log_backtrace;
3746 3716
3747sub _log_backtrace { 3717sub _log_backtrace {

Diff Legend

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