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 "\xff\x53\x4d\x42") {
$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__
----------------- 8< ----------------- （完）