package MConnection;
use strict;
use vars qw(
  @ISA
  %Connections
  $ListenSocket
  $NextConID
  %ANSITable
);

use Carp;
use IO::Socket;
use IO::File;
use MGlobals;
use MObject;
use AllocTracker;

use constant GA   => chr(255) . chr(249);
use constant EOFF => chr(255) . chr(0xFB) . chr(1);
use constant EON  => chr(255) . chr(0xFC) . chr(1);
use constant SCR_WIDTH => 79;
use constant SCR_HEIGHT => 24;

#@ISA = qw(AllocTracker);

%ANSITable = (
  '&'  => '&',
  'z'  => '',
  'zz' => '',

  n => "\x1B[0m", # normal

  sb => "\x1B[1m", # bold
  su => "\x1B[4m", # underline
  sf => "\x1B[5m", # flash
  si => "\x1B[7m", # inverse

  # fg colors
  fk => "\x1B[30m", k => "\x1B[30m",
  fr => "\x1B[31m", r => "\x1B[31m",
  fg => "\x1B[32m", g => "\x1B[32m",
  fy => "\x1B[33m", 'y'=>"\x1B[33m",
  fb => "\x1B[34m", b => "\x1B[34m",
  fm => "\x1B[35m", 'm'=>"\x1B[35m",
  fc => "\x1B[36m", c => "\x1B[36m",
  fw => "\x1B[37m", w => "\x1B[37m",

  bk => "\x1B[40m",
  br => "\x1B[41m",
  bg => "\x1B[42m",
  by => "\x1B[43m",
  bb => "\x1B[44m",
  bm => "\x1B[45m",
  bc => "\x1B[46m",
  bw => "\x1B[47m",
);
$NextConID = 1 unless $NextConID;

### Listening - class methods ### ### ### ### ### ### ### ### ### ### ###

sub listen_start {
  my ($class, $port) = @_;

  $ListenSocket = new IO::Socket::INET (
    LocalHost => '127.0.0.1',
    LocalPort => $port,
    Proto     => 'tcp',
    Listen    => 5,
    Timeout   => .001,
  ) or die "Can't create socket: $!\n";
}

sub listen_stop {
  my ($class) = @_;

  $ListenSocket->close if $ListenSocket;
  undef $ListenSocket;
}

sub listen_idle {
  my ($class, $timeout) = @_;

  $ListenSocket->timeout($timeout) if defined $timeout;
  if ($ListenSocket and $ListenSocket->opened) {
    eval {
      my $new = $ListenSocket->accept;
      return unless $new;
      $new->timeout(30);
      $class->new($new);
    };
    die $@ if $@ and $@ !~ /timeout/;
    return 1;
  } else {
    # warn "listen_idle with no socket";
    return 0;
  }
}

### Connections ### ### ### ### ### ### ### ### ### ### ###

sub new {
  my ($class, $sock) = @_;

  my $self = bless {
    sock => $sock,
    in_buffer => '',
    state => 'ansi',
    IP => eval {(join '.', unpack 'C4', $sock->peeraddr)} || 'n/a',
    port => eval {$sock->peerport} || 'n/a',
    needsprompt => 1,
    aliases => {},
    scr_width => 80,
    scr_height => 24,
  }, $class;
  #syslog "$self->{IP}:$self->{'port'}: new connection";
  print "$self CREATED\n" if ::GC_DEBUG;

  $Connections{my $id = $NextConID++} = $self;
  $self->{id} = $id;
  $self->send("You have connected to $::MUDName.");

  return $self;
}

sub ip {$_[0]{IP}}
sub port {$_[0]{port}}

sub send_str_raw {
  my ($self, $t) = @_;
  $t =~ s/\n/\015\012/g if $self->{IP} ne 'n/a';
  my $s = $self->{sock};
  goto FAILED unless defined $s and $s->opened;
  my $len = syswrite $s, $t, length($t);
  goto FAILED unless defined $len;
  # die "huh?" if $len != length($t);
  return 1;
  FAILED:
  $self->disconnect();
  return 0;
}

