Vim-gtk с perl-документом

Однажды сильно припёрло написать свой dhcp-сервер. Для обслуживания кучи relay’ев. Функционал полный был даже не нужен. Точнее так: нужно было, чтобы он до конца не был реализован. Например, не нужно было сохранять время аренды адреса, но нужно было назначать параметры клиентам в зависимости от номера vlan’а, откуда к нам перенаправлен запрос. И решено было всё это написать на perl, благо даже модуль есть специальный — Net::DHCP::Packet.

Так как, фактически, соотношение номера vlan’а и сетевая адресация происходили в определённой известной зависимости, своя реализация dhcp-сервера была выполнена в формате «запустил и забыл». Никакой необходимости в изменении конфигурации на лету. Просто незачем менять конфигурацию. А ещё отсутствовал ввод-вывод на диск (не надо было писать журнал), так что он (dhcp-сервер) как был запущен, так и здравствует на виртуальной машине до сих пор. Натуральная вещь в себе…

Ну а тут я выложу пример простой программы на 150 строчек кода, который делает всё тоже самое, но с минимальными зависимостями. И для человека, желающего быстро разобраться с Net::DHCP::Packet будет полезно, и как пример простого однопоточного udp-сервера сгодится:

#!/usr/bin/perl
# Оглашаем прагмы
use strict;
use warnings;
# и подключаем модули.
use sigtrap qw(handler toggle_work_flag normal-signals);
use IO::Socket::INET;
use Net::IP qw(:PROC);
use Net::DHCP::Packet;
use Net::DHCP::Constants;


# Начинаем код с оглашения конфигурации.
my %config = (
	'bind_addr'	=> "17.31.255.145",		# на этот адрес "сядет" наш сервер
	'bind_port'	=> "6767",			# порт, который сервер будет слушать
	'vlan_min'	=> 1000,			# минимальный номер vlan'а
	'vlan_max'	=> 5999,			# максимальный номер vlan'а
	'ipv4_range'	=> "172.16.0.0/16",		# префикс с маской, который мы отдаём клиентам
	'dns_servers'	=> "172.17.17.17 172.18.18.18", # адреса dns-серверов, одной строкой с пробелами
	'lease_time'	=> 86400			# ttl аренды адреса в секундах
);

# Нам надо подготовить значения для определения начала и конца префикса.
# А раз это нужно всегда, то сделаем это один раз и заблаговременно.
prepare_address_space(\%config) or die("Can't calculate address space!\n");


# Мы будем отслеживать необходимость завершения через данную переменную.
my $we_work = 1;

# Открываем сокет. Обязательно в не блокируемом режиме. Иначе рабочий цикл
# будет залипать каждый раз, когда будет простаивать.
my $socket = IO::Socket::INET->new(
	LocalAddr	=> $config{'bind_addr'},
	LocalPort	=> $config{'bind_port'},
	Proto		=> 'udp',
	Blocking	=> 0
) or die("Can't create udp socket: " . $! . "\n");

