通过perl实现一个简单的NIDS

#!/usr/bin/perl
#
# Comments/suggestions to stardust at xfocus dot org
#
#
# $Id: perl-ids.pl,v 1.16 2004/03/04 21:51:12 stardust Exp $
#
# 引用所有相关的模块
use Net::PcapUtils;
use NetPacket::Ethernet qw(:strip);
use NetPacket::TCP;
use NetPacket::IP qw(:protos);
use NetPacket::SMB;
use NetPacket::FTP;
# 定义日志文件名
$workingdir = "./";
$attacklog = "attack.log";
$monitorlog = "monitor.log";
# 以后台进程方式运行
daemon ();
sub daemon {
unless (fork) {
SniffLoop ();
exit 0;
}
exit 1;
}
# 抓包循环
sub SniffLoop {
# 进入工作目录
chdir ("$workingdir");
# 打开日志文件
open (ATTACKLOG,">> $attacklog");
open (MONITORLOG,">> $monitorlog");
# 设置文件读写为非缓冲模式
select(ATTACKLOG); $　++; select(MONITORLOG); $　++; select(STDOUT); $　++;
# 设置信号处理函数，因为程序运行于后台，退出时需要利用信号处理函数做些清理工作
$SIG{"INT"} = 'HandleINT';
$SIG{"TERM"} = 'HandleTERM';
# 进入抓包回调函数
Net::PcapUtils::loop(&sniffit, SNAPLEN => 1800, Promisc => 1, FILTER => 'tcp or udp', DEV => 'eth0');
}
sub sniffit {
my ($args,$header,$packet) = @_;
# 解码IP包
$ip = NetPacket::IP->decode(eth_strip($packet));
# TCP协议
if ($ip->{proto} == IP_PROTO_TCP) {
# 解码TCP包
$tcp = NetPacket::TCP->decode($ip->{data});
# 检查来自SMB客户端的包
if (($tcp->{dest_port} == 139) 　　 ($tcp->{dest_port} == 445)) {
# 如果目的端口是139或445，认为是SMB协议包，做相应的检查
SmbClientCheck ($ip->{src_ip},$tcp->{src_port},$ip->{dest_ip},$tcp->{dest_port},$tcp->{data});
} elsif ($tcp->{dest_port} == 21) {
# 如果目的端口是21，认为是FTP协议，做相应的检查
FtpClientCheck ($ip->{src_ip},$tcp->{src_port},$ip->{dest_ip},$tcp->{dest_port},$tcp->{data});
} else {}
# UDP协议
} elsif ($ip->{proto} == IP_PROTO_UDP) {
} else {}
}
sub SmbClientCheck {
my ($src_ip,$src_port,$dest_ip,$dst_port,$data) = @_;
# 调用SMB解码模块解码
$smb = NetPacket::SMB->decode($data);
# 如果解码成功
if ($smb->{valid}) {
# 示例检测新近公布eeye的那个ASN.1解码错误导致的堆破坏漏洞
# BID：9633,9635 CVEID：CAN-2003-0818 NSFOCUSID：6000
# 如果SMB命令是Session Setup AndX
if ($smb->{cmd} == 0x73) {
# 如果设置了Extended Security Negotiation位，表示有包里有Security Blob
if ($smb->{flags2} & F2_EXTSECURINEG) {
# 用正则表达式匹配通常会在攻击包里出现的OID及引发错误的畸形数据串
# 由于不是从原理上检测加之ASN.1编码的灵活性，这样的检测会导致漏报
if (($smb->{bytecount} > 0) && ($smb->{bytes} =~ m/x06x06x2bx06x01x05x05x02.*[xa1x05x23x03x03x01x07　x84xffxffxff]/)) {
# 记入日志文件
LogAlert ($src_ip,$src_port,$dest_ip,$dst_port,"ASN.1 malform encode attack!");
}
}
}
}
}
sub FtpClientCheck {
my ($src_ip,$src_port,$dest_ip,$dst_port,$data) = @_;
# 调用FTP解码模块解码
$ftp = NetPacket::FTP->decode($data);
# 如果解码成功
if ($ftp->{valid}) {
# 示例检测新近公布的Serv-U < 5.0.0.4版FTP服务器MDTM命令溢出攻击
# BID：9751 NSFOCUSID：6078
# 遍历从数据包里解码出来的FTP命令及其参数
for (my $i = 1;$i <= $ftp->{cmdcount};$i++) {
my $cmd = "cmd"."$i";
my $para = "para"."$i";
# 如果FTP命令是MDTM
if (uc($ftp->{$cmd}) eq "MDTM") {
# 用正则表达式匹配引发溢出的参数串，这里体现了正则
# 表达式的强大，用此匹配可以从原理上检测到畸形参数串
if ($ftp->{$para} =~ m/d{14}[+　-]S{5,}s+S{1,}/) {
LogAlert ($src_ip,$src_port,$dest_ip,$dst_port,"Serv-U < v5.0.0.4 MDTM command long timezone string overflow attack!");
}
}
}
}
}
# 记录攻击告警
sub LogAlert {
my ($src_ip,$src_port,$dest_ip,$dst_port,$message) = @_;
my $nowtime = localtime;
printf ATTACKLOG ("%s %s:%s -> %s:%s %s ",$nowtime,$src_ip,$src_port,$dest_ip,$dst_port,$message);
printf ("%s %s:%s -> %s:%s %s ",$nowtime,$src_ip,$src_port,$dest_ip,$dst_port,$message);
}
# 记录监控信息
sub LogMonitor {
my ($src_ip,$src_port,$dest_ip,$dst_port,$message) = @_;
my $nowtime = localtime;
printf MONITORLOG ("%s %s:%s -> %s:%s %s ",$nowtime,$src_ip,$src_port,$dest_ip,$dst_port,$message);
printf ("%s %s:%s -> %s:%s %s ",$nowtime,$src_ip,$src_port,$dest_ip,$dst_port,$message);
}
# INT信号处理例程
sub HandleINT {
CleanUp ();
exit (0);
}
# TERM信号处理例程
sub HandleTERM {
CleanUp ();
exit (0);
}
# 清理，主要工作是关闭文件句柄
sub CleanUp {
close (ATTACKLOG); close (MONITORLOG);
}

