--- deliantra/server/lib/cf.pm	2007/01/01 17:30:34	1.116
+++ deliantra/server/lib/cf.pm	2007/01/09 21:32:42	1.155
@@ -10,27 +10,28 @@
 use Safe;
 use Safe::Hole;
 
-use Coro 3.3;
+use Coro 3.3 ();
 use Coro::Event;
 use Coro::Timer;
 use Coro::Signal;
 use Coro::Semaphore;
 use Coro::AIO;
 
+use Data::Dumper;
 use Digest::MD5;
 use Fcntl;
-use IO::AIO 2.31 ();
+use IO::AIO 2.32 ();
 use YAML::Syck ();
 use Time::HiRes;
 
 use Event; $Event::Eval = 1; # no idea why this is required, but it is
 
+sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
+
 # work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
 $YAML::Syck::ImplicitUnicode = 1;
 
-$Coro::main->prio (2); # run main coroutine ("the server") with very high priority
-
-sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
+$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
 
 our %COMMAND      = ();
 our %COMMAND_TIME = ();
@@ -49,11 +50,14 @@
 our $UPTIME; $UPTIME ||= time;
 our $RUNTIME;
 
-our %MAP; # all maps
+our %PLAYER; # all users
+our %MAP;    # all maps
 our $LINK_MAP; # the special {link} map
-our $FREEZE;
 our $RANDOM_MAPS = cf::localdir . "/random";
-our %EXT_CORO;
+our %EXT_CORO; # coroutines bound to extensions
+
+our $WAIT_FOR_TICK;     $WAIT_FOR_TICK     ||= new Coro::Signal;
+our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal;
 
 binmode STDOUT;
 binmode STDERR;
@@ -73,8 +77,7 @@
 
 # a special map that is always available
 our $LINK_MAP;
-
-our $EMERGENCY_POSITION = $cf::CFG{emergency_position} || ["/world/world_105_115", 5, 37];
+our $EMERGENCY_POSITION;
 
 #############################################################################
 
@@ -109,6 +112,13 @@
 Configuration for the server, loaded from C</etc/crossfire/config>, or
 from wherever your confdir points to.
 
+=item $cf::WAIT_FOR_TICK, $cf::WAIT_FOR_TICK_ONE
+
+These are Coro::Signal objects that are C<< ->broadcast >> (WAIT_FOR_TICK)
+or C<< ->send >> (WAIT_FOR_TICK_ONE) on after normal server tick
+processing has been done. Call C<< ->wait >> on them to maximise the
+window of cpu time available, or simply to synchronise to the server tick.
+
 =back
 
 =cut
@@ -121,7 +131,7 @@
       $msg .= "\n"
          unless $msg =~ /\n$/;
 
-      LOG llevError, "cfperl: $msg";
+      LOG llevError, $msg;
    };
 }
 
@@ -157,8 +167,29 @@
 
 =over 4
 
+=item dumpval $ref
+
 =cut
 
+sub dumpval {
+   eval {
+      local $SIG{__DIE__};
+      my $d;
+      if (1) {
+         $d = new Data::Dumper([$_[0]], ["*var"]);
+         $d->Terse(1);
+         $d->Indent(2);
+         $d->Quotekeys(0);
+         $d->Useqq(1);
+         #$d->Bless(...);
+         $d->Seen($_[1]) if @_ > 1;
+         $d = $d->Dump();
+      }
+      $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
+      $d
+   } || "[unable to dump $_[0]: '$@']";
+}
+
 use JSON::Syck (); # TODO# replace by JSON::PC once working
 
 =item $ref = cf::from_json $json
@@ -183,6 +214,66 @@
    JSON::Syck::Dump $_[0]
 }
 
