--- deliantra/server/lib/cf.pm 2009/10/16 01:56:41 1.487 +++ deliantra/server/lib/cf.pm 2010/02/03 20:48:22 1.506 @@ -1,7 +1,7 @@ # # This file is part of Deliantra, the Roguelike Realtime MMORPG. # -# Copyright (©) 2006,2007,2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team +# Copyright (©) 2006,2007,2008,2009,2010 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 @@ -34,6 +34,7 @@ use Safe; use Safe::Hole; use Storable (); +use Carp (); use Guard (); use Coro (); @@ -54,7 +55,6 @@ use JSON::XS 2.01 (); use BDB (); use Data::Dumper; -use Digest::MD5; use Fcntl; use YAML::XS (); use IO::AIO (); @@ -230,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. @@ -291,7 +291,7 @@ } $EV::DIED = sub { - warn "error in event callback: @_"; + Carp::cluck "error in event callback: @_"; }; ############################################################################# @@ -425,24 +425,29 @@ our @SLOT_QUEUE; our $SLOT_QUEUE; +our $SLOT_DECAY = 0.9; $SLOT_QUEUE->cancel if $SLOT_QUEUE; $SLOT_QUEUE = Coro::async { $Coro::current->desc ("timeslot manager"); my $signal = new Coro::Signal; + my $busy; while () { next_job: + my $avail = cf::till_tick; - if ($avail > 0.01) { - for (0 .. $#SLOT_QUEUE) { - if ($SLOT_QUEUE[$_][0] < $avail) { - my $job = splice @SLOT_QUEUE, $_, 1, (); - $job->[2]->send; - Coro::cede; - goto next_job; - } + + for (0 .. $#SLOT_QUEUE) { + if ($SLOT_QUEUE[$_][0] <= $avail) { + $busy = 0; + my $job = splice @SLOT_QUEUE, $_, 1, (); + $job->[2]->send; + Coro::cede; + goto next_job; + } else { + $SLOT_QUEUE[$_][0] *= $SLOT_DECAY; } } @@ -451,6 +456,7 @@ push @cf::WAIT_FOR_TICK, $signal; $signal->wait; } else { + $busy = 0; Coro::schedule; } } @@ -461,7 +467,8 @@ my ($time, $pri, $name) = @_; - $time = $TICK * .6 if $time > $TICK * .6; + $time = clamp $time, 0.01, $TICK * .6; + my $sig = new Coro::Signal; push @SLOT_QUEUE, [$time, $pri, $sig, $name]; @@ -1394,38 +1401,47 @@ $todo{$base} = \%ext; } + my $pass = 0; my %done; while (%todo) { my $progress; + ++$pass; + + ext: while (my ($k, $v) = each %todo) { for (split /,\s*/, $v->{meta}{depends}) { - goto skip + next ext unless exists $done{$_}; } - warn "... loading '$k' into '$v->{pkg}'\n"; + warn "... pass $pass, loading '$k' into '$v->{pkg}'\n"; - unless (eval $v->{source}) { - my $msg = $@ ? "$v->{path}: $@\n" - : "$v->{base}: extension inactive.\n"; - - if (exists $v->{meta}{mandatory}) { - warn $msg; - cf::cleanup "mandatory extension failed to load, exiting."; - } - - warn $msg; - } + my $active = eval $v->{source}; - $done{$k} = delete $todo{$k}; - push @EXTS, $v->{pkg}; - $progress = 1; + if (length $@) { + warn "$v->{path}: $@\n"; + + cf::cleanup "mandatory extension '$k' failed to load, exiting." + if exists $v->{meta}{mandatory}; + } else { + $done{$k} = delete $todo{$k}; + push @EXTS, $v->{pkg}; + $progress = 1; + + warn "$v->{base}: extension inactive.\n" + unless $active; + } } - skip: - die "cannot load " . (join ", ", keys %todo) . ": unable to resolve dependencies\n" - unless $progress; + unless ($progress) { + warn "cannot load " . (join ", ", keys %todo) . ": unable to resolve dependencies\n"; + + while (my ($k, $v) = each %todo) { + cf::cleanup "mandatory extension '$k' has unresolved dependencies, exiting." + if exists $v->{meta}{mandatory}; + } + } } }; } @@ -2011,8 +2027,8 @@ } } -sub pre_load { } -sub post_load { } +sub pre_load { } +#sub post_load { } # XS sub load { my ($self) = @_; @@ -2343,6 +2359,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 @@ -2547,7 +2595,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; @@ -2756,6 +2804,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 @@ -2915,17 +2988,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) @@ -2938,10 +3001,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})); } } @@ -2955,11 +3018,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})); } } @@ -3096,7 +3159,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 )); @@ -3158,8 +3221,8 @@ %vars = (_dummy => 0) unless %vars; + my @res; local $_; - local @safe::cf::_safe_eval_args = values %vars; my $eval = "do {\n" @@ -3169,9 +3232,15 @@ . "\n}" ; - sub_generation_inc; - my @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval); - sub_generation_inc; + if ($CFG{safe_eval}) { + sub_generation_inc; + local @safe::cf::_safe_eval_args = values %vars; + @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval); + sub_generation_inc; + } else { + local @cf::_safe_eval_args = values %vars; + @res = wantarray ? eval eval : scalar eval $eval; + } if ($@) { warn "$@"; @@ -3200,8 +3269,8 @@ sub register_script_function { my ($fun, $cb) = @_; - no strict 'refs'; - *{"safe::$fun"} = $safe_hole->wrap ($cb); + $fun = "safe::$fun" if $CFG{safe_eval}; + *$fun = $safe_hole->wrap ($cb); } =back @@ -3232,9 +3301,11 @@ 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 => $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]), + data => $exp_table, + hash => (Digest::MD5::md5 $exp_table), }; cf::cede_to_tick; @@ -3246,8 +3317,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; } @@ -3281,29 +3352,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; @@ -3476,12 +3531,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; @@ -3519,6 +3575,8 @@ } sub write_runtime_sync { + my $t0 = EV::time; + # first touch the runtime file to show we are still running: # the fsync below can take a very very long time. @@ -3526,7 +3584,7 @@ my $guard = cf::lock_acquire "write_runtime"; - my $fh = aio_open "$RUNTIMEFILE~", O_WRONLY | O_CREAT, 0644 + my $fh = aio_open "$RUNTIMEFILE~", O_WRONLY | O_CREAT | O_TRUNC, 0644 or return; my $value = $cf::RUNTIME + 90 + 10; @@ -3549,7 +3607,7 @@ aio_rename "$RUNTIMEFILE~", $RUNTIMEFILE and return; - warn "runtime file written.\n"; + warn sprintf "runtime file written (%gs).\n", EV::time - $t0; 1 } @@ -3850,7 +3908,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; @@ -3858,7 +3916,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; @@ -3874,6 +3932,8 @@ cf::server_tick; # one server iteration + #for(1..3e6){} EV::now_update; $NOW=EV::now; # generate load #d# + if ($NOW >= $NEXT_RUNTIME_WRITE) { $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.; Coro::async_pool { @@ -3905,7 +3965,7 @@ { # configure BDB - BDB::min_parallel 8; + BDB::min_parallel 16; BDB::max_poll_reqs $TICK * 0.1; $AnyEvent::BDB::WATCHER->priority (1);