#
# NetPacket::FTP - Decode FTP packets
#
# Comments/suggestions to stardust at xfocus dot org
#
#
# $Id: FTP.pm,v 1.16 2004/03/03 l1:16:20 stardust Exp $
#
package NetPacket::FTP;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use NetPacket;
my $myclass;
BEGIN {
$myclass = __PACKAGE__;
$VERSION = "0.01";
}
sub Version () { "$myclass v$VERSION" }
BEGIN {
@ISA = qw(Exporter NetPacket);
# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
@EXPORT = qw(
);
# Other items we are prepared to export if requested
@EXPORT_OK = qw(
);
# Tags:
%EXPORT_TAGS = (
ALL => [@EXPORT, @EXPORT_OK],
);
}
#
# Decode the packet
#
# FTP协议文本参看RFC959，http://www.ietf.org/rfc/rfc0959.txt
# 常见的FTP命令
my @ftp_cmds = qw(ABOR ACCT ALLO APPE CDUP CWD DELE HELP LIST MKD MODE NLST
NOOP PASS PASV PORT PWD QUIT REIN REST RETR RMD RNFR RNTO
SITE SMNT STAT STOR STOU STRU SYST TYPE USER XCUP XCWD XMKD
XPWD XRMD LPRT LPSV ADAT AUTH CCC CONF ENC MIC PBSZ PROT
FEAT OPTS EPRT EPSV LANG MDTM MLSD MLST SIZE DIGT CLNT MACB
);
sub decode {
my $class = shift;
my($data) = @_;
my $self = {};
my $cmdhead = 0;
my $cmdtail = 0;
my @parts = ();
my $cmdcount = 0;
my $returnindex = 0;
my $data_len = length($data);
# 如果数据长度过短则不处理
if ($data_len >= 4) {
# 一个包里的FTP命令个数
$self->{cmdcount} = 0;
# 搜索回车，之前认为是一个命令行，需要注意的是一个包里可能包含多个FTP命令
while ( (($returnindex = index ($data,"x0a",$cmdhead)) >=0) 　　 (($returnindex < 0) && (($data_len - $cmdhead) >= 4))) {
# 调整一个命令行串尾指针
if ($returnindex < 0) {
$cmdtail = $data_len -1;
} else {
$cmdtail = $returnindex;
}
if ((my $cmdlen = ($cmdtail - $cmdhead + 1)) >= 4) {
# 取出命令行串
my $cmdline = substr($data,$cmdhead,$cmdlen);
# 从命令行里拆分出命令名和它的参数串
if (splitcmd($cmdline,@parts)) {
$self->{cmdcount}++;
my $cmdindex = "cmd"."$self->{cmdcount}";
my $paraindex = "para"."$self->{cmdcount}";
# 记录到要返回到主程序的对象
$self->{$cmdindex} = $parts[0];
$self->{$paraindex} = $parts[1];
}
}
# 调整命令行串头指针
$cmdhead = $cmdtail + 1;
}
# 如果命令个数大于0，则说明解码是有效的
if ($self->{cmdcount} == 0) {
$self->{valid} = 0;
} else {
$self->{valid} = 1;
}
} else {
$self->{valid} = 0;
}
# 返回对象
bless($self, $class);
return $self;
}
sub splitcmd {
my ($cmdline,$parts) = @_;
# 去除行尾的回车
chomp($cmdline);
# 用正则表达式抽取出命令名字和参数，既然效率不是考虑的主要问题就“毫无顾忌”地使用正则表达式，因为方便
if ($cmdline =~ m/^s*([a-zA-Z]{3,4})s+(.*)/) {
my $valid_cmd = 0;
# 检查抽出来的命令名字是否是一个已知的合法FTP命令
for (my $i=0;$i<@ftp_cmds;$i++) {
if ($ftp_cmds[$i] eq uc($1)) {
$valid_cmd = 1;
last;
}
}
# 如果是合法的命令则返回给调用函数
if ($valid_cmd) {
${$parts}[0] = $1;
${$parts}[1] = $2;
return 1;
} else {
return 0;
}
} else {
return 0;
}
}
#
# Module initialisation
#
1;
# autoloaded methods go after the END token (&& pod) below
__END__

