Все знают, что любая книга по программированию начинается с приведения примера программы hello world. Я тоже не буду оригинальничать и покажу, как надо писать hello world. Но в отличие от других авторов, которые очень быстро переходят от этой программы к каким-то очень высоким материям, философским обоснованиям, паттернам программирования и шаблонам проектирования (чтобы это всё ни значило), я ограничусь только hello world. Кто-то же должен заполнить пробел между hello world и… веб-сервером :)).

Итак…

Задача: написать классическую программу hello world

Есть такое классное правило разработки: без хорошего ТЗ всё получится ХЗ.

Скажите, почему в книжках по программированию всегда приводится примерно такое совершенно примитивное убожество:

Код 1 — code1.rs:

fn main() {
    println!("Hello, World!");
}

А всё потому что в этих серьезных книгах для hello world нет даже упоминания ТЗ. Но так как я не просто очередной никому неизвестный автор книжки по программированию, а всё-таки какой-никакой а программист, я первым делом составлю ТЗ: этот hello world должен выводить “hello world” всегда и везде: на компе, на сотовом, днем, ночью, мне, вам…

Я знаю что это очень плохое ТЗ, но уверяю вас 90% других ТЗ еще хуже :))

Для решения такой задачи код 1 конечно не годится. Да и вообще на самом деле так никто не программирует, обычно программа — это отдельный сервис, даже, не побоюсь этого слова, микросервис. А что вообще такое сервис? Это некая программа, которая принимает запросы и выдает результаты. На самом деле принимать запросы программа может всего несколькими способами:

• параметры командной строки — запрос приходит в момент запуска;

• стандартный ввод — запрос приходит через stdin;

• файлы — запрос лежит в файле, и программа читает его с диска;

• сеть — запрос приходит по сети.

Для моего ТЗ подходит прием запросов по сети. Значит эта программа должна стать сетевым сервером, который принимает соединения по определенному порту.

Если делать всё по правильному, то порт надо брать из параметра командной строки, если его нет, то по умолчанию пусть порт будет 8080.

Так же в ТЗ нет никакой конкретики по архитектуре и стеку, поэтому я волен выбирать что угодно. И я выбираю Linux и Perl. Почему именно эта пара?

Потому что задача этой книги — не показать красивый фреймворк, а показать, как всё работает на самом деле: сокеты, файловые дескрипторы, события, неблокирующий ввод-вывод, поведение ядра. Linux здесь нужен потому что он даёт нормальный, честный, прозрачный интерфейс: сокет — это файловый дескриптор, событие — это бит в маске, epoll — это системный вызов, а не чёрный ящик. Perl здесь нужен потому что он позволяет работать с этим интерфейсом очень близко к системе, но без лишней бюрократии. У него есть fileno(), sysread(), syswrite(), нормальные ссылочные структуры, модуль IO::Epoll, и при этом можно написать сервер в несколько десятков строк, не потеряв понимания, где именно происходит магия.

Потому что я больше ничего не знаю.

Итак, вот код который решает задачу:

Код 2 — скрипт code2.rev6.pl:

#!/usr/local/bin/perl
use strict;
use warnings;
use IO::Socket::INET;

# Читаем порт из параметров командной строки, по умолчанию 8080
sub get_port {
    my $port = @ARGV ? shift @ARGV : 8080;
    die "порт должен быть целым числом: $port" unless $port =~ /\A[0-9]+\z/;
    return $port;
}

# Создаём слушающий сокет на указанном порту
sub get_server {
    my ($port) = @_;

    return IO::Socket::INET->new(
        LocalPort => $port,
        Proto     => 'tcp',
        Listen    => 5,
        Reuse     => 1,
    );
}

# Принимаем одно клиентское соединение
sub get_client {
    my ($server) = @_;

    my $client = $server->accept() or die "ошибка accept: $!";
    return $client;
}

# Собираем HTTP-ответ
sub get_response {
    my ($body) = @_;

    return "HTTP/1.1 200 OK\r\n"
        . "Content-Type: text/plain; charset=utf-8\r\n"
        . "Content-Length: " . length($body) . "\r\n"
        . "\r\n"
        . $body;
}

my $port   = get_port();
my $server = get_server($port)
    or die "не удалось создать сокет на порту $port: $!";

# Ждём соединение
my $client = get_client($server);

# Отдаём ответ
print $client get_response("Hello, World!\n");

# Закрываем сокеты — программа завершается
close $client;
close $server;

Ну вот, это уже что-то похожее на реальное приложение.

Появились четыре функции.

get_port() читает порт из параметров командной строки, проверяет, что там целое число, и возвращает 8080, если аргумента нет.

