--- deliantra/server/lib/cf.pm 2009/10/08 05:09:43 1.480
+++ deliantra/server/lib/cf.pm 2010/01/05 16:16:37 1.498
@@ -1,23 +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.
+# 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 GNU General Public License
-# along with this program. If not, see .
+# 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
-#
+#
package cf;
@@ -33,6 +34,7 @@
use Safe;
use Safe::Hole;
use Storable ();
+use Carp ();
use Guard ();
use Coro ();
@@ -53,9 +55,8 @@
use JSON::XS 2.01 ();
use BDB ();
use Data::Dumper;
-use Digest::MD5;
use Fcntl;
-use YAML ();
+use YAML::XS ();
use IO::AIO ();
use Time::HiRes;
use Compress::LZF;
@@ -119,7 +120,7 @@
our $BDB_TRICKLE_WATCHER;
our $DB_ENV;
-our @EXTRA_MODULES = qw(pod mapscript);
+our @EXTRA_MODULES = qw(pod match mapscript);
our %CFG;
@@ -172,7 +173,7 @@
}
# this is decidedly evil
-$REFLECT{object}{flags} = [grep $_, map /^FLAG_([A-Z0-9_]+)$/ && lc $1, keys %{"cf::"}];
+$REFLECT{object}{flags} = { map +($_ => undef), grep $_, map /^FLAG_([A-Z0-9_]+)$/ && lc $1, keys %{"cf::"} };
#############################################################################
@@ -229,7 +230,7 @@
=item @cf::INVOKE_RESULTS
-This array contains the results of the last C call. When
+This array contains the results of the last C call. When
C is called C<@cf::INVOKE_RESULTS> is set to the parameters of
that call.
@@ -290,7 +291,7 @@
}
$EV::DIED = sub {
- warn "error in event callback: @_";
+ Carp::cluck "error in event callback: @_";
};
#############################################################################
@@ -2342,6 +2343,38 @@
]
}
+=item cf::map::static_maps
+
+Returns an arrayref if paths of all static maps (all preinstalled F<.map>
+file in the shared directory excluding F and F). May
+block.
+
+=cut
+
+sub static_maps() {
+ my @dirs = "";
+ my @maps;
+
+ while (@dirs) {
+ my $dir = shift @dirs;
+
+ next if $dir eq "/styles" || $dir eq "/editor";
+
+ my ($dirs, $files) = Coro::AIO::aio_scandir "$MAPDIR$dir", 2
+ or return;
+
+ for (@$files) {
+ s/\.map$// or next;
+ utf8::decode $_;
+ push @maps, "$dir/$_";
+ }
+
+ push @dirs, map "$dir/$_", @$dirs;
+ }
+
+ \@maps
+}
+
=back
=head3 cf::object
@@ -2546,7 +2579,7 @@
# use -1 or undef as default coordinates, not 0, 0
($x, $y) = ($map->enter_x, $map->enter_y)
- if $x <=0 && $y <= 0;
+ if $x <= 0 && $y <= 0;
$map->load;
$map->load_neighbours;
@@ -2755,6 +2788,31 @@
$self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text);
}
+=item $client->send_big_packet ($pkt)
+
+Like C, but tries to compress large packets, and fragments
+them as required.
+
+=cut
+
+our $MAXFRAGSIZE = cf::MAXSOCKBUF - 64;
+
+sub cf::client::send_big_packet {
+ my ($self, $pkt) = @_;
+
+ # try lzf for large packets
+ $pkt = "lzf " . Compress::LZF::compress $pkt
+ if 1024 <= length $pkt and $self->{can_lzf};
+
+ # split very large packets
+ if ($MAXFRAGSIZE < length $pkt and $self->{can_lzf}) {
+ $self->send_packet ("frag $_") for unpack "(a$MAXFRAGSIZE)*", $pkt;
+ $pkt = "frag";
+ }
+
+ $self->send_packet ($pkt);
+}
+
=item $client->send_msg ($channel, $msg, $color, [extra...])
Send a drawinfo or msg packet to the client, formatting the msg for the
@@ -2766,6 +2824,12 @@
# non-persistent channels (usually the info channel)
our %CHANNEL = (
+ "c/motd" => {
+ id => "infobox",
+ title => "MOTD",
+ reply => undef,
+ tooltip => "The message of the day",
+ },
"c/identify" => {
id => "infobox",
title => "Identify",
@@ -2778,6 +2842,12 @@
reply => undef,
tooltip => "Signs and other items you examined",
},
+ "c/shopinfo" => {
+ id => "infobox",
+ title => "Shop Info",
+ reply => undef,
+ tooltip => "What your bargaining skill tells you about the shop",
+ },
"c/book" => {
id => "infobox",
title => "Book",
@@ -2902,17 +2972,7 @@
[$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]
);
- # try lzf for large packets
- $pkt = "lzf " . Compress::LZF::compress $pkt
- if 1024 <= length $pkt and $self->{can_lzf};
-
- # split very large packets
- if (8192 < length $pkt and $self->{can_lzf}) {
- $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt;
- $pkt = "frag";
- }
-
- $self->send_packet ($pkt);
+ $self->send_big_packet ($pkt);
}
=item $client->ext_msg ($type, @msg)
@@ -2925,10 +2985,10 @@
my ($self, $type, @msg) = @_;
if ($self->extcmd == 2) {
- $self->send_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
+ $self->send_big_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
} elsif ($self->extcmd == 1) { # TODO: remove
push @msg, msgtype => "event_$type";
- $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg}));
+ $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
}
}
@@ -2942,11 +3002,11 @@
my ($self, $id, @msg) = @_;
if ($self->extcmd == 2) {
- $self->send_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
+ $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_packet ("ext " . $self->{json_coder}->encode ({@msg}));
+ $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
}
}
@@ -3083,7 +3143,7 @@
$SIG{FPE} = 'IGNORE';
$safe->permit_only (Opcode::opset qw(
- :base_core :base_mem :base_orig :base_math
+ :base_core :base_mem :base_orig :base_math :base_loop
grepstart grepwhile mapstart mapwhile
sort time
));
@@ -3233,8 +3293,8 @@
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};
- cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64};
+ cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32};
+ cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64};
cf::cede_to_tick;
}
@@ -3268,29 +3328,13 @@
}
{
- # TODO: for gcfclient pleasure, we should give resources
- # that gcfclient doesn't grok a >10000 face index.
my $res = $facedata->{resource};
while (my ($name, $info) = each %$res) {
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} || {} },
- });
-
- $data = pack "(w/a*)*", $meta, $info->{data};
- } else {
- $data = $info->{data};
- }
- cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
+ cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
cf::face::set_type $idx, $info->{type};
} else {
$RESOURCE{$name} = $info;
@@ -3384,11 +3428,13 @@
}
sub reload_config {
+ warn "reloading config file...\n";
+
open my $fh, "<:utf8", "$CONFDIR/config"
or return;
local $/;
- *CFG = YAML::Load <$fh>;
+ *CFG = YAML::XS::Load scalar <$fh>;
$EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
@@ -3402,6 +3448,8 @@
};
warn $@ if $@;
}
+
+ warn "finished reloading resource files\n";
}
sub pidfile() {
@@ -3459,12 +3507,13 @@
evthread_start IO::AIO::poll_fileno;
cf::sync_job {
+ cf::load_settings;
+ cf::load_materials;
+
reload_resources;
reload_config;
db_init;
- cf::load_settings;
- cf::load_materials;
cf::init_uuid;
cf::init_signals;
cf::init_commands;
@@ -3761,7 +3810,7 @@
warn "reloading cf.pm";
require cf;
- cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
+ cf::_connect_to_perl_1;
warn "loading config and database again";
cf::reload_config;
@@ -3833,7 +3882,7 @@
our @WAIT_FOR_TICK_BEGIN;
sub wait_for_tick {
- return if tick_inhibit || $Coro::current == $Coro::main;
+ return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
my $signal = new Coro::Signal;
push @WAIT_FOR_TICK, $signal;
@@ -3841,7 +3890,7 @@
}
sub wait_for_tick_begin {
- return if tick_inhibit || $Coro::current == $Coro::main;
+ return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
my $signal = new Coro::Signal;
push @WAIT_FOR_TICK_BEGIN, $signal;
@@ -3979,6 +4028,7 @@
# load additional modules
require "cf/$_.pm" for @EXTRA_MODULES;
+cf::_connect_to_perl_2;
END { cf::emergency_save }