VPF::Односторонние каналы к потомками

TroRg

Дата 20.3.2008, 19:09 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 29.1.2008

Репутация: нет
Всего: нет

Приветствую, подскажите как реализовать постоянные односторонние каналы к потомкам,
сколько ни мучался, не получается реализовать в этом коде.

Код


#!/usr/bin/perl

use IO::Handle;
use IO::Select;
use Socket;
use IO::Socket;
use POSIX;
use Digest::MD5 qw/md5_hex/;
use DBI;
use DBD::mysql;
use strict;
use warnings;


my $proto  = 'tcp';
my $port   = 10001;
my $reuse  = 1;
my $listen = 10;
my $client;
my @ready;
my $peeraddr;
my $i=0;
my %proc;

socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC) or die "socketpair : $!\n";
CHILD->autoflush(1);
PARENT->autoflush(1);
my $srv = IO::Socket::INET->new(LocalPort => $port, Proto => $proto, Reuse => $reuse, Listen => $listen);
die "Socket error : $!" unless defined $srv;

my $select = IO::Select->new($srv);

while (1){
    foreach my $cl ($select->can_read(1)){
        #
        if ($cl == $srv){
            $client = $srv->accept();
            #Общий родительский цикл,ожидаие подключения
            my $pid = fork;
            unless($pid!=0){
                $srv->close();
                undef $proto;
                undef $port;
                undef $reuse;
                undef $listen;
                $peeraddr = inet_ntoa($client->peeraddr());
                my ($buffer,$data,$inbuffer,$rv);
                my $auth = 0;
                while (1){
                    if ($auth != 1){
                        $rv = $client->recv($buffer, POSIX::BUFSIZ, 0);
                        unless (defined($rv) && length($buffer)){
                            undef $rv;
                            undef $buffer;
                            undef $auth;
                            undef $data;
                            undef $inbuffer;
                            undef $peeraddr;
                            $client->close();
                            exit(0);
                        }
                        $inbuffer .= $buffer;
                        while ($inbuffer =~ s/(.*\n)//){
                            push (@ready, chomp((my $ch = $1)));
                        }
                    }else{
                        push(@ready, "sdev");
                    }

                    foreach my $request (@ready){
                        if ($request =~ /^exit$|^quit$/){
                            $client->close();
                            exit(1);
                        }
                        if ($request =~ /^l:(.{1,20});p:(.{1,20});.*/){
                            my $login = $1;
                            my $pass = md5_hex($2);
                            my $dbh = DBI->connect("DBI:mysql:test:localhost", "test", "test");
                            my $sth = $dbh->prepare("SELECT * FROM users WHERE username='".$login."' AND password='".$pass."'");
                            $sth->execute();
                            if (my $ips = $sth->fetchrow_hashref()){
                                print "authenticated!\n";
                            }
                        }
                        my $vr = $client->send("Lallalalaa\n", 0);
                    }
                    $#ready = -1;
                }
                exit(0);
            }
        }
    }
}

sir_nuf_nuf

Дата 20.3.2008, 22:51 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 920
Регистрация: 6.1.2008

Репутация: 14
Всего: 31

а pipe вообще не вариант ?

--------------------

TroRg

Дата 21.3.2008, 10:56 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 29.1.2008

Репутация: нет
Всего: нет

всем спасибо за внимание, решил проблему

Это сообщение отредактировал(а) TroRg - 21.3.2008, 20:51

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: Общие вопросы \| Следующая тема »