--- deliantra/server/lib/cf.pm 2007/04/18 14:45:13 1.251 +++ deliantra/server/lib/cf.pm 2007/04/28 05:55:55 1.262 @@ -56,7 +56,18 @@ our $RELOAD; # number of reloads so far our @EVENT; -our $LIBDIR = datadir . "/ext"; + +our $CONFDIR = confdir; +our $DATADIR = datadir; +our $LIBDIR = "$DATADIR/ext"; +our $PODDIR = "$DATADIR/pod"; +our $MAPDIR = "$DATADIR/" . mapdir; +our $LOCALDIR = localdir; +our $TMPDIR = "$LOCALDIR/" . tmpdir; +our $UNIQUEDIR = "$LOCALDIR/" . uniquedir; +our $PLAYERDIR = "$LOCALDIR/" . playerdir; +our $RANDOMDIR = "$LOCALDIR/random"; +our $BDBDIR = "$LOCALDIR/db"; our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) our $TICK_WATCHER; @@ -77,8 +88,6 @@ our %PLAYER; # all users our %MAP; # all maps our $LINK_MAP; # the special {link} map, which is always available -our $RANDOM_MAPS = cf::localdir . "/random"; -our $BDB_ENV_DIR = cf::localdir . "/db"; # used to convert map paths into valid unix filenames by replacing / by ∕ our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons @@ -87,18 +96,14 @@ binmode STDERR; # read virtual server time, if available -unless ($RUNTIME || !-e cf::localdir . "/runtime") { - open my $fh, "<", cf::localdir . "/runtime" +unless ($RUNTIME || !-e "$LOCALDIR/runtime") { + open my $fh, "<", "$LOCALDIR/runtime" or die "unable to read runtime file: $!"; $RUNTIME = <$fh> + 0.; } -mkdir cf::localdir; -mkdir cf::localdir . "/" . cf::playerdir; -mkdir cf::localdir . "/" . cf::tmpdir; -mkdir cf::localdir . "/" . cf::uniquedir; -mkdir $RANDOM_MAPS; -mkdir $BDB_ENV_DIR; +mkdir $_ + for $LOCALDIR, $TMPDIR, $UNIQUEDIR, $PLAYERDIR, $RANDOMDIR, $BDBDIR; our $EMERGENCY_POSITION; @@ -119,10 +124,14 @@ The time this server has run, starts at 0 and is increased by $cf::TICK on every server tick. -=item $cf::LIBDIR - -The perl library directory, where extensions and cf-specific modules can -be found. It will be added to C<@INC> automatically. +=item $cf::CONFDIR $cf::DATADIR $cf::LIBDIR $cf::PODDIR +$cf::MAPDIR $cf::LOCALDIR $cf::TMPDIR $cf::UNIQUEDIR +$cf::PLAYERDIR $cf::RANDOMDIR $cf::BDBDIR + +Various directories - "/etc", read-only install directory, perl-library +directory, pod-directory, read-only maps directory, "/var", "/var/tmp", +unique-items directory, player file directory, random maps directory and +database environment. =item $cf::NOW @@ -154,7 +163,7 @@ $msg .= "\n" unless $msg =~ /\n$/; - $msg =~ s/([\x00-\x09\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge; + $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge; utf8::encode $msg; LOG llevError, $msg; @@ -236,6 +245,10 @@ Lock names should begin with a unique identifier (for example, cf::map::find uses map_find and cf::map::load uses map_load). +=item $locked = cf::lock_active $string + +Return true if the lock is currently active, i.e. somebody has locked it. + =cut our %LOCK; @@ -264,6 +277,12 @@ } } +sub lock_active($) { + my ($key) = @_; + + ! ! $LOCK{$key} +} + sub freeze_mainloop { return unless $TICK_WATCHER->is_active; @@ -352,7 +371,7 @@ sub write_runtime { my $guard = cf::lock_acquire "write_runtime"; - my $runtime = cf::localdir . "/runtime"; + my $runtime = "$LOCALDIR/runtime"; my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 or return; @@ -957,10 +976,7 @@ =cut sub playerdir($) { - cf::localdir - . "/" - . cf::playerdir - . "/" + "$PLAYERDIR/" . (ref $_[0] ? $_[0]->ob->name : $_[0]) } @@ -1090,7 +1106,7 @@ =cut sub list_logins { - my $dirs = aio_readdir cf::localdir . "/" . cf::playerdir + my $dirs = aio_readdir $PLAYERDIR or return []; my @logins; @@ -1338,7 +1354,7 @@ sub load_path { my ($self) = @_; - sprintf "%s/%s/%s.map", cf::datadir, cf::mapdir, $self->{path} + "$MAPDIR/$self->{path}.map" } # the temporary/swap location @@ -1346,7 +1362,7 @@ my ($self) = @_; (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g; - sprintf "%s/%s/%s.map", cf::localdir, cf::tmpdir, $path + "$TMPDIR/$path.map" } # the unique path, undef == no special unique path @@ -1354,7 +1370,7 @@ my ($self) = @_; (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g; - sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $path + "$UNIQUEDIR/$path" } # and all this just because we cannot iterate over @@ -1476,53 +1492,54 @@ local $self->{deny_reset} = 1; # loading can take a long time my $path = $self->{path}; - my $guard = cf::lock_acquire "map_load:$path"; - return if $self->in_memory != cf::MAP_SWAPPED; + { + my $guard = cf::lock_acquire "map_load:$path"; - $self->in_memory (cf::MAP_LOADING); + return if $self->in_memory != cf::MAP_SWAPPED; - $self->alloc; + $self->in_memory (cf::MAP_LOADING); - $self->pre_load; - Coro::cede; + $self->alloc; - $self->_load_objects ($self->{load_path}, 1) - or return; + $self->pre_load; + Coro::cede; - $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1) - if delete $self->{load_original}; + $self->_load_objects ($self->{load_path}, 1) + or return; - if (my $uniq = $self->uniq_path) { - utf8::encode $uniq; - if (aio_open $uniq, O_RDONLY, 0) { - $self->clear_unique_items; - $self->_load_objects ($uniq, 0); - } - } + $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1) + if delete $self->{load_original}; - Coro::cede; - # now do the right thing for maps - $self->link_multipart_objects; - Coro::cede; + if (my $uniq = $self->uniq_path) { + utf8::encode $uniq; + if (aio_open $uniq, O_RDONLY, 0) { + $self->clear_unique_items; + $self->_load_objects ($uniq, 0); + } + } - unless ($self->{deny_activate}) { - $self->decay_objects; - $self->fix_auto_apply; - $self->update_buttons; Coro::cede; - $self->set_darkness_map; + # now do the right thing for maps + $self->link_multipart_objects; $self->difficulty ($self->estimate_difficulty) unless $self->difficulty; Coro::cede; - $self->activate; - Coro::cede; + + unless ($self->{deny_activate}) { + $self->decay_objects; + $self->fix_auto_apply; + $self->update_buttons; + Coro::cede; + $self->set_darkness_map; + Coro::cede; + $self->activate; + } + + $self->in_memory (cf::MAP_IN_MEMORY); } $self->post_load; - Coro::cede; - - $self->in_memory (cf::MAP_IN_MEMORY); } sub customise_for { @@ -1723,7 +1740,7 @@ =cut sub unique_maps() { - my $files = aio_readdir cf::localdir . "/" . cf::uniquedir + my $files = aio_readdir $UNIQUEDIR or return; my @paths; @@ -1989,7 +2006,7 @@ my $data = cf::to_json $rmp; my $md5 = Digest::MD5::md5_hex $data; - my $meta = "$cf::RANDOM_MAPS/$md5.meta"; + my $meta = "$RANDOMDIR/$md5.meta"; if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) { aio_write $fh, 0, (length $data), $data, 0; @@ -2375,7 +2392,11 @@ } } + my $t1 = Time::HiRes::time; my $data = $process->(\@data); + my $t2 = Time::HiRes::time; + + warn "cache: '$id' processed in ", $t2 - $t1, "s\n"; db_put cache => "$id/data", $data; db_put cache => "$id/md5" , $md5; @@ -2416,9 +2437,10 @@ return wantarray ? @$res : $res->[-1]; } else { + reset_signals; local $SIG{__WARN__}; + local $SIG{__DIE__}; eval { - local $SIG{__DIE__}; close $fh1; my @res = eval { $cb->(@args) }; @@ -2487,23 +2509,23 @@ 1 } -sub reload_facedata { - load_facedata sprintf "%s/facedata", cf::datadir - or die "unable to load facedata\n"; -} - sub reload_regions { - load_resource_file sprintf "%s/%s/regions", cf::datadir, cf::mapdir + load_resource_file "$MAPDIR/regions" or die "unable to load regions file\n"; } +sub reload_facedata { + load_facedata "$DATADIR/facedata" + or die "unable to load facedata\n"; +} + sub reload_archetypes { - load_resource_file sprintf "%s/archetypes", cf::datadir + load_resource_file "$DATADIR/archetypes" or die "unable to load archetypes\n"; } sub reload_treasures { - load_resource_file sprintf "%s/treasures", cf::datadir + load_resource_file "$DATADIR/treasures" or die "unable to load treasurelists\n"; } @@ -2523,7 +2545,7 @@ } sub cfg_load { - open my $fh, "<:utf8", cf::confdir . "/config" + open my $fh, "<:utf8", "$CONFDIR/config" or return; local $/; @@ -2703,6 +2725,7 @@ warn "unloading cf.pm \"a bit\""; delete $INC{"cf.pm"}; + delete $INC{"cf/pod.pm"}; # don't, removes xs symbols, too, # and global variables created in xs @@ -2872,12 +2895,12 @@ eval { BDB::db_env_open $DB_ENV, - $BDB_ENV_DIR, + $BDBDIR, BDB::INIT_LOCK | BDB::INIT_LOG | BDB::INIT_MPOOL | BDB::INIT_TXN | BDB::RECOVER | BDB::REGISTER | BDB::USE_ENVIRON | BDB::CREATE, 0666; - cf::cleanup "db_env_open($BDB_ENV_DIR): $!" if $!; + cf::cleanup "db_env_open($BDBDIR): $!" if $!; $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC, 1); $DB_ENV->set_lk_detect; @@ -2903,6 +2926,44 @@ ); } +my $_log_backtrace; + +sub _log_backtrace { + my ($msg, @addr) = @_; + + $msg =~ s/\n//; + + # limit the # of concurrent backtraces + if ($_log_backtrace < 2) { + ++$_log_backtrace; + async { + my @bt = fork_call { + @addr = map { sprintf "%x", $_ } @addr; + my $self = (-f "/proc/$$/exe") ? "/proc/$$/exe" : $^X; + open my $fh, "exec addr2line -C -f -i -e \Q$self\E @addr 2>&1 |" + or die "addr2line: $!"; + + my @funcs; + my @res = <$fh>; + chomp for @res; + while (@res) { + my ($func, $line) = splice @res, 0, 2, (); + push @funcs, "[$func] $line"; + } + + @funcs + }; + + LOG llevInfo, "[ABT] $msg\n"; + LOG llevInfo, "[ABT] $_\n" for @bt; + --$_log_backtrace; + }; + } else { + LOG llevInfo, "[ABT] $msg\n"; + LOG llevInfo, "[ABT] [suppressed]\n"; + } +} + # load additional modules use cf::pod;