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.393 by root, Fri Oct 26 04:47:00 2007 UTC vs.
Revision 1.415 by root, Thu Apr 10 15:35:16 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 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.1 (); 36use Coro 4.50 ();
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>:
… …
406 450
407BEGIN { *async = \&Coro::async_pool } 451BEGIN { *async = \&Coro::async_pool }
408 452
409=item cf::sync_job { BLOCK } 453=item cf::sync_job { BLOCK }
410 454
411The design of Crossfire TRT requires that the main coroutine ($Coro::main) 455The design of Deliantra requires that the main coroutine ($Coro::main)
412is always able to handle events or runnable, as Crossfire TRT is only 456is always able to handle events or runnable, as Deliantra is only
413partly reentrant. Thus "blocking" it by e.g. waiting for I/O is not 457partly reentrant. Thus "blocking" it by e.g. waiting for I/O is not
414acceptable. 458acceptable.
415 459
416If it must be done, put the blocking parts into C<sync_job>. This will run 460If it must be done, put the blocking parts into C<sync_job>. This will run
417the given BLOCK in another coroutine while waiting for the result. The 461the given BLOCK in another coroutine while waiting for the result. The
… …
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) = @_;
… …
508 reset_signals; 547 reset_signals;
509 &$cb 548 &$cb
510 }, @args; 549 }, @args;
511 550
512 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
513} 579}
514 580
515=item $value = cf::db_get $family => $key 581=item $value = cf::db_get $family => $key
516 582
517Returns a single value from the environment database. 583Returns a single value from the environment database.
… …
662attach callbacks/event handlers (a collection of which is called an "attachment") 728attach callbacks/event handlers (a collection of which is called an "attachment")
663to it. All such attachable objects support the following methods. 729to it. All such attachable objects support the following methods.
664 730
665In the following description, CLASS can be any of C<global>, C<object> 731In the following description, CLASS can be any of C<global>, C<object>
666C<player>, C<client> or C<map> (i.e. the attachable objects in 732C<player>, C<client> or C<map> (i.e. the attachable objects in
667Crossfire TRT). 733Deliantra).
668 734
669=over 4 735=over 4
670 736
671=item $attachable->attach ($attachment, key => $value...) 737=item $attachable->attach ($attachment, key => $value...)
672 738
… …
954 } 1020 }
955 1021
956 0 1022 0
957} 1023}
958 1024
959=item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...) 1025=item $bool = cf::global->invoke (EVENT_CLASS_XXX, ...)
960 1026
961=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...) 1027=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...)
962 1028
963Generate an object-specific event with the given arguments. 1029Generate an object-specific event with the given arguments.
964 1030
… …
1042cf::attachable->attach ( 1108cf::attachable->attach (
1043 prio => -1000000, 1109 prio => -1000000,
1044 on_instantiate => sub { 1110 on_instantiate => sub {
1045 my ($obj, $data) = @_; 1111 my ($obj, $data) = @_;
1046 1112
1047 $data = from_json $data; 1113 $data = decode_json $data;
1048 1114
1049 for (@$data) { 1115 for (@$data) {
1050 my ($name, $args) = @$_; 1116 my ($name, $args) = @$_;
1051 1117
1052 $obj->attach ($name, %{$args || {} }); 1118 $obj->attach ($name, %{$args || {} });
… …
1289 my $msg = $@ ? "$v->{path}: $@\n" 1355 my $msg = $@ ? "$v->{path}: $@\n"
1290 : "$v->{base}: extension inactive.\n"; 1356 : "$v->{base}: extension inactive.\n";
1291 1357
1292 if (exists $v->{meta}{mandatory}) { 1358 if (exists $v->{meta}{mandatory}) {
1293 warn $msg; 1359 warn $msg;
1294 warn "mandatory extension failed to load, exiting.\n"; 1360 cf::cleanup "mandatory extension failed to load, exiting.";
1295 exit 1;
1296 } 1361 }
1297 1362
1298 warn $msg; 1363 warn $msg;
1299 } 1364 }
1300 1365
… …
2312 : () 2377 : ()
2313 } @{ aio_readdir $UNIQUEDIR or [] } 2378 } @{ aio_readdir $UNIQUEDIR or [] }
2314 ] 2379 ]
2315} 2380}
2316 2381
2317package cf;
2318
2319=back 2382=back
2320 2383
2321=head3 cf::object 2384=head3 cf::object
2322 2385
2323=cut 2386=cut
… …
2625 $rmp->{origin_y} = $exit->y; 2688 $rmp->{origin_y} = $exit->y;
2626 } 2689 }
2627 2690
2628 $rmp->{random_seed} ||= $exit->random_seed; 2691 $rmp->{random_seed} ||= $exit->random_seed;
2629 2692
2630 my $data = cf::to_json $rmp; 2693 my $data = cf::encode_json $rmp;
2631 my $md5 = Digest::MD5::md5_hex $data; 2694 my $md5 = Digest::MD5::md5_hex $data;
2632 my $meta = "$RANDOMDIR/$md5.meta"; 2695 my $meta = "$RANDOMDIR/$md5.meta";
2633 2696
2634 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) { 2697 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) {
2635 aio_write $fh, 0, (length $data), $data, 0; 2698 aio_write $fh, 0, (length $data), $data, 0;
… …
3135 { 3198 {
3136 my $faces = $facedata->{faceinfo}; 3199 my $faces = $facedata->{faceinfo};
3137 3200
3138 while (my ($face, $info) = each %$faces) { 3201 while (my ($face, $info) = each %$faces) {
3139 my $idx = (cf::face::find $face) || cf::face::alloc $face; 3202 my $idx = (cf::face::find $face) || cf::face::alloc $face;
3203
3140 cf::face::set_visibility $idx, $info->{visibility}; 3204 cf::face::set_visibility $idx, $info->{visibility};
3141 cf::face::set_magicmap $idx, $info->{magicmap}; 3205 cf::face::set_magicmap $idx, $info->{magicmap};
3142 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32}; 3206 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}; 3207 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64};
3144 3208
3145 cf::cede_to_tick; 3209 cf::cede_to_tick;
3146 } 3210 }
3147 3211
3148 while (my ($face, $info) = each %$faces) { 3212 while (my ($face, $info) = each %$faces) {
3149 next unless $info->{smooth}; 3213 next unless $info->{smooth};
3214
3150 my $idx = cf::face::find $face 3215 my $idx = cf::face::find $face
3151 or next; 3216 or next;
3217
3152 if (my $smooth = cf::face::find $info->{smooth}) { 3218 if (my $smooth = cf::face::find $info->{smooth}) {
3153 cf::face::set_smooth $idx, $smooth; 3219 cf::face::set_smooth $idx, $smooth;
3154 cf::face::set_smoothlevel $idx, $info->{smoothlevel}; 3220 cf::face::set_smoothlevel $idx, $info->{smoothlevel};
3155 } else { 3221 } else {
3156 warn "smooth face '$info->{smooth}' not found for face '$face'"; 3222 warn "smooth face '$info->{smooth}' not found for face '$face'";
… …
3174 { 3240 {
3175 # TODO: for gcfclient pleasure, we should give resources 3241 # TODO: for gcfclient pleasure, we should give resources
3176 # that gcfclient doesn't grok a >10000 face index. 3242 # that gcfclient doesn't grok a >10000 face index.
3177 my $res = $facedata->{resource}; 3243 my $res = $facedata->{resource};
3178 3244
3179 my $soundconf = delete $res->{"res/sound.conf"};
3180
3181 while (my ($name, $info) = each %$res) { 3245 while (my ($name, $info) = each %$res) {
3246 if (defined $info->{type}) {
3182 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3247 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3183 my $data; 3248 my $data;
3184 3249
3185 if ($info->{type} & 1) { 3250 if ($info->{type} & 1) {
3186 # prepend meta info 3251 # prepend meta info
3187 3252
3188 my $meta = $enc->encode ({ 3253 my $meta = $enc->encode ({
3189 name => $name, 3254 name => $name,
3190 %{ $info->{meta} || {} }, 3255 %{ $info->{meta} || {} },
3191 }); 3256 });
3192 3257
3193 $data = pack "(w/a*)*", $meta, $info->{data}; 3258 $data = pack "(w/a*)*", $meta, $info->{data};
3259 } else {
3260 $data = $info->{data};
3261 }
3262
3263 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
3264 cf::face::set_type $idx, $info->{type};
3194 } else { 3265 } else {
3195 $data = $info->{data}; 3266 $RESOURCE{$name} = $info;
3196 } 3267 }
3197 3268
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; 3269 cf::cede_to_tick;
3202 } 3270 }
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 } 3271 }
3272
3273 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
3222 3274
3223 1 3275 1
3224} 3276}
3277
3278cf::global->attach (on_resource_update => sub {
3279 if (my $soundconf = $RESOURCE{"res/sound.conf"}) {
3280 $soundconf = JSON::XS->new->utf8->relaxed->decode ($soundconf->{data});
3281
3282 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3283 my $sound = $soundconf->{compat}[$_]
3284 or next;
3285
3286 my $face = cf::face::find "sound/$sound->[1]";
3287 cf::sound::set $sound->[0] => $face;
3288 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3289 }
3290
3291 while (my ($k, $v) = each %{$soundconf->{event}}) {
3292 my $face = cf::face::find "sound/$v";
3293 cf::sound::set $k => $face;
3294 }
3295 }
3296});
3225 3297
3226register_exticmd fx_want => sub { 3298register_exticmd fx_want => sub {
3227 my ($ns, $want) = @_; 3299 my ($ns, $want) = @_;
3228 3300
3229 while (my ($k, $v) = each %$want) { 3301 while (my ($k, $v) = each %$want) {
… …
3284sub reload_config { 3356sub reload_config {
3285 open my $fh, "<:utf8", "$CONFDIR/config" 3357 open my $fh, "<:utf8", "$CONFDIR/config"
3286 or return; 3358 or return;
3287 3359
3288 local $/; 3360 local $/;
3289 *CFG = YAML::Syck::Load <$fh>; 3361 *CFG = YAML::Load <$fh>;
3290 3362
3291 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3363 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
3292 3364
3293 $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};
3294 $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};
… …
3306 # we must not ever block the main coroutine 3378 # we must not ever block the main coroutine
3307 local $Coro::idle = sub { 3379 local $Coro::idle = sub {
3308 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 3380 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
3309 (async { 3381 (async {
3310 $Coro::current->{desc} = "IDLE BUG HANDLER"; 3382 $Coro::current->{desc} = "IDLE BUG HANDLER";
3311 Event::one_event; 3383 EV::loop EV::LOOP_ONESHOT;
3312 })->prio (Coro::PRIO_MAX); 3384 })->prio (Coro::PRIO_MAX);
3313 }; 3385 };
3314 3386
3315 reload_config; 3387 reload_config;
3316 db_init; 3388 db_init;
3317 load_extensions; 3389 load_extensions;
3318 3390
3319 $TICK_WATCHER->start; 3391 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3392 evthread_start IO::AIO::poll_fileno;
3320 Event::loop; 3393 EV::loop;
3321} 3394}
3322 3395
3323############################################################################# 3396#############################################################################
3324# initialisation and cleanup 3397# initialisation and cleanup
3325 3398
3326# install some emergency cleanup handlers 3399# install some emergency cleanup handlers
3327BEGIN { 3400BEGIN {
3401 our %SIGWATCHER = ();
3328 for my $signal (qw(INT HUP TERM)) { 3402 for my $signal (qw(INT HUP TERM)) {
3329 Event->signal ( 3403 $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"; 3404 cf::cleanup "SIG$signal";
3336 },
3337 ); 3405 };
3338 } 3406 }
3339} 3407}
3340 3408
3341sub write_runtime { 3409sub write_runtime {
3342 my $runtime = "$LOCALDIR/runtime"; 3410 my $runtime = "$LOCALDIR/runtime";
… …
3436 warn "syncing database to disk"; 3504 warn "syncing database to disk";
3437 BDB::db_env_txn_checkpoint $DB_ENV; 3505 BDB::db_env_txn_checkpoint $DB_ENV;
3438 3506
3439 # if anything goes wrong in here, we should simply crash as we already saved 3507 # if anything goes wrong in here, we should simply crash as we already saved
3440 3508
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"; 3509 warn "flushing outstanding aio requests";
3447 for (;;) { 3510 for (;;) {
3448 BDB::flush; 3511 BDB::flush;
3449 IO::AIO::flush; 3512 IO::AIO::flush;
3450 Coro::cede_notself; 3513 Coro::cede_notself;
… …
3531 warn "leaving sync_job"; 3594 warn "leaving sync_job";
3532 3595
3533 1 3596 1
3534 } or do { 3597 } or do {
3535 warn $@; 3598 warn $@;
3536 warn "error while reloading, exiting."; 3599 cf::cleanup "error while reloading, exiting.";
3537 exit 1;
3538 }; 3600 };
3539 3601
3540 warn "reloaded"; 3602 warn "reloaded";
3541}; 3603};
3542 3604
… …
3544 3606
3545sub reload_perl() { 3607sub reload_perl() {
3546 # doing reload synchronously and two reloads happen back-to-back, 3608 # doing reload synchronously and two reloads happen back-to-back,
3547 # coro crashes during coro_state_free->destroy here. 3609 # coro crashes during coro_state_free->destroy here.
3548 3610
3549 $RELOAD_WATCHER ||= Event->timer ( 3611 $RELOAD_WATCHER ||= EV::timer 0, 0, sub {
3550 reentrant => 0,
3551 after => 0,
3552 data => WF_AUTOCANCEL,
3553 cb => sub {
3554 do_reload_perl; 3612 do_reload_perl;
3555 undef $RELOAD_WATCHER; 3613 undef $RELOAD_WATCHER;
3556 },
3557 ); 3614 };
3558} 3615}
3559 3616
3560register_command "reload" => sub { 3617register_command "reload" => sub {
3561 my ($who, $arg) = @_; 3618 my ($who, $arg) = @_;
3562 3619
… …
3575 3632
3576our @WAIT_FOR_TICK; 3633our @WAIT_FOR_TICK;
3577our @WAIT_FOR_TICK_BEGIN; 3634our @WAIT_FOR_TICK_BEGIN;
3578 3635
3579sub wait_for_tick { 3636sub wait_for_tick {
3580 return unless $TICK_WATCHER->is_active; 3637 return if tick_inhibit;
3581 return if $Coro::current == $Coro::main; 3638 return if $Coro::current == $Coro::main;
3582 3639
3583 my $signal = new Coro::Signal; 3640 my $signal = new Coro::Signal;
3584 push @WAIT_FOR_TICK, $signal; 3641 push @WAIT_FOR_TICK, $signal;
3585 $signal->wait; 3642 $signal->wait;
3586} 3643}
3587 3644
3588sub wait_for_tick_begin { 3645sub wait_for_tick_begin {
3589 return unless $TICK_WATCHER->is_active; 3646 return if tick_inhibit;
3590 return if $Coro::current == $Coro::main; 3647 return if $Coro::current == $Coro::main;
3591 3648
3592 my $signal = new Coro::Signal; 3649 my $signal = new Coro::Signal;
3593 push @WAIT_FOR_TICK_BEGIN, $signal; 3650 push @WAIT_FOR_TICK_BEGIN, $signal;
3594 $signal->wait; 3651 $signal->wait;
3595} 3652}
3596 3653
3597$TICK_WATCHER = Event->timer ( 3654sub 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) { 3655 if ($Coro::current != $Coro::main) {
3605 Carp::cluck "major BUG: server tick called outside of main coro, skipping it" 3656 Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
3606 unless ++$bug_warning > 10; 3657 unless ++$bug_warning > 10;
3607 return; 3658 return;
3608 } 3659 }
3609 3660
3610 $NOW = $tick_start = Event::time;
3611
3612 cf::server_tick; # one server iteration 3661 cf::server_tick; # one server iteration
3613 3662
3614 $RUNTIME += $TICK;
3615 $NEXT_TICK += $TICK;
3616
3617 if ($NOW >= $NEXT_RUNTIME_WRITE) { 3663 if ($NOW >= $NEXT_RUNTIME_WRITE) {
3618 $NEXT_RUNTIME_WRITE = $NOW + 10; 3664 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
3619 Coro::async_pool { 3665 Coro::async_pool {
3620 $Coro::current->{desc} = "runtime saver"; 3666 $Coro::current->{desc} = "runtime saver";
3621 write_runtime 3667 write_runtime
3622 or warn "ERROR: unable to write runtime file: $!"; 3668 or warn "ERROR: unable to write runtime file: $!";
3623 };
3624 } 3669 };
3670 }
3625 3671
3626 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) { 3672 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) {
3627 $sig->send; 3673 $sig->send;
3628 } 3674 }
3629 while (my $sig = shift @WAIT_FOR_TICK) { 3675 while (my $sig = shift @WAIT_FOR_TICK) {
3630 $sig->send; 3676 $sig->send;
3631 } 3677 }
3632 3678
3633 $NOW = Event::time; 3679 $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; 3680 $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
3643 3681
3644 _post_tick; 3682 if (0) {
3683 if ($NEXT_TICK) {
3684 my $jitter = $TICK_START - $NEXT_TICK;
3685 $JITTER = $JITTER * 0.75 + $jitter * 0.25;
3686 warn "jitter $JITTER\n";#d#
3687 }
3645 }, 3688 }
3646); 3689}
3647 3690
3648{ 3691{
3692 # configure BDB
3693
3649 BDB::min_parallel 8; 3694 BDB::min_parallel 8;
3650 BDB::max_poll_time $TICK * 0.1; 3695 BDB::max_poll_reqs $TICK * 0.1;
3651 $BDB_POLL_WATCHER = Event->io ( 3696 $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 3697
3675 unless ($DB_ENV) { 3698 unless ($DB_ENV) {
3676 $DB_ENV = BDB::db_env_create; 3699 $DB_ENV = BDB::db_env_create;
3677 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC 3700 $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC
3678 | BDB::LOG_AUTOREMOVE, 1); 3701 | BDB::LOG_AUTOREMOVE, 1);
… …
3693 3716
3694 cf::cleanup "db_env_open(db): $@" if $@; 3717 cf::cleanup "db_env_open(db): $@" if $@;
3695 }; 3718 };
3696 } 3719 }
3697 3720
3698 $BDB_DEADLOCK_WATCHER = Event->timer ( 3721 $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 { }; 3722 BDB::db_env_lock_detect $DB_ENV, 0, BDB::LOCK_DEFAULT, 0, sub { };
3706 },
3707 ); 3723 };
3708 $BDB_CHECKPOINT_WATCHER = Event->timer ( 3724 $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 { }; 3725 BDB::db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { };
3716 },
3717 ); 3726 };
3718 $BDB_TRICKLE_WATCHER = Event->timer ( 3727 $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 { }; 3728 BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { };
3726 },
3727 ); 3729 };
3728} 3730}
3729 3731
3730{ 3732{
3733 # configure IO::AIO
3734
3731 IO::AIO::min_parallel 8; 3735 IO::AIO::min_parallel 8;
3732
3733 undef $Coro::AIO::WATCHER;
3734 IO::AIO::max_poll_time $TICK * 0.1; 3736 IO::AIO::max_poll_time $TICK * 0.1;
3735 $AIO_POLL_WATCHER = Event->io ( 3737 $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} 3738}
3744 3739
3745my $_log_backtrace; 3740my $_log_backtrace;
3746 3741
3747sub _log_backtrace { 3742sub _log_backtrace {

Diff Legend

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