… | |
… | |
4 | use strict; |
4 | use strict; |
5 | |
5 | |
6 | use Symbol; |
6 | use Symbol; |
7 | use List::Util; |
7 | use List::Util; |
8 | use Socket; |
8 | use Socket; |
9 | use EV; |
9 | use EV 1.86; |
10 | use Opcode; |
10 | use Opcode; |
11 | use Safe; |
11 | use Safe; |
12 | use Safe::Hole; |
12 | use Safe::Hole; |
13 | use Storable (); |
13 | use Storable (); |
14 | |
14 | |
15 | use Coro 4.1 (); |
15 | use Coro 4.32 (); |
16 | use Coro::State; |
16 | use Coro::State; |
17 | use Coro::Handle; |
17 | use Coro::Handle; |
18 | use Coro::EV; |
18 | use Coro::EV; |
19 | use Coro::Timer; |
19 | use Coro::Timer; |
20 | use Coro::Signal; |
20 | use Coro::Signal; |
21 | use Coro::Semaphore; |
21 | use Coro::Semaphore; |
22 | use Coro::AIO; |
22 | use Coro::AIO; |
|
|
23 | use Coro::BDB; |
23 | use Coro::Storable; |
24 | use Coro::Storable; |
24 | use Coro::Util (); |
25 | use Coro::Util (); |
25 | |
26 | |
26 | use JSON::XS (); |
27 | use JSON::XS 2.01 (); |
27 | use BDB (); |
28 | use BDB (); |
28 | use Data::Dumper; |
29 | use Data::Dumper; |
29 | use Digest::MD5; |
30 | use Digest::MD5; |
30 | use Fcntl; |
31 | use Fcntl; |
31 | use YAML::Syck (); |
32 | use YAML::Syck (); |
… | |
… | |
68 | our $TMPDIR = "$LOCALDIR/" . tmpdir; |
69 | our $TMPDIR = "$LOCALDIR/" . tmpdir; |
69 | our $UNIQUEDIR = "$LOCALDIR/" . uniquedir; |
70 | our $UNIQUEDIR = "$LOCALDIR/" . uniquedir; |
70 | our $PLAYERDIR = "$LOCALDIR/" . playerdir; |
71 | our $PLAYERDIR = "$LOCALDIR/" . playerdir; |
71 | our $RANDOMDIR = "$LOCALDIR/random"; |
72 | our $RANDOMDIR = "$LOCALDIR/random"; |
72 | our $BDBDIR = "$LOCALDIR/db"; |
73 | our $BDBDIR = "$LOCALDIR/db"; |
|
|
74 | our %RESOURCE; |
73 | |
75 | |
74 | our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) |
76 | our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) |
75 | our $TICK_WATCHER; |
77 | our $TICK_WATCHER; |
76 | our $AIO_POLL_WATCHER; |
78 | our $AIO_POLL_WATCHER; |
77 | our $NEXT_RUNTIME_WRITE; # when should the runtime file be written |
79 | our $NEXT_RUNTIME_WRITE; # when should the runtime file be written |
78 | our $NEXT_TICK; |
80 | our $NEXT_TICK; |
79 | our $NOW; |
|
|
80 | our $USE_FSYNC = 1; # use fsync to write maps - default off |
81 | our $USE_FSYNC = 1; # use fsync to write maps - default off |
81 | |
82 | |
82 | our $BDB_POLL_WATCHER; |
83 | our $BDB_POLL_WATCHER; |
83 | our $BDB_DEADLOCK_WATCHER; |
84 | our $BDB_DEADLOCK_WATCHER; |
84 | our $BDB_CHECKPOINT_WATCHER; |
85 | our $BDB_CHECKPOINT_WATCHER; |
… | |
… | |
87 | |
88 | |
88 | our %CFG; |
89 | our %CFG; |
89 | |
90 | |
90 | our $UPTIME; $UPTIME ||= time; |
91 | our $UPTIME; $UPTIME ||= time; |
91 | our $RUNTIME; |
92 | our $RUNTIME; |
|
|
93 | our $NOW; |
92 | |
94 | |
93 | our (%PLAYER, %PLAYER_LOADING); # all users |
95 | our (%PLAYER, %PLAYER_LOADING); # all users |
94 | our (%MAP, %MAP_LOADING ); # all maps |
96 | our (%MAP, %MAP_LOADING ); # all maps |
95 | our $LINK_MAP; # the special {link} map, which is always available |
97 | our $LINK_MAP; # the special {link} map, which is always available |
96 | |
98 | |
… | |
… | |
246 | $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge; |
248 | $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge; |
247 | $d |
249 | $d |
248 | } || "[unable to dump $_[0]: '$@']"; |
250 | } || "[unable to dump $_[0]: '$@']"; |
249 | } |
251 | } |
250 | |
252 | |
251 | =item $ref = cf::from_json $json |
253 | =item $ref = cf::decode_json $json |
252 | |
254 | |
253 | Converts a JSON string into the corresponding perl data structure. |
255 | Converts a JSON string into the corresponding perl data structure. |
254 | |
256 | |
255 | =item $json = cf::to_json $ref |
257 | =item $json = cf::encode_json $ref |
256 | |
258 | |
257 | Converts a perl data structure into its JSON representation. |
259 | Converts a perl data structure into its JSON representation. |
258 | |
260 | |
259 | =cut |
261 | =cut |
260 | |
262 | |
261 | our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max |
263 | our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max |
262 | |
264 | |
263 | sub to_json ($) { $json_coder->encode ($_[0]) } |
265 | sub encode_json($) { $json_coder->encode ($_[0]) } |
264 | sub from_json ($) { $json_coder->decode ($_[0]) } |
266 | sub decode_json($) { $json_coder->decode ($_[0]) } |
265 | |
267 | |
266 | =item cf::lock_wait $string |
268 | =item cf::lock_wait $string |
267 | |
269 | |
268 | Wait until the given lock is available. See cf::lock_acquire. |
270 | Wait until the given lock is available. See cf::lock_acquire. |
269 | |
271 | |
… | |
… | |
967 | } |
969 | } |
968 | |
970 | |
969 | 0 |
971 | 0 |
970 | } |
972 | } |
971 | |
973 | |
972 | =item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...) |
974 | =item $bool = cf::global->invoke (EVENT_CLASS_XXX, ...) |
973 | |
975 | |
974 | =item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...) |
976 | =item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...) |
975 | |
977 | |
976 | Generate an object-specific event with the given arguments. |
978 | Generate an object-specific event with the given arguments. |
977 | |
979 | |
… | |
… | |
1055 | cf::attachable->attach ( |
1057 | cf::attachable->attach ( |
1056 | prio => -1000000, |
1058 | prio => -1000000, |
1057 | on_instantiate => sub { |
1059 | on_instantiate => sub { |
1058 | my ($obj, $data) = @_; |
1060 | my ($obj, $data) = @_; |
1059 | |
1061 | |
1060 | $data = from_json $data; |
1062 | $data = decode_json $data; |
1061 | |
1063 | |
1062 | for (@$data) { |
1064 | for (@$data) { |
1063 | my ($name, $args) = @$_; |
1065 | my ($name, $args) = @$_; |
1064 | |
1066 | |
1065 | $obj->attach ($name, %{$args || {} }); |
1067 | $obj->attach ($name, %{$args || {} }); |
… | |
… | |
2638 | $rmp->{origin_y} = $exit->y; |
2640 | $rmp->{origin_y} = $exit->y; |
2639 | } |
2641 | } |
2640 | |
2642 | |
2641 | $rmp->{random_seed} ||= $exit->random_seed; |
2643 | $rmp->{random_seed} ||= $exit->random_seed; |
2642 | |
2644 | |
2643 | my $data = cf::to_json $rmp; |
2645 | my $data = cf::encode_json $rmp; |
2644 | my $md5 = Digest::MD5::md5_hex $data; |
2646 | my $md5 = Digest::MD5::md5_hex $data; |
2645 | my $meta = "$RANDOMDIR/$md5.meta"; |
2647 | my $meta = "$RANDOMDIR/$md5.meta"; |
2646 | |
2648 | |
2647 | if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) { |
2649 | if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) { |
2648 | aio_write $fh, 0, (length $data), $data, 0; |
2650 | aio_write $fh, 0, (length $data), $data, 0; |
… | |
… | |
3148 | { |
3150 | { |
3149 | my $faces = $facedata->{faceinfo}; |
3151 | my $faces = $facedata->{faceinfo}; |
3150 | |
3152 | |
3151 | while (my ($face, $info) = each %$faces) { |
3153 | while (my ($face, $info) = each %$faces) { |
3152 | my $idx = (cf::face::find $face) || cf::face::alloc $face; |
3154 | my $idx = (cf::face::find $face) || cf::face::alloc $face; |
|
|
3155 | |
3153 | cf::face::set_visibility $idx, $info->{visibility}; |
3156 | cf::face::set_visibility $idx, $info->{visibility}; |
3154 | cf::face::set_magicmap $idx, $info->{magicmap}; |
3157 | cf::face::set_magicmap $idx, $info->{magicmap}; |
3155 | cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32}; |
3158 | cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32}; |
3156 | cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64}; |
3159 | cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64}; |
3157 | |
3160 | |
3158 | cf::cede_to_tick; |
3161 | cf::cede_to_tick; |
3159 | } |
3162 | } |
3160 | |
3163 | |
3161 | while (my ($face, $info) = each %$faces) { |
3164 | while (my ($face, $info) = each %$faces) { |
3162 | next unless $info->{smooth}; |
3165 | next unless $info->{smooth}; |
|
|
3166 | |
3163 | my $idx = cf::face::find $face |
3167 | my $idx = cf::face::find $face |
3164 | or next; |
3168 | or next; |
|
|
3169 | |
3165 | if (my $smooth = cf::face::find $info->{smooth}) { |
3170 | if (my $smooth = cf::face::find $info->{smooth}) { |
3166 | cf::face::set_smooth $idx, $smooth; |
3171 | cf::face::set_smooth $idx, $smooth; |
3167 | cf::face::set_smoothlevel $idx, $info->{smoothlevel}; |
3172 | cf::face::set_smoothlevel $idx, $info->{smoothlevel}; |
3168 | } else { |
3173 | } else { |
3169 | warn "smooth face '$info->{smooth}' not found for face '$face'"; |
3174 | warn "smooth face '$info->{smooth}' not found for face '$face'"; |
… | |
… | |
3187 | { |
3192 | { |
3188 | # TODO: for gcfclient pleasure, we should give resources |
3193 | # TODO: for gcfclient pleasure, we should give resources |
3189 | # that gcfclient doesn't grok a >10000 face index. |
3194 | # that gcfclient doesn't grok a >10000 face index. |
3190 | my $res = $facedata->{resource}; |
3195 | my $res = $facedata->{resource}; |
3191 | |
3196 | |
3192 | my $soundconf = delete $res->{"res/sound.conf"}; |
|
|
3193 | |
|
|
3194 | while (my ($name, $info) = each %$res) { |
3197 | while (my ($name, $info) = each %$res) { |
|
|
3198 | if (defined $info->{type}) { |
3195 | my $idx = (cf::face::find $name) || cf::face::alloc $name; |
3199 | my $idx = (cf::face::find $name) || cf::face::alloc $name; |
3196 | my $data; |
3200 | my $data; |
3197 | |
3201 | |
3198 | if ($info->{type} & 1) { |
3202 | if ($info->{type} & 1) { |
3199 | # prepend meta info |
3203 | # prepend meta info |
3200 | |
3204 | |
3201 | my $meta = $enc->encode ({ |
3205 | my $meta = $enc->encode ({ |
3202 | name => $name, |
3206 | name => $name, |
3203 | %{ $info->{meta} || {} }, |
3207 | %{ $info->{meta} || {} }, |
3204 | }); |
3208 | }); |
3205 | |
3209 | |
3206 | $data = pack "(w/a*)*", $meta, $info->{data}; |
3210 | $data = pack "(w/a*)*", $meta, $info->{data}; |
|
|
3211 | } else { |
|
|
3212 | $data = $info->{data}; |
|
|
3213 | } |
|
|
3214 | |
|
|
3215 | cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data; |
|
|
3216 | cf::face::set_type $idx, $info->{type}; |
3207 | } else { |
3217 | } else { |
3208 | $data = $info->{data}; |
3218 | $RESOURCE{$name} = $info; |
3209 | } |
3219 | } |
3210 | |
3220 | |
3211 | cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data; |
|
|
3212 | cf::face::set_type $idx, $info->{type}; |
|
|
3213 | |
|
|
3214 | cf::cede_to_tick; |
3221 | cf::cede_to_tick; |
3215 | } |
3222 | } |
3216 | |
|
|
3217 | if ($soundconf) { |
|
|
3218 | $soundconf = $enc->decode (delete $soundconf->{data}); |
|
|
3219 | |
|
|
3220 | for (0 .. SOUND_CAST_SPELL_0 - 1) { |
|
|
3221 | my $sound = $soundconf->{compat}[$_] |
|
|
3222 | or next; |
|
|
3223 | |
|
|
3224 | my $face = cf::face::find "sound/$sound->[1]"; |
|
|
3225 | cf::sound::set $sound->[0] => $face; |
|
|
3226 | cf::sound::old_sound_index $_, $face; # gcfclient-compat |
|
|
3227 | } |
|
|
3228 | |
|
|
3229 | while (my ($k, $v) = each %{$soundconf->{event}}) { |
|
|
3230 | my $face = cf::face::find "sound/$v"; |
|
|
3231 | cf::sound::set $k => $face; |
|
|
3232 | } |
|
|
3233 | } |
|
|
3234 | } |
3223 | } |
|
|
3224 | |
|
|
3225 | cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE); |
3235 | |
3226 | |
3236 | 1 |
3227 | 1 |
3237 | } |
3228 | } |
|
|
3229 | |
|
|
3230 | cf::global->attach (on_resource_update => sub { |
|
|
3231 | if (my $soundconf = $RESOURCE{"res/sound.conf"}) { |
|
|
3232 | $soundconf = JSON::XS->new->utf8->relaxed->decode ($soundconf->{data}); |
|
|
3233 | |
|
|
3234 | for (0 .. SOUND_CAST_SPELL_0 - 1) { |
|
|
3235 | my $sound = $soundconf->{compat}[$_] |
|
|
3236 | or next; |
|
|
3237 | |
|
|
3238 | my $face = cf::face::find "sound/$sound->[1]"; |
|
|
3239 | cf::sound::set $sound->[0] => $face; |
|
|
3240 | cf::sound::old_sound_index $_, $face; # gcfclient-compat |
|
|
3241 | } |
|
|
3242 | |
|
|
3243 | while (my ($k, $v) = each %{$soundconf->{event}}) { |
|
|
3244 | my $face = cf::face::find "sound/$v"; |
|
|
3245 | cf::sound::set $k => $face; |
|
|
3246 | } |
|
|
3247 | } |
|
|
3248 | }); |
3238 | |
3249 | |
3239 | register_exticmd fx_want => sub { |
3250 | register_exticmd fx_want => sub { |
3240 | my ($ns, $want) = @_; |
3251 | my ($ns, $want) = @_; |
3241 | |
3252 | |
3242 | while (my ($k, $v) = each %$want) { |
3253 | while (my ($k, $v) = each %$want) { |
… | |
… | |
3328 | reload_config; |
3339 | reload_config; |
3329 | db_init; |
3340 | db_init; |
3330 | load_extensions; |
3341 | load_extensions; |
3331 | |
3342 | |
3332 | $TICK_WATCHER->start; |
3343 | $TICK_WATCHER->start; |
|
|
3344 | $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority |
3333 | EV::loop; |
3345 | EV::loop; |
3334 | } |
3346 | } |
3335 | |
3347 | |
3336 | ############################################################################# |
3348 | ############################################################################# |
3337 | # initialisation and cleanup |
3349 | # initialisation and cleanup |
… | |
… | |
3601 | |
3613 | |
3602 | $NOW = $tick_start = EV::now; |
3614 | $NOW = $tick_start = EV::now; |
3603 | |
3615 | |
3604 | cf::server_tick; # one server iteration |
3616 | cf::server_tick; # one server iteration |
3605 | |
3617 | |
3606 | $RUNTIME += $TICK; |
3618 | $RUNTIME += $TICK; |
3607 | $NEXT_TICK += $TICK; |
3619 | $NEXT_TICK = $_[0]->at; |
3608 | |
3620 | |
3609 | if ($NOW >= $NEXT_RUNTIME_WRITE) { |
3621 | if ($NOW >= $NEXT_RUNTIME_WRITE) { |
3610 | $NEXT_RUNTIME_WRITE = $NOW + 10; |
3622 | $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.; |
3611 | Coro::async_pool { |
3623 | Coro::async_pool { |
3612 | $Coro::current->{desc} = "runtime saver"; |
3624 | $Coro::current->{desc} = "runtime saver"; |
3613 | write_runtime |
3625 | write_runtime |
3614 | or warn "ERROR: unable to write runtime file: $!"; |
3626 | or warn "ERROR: unable to write runtime file: $!"; |
3615 | }; |
3627 | }; |
… | |
… | |
3628 | _post_tick; |
3640 | _post_tick; |
3629 | }; |
3641 | }; |
3630 | $TICK_WATCHER->priority (EV::MAXPRI); |
3642 | $TICK_WATCHER->priority (EV::MAXPRI); |
3631 | |
3643 | |
3632 | { |
3644 | { |
|
|
3645 | # configure BDB |
|
|
3646 | |
3633 | BDB::min_parallel 8; |
3647 | BDB::min_parallel 8; |
3634 | BDB::max_poll_time $TICK * 0.1; |
3648 | BDB::max_poll_reqs $TICK * 0.1; |
3635 | $BDB_POLL_WATCHER = EV::io BDB::poll_fileno, EV::READ, \&BDB::poll_cb; |
3649 | $Coro::BDB::WATCHER->priority (1); |
3636 | |
|
|
3637 | BDB::set_sync_prepare { |
|
|
3638 | my $status; |
|
|
3639 | my $current = $Coro::current; |
|
|
3640 | ( |
|
|
3641 | sub { |
|
|
3642 | $status = $!; |
|
|
3643 | $current->ready; undef $current; |
|
|
3644 | }, |
|
|
3645 | sub { |
|
|
3646 | Coro::schedule while defined $current; |
|
|
3647 | $! = $status; |
|
|
3648 | }, |
|
|
3649 | ) |
|
|
3650 | }; |
|
|
3651 | |
3650 | |
3652 | unless ($DB_ENV) { |
3651 | unless ($DB_ENV) { |
3653 | $DB_ENV = BDB::db_env_create; |
3652 | $DB_ENV = BDB::db_env_create; |
3654 | $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC |
3653 | $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC |
3655 | | BDB::LOG_AUTOREMOVE, 1); |
3654 | | BDB::LOG_AUTOREMOVE, 1); |
… | |
… | |
3682 | BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { }; |
3681 | BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { }; |
3683 | }; |
3682 | }; |
3684 | } |
3683 | } |
3685 | |
3684 | |
3686 | { |
3685 | { |
|
|
3686 | # configure IO::AIO |
|
|
3687 | |
3687 | IO::AIO::min_parallel 8; |
3688 | IO::AIO::min_parallel 8; |
3688 | |
|
|
3689 | undef $Coro::AIO::WATCHER; |
|
|
3690 | IO::AIO::max_poll_time $TICK * 0.1; |
3689 | IO::AIO::max_poll_time $TICK * 0.1; |
3691 | $AIO_POLL_WATCHER = EV::io IO::AIO::poll_fileno, EV::READ, \&IO::AIO::poll_cb; |
3690 | $Coro::AIO::WATCHER->priority (1); |
3692 | } |
3691 | } |
3693 | |
3692 | |
3694 | my $_log_backtrace; |
3693 | my $_log_backtrace; |
3695 | |
3694 | |
3696 | sub _log_backtrace { |
3695 | sub _log_backtrace { |