[PERL] serwer wielowatkowy do logowania i rozsylania wiadomosci

[szlagus]

Witam próbuję sobie stworzyć serwer który:
Po połączeniu bierze dane od użytkownika login-hasło
sprawdza poprawność przez połączenie do strony internetowej
gdy zaloguje się admin ma możliwość opcji wykonania komendy send "jakiś tekst" i jakiś tekst jest wysyłany do klientów i niby mam ten serwer ale jest jeden problem rozsyła on tak naprawdę do póki nie podłączy się druga osoba

#!/usr/bin/perl

use warnings;
use strict;
use IO::Socket;
use threads;
use threads::shared;
use LWP::UserAgent;

$|++;

print "$$ - pid servera\n";

our @clients : shared;
@clients = ();
my $user = 0;

my $server = new IO::Socket::INET(
    Timeout   => 7200,
    Proto     => "tcp",
    LocalPort => 12345,
    Reuse     => 1,
    Listen    => 3
);
my $num_of_client = -1;

while (1) {
    my $client;

    do {
        $client = $server->accept;
    } until ( defined($client) );

    my $peerhost = $client->peerhost();
    print "accepted a client $client, $peerhost, id = ", ++$num_of_client, "\n";
    my $fileno = fileno $client;
    push (@clients, $fileno);
    $user++;
    my $thr = threads->new( \&processit, $client, $fileno, $peerhost,$user )->detach(); 
}

sub loguj {
    my ($login,$pass) = @_;
    my $log = LWP::UserAgent->new;
    $log->agent("TraderServer");
    my $res = $log->get("http://link");
    if ($res->is_success) {
        if ($res->as_string =~ /<info>(.*)<\/info>/) {
            return $1;
        }
    }
}

sub processit {
    my ($lclient,$lfileno,$lpeer,$id) = @_;   
        if ($lclient->connected) {
            my @act = ();
            my $logon = 0;  
            print $lclient "LOGON PLEASE\n";
            while(<$lclient>) {
                my $what = $_;
                chomp ($what);
                $what = "".$what." ";
                if ($logon == 0) {
                    @act = split(' ',$what);
                    if ($act[0] ne "LOGIN") {
                        print $lclient "Aby korzystac z servera prosimy o zalogowanie\n";
                    } else {
                        if (($act[1] eq "admin") and ($act[2] eq "admin")) {
                            $logon = 2;
                        } else {
                            print "".$act[1]." ".$act[2]."\n";
                            my $log_err = loguj($act[1],$act[2]);
                            print $log_err,"\n";
                            if ($log_err eq "ok") {
                                $logon = 1;
                                print $lclient "LOGON SUCCESS\n";
                            } else {
                                print $lclient "Dostep zabroniony\n";
                            }
                        }
                    }
                } else {
                    print "klient-> @clients\n";           
                    my $what = $_;
                    #chomp($what);

                    # Zalogowany jako administrator
                    if ($logon == 2) {
                        $what =~ s/\r//;
                        $what =~ s/\n//;
                        $what = "".$what." ";
                        my @act = ();
                        print "$what\n";
                        @act = split(' ',$what);
                        if ($act[0] eq "send") {
                            # sygnal w nastepujacy sposob: SYSTEM DATE CODE ACTION CENA SL TP BE DO
                            if ($what =~ /"(.*)"/) {
                                #wyslij_syg($1);
                                    foreach my $fn (@clients) { 
                                    open my $fh, ">&=$fn" or warn $! and die;
                                    print $fh  "$1\n";  
                                    }
                                print "zgloszenie wykonane\n";
                            }
                        }
                    }
                    #foreach my $fn (@clients) { 
                     #   open my $fh, ">&=".$fn."" or warn $! and die;
                      #  print $fh  "$lpeer->".$what."\n";  
                       # close ($fh);
                    #}
                }
            }
        }
    close( $lclient);
    @clients = grep {$_ !~ $lfileno} @clients;
}
sub wyslij_syg() {
    my ($syg) = @_;
    foreach my $fn (@clients) { 
        open my $fh, ">&=$fn" or warn $! and die;
        print $fh  "$syg\n";  
   }    
}
__END__

Ogólnie to tak:

podłączam się telnetem loguje jako admin wysyłam komendę send "jakaś treść" i jest ok odpalam drugi telnet podłączam sie jako klient i wysyłam znowu komendę send "asdasdasd" (tu u klienta nie pojawi sie tekst do póki nie naciśnie sobie entera) a adminowi blokuje się kolejna możliwość wysłania komendy send...
Czy mógłbym prosić o pomoc ?

Dodam że nie testowałem tego kodu na linuxie pod windowsem jest problem.

[Elitegroup]

a jak sprawdzisz na warunkach, które będą w rzeczywistości tzn czy odpalenie telnetu, ale na INNYM komputerze i podłączenie się również powoduje zwiechę adm?

To co robisz idzie przez ten sam port na 2 aplikacje, być może to jest przyczyną zwiechy jednego konta.