get_server($port) создаёт слушающий сокет на этом порту и возвращает его, а если не получилось — скрипт ругается и падает. Адрес в get_server() не указан — такой сокет слушает на всех интерфейсах, поэтому сервис будет доступен и снаружи, даже если запустить его в докере.

get_client($server) вызывает accept() на слушающем сокете и возвращает новый сокет, который соответствует уже конкретному клиентскому соединению. accept() — это блокирующий вызов: программа остановится в этом месте и будет ждать, пока не придёт клиент.

get_response($body) собирает минимальный HTTP-ответ: строка статуса, заголовки, пустая строка-разделитель и тело ответа. Здесь пока нет заголовка Connection: close, но чуть ниже станет понятно, зачем он нужен.

Осталось описать основное тело программы. Сначала получаю номер порта, затем создаю слушающий сокет, жду клиента через accept(), отправляю ему ответ с помощью print, после чего закрываю клиентский сокет и слушающий сокет. На этом программа заканчивается.

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

Прекрасно! Но… это же не сервис. Ежу понятно что сервис-то всё время должен работать, а эта программа один раз отработала и завершилась. Решение очевидное — внедрить цикл.

Код 3 — скрипт code3.rev10.pl:

# всё начало скрипта — как в коде 2, но без close $server

# В цикле ждём соединения и на каждое отвечаем
while (1) {
    my $client = get_client($server);
    print $client get_response("Hello, World!\n");
    close $client;
}

Заметили, да? В коде 2 был close $server;, а в коде 3 нет. Сеееервис! Программа стартанула, заняла сокет и больше никогда его не закрывает. Наверно это плохо, но не буду забегать вперед. Главное что всё пашет и вроде правильно.

Смотрим, что получилось. Сервис живёт в цикле: accept() ждёт новое соединение, get_response() собирает ответ, print отправляет его, close $client закрывает соединение — и снова accept(). И так до бесконечности, пока сервис не остановят.

Про close $client; надо сказать отдельно, потому что это не техническая мелочь, а решение. Закрывая сокет, я отправляю клиенту FIN — «я закончил, данных от меня больше не будет».

А зачем закрывать? Затем, что иначе соединение остаётся открытым и я обязан сам решать, что с ним делать дальше. При этом HTTP/1.1 по умолчанию соединение постоянное (keep-alive): клиент вправе, прочитав ответ, прислать в это же соединение второй запрос и ждать второго ответа. Сокет закрылся — и второй запрос ему придётся отправлять заново, в новое соединение.

Можно и наоборот: убрать close $client; и отдать закрытие клиенту. Тогда всё, придется заниматься всем, от чего избавляло закрытие: читать запросы из этого соединения до конца, следить за простоем (клиент вправе держать соединение открытым часами), держать открытый дескриптор на каждое соединение. А дескрипторов у процесса конечное число (ulimit -n, обычно 1024): убрав close, сервис умрёт на тысяче клиентов с «too many open files».

И ещё нюанс на будущее: первая сторона, отправившая FIN, на пару минут попадает в состояние TIME_WAIT, так что вопрос «кто закрывает» — это не только про удобство, но и про ресурсы. Короче, «убрать close» — это не упрощение, а перекладывание ответственности: убрав его, надо сразу договориться, кто и когда закрывает соединение, и обычно это пишут прямо в заголовке ответа, а не оставляют на догадки.

И теперь да, получается: в заголовок ответа надо добавить Connection: close.

Почему? Потому что сервис сам закрывает соединение сразу после ответа. Если клиент получит ответ без Connection: close, он по умолчанию будет считать, что соединение остаётся живым и в него можно послать следующий запрос. А сервис уже сделал close $client. Тогда клиент либо получит сброс соединения, либо будет ждать данные там, где их больше нет. То есть обязательно надо явно сообщить клиенту: «после этого ответа соединение будет закрыто».

Поэтому правильный get_response() дальше будет выглядеть так:

sub get_response {
    my ($body) = @_;

    return "HTTP/1.1 200 OK\r\n"
        . "Content-Type: text/plain; charset=utf-8\r\n"
        . "Connection: close\r\n"
        . "Content-Length: " . length($body) . "\r\n"
        . "\r\n"
        . $body;
}

Забегая вперед: в последующих версиях сервера этот заголовок уже будет присутствовать.

Но самое фундаментальное слабое место этой программы вот в чем: клиенты в ней обслуживаются строго по очереди, а не параллельно. Пока сервис возится с одним соединением, все остальные ждут. Пока ответ всегда один и тот же, это незаметно, но представьте, что один вызов оказался медленным. Второй клиент будет ждать секунду, третий — две, десятый — девять. Один медленный вызов — и застопорились все. Чтобы такого не было, сервис должен держать в работе сразу много соединений. Это называется мультиплексирование.

