--- deliantra/server/lib/cf.pm	2006/12/21 23:02:54	1.94
+++ deliantra/server/lib/cf.pm	2006/12/31 22:23:12	1.109
@@ -1,5 +1,8 @@
 package cf;
 
+use utf8;
+use strict;
+
 use Symbol;
 use List::Util;
 use Storable;
@@ -7,16 +10,25 @@
 use Safe;
 use Safe::Hole;
 
-use IO::AIO ();
+use Coro 3.3;
+use Coro::Event;
+use Coro::Timer;
+use Coro::Signal;
+use Coro::Semaphore;
+use Coro::AIO;
+
+use Digest::MD5;
+use Fcntl;
+use IO::AIO 2.31 ();
 use YAML::Syck ();
 use Time::HiRes;
-use Event;
-$Event::Eval = 1; # no idea why this is required, but it is
+
+use Event; $Event::Eval = 1; # no idea why this is required, but it is
 
 # work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
 $YAML::Syck::ImplicitUnicode = 1;
 
-use strict;
+$Coro::main->prio (2); # run main coroutine ("the server") with very high priority
 
 sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
 
@@ -24,18 +36,43 @@
 our %COMMAND_TIME = ();
 our %EXTCMD       = ();
 
-_init_vars;
-
 our @EVENT;
 our $LIBDIR = datadir . "/ext";
 
 our $TICK = MAX_TIME * 1e-6;
 our $TICK_WATCHER;
 our $NEXT_TICK;
+our $NOW;
 
 our %CFG;
 
 our $UPTIME; $UPTIME ||= time;