[szlagus]

Chodzi o to że wszystko się odwiesza gdy w telnecie zrobi się dodatkowy enter - zrobi go każdy podłączony klient (wtedy u klienta wyskakuje wysłany komunikat przez admina i admin może ponownie wysyłać) jakby trzeba było wysłać enter od klienta żeby doszło to co admin pisał (?) napisałem też aplikację która się podłączyła i słała komendy ale wyszło to samo.

[TQM]

Nie myl pojecia wielowatkowosci z asynchronicznoscia... operacje na socketach sa blokujace, tzn jest jedna operacja I/O w danym czasie i jesli ktorys element aplikacji czeka na input to blokuje najczesciej pozostale - ja tez nie raz sie na to nadzialem :-(
LWP na 100000% jest blokujace, wiec jak bedziesz mial jakis wolny serwer ktory potrzebuje 10sek aby wygenerowac strone, to LWP czeka na strone, cala aplikacje czeka na LWP, nic sie nie dzieje.

Mozna to zalatwic na pare sposobow:
- akceptujesz polaczenie i odkladasz w tabeli glob do uchwytu pliku opisujacego polaczenie i pozniej petla select() z timeoutem lecisz przez te sockety i szukasz az cos bezie mialo dane ktore mozesz czytac - taki multiplekser
- przepisujesz kod na cos innego - np zainteresuj sie modulem AnyEvent - mozna fajnie zrobic lekkie, bardzo wydajne i nie blokujace serwery ktore nie uzywaja watkow a wiec nie ma problemu wspoldzielenia zmiennych itd

Co wazne, AnyEvent jest event-based czyli jak cos przyjdzie to odpalany jest callback (normalny sub) i obsluguje to co sie stalo. W AnyEvent mozna wsadzic LWP czy WWW::Mechanize (moja preferencja) i dziala super. Robilem kiedys test:

- pobranie 10 roznych stron jedna po drugiej uzywajac WWW::Mechanize - 7.2sek
- pobranie tych samych stron uzywajac AnyEvent (rownolegle) - 0.85sek

[szlagus]

A masz może przykład takiego servera ?
Szczerze zalezy mi na logowanie ale pierwszy punkt w ktorym opisujesz jak to zrobic nie za wiele mi mowi bo nie bazowalem nigdy na Socketach bez IO::Socket w perlu.
Lub przykład wykorzystania do TCP AnyEvent (poza search cpan) ?

[TQM]

AnyEvent'a najszybsciej wlasnie przez CPAN znajdziesz przyklady. AnyEvent to tylko implementacja nieblokujacej petli (synchroniczna, nieblokujaca i jednowatkowa wiec nie masz problemow ze wspoldzieleniem zmiennych) wiec do obslugi socket'ow tak jak chcesz bedziesz jeszcze musial uzyc AnyEvent::Socket i AnyEvent::Handle

Ja napisalem na AnyEvent receiver do sysloga (UDP) ktory lapie logi ze zdalnych serwerow, zbiera, grupuje po IP zrodla i co 1 minute wysyla przez scp do systemu korelacji logow, ktory (o zgrozo) nie potrafi obsluzyc syslog'a :-(

BTW tu masz ciekawy projekt https://github.com/beanz/anyevent-mocktcpserver-perl - moze uda Ci sie go wziasc nawet jak gotowca i przerobic pod wlasne potrzeby.

Co do tego multipleksera - masz grzebania i nie dziala tak ladnie jak AnyEvent. Po prostu jak otworzysz socket przychodzacy lub wychodzacy (w Twoim przypadku nie ma wielkiego znaczenia raczej) to jego file handle (jako glob) odkladasz w tablicy, pozniej w petli lecisz przez kazdy z tych uchwytow i robisz select() z timeout'em (zobacz do dokumentacji, ostatni argumen to timeout) i teraz jesli cos jest na wejsciu to czytasz i przetwarzasz, jak nie ma to masz timeout i nastepny uchwyt.

Wydajnosciowo potrafi dzialac bardoz ladnie ale stworzenie i utrzymanie tego kodu na chodzie (profesjnolanlnie) to masakra - mowimy o miesiacach vs godziny/dni dla AnyEvent.

[szlagus]

Ok coś tam zrozumiałem w tym czasie z mojego googlowania udało mi się uzyskać dobry efekt przy pomocy:

POE - search.cpan.org

szczerze mówiąc fakt ze odłożyłem LWP::UserAgent i na chwile obecna nie zrobiłem autoryzacji hasłem to teraz nic mi się nie blokuje.

Korzystałeś z tego POE może ? Ciekawi mnie jak wygląda różnica/wydajność między POE a AnyEvent

[TQM]

W POE pisalem pare lat... i przesiadlem sie na AnyEvent jak tylko byla okazja.

AnyEvent o wiele szybsze i o wiele lzejsze - gole POE zaladowane zjada 14MB RAM zanim wyswietli hello world. POE za ciezkie moim zdaniem, odrzucilem je juz calkowicie.