#! perl

use IO::Socket;
use Storable qw/nfreeze thaw/;

my %global; # for use by eval'ed commands

sub tcp_serve($) {
   my ($fh) = @_;

   binmode $fh, ":raw:perlio:utf8";

   my $buf;
   my ($a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z);
   my (%l, @l); # for use by shell users

   print $fh "Welcome!\n",
             "Remember that everything entered here will be in the main coro context within cf::!\n",
             "You can freely use \$a .. \$z and \@l and \%l\n";
   print $fh "\n> ";

   Event->io (fd => $fh, poll => 'r', data => 0, cb => sub {
      if (defined (my $cmd = <$fh>)) {
         my $old_fh = select $fh;

         if ($cmd =~ /^\s*exit\b/i) {
            print "will not exit() server.\n";
         } else {
            package cf;
            my @res = eval $cmd;
            warn "tcpshell evaluation error: $@" if $@;
            print $@ if $@;

            print cf::dumpval @res > 1 ? \@res : $res[0] if @res;
         }

         print "\n> ";
         select $old_fh;
      } else {
         $_[0]->w->cancel;
      }
   });
}

# now a shell listening on a tcp-port - let the firewall decide access rights
if ($cf::CFG{perl_shell}) {
   if (my $listen = new IO::Socket::INET LocalAddr => $cf::CFG{perl_shell}, Listen => 1, ReuseAddr => 1) {
      Event->io (fd => $listen, poll => 'r', data => cf::WF_AUTOCANCEL, cb => sub { tcp_serve $listen->accept });
   }
}