Обычный способ решить эту проблему — на каждого клиента заводить отдельный процесс или поток. Но есть более трушный путь: вообще не ждать. Сокет становится готовым к чтению только тогда, когда клиент реально что-то прислал, а какие сокеты готовы прямо сейчас, знает системный вызов epoll — в Perl с ним удобно работать через модуль IO::Epoll.

Остаётся крутить цикл, который ждёт событий и реагирует на готовые сокеты. Такой цикл называется евент луп — цикл событий.

Простейший евент луп выглядит так.

Код 4 — скрипт code4.rev6.pl:

# всё начало скрипта — как в коде 3 (с обновлённым get_response), плюс:
use IO::Epoll;

my $epoll = epoll_create(1000);
die "не удалось создать epoll: $!" if $epoll < 0;

my $port          = get_port();
my $server        = get_server($port);
my $server_fileno = fileno($server);

epoll_ctl($epoll, EPOLL_CTL_ADD, $server_fileno, EPOLLIN) >= 0
    or die "ошибка epoll_ctl: $!";

# Простейший евент луп: ждём события сразу на всех сокетах
while (1) {
    my $events = epoll_wait($epoll, 100, -1)
        or die "ошибка epoll_wait: $!";

    for my $event (@$events) {
        my ($fileno, $mask) = @$event;

        # Есть что читать. ВНИМАНИЕ: это ошибка — запрос мы так и не читаем
        if ($mask & EPOLLIN) {
            if ($fileno == $server_fileno) {
                my $client   = get_client($server); # Ждём соединение
                my $response = get_response("hello world");
                print $client $response;
                # Закрываем сокет
                close $client;
            }
        }
    }
}

Разберём, что здесь появилось.

epoll_create(1000) создаёт в ядре экземпляр epoll и возвращает его дескриптор (число 1000 — историческая подсказка ядру о размере очереди; в современных ядрах этот аргумент игнорируется, но должен быть больше нуля).

Поскольку системные вызовы epoll работают не с перловыми объектами сокетов, а с целочисленными файловыми дескрипторами ОС, надо узнаьб номер дескриптора слушающего сокета через fileno($server) и зарегистрироать его вызовом epoll_ctl(). А внутри бесконечного цикла epoll_wait($epoll, 100, -1) ждёт, пока ядро не сообщит о событиях (не более 100 событий за вызов, -1 означает ждать без таймаута).

А теперь про сами маски, потому что дальше всё держится на них. Маска — это просто число, в котором каждый бит означает событие. Имена битов пришли из двух разных сисколлов: poll(2) зовёт их POLLIN и POLLOUT, а epoll(4) — EPOLLIN и EPOLLOUT. Значения у них одинаковые, различаются только названия; IO::Epoll по умолчанию экспортирует EPOLL-имена (а с тегом :compat может притворяться модулем IO::Poll и экспортировать POLL-имена).

Смысл битов простой: EPOLLIN — на сокете есть что читать (у слушающего сокета — в очереди стоит готовое соединение), EPOLLOUT — можно писать и не заблокироваться, EPOLLERR — на сокете ошибка, EPOLLHUP — вторая сторона закрыла соединение.

Дальше самое интересное: маска в epoll участвует дважды, и это две разные маски. Первая — маска интереса: какие события программа просит отслеживать для этого дескриптора. Именно её надо передать в epoll_ctl($epoll, EPOLL_CTL_ADD, $server_fileno, EPOLLIN) при добавлении дескриптора в epoll, а для изменения маски уже известного дескриптора используется операция EPOLL_CTL_MOD. Вторая — маска случившегося: что реально произошло. Её возвращает epoll_wait() по каждому готовому дескриптору: результатом epoll_wait() является ссылка на массив пар [$fileno, $mask], где $fileno — номер сработавшего дескриптора, а $mask — битовая маска случившихся на нём событий. В цикле проверяется нужный бит обычным побитовым «И»: if ($mask & EPOLLIN).

Интерес и случившееся совпадают не всегда, и это важно. EPOLLERR и EPOLLHUP ядро сообщает всегда, даже если их не просили: подпишемся только на EPOLLIN — сбой или обрыв прилетит вместе с EPOLLIN, и узнаем о нём лишь тогда, когда sysread() вернёт ноль или ошибку. Поэтому в настоящем сервере на маску события смотрят целиком, а не по одному биту.

И последнее: epoll по умолчанию работает в режиме level-triggered (LT) — «пока событие не разобрано, извещай о нём снова». Не вычитали данные — EPOLLIN придёт на следующей итерации; сокет закрыли, а из epoll не убрали — EPOLLHUP будет приходить бесконечно, и epoll_wait() начнёт возвращаться мгновенно. Есть и второй режим — edge-triggered (EPOLLET): ядро извещает один раз о переходе, а дальше вычитывай до EAGAIN сам.

