Jump to content
Калькуляторы

DHCP server with SQL support on Perl DHCP сервер с базой SQL на Perl, с опцией 82, маршрутами и прочим

Было бы чудестно, если бы вы выложили еще и структуру базы и веб-морду :)

Дык написал же:

Вроде как прилепил к абиллсу

 

bomberman

Нагрузки от дхцп сервера собссно практически нет, на теперишнем тазике думаю тысяч 50-100 абонов с лизой на час легко вытянет. Рилею на паре роутеров.

Share this post


Link to post
Share on other sites

Идея интересная, но может для такого серьезного проекта лучше переписать все это на сях?

Share this post


Link to post
Share on other sites

На сях не проблема написать, и даже есть написанное, ищите на форуме.

На сях сложнее сделать гибкое решение без правки исходников, и править там немного сложнее.

Моё тестирование показало что узкое место - это сама база.

Share this post


Link to post
Share on other sites

Нагрузки от дхцп сервера собссно практически нет

Вы немного не верно меня поняли. Имелось в виду какая нагрузка на сам DCHP. Сколько в среднем аренд выдаёт в секунду/минуту.

Какое кол-во абонентов обслуживает?

Share this post


Link to post
Share on other sites

Около 3 пакетов в секунду прилетает/уходит (сужу по журналу, 500 записей за 162 секунды).

Share this post


Link to post
Share on other sites

Что то я запутался с размерами пакетов.

На нормальный пакет размером 337 байта выдает

marshall: packet too small (295), minimum size is 300 at /dhcp-perl/dhcpd.pl line 278 thread 1.
[30/Nov/2012 22:37:05] Thread 1: Got a packet src = 172.23.127.254:67 length = 295

 

Соответственно строчки

sub request_loop {
....
       while( $RUNNING == 1 ) {
               $buf = undef;
               eval { # catch fatal errors
                       # receive packet
                       $fromaddr = recv($SOCKET_RCV, $buf, 16384, 0) || logger("Thread ($tid) recv err: $!");
                       next if ($!); # continue loop if an error occured
                       # filter to small packets
                       next if (length($buf) < 236); # 300
                       if (defined($DEBUG)) { $t0 = Benchmark->new; }
                       # parce data to dhcp structes
                       $dhcpreq = new Net::DHCP::Packet($buf);

 

Почему сравнивают с размером 236 байт? recv($SOCKET_RCV, $buf, 16384, 0) возвращает без заголовка и наверное надо отнимать от 300 число 42(размер заголовка udp)?

А откуда взялось число 300? Это BOOTP_MIN_LEN в Packet.pm. Но это с заголовком. Как сделать, что бы не ругалось на маленькие пакеты?

 

PS: Кстати, по моим подсчетам до DHCPмагик 278 байт. С обязательными опциями client identifer и parametr regues минимальный пакет 291 байт.

Edited by doubtpoint

Share this post


Link to post
Share on other sites

recv возвращает размер данных переданных в юдп, те ни юдп ни ип там уже нет.

Уже не помню тонкостей. 236 это либо из рфк либо я посчитал размер дхцп заголовка. 300 из Packet.pm - там была своя проверка. Я патчил Packet.pm чтобы он не ругался на мелкие пакеты и что то ещё по мелочи.

Share this post


Link to post
Share on other sites

recv возвращает размер данных переданных в юдп, те ни юдп ни ип там уже нет.

Уже не помню тонкостей. 236 это либо из рфк либо я посчитал размер дхцп заголовка. 300 из Packet.pm - там была своя проверка. Я патчил Packet.pm чтобы он не ругался на мелкие пакеты и что то ещё по мелочи.

Мелкие пакеты на входе нужно добивать padding-ами. Я встречал такое у некоторых глючных relay-ев.

Share this post


Link to post
Share on other sites

Я патчил Packet.pm чтобы он не ругался на мелкие пакеты и что то ещё по мелочи.

Спасибо за совет - буду патчить.

 

Из замечаний, по мелочи, пока нашел:

1)use Switch; - в перл 5.10 признали устаревшим, а с 5.14 не поддерживаемым.

2)игнорируется поле xid - на него всем клиентам наплевать?

3)RID в opt82 может быть не только 6+2 байта. Например в циско(вроде и некоторых других свичах) он задается текстовой строкой.

