LINUX.ORG.RU
Форум — Development  

perl простой сервер, проблема с $client->close()

 , ,


0

1

Хеллоу евриуан!) Помогите пожалуйста с перл скриптом. Соединяюсь telnet'ом на 3000 порт, ввожу quit, а соединение не сбрасывается: 

use IO::Socket::INET;
use threads;
use 5.010;

my $srv = IO::Socket::INET->new(LocalPort => 3000, Proto => 'tcp', Listen => 5,
                                Reuse => 1) or die $!;

while ($cli = $srv->accept()) {
    threads->create(
        sub {
            while ($cli) {
                $cli->recv($data, 1024);
                $data =~ s/\v//g;
                my ($cmd, $arg) = split ' ', $data;
                given ($cmd) {
                    when ('..')   { chdir ".." }
                    when ('ls')   { my $ls = join ' ', (glob "./*");
                                    $cli->send($ls . "\n");          }
                    when ('cd')   { chdir $arg or $cli->send("$!\n") }
                    when ('md')   { mkdir $arg or $cli->send("$!\n") }
                    when ('rmd')  { rmdir $arg or $cli->send("$!\n") }
                    when ('quit') { $cli->close }
                    when ('halt') { exit }
                    default       { $cli->send("Неизвестная команда\n")}
                };
       });
}
1. запускаю в терминале 2. с телнета соединившись набираю quit 3. скрипт в терминале высвечивает Thread 1 terminated abnormally: send: Cannot determine peer address at ./server.pl line 24 thread 1.

Вариант ruby работает отлично: 

#-*- coding:utf-8 -*-
require 'socket'

server = TCPServer.new 3000
loop do
    Thread.start(server.accept) { |cli|
        while cli
            cmd, arg = cli.gets.chomp.split " "
            case cmd
                when ".."    then Dir.chdir ".." rescue cli.puts $!#"error"
                when "ls"    then cli.puts  Dir.glob("./*").join ' '
                when "cd"    then Dir.chdir arg  rescue cli.puts $!#"error"
                when "md"    then Dir.mkdir arg  rescue cli.puts $!#"error"
                when "rmd"   then Dir.rmdir arg  rescue cli.puts $!#"error"
                when "quit!" then cli.close
                when "halt!" then exit
                else         cli.puts "Неизвестная команда \n"
            end
        end
    }
end

Deleted

Видимо так 

use strict;
use IO::Socket::INET;
use threads;
use 5.010;

my $srv = IO::Socket::INET->new(LocalPort => 3000, Proto => 'tcp', Listen => 5,
                                Reuse => 1) or die $!;

while (my $cli = $srv->accept()) {
    threads->create(
        sub {
            while ($cli->connected) {
                $cli->recv(my $data, 1024);
                $data =~ s/\v//g;
                my ($cmd, $arg) = split ' ', $data;
                
                given ($cmd) {
                    when ('..')   { chdir ".." }
                    when ('ls')   { my $ls = join ' ', (glob "./*");
                                    $cli->send($ls . "\n");          }
                    when ('cd')   { chdir $arg or $cli->send("$!\n") }
                    when ('md')   { mkdir $arg or $cli->send("$!\n") }
                    when ('rmd')  { rmdir $arg or $cli->send("$!\n") }
                    when ('quit') { $cli->close }
                    when ('halt') { exit }
                    default       { $cli->send("Неизвестная команда\n")}
                };
            }
       });
}

Olegymous ★★★
()

#-*- coding:utf-8 -*-

вот я тебя и нашёл!

скажи, эта волшебная емакс-строка # -*- var:val -*- обязательно должна быть первой? Т.е. если первой строкой идет интерпретатор #! /usr/bin/env perl, то эта строка уже просто комментарий и никому не интересна?

Stil ★★★★★
()
Ответ на: комментарий от Olegymous

спасибо. добавив use warnings, diagnostics; интерпретатор выдал:

getpeername() on closed socket GEN1 at /usr/lib/perl5/IO/Socket.pm line 270 (#1) (W closed) You tried to get a socket or peer socket name on a closed socket. Did you forget to check the return value of your socket() call?

Стоит беспокоиться?

Deleted
()
Ответ на: комментарий от Stil

я от тебя не прятался :)

у меня в файле две строки: первая - /usr/bin/env ruby, а вторая #-*- coding:utf-8 -*-. Перлу вторую строку нет необходимости указывать. По невнимательности скопировал только от этой строки =) Но спасибо за разъяснение)

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