sub send_str {
  my ($self, $text) = @_;

  return unless $self->{sock};
  $text =~ s/&([a-z&]{1,2})(;?)/&{sub{
    return $self->{ansi} ? $ANSITable{$1} : '' if exists $ANSITable{$1};
    return "&$1$2";
  }}/eg;
  $self->send_str_raw($text);
}

sub send {
  my ($self, $text) = @_;

  if (not defined $text) {
    carp "Undef passed to MConnection::send";
    return;
  }
  $text =~ s/\n+$//;
  return unless $self->{sock};
  $self->send_str("\n") if not $self->{needsprompt} and not $self->{gotline};
  $self->send_str("$text\n");
  $self->{needsprompt} = 1;
}

sub do_page {
  my ($self, $text) = @_;

  # This is the entry point for the pager; all it does right
  # now is wrap long lines. It does not handle the color codes well.

  if (not defined $text) {
    carp "Undef passed to MConnection::do_page";
    return;
  }
  my $fmtext = '';
  my $t;
  my $wid = $self->scr_width;
  foreach (split /\n/, $text) {
    $t = $_;
    {
      (my $noansi = $t) =~ s/&([a-z&]{1,2})(;?)//g;
      my $char = length $t;
      if (length $noansi > $wid) {
        $char = $wid + 1;
        $char-- while substr($t, $char - 1, 1) !~ /\s/;
      }
      my $out = substr($t, 0, $char);
      $out =~ s/\s+$//;
      $fmtext .= "$out\n";
      next if $char >= length $t;
      $t = substr($t, $char);
      redo if $t;
    }
  }
  $self->send($fmtext);
}