Share this post


Link to post
Share on other sites

Если честно, я давно уже в исходники не заглядывал и порядком забыл детали реализации. Как полезу в очередной раз - обязательно исправлю свич и остальное посмотрю.

Share this post


Link to post
Share on other sites

Всем привет. По тихоньку ввожу данный сервер в боевое действо.

 

Скажите, а почему когда приходит DHCPREQUEST

IP: 172.20.2.15 (70:72:cf:30:65:b0) > 10.10.10.50 (0:d:61:35:2a:72)

в CIADDR: 172.20.2.15

в логи не пишется ИП адрес клиента

Share this post


Link to post
Share on other sites

Код перед вами, смотрите... Не так много там разбираться.

У меня все журналируется...

Share this post


Link to post
Share on other sites

посмотрите дампик http://yadi.sk/d/O_aVFxfQ14OtE

нормально ли работает, а то попадаются по несколько подряд запросов на которые нет ответа сразу

 

 

С пустым ИП тоже решил проблему вот таким исправлением:

в sub db_log_detailed {

if (defined($_[1]->getOptionRaw(DHO_DHCP_REQUESTED_ADDRESS()))) {
	$requested_ip = $_[1]->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
}else{
	if ($client_ip!="")	{
		$requested_ip = $client_ip;
	}
	else {
		$requested_ip = '';
	}
}

Edited by Cramac

Share this post


Link to post
Share on other sites

Пустой регвестед адрес приходит при первом получении адреса, тк у клиента ещё нет и не было адреса.

Share this post


Link to post
Share on other sites

в логи не пишется ИП адрес клиента

Трудно по вашему описанию точную причину понять. Но надо посмотреть функцию sub db_log_detailed . Она отвечает за лог и все строчки ее довольно просты.

По дампу очень быстро приходит сразу несколько запросов, а на ответ требуется время (в дампе около 0.01 сек). Это нормально.

 

DHO_DHCP_REQUESTED_ADDRESS может отсутствовать - это пожелание клиента адреса. Он может и не знать, что хочет.

Edited by doubtpoint

Share this post


Link to post
Share on other sites

а подскажите куда посмотреть (в какую функцию), хочу чтоб ответы логировались в базе.

Share this post


Link to post
Share on other sites

Может быть на перл форуме надо спросить, но разбираюсь сданным скритом...

Запись в общий файл из потоков как-то надо особенно прописывать?

 

Например вот так в файл пишет только вывод до потоков, а на экран и из потоков тоже.

sub startpoint
       if (defined($LOGFILE)) { open LOGFILE, ">> $LOGFILE" || logger("LOG file save error: $!");   }

sub logger {
       if (defined($DEBUG) == 0) { return; }
#       if (fileno(LOGFILE)) {
           print LOGFILE strftime("[%d/%b/%Y %H:%M:%S] ", localtime).$_[0]."\n";
#       }
       print STDOUT strftime "[%d/%b/%Y %H:%M:%S] ", localtime;
       print STDOUT $_[0]."\n";
}

 

Как-то глобально надо прописывать указатель на файл?

Share this post


Link to post
Share on other sites

В ф-и ответов очевидно же...

а нет примерчика как записать в базу ответ?

 

думаю простой вставкой в функцию ответа строки

db_log_detailed($dbh, $dhcpresp);

не сработает?

Share this post


Link to post
Share on other sites

а нет примерчика как записать в базу ответ?

думаю простой вставкой в функцию ответа строки

db_log_detailed($dbh, $dhcpresp);

не сработает?

Что-то не понятна твоя проблема.

В исходниках есть пример SQL:

sub db_log_detailed {
#my $dbh = $_[0];
#my $dhcpreq = $_[1];
my ($mac, $sth);
my ($dhcp_opt82_vlan_id, $dhcp_opt82_unit_id, $dhcp_opt82_port_id, $dhcp_opt82_chasis_id);
my ($client_ip, $gateway_ip, $client_ident, $requested_ip, $hostname, $dhcp_vendor_class, $dhcp_user_class);
my ($message_type);

$message_type = $_[1]->getOptionValue(DHO_DHCP_MESSAGE_TYPE());


# change hw addr format
$mac = FormatMAC(substr($_[1]->chaddr(), 0, (2 * $_[1]->hlen())));

GetRelayAgentOptions($_[1], $dhcp_opt82_vlan_id, $dhcp_opt82_unit_id, $dhcp_opt82_port_id, $dhcp_opt82_chasis_id);


$client_ip = $_[1]->ciaddr;
$gateway_ip = $_[1]->giaddr;
if (defined($_[1]->getOptionRaw(DHO_DHCP_CLIENT_IDENTIFIER()))) {
	$client_ident = BuffToHEX($_[1]->getOptionRaw(DHO_DHCP_CLIENT_IDENTIFIER()));
}else{
	$client_ident = '';
}
if (defined($_[1]->getOptionRaw(DHO_DHCP_REQUESTED_ADDRESS()))) {
	$requested_ip = $_[1]->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
}else{
	$requested_ip = '';
}
if (defined($_[1]->getOptionRaw(DHO_HOST_NAME()))) {
	$hostname = $_[1]->getOptionValue(DHO_HOST_NAME());
}else{
	$hostname = '';
}
if (defined($_[1]->getOptionRaw(DHO_VENDOR_CLASS_IDENTIFIER()))) {
	$dhcp_vendor_class = $_[1]->getOptionValue(DHO_VENDOR_CLASS_IDENTIFIER());
}else{
	$dhcp_vendor_class = '';
}
if (defined($_[1]->getOptionRaw(DHO_USER_CLASS()))) {
	$dhcp_user_class = $_[1]->getOptionRaw(DHO_USER_CLASS());
}else{
	$dhcp_user_class = '';
}



$sth = $_[0]->prepare("INSERT INTO `log_dhcp`
            (`t`, `agent_mac`, `agent_ip`, `cl_mac`, `cl_ip`, `cl_port`, `cl_vlan`, `cl_name`, `cl_vendor`, `m_type`)
     VALUES(NOW(), '$dhcp_opt82_chasis_id', '$gateway_ip', '$mac', '$requested_ip', '$dhcp_opt82_port_id', '$dhcp_opt82_vlan_id', '$hostname', '$dhcp_vendor_class', $message_type)
");


$sth->execute();
$sth->finish();
}

 

--
-- Структура таблицы `log_dhcp`
--

CREATE TABLE IF NOT EXISTS `log_dhcp` (
 `t` datetime NOT NULL,
 `agent_mac` varchar(17) NOT NULL,
 `agent_ip` varchar(15) NOT NULL,
 `cl_mac` varchar(17) NOT NULL,
 `cl_ip` varchar(15) NOT NULL,
 `cl_port` int(1) NOT NULL,
 `cl_vlan` int(2) NOT NULL,
 `cl_name` varchar(20) NOT NULL,
 `cl_vendor` varchar(20) NOT NULL,
 `m_type` varchar(20) NOT NULL
) ENGINE=MyISAM DEFAULT CHARSET=utf8;

Share this post


Link to post
Share on other sites

PS: Не заметил, что ты хотел записать ответ, а не входящее сообщение.

Ну тогда в функции sub send_reply раскоментарить строчку

#db_log_detailed($_[3], $dhcpresppkt);

 

А еще лучше скопировать данную функцию с другим названием и подправить в ней нужные тебе поля

Share this post


Link to post
Share on other sites

doubtpoint, спс

 

upd. Простое раскоментирование не помогло.

 

по дебагу:

Caught error in main loop: Can't call method "getOptionValue" without a package or object reference at /lib/dhcp-perl/dhcpd.pl line 1056.

Edited by Cramac

Share this post


Link to post
Share on other sites

по дебагу:

Caught error in main loop: Can't call method "getOptionValue" without a package or object reference at /lib/dhcp-perl/dhcpd.pl line 1056.

У меня немного другой код и я не могу тебе все исправить под твои задачи. Надо немного самому на месте подобраться или попросить человека разбирающегося на перл.

 

Наверное в sub send_reply надо

#db_log_detailed($_[3], $dhcpresppkt);

заменить

#db_log_detailed($_[3], $dhcpresp);

 

--------------------------

По моему вопросу, я обнаружил, что пишется в файл кусками по 8 кбайт. Как бы заставить писать по строчно?

Edited by doubtpoint

Share this post


Link to post
Share on other sites

не, точно не то...я так пологаю что надо передавать то что отсылается, что у меня и прописано..

send($SOCKET_RCV, $dhcpresppkt, 0, $toaddr) || logger("send error: $!");

db_log_detailed($_[3], $dhcpresppkt);

 

sub send_reply {
#my $fromaddr = $_[0];
#my $dhcpreq = $_[1];
#my $dhcpresp = $_[2];
#my $dbh = $_[3];
my ($dhcpresppkt, $toaddr);


# add last!!!!
if (defined($_[1]->getOptionRaw(DHO_DHCP_AGENT_OPTIONS()))) {
	$_[2]->addOptionRaw(DHO_DHCP_AGENT_OPTIONS(), $_[1]->getOptionRaw(DHO_DHCP_AGENT_OPTIONS()));
}

$dhcpresppkt = $_[2]->serialize();
#if (length($dhcpresppkt) < 548) {
#	$dhcpresppkt .= "\0" x (548 - length($dhcpresppkt));
#}


if ($_[1]->giaddr() eq '0.0.0.0') {
	# client local, not relayed
	if ($_[2]->DHO_DHCP_MESSAGE_TYPE() == DHCPNAK) {# allways broadcast DHCPNAK
		$toaddr = $ADDR_BCAST;
	}else{
		if ($_[1]->ciaddr() eq '0.0.0.0') {
			# ALL HERE NON RFC 2131 4.1 COMPLIANT!!!
			# perl can not send to hw addr unicaset with ip 0.0.0.0, and we send broadcast
			if ($_[1]->flags() == 0 || 1) {# send unicast XXXXXXXXX - flags ignored!
				# here we mast send unicast to hw addr, ip 0.0.0.0
				my ($port, $addr) = unpack_sockaddr_in($_[0]);
				my $ipaddr = inet_ntoa($addr);

				if ($ipaddr eq '0.0.0.0') {
					$toaddr = $ADDR_BCAST;
				}else{# giaddr and ciaddr is zero but we know ip addr from received packet
					$toaddr = sockaddr_in($CLIENT_PORT, $addr);
				}
			}else{
				# only this comliant to rfc 2131 4.1
				$toaddr = $ADDR_BCAST;
			}
		}else{# client have IP addr, send unicast
			$toaddr = sockaddr_in($CLIENT_PORT, $_[1]->ciaddrRaw());
		}
	}
}else{# send to relay
	$toaddr = sockaddr_in($SERVER_PORT, $_[1]->giaddrRaw());
}
send($SOCKET_RCV, $dhcpresppkt, 0, $toaddr) || logger("send error: $!");
db_log_detailed($_[3], $dhcpresppkt);


if (defined($DEBUG)) {
	my ($port, $addr) = unpack_sockaddr_in($toaddr);
	my $ipaddr = inet_ntoa($addr);
    	logger("Sending response to = $ipaddr:$port length = ".length($dhcpresppkt));
	if ($DEBUG > 1) { logger($_[2]->toString()); }
}

# send copy of packet to mirror, if specified
if (defined($ADDR_MIRROR)) { send($SOCKET_RCV, $dhcpresppkt, 0, $ADDR_MIRROR) || logger("send mirr error: $!"); }

}

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this