+=item cf::lock_wait $string
+
+Wait until the given lock is available. See cf::lock_acquire. 
+
+=item my $lock = cf::lock_acquire $string
+
+Wait until the given lock is available and then acquires it and returns
+a Coro::guard object. If the guard object gets destroyed (goes out of scope,
+for example when the coroutine gets canceled), the lock is automatically
+returned.
+
+Lock names should begin with a unique identifier (for example, cf::map::find
+uses map_find and cf::map::load uses map_load).
+
+=cut
+
+our %LOCK;
+
+sub lock_wait($) {
+   my ($key) = @_;
+
+   # wait for lock, if any
+   while ($LOCK{$key}) {
+      push @{ $LOCK{$key} }, $Coro::current;
+      Coro::schedule;
+   }
+}
+
+sub lock_acquire($) {
+   my ($key) = @_;
+
+   # wait, to be sure we are not locked
+   lock_wait $key;
+
+   $LOCK{$key} = [];
+
+   Coro::guard {
+      # wake up all waiters, to be on the safe side
+      $_->ready for @{ delete $LOCK{$key} };
+   }
+}
+
+sub freeze_mainloop {
+   return unless $TICK_WATCHER->is_active;
+
+   my $guard = Coro::guard { $TICK_WATCHER->start };
+   $TICK_WATCHER->stop;
+   $guard
+}
+
+=item cf::async { BLOCK }
+
+Currently the same as Coro::async_pool, meaning you cannot use
+C<on_destroy>, C<join> or other gimmicks on these coroutines. The only
+thing you are allowed to do is call C<prio> on it.
+
+=cut
+
+BEGIN { *async = \&Coro::async_pool }
+
 =item cf::sync_job { BLOCK }
 
 The design of crossfire+ requires that the main coro ($Coro::main) is
@@ -205,20 +296,19 @@
       
       # TODO: use suspend/resume instead
       # (but this is cancel-safe)
-      local $FREEZE = 1;
+      my $freeze_guard = freeze_mainloop;
 
       my $busy = 1;
       my @res;
 
-      (Coro::async {
+      (async {
          @res = eval { $job->() };
          warn $@ if $@;
          undef $busy;
       })->prio (Coro::PRIO_MAX);
 
       while ($busy) {
-         Coro::cede_notself;
-         Event::one_event unless Coro::nready;
+         Coro::cede or Event::one_event;
       }
 
       wantarray ? @res : $res[0]
@@ -229,22 +319,17 @@
    }
 }
 
-=item $coro = cf::coro { BLOCK }
+=item $coro = cf::async_ext { BLOCK }
 
-Creates and returns a new coro. This coro is automcatially being canceled
-when the extension calling this is being unloaded.
+Like async, but this coro is automcatially being canceled when the
+extension calling this is being unloaded.
 
 =cut
 