sub object {
  my ($self, $obj) = @_;

  $self->{object} = $obj if defined $obj;
  $self->{object};
}
sub ansi {$_[0]->{ansi}}
sub scr_width {$_[0]->{scr_width}}
sub scr_height {$_[0]->{scr_height}}

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

  {
    my $tx;
    do {$self->disconnect; return} unless $self->{sock};
    my $mask = my $junk = my $junk2 = ''; vec($mask,fileno($self->{sock}),1) = 1;
    next unless select($junk=$mask, undef, $junk2=$mask, 0);
    my $res = sysread $self->{sock}, $tx, 4096;
    $self->disconnect unless defined $res;
    next unless $res;
    $self->{in_buffer} .= $tx;
  }

  return unless $self->{sock};
  if ($self->{needsprompt}) {
    $self->send_str(&{{
      'ansi' => sub {'Does your terminal support ANSI color [Y/n]? '},
      'login' => sub {'By what name do you wish to be known? '},
      'pass' => sub {'Password: ' . EOFF},
      'confirm_name' => sub {"Did I get that right, $self->{login_name} [y/N]? "},
      'newpass_old' => sub {'Enter your old password: ' . EOFF},
      'newpass_new' => sub {'Enter your new password: ' . EOFF},
      'newpass_new2' => sub {'Confirm your new password: ' . EOFF},
      'menu' => sub {qq{
&c;  +---------------------------+
  | 0. Quit                   |
  | 1. Enter the world        |
  | P. Change password        |
  | D. Delete this player     |
  +---------------------------+&n;

What do you want to do? }},
      'command' => sub {
        my $obj = $self->{'object'};
        my $hit = int($obj->c_hit);
        $hit = "&r;$hit&n;" if $hit / $obj->m_hit < .20;
        my $move = int($obj->c_move);
        $move = "&m;$move&n;" if $move / $obj->m_move < .20;
        my $enf = int($obj->en_fire);
        my $enw = int($obj->en_water);
        my $ena = int($obj->en_air);
        my $ene = int($obj->en_earth);
        "\n@{[$obj->ispc ? '' : $obj->name . ' ']}${hit}H ${move}V $enf/$enw/$ena/${ene}M> ";
      },
    }->{$self->{'state'}} || sub {die "no prompt for state: $self->{'state'}"}} . GA);
    $self->{needsprompt} = 0;
  }

  return unless $self->{sock};
  while ($self->open and $self->{in_buffer} =~ s/^(.*?)[\015\012]//) {
    my $input = $1;
    $self->{in_buffer} =~ s/^[\015\012]//;
    for ($input) {
      s/^\s+//;
      s/\s+$//;
      tr/\x00-\x1F\x7F-\xFF//d; # this does chom?p's job too
    }
    $self->{'gotline'} = 1;
    &{{
      'ansi' => sub {
        $self->{'ansi'} = $input !~ /^n/i;
        $self->send('');
        $self->send($::Misc{splash});
        $self->send('');
        $self->setstate('login');
      },
      'login' => sub {
        $input or do {$self->disconnect; return};
        my $name = ucfirst $input;
        $self->{login_name} = $name;
        if (!-e ":players:@{[lc $name]}.obj") {
          # Should I ever make this mud fully cross-platform, the 'lc' is in there for
          # those broken file systems that care about filename case.     :)
          $self->setstate('confirm_name');
        } elsif (has_password($name)) {
          $self->setstate('pass');
        } else {
          $self->setstate('menu');
        }
      },
      'pass' => sub {
        $self->send(EON); # implicitly adds \n
        my $name = $self->{'login_name'};
        unless (authenticate($name, $input)) {
          $self->send('Incorrect password.');
          syslog "$self->{IP}:$self->{'port'}: bad login attempt for '$name'";
          $self->disconnect;
          return;
        }
        $self->setstate('menu');
      },
      'newpass_old' => sub {
        $self->send(EON);
        $input or do {$self->send("Cancelled."); $self->setstate('menu'); return};
        my $name = $self->{'login_name'};
        unless (authenticate($name, $input)) {
          $self->send('Incorrect password.');
          $self->setstate('menu');
          return;
        }
        $self->setstate('newpass_new');
      },
      'newpass_new' => sub {
        $self->send(EON);
        $input or do {$self->send("Cancelled."); $self->setstate('menu'); return};
        $self->{"new_password"} = $input;
        $self->setstate('newpass_new2');
      },
      'newpass_new2' => sub {
        $self->send(EON);
        $input or do {$self->send("Cancelled."); $self->setstate('menu'); return};
        if ($input eq $self->{"new_password"}) {
          set_player_password($self->{'login_name'}, $input);
          $self->send('Password changed.');
          $self->setstate('menu');
        } else {
          $self->send("The two passwords did not match.");
          $self->setstate('newpass_new');
        }
      },
      'confirm_name' => sub {
        if ($input !~ /^y/i) {
          $self->setstate('login');
          return;
        }
        $self->send("Okay, I'll make a new player.");
        $self->send("Don't forget to set your password.");
        $self->{newplayer} = 1;
        $self->setstate('menu');
      },
      'menu' => sub {
        &{{
          0 => sub {$self->disconnect},
          1 => sub {$self->do_connect($self->{login_name})},
          p => sub {$self->setstate(has_password($self->{login_name}) ? 'newpass_old' : 'newpass_new')},
          d => sub {$self->send("Sorry, that's not implemented yet.")},
        }->{lc $input} || sub {$self->send("That is not a valid choice.")}};
      },
      'command' => sub {
        $self->{'object'}->command($input);
      },
    }->{$self->{'state'}}};
    if ($self->open) {
      $self->{gotline} = 0;
      $self->{needsprompt} = 1;
    }
  }
}

sub do_connect {
  my ($self, $name) = @_;

  my ($obj, $recon);
  if (!-e ":players:@{[lc $name]}.obj") {
    $self->send("New player.");
    $obj = make_new_player($name);
    syslog "$self->{IP}:$self->{'port'}: New player: '$name'";
  } elsif (!$obj and $obj = find_named_player($name)) {
    $self->send('Reconnecting.');
    $recon = 1;
    syslog "$self->{IP}:$self->{'port'}: $name has reconnected";
  } else {
    $self->send('Restoring player.');
    $obj = load_player($name);
    syslog "$self->{IP}:$self->{'port'}: $name has entered the game";
  }
  $self->link_to_player($obj, $recon);
}