Посмотрите теперь, что делает код 4: я добавил приёмный сокет в epoll и слежу за событием чтения на нём. Но как только приходит событие на $server_fileno, я тут же в этом же блоке делаю accept(), сразу пишу ответ в $client и закрываю его. Но ведь при акцепте у меня получается ещё один клиентский сокет — а почему бы и его не добавить в epoll и не следить за его событиями отдельно от слушающего сокета?

И даже если добавлю клиентский сокет в epoll, на первый взгляд покажется, что всё хорошо: сервис вечный, соединений держит сколько угодно, процессор не жжёт. Но если присмотреться к тому, как устроен ввод-вывод, в нём четыре ошибки, и каждая из них смертельная. Разберу их по порядку — от самой заметной к самой глубокой.

Ошибка №1 — чтение без чтения. Сработало событие EPOLLIN, то есть «на этом сокете есть что читать», и программа тут же отвечает. Причем ничего не читая: в коде нет ни sysread(), ни recv(). Получается, сервер отвечает, не взглянув на запрос. Он не знает ни метода, ни пути, ни версии HTTP, ни заголовков — что бы клиент ни попросил, он получит hello world. И это ещё полбеды. У TCP свои правила: если закрыть сокет, в буфере которого остались непрочитанные данные, ядро вместо обычного FIN отправит клиенту RST. Клиент может даже не успеть прочитать ответ — вместо hello world он получит «connection reset by peer». Вывод простой: раз EPOLLIN случился на клиентском сокете, данные из него надо забрать.

Ошибка №2 — обмен всё равно блокирующий. Здесь придётся разобраться, что такое блокировка вообще. По умолчанию любой сокет блокирующий: каждая операция над ним ждёт, пока сможет завершиться. accept() ждёт, пока придёт соединение. sysread() ждёт, пока в сокете появятся байты. syswrite() ждёт, пока все данные влезут в буфер отправки. Именно поэтому код 3 висит в accept() и никого не обслуживает, пока не придёт клиент. epoll этого не отменяет: он лишь сообщает, какие сокеты готовы прямо сейчас, и ничего не знает о том, как вы будете с ними работать. Готовность — это подсказка, а не обещание, что операция не начнёт ждать.

Что из этого следует на практике? Сервис ждёт медленного клиента. Представьте: соединение принято, а клиент молчит или присылает по байту в час. Обработчик входит в sysread() и замирает внутри — и вместе с ним замирает весь сервис: остальные готовые сокеты обработать уже некому, программа ведь даже не вернулась в epoll_wait(). Та же беда, что и с циклом из кода 3, только теперь она спрятана глубже. Мультиплексирование получается фиктивным.

Чтобы оно стало настоящим, сокеты надо перевести в неблокирующий режим. Тогда операция, которая не может выполниться прямо сейчас, не ждёт, а сразу сдаётся: возвращает undef, а в $! лежит EAGAIN или EWOULDBLOCK — «попробуй позже, когда будет готово». Евент луп из «сделай всё и не возвращайся, пока не сделаешь» превращается в «сделай ровно столько, сколько можно сделать не ожидая, и возвращайся в epoll_wait()».

Ошибка №3 — блокирующий accept(). Слушающий сокет тоже по умолчанию блокирующий, и это отдельная засада. Во-первых, между epoll_wait() и accept() соединение может исчезнуть: клиент отвалился, или его успел принять кто-то другой. Блокирующий accept() в такой ситуации повиснет навсегда, хотя ждать уже нечего. Во-вторых, в очереди может лежать сразу несколько соединений, поэтому часто их принимают в цикле, пока accept() не вернёт undef, — и вот именно этот последний, пустой вызов и повиснет, если сокет блокирующий. Правда, поскольку epoll по умолчанию работает в режиме level-triggered, пока событие не разобрано до конца, epoll_wait() будет сообщать о нём снова и снова. Но от первой засады с отвалившимся клиентом это не спасает, значит и слушающий сокет обязан быть неблокирующим.

Ошибка №4 — осталось разобраться с самим обменом. Во всех прежних кодах ответ уходит через print, и это тоже надо менять. print пишет через буферизацию: данные сначала попадают в буфер в памяти процесса и могут спокойно лежать там, пока буфер не заполнится или пока сокет не закроют. Сколько байт на самом деле ушло в сеть, print не говорит — он возвращает всего лишь признак успеха. На неблокирующем сокете это превращается в кашу: буфер полон, записать ничего нельзя, а print со своей буферизацией прячет ошибку и делает вид, что всё хорошо. Вдобавок нельзя смешивать буферизованный print и sysread()/syswrite() на одном сокете — буфер в памяти и сисколл видят разное состояние одного и того же соединения.