+our $RUNTIME;
+
+our %MAP; # all maps
+our $LINK_MAP; # the special {link} map
+our $FREEZE;
+our $RANDOM_MAPS = cf::localdir . "/random";
+our %EXT_CORO;
+
+binmode STDOUT;
+binmode STDERR;
+
+# read virtual server time, if available
+unless ($RUNTIME || !-e cf::localdir . "/runtime") {
+   open my $fh, "<", cf::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;
+
+# a special map that is always available
+our $LINK_MAP;
 
 #############################################################################
 
@@ -47,11 +84,20 @@
 
 The timestamp of the server start (so not actually an uptime).
 
+=item $cf::RUNTIME
+
+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::NOW
+
+The time of the last (current) server tick.
+
 =item $cf::TICK
 
 The interval between server ticks, in seconds.
@@ -68,10 +114,11 @@
 BEGIN {
    *CORE::GLOBAL::warn = sub {
       my $msg = join "", @_;
+      utf8::encode $msg;
+
       $msg .= "\n"
          unless $msg =~ /\n$/;
 
-      print STDERR "cfperl: $msg";
       LOG llevError, "cfperl: $msg";
    };
 }
@@ -86,7 +133,7 @@
 # we bless all objects into (empty) derived classes to force a method lookup
 # within the Safe compartment.
 for my $pkg (qw(
-   cf::global
+   cf::global cf::attachable
    cf::object cf::object::player
    cf::client cf::player
    cf::arch cf::living
@@ -134,12 +181,208 @@
    JSON::Syck::Dump $_[0]
 }
 
+=item cf::sync_job { BLOCK }
+
+The design of crossfire+ requires that the main coro ($Coro::main) is
+always able to handle events or runnable, as crossfire+ is only partly
+reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.
+
+If it must be done, put the blocking parts into C<sync_job>. This will run
+the given BLOCK in another coroutine while waiting for the result. The
+server will be frozen during this time, so the block should either finish
+fast or be very important.
+
+=cut
+
+sub sync_job(&) {
+   my ($job) = @_;
+
+   my $busy = 1;
+   my @res;
+
+   # TODO: use suspend/resume instead
+   local $FREEZE = 1;
+
+   my $coro = Coro::async {
+      @res = eval { $job->() };
+      warn $@ if $@;
+      undef $busy;
+   };
+
+   if ($Coro::current == $Coro::main) {
+      $coro->prio (Coro::PRIO_MAX);
+      while ($busy) {
+         Coro::cede_notself;
+         Event::one_event unless Coro::nready;
+      }
+   } else {
+      $coro->join;
+   }
+
+   wantarray ? @res : $res[0]
+}
+
+=item $coro = cf::coro { BLOCK }
+
+Creates and returns a new coro. This coro is automcatially being canceled
+when the extension calling this is being unloaded.
+
+=cut
+
+sub coro(&) {
+   my $cb = shift;
+
+   my $coro; $coro = async {
+      eval {
+         $cb->();
+      };
+      warn $@ if $@;
+   };
+
+   $coro->on_destroy (sub {
+      delete $EXT_CORO{$coro+0};
+   });
+   $EXT_CORO{$coro+0} = $coro;
+
+   $coro
+}
+
+sub write_runtime {
+   my $runtime = cf::localdir . "/runtime";
+
+   my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
+      or return;
+
+   my $value = $cf::RUNTIME;
+   (aio_write $fh, 0, (length $value), $value, 0) <= 0
+      and return;
+
+   aio_fsync $fh
+      and return;
+
+   close $fh
+      or return;
+
+   aio_rename "$runtime~", $runtime
+      and return;
+
+   1
+}
+
 =back
 
 =cut
 
 #############################################################################
 
+package cf::path;
+
+sub new {
+   my ($class, $path, $base) = @_;
+
+   my $self = bless { }, $class;
+
+   if ($path =~ s{^\?random/}{}) {
+      Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
+      $self->{random} = cf::from_json $data;
+   } else {
+      if ($path =~ s{^~([^/]+)?}{}) {
+         $self->{user_rel} = 1;
+
+         if (defined $1) {
+            $self->{user} = $1;
+         } elsif ($base =~ m{^~([^/]+)/}) {
+            $self->{user} = $1;
+         } else {
+            warn "cannot resolve user-relative path without user <$path,$base>\n";
+         }
+      } elsif ($path =~ /^\//) {
+         # already absolute
+      } else {
+         $base =~ s{[^/]+/?$}{};
+         return $class->new ("$base/$path");
+      }
+
+      for ($path) {
+         redo if s{/\.?/}{/};
+         redo if s{/[^/]+/\.\./}{/};
+      }
+   }
+
+   $self->{path} = $path;
+
+   $self
+}
+
+# the name / primary key / in-game path
+sub as_string {
+   my ($self) = @_;
+
+   $self->{user_rel} ? "~$self->{user}$self->{path}"
+   : $self->{random} ? "?random/$self->{path}"
+                     : $self->{path}
+}
+
+# the displayed name, this is a one way mapping
+sub visible_name {
+   my ($self) = @_;
+
+#   if (my $rmp = $self->{random}) {
+#      # todo: be more intelligent about this
+#      "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
+#   } else {
+      $self->as_string
+#   }
+}
+
+# escape the /'s in the path
+sub _escaped_path  {
+   # ∕ is U+2215
+   (my $path = $_[0]{path}) =~ s/\//∕/g;
+   $path
+}
+
+# the original (read-only) location
+sub load_path {
+   my ($self) = @_;
+
+   sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
+}
+
+# the temporary/swap location
+sub save_path {
+   my ($self) = @_;
+
+   $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
+   : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
+                     : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
+}
+
+# the unique path, might be eq to save_path
+sub uniq_path {
+   my ($self) = @_;
+
+   $self->{user_rel} || $self->{random}
+      ? undef
+      : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
+}
+
+# return random map parameters, or undef
+sub random_map_params {
+   my ($self) = @_;
+
+   $self->{random}
+}
+
+# this is somewhat ugly, but style maps do need special treatment
+sub is_style_map {
+   $_[0]{path} =~ m{^/styles/}
+}
+
+package cf;
+
+#############################################################################
+
 =head2 ATTACHABLE OBJECTS
 
 Many objects in crossfire are so-called attachable objects. That means you can
@@ -251,15 +494,24 @@
       }
    }
 
+=item $attachable->valid
+
+Just because you have a perl object does not mean that the corresponding
+C-level object still exists. If you try to access an object that has no
+valid C counterpart anymore you get an exception at runtime. This method
+can be used to test for existence of the C object part without causing an
+exception.
+
 =cut
 
 # the following variables are defined in .xs and must not be re-created
-our @CB_GLOBAL = (); # registry for all global events
-our @CB_OBJECT = (); # all objects (should not be used except in emergency)
-our @CB_PLAYER = ();
-our @CB_CLIENT = ();
-our @CB_TYPE   = (); # registry for type (cf-object class) based events
-our @CB_MAP    = ();
+our @CB_GLOBAL     = (); # registry for all global events
+our @CB_ATTACHABLE = (); # registry for all attachables
+our @CB_OBJECT     = (); # all objects (should not be used except in emergency)
+our @CB_PLAYER     = ();
+our @CB_CLIENT     = ();
+our @CB_TYPE       = (); # registry for type (cf-object class) based events
+our @CB_MAP        = ();
 
 my %attachment;
 
