--- deliantra/server/lib/cf.pm 2011/05/04 07:36:40 1.569
+++ deliantra/server/lib/cf.pm 2012/11/04 02:20:11 1.590
@@ -1,22 +1,22 @@
#
# This file is part of Deliantra, the Roguelike Realtime MMORPG.
-#
-# Copyright (©) 2006,2007,2008,2009,2010,2011 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
-#
+#
+# Copyright (©) 2006,2007,2008,2009,2010,2011,2012 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 Affero 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 Affero GNU General Public License
# and the GNU General Public License along with this program. If not, see
# .
-#
+#
# The authors can be reached via e-mail to
#
@@ -34,7 +34,10 @@
use Storable ();
use Carp ();
-use Guard ();
+use AnyEvent ();
+use AnyEvent::IO ();
+use AnyEvent::DNS ();
+
use Coro ();
use Coro::State;
use Coro::Handle;
@@ -50,6 +53,7 @@
use Coro::Storable;
use Coro::Util ();
+use Guard ();
use JSON::XS 2.01 ();
use BDB ();
use Data::Dumper;
@@ -110,7 +114,7 @@
our $PIDFILE = "$LOCALDIR/pid";
our $RUNTIMEFILE = "$LOCALDIR/runtime";
-our %RESOURCE; # unused
+#our %RESOURCE; # unused
our $OUTPUT_RATE_MIN = 3000;
our $OUTPUT_RATE_MAX = 1000000;
@@ -131,9 +135,11 @@
our @EXTRA_MODULES = qw(pod match mapscript incloader);
our %CFG;
+our %EXT_CFG; # cfgkeyname => [var-ref, defaultvalue]
our $UPTIME; $UPTIME ||= time;
-our $RUNTIME;
+our $RUNTIME = 0;
+our $SERVER_TICK = 0;
our $NOW;
our (%PLAYER, %PLAYER_LOADING); # all users
@@ -153,6 +159,9 @@
our $REATTACH_ON_RELOAD; # set to true to force object reattach on reload (slow)
our $REALLY_UNLOOP; # never set to true, please :)
+our $WAIT_FOR_TICK = new Coro::Signal;
+our @WAIT_FOR_TICK_BEGIN;
+
binmode STDOUT;
binmode STDERR;
@@ -195,7 +204,22 @@
=item $cf::UPTIME
-The timestamp of the server start (so not actually an uptime).
+The timestamp of the server start (so not actually an "uptime").
+
+=item $cf::SERVER_TICK
+
+An unsigned integer that starts at zero when the server is started and is
+incremented on every tick.
+
+=item $cf::NOW
+
+The (real) time of the last (current) server tick - updated before and
+after tick processing, so this is useful only as a rough "what time is it
+now" estimate.
+
+=item $cf::TICK
+
+The interval between each server tick, in seconds.
=item $cf::RUNTIME
@@ -211,14 +235,6 @@
unique-items directory, player file directory, random maps directory and
database environment.
-=item $cf::NOW
-
-The time of the last (current) server tick.
-
-=item $cf::TICK
-
-The interval between server ticks, in seconds.
-
=item $cf::LOADAVG
The current CPU load on the server (alpha-smoothed), as a value between 0
@@ -240,6 +256,18 @@
returns directly I the tick processing (and consequently, can only wake one thread
per tick), while cf::wait_for_tick wakes up all waiters after tick processing.
+Note that cf::Wait_for_tick will immediately return when the server is not
+ticking, making it suitable for small pauses in threads that need to run
+when the server is paused. If that is not applicable (i.e. you I
+want to wait, use C<$cf::WAIT_FOR_TICK>).
+
+=item $cf::WAIT_FOR_TICK
+
+Note that C is probably the correct thing to use. This
+variable contains a L that is broadcats after every server
+tick. Calling C<< ->wait >> on it will suspend the caller until after the
+next server tick.
+
=cut
sub wait_for_tick();
@@ -314,7 +342,7 @@
}
$EV::DIED = sub {
- Carp::cluck "error in event callback: @_";
+ warn "error in event callback: $@";
};
#############################################################################
@@ -351,7 +379,7 @@
} || "[unable to dump $_[0]: '$@']";
}
-=item $scalar = load_file $path
+=item $scalar = cf::load_file $path
Loads the given file from path and returns its contents. Croaks on error
and can block.
@@ -365,6 +393,44 @@
$data
}
+=item $success = cf::replace_file $path, $data, $sync
+
+Atomically replaces the file at the given $path with new $data, and
+optionally $sync the data to disk before replacing the file.
+
+=cut
+
+sub replace_file($$;$) {
+ my ($path, $data, $sync) = @_;
+
+ my $lock = cf::lock_acquire ("replace_file:$path");
+
+ my $fh = aio_open "$path~", Fcntl::O_WRONLY | Fcntl::O_CREAT | Fcntl::O_TRUNC, 0644
+ or return;
+
+ $data = $data->() if ref $data;
+
+ length $data == aio_write $fh, 0, (length $data), $data, 0
+ or return;
+
+ !$sync
+ or !aio_fsync $fh
+ or return;
+
+ aio_close $fh
+ and return;
+
+ aio_rename "$path~", $path
+ and return;
+
+ if ($sync) {
+ $path =~ s%/[^/]*$%%;
+ aio_pathsync $path;
+ }
+
+ 1
+}
+
=item $ref = cf::decode_json $json
Converts a JSON string into the corresponding perl data structure.
@@ -547,8 +613,7 @@
if (@SLOT_QUEUE) {
# we do not use wait_for_tick() as it returns immediately when tick is inactive
- push @cf::WAIT_FOR_TICK, $signal;
- $signal->wait;
+ $WAIT_FOR_TICK->wait;
} else {
$busy = 0;
Coro::schedule;
@@ -1441,10 +1506,7 @@
my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };
if (ref $msg) {
- my ($type, $reply, @payload) =
- "ARRAY" eq ref $msg
- ? @$msg
- : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
+ my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash
my @reply;
@@ -1476,9 +1538,22 @@
$grp
}
+sub _ext_cfg_reg($$$$) {
+ my ($rvar, $varname, $cfgname, $default) = @_;
+
+ $cfgname = lc $varname
+ unless length $cfgname;
+
+ $EXT_CFG{$cfgname} = [$rvar, $default];
+
+ $$rvar = exists $CFG{$cfgname} ? $CFG{$cfgname} : $default;
+}
+
sub load_extensions {
info "loading extensions...";
+ %EXT_CFG = ();
+
cf::sync_job {
my %todo;
@@ -1530,7 +1605,16 @@
trace "... pass $pass, loading '$k' into '$v->{pkg}'\n";
- my $active = eval $v->{source};
+ my $source = $v->{source};
+
+ # support "CONF varname :confname = default" pseudo-statements
+ $source =~ s{
+ ^ CONF \s+ ([^\s:=]+) \s* (?:: \s* ([^\s:=]+) \s* )? = ([^\n#]+)
+ }{
+ "our \$$1; BEGIN { cf::_ext_cfg_reg \\\$$1, q\x00$1\x00, q\x00$2\x00, $3 }";
+ }gmxe;
+
+ my $active = eval $source;
if (length $@) {
error "$v->{path}: $@\n";
@@ -2173,7 +2257,7 @@
my $guard = cf::lock_acquire "map_data:$path";
return unless $self->valid;
- return unless $self->in_memory == cf::MAP_SWAPPED;
+ return unless $self->state == cf::MAP_SWAPPED;
$self->alloc;
@@ -2206,7 +2290,7 @@
if delete $self->{load_original};
}
- $self->in_memory (cf::MAP_INACTIVE);
+ $self->state (cf::MAP_INACTIVE);
cf::cede_to_tick;
# now do the right thing for maps
@@ -2247,33 +2331,6 @@
$self
}
-# find and load all maps in the 3x3 area around a map
-sub load_neighbours {
- my ($map) = @_;
-
- my @neigh; # diagonal neighbours
-
- for (0 .. 3) {
- my $neigh = $map->tile_path ($_)
- or next;
- $neigh = find $neigh, $map
- or next;
- $neigh->load;
-
- # now find the diagonal neighbours
- push @neigh,
- [$neigh->tile_path (($_ + 3) % 4), $neigh],
- [$neigh->tile_path (($_ + 1) % 4), $neigh];
- }
-
- for (grep defined $_->[0], @neigh) {
- my ($path, $origin) = @$_;
- my $neigh = find $path, $origin
- or next;
- $neigh->load;
- }
-}
-
sub find_sync {
my ($path, $origin) = @_;
@@ -2301,7 +2358,7 @@
my ($path, $origin, $load) = @_;
$path = normalise $path, $origin;
-
+
if (my $map = $cf::MAP{$path}) {
return $map if !$load || $map->linkable;
}
@@ -2379,7 +2436,7 @@
# first deactivate the map and "unlink" it from the core
$self->deactivate;
$_->clear_links_to ($self) for values %cf::MAP;
- $self->in_memory (cf::MAP_SWAPPED);
+ $self->state (cf::MAP_SWAPPED);
# then atomically save
$self->_save;
@@ -2415,7 +2472,7 @@
cf::trace "resetting map ", $self->path, "\n";
- $self->in_memory (cf::MAP_SWAPPED);
+ $self->state (cf::MAP_SWAPPED);
# need to save uniques path
unless ($self->{deny_save}) {
@@ -2755,7 +2812,6 @@
if $x <= 0 && $y <= 0;
$map->load;
- $map->load_neighbours;
return unless $self->contr->active;
@@ -3181,12 +3237,7 @@
sub cf::client::ext_msg($$@) {
my ($self, $type, @msg) = @_;
- if ($self->extcmd == 2) {
- $self->send_big_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
- } elsif ($self->extcmd == 1) { # TODO: remove
- push @msg, msgtype => "event_$type";
- $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
- }
+ $self->send_big_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
}
=item $client->ext_reply ($msgid, @msg)
@@ -3198,13 +3249,7 @@
sub cf::client::ext_reply($$@) {
my ($self, $id, @msg) = @_;
- if ($self->extcmd == 2) {
- $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
- } elsif ($self->extcmd == 1) {
- #TODO: version 1, remove
- unshift @msg, msgtype => "reply", msgid => $id;
- $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
- }
+ $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
}
=item $success = $client->query ($flags, "text", \&cb)
@@ -3269,10 +3314,7 @@
my $msg = eval { $ns->{json_coder}->decode ($buf) };
if (ref $msg) {
- my ($type, $reply, @payload) =
- "ARRAY" eq ref $msg
- ? @$msg
- : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
+ my ($type, $reply, @payload) = @$msg; # version 1 used %type, $id, %$hash
my @reply;
@@ -3460,6 +3502,30 @@
#############################################################################
# the server's init and main functions
+our %FACEHASH; # hash => idx, #d# HACK for http server
+
+# internal api, not fianlised
+sub add_face {
+ my ($name, $type, $data) = @_;
+
+ my $idx = cf::face::find $name;
+
+ if ($idx) {
+ delete $FACEHASH{cf::face::get_chksum $idx};
+ } else {
+ $idx = cf::face::alloc $name;
+ }
+
+ my $hash = cf::face::mangle_chksum Digest::MD5::md5 $data;
+
+ cf::face::set_type $idx, $type;
+ cf::face::set_data $idx, 0, $data, $hash;
+ cf::face::set_meta $idx, $type & 1 ? undef : undef;
+ $FACEHASH{$hash} = $idx;#d#
+
+ $idx
+}
+
sub load_facedata($) {
my ($path) = @_;
@@ -3476,19 +3542,13 @@
$facedata->{version} == 2
or cf::cleanup "$path: version mismatch, cannot proceed.";
- # patch in the exptable
- my $exp_table = $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]);
- $facedata->{resource}{"res/exp_table"} = {
- type => FT_RSRC,
- data => $exp_table,
- hash => (Digest::MD5::md5 $exp_table),
- };
cf::cede_to_tick;
{
my $faces = $facedata->{faceinfo};
- while (my ($face, $info) = each %$faces) {
+ for my $face (sort keys %$faces) {
+ my $info = $faces->{$face};
my $idx = (cf::face::find $face) || cf::face::alloc $face;
cf::face::set_visibility $idx, $info->{visibility};
@@ -3496,6 +3556,7 @@
cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32};
cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64};
cf::face::set_data $idx, 2, $info->{glyph} , $info->{glyph} ;
+ $FACEHASH{$info->{hash64}} = $idx;#d#
cf::cede_to_tick;
}
@@ -3532,13 +3593,16 @@
my $res = $facedata->{resource};
while (my ($name, $info) = each %$res) {
- if (defined $info->{type}) {
+ if (defined (my $type = $info->{type})) {
+ # TODO: different hash - must free and use new index, or cache ixface data queue
my $idx = (cf::face::find $name) || cf::face::alloc $name;
+ cf::face::set_type $idx, $type;
cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
- cf::face::set_type $idx, $info->{type};
+ cf::face::set_meta $idx, $type & 1 ? undef : $info->{meta}; # preserve meta unless prepended already
+ $FACEHASH{$info->{hash}} = $idx;#d#
} else {
- $RESOURCE{$name} = $info; # unused
+# $RESOURCE{$name} = $info; # unused
}
cf::cede_to_tick;
@@ -3568,6 +3632,19 @@
$status
}
+sub reload_exp_table {
+ _reload_exp_table;
+
+ add_face "res/exp_table" => FT_RSRC,
+ JSON::XS->new->utf8->canonical->encode (
+ [map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]
+ );
+}
+
+sub reload_materials {
+ _reload_materials;
+}
+
sub reload_regions {
# HACK to clear player env face cache, we need some signal framework
# for this (global event?)
@@ -3590,6 +3667,15 @@
sub reload_archetypes {
load_resource_file "$DATADIR/archetypes"
or die "unable to load archetypes\n";
+
+ add_face "res/skill_info" => FT_RSRC,
+ JSON::XS->new->utf8->canonical->encode (
+ [map [cf::arch::skillvec ($_)->name], 0 .. cf::arch::skillvec_size - 1]
+ );
+ add_face "res/spell_paths" => FT_RSRC,
+ JSON::XS->new->utf8->canonical->encode (
+ [map [cf::spellpathnames ($_)], 0 .. NRSPELLPATHS - 1]
+ );
}
sub reload_treasures {
@@ -3620,9 +3706,9 @@
sub reload_resources {
trace "reloading resource files...\n";
- reload_exp_table;
reload_materials;
reload_facedata;
+ reload_exp_table;
reload_sound;
reload_archetypes;
reload_regions;
@@ -3684,14 +3770,14 @@
cf::init_globals; # initialise logging
LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
- LOG llevInfo, "Copyright (C) 2005-2011 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
+ LOG llevInfo, "Copyright (C) 2005-2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
$Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
# we must not ever block the main coroutine
- local $Coro::idle = sub {
+ $Coro::idle = sub {
Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
(async {
$Coro::current->{desc} = "IDLE BUG HANDLER";
@@ -3736,8 +3822,7 @@
cf::object::thawer::errors_are_fatal 0;
info "parse errors in files are no longer fatal from this point on.\n";
- my $free_main; $free_main = EV::idle sub {
- undef $free_main;
+ AE::postpone {
undef &main; # free gobs of memory :)
};
@@ -3904,7 +3989,7 @@
trace "emergency_perl_save: flushing outstanding aio requests";
while (IO::AIO::nreqs || BDB::nreqs) {
- Coro::EV::timer_once 0.01; # let the sync_job do it's thing
+ Coro::AnyEvent::sleep 0.01; # let the sync_job do it's thing
}
cf::write_runtime_sync; # external watchdog should not bark
@@ -4095,19 +4180,14 @@
my $bug_warning = 0;
-our @WAIT_FOR_TICK;
-our @WAIT_FOR_TICK_BEGIN;
-
sub wait_for_tick() {
- return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
+ return Coro::AnyEvent::poll if tick_inhibit || $Coro::current == $Coro::main;
- my $signal = new Coro::Signal;
- push @WAIT_FOR_TICK, $signal;
- $signal->wait;
+ $WAIT_FOR_TICK->wait;
}
sub wait_for_tick_begin() {
- return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
+ return Coro::AnyEvent::poll if tick_inhibit || $Coro::current == $Coro::main;
my $signal = new Coro::Signal;
push @WAIT_FOR_TICK_BEGIN, $signal;
@@ -4121,7 +4201,7 @@
return;
}
- cf::server_tick; # one server iteration
+ cf::one_tick; # one server iteration
#for(1..3e6){} AE::now_update; $NOW=AE::now; # generate load #d#
@@ -4137,9 +4217,7 @@
if (my $sig = shift @WAIT_FOR_TICK_BEGIN) {
$sig->send;
}
- while (my $sig = shift @WAIT_FOR_TICK) {
- $sig->send;
- }
+ $WAIT_FOR_TICK->broadcast;
$LOAD = ($NOW - $TICK_START) / $TICK;
$LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25;
@@ -4158,7 +4236,7 @@
BDB::min_parallel 16;
BDB::max_poll_reqs $TICK * 0.1;
- $AnyEvent::BDB::WATCHER->priority (1);
+ #$AnyEvent::BDB::WATCHER->priority (1);
unless ($DB_ENV) {
$DB_ENV = BDB::db_env_create;