--- deliantra/server/lib/cf.pm	2006/12/30 16:56:16	1.104
+++ deliantra/server/lib/cf.pm	2006/12/31 21:02:05	1.108
@@ -15,8 +15,11 @@
 use Coro::Timer;
 use Coro::Signal;
 use Coro::Semaphore;
+use Coro::AIO;
 
-use IO::AIO 2.3;
+use Digest::MD5;
+use Fcntl;
+use IO::AIO 2.31 ();
 use YAML::Syck ();
 use Time::HiRes;
 
@@ -49,6 +52,8 @@
 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;
@@ -64,8 +69,10 @@
 mkdir cf::localdir . "/" . cf::playerdir;
 mkdir cf::localdir . "/" . cf::tmpdir;
 mkdir cf::localdir . "/" . cf::uniquedir;
+mkdir $RANDOM_MAPS;
 
-our %EXT_CORO;
+# a special map that is always available
+our $LINK_MAP;
 
 #############################################################################
 
@@ -174,6 +181,47 @@
    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
@@ -199,12 +247,137 @@
    $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/}{}) {
+      $self->{random} = cf::from_json $path;
+   } 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) = @_;
+
+   $self->{random} ? "?random/$self->{random}{origin_map}+$self->{random}{origin_x}+$self->{random}{origin_y}/$self->{random}{dungeon_level}"
+                   : $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, Digest::MD5::md5_hex $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
@@ -565,31 +738,38 @@
 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";
    }
 }
 
@@ -604,20 +784,18 @@
 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);
 }
 
 #############################################################################
@@ -1226,6 +1404,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;
@@ -1235,13 +1421,20 @@
 #############################################################################
 # initialisation
 
-sub _perl_reload() {
+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...";
 
-   eval {
-      local $FREEZE = 1;
+   local $FREEZE = 1;
+   cf::emergency_save;
 
-      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) {
@@ -1310,13 +1503,27 @@
       warn "reattach";
       _global_reattach;
    };
-   warn $@ if $@;
 
-   warn "reloaded";
+   if ($@) {
+      warn $@;
+      warn "error while reloading, exiting.";
+      exit 1;
+   }
+
+   warn "reloaded successfully";
 };
 
-sub perl_reload() {
-   _perl_reload;
+#############################################################################
+
+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__;
@@ -1325,8 +1532,9 @@
    my ($who, $arg) = @_;
 
    if ($who->flag (FLAG_WIZ)) {
-      $who->message ("reloading...");
-      _perl_reload;
+      $who->message ("start of reload.");
+      perl_reload;
+      $who->message ("end of reload.");
    }
 };
 
@@ -1355,20 +1563,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);
-
-# we must not ever block the main coroutine
-$Coro::idle = sub {
-   #Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
-   warn "FATAL: Coro::idle was called, major BUG\n";
-   (Coro::unblock_sub {
-      Event::one_event;
-   })->();
-};
+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