LINUX.ORG.RU

perl, IPC & socket - чего тут не так?


0

0

надо мне консоль некой программы вывести через сокет для клиентов. 

Написал программу:

#!/usr/bin/perl -w

use IPC::Open2;
use IO::Socket;
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;
print "[Server $0 accepting clients]\n";

my $pid = open2(*RD, *WR, 'bash');

if ($pid1 = fork) {
  close(RD);
  while($client = $server->accept()){
    $client->autoflush(1);
    while (defined($line = <$client>)) {
      print "[$line ] <-\n";
      print WR "$line\n";
    }
    close $client;
  }
  close(WR);
  waitpid($pid1,0);
} else {
  die "cannot fork: $!" unless defined $pid;
  close(WR);
  while(<RD>){
    print "<child $_ >\n";
  }
}

запускаю телнет, ввожу команды:

[vilfred@mobile100 devel]$ telnet localhost 9000
Trying 127.0.0.1...
Connected to localhost.localdomain (127.0.0.1).
Escape character is '^]'.
ls
ls -la

вывод сервера, к которому подсоединяюсь клиентом:

[vilfred@mobile100 devel]$ perl zxc.pl
[Server zxc.pl accepting clients]
[ls
 ] <-
: command not found
[ls -la
 ] <-
ls: неверная опция --
Попробуйте `ls --help' для получения более подробного описания.


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

☆☆

вобщем, часть проблемы решилась, однако, \r\n оказывается вылазит иногда.

vilfred ☆☆
() автор топика

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

короче так (не мультиклиент еще для одной проги, но это уже полбеды): 

#!/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;
print "[Server $0 accepting clients]\n";

my $pid = open2(\*RD, \*WR, 'bash');

while($client = $server->accept()){
  $client->autoflush(1);
  my ($byte,$c,$rr);
  if ($pid1 = fork) {
    close(RD); close STDIN;
    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;
        $rr=''
      } if $byte=~m![\cM\cJ\n]!sm;
    }
    close $client;
    close(WR);
    waitpid($pid1,0);
  } else {
    die "cannot fork: $!" unless defined $pid;
    close(WR);
    while(<RD>){
      print $client "$_";
    }
    close RD;
  }
}

vilfred ☆☆
() автор топика
Ответ на: комментарий от anonymous

и inetd мне отдаст вывод стдоут и стдин проги в сокет? Если это так, скажи что мне читать. потому как есть конешно интерес сделать :) но и время тож иногда бывает ограниченным :(

vilfred ☆☆
() автор топика
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.