@@ -275,6 +527,9 @@
                            @{$registry->[$event] || []}, $cb;
 }
 
+# hack
+my %attachable_klass = map +($_ => 1), KLASS_OBJECT, KLASS_CLIENT, KLASS_PLAYER, KLASS_MAP;
+
 # attach handles attaching event callbacks
 # the only thing the caller has to do is pass the correct
 # registry (== where the callback attaches to).
@@ -285,6 +540,11 @@
    my $prio = 0;
    my %cb_id = map +("on_" . lc $EVENT[$_][0], $_) , grep $EVENT[$_][1] == $klass, 0 .. $#EVENT;
 
+   #TODO: get rid of this hack
+   if ($attachable_klass{$klass}) {
+      %cb_id = (%cb_id, map +("on_" . lc $EVENT[$_][0], $_) , grep $EVENT[$_][1] == KLASS_ATTACHABLE, 0 .. $#EVENT);
+   }
+
    while (@arg) {
       my $type = shift @arg;
 
@@ -369,7 +629,7 @@
    exists $obj->{_attachment}{$name}
 }
 
-for my $klass (qw(GLOBAL OBJECT PLAYER CLIENT MAP)) {
+for my $klass (qw(ATTACHABLE GLOBAL OBJECT PLAYER CLIENT MAP)) {
    eval "#line " . __LINE__ . " 'cf.pm'
       sub cf::\L$klass\E::_attach_registry {
          (\\\@CB_$klass, KLASS_$klass)
@@ -415,19 +675,13 @@
    0
 }
 
-=item $bool = cf::invoke EVENT_GLOBAL_XXX, ...
-
-=item $bool = $object->invoke (EVENT_OBJECT_XXX, ...)
-
-=item $bool = $player->invoke (EVENT_PLAYER_XXX, ...)
+=item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...)
 
-=item $bool = $client->invoke (EVENT_CLIENT_XXX, ...)
+=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...)
 
-=item $bool = $map->invoke (EVENT_MAP_XXX, ...)
+Generate an object-specific event with the given arguments.
 
-Generate a global/object/player/map-specific event with the given arguments.
-
-This API is preliminary (most likely, the EVENT_KLASS_xxx prefix will be
+This API is preliminary (most likely, the EVENT_CLASS_xxx prefix will be
 removed in future versions), and there is no public API to access override
 results (if you must, access C<@cf::invoke_results> directly).
 
@@ -436,43 +690,12 @@
 =cut
 
 #############################################################################
-
-=head2 METHODS VALID FOR ALL ATTACHABLE OBJECTS
-
-Attachable objects includes objects, players, clients and maps.
-
-=over 4
-
-=item $object->valid
-
-Just because you have a perl object does not mean that the corresponding
-C-level object still exists. If you try to access an object that has no
-valid C counterpart anymore you get an exception at runtime. This method
-can be used to test for existence of the C object part without causing an
-exception.
-
-=back
-
-=cut
-
-#############################################################################
 # object support
 
-sub instantiate {
-   my ($obj, $data) = @_;
-
-   $data = from_json $data;
-
-   for (@$data) {
-      my ($name, $args) = @$_;
-
-      $obj->attach ($name, %{$args || {} });
-   }
-}
-
-# basically do the same as instantiate, without calling instantiate
 sub reattach {
+   # basically do the same as instantiate, without calling instantiate
    my ($obj) = @_;
+
    my $registry = $obj->registry;
 
    @$registry = ();
@@ -491,34 +714,67 @@
    }
 }
 
+cf::attachable->attach (
+   prio           => -1000000,
+   on_instantiate => sub {
+      my ($obj, $data) = @_;
+
+      $data = from_json $data;
+
+      for (@$data) {
+         my ($name, $args) = @$_;
+
+         $obj->attach ($name, %{$args || {} });
+      }
+   },
+   on_reattach => \&reattach,
+   on_clone => sub {
+      my ($src, $dst) = @_;
+
+      @{$dst->registry} = @{$src->registry};
+
+      %$dst = %$src;
+
+      %{$dst->{_attachment}} = %{$src->{_attachment}}
+         if exists $src->{_attachment};
+   },
+);
+
 sub object_freezer_save {
    my ($filename, $rdata, $objs) = @_;
 
-   if (length $$rdata) {
-      warn sprintf "saving %s (%d,%d)\n",
-         $filename, length $$rdata, scalar @$objs;
-
-      if (open my $fh, ">:raw", "$filename~") {
-         chmod SAVE_MODE, $fh;
-         syswrite $fh, $$rdata;
-         close $fh;
+   sync_job {
+      if (length $$rdata) {
+         warn sprintf "saving %s (%d,%d)\n",
+            $filename, length $$rdata, scalar @$objs;
 
-         if (@$objs && open my $fh, ">:raw", "$filename.pst~") {
+         if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
             chmod SAVE_MODE, $fh;
-            syswrite $fh, Storable::nfreeze { version => 1, objs => $objs };
+            aio_write $fh, 0, (length $$rdata), $$rdata, 0;
+            aio_fsync $fh;
             close $fh;
-            rename "$filename.pst~", "$filename.pst";
+
+            if (@$objs) {
+               if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
+                  chmod SAVE_MODE, $fh;
+                  my $data = Storable::nfreeze { version => 1, objs => $objs };
+                  aio_write $fh, 0, (length $data), $data, 0;
+                  aio_fsync $fh;
+                  close $fh;
+                  aio_rename "$filename.pst~", "$filename.pst";
+               }
+            } else {
+               aio_unlink "$filename.pst";
+            }
+
+            aio_rename "$filename~", $filename;
          } else {
-            unlink "$filename.pst";
+            warn "FATAL: $filename~: $!\n";
          }
-
-         rename "$filename~", $filename;
       } else {
-         warn "FATAL: $filename~: $!\n";
+         aio_unlink $filename;
+         aio_unlink "$filename.pst";
       }
-   } else {
-      unlink $filename;
-      unlink "$filename.pst";
    }
 }
 
@@ -533,36 +789,20 @@
 sub object_thawer_load {
    my ($filename) = @_;
 
-   local $/;
+   my ($data, $av);
 
-   my $av;
+   (aio_load $filename, $data) >= 0
+      or return;
 
-   #TODO: use sysread etc.
-   if (open my $data, "<:raw:perlio", $filename) {
-      $data = <$data>;
-      if (open my $pst, "<:raw:perlio", "$filename.pst") {
-         $av = eval { (Storable::thaw <$pst>)->{objs} };
-      }
-      return ($data, $av);
+   unless (aio_stat "$filename.pst") {
+      (aio_load "$filename.pst", $av) >= 0
+         or return;
+      $av = eval { (Storable::thaw <$av>)->{objs} };
    }
 
-   ()
+   return ($data, $av);
 }
 
-cf::object->attach (
-   prio     => -1000000,
-   on_clone => sub {
-      my ($src, $dst) = @_;
-
-      @{$dst->registry} = @{$src->registry};
-
-      %$dst = %$src;
-
-      %{$dst->{_attachment}} = %{$src->{_attachment}}
-         if exists $src->{_attachment};
-   },
-);
-
 #############################################################################
 # command handling &c
 
@@ -760,6 +1000,8 @@
 
 Functions and methods that extend core crossfire objects.
 
+=head3 cf::player
+
 =over 4
 
 =item cf::player::exists $login
@@ -773,6 +1015,26 @@
       or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;
 }
 
+=item $player->ext_reply ($msgid, $msgtype, %msg)
+
+Sends an ext reply to the player.
+
+=cut
+
+sub cf::player::ext_reply($$$%) {
+   my ($self, $id, %msg) = @_;
+
+   $msg{msgid} = $id;
+
+   $self->send ("ext " . to_json \%msg);
+}
+
+=back
+
+=head3 cf::object::player
+
+=over 4
+
 =item $player_object->reply ($npc, $msg[, $flags])
 
 Sends a message to the player, as if the npc C<$npc> replied. C<$npc>
@@ -783,6 +1045,7 @@
 
 # rough implementation of a future "reply" method that works
 # with dialog boxes.
+#TODO: the first argument must go, split into a $npc->reply_to ( method
 sub cf::object::player::reply($$$;$) {
    my ($self, $npc, $msg, $flags) = @_;
 
@@ -796,20 +1059,6 @@
    }
 }
 
-=item $player->ext_reply ($msgid, $msgtype, %msg)
-
-Sends an ext reply to the player.
-
-=cut
-
-sub cf::player::ext_reply($$$%) {
-   my ($self, $id, %msg) = @_;
-
-   $msg{msgid} = $id;
-
-   $self->send ("ext " . to_json \%msg);
-}
-
 =item $player_object->may ("access")
 
 Returns wether the given player is authorized to access resource "access"
@@ -826,9 +1075,111 @@
          : $cf::CFG{"may_$access"})
 }
 
