LINUX.ORG.RU

работа с сокетами на перле. нужна помошь


0

0

есть два скрипта. 1. #!/usr/bin/perl

use strict; use IO::Socket; use IO::Select;

my $texts={}; my $serv=new IO::Socket::INET( Proto => 'tcp', LocalAddr => '10.0.36.10:25', Listen => 10, Reuse => 1 );

my $sel=new IO::Select();

$sel->add($serv); my $timeout = 300;

while (1) { foreach my $cli ($sel->can_read($timeout)) { if ($cli eq $serv) { # оПЧПЕ УПЕДЙОЕОЙЕ $cli=$serv->accept(); $texts->{$cli}=""; $sel->add($cli); $cli->send("220 Welcome to Qmail Toaster",1024); } else { # рТЙЫМЙ ЛБЛЙЕ-ФП ДБООЩЕ? my ($tmp,$size); $size=$cli->recv($tmp,1024); print $size."\n"; if (defined $size && $size > 0) { #дЕКУФЧЙФЕМШОП РТЙЫМЙ $texts->{$cli}.=$tmp; # дПВБЧМСЕН ДБООЩЕ Ч ЛПОЕГ print $texts->{$cli}; work($texts,$cli); } else {#оБ УБНПН ДЕМЕ ТБЪТЩЧ УПЕДЙОЕОЙС print "no carrier.\n"; delete $texts->{$cli}; $sel->remove($cli); } } } }

sub work { my ($texts,$cli)=@_; # рТЧПЧЕТСЕН ЕУФШ МЙ РПМОБС ЖТБЪБ Й ЕУМЙ ЕУФШ ХДБМСЕН ЕЈ # ЙЪ ВХЖЖЕТБ my $ans = $texts->{$cli}; print $ans; my $mail_from; my $rcpt_to; my $quest; my $temp;

if ($ans =~ /HELO/i ) { $cli->send("Some answer");# Send some data } } проблема -- переменная $size не определена а переменная $tmp содержит в себе данные которые пришли по сети.

anonymous

Re: работа с сокетами на перле. нужна помошь

скрипт 2 use strict; use IO::Socket;

my $local = IO::Socket::INET->new( Proto => 'tcp', LocalAddr => '10.0.36.10:25', Listen => 5, Reuse => 1 ) or die "$!";

$local->listen(); #$local->autoflush(0);

print "At your service. Waiting...\n";

my $addr; $|=1; my $SP = 255; my $CRLF = "\x0D\x0A"; my $CR = "\x0D"; my $LF = "\x0A"; open FH,">/root/mail.tmp";

while ($addr = $local->accept() ) { print "Connected from: ", $addr->peerhost(); print " Port: ", $addr->peerport(), "\n"; my $greeting = "220 Welcome to Qmail Toaster.\r\n"; print FH $greeting; print $greeting; my $mail_from; my $rcpt_to; my $temp; my $quest; $addr->send($greeting,1024); $|=1;

while (<$addr>) { my $ans,$quest; my $stop = 0; $ans = ""; #$addr->send($data,64); while ($stop == 0) { #$addr->send("",1024); $addr->recv($ans,1024); print FH $ans; print $ans; if ($ans =~ /HELO/i) { $quest = "250 Welcome to Qmail Toaster.\n"; $addr->send($quest,1024); print $quest; print FH $quest; } if (($ans =~ /MAIL/i) && ($ans =~/FROM/i)) { ($temp,$mail_from) = split /:/,$ans; chomp $mail_from; $quest = "250 Requested mail action okay, completed.\n"; $addr->send($quest,1024); print $mail_from."\n"; print FH $quest; } if (($ans =~ /RCPT/i) && ($ans =~ /TO/i)) { ($temp,$rcpt_to) = split /:/,$ans; chomp $rcpt_to; $quest = "250 Requested mail action okay, completed.\n"; $addr->send($quest,1024); print $rcpt_to."\n"; print FH $quest; } if ($ans =~/DATA/i) { $quest = "354 Start mail input; end with <CRLF>.<CRLF>\n"; $addr->send($quest,1024); print FH $quest; my $start_data = 1; while ($start_data == 1) { $addr->recv($ans,1024,0); print FH $ans; #print "Debug on:".$ans; $ans =~ s/\015\012//gi; #print "Debug off:".$ans."\n";

#chomp $ans;

if ($ans eq ".") { $start_data = 0; #print "\$start_data: ".$start_data."\n"; } else { print $ans."\n"; } } $quest = "250 Requested mail action okay, completed\n"; $addr->send($quest,1024); print FH $quest; } if ($ans =~/QUIT/i) { $quest = "See You.\n"; $addr->send($quest,1024); print FH $quest; $stop = 1; } if ($ans =~/EHLO/i) { $quest= "250-Welcome to Qmail Toaster Ver. 1.2 smtp Server\n". "250-STARTTLS\n". "250-PIPELINING\n". "250-8BITMIME\n". "250-SIZE 20971520\n". "250 AUTH LOGIN PLAIN CRAM-MD5\n"; $addr->send($quest,1024); print FH $quest;

} # print $ans; } close $addr; print "Waiting next connection.\n"; } close FH; } проблема -- почему то сервер в упор не видит первую строку. если пробовать телнетом то нужно нажать ентер а потом набирать команды.

очень нужна ваша помошь

anonymous ()
Ответ на: Re: работа с сокетами на перле. нужна помошь от anonymous

Re: работа с сокетами на перле. нужна помошь

#!/usr/bin/perl -w use strict;use IO::Socket;use IO::Handle;use Socket;use Symbol;use POSIX;use Net::hostent;use Fcntl;use IO::Select; my $port=6002; my $host="127.0.0.1"; my $PREFORK="1"; my $MAX_CLIENTS_PER_CHILD="1";my %children=(); my $children=0;my $f="/mnt/data/mnt/work/control.txt";make_new_child() for(1 .. $PREFORK);$SIG{CHLD}=\&REAPER; $SIG{INT}=\&HUNTSMAN;while(1){ sleep; for(my $i=$children; $i<$PREFORK; $i++){ make_new_child() }} sub make_new_child{ my($pid, $sigset, $kidpid, $server, $client); $sigset=POSIX::SigSet->new(SIGINT); sigprocmask(SIG_BLOCK, $sigset) or die "can't block SIGINT for fork: $!\n"; die "fork: $!" unless defined do{$pid = fork}; if($pid){ sigprocmask(SIG_UNBLOCK, $sigset) or die "can't unblock SIGINT for fork: $!\n"; $children{$pid}=1; $children++; return; } else { $SIG{INT} = 'DEFAULT'; $SIG{CHLD}='IGNORE'; sigprocmask(SIG_UNBLOCK, $sigset) or die "can't unblock SIGINT for fork: $!\n"; for(my $i=0; $i<$MAX_CLIENTS_PER_CHILD; $i++){ # sleep 2; socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC) or die "socketpair: $!"; CHILD->autoflush(1); PARENT->autoflush(1); my $handle = IO::Socket::INET->new( Proto => 'tcp', PeerAddr => $host, PeerPort => $port) or die do{ print "can't connect to port $port on $host: $!\n"; sleep 1; }; print "[Connected to $host:$port]\n"; die "can't fork: $!" unless defined do{$kidpid = fork()}; if ($kidpid) { my ($byte, $tmp); close PARENT; while(sysread($handle, $byte, 1) eq 1){ $tmp.=$byte; do{print CHILD "$tmp\n"; $tmp='' } if $tmp eq 'ok'; # R.A.= 122356 Dec.= -3314 Eok do{print CHILD "$tmp\n"; $tmp='' }if $tmp =~m!R(.*?)Eok!; do{print CHILD $tmp,"\n"; $tmp=''} if $tmp eq 'error'; } close CHILD; kill "TERM" => $kidpid; waitpid($kidpid,0); } else { close CHILD; $server = IO::Socket::INET->new( LocalPort => 6003, Type => SOCK_STREAM, Proto => 'tcp', Reuse => 1, Listen => SOMAXCONN); die "making socket: $! $@" unless $server; print "go translate9\n"; while($client=$server->accept()){ $client->autoflush(1); my $sad = $client -> sockname(); my ($p,$a)= sockaddr_in($sad); my $ph = inet_ntoa($a); print "[Connected from $p:$ph]\n"; my ($line, $line1); while (defined ($line = <$client>)){ print $handle $line; chomp($line1=<PARENT>); print $client "$line1\n"; } # close $client; } close PARENT; close $client; } } exit; }}sub HUNTSMAN{ local($SIG{CHLD})='IGNORE'; kill 'INT' => keys %children; exit;} sub REAPER{ $SIG{CHLD}=\&REAPER; my $pid = wait; $children--; delete $children{$pid};}

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