view release on metacpan or  search on metacpan

Deliantra/Protocol/Base.pm  view on Meta::CPAN

   my ($self, @nonces) = @_;

   $self->{nonces} = \@nonces;
   $self->addme_ok;
}

sub addme_wait {
   ++$_[0]{addme_wait}
}

sub addme_ok {
   my ($self) = @_;

   return if --$self->{addme_wait};

   # done with negotiation

   my $done_cb = sub {
      my ($ok, $msg) = @_;

      $self->{on_addme}($ok, $msg)
         if $self->{on_addme};

      # server is supposed to close the connection on error
   };

   $self->setup ($self->{setup});

   if ($self->{create_login}) {
      $self->send_exti_req (create_login => $self->{user}, $self->{pass}, $done_cb);
   } else {
      my ($n1, $n2) = @{ $self->{nonces} };

      if (
         $n1 eq $n2
         or length $n1 < 32
         or length $n2 < 32
      ) {
         # crypto error, avoid playing oracle
         return $self->feed_eof;
      }

      my $pass = Deliantra::Util::auth_pw $self->{pass}, $n1, $n2;
      $self->send_exti_req (login => $self->{user}, $pass, $done_cb);
   }

   $self->{addme_success} = 1;
   $self->addme;

   $self->feed_newmap;
}

# not documented, maybe not so useful
sub addme { }

sub addme_guard {
   my ($self) = @_;

   $self->addme_wait;

   Scalar::Util::weaken $self;
   AnyEvent::Util::guard {
      $self->addme_ok if $self;
   }
}

sub token {
   ++$_[0]{token}
}

sub feed {
   my ($self, $data) = @_;

   eval {
      $data =~ s/^([^ ]+)(?: |$)//
         or return;

      my $cb = $self->can ("feed_$1")
         or return; # ignore unknown commands

      $cb->($self, $data);
   };

   warn $@ if $@;
}

sub feed_lzf {
   my ($self, $data) = @_;

   $self->feed (decompress $data);
}

sub feed_frag {
   my ($self, $data) = @_;

   if (length $data) {
      $self->{_frag} .= $data;
   } else {
      $self->feed (delete $self->{_frag});
   }
}

sub feed_goodbye {
   my ($self) = @_;

   # nop
}

sub feed_version {
   my ($self, $version) = @_;

   if ($version =~ /^(\d+) (\d+) (.*)/) {
      $self->{s_version} = {
         sc_version => $1,
         cs_version => $2,
         server     => $3,
      };
   } else {
      $self->{s_version} = $self->{json_coder}->decode ($version);
   }
}