+=head3 cf::client
+
+=over 4
+
+=item $client->send_drawinfo ($text, $flags)
+
+Sends a drawinfo packet to the client. Circumvents output buffering so
+should not be used under normal circumstances.
+
+=cut
+
+sub cf::client::send_drawinfo {
+   my ($self, $text, $flags) = @_;
+
+   utf8::encode $text;
+   $self->send_packet (sprintf "drawinfo %d %s", $flags, $text);
+}
+
+
+=item $success = $client->query ($flags, "text", \&cb)
+
+Queues a query to the client, calling the given callback with
+the reply text on a reply. flags can be C<cf::CS_QUERY_YESNO>,
+C<cf::CS_QUERY_SINGLECHAR> or C<cf::CS_QUERY_HIDEINPUT> or C<0>.
+
+Queries can fail, so check the return code. Or don't, as queries will become
+reliable at some point in the future.
+
 =cut
 
-#############################################################################
+sub cf::client::query {
+   my ($self, $flags, $text, $cb) = @_;
+
+   return unless $self->state == ST_PLAYING
+              || $self->state == ST_SETUP
+              || $self->state == ST_CUSTOM;
+
+   $self->state (ST_CUSTOM);
+
+   utf8::encode $text;
+   push @{ $self->{query_queue} }, [(sprintf "query %d %s", $flags, $text), $cb];
+
+   $self->send_packet ($self->{query_queue}[0][0])
+      if @{ $self->{query_queue} } == 1;
+}
+
+cf::client->attach (
+   on_reply => sub {
+      my ($ns, $msg) = @_;
+
+      # this weird shuffling is so that direct followup queries
+      # get handled first
+      my $queue = delete $ns->{query_queue};
+
+      (shift @$queue)->[1]->($msg);
+
+      push @{ $ns->{query_queue} }, @$queue;
+
+      if (@{ $ns->{query_queue} } == @$queue) {
+         if (@$queue) {
+            $ns->send_packet ($ns->{query_queue}[0][0]);
+         } else {
+            $ns->state (ST_PLAYING) if $ns->state == ST_CUSTOM;
+         }
+      }
+   },
+);
+
+=item $client->coro (\&cb)
+
+Create a new coroutine, running the specified callback. The coroutine will
+be automatically cancelled when the client gets destroyed (e.g. on logout,
+or loss of connection).
+
+=cut
+
+sub cf::client::coro {
+   my ($self, $cb) = @_;
+
+   my $coro; $coro = async {
+      eval {
+         $cb->();
+      };
+      warn $@ if $@;
+   };
+
+   $coro->on_destroy (sub {
+      delete $self->{_coro}{$coro+0};
+   });
+
+   $self->{_coro}{$coro+0} = $coro;
+
+   $coro
+}
+
+cf::client->attach (
+   on_destroy => sub {
+      my ($ns) = @_;
+
+      $_->cancel for values %{ (delete $ns->{_coro}) || {} };
+   },
+);
+
+=back
+
 
 =head2 SAFE SCRIPTING
 
