[perl] проброс проги в сокет

Barbie29

по мотивам беседы в H&S написал прогу по след техзаданию(просто ради исскуства). дык она один раз соединят, а второй нет. толи 5 утра уже, толи я чето гдето забыл
что надо, есть некая прога, консольная, которая не имеет сокетного интерфейса
для соединения через интернет.
Надо написать для неё оболочку, которая бы умела пробрасывать диалог
пользователя с программой через сокет, т.е. telnet 123.233.12.24 9000
и ты пишешь команды в прогу, и она тебе возвращает значение как будто
ты на консоли работаешь.
Короче я это дело написал на сабже, но толи уже 5 утра и лыжи не едут,
толи еще чего-то. Вобщем один раз оно логинится, но второй уже не
хочет. Походу я чего то где то уже не вижу. Это можно обойти
перезапуском сервера по отрубанию клента, но не хотелось бы. С зомбями
все вроде бы ок, но гдето там чето застревает.

#!/usr/bin/perl -w



use IPC::Open2;

use IO::Socket;

#use IPC::Shareable;

use strict;

my $PORT = 9000;

my ($pid1,$line,$server,$client);

$server = IO::Socket::INET->new( Proto     => 'tcp',

                                 LocalPort => $PORT,

                                 Listen    => SOMAXCONN,

                                 Reuse     => 1);

die "can't setup server $!" unless $server;

my $pid = open2(\*RD, \*WR, '/bin/bash') or die "cant open: $!\n";

while($client = $server->accept{

  $client->autoflush(1);

  print "next client\n";

  my ($byte,$c,$rr);

  if ($pid1 = fork) {

    while (sysread($client, $byte, 1) == 1) {

      $c=1 if $byte=~m!.!sm;

      $rr.=$byte if $c==1;

      do{

        $c=0; $rr=~s!(.*)[\r|\n|\cM|\cJ]$!$1\n!;

        print $rr; #print "\\r" if $rr=~m!\n$!sm;

        print WR $rr if $rr ne '';

        $rr='';

      } if $byte=~m![\r\cM\cJ\n]!sm;

    }

    close $client;

    waitpid($pid1,0);

  } else {

    die "cannot fork: $!" unless defined $pid;

    while(<RD>){

      print $client "$_";

    }

  }

  close $client;

}

/bin/bash сюда вставлен просто для удобства отладки. конешно я
понимаю, что это мегадырища в безопастности и т.п. Т.е. на самом
деле там конешно будет /bin/my_cool_program
вот как диалог с сервером выглядит с клиента:

[server /root]# telnet 22.15.136.142 9000

Trying 22.15.136.142...

Connected to www.server.ru (22.15.136.142).

Escape character is '^]'.

w

 01:11:10  up 4 days, 13:03,  7 users,  load average: 0.60, 0.59, 0.55

USER     TTY      FROM                 IDLE   JCPU   PCPU  WHAT

vilfred  pts/1    221.15.136.142   Tue 4pm  3days  0.03s  0.03s  -bash

vilfred  pts/2    -                Tue 8pm  3days  0.06s  0.06s  /bin/bash

vilfred  pts/3    -                Tue 8pm  3days  0.06s  0.06s  /bin/bash

vilfred  pts/4    -                Tue 8pm  3days 21.32s 21.30s  stime

vilfred  pts/5    22.15.136.142    Tue 4pm  3days  0.64s  0.59s  screen -rd

vilfred  pts/6    prorval.test.usu 12:16am 53:07   0.06s  0.01s  sshd: vilfred [

root     pts/7    prorval.test.usu 12:34am  4.00s  0.25s  0.04s  -bash

who

vilfred  pts/1        Jan 15 16:35 (221.15.136.142)

vilfred  pts/2        Jan 15 20:20

vilfred  pts/3        Jan 15 20:20

vilfred  pts/4        Jan 15 20:20

vilfred  pts/5        Jan 15 16:53 (22.15.136.142)

vilfred  pts/6        Jan 19 00:16 (prorval.test.usu)

root     pts/7        Jan 19 00:34 (prorval.test.usu)

^]



telnet> quit

Connection closed.

[server /root]# 

если же телнет запустить второй раз - то не заработает, отчегото,
толи гдето перевод каретки запрятался, толи еще чето.

VitMix

если же телнет запустить второй раз - то не заработает

А какой смысл постить листинг первой, успешной сессии? В ней же ошибка не проявляется!
Запостил бы, хотя бы, листинг второй, неуспешной...

VitMix

А если по делу, то у тебя вот тут, скорее всего, прога зацикливается:
while(<RD>){
print $client "$_";
}
Этот цикл не закончится, пока bash не умрёт. А с чего бы ему умереть?

Barbie29

походу надо это клиентом делать. а сервер должен держать или отфоркивать клиентов. т.е. архитекутра не та у проги, т.к. одноразовая. спасибо за наводку.