sysread() и syswrite() работают без буфера, напрямую через сисколлы read(2) и write(2). И главное — они честно рассказывают, что произошло. sysread() возвращает число реально прочитанных байт: сколько пришло, столько и отдаёт, а не ждёт, пока наберётся весь запрошенный размер. Ноль байт означает, что клиент закрыл соединение, undef вместе с EAGAIN — что читать пока нечего. syswrite() возвращает число реально записанных байт, и это число может оказаться меньше длины данных: часть ушла в сокет, часть нет. Это не ошибка, а частичная запись: остаток надо дослать позже, когда epoll сообщит EPOLLOUT. undef вместе с EAGAIN означает, что буфер отправки полон прямо сейчас.

Даааа… В общем, куча проблем.

Кстати, ошибки №2 и №3 только выглядят пугающе, а лечатся элементарно: просто выключаешь блокировку на сокете через $socket->blocking(0) — и всё.

Ошибку №1 пока не буду исправлять, просто надо иметь её в виду, разберу её попозже (в коде 8). Пока для простоты буду считать, что программа, как только получила событие от клиента, сразу пишет в сокет "hello world" и всё.

А вот ошибка №4 — самая интересная: там фишка в том, что никогда нельзя быть уверенным, что если ты что-то написал в сокет, то это ушло. Оно может уйти, может уйти частично, может вообще не уйти. Сокет может быть закрыт той стороной. Та сторона может тормозить, читать медленно. В общем, есть нюансы, которые если не предусмотреть, то сервис упадёт.

Из этого следует, что запись в сокет может не произойти за одну итерацию цикла. В идеале конечно чо там, всего 11 символов, гавно вопрос, но если вы будете в будущем писать что-то более серьёзное, то вы должны быть готовы, что из 11 символов в сокет будет записано только 5, и вам оставшиеся 6 надо будет дослать в следующих итерациях евент лупа (и не факт, что получится с первого раза). Значит, надо как-то хранить, что осталось послать. Это я назову контекстом клиентов и введу его в код.

Вот тут и стоит посмотреть, как это устроено в настоящем сервере. Там евент луп сделан так: у каждого сокета есть свой объект-контекст (socket, socket_fileno, mask, буфер out), все контексты сложены в одну таблицу $context по номеру дескриптора, и цикл на каждое событие из epoll_wait() достаёт из этой таблицы контекст того дескриптора, которого событие коснулось. Отдельного хранилища «что кому не дослано» нет: остаток ответа живёт в том же контексте, которому он принадлежит.

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

• в коде 5 начну добавлять в epoll не только слушающий, но и клиентские сокеты, заведу таблицу $context по номеру дескриптора и выключу блокировку на сокетах через $socket->blocking(0) (закрыв ошибки №2 и №3);

• в коде 6 превращу элементы $context из голых сокетов в объекты-хеши и добавлю подписку на готовность к записи (EPOLLOUT);

• в коде 7 положу в этот контекст буфер вывода out и заменю print на честный неблокирующий syswrite(), закрыв ошибку №4.

Начну с добавления клиентских сокетов в epoll, таблицы $context и отключения блокировки.

Код 5 — скрипт code5.rev4.pl:

# всё начало скрипта (get_port, get_response и модули) — как в коде 4

# Создаём слушающий сокет и сразу запоминаем его в контексте
sub get_server {
    my ($port, $context) = @_;

    my $socket = IO::Socket::INET->new(
        LocalPort => $port,
        Proto     => 'tcp',
        Listen    => 5,
        Reuse     => 1,
    ) or die "не удалось создать сокет на порту $port: $!";

    $socket->blocking(0);

    my $fileno = fileno($socket);
    $context->{$fileno} = $socket;

    return $socket;
}

# Принимаем клиентское соединение и тоже запоминаем его в контексте
sub get_client {
    my ($server, $context) = @_;

    my $socket = $server->accept() or die "ошибка accept: $!";
    $socket->blocking(0);

    my $fileno = fileno($socket);
    $context->{$fileno} = $socket;

    return $socket;
}

# Подписка на чтение
sub add_read {
    my ($epoll, $socket) = @_;

    my $fileno = fileno($socket);

    epoll_ctl($epoll, EPOLL_CTL_ADD, $fileno, EPOLLIN) >= 0
        or die "ошибка epoll_ctl: $!";
}