sub link_to_player {
  my ($self, $obj, $recon) = @_;

  $self->setstate('command');
  if ($obj->connection) {
    $obj->act('Multiple login detected...disconnecting.',
              $obj->name . ' explodes into dust!');
    syslog($obj->name . " has re-logged in...disconnecting old socket.");
    $obj->connection->disconnect('silent');
  }
  $obj->connection($self);
  $self->object($obj);
  $obj->saveable(1);
  $self->send('');
  $obj->command('look');
  $obj->act(undef, $recon
    ? $obj->name . " has reconnected."
    : "You feel a distortion of reality and " . $obj->name . " appears.");
}

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

  $self->object(undef);
  $self->setstate('menu');
}

sub make_new_player {
  my ($name) = @_;

  my $obj = MObject->new('prototype' => PLAYER_PROTO);
  $obj->aliases($name);
  $obj->name($name);
  for my $meth (qw(str int wis dex con cha)) {
    my $bmeth = "${meth}_base";
    $obj->$bmeth(my $d = dice(3, 6));
    $obj->$meth($d);
  }
  $obj->stradd_base(my $d = $obj->str == 18 ? dice(1, 100) : 0);
  $obj->stradd($d);
  
  $::Rooms{$obj->loadroom}->add_contents($obj);
  $obj;
}

sub load_player {
  my ($name) = @_;

  my $file = ":players:@{[lc $name]}.obj";
  my $hand = IO::File->new("< $file") or die $!;
  local $/;
  my $obj = MObject->thaw(<$hand>);
  $obj->c_hit(10) if $obj->c_hit < 10;
  $obj->c_move(10) if $obj->c_move < 10;
  $obj->position(8);
  $obj->fighting(undef);
  $::Rooms{$obj->loadroom}->add_contents($obj);
  $obj;
}

sub find_named_player {
  my ($name) = @_;

  my $found = 0;
  foreach my $obj (values %MObject::Objects) {
    $found = $obj, last if $obj->ispc and lc $obj->name eq lc $name;
  }
}

sub authenticate {
  my ($name, $pass) = @_;

  local *PFILE;
  $name = lc $name;
  open PFILE, ":players:$name.pass" or return 1;
  my $realpass = <PFILE>;
  chomp $realpass;
  close PFILE;
  return (crypt($pass, substr($realpass, 0, 2)) eq $realpass);
}

sub has_password {
  my ($name) = @_;

  return -e ":players:$name.pass";
}

sub set_player_password {
  my ($name, $newpass) = @_;

  (my $dname) = $name =~ /(^\w+$)/ or die "bad name: $name";
  $dname = lc $dname;
  local *PFILE;
  open PFILE, "> :players:$dname.pass" or return '';
  my @chars = ('a'..'z', 'A'..'Z', 0..9, '.');
  print PFILE crypt($newpass, $chars[rand @chars] . $chars[rand @chars]);
  close PFILE;
}

sub do_alias_cmd {
  my ($self, $args) = @_;

  my ($name, $cmds) = split /\s+/, $args, 2;
  if (defined $name) {
    if (defined $cmds) {
      $self->{aliases}{$name} = $cmds;
      # $self->send("Set alias.");
    } else {
      delete $self->{aliases}{$name};
      # $self->send("Deleted alias.");
    }
  } else {
    $self->send("Currently defined aliases:");
    foreach (keys %{$self->{aliases}}) {
      $self->send(sprintf "%-16s -> %s", $_, $self->{aliases}{$_});
    }
  }
}

sub setstate {
  $_[0]{state} = $_[1];
  $_[0]{needsprompt} = 1;
}

sub open {$_[0]->{sock} ? 1 : 0}

sub disconnect {
  my ($self, $opt) = @_;

  if ($self->{sock}) {
    undef $self->{sock};
    $self->{'disc_hook'}->() if $self->{'disc_hook'};
  }
  delete $Connections{$self->{id}} if $self->{id};
  if ($self->{'object'}) {
    $self->{'object'}->act(undef, $self->{'object'}->name . " has lost $GENDER_POSS[$self->{'object'}->gender] link.")
      unless $opt and $opt eq 'silent';
    $self->{'object'}->connection(undef);
  }
  %{$self} = ();
}

sub DESTROY {
  my ($self) = @_;
  $self->disconnect;
  print "$self DESTROYED\n" if ::GC_DEBUG;
  1;
}


1;
