--- deliantra/server/ext/login.ext	2010/05/04 21:45:42	1.109
+++ deliantra/server/ext/login.ext	2012/11/15 07:08:15	1.122
@@ -4,13 +4,9 @@
 
 use Fcntl;
 use Coro::AIO;
+use Deliantra::Util ();
 
-our $MAX_DISCONNECT_TIME = $cf::CFG{max_disconnect_time} || 3600;
-
-# paranoia function to overwrite a string-in-place
-sub nuke_str {
-   substr $_[0], 0, (length $_[0]), "x" x length $_[0]
-}
+CONF MAX_DISCONNECT_TIME = 3600;
 
 sub query {
    my ($ns, $flags, $text) = @_;
@@ -61,10 +57,9 @@
    my $x = $ob->x;
    my $y = $ob->y;
 
-#   return 0;#d#
-#   warn join ":", $m->at ($x, $y);#d#
-#   warn "FOO$m { ".scalar ($m->at ($x, $y))." }\n";
-#   return 0;
+   # never happens normally, but helps when shell users make mistakes
+   $m->linkable
+      or return 1;
 
    scalar grep $_->type == cf::SAVEBED, $m->at ($x, $y)
 }
@@ -128,23 +123,123 @@
    $ob->goto ($map, $x, $y);
 }
 