# И пока пользователь не пошлёт серверу сигнал завершения,
# $we_work будет TRUE, а всё это будет крутится...
while($we_work) {
	# У нас не блокируемый режим на сокете. А значит recv вернет TRUE
	# только при наличии считанного из сокета сообщения.
	if($socket->recv(my $in_msg, 512)) {
		# Если в сообщении был "мусор", то есть нечто, что не будет воспринято как dhcp-пакет,
		# то Net::DHCP::Packet умрёт и всё выполнение в след за ним. Нам так не надо.
		# Чтобы так не было, пытаемся отдавать пакет для создания объекта только в eval.
		# Если внутри eval случится какая проблема, то вернётся undef и нас выкинет на следующий виток цикла.
		my $packet = eval{
			Net::DHCP::Packet->new($in_msg);
		} or next();

		# Там нужны для работы имя интерфейса (то, которое отдал нам relay) и тип запроса.
		my $iface = $packet->getOptionValue(82);	# это для isc-dhcp-relay, на коммутаторах может быть другое поле
		my $messagetype = $packet->getOptionValue(DHO_DHCP_MESSAGE_TYPE());

		# Структуры данных для формирвоания ответа:
		my $answer;
		my $to_client;

		# Строка с Option 82 определена, тип сообщений - discover, адреса удалось "посчитать".
		if((defined($iface)) and ($messagetype eq DHCPDISCOVER()) and ($to_client = calculate_address(\%config, $iface))) {
			$answer = Net::DHCP::Packet->new(
				Comment				=> $packet->comment(),
				Op				=> BOOTREPLY(),
				Hops				=> $packet->hops(),
				Xid				=> $packet->xid(),
				Flags				=> $packet->flags(),
				Ciaddr				=> $packet->ciaddr(),
				Yiaddr				=> $to_client->{'client'},
				Siaddr				=> $packet->siaddr(),
				Giaddr				=> $packet->giaddr(),
				Chaddr				=> $packet->chaddr(),
				DHO_DHCP_MESSAGE_TYPE()		=> DHCPOFFER(),
				DHO_DHCP_SERVER_IDENTIFIER()	=> $config{'bind_addr'}
			);

			$answer->addOptionValue(DHO_DHCP_LEASE_TIME(), $config{'lease_time'});
			$answer->addOptionValue(DHO_SUBNET_MASK(), $to_client->{'mask'});
			$answer->addOptionValue(DHO_ROUTERS(), $to_client->{'router'});
			$answer->addOptionValue(DHO_DOMAIN_NAME_SERVERS(), $config{'dns_servers'});
			$answer->addOptionValue(82, $packet->getOptionValue(82));
		}
		# Строка с Option 82 определена, тип сообщений - request, адреса удалось "посчитать".
		elsif((defined($iface)) and ($messagetype eq DHCPREQUEST()) and ($to_client = calculate_address(\%config, $iface))) {
			# В реквесте присутствует запрос на определённый адрес. Достанем этот адрес из запроса.
			my $requested_address = $packet->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());

			# Адрес удалось достать из запроса, и он соответствует тому, который должен быть у клиента.
			if((defined($requested_address)) and ($requested_address eq $to_client->{'client'})) {
				$answer = new Net::DHCP::Packet(
					Comment				=> $packet->comment(),
					Op				=> BOOTREPLY(),
					Hops				=> $packet->hops(),
					Xid				=> $packet->xid(),
					Flags				=> $packet->flags(),
					Ciaddr				=> $packet->ciaddr(),
					Yiaddr				=> $to_client->{'client'},
					Siaddr				=> $packet->siaddr(),
					Giaddr				=> $packet->giaddr(),
					Chaddr				=> $packet->chaddr(),
					DHO_DHCP_MESSAGE_TYPE()		=> DHCPACK(),
					DHO_DHCP_SERVER_IDENTIFIER()	=> $config{'bind_addr'}
				);

				$answer->addOptionValue(DHO_DHCP_LEASE_TIME(), $config{'lease_time'});
				$answer->addOptionValue(DHO_SUBNET_MASK(), $to_client->{'mask'});
				$answer->addOptionValue(DHO_ROUTERS(), $to_client->{'router'});
				$answer->addOptionValue(DHO_DOMAIN_NAME_SERVERS(), $config{'dns_servers'});
				$answer->addOptionValue(82, $packet->getOptionValue(82));
			}
			# Либо адрес не был указан, либо он не соответствовал допустимому.
			else {
				$answer = new Net::DHCP::Packet(
					Comment				=> $packet->comment(),
					Op				=> BOOTREPLY(),
					Hops				=> $packet->hops(),
					Xid				=> $packet->xid(),
					Flags				=> $packet->flags(),
					Ciaddr				=> $packet->ciaddr(),
					Yiaddr				=> '0.0.0.0',
					Siaddr				=> $packet->siaddr(),
					Giaddr				=> $packet->giaddr(),
					Chaddr				=> $packet->chaddr(),
					DHO_DHCP_SERVER_IDENTIFIER()	=> $config{'bind_addr'},
					DHO_DHCP_MESSAGE_TYPE()		=> DHCPNAK(),
					DHO_DHCP_MESSAGE(), "Bad request...",
				);
			}
		}

		# Если ответ сформирован, то надо его подготовить к отправке,
		# и, собственно, отправить клиенту. Кстати, IO::Socket::INET помнит,
		# от кого мы в последний раз recv делали. Ему и отправится ответ.
		if($answer) {
			my $to_send = $answer->serialize();
			$socket->send($to_send) if($to_send);
		}
	}
}