@@ -1058,6 +1409,14 @@
 }
 
 sub main {
+   # we must not ever block the main coroutine
+   local $Coro::idle = sub {
+      Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
+      (Coro::unblock_sub {
+         Event::one_event;
+      })->();
+   };
+
    cfg_load;
    db_load;
    load_extensions;
@@ -1067,20 +1426,33 @@
 #############################################################################
 # initialisation
 
-sub _perl_reload(&) {
-   my ($msg) = @_;
+sub perl_reload() {
+   # can/must only be called in main
+   if ($Coro::current != $Coro::main) {
+      warn "can only reload from main coroutine\n";
+      return;
+   }
+
+   warn "reloading...";
 
-   $msg->("reloading...");
+   local $FREEZE = 1;
+   cf::emergency_save;
 
    eval {
+      # if anything goes wrong in here, we should simply crash as we already saved
+
       # cancel all watchers
       for (Event::all_watchers) {
          $_->cancel if $_->data & WF_AUTOCANCEL;
       }
 
+      # cancel all extension coros
+      $_->cancel for values %EXT_CORO;
+      %EXT_CORO = ();
+
       # unload all extensions
       for (@exts) {
-         $msg->("unloading <$_>");
+         warn "unloading <$_>";
          unload_extension $_;
       }
 
@@ -1088,7 +1460,7 @@
       while (my ($k, $v) = each %INC) {
          next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
 
-         $msg->("removing <$k>");
+         warn "removing <$k>";
          delete $INC{$k};
 
          $k =~ s/\.pm$//;
@@ -1103,10 +1475,11 @@
 
       # sync database to disk
       cf::db_sync;
+      IO::AIO::flush;
 
       # get rid of safe::, as good as possible
       Symbol::delete_package "safe::$_"
-         for qw(cf::object cf::object::player cf::player cf::map cf::party cf::region);
+         for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
 
       # remove register_script_function callbacks
       # TODO
@@ -1119,31 +1492,43 @@
       #Symbol::delete_package __PACKAGE__;
 
       # reload cf.pm
-      $msg->("reloading cf.pm");
+      warn "reloading cf.pm";
       require cf;
+      cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
 
       # load config and database again
       cf::cfg_load;
       cf::db_load;
 
       # load extensions
-      $msg->("load extensions");
+      warn "load extensions";
       cf::load_extensions;
 
       # reattach attachments to objects
-      $msg->("reattach");
+      warn "reattach";
       _global_reattach;
    };
-   $msg->($@) if $@;
 
-   $msg->("reloaded");
+   if ($@) {
+      warn $@;
+      warn "error while reloading, exiting.";
+      exit 1;
+   }
+
+   warn "reloaded successfully";
 };
 
-sub perl_reload() {
-   _perl_reload {
-      warn $_[0];
-      print "$_[0]\n";
-   };
+#############################################################################
+
+unless ($LINK_MAP) {
+   $LINK_MAP = cf::map::new;
+
+   $LINK_MAP->width  (41);
+   $LINK_MAP->height (41);
+   $LINK_MAP->alloc;
+   $LINK_MAP->path ("{link}");
+   $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
+   $LINK_MAP->in_memory (MAP_IN_MEMORY);
 }
 
 register "<global>", __PACKAGE__;
@@ -1152,27 +1537,29 @@
    my ($who, $arg) = @_;
 
    if ($who->flag (FLAG_WIZ)) {
-      _perl_reload {
-         warn $_[0];
-         $who->message ($_[0]);
-      };
+      $who->message ("start of reload.");
+      perl_reload;
+      $who->message ("end of reload.");
    }
 };
 
 unshift @INC, $LIBDIR;
 
 $TICK_WATCHER = Event->timer (
-   prio  => 0,
-   at    => $NEXT_TICK || 1,
-   data  => WF_AUTOCANCEL,
-   cb    => sub {
-      cf::server_tick; # one server iteration
+   reentrant => 0,
+   prio      => 0,
+   at        => $NEXT_TICK || $TICK,
+   data      => WF_AUTOCANCEL,
+   cb        => sub {
+      unless ($FREEZE) {
+         cf::server_tick; # one server iteration
+         $RUNTIME += $TICK;
+      }
 
-      my $NOW = Event::time;
       $NEXT_TICK += $TICK;
 
       # if we are delayed by four ticks or more, skip them all
-      $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
+      $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
 
       $TICK_WATCHER->at ($NEXT_TICK);
       $TICK_WATCHER->start;
@@ -1181,11 +1568,25 @@
 
 IO::AIO::max_poll_time $TICK * 0.2;
 
-Event->io (fd   => IO::AIO::poll_fileno,
-           poll => 'r',
-           prio => 5,
-           data => WF_AUTOCANCEL,
-           cb   => \&IO::AIO::poll_cb);
+Event->io (
+   fd   => IO::AIO::poll_fileno,
+   poll => 'r',
+   prio => 5,
+   data => WF_AUTOCANCEL,
+   cb   => \&IO::AIO::poll_cb,
+);
+
+Event->timer (
+   data     => WF_AUTOCANCEL,
+   after    => 0,
+   interval => 10,
+   cb       => sub {
+      (Coro::unblock_sub {
+         write_runtime
+            or warn "ERROR: unable to write runtime file: $!";
+      })->();
+   },
+);
 
 1