-sub encode_password {
-   crypt $_[0],
-      join '',
-         ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[(cf::rndm 64), (cf::rndm 64)]
+sub encode_password($) {
+   "!" . unpack "H*", $_[0]
+}
+
+sub compare_password($$) {
+   my ($pass, $token) = @_;
+
+   if ($token =~ /!!(.*)/) {
+      return +(substr $pass, 0, 8) eq pack "H*", $1;
+   } elsif ($token =~ /!(.*)/) {
+      return $pass eq pack "H*", $1;
+   } else {
+      return $token eq crypt $pass, $token;
+   }
 }
 
-# delete a player directory, be non-blocking AND synchronous...
-# (that's hard, so we crap out and fork).
+# delete a player directory
 sub nuke_playerdir {
    my ($user) = @_;
 
+   my $lock = cf::lock_acquire "ext::login::nuke_playerdir";
+
    my $temp = "$PLAYERDIR/~$Coro::current~deleting~";
+   aio_rename "$PLAYERDIR/$user", $temp;
+   IO::AIO::aio_rmtree $temp;
+}
 
-   cf::fork_call {
-      rename "$PLAYERDIR/$user", $temp;
-      system "rm", "-rf", $temp;
-   };
+sub login_done {
+   my ($pl) = @_;
+
+   if (0 < Coro::AIO::aio_load "$cf::CONFDIR/motd", my $motd) {
+      $pl->ns->send_msg ("c/motd" => $motd, cf::NDI_CLEAR);
+   }
+}
+
+sub chargen {
+   my ($ns, $user, $pass) = @_;
+
+   # the rest of this function is character creation
+   $Coro::current->{desc} = "addme($user) chargen";
+
+   # just to make sure nothing is left over
+   # normally, nothing is there.
+   nuke_playerdir $user;
+
+   my $pl = cf::player::new $user;
+   $pl->password (encode_password $pass);
+   $pl->connect ($ns);
+   my $ob = $pl->ob;
+
+   $ob->goto ($pl->maplevel, $ob->x, $ob->y);
+
+   while () {
+      $ob->update_stats;
+      $pl->save_stats;
+
+      my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
+                   "[y] to roll new stats [n] to use stats\n[1-7] [1-7] to swap stats.\nRoll again (y/n/1-7)?";
+
+      if ($res =~ /^[Nn]/) {
+         last;
+      } elsif ($res > 0 && $res <= 7) {
+         my $swap = query $ns, cf::CS_QUERY_SINGLECHAR, "Swap stat with (will not roll new stats) [1-7]?";
+
+         if ($swap > 0 && $swap <= 7) {
+            $ob->swap_stats ($res - 1, $swap - 1);
+         }
+      } else {
+         $ob->roll_stats;
+      }
+
+      Coro::Timer::sleep 0.05;
+   }
+
+   $ob->set_animation (2);
+   $ob->add_statbonus;
+
+   while () {
+      $ns->send_msg ("chargen-race-title", ucfirst $pl->title, -1);
+      my $msg = $ob->msg;
+      $msg =~ s/(?<=\S)\n(?=\S)/ /g;
+      $ns->send_msg ("chargen-race-description", $msg, cf::NDI_BLUE);
+
+      my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
+                   "Now choose a character.\nPress any key to change outlook.\nPress `d' when you're pleased.\n";
+
+      last if $res =~ /[dD]/;
+
+      $pl->chargen_race_next;
+      Coro::Timer::sleep 0.05;
+   }
+
+   # create the playerdir, if necessary, as chargen_race_done did it before
+   # presumably because of unique maps
+   aio_mkdir playerdir $pl, 0770;
+   $pl->chargen_race_done;
+
+   while () {
+      my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
+                   "Now choose a gender.\nPress 'f' to become female, and 'm' to become male.\n";
+
+      if ($res =~ /^[fF]/) {
+         $pl->gender (1);
+         last;
+      } elsif ($res =~ /^[mM]/) {
+         $pl->gender (0);
+         last;
+      }
+      Coro::Timer::sleep 0.05;
+   }
+
+   $ob->reply (undef, "Welcome to Deliantra!");
+
+   # XXX: Workaround for delayed client ext protocol handshake
+   $pl->esrv_new_player;
+
+   delete $pl->{deny_save};
 }
 
 cf::client->attach (on_addme => sub {
@@ -232,15 +327,17 @@
          if (my $pl = cf::player::find $user) {
             aio_stat $pl->path and next;
             my $mtime = (stat _)[9];
-            my $hash = $pl->password;
+            my $token = $pl->password;
+
+            if ($cf::CFG{ext_login_nocheck} or compare_password $pass, $token) {
+               # player exists and passwords match - we can proceed
 
-            if ($cf::CFG{ext_login_nocheck} or $hash eq crypt $pass, $hash) {
-               nuke_str $pass;
                # password matches, wonderful
                my $pl = cf::player::find $user or next;
                $pl->connect ($ns);
                enter_map $pl;
-               last;
+               login_done $pl;
+               return;
             } elsif (can_cleanup $pl, $mtime) {
                Coro::Timer::sleep 1;
 
@@ -251,7 +348,6 @@
                   cf::NDI_RED
                );
 
-               #TODO: nuke_str
                (query $ns, cf::CS_QUERY_SINGLECHAR, "Delete existing account and create a new one (Y/N)?") =~ /^[yY]/
                   or next;
 
@@ -263,8 +359,6 @@
 
                # fall through to creation
             } else {
-               nuke_str $pass;
-
                Coro::Timer::sleep 1;
 
                $ns->send_drawinfo (
@@ -276,7 +370,7 @@
             }
          } else {
             # unable to load the playerfile:
-            # check wether the player dir exists, which means the file is corrupted or
+            # check whether the player dir exists, which means the file is corrupted or
             # something very similar.
             if (!aio_stat cf::player::playerdir $user) {
                $ns->send_drawinfo (
@@ -289,17 +383,9 @@
             }
          }
 
-         # the rest of this function is character creation
-         $Coro::current->{desc} = "addme($user) chargen";
-
-         # just to make sure nothing is left over
-         nuke_playerdir $user;
-
          my $pass2 = query $ns, cf::CS_QUERY_HIDEINPUT, "Please type your password again.";
 
          if ($pass2 ne $pass) {
-            nuke_str $pass;
-            nuke_str $pass2;
             $ns->send_drawinfo (
                "The passwords do not match, please try again.",
                cf::NDI_RED
@@ -308,155 +394,78 @@
             next;
          }
 
-         nuke_str $pass2;
-
-         my $pl = cf::player::new $user;
-         $pl->password (encode_password $pass);
-         nuke_str $pass;
-         $pl->connect ($ns);
-         my $ob = $pl->ob;
-
-         $ob->goto ($pl->maplevel, $ob->x, $ob->y);
-
-         while () {
-            $ob->update_stats;
-            $pl->save_stats;
-
-            my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
-                         "[y] to roll new stats [n] to use stats\n[1-7] [1-7] to swap stats.\nRoll again (y/n/1-7)?";
-
-            if ($res =~ /^[Nn]/) {
-               last;
-            } elsif ($res > 0 && $res <= 7) {
-               my $swap = query $ns, cf::CS_QUERY_SINGLECHAR, "Swap stat with (will not roll new stats) [1-7]?";
-
-               if ($swap > 0 && $swap <= 7) {
-                  $ob->swap_stats ($res - 1, $swap - 1);
-               }
-            } else {
-               $ob->roll_stats;
-            }
-
-            Coro::Timer::sleep 0.05;
-         }
-
-         $ob->set_animation (2);
-         $ob->add_statbonus;
-
-         while () {
-            $ns->send_msg ("chargen-race-title", ucfirst $pl->title, -1);
-            my $msg = $ob->msg;
-            $msg =~ s/(?<=\S)\n(?=\S)/ /g;
-            $ns->send_msg ("chargen-race-description", $msg, cf::NDI_BLUE);
-
-            my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
-                         "Now choose a character.\nPress any key to change outlook.\nPress `d' when you're pleased.\n";
-
-            last if $res =~ /[dD]/;
-
-            $pl->chargen_race_next;
-            Coro::Timer::sleep 0.05;
-         }
+         last;
+      }
 
-         # create the playerdir, if necessary, as chargen_race_done did it before
-         # presumably because of unique maps
-         aio_mkdir playerdir $pl, 0770;
-         $pl->chargen_race_done;
+      # lock again, too layz to make this nicer
+      local $cf::LOGIN_LOCK{$user} = 1;
 
-         while () {
-            my $res = query $ns, cf::CS_QUERY_SINGLECHAR,
-                         "Now choose a gender.\nPress 'f' to become female, and 'm' to become male.\n";
-
-            if ($res =~ /^[fF]/) {
-               $pl->gender (1);
-               last;
-            } elsif ($res =~ /^[mM]/) {
-               $pl->gender (0);
-               last;
-            }
-            Coro::Timer::sleep 0.05;
-         }
+      chargen $ns, $user, $pass;
+      login_done $ns->pl;
+   });
+});
 
-         $ob->reply (undef, "Welcome to Deliantra!");
+cf::client->attach (
+   on_version => sub {
+      my ($ns, $arg) = @_;
 
-         # XXX: Workaround for delayed client ext protocol handshake
-         $pl->esrv_new_player;
+      $ns->ext_msg (nonces => map { join "", map { chr rand 256 } 0..63  } 1..2);
+   },
+);
 
-         delete $pl->{deny_save};
+#cf::register_async_exticmd create_login => sub {
+#   my ($ns, $reply, $user, $pass) = @_;
+#
+#   $ns->pl and return $ns->destroy;
+#};
 
-         last;
-      }
+cf::register_async_exticmd login => sub {
+   my ($ns, $reply, $user, $hash) = @_;
 
-      if (0 < Coro::AIO::aio_load "$cf::CONFDIR/motd", my $motd) {
-         $ns->send_msg ("c/motd" => $motd, cf::NDI_CLEAR);
-      }
-   });
-});
+   $ns->pl and return $ns->destroy;
+};
 
 cf::register_command password => sub {
    my ($pl, $arg) = @_;
 
-   my (@args) = split /\s+/, $arg;
-
-   my ($new_pw, $player);
-
-   if ($pl->flag (cf::FLAG_WIZ)) {
-      ($player, $new_pw) = @args;
-   } else {
-      $new_pw = $args[0];
+   unless ($pl->flag (cf::FLAG_WIZ)) {
+      $pl->message (
+         "The password can currently only changed by a DM.",
+         cf::NDI_UNIQUE | cf::NDI_REPLY);
+      return;
    }
 
+   my (@args) = split /\s+/, $arg;
+   my ($player, $new_pw) = @args;
+
    if ($pl->flag (cf::FLAG_WIZ) && $player eq '') {
       $pl->message (
          "Usage: password <player> [<new password>]",
          cf::NDI_UNIQUE | cf::NDI_REPLY);
       return;
-   } elsif (!$pl->flag (cf::FLAG_WIZ) && $new_pw eq '') {
-      $pl->message (
-         "Usage: password <new password>",
-         cf::NDI_UNIQUE | cf::NDI_REPLY);
-      return;
    }
 
-   if ($player ne '' && $pl->flag (cf::FLAG_WIZ)) {
-      unless ($new_pw ne '') {
-         $new_pw =
-            join '',
-               map { ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[(cf::rndm 64)] }
-                  1..9;
-      }
-
-      cf::async {
-         my $plc = cf::player::find $player;
-         if ($plc) {
-            $plc->password (encode_password $new_pw);
-            $pl->message (
-               "Ok, changed password of '$player' to '$new_pw'!",
-               cf::NDI_UNIQUE | cf::NDI_RED | cf::NDI_REPLY);
-         } else {
-            $pl->message (
-               "Fail! Couldn't set password for '$player', "
-               . "he doesn't seem to exist!",
-               cf::NDI_UNIQUE | cf::NDI_RED | cf::NDI_REPLY);
-         }
-      };
-   } else {
-      my $change = delete $pl->{password_change};
+   if ($new_pw eq '') {
+      $new_pw =
+         join '',
+            map { ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[(cf::rndm 64)] }
+               1..9;
+   }
 
-      if ($change && (time - $change->[0]) < 60) {
+   cf::async {
+      my $plc = cf::player::find $player;
+      if ($plc) {
+         $plc->password (encode_password $new_pw);
          $pl->message (
-            "Ok, changed your password!",
+            "Ok, changed password of '$player' to '$new_pw'!",
             cf::NDI_UNIQUE | cf::NDI_RED | cf::NDI_REPLY);
-         $pl->contr->password (encode_password $new_pw);
-
       } else {
          $pl->message (
-            "Ok, please confirm your new password by sending "
-            . "the command again within one minute!",
+            "Fail! Couldn't set password for '$player', "
+            . "he doesn't seem to exist!",
             cf::NDI_UNIQUE | cf::NDI_RED | cf::NDI_REPLY);
-         $pl->{password_change} = [time, $new_pw];
       }
-   }
+   };
 };
 
 cf::register_command quit => sub {
@@ -478,9 +487,7 @@
          $ob->send_msg (undef, "Ok, not not quitting then.", cf::NDI_UNIQUE | cf::NDI_RED | cf::NDI_REPLY);
       } else {
          $ob->send_msg (undef, "Ok, quitting, hope to see you again.", cf::NDI_UNIQUE | cf::NDI_RED | cf::NDI_REPLY);
-         $pl->ns->flush;
          cf::async {
-            ext::highscore::check $pl->ob;
             $pl->quit_character;
          };
       }
@@ -498,22 +505,26 @@
 
       # update respawn position
       $pl->savebed ($bed->map->path, $bed->x, $bed->y);
-      cf::async { $pl->save };
 
-      my $killer = cf::arch::get "killer_logout"; $pl->killer ($killer); $killer->destroy;
-      ext::highscore::check $ob;
+      cf::async {
+         my $killer = cf::arch::get "killer_logout"; $pl->killer ($killer); $killer->destroy;
+         ext::highscore::check $ob;
 
-      $ob->send_msg ($cf::SAY_CHANNEL => "In the future, you will wake up here when you die.", cf::NDI_DEF | cf::NDI_REPLY);
+         $pl->save;
 
-      $pl->ns->query (cf::CS_QUERY_SINGLECHAR, "Do you want to continue playing (y/n)?", sub {
-         if ($_[0] !~ /^[yY]/) {
-            $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1);
-            $pl->deactivate;
-            $pl->ns->destroy;
-         } else {
-            cf::async { $pl->save };
-         }
-      });
+         $ob->send_msg ($cf::SAY_CHANNEL => "In the future, you will wake up here when you die.", cf::NDI_DEF | cf::NDI_REPLY);
+
+         my $ns = $pl->ns
+            or return;
+
+         $ns->query (cf::CS_QUERY_SINGLECHAR, "Do you want to continue playing (y/n)?", sub {
+            if ($_[0] !~ /^[yY]/) {
+               $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1);
+               $pl->deactivate;
+               $pl->ns->destroy;
+            }
+         });
+      };
    },
 );