#
# NetPacket::SMB - Decode SMB packets
#
# Comments/suggestions to stardust at xfocus dot org
#
#
# $Id: SMB.pm,v 1.16 2004/02/23 12:25:17 stardust Exp $
#
package NetPacket::SMB;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use NetPacket;
my $myclass;
# SMB flags
use constant F2_LONGNAMEALLW => 0x0001;
use constant F2_EXTATTRIBUTE => 0x0002;
use constant F2_SECURITYSIGN => 0x0004;
use constant F2_LONGNAMEUSED => 0x0040;
use constant F2_EXTSECURINEG => 0x0800;
use constant F2_DONTRESOLDFS => 0x1000;
use constant F2_EXECONLYREAD => 0x2000;
use constant F2_ERRORCODTYPE => 0x4000;
use constant F2_UNICODSTRING => 0x8000;
use constant F_LOCKANDREAD => 0x01;
use constant F_RCVBUFFPOST => 0x02;
use constant F_CASESENSITV => 0x08;
use constant F_CANONICPATH => 0x10;
use constant F_OPLOCKSREQU => 0x20;
use constant F_NOTIFYONOPN => 0x40;
use constant F_REQUERESPON => 0x80;
BEGIN {
$myclass = __PACKAGE__;
$VERSION = "0.01";
}
sub Version () { "$myclass v$VERSION" }
BEGIN {
@ISA = qw(Exporter NetPacket);
# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
@EXPORT = qw(F2_LONGNAMEALLW F2_EXTATTRIBUTE F2_SECURITYSIGN
F2_LONGNAMEUSED F2_EXTSECURINEG F2_DONTRESOLDFS
F2_EXECONLYREAD F2_ERRORCODTYPE F2_UNICODSTRING
F_LOCKANDREAD F_RCVBUFFPOST F_CASESENSITV
F_CANONICPATH F_OPLOCKSREQU F_NOTIFYONOPN
F_REQUERESPON
);
# Other items we are prepared to export if requested
@EXPORT_OK = qw(smb_strip
);
# Tags:
%EXPORT_TAGS = (
ALL => [@EXPORT, @EXPORT_OK],
strip => [qw(smb_strip)],
);
}
#
# Strip header from packet and return the data contained in it
#
undef &smb_strip;
*smb_strip = &strip;
# 剥除SMB头的函数
sub strip {
my ($data) = @_;
my $smb_obj = NetPacket::SMB->decode($data);
return $smb_obj->{data};
}
#
# Decode the packet
#
sub decode {
my $class = shift;
my($data) = @_;
my $self = {};
my $data_len = 0;
my $temp = "";
$data_len = length ($data);
# 如果数据区长度小于39字节（4+32+3），则认为不是一个可解码的SMB包
if ($data_len < 39) {
$self->{valid} = 0;
} else {
# 取SMB的标志串
my $smb_mark = substr ($data,4,4);
# 是否符合标志串
if ($smb_mark ne "xffx53x4dx42") {
$self->{valid} = 0;
} else {
$self->{valid} = 1;
# Decode SMB packet
if (defined($data)) {
# 用PERL的unpack函数解码32字节长的SMB头结构，头结构可
# 参考 http://www.cs.uml.edu/~bill/cs592/cifs.chm
# 感谢小四（scz at nsfocus dot com）对于SMB头结构中字段字节序的提醒
($self->{nbt_type}, $self->{nbt_flag}, $self->{nbt_len},
$self->{mark}, $self->{cmd}, $self->{status},
$self->{flags}, $self->{flags2}, $self->{ext},
$self->{ext2}, $self->{ext3}, $self->{tid},
$self->{pid}, $self->{uid}, $self->{mid},
$self->{data}) = unpack("CCna4CVCvVVVvvvva*", $data);
($self->{wordcount},$temp) = unpack("Ca*",$self->{data});
if ((36 + 1 + $self->{wordcount} * 2) <= ($data_len - 2)) {
# 解码SMB结构下的wordcount字节及bytecount字节数据
my $wordbytes = $self->{wordcount} * 2;
($self->{wordcount},$self->{words},$self->{bytecount},$self->{bytes}) = unpack("C"."a"."$wordbytes"."va*",$self->{data});
} else {
($self->{wordcount},$self->{words}) = unpack("Ca*",$self->{data});
$self->{bytecount} = -1; $self->{bytes} = "";
}
}
}
}
# 返回对象
bless($self, $class);
return $self;
}
#
# Module initialisation
#
1;
# autoloaded methods go after the END token (&& pod) below
__END__