-sub coro(&) {
+sub async_ext(&) {
    my $cb = shift;
 
-   my $coro; $coro = async {
-      eval {
-         $cb->();
-      };
-      warn $@ if $@;
-   };
+   my $coro = &Coro::async ($cb);
 
    $coro->on_destroy (sub {
       delete $EXT_CORO{$coro+0};
@@ -284,6 +369,9 @@
 
 package cf::path;
 
+# used to convert map paths into valid unix filenames by repalcing / by ∕
+our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
+
 sub new {
    my ($class, $path, $base) = @_;
 
@@ -356,8 +444,7 @@
 
 # escape the /'s in the path
 sub _escaped_path  {
-   # ∕ is U+2215
-   (my $path = $_[0]{path}) =~ s/\//∕/g;
+   (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
    $path
 }
 
@@ -819,6 +906,8 @@
       $av = eval { (Storable::thaw $av)->{objs} };
    }
 
+   warn sprintf "loading %s (%d)\n",
+      $filename, length $data, scalar @{$av || []};#d#
    return ($data, $av);
 }
 
@@ -992,46 +1081,174 @@
 cf::map->attach (prio => -10000, package => cf::mapsupport::);
 
 #############################################################################
-# load/save perl data associated with player->ob objects
 
-sub all_objects(@) {
-   @_, map all_objects ($_->inv), @_
+=head2 CORE EXTENSIONS
+
+Functions and methods that extend core crossfire objects.
+
+=cut
+
+package cf::player;
+
+use Coro::AIO;
+
+=head3 cf::player
+
+=over 4
+
+=item cf::player::find $login
+
+Returns the given player object, loading it if necessary (might block).
+
+=cut
+
+sub playerdir($) {
+   cf::localdir
+     . "/"
+     . cf::playerdir
+     . "/"
+     . (ref $_[0] ? $_[0]->ob->name : $_[0])
 }
 
-# TODO: compatibility cruft, remove when no longer needed
-cf::player->attach (
-   on_load => sub {
-      my ($pl, $path) = @_;
+sub path($) {
+   my $login = ref $_[0] ? $_[0]->ob->name : $_[0];
 
-      for my $o (all_objects $pl->ob) {
-         if (my $value = $o->get_ob_key_value ("_perl_data")) {
-            $o->set_ob_key_value ("_perl_data");
+   (playerdir $login) . "/$login.pl"
+}
 
-            %$o = %{ Storable::thaw pack "H*", $value };
-         }
+sub find_active($) {
+   $cf::PLAYER{$_[0]}
+      and $cf::PLAYER{$_[0]}->active
+      and $cf::PLAYER{$_[0]}
+}
+
+sub exists($) {
+   my ($login) = @_;
+
+   $cf::PLAYER{$login}
+      or cf::sync_job { !aio_stat $login }
+}
+
+sub find($) {
+   return $cf::PLAYER{$_[0]} || do {
+      my $login = $_[0];
+
+      my $guard = cf::lock_acquire "user_find:$login";
+
+      $cf::PLAYER{$_[0]} || do {
+         my $pl = load_pl path $login
+            or return;
+         $cf::PLAYER{$login} = $pl
       }
-   },
-);
+   }
+}
 
-#############################################################################
+sub save($) {
+   my ($pl) = @_;
 
-=head2 CORE EXTENSIONS
+   return if $pl->{deny_save};
 
-Functions and methods that extend core crossfire objects.
+   my $path = path $pl;
+   my $guard = cf::lock_acquire "user_save:$path";
 
-=head3 cf::player
+   return if $pl->{deny_save};
 
-=over 4
+   aio_mkdir playerdir $pl, 0770;
+   $pl->{last_save} = $cf::RUNTIME;
+
+   $pl->save_pl ($path);
+   Coro::cede;
+}
+
+sub new($) {
+   my ($login) = @_;
+
+   my $self = create;
+
+   $self->ob->name ($login);
+   $self->{deny_save} = 1;
+
+   $cf::PLAYER{$login} = $self;
+
+   $self
+}
+
+=item $pl->quit_character
+
+Nukes the player without looking back. If logged in, the connection will
+be destroyed. May block for a long time.
+
+=cut
+
+sub quit_character {
+   my ($pl) = @_;
+
+   $pl->{deny_save} = 1;
+   $pl->password ("*"); # this should lock out the player until we nuked the dir
+
+   $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
+   $pl->deactivate;
+   $pl->invoke (cf::EVENT_PLAYER_QUIT);
+   $pl->ns->destroy if $pl->ns;
+
+   my $path = playerdir $pl;
+   my $temp = "$path~$cf::RUNTIME~deleting~";
+   aio_rename $path, $temp;
+   delete $cf::PLAYER{$pl->ob->name};
+   $pl->destroy;
+   IO::AIO::aio_rmtree $temp;
+}
+
+=item cf::player::list_logins
+
+Returns am arrayref of all valid playernames in the system, can take a
+while and may block, so not sync_job-capable, ever.
+
+=cut
+
+sub list_logins {
+   my $dirs = aio_readdir cf::localdir . "/" . cf::playerdir
+      or return [];
+
+   my @logins;
+
+   for my $login (@$dirs) {
+      my $fh = aio_open path $login, 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
+
+      utf8::decode $login;
+      push @logins, $login;
+   }
 
-=item cf::player::exists $login
+   \@logins
+}
+
+=item $player->maps
 
-Returns true when the given account exists.
+Returns an arrayref of cf::path's of all maps that are private for this
+player. May block.
 
 =cut
 
-sub cf::player::exists($) {
-   cf::player::find $_[0]
-      or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;
+sub maps($) {
+   my ($pl) = @_;
+
+   my $files = aio_readdir playerdir $pl
+      or return;
+
+   my @paths;
+
+   for (@$files) {
+      utf8::decode $_;
+      next if /\.(?:pl|pst)$/;
+      next unless /^$PATH_SEP/;
+
+      s/$PATH_SEP/\//g;
+      push @paths, new cf::path "~" . $pl->ob->name . "/" . $_;
+   }
+
+   \@paths
 }
 
 =item $player->ext_reply ($msgid, $msgtype, %msg)
@@ -1040,14 +1257,16 @@
 
 =cut
 
-sub cf::player::ext_reply($$$%) {
+sub ext_reply($$$%) {
    my ($self, $id, %msg) = @_;
 
    $msg{msgid} = $id;
 
-   $self->send ("ext " . to_json \%msg);
+   $self->send ("ext " . cf::to_json \%msg);
 }
 
+package cf;
+
 =back
 
 
@@ -1062,8 +1281,8 @@
 use Fcntl;
 use Coro::AIO;
 
-our $MAX_RESET     = 7200;
-our $DEFAULT_RESET = 3600;
+our $MAX_RESET     = 3600;
+our $DEFAULT_RESET = 3000;
 
 sub generate_random_map {
    my ($path, $rmp) = @_;
@@ -1089,7 +1308,8 @@
 sub change_all_map_light {
    my ($change) = @_;
 
-   $_->change_map_light ($change) for values %cf::MAP;
+   $_->change_map_light ($change)
+      for grep $_->outdoor, values %cf::MAP;
 }
 
 sub try_load_header($) {
@@ -1102,6 +1322,9 @@
    my $map = cf::map::new
       or return;
 
+   # for better error messages only, will be overwritten
+   $map->path ($path);
+
    $map->load_header ($path)
      or return;
 
@@ -1110,19 +1333,28 @@
    $map
 }
 
-sub find_map {
+sub find;
+sub find {
    my ($path, $origin) = @_;
 
-   #warn "find_map<$path,$origin>\n";#d#
+   #warn "find<$path,$origin>\n";#d#
 
    $path = new cf::path $path, $origin && $origin->path;
    my $key = $path->as_string;
 
+   cf::lock_wait "map_find:$key";
+
    $cf::MAP{$key} || do {
+      my $guard = cf::lock_acquire "map_find:$key";
+
       # do it the slow way
       my $map = try_load_header $path->save_path;
 
+      Coro::cede;
+
       if ($map) {
+         $map->last_access ((delete $map->{last_access})
+                            || $cf::RUNTIME); #d#
          # safety
          $map->{instantiate_time} = $cf::RUNTIME
             if $map->{instantiate_time} > $cf::RUNTIME;
@@ -1137,6 +1369,7 @@
 
          $map->{load_original} = 1;
          $map->{instantiate_time} = $cf::RUNTIME;
+         $map->last_access ($cf::RUNTIME);
          $map->instantiate;
 
          # per-player maps become, after loading, normal maps
@@ -1146,11 +1379,14 @@
       $map->path ($key);
       $map->{path} = $path;
       $map->{last_save} = $cf::RUNTIME;
-      $map->last_access ($cf::RUNTIME);
+
+      Coro::cede;
 
       if ($map->should_reset) {
          $map->reset;
-         $map = find_map $path;
+         undef $guard;
+         $map = find $path
+            or return;
       }
 
       $cf::MAP{$key} = $map
@@ -1160,12 +1396,13 @@
 sub load {
    my ($self) = @_;
 
+   my $path = $self->{path};
+   my $guard = cf::lock_acquire "map_load:" . $path->as_string;
+
    return if $self->in_memory != cf::MAP_SWAPPED;
 
    $self->in_memory (cf::MAP_LOADING);
 
-   my $path = $self->{path};
-
    $self->alloc;
    $self->load_objects ($self->{load_path}, 1)
       or return;
@@ -1181,6 +1418,8 @@
       }
    }
 
+   Coro::cede;
+
    # now do the right thing for maps
    $self->link_multipart_objects;
 
@@ -1197,36 +1436,45 @@
       $self->activate;
    }
 
+   Coro::cede;
+
    $self->in_memory (cf::MAP_IN_MEMORY);
 }
 
-sub load_map_sync {
+sub find_sync {
    my ($path, $origin) = @_;
 
-   #warn "load_map_sync<$path, $origin>\n";#d#
+   cf::sync_job { cf::map::find $path, $origin }
+}
 
-   cf::sync_job {
-      my $map = cf::map::find_map $path, $origin
-         or return;
-      $map->load;
-      $map
-   }
+sub do_load_sync {
+   my ($map) = @_;
+
+   cf::sync_job { $map->load };
 }
 
 sub save {
    my ($self) = @_;
 
-   my $save = $self->{path}->save_path; utf8::encode $save;
-   my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
+   my $lock = cf::lock_acquire "map_data:" . $self->path;
 
    $self->{last_save} = $cf::RUNTIME;
 
    return unless $self->dirty;
 
+   my $save = $self->{path}->save_path; utf8::encode $save;
+   my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
+
    $self->{load_path} = $save;
 
    return if $self->{deny_save};
 
+   local $self->{last_access} = $self->last_access;#d#
+
+   cf::async {
+      $_->contr->save for $self->players;
+   };
+
    if ($uniq) {
       $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
       $self->save_objects ($uniq, cf::IO_UNIQUES);
@@ -1238,11 +1486,15 @@
 sub swap_out {
    my ($self) = @_;
 
+   # save first because save cedes
+   $self->save;
+
+   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->{deny_save};
 
-   $self->save;
    $self->clear;
    $self->in_memory (cf::MAP_SWAPPED);
 }
@@ -1290,6 +1542,8 @@
 sub reset {
    my ($self) = @_;
 
+   my $lock = cf::lock_acquire "map_data:" . $self->path;
+
    return if $self->players;
    return if $self->{path}{user_rel};#d#
 
@@ -1318,30 +1572,43 @@
    my ($map, $ob) = @_;
 
    if ($map->per_player) {
-      return cf::map::find_map "~" . $ob->name . "/" . $map->{path}{path};
+      return cf::map::find "~" . $ob->name . "/" . $map->{path}{path};
    }
 
    $map
 }
 
-sub emergency_save {
-   local $cf::FREEZE = 1;
+package cf;
 
-   warn "enter emergency map save\n";
+=back
 
-   cf::sync_job {
-      warn "begin emergency map save\n";
-      $_->save for values %cf::MAP;
-   };
+=head3 cf::object
+
+=cut
+
+package cf::object;
+
+=over 4
+
+=item $ob->inv_recursive
+
+Returns the inventory of the object _and_ their inventories, recursively.
 
-   warn "end emergency map save\n";
+=cut
+
+sub inv_recursive_;
+sub inv_recursive_ {
+   map { $_, inv_recursive_ $_->inv } @_
+}
+
+sub inv_recursive {
+   inv_recursive_ inv $_[0]
 }
 
 package cf;
 
 =back
 
-
 =head3 cf::object::player
 
 =over 4
@@ -1407,13 +1674,14 @@
 sub cf::object::player::enter_link {
    my ($self) = @_;
 
+   $self->deactivate_recursive;
+
    return if $self->map == $LINK_MAP;
 
-   $self->{_link_pos} = [$self->map->{path}, $self->x, $self->y]
+   $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
       if $self->map;
 
    $self->enter_map ($LINK_MAP, 20, 20);
-   $self->deactivate_recursive;
 }
 
 sub cf::object::player::leave_link {
@@ -1424,11 +1692,11 @@
    unless ($map) {
       # restore original map position
       ($map, $x, $y) = @{ $link_pos || [] };
-      $map = cf::map::find_map $map;
+      $map = cf::map::find $map;
 
       unless ($map) {
          ($map, $x, $y) = @$EMERGENCY_POSITION;
-         $map = cf::map::find_map $map
+         $map = cf::map::find $map
             or die "FATAL: cannot load emergency map\n";
       }
    }
@@ -1442,29 +1710,63 @@
 
    $map->load;
 
+   return unless $self->contr->active;
    $self->activate_recursive;
    $self->enter_map ($map, $x, $y);
 }
 
-=item $player_object->goto_map ($map, $x, $y)
+cf::player->attach (
+   on_logout => sub {
+      my ($pl) = @_;
+
+      # abort map switching before logout
+      if ($pl->ob->{_link_pos}) {
+         cf::sync_job {
+            $pl->ob->leave_link
+         };
+      }
+   },
+   on_login => sub {
+      my ($pl) = @_;
+
+      # try to abort aborted map switching on player login :)
+      # should happen only on crashes
+      if ($pl->ob->{_link_pos}) {
+         $pl->ob->enter_link;
+         (async {
+            # we need this sleep as the login has a concurrent enter_exit running
+            # and this sleep increases chances of the player not ending up in scorn
+            $pl->ob->reply (undef,
+                            "There was an internal problem at your last logout, "
+                          . "the server will try to bring you to your intended destination in a second.",
+                            cf::NDI_RED);
+            Coro::Timer::sleep 1;
+            $pl->ob->leave_link;
+         })->prio (2);
+      }
+   },
+);
+
+=item $player_object->goto ($path, $x, $y)
 
 =cut
 
-sub cf::object::player::goto_map {
+sub cf::object::player::goto {
    my ($self, $path, $x, $y) = @_;
 
-   $self->enter_link;
+   $path = new cf::path $path;
+   $path ne "/" or Carp::cluck ("oy");#d#
 
-   (Coro::async {
-      $path = new cf::path $path;
+   $self->enter_link;
 
-      my $map = cf::map::find_map $path->as_string;
+   (async {
+      my $map = cf::map::find $path->as_string;
       $map = $map->customise_for ($self) if $map;
 
-      warn "entering ", $map->path, " at ($x, $y)\n"
-         if $map;
+#      warn "entering ", $map->path, " at ($x, $y)\n"
+#         if $map;
 
-      $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
+      $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
 
       $self->leave_link ($map, $x, $y);
    })->prio (1);
@@ -1527,14 +1829,14 @@
 
    $self->enter_link;
 
-   (Coro::async {
+   (async {
+      $self->deactivate_recursive; # just to be sure
       unless (eval {
-
          prepare_random_map $exit
             if $exit->slaying eq "/!";
 
          my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
-         $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
+         $self->goto ($path, $exit->stats->hp, $exit->stats->sp);
 
          1;
       }) {
@@ -1601,7 +1903,8 @@
 
       # this weird shuffling is so that direct followup queries
       # get handled first
-      my $queue = delete $ns->{query_queue};
+      my $queue = delete $ns->{query_queue}
+         or return; # be conservative, not sure how that can happen, but we saw a crash here
 
       (shift @$queue)->[1]->($msg);
 
@@ -1617,7 +1920,7 @@
    },
 );
 
-=item $client->coro (\&cb)
+=item $client->async (\&cb)
 
 Create a new coroutine, running the specified callback. The coroutine will
 be automatically cancelled when the client gets destroyed (e.g. on logout,
@@ -1625,15 +1928,10 @@
 
 =cut
 
-sub cf::client::coro {
+sub cf::client::async {
    my ($self, $cb) = @_;
 
-   my $coro; $coro = async {
-      eval {
-         $cb->();
-      };
-      warn $@ if $@;
-   };
+   my $coro = &Coro::async ($cb);
 
    $coro->on_destroy (sub {
       delete $self->{_coro}{$coro+0};
@@ -1815,14 +2113,12 @@
    my $path = cf::localdir . "/database.pst";
 
    sub db_load() {
-      warn "loading database $path\n";#d# remove later
       $DB = stat $path ? Storable::retrieve $path : { };
    }
 
    my $pid;
 
    sub db_save() {
-      warn "saving database $path\n";#d# remove later
       waitpid $pid, 0 if $pid;
       if (0 == ($pid = fork)) {
          $DB->{_meta}{version} = 1;
@@ -1880,15 +2176,26 @@
 
    local $/;
    *CFG = YAML::Syck::Load <$fh>;
+
+   $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
+
+   $cf::map::MAX_RESET     = $CFG{map_max_reset}     if exists $CFG{map_max_reset};
+   $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
+
+   if (exists $CFG{mlockall}) {
+      eval {
+         $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
+            and die "WARNING: m(un)lockall failed: $!\n";
+      };
+      warn $@ if $@;
+   }
 }
 
 sub main {
    # we must not ever block the main coroutine
    local $Coro::idle = sub {
       Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
-      (Coro::unblock_sub {
-         Event::one_event;
-      })->();
+      async { Event::one_event };
    };
 
    cfg_load;
@@ -1898,7 +2205,49 @@
 }
 
 #############################################################################
-# initialisation
+# initialisation and cleanup
+
+# install some emergency cleanup handlers
+BEGIN {
+   for my $signal (qw(INT HUP TERM)) {
+      Event->signal (
+         data   => WF_AUTOCANCEL,
+         signal => $signal,
+         cb     => sub {
+            cf::cleanup "SIG$signal";
+         },
+      );
+   }
+}
+
+sub emergency_save {
+   my $freeze_guard = cf::freeze_mainloop;
+
+   warn "enter emergency perl save\n";
+
+   cf::sync_job {
+      # use a peculiar iteration method to avoid tripping on perl
+      # refcount bugs in for. also avoids problems with players
+      # and maps saved/Destroyed asynchronously.
+      warn "begin emergency player save\n";
+      for my $login (keys %cf::PLAYER) {
+         my $pl = $cf::PLAYER{$login} or next;
+         $pl->valid or next;
+         $pl->save;
+      }
+      warn "end emergency player save\n";
+
+      warn "begin emergency map save\n";
+      for my $path (keys %cf::MAP) {
+         my $map = $cf::MAP{$path} or next;
+         $map->valid or next;
+         $map->save;
+      }
+      warn "end emergency map save\n";
+   };
+
+   warn "leave emergency perl save\n";
+}
 
 sub reload() {
    # can/must only be called in main
@@ -1909,7 +2258,7 @@
 
    warn "reloading...";
 
-   local $FREEZE = 1;
+   my $guard = freeze_mainloop;
    cf::emergency_save;
 
    eval {
@@ -1981,6 +2330,7 @@
       # reattach attachments to objects
       warn "reattach";
       _global_reattach;
+      reattach $_ for values %MAP;
    };
 
    if ($@) {
@@ -2006,7 +2356,7 @@
 
    # dirty hack because... archetypes are not yet loaded
    Event->timer (
-      after => 2,
+      after => 10,
       cb    => sub {
          $_[0]->w->cancel;
 
@@ -2055,13 +2405,13 @@
    at        => $NEXT_TICK || $TICK,
    data      => WF_AUTOCANCEL,
    cb        => sub {
-      unless ($FREEZE) {
-         cf::server_tick; # one server iteration
-         $RUNTIME += $TICK;
-      }
-
+      cf::server_tick; # one server iteration
+      $RUNTIME   += $TICK;
       $NEXT_TICK += $TICK;
 
+      $WAIT_FOR_TICK->broadcast;
+      $WAIT_FOR_TICK_ONE->send if $WAIT_FOR_TICK_ONE->awaited;
+
       # if we are delayed by four ticks or more, skip them all
       $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
 
@@ -2092,5 +2442,7 @@
    },
 );
 
+END { cf::emergency_save }
+
 1