# Закрыли сокет и ушли на покой...
$socket->close();
exit(0);


# Данная функция вызывается sigtrap'ом при получении сигнала "нормального" завершения.
# Всего лишь изменяет $we_work на FALSE.
sub toggle_work_flag {
	$we_work = 0;
	return(1);
}


# Функция добавляет в конфигурационный хеш записи о минимальном и максимальном значении
# числовой интерпретации адресного пространства. С ними потом мы будем сравнивать
# то, что будет получаться при расчёте подсетей клиентов. Это чтобы лишнего не отдавать.
sub prepare_address_space {
	my $config = shift();

	my $ip = Net::IP->new($config->{'ipv4_range'});
	return(undef) unless($ip);	# таки да, Net::IP->new() умеет возвращать undef

	$config->{'first_ipv4_int'} = $ip->intip();	# числовое значение первого
	$config->{'last_ipv4_int'} = $ip->last_int();	# числовое значение последнего адреса

	return(1);
}


# Функция расчёта адреса клиента. По логике для ПЕРВОЙ сети из 192.168.0.0 мы получим:
# 192.168.0.1 - роутер, 192.168.0.2 - клиент. К солению это хардкод. Не нашёл, как сделать
# расчёт ip-адресов клиентов настраиваемым, без усложнения и раздутия кода.
# Впрочем может оно и не надо, так как смена логики расчёта (не адресного пространства в целом,
# оно то меняется легко, прямо в начале, в хеше конфигурации) приведёт пересмотру логики работы всей сети.
sub calculate_address {
	my $config = shift();
	my $iface = shift();

	# $iface содержит ИМЯ. Мы должны уметь извлекать НОМЕР vlan'а из имени.
	my $vlan_num;
	# Пример для имён типа vlan[номер vlan'а]:
	if($iface =~ /^.{2}vlan(\d+)$/) {
		$vlan_num = $1;
	}
	# Пример для имён eth[номер сетевой].[номер vlan'а]:
	elsif($iface =~ /^.{2}eth\d+\.(\d+)$/) {
		$vlan_num = $1;
	}
	# Не смогли извлечь? Ну и посчитать не сможем...
	else {
		return(undef);
	}

	# Если номер vlan'а меньше или больше пределов, установленных нами, то считать не будем.
	if(($vlan_num < $config->{'vlan_min'}) or ($vlan_num > $config->{'vlan_max'})) {
		return(undef);
	}

	my $real_num	= $vlan_num - $config->{'vlan_min'};			# реальный номер сети, отсчёт от 0
	my $net_int	= $config->{'first_ipv4_int'} + (4 * $real_num);	# числовое представление ПЕРВОГО АДРЕСА в сети
	my $router_int	= $net_int + 1;						# числовое представления АДРЕСА РОУТЕРА
	my $client_int	= $router_int + 1;					# числовое представление АДРЕСА КЛИЕНТА
	my $bcast_int	= $client_int + 1;					# числовое представление ШИРОКОВЕЩАТЕЛЬНОГО АДРЕСА

	# Если наш широковещательный адрес находится за адресным
	# пространством общего префикса, то отдаём undef.
	if($bcast_int > $config->{'last_ipv4_int'}) {
		return(undef);
	}

	my $client = {
		'mask'		=> "255.255.255.252",	# хардкод, маска под четыре адреса в сети... поменяете логику, поменяйте и маску ;)
		'router'	=> ip_bintoip(ip_inttobin($router_int, 4), 4),
		'client'	=> ip_bintoip(ip_inttobin($client_int, 4), 4)
	};

	return($client);
}

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *

+ 60 = 69