# Убираем сокет из контекста и закрываем его
sub clean_socket {
    my ($socket, $context) = @_;

    delete $context->{fileno($socket)};
    close $socket;
}

my $context = {}; # fileno => socket

my $epoll = epoll_create(1000);
die "не удалось создать epoll: $!" if $epoll < 0;

my $port   = get_port();
my $server = get_server($port, $context);
add_read($epoll, $server);

# Простейший евент луп: ждём события сразу на всех сокетах
while (1) {
    my $events = epoll_wait($epoll, 100, -1)
        or die "ошибка epoll_wait: $!";

    for my $event (@$events) {
        my ($fileno, $mask) = @$event;
        my $socket = $context->{$fileno};

        next unless $socket;

        if ($mask & EPOLLIN) {
            if ($socket == $server) {
                my $client = get_client($server, $context);
                add_read($epoll, $client);
                next;
            }

            # ВНИМАНИЕ: запрос мы здесь ещё не читаем
            my $response = get_response("hello world");
            print $socket $response;

            clean_socket($socket, $context);
        }
    }
}

Что изменилось по сравнению с кодом 4?

Во-первых, при приёме соединения я больше не пишк ответ сразу после accept(), а добавляю клиентский сокет в epoll через функцию add_read($epoll, $client) и жду, когда событие EPOLLIN случится уже на самом клиенте.

Во-вторых, поскольку в epoll теперь живёт много сокетов, а epoll_wait() возвращает только числовой дескриптор $fileno, появился хеш $context — таблица соответствия между номером дескриптора и объектом сокета.

В-третьих, и слушающий, и клиентский сокеты теперь переводятся в неблокирующий режим вызовом $socket->blocking(0) — этим я закрыл ошибки №2 и №3.

Но в коде 5 в таблице $context пока лежат голые сокеты, а ответ всё ещё отправляется сразу в ветке EPOLLIN через print. Чтобы подступиться к ошибке №4, сначала превращу элемент контекста в объект-хеш и научу отдельно следить за событием записи EPOLLOUT.

Код 6 — скрипт code6.rev6.pl:

# get_port() и get_response() — как раньше

# Сервер теперь не просто сокет, а объект-хеш
sub get_server {
    my ($port, $context) = @_;

    my $socket = IO::Socket::INET->new(
        LocalPort => $port,
        Proto     => 'tcp',
        Listen    => 5,
        Reuse     => 1,
    ) or die "не удалось создать сокет на порту $port: $!";

    $socket->blocking(0);

    my $fileno = fileno($socket);

    my $server = {
        socket        => $socket,
        socket_fileno => $fileno,
        mask          => 0,
    };

    $context->{$fileno} = $server;

    return $server;
}

# Клиент тоже объект-хеш
sub get_client {
    my ($server, $context) = @_;

    my $socket = $server->{socket}->accept() or die "ошибка accept: $!";
    $socket->blocking(0);

    my $fileno = fileno($socket);

    my $client = {
        socket        => $socket,
        socket_fileno => $fileno,
        mask          => 0,
    };

    $context->{$fileno} = $client;

    return $client;
}

# Подписка на чтение
sub add_read {
    my ($obj, $epoll) = @_;

    my $fileno = $obj->{socket_fileno};

    $obj->{mask} = EPOLLIN;

    epoll_ctl($epoll, EPOLL_CTL_ADD, $fileno, $obj->{mask}) >= 0
        or die "ошибка epoll_ctl: $!";
}

# Добавляем интерес к записи
sub add_write {
    my ($obj, $epoll) = @_;

    my $fileno = $obj->{socket_fileno};

    if (($obj->{mask} & EPOLLOUT) != EPOLLOUT) {
        $obj->{mask} |= EPOLLOUT;

        epoll_ctl($epoll, EPOLL_CTL_MOD, $fileno, $obj->{mask}) >= 0
            or die "ошибка epoll_ctl: $!";
    }
}

# Удаляем объект из epoll, из контекста и закрываем сокет
sub clean_obj {
    my ($obj, $epoll, $context) = @_;

    my $fileno = $obj->{socket_fileno};

    epoll_ctl($epoll, EPOLL_CTL_DEL, $fileno, 0) >= 0
        or die "ошибка epoll_ctl: $!";

    delete $context->{$fileno};
    close $obj->{socket};
}

my $context = {}; # fileno => объект соединения

my $epoll = epoll_create(1000);
die "не удалось создать epoll: $!" if $epoll < 0;

my $port   = get_port();
my $server = get_server($port, $context);
add_read($server, $epoll);

# Евент луп
while (1) {
    my $events = epoll_wait($epoll, 100, -1)
        or die "ошибка epoll_wait: $!";

    for my $event (@$events) {
        my ($fileno, $mask) = @$event;
        my $obj = $context->{$fileno};

        next unless $obj;

        if ($mask & EPOLLIN) {
            if ($obj == $server) {
                my $client = get_client($server, $context);
                add_read($client, $epoll);
                next;
            }

            # Запрос пока не читаем, только просим уведомить о возможности записи
            add_write($obj, $epoll);
        }

        if ($mask & EPOLLOUT) {
            my $response = get_response("hello world");
            print { $obj->{socket} } $response;

            clean_obj($obj, $epoll, $context);
        }
    }
}

Здесь уже есть важный шаг вперёд.

Теперь соединение - не голый сокет, а хеш-объект, в котором хранятся сам сокет, файловый дескриптор и текущая маска интереса. Это нужно, потому что epoll_ctl() работает с файловыми дескрипторами, а мне надо управлять состоянием соединения.

Появилась функция add_write(). Она не пишет ответ немедленно, а лишь добавляет к дескриптору интерес EPOLLOUT. То есть программа говорит ядру: «сообщи мне, когда в этот сокет можно будет писать без блокировки».

Когда приходит событие EPOLLOUT, программа отправляет ответ и закрывает соединение.

Остался последний шаг для исправления ошибки №4: добавить в контекст соединения буфер вывода out и заменить буферизованный print на честный неблокирующий syswrite(), способный досылать данные по частям.

Код 7 — скрипт code7.rev8.pl:

# get_port(), get_response(), get_server(), add_read(), add_write(), clean_obj()
# — как в коде 6, только в get_client() добавляется поле out

sub get_client {
    my ($server, $context) = @_;

    my $socket = $server->{socket}->accept() or die "ошибка accept: $!";
    $socket->blocking(0);

    my $fileno = fileno($socket);

    my $client = {
        socket        => $socket,
        socket_fileno => $fileno,
        mask          => 0,
        out           => '',
    };

    $context->{$fileno} = $client;

    return $client;
}

# Снимаем интерес к записи, когда буфер пуст
sub del_write {
    my ($obj, $epoll) = @_;

    my $fileno = $obj->{socket_fileno};

    return unless defined $fileno && $fileno >= 0;

    if (($obj->{mask} & EPOLLOUT) == EPOLLOUT) {
        $obj->{mask} = EPOLLIN;

        epoll_ctl($epoll, EPOLL_CTL_MOD, $fileno, $obj->{mask}) >= 0
            or die "ошибка epoll_ctl: $!";
    }
}

# Неблокирующая запись
sub write_fun {
    my ($obj) = @_;

    my $socket = $obj->{socket};
    return 0 unless $socket;

    # Если писать нечего — выходим
    if ($obj->{out} eq '') {
        return 0;
    }

    my $bytes = syswrite($socket, $obj->{out});

    if (defined $bytes) {
        if ($bytes > 0) {
            # Производительный сдвиг буфера вывода
            substr($obj->{out}, 0, $bytes, '');
            return $bytes;
        }
        else {
            return -1;
        }
    }

    # Если буфер ядра переполнен — ждём следующего события
    if ($! == EAGAIN || $! == EWOULDBLOCK) {
        return; # undef
    }

    return -1;
}

# Евент луп
while (1) {
    my $events = epoll_wait($epoll, 100, -1)
        or die "ошибка epoll_wait: $!";

    for my $event (@$events) {
        my ($fileno, $mask) = @$event;
        my $obj = $context->{$fileno};

        next unless $obj;

        if ($mask & EPOLLIN) {
            if ($obj == $server) {
                my $client = get_client($server, $context);
                add_read($client, $epoll);
                next;
            }

            # Запрос всё ещё не читаем, сразу готовим ответ
            $obj->{out} = get_response("hello world");
            add_write($obj, $epoll);
        }

        if ($mask & EPOLLOUT) {
            my $res = write_fun($obj);

            # Если получили EAGAIN — ждём следующего события
            if (!defined $res) {
                next;
            }

            if ($res >= 0) {
                if ($obj->{out} eq '') {
                    del_write($obj, $epoll);
                    clean_obj($obj, $epoll, $context);
                }
            }
            else {
                clean_obj($obj, $epoll, $context);
            }
        }
    }
}

Здесь появляется настоящая неблокирующая запись.

Ответ больше не пишется целиком через print. Он сначала кладётся в буфер $obj->{out}, а функция write_fun() делает один syswrite() и пытается отдать данные ядру. Если ядро приняло не всё, программа срезает уже отправленный кусок из буфера и ждёт следующего EPOLLOUT. Если ядро временно не может принять данные и возвращает EAGAIN/EWOULDBLOCK, просто выходит из обработчика и ждёт следующего события.

Функция del_write() нужна для того, чтобы снять интерес к записи, когда буфер уже пуст. Иначе ядро будет постоянно сообщать, что сокет готов к записи, и цикл начнёт молотить по пустому буферу.

Теперь вернёмся к ошибке №1, которую я отложил: в коде 7 программа реагирует на EPOLLIN, но всё ещё не читает данные из клиентского сокета. В режиме level-triggered это опасно вдвойне: пока данные остаются в буфере ядра, событие чтения будет приходить снова и снова, а закрытие сокета с непрочитанным буфером приведёт к отправке RST. Поэтому следующая версия обязана читать запрос через sysread().

Код 8 — скрипт code8.rev5.pl:

# Всё из кода 7, плюс функция чтения запроса

sub read_fun {
    my ($obj) = @_;

    my $socket = $obj->{socket};
    return 0 unless $socket;

    my $buffer;
    my $bytes = sysread($socket, $buffer, 32768);

    if (defined $bytes) {
        if ($bytes > 0) {
            $obj->{in} .= $buffer;
            $obj->{total_bytes_read} += $bytes;
            return $bytes;
        }
        else {
            # sysread вернул 0 — клиент корректно закрыл соединение
            return 0;
        }
    }

    # Если данных пока нет — ждём следующего события
    if ($! == EAGAIN || $! == EWOULDBLOCK) {
        return; # undef
    }

    # Любая другая ошибка чтения — обрыв
    return -1;
}

# Евент луп
while (1) {
    my $events = epoll_wait($epoll, 100, -1)
        or die "ошибка epoll_wait: $!";

    for my $event (@$events) {
        my ($fileno, $mask) = @$event;
        my $obj = $context->{$fileno};

        next unless $obj;

        if ($mask & EPOLLIN) {
            if ($obj == $server) {
                my $client = get_client($server, $context);
                add_read($client, $epoll);
                next;
            }

            # Читаем данные из сокета сетевого клиента
            my $bytes_read = read_fun($obj);

            # Если sysread вернул undef (EAGAIN/EWOULDBLOCK) — данных нет, ждём
            if (!defined $bytes_read) {
                next;
            }

            # Если вернул 0 — это чистый FIN, клиент закрыл сокет
            if ($bytes_read == 0) {
                clean_obj($obj, $epoll, $context);
                next;
            }

            # Если вернул отрицательное значение — критическая ошибка чтения
            if ($bytes_read < 0) {
                clean_obj($obj, $epoll, $context);
                next;
            }

            $obj->{out} = get_response("hello world");
            add_write($obj, $epoll);
        }

        if ($mask & EPOLLOUT) {
            my $res = write_fun($obj);

            if (!defined $res) {
                next;
            }

            if ($res >= 0) {
                if ($obj->{out} eq '') {
                    del_write($obj, $epoll);

                    # Здесь можно вызвать clean_obj(), если хотим закрыть
                    # соединение сразу после отправки ответа.
                    #
                    # В этом учебном варианте можно оставить соединение открытым
                    # и дождаться, пока клиент сам корректно закроет его.
                    # Тогда мы позже получим событие чтения и увидим
                    # $bytes_read == 0 в read_fun().
                }
            }
            else {
                clean_obj($obj, $epoll, $context);
            }
        }
    }
}

И вот теперь программа наконец читает запрос.

read_fun() делает sysread() и складывает прочитанные данные в $obj->{in}. Возвращаемое значение здесь очень важно:

• положительное число — прочитали сколько-то байт;

• 0 — клиент закрыл соединение, получаем FIN;

• undef — данных пока нет, это нормальная ситуация для неблокирующего ввода-вывода, если $! равен EAGAIN или EWOULDBLOCK;

• отрицательное значение — критическая ошибка чтения.

После чтения формируем ответ, кладём его в буфер $obj->{out} и подписываемся на запись через add_write(). Дальше EPOLLOUT приведёт к вызову write_fun(), который отправит данные.

Этот код уже гораздо ближе к нормальному серверу: он слушает порт, принимает соединения, читает данные, пишет ответ и следит за событиями через epoll. Но это всё ещё очень упрощённый сервер. Он не разбирает HTTP-запрос, не понимает заголовки, не проверяет тело запроса, не ограничивает размер чтения и не закрывает соединения по таймауту. Для учебного “hello world” это нормально, но для боевого сервера этого мало.

Конечно надо развивать код дальше, и защищать этот нещасный hello world от всех нападок реального мира, но уже сейчас код стал мягко говоря нечитаемым. Дальнейшее его развитие приведет к еще большему усложнению. Неужели нет никакого хода, чтобы всё стало попроще и в то же время не потерять функционал?

Подумаю об этом во второй части.