--- deliantra/server/lib/cf.pm 2007/11/08 19:43:25 1.394
+++ deliantra/server/lib/cf.pm 2008/05/10 22:38:52 1.433
@@ -1,3 +1,24 @@
+#
+# This file is part of Deliantra, the Roguelike Realtime MMORPG.
+#
+# Copyright (©) 2006,2007,2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
+#
+# Deliantra is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see .
+#
+# The authors can be reached via e-mail to
+#
+
package cf;
use utf8;
@@ -6,45 +27,44 @@
use Symbol;
use List::Util;
use Socket;
-use Event;
+use EV;
use Opcode;
use Safe;
use Safe::Hole;
use Storable ();
-use Coro 4.1 ();
+use Coro ();
use Coro::State;
use Coro::Handle;
-use Coro::Event;
+use Coro::EV;
use Coro::Timer;
use Coro::Signal;
use Coro::Semaphore;
+use Coro::AnyEvent;
use Coro::AIO;
+use Coro::BDB;
use Coro::Storable;
use Coro::Util ();
-use JSON::XS ();
+use JSON::XS 2.01 ();
use BDB ();
use Data::Dumper;
use Digest::MD5;
use Fcntl;
-use YAML::Syck ();
-use IO::AIO 2.51 ();
+use YAML ();
+use IO::AIO ();
use Time::HiRes;
use Compress::LZF;
use Digest::MD5 ();
+AnyEvent::detect;
+
# configure various modules to our taste
#
$Storable::canonical = 1; # reduce rsync transfers
Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator
Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later
-$Event::Eval = 1; # no idea why this is required, but it is
-
-# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
-$YAML::Syck::ImplicitUnicode = 1;
-
$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
@@ -72,16 +92,13 @@
our $PLAYERDIR = "$LOCALDIR/" . playerdir;
our $RANDOMDIR = "$LOCALDIR/random";
our $BDBDIR = "$LOCALDIR/db";
+our %RESOURCE;
our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
-our $TICK_WATCHER;
-our $AIO_POLL_WATCHER;
our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
our $NEXT_TICK;
-our $NOW;
our $USE_FSYNC = 1; # use fsync to write maps - default off
-our $BDB_POLL_WATCHER;
our $BDB_DEADLOCK_WATCHER;
our $BDB_CHECKPOINT_WATCHER;
our $BDB_TRICKLE_WATCHER;
@@ -91,6 +108,7 @@
our $UPTIME; $UPTIME ||= time;
our $RUNTIME;
+our $NOW;
our (%PLAYER, %PLAYER_LOADING); # all users
our (%MAP, %MAP_LOADING ); # all maps
@@ -101,7 +119,8 @@
our $LOAD; # a number between 0 (idle) and 1 (too many objects)
our $LOADAVG; # same thing, but with alpha-smoothing
-our $tick_start; # for load detecting purposes
+our $JITTER; # average jitter
+our $TICK_START; # for load detecting purposes
binmode STDOUT;
binmode STDERR;
@@ -164,7 +183,7 @@
=item %cf::CFG
-Configuration for the server, loaded from C, or
+Configuration for the server, loaded from C, or
from wherever your confdir points to.
=item cf::wait_for_tick, cf::wait_for_tick_begin
@@ -196,6 +215,21 @@
};
}
+$Coro::State::DIEHOOK = sub {
+ return unless $^S eq 0; # "eq", not "=="
+
+ if ($Coro::current == $Coro::main) {#d#
+ warn "DIEHOOK called in main context, Coro bug?\n";#d#
+ return;#d#
+ }#d#
+
+ # kill coroutine otherwise
+ warn Carp::longmess $_[0];
+ Coro::terminate
+};
+
+$SIG{__DIE__} = sub { }; #d#?
+
@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
@@ -217,7 +251,7 @@
@{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
}
-$Event::DIED = sub {
+$EV::DIED = sub {
warn "error in event callback: @_";
};
@@ -250,11 +284,11 @@
} || "[unable to dump $_[0]: '$@']";
}
-=item $ref = cf::from_json $json
+=item $ref = cf::decode_json $json
Converts a JSON string into the corresponding perl data structure.
-=item $json = cf::to_json $ref
+=item $json = cf::encode_json $ref
Converts a perl data structure into its JSON representation.
@@ -262,8 +296,8 @@
our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
-sub to_json ($) { $json_coder->encode ($_[0]) }
-sub from_json ($) { $json_coder->decode ($_[0]) }
+sub encode_json($) { $json_coder->encode ($_[0]) }
+sub decode_json($) { $json_coder->decode ($_[0]) }
=item cf::lock_wait $string
@@ -329,13 +363,24 @@
}
sub freeze_mainloop {
- return unless $TICK_WATCHER->is_active;
+ tick_inhibit_inc;
- my $guard = Coro::guard {
- $TICK_WATCHER->start;
- };
- $TICK_WATCHER->stop;
- $guard
+ Coro::guard \&tick_inhibit_dec;
+}
+
+=item cf::periodic $interval, $cb
+
+Like EV::periodic, but randomly selects a starting point so that the actions
+get spread over timer.
+
+=cut
+
+sub periodic($$) {
+ my ($interval, $cb) = @_;
+
+ my $start = rand List::Util::min 180, $interval;
+
+ EV::periodic $start, $interval, 0, $cb
}
=item cf::get_slot $time[, $priority[, $name]]
@@ -385,6 +430,8 @@
};
sub get_slot($;$$) {
+ return if tick_inhibit || $Coro::current == $Coro::main;
+
my ($time, $pri, $name) = @_;
$time = $TICK * .6 if $time > $TICK * .6;
@@ -424,15 +471,13 @@
my ($job) = @_;
if ($Coro::current == $Coro::main) {
- my $time = Event::time;
+ my $time = EV::time;
# this is the main coro, too bad, we have to block
# till the operation succeeds, freezing the server :/
LOG llevError, Carp::longmess "sync job";#d#
- # TODO: use suspend/resume instead
- # (but this is cancel-safe)
my $freeze_guard = freeze_mainloop;
my $busy = 1;
@@ -449,16 +494,13 @@
if (Coro::nready) {
Coro::cede_notself;
} else {
- Event::one_event;
+ EV::loop EV::LOOP_ONESHOT;
}
}
- $time = Event::time - $time;
-
- LOG llevError | logBacktrace, Carp::longmess "long sync job"
- if $time > $TICK * 0.5 && $TICK_WATCHER->is_active;
+ my $time = EV::time - $time;
- $tick_start += $time; # do not account sync jobs to server load
+ $TICK_START += $time; # do not account sync jobs to server load
wantarray ? @res : $res[0]
} else {
@@ -493,7 +535,7 @@
Executes the given code block with the given arguments in a seperate
process, returning the results. Everything must be serialisable with
Coro::Storable. May, of course, block. Note that the executed sub may
-never block itself or use any form of Event handling.
+never block itself or use any form of event handling.
=cut
@@ -512,6 +554,33 @@
wantarray ? @res : $res[-1]
}
+=item $coin = coin_from_name $name
+
+=cut
+
+our %coin_alias = (
+ "silver" => "silvercoin",
+ "silvercoin" => "silvercoin",
+ "silvercoins" => "silvercoin",
+ "gold" => "goldcoin",
+ "goldcoin" => "goldcoin",
+ "goldcoins" => "goldcoin",
+ "platinum" => "platinacoin",
+ "platinumcoin" => "platinacoin",
+ "platinumcoins" => "platinacoin",
+ "platina" => "platinacoin",
+ "platinacoin" => "platinacoin",
+ "platinacoins" => "platinacoin",
+ "royalty" => "royalty",
+ "royalties" => "royalty",
+);
+
+sub coin_from_name($) {
+ $coin_alias{$_[0]}
+ ? cf::arch::find $coin_alias{$_[0]}
+ : undef
+}
+
=item $value = cf::db_get $family => $key
Returns a single value from the environment database.
@@ -956,7 +1025,7 @@
0
}
-=item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...)
+=item $bool = cf::global->invoke (EVENT_CLASS_XXX, ...)
=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...)
@@ -1044,7 +1113,7 @@
on_instantiate => sub {
my ($obj, $data) = @_;
- $data = from_json $data;
+ $data = decode_json $data;
for (@$data) {
my ($name, $args) = @$_;
@@ -1075,18 +1144,18 @@
$decname, length $$rdata, scalar @$objs;
if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
- chmod SAVE_MODE, $fh;
+ aio_chmod $fh, SAVE_MODE;
aio_write $fh, 0, (length $$rdata), $$rdata, 0;
aio_fsync $fh if $cf::USE_FSYNC;
- close $fh;
+ aio_close $fh;
if (@$objs) {
if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
- chmod SAVE_MODE, $fh;
+ aio_chmod $fh, SAVE_MODE;
my $data = Coro::Storable::nfreeze { version => 1, objs => $objs };
aio_write $fh, 0, (length $data), $data, 0;
aio_fsync $fh if $cf::USE_FSYNC;
- close $fh;
+ aio_close $fh;
aio_rename "$filename.pst~", "$filename.pst";
}
} else {
@@ -1291,8 +1360,7 @@
if (exists $v->{meta}{mandatory}) {
warn $msg;
- warn "mandatory extension failed to load, exiting.\n";
- exit 1;
+ cf::cleanup "mandatory extension failed to load, exiting.";
}
warn $msg;
@@ -1391,6 +1459,7 @@
my $pl = cf::player::load_pl $f
or return;
+
local $cf::PLAYER_LOADING{$login} = $pl;
$f->resolve_delayed_derefs;
$cf::PLAYER{$login} = $pl
@@ -1411,6 +1480,8 @@
aio_mkdir playerdir $pl, 0770;
$pl->{last_save} = $cf::RUNTIME;
+ cf::get_slot 0.01;
+
$pl->save_pl ($path);
cf::cede_to_tick;
}
@@ -1455,6 +1526,8 @@
$pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
$pl->deactivate;
+ my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy;
+ $pl->ob->check_score;
$pl->invoke (cf::EVENT_PLAYER_QUIT);
$pl->ns->destroy if $pl->ns;
@@ -1503,7 +1576,8 @@
my $path = path $login;
# a .pst is a dead give-away for a valid player
- unless (-e "$path.pst") {
+ # if no pst file found, open and chekc for blocked users
+ if (aio_stat "$path.pst") {
my $fh = aio_open $path, Fcntl::O_RDONLY, 0 or next;
aio_read $fh, 0, 512, my $buf, 0 or next;
$buf !~ /^password -------------$/m or next; # official not-valid tag
@@ -1712,6 +1786,9 @@
sub generate_random_map {
my ($self, $rmp) = @_;
+
+ my $lock = cf::lock_acquire "generate_random_map"; # the random map generator is NOT reentrant ATM
+
# mit "rum" bekleckern, nicht
$self->_create_random_map (
$rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
@@ -1843,7 +1920,7 @@
sub save_path {
my ($self) = @_;
- (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
+ (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/go;
"$TMPDIR/$path.map"
}
@@ -1851,7 +1928,7 @@
sub uniq_path {
my ($self) = @_;
- (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
+ (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/go;
"$UNIQUEDIR/$path"
}
@@ -1959,8 +2036,8 @@
cf::lock_wait "map_find:$path";
$cf::MAP{$path} || do {
- my $guard1 = cf::lock_acquire "map_find:$path";
- my $guard2 = cf::lock_acquire "map_data:$path"; # just for the fun of it
+ my $guard1 = cf::lock_acquire "map_data:$path"; # just for the fun of it
+ my $guard2 = cf::lock_acquire "map_find:$path";
my $map = new_from_path cf::map $path
or return;
@@ -1973,8 +2050,8 @@
if ($map->should_reset) {#d#TODO# disabled, crashy (locking issue?)
# doing this can freeze the server in a sync job, obviously
#$cf::WAIT_FOR_TICK->wait;
- undef $guard1;
undef $guard2;
+ undef $guard1;
$map->reset;
return find $path;
}
@@ -2047,7 +2124,7 @@
$self->{last_save} = $cf::RUNTIME;
$self->last_access ($cf::RUNTIME);
- $self->in_memory (cf::MAP_IN_MEMORY);
+ $self->in_memory (cf::MAP_ACTIVE);
}
$self->post_load;
@@ -2115,7 +2192,7 @@
$path = normalise $path, $origin && $origin->{path};
if (my $map = $cf::MAP{$path}) {
- return $map if !$load || $map->in_memory == cf::MAP_IN_MEMORY;
+ return $map if !$load || $map->in_memory == cf::MAP_ACTIVE;
}
$MAP_PREFETCH{$path} |= $load;
@@ -2162,6 +2239,8 @@
$_->contr->save for $self->players;
};
+ cf::get_slot 0.02;
+
if ($uniq) {
$self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
$self->_save_objects ($uniq, cf::IO_UNIQUES);
@@ -2179,7 +2258,7 @@
my $lock = cf::lock_acquire "map_data:$self->{path}";
return if $self->players;
- return if $self->in_memory != cf::MAP_IN_MEMORY;
+ return if $self->in_memory != cf::MAP_ACTIVE;
return if $self->{deny_save};
$self->in_memory (cf::MAP_SWAPPED);
@@ -2307,15 +2386,14 @@
[
map {
utf8::decode $_;
- /\.map$/
- ? normalise $_
- : ()
+ s/\.map$//; # TODO future compatibility hack
+ /\.pst$/ || !/^$PATH_SEP/o # TODO unique maps apparebntly lack the .map suffix :/
+ ? ()
+ : normalise $_
} @{ aio_readdir $UNIQUEDIR or [] }
]
}
-package cf;
-
=back
=head3 cf::object
@@ -2328,7 +2406,8 @@
=item $ob->inv_recursive
-Returns the inventory of the object _and_ their inventories, recursively.
+Returns the inventory of the object I their inventories, recursively,
+but I the object itself.
=cut
@@ -2343,7 +2422,7 @@
=item $ref = $ob->ref
-creates and returns a persistent reference to an objetc that can be stored as a string.
+Creates and returns a persistent reference to an object that can be stored as a string.
=item $ob = cf::object::deref ($refstring)
@@ -2385,6 +2464,20 @@
=cut
+our $SAY_CHANNEL = {
+ id => "say",
+ title => "Map",
+ reply => "say ",
+ tooltip => "Things said to and replied from npcs near you and other players on the same map only.",
+};
+
+our $CHAT_CHANNEL = {
+ id => "chat",
+ title => "Chat",
+ reply => "chat ",
+ tooltip => "Player chat and shouts, global to the server.",
+};
+
# rough implementation of a future "reply" method that works
# with dialog boxes.
#TODO: the first argument must go, split into a $npc->reply_to ( method
@@ -2405,7 +2498,7 @@
} else {
$msg = $npc->name . " says: $msg" if $npc;
- $self->message ($msg, $flags);
+ $self->send_msg ($SAY_CHANNEL => $msg, $flags);
}
}
}
@@ -2610,8 +2703,6 @@
sub prepare_random_map {
my ($exit) = @_;
- my $guard = cf::lock_acquire "exit_prepare:$exit";
-
# all this does is basically replace the /! path by
# a new random map path (?random/...) with a seed
# that depends on the exit object
@@ -2623,11 +2714,13 @@
$rmp->{origin_map} = $exit->map->path;
$rmp->{origin_x} = $exit->x;
$rmp->{origin_y} = $exit->y;
+
+ $exit->map->touch;
}
$rmp->{random_seed} ||= $exit->random_seed;
- my $data = cf::to_json $rmp;
+ my $data = JSON::XS->new->utf8->pretty->canonical->encode ($rmp);
my $md5 = Digest::MD5::md5_hex $data;
my $meta = "$RANDOMDIR/$md5.meta";
@@ -2636,8 +2729,12 @@
undef $fh;
aio_rename "$meta~", $meta;
- $exit->slaying ("?random/$md5");
- $exit->msg (undef);
+ my $slaying = "?random/$md5";
+
+ if ($exit->valid) {
+ $exit->slaying ("?random/$md5");
+ $exit->msg (undef);
+ }
}
}
@@ -2646,31 +2743,33 @@
return unless $self->type == cf::PLAYER;
- if ($exit->slaying eq "/!") {
- #TODO: this should de-fi-ni-te-ly not be a sync-job
- # the problem is that $exit might not survive long enough
- # so it needs to be done right now, right here
- cf::sync_job { prepare_random_map $exit };
- }
-
- my $slaying = cf::map::normalise $exit->slaying, $exit->map && $exit->map->path;
- my $hp = $exit->stats->hp;
- my $sp = $exit->stats->sp;
-
$self->enter_link;
- # if exit is damned, update players death & WoR home-position
- $self->contr->savebed ($slaying, $hp, $sp)
- if $exit->flag (FLAG_DAMNED);
-
(async {
- $Coro::current->{desc} = "enter_exit $slaying $hp $sp";
+ $Coro::current->{desc} = "enter_exit";
- $self->deactivate_recursive; # just to be sure
unless (eval {
- $self->goto ($slaying, $hp, $sp);
+ $self->deactivate_recursive; # just to be sure
+
+ # random map handling
+ {
+ my $guard = cf::lock_acquire "exit_prepare:$exit";
+
+ prepare_random_map $exit
+ if $exit->slaying eq "/!";
+ }
+
+ my $map = cf::map::normalise $exit->slaying, $exit->map && $exit->map->path;
+ my $x = $exit->stats->hp;
+ my $y = $exit->stats->sp;
+
+ $self->goto ($map, $x, $y);
+
+ # if exit is damned, update players death & WoR home-position
+ $self->contr->savebed ($map, $x, $y)
+ if $exit->flag (cf::FLAG_DAMNED);
- 1;
+ 1
}) {
$self->message ("Something went wrong deep within the crossfire server. "
. "I'll try to bring you back to the map you were before. "
@@ -2760,6 +2859,12 @@
reply => undef,
tooltip => "Information related to the maps",
},
+ "c/party" => {
+ id => "party",
+ title => "Party",
+ reply => "gsay ",
+ tooltip => "Messages and chat related to your party",
+ },
);
sub cf::client::send_msg {
@@ -3006,7 +3111,7 @@
cf::object
contr pay_amount pay_player map x y force_find force_add destroy
- insert remove name archname title slaying race decrease_ob_nr
+ insert remove name archname title slaying race decrease split
cf::object::player
player
@@ -3021,8 +3126,8 @@
for (
["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y
- insert remove inv name archname title slaying race
- decrease_ob_nr destroy)],
+ insert remove inv nrof name archname title slaying race
+ decrease split destroy)],
["cf::object::player" => qw(player)],
["cf::player" => qw(peaceful)],
["cf::map" => qw(trigger)],
@@ -3137,6 +3242,7 @@
while (my ($face, $info) = each %$faces) {
my $idx = (cf::face::find $face) || cf::face::alloc $face;
+
cf::face::set_visibility $idx, $info->{visibility};
cf::face::set_magicmap $idx, $info->{magicmap};
cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32};
@@ -3147,8 +3253,10 @@
while (my ($face, $info) = each %$faces) {
next unless $info->{smooth};
+
my $idx = cf::face::find $face
or next;
+
if (my $smooth = cf::face::find $info->{smooth}) {
cf::face::set_smooth $idx, $smooth;
cf::face::set_smoothlevel $idx, $info->{smoothlevel};
@@ -3176,52 +3284,58 @@
# that gcfclient doesn't grok a >10000 face index.
my $res = $facedata->{resource};
- my $soundconf = delete $res->{"res/sound.conf"};
-
while (my ($name, $info) = each %$res) {
- my $idx = (cf::face::find $name) || cf::face::alloc $name;
- my $data;
+ if (defined $info->{type}) {
+ my $idx = (cf::face::find $name) || cf::face::alloc $name;
+ my $data;
+
+ if ($info->{type} & 1) {
+ # prepend meta info
+
+ my $meta = $enc->encode ({
+ name => $name,
+ %{ $info->{meta} || {} },
+ });
- if ($info->{type} & 1) {
- # prepend meta info
-
- my $meta = $enc->encode ({
- name => $name,
- %{ $info->{meta} || {} },
- });
+ $data = pack "(w/a*)*", $meta, $info->{data};
+ } else {
+ $data = $info->{data};
+ }
- $data = pack "(w/a*)*", $meta, $info->{data};
+ cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
+ cf::face::set_type $idx, $info->{type};
} else {
- $data = $info->{data};
+ $RESOURCE{$name} = $info;
}
- cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
- cf::face::set_type $idx, $info->{type};
-
cf::cede_to_tick;
}
+ }
- if ($soundconf) {
- $soundconf = $enc->decode (delete $soundconf->{data});
+ cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
- for (0 .. SOUND_CAST_SPELL_0 - 1) {
- my $sound = $soundconf->{compat}[$_]
- or next;
+ 1
+}
- my $face = cf::face::find "sound/$sound->[1]";
- cf::sound::set $sound->[0] => $face;
- cf::sound::old_sound_index $_, $face; # gcfclient-compat
- }
+cf::global->attach (on_resource_update => sub {
+ if (my $soundconf = $RESOURCE{"res/sound.conf"}) {
+ $soundconf = JSON::XS->new->utf8->relaxed->decode ($soundconf->{data});
- while (my ($k, $v) = each %{$soundconf->{event}}) {
- my $face = cf::face::find "sound/$v";
- cf::sound::set $k => $face;
- }
+ for (0 .. SOUND_CAST_SPELL_0 - 1) {
+ my $sound = $soundconf->{compat}[$_]
+ or next;
+
+ my $face = cf::face::find "sound/$sound->[1]";
+ cf::sound::set $sound->[0] => $face;
+ cf::sound::old_sound_index $_, $face; # gcfclient-compat
}
- }
- 1
-}
+ while (my ($k, $v) = each %{$soundconf->{event}}) {
+ my $face = cf::face::find "sound/$v";
+ cf::sound::set $k => $face;
+ }
+ }
+});
register_exticmd fx_want => sub {
my ($ns, $want) = @_;
@@ -3231,6 +3345,16 @@
}
};
+sub load_resource_file($) {
+ my $guard = lock_acquire "load_resource_file";
+
+ my $status = load_resource_file_ $_[0];
+ get_slot 0.1, 100;
+ cf::arch::commit_load;
+
+ $status
+}
+
sub reload_regions {
# HACK to clear player env face cache, we need some signal framework
# for this (global event?)
@@ -3253,11 +3377,6 @@
sub reload_archetypes {
load_resource_file "$DATADIR/archetypes"
or die "unable to load archetypes\n";
- #d# NEED to laod twice to resolve forward references
- # this really needs to be done in an extra post-pass
- # (which needs to be synchronous, so solve it differently)
- load_resource_file "$DATADIR/archetypes"
- or die "unable to load archetypes\n";
}
sub reload_treasures {
@@ -3268,16 +3387,17 @@
sub reload_resources {
warn "reloading resource files...\n";
- reload_regions;
reload_facedata;
- #reload_archetypes;#d#
reload_archetypes;
+ reload_regions;
reload_treasures;
warn "finished reloading resource files\n";
}
sub init {
+ my $guard = freeze_mainloop;
+
reload_resources;
}
@@ -3286,7 +3406,7 @@
or return;
local $/;
- *CFG = YAML::Syck::Load <$fh>;
+ *CFG = YAML::Load <$fh>;
$EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
@@ -3308,16 +3428,21 @@
Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
(async {
$Coro::current->{desc} = "IDLE BUG HANDLER";
- Event::one_event;
+ EV::loop EV::LOOP_ONESHOT;
})->prio (Coro::PRIO_MAX);
};
- reload_config;
- db_init;
- load_extensions;
+ {
+ my $guard = freeze_mainloop;
+ reload_config;
+ db_init;
+ load_extensions;
+
+ $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
+ evthread_start IO::AIO::poll_fileno;
+ }
- $TICK_WATCHER->start;
- Event::loop;
+ EV::loop;
}
#############################################################################
@@ -3325,20 +3450,15 @@
# install some emergency cleanup handlers
BEGIN {
+ our %SIGWATCHER = ();
for my $signal (qw(INT HUP TERM)) {
- Event->signal (
- reentrant => 0,
- data => WF_AUTOCANCEL,
- signal => $signal,
- prio => 0,
- cb => sub {
- cf::cleanup "SIG$signal";
- },
- );
+ $SIGWATCHER{$signal} = EV::signal $signal, sub {
+ cf::cleanup "SIG$signal";
+ };
}
}
-sub write_runtime {
+sub write_runtime_sync {
my $runtime = "$LOCALDIR/runtime";
# first touch the runtime file to show we are still running:
@@ -3376,6 +3496,49 @@
1
}
+our $uuid_lock;
+our $uuid_skip;
+
+sub write_uuid_sync($) {
+ $uuid_skip ||= $_[0];
+
+ return if $uuid_lock;
+ local $uuid_lock = 1;
+
+ my $uuid = "$LOCALDIR/uuid";
+
+ my $fh = aio_open "$uuid~", O_WRONLY | O_CREAT, 0644
+ or return;
+
+ my $value = uuid_str $uuid_skip + uuid_seq uuid_cur;
+ $uuid_skip = 0;
+
+ (aio_write $fh, 0, (length $value), $value, 0) <= 0
+ and return;
+
+ # always fsync - this file is important
+ aio_fsync $fh
+ and return;
+
+ close $fh
+ or return;
+
+ aio_rename "$uuid~", $uuid
+ and return;
+
+ warn "uuid file written ($value).\n";
+
+ 1
+
+}
+
+sub write_uuid($$) {
+ my ($skip, $sync) = @_;
+
+ $sync ? write_uuid_sync $skip
+ : async { write_uuid_sync $skip };
+}
+
sub emergency_save() {
my $freeze_guard = cf::freeze_mainloop;
@@ -3405,6 +3568,10 @@
warn "begin emergency database checkpoint\n";
BDB::db_env_txn_checkpoint $DB_ENV;
warn "end emergency database checkpoint\n";
+
+ warn "begin write uuid\n";
+ write_uuid_sync 1;
+ warn "end write uuid\n";
};
warn "leave emergency perl save\n";
@@ -3429,20 +3596,15 @@
warn "entering sync_job";
cf::sync_job {
- cf::write_runtime; # external watchdog should not bark
+ cf::write_runtime_sync; # external watchdog should not bark
cf::emergency_save;
- cf::write_runtime; # external watchdog should not bark
+ cf::write_runtime_sync; # external watchdog should not bark
warn "syncing database to disk";
BDB::db_env_txn_checkpoint $DB_ENV;
# if anything goes wrong in here, we should simply crash as we already saved
- warn "cancelling all WF_AUTOCANCEL watchers";
- for (Event::all_watchers) {
- $_->cancel if $_->data & WF_AUTOCANCEL;
- }
-
warn "flushing outstanding aio requests";
for (;;) {
BDB::flush;
@@ -3533,8 +3695,7 @@
1
} or do {
warn $@;
- warn "error while reloading, exiting.";
- exit 1;
+ cf::cleanup "error while reloading, exiting.";
};
warn "reloaded";
@@ -3546,15 +3707,10 @@
# doing reload synchronously and two reloads happen back-to-back,
# coro crashes during coro_state_free->destroy here.
- $RELOAD_WATCHER ||= Event->timer (
- reentrant => 0,
- after => 0,
- data => WF_AUTOCANCEL,
- cb => sub {
- do_reload_perl;
- undef $RELOAD_WATCHER;
- },
- );
+ $RELOAD_WATCHER ||= EV::timer 0, 0, sub {
+ do_reload_perl;
+ undef $RELOAD_WATCHER;
+ };
}
register_command "reload" => sub {
@@ -3577,8 +3733,7 @@
our @WAIT_FOR_TICK_BEGIN;
sub wait_for_tick {
- return unless $TICK_WATCHER->is_active;
- return if $Coro::current == $Coro::main;
+ return if tick_inhibit || $Coro::current == $Coro::main;
my $signal = new Coro::Signal;
push @WAIT_FOR_TICK, $signal;
@@ -3586,91 +3741,56 @@
}
sub wait_for_tick_begin {
- return unless $TICK_WATCHER->is_active;
- return if $Coro::current == $Coro::main;
+ return if tick_inhibit || $Coro::current == $Coro::main;
my $signal = new Coro::Signal;
push @WAIT_FOR_TICK_BEGIN, $signal;
$signal->wait;
}
-$TICK_WATCHER = Event->timer (
- reentrant => 0,
- parked => 1,
- prio => 0,
- at => $NEXT_TICK || $TICK,
- data => WF_AUTOCANCEL,
- cb => sub {
- if ($Coro::current != $Coro::main) {
- Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
- unless ++$bug_warning > 10;
- return;
- }
-
- $NOW = $tick_start = Event::time;
-
- cf::server_tick; # one server iteration
-
- $RUNTIME += $TICK;
- $NEXT_TICK += $TICK;
-
- if ($NOW >= $NEXT_RUNTIME_WRITE) {
- $NEXT_RUNTIME_WRITE = $NOW + 10;
- Coro::async_pool {
- $Coro::current->{desc} = "runtime saver";
- write_runtime
- or warn "ERROR: unable to write runtime file: $!";
- };
- }
-
- if (my $sig = shift @WAIT_FOR_TICK_BEGIN) {
- $sig->send;
- }
- while (my $sig = shift @WAIT_FOR_TICK) {
- $sig->send;
- }
+sub tick {
+ if ($Coro::current != $Coro::main) {
+ Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
+ unless ++$bug_warning > 10;
+ return;
+ }
- $NOW = Event::time;
+ cf::server_tick; # one server iteration
- # if we are delayed by four ticks or more, skip them all
- $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
+ if ($NOW >= $NEXT_RUNTIME_WRITE) {
+ $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
+ Coro::async_pool {
+ $Coro::current->{desc} = "runtime saver";
+ write_runtime_sync
+ or warn "ERROR: unable to write runtime file: $!";
+ };
+ }
- $TICK_WATCHER->at ($NEXT_TICK);
- $TICK_WATCHER->start;
+ if (my $sig = shift @WAIT_FOR_TICK_BEGIN) {
+ $sig->send;
+ }
+ while (my $sig = shift @WAIT_FOR_TICK) {
+ $sig->send;
+ }
- $LOAD = ($NOW - $tick_start) / $TICK;
- $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
+ $LOAD = ($NOW - $TICK_START) / $TICK;
+ $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
- _post_tick;
- },
-);
+ if (0) {
+ if ($NEXT_TICK) {
+ my $jitter = $TICK_START - $NEXT_TICK;
+ $JITTER = $JITTER * 0.75 + $jitter * 0.25;
+ warn "jitter $JITTER\n";#d#
+ }
+ }
+}
{
- BDB::min_parallel 8;
- BDB::max_poll_time $TICK * 0.1;
- $BDB_POLL_WATCHER = Event->io (
- reentrant => 0,
- fd => BDB::poll_fileno,
- poll => 'r',
- prio => 0,
- data => WF_AUTOCANCEL,
- cb => \&BDB::poll_cb,
- );
+ # configure BDB
- BDB::set_sync_prepare {
- my $status;
- my $current = $Coro::current;
- (
- sub {
- $status = $!;
- $current->ready; undef $current;
- },
- sub {
- Coro::schedule while defined $current;
- $! = $status;
- },
- )
- };
+ BDB::min_parallel 8;
+ BDB::max_poll_reqs $TICK * 0.1;
+ $AnyEvent::BDB::WATCHER->priority (1);
unless ($DB_ENV) {
$DB_ENV = BDB::db_env_create;
@@ -3695,51 +3815,23 @@
};
}
- $BDB_DEADLOCK_WATCHER = Event->timer (
- after => 3,
- interval => 1,
- hard => 1,
- prio => 0,
- data => WF_AUTOCANCEL,
- cb => sub {
- BDB::db_env_lock_detect $DB_ENV, 0, BDB::LOCK_DEFAULT, 0, sub { };
- },
- );
- $BDB_CHECKPOINT_WATCHER = Event->timer (
- after => 11,
- interval => 60,
- hard => 1,
- prio => 0,
- data => WF_AUTOCANCEL,
- cb => sub {
- BDB::db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { };
- },
- );
- $BDB_TRICKLE_WATCHER = Event->timer (
- after => 5,
- interval => 10,
- hard => 1,
- prio => 0,
- data => WF_AUTOCANCEL,
- cb => sub {
- BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { };
- },
- );
+ $BDB_DEADLOCK_WATCHER = EV::periodic 0, 3, 0, sub {
+ BDB::db_env_lock_detect $DB_ENV, 0, BDB::LOCK_DEFAULT, 0, sub { };
+ };
+ $BDB_CHECKPOINT_WATCHER = EV::periodic 0, 60, 0, sub {
+ BDB::db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { };
+ };
+ $BDB_TRICKLE_WATCHER = EV::periodic 0, 10, 0, sub {
+ BDB::db_env_memp_trickle $DB_ENV, 20, 0, sub { };
+ };
}
{
- IO::AIO::min_parallel 8;
+ # configure IO::AIO
- undef $Coro::AIO::WATCHER;
+ IO::AIO::min_parallel 8;
IO::AIO::max_poll_time $TICK * 0.1;
- $AIO_POLL_WATCHER = Event->io (
- reentrant => 0,
- data => WF_AUTOCANCEL,
- fd => IO::AIO::poll_fileno,
- poll => 'r',
- prio => 0,
- cb => \&IO::AIO::poll_cb,
- );
+ $AnyEvent::AIO::WATCHER->priority (1);
}
my $_log_backtrace;