package Parse::Win32Registry::Base;
use strict;
use warnings;
use base qw(Exporter);
use Carp;
use Encode;
use Time::Local qw(timegm);
our @EXPORT_OK = qw(
warnf
iso8601
hexdump
format_octets
unpack_windows_time
unpack_string
unpack_unicode_string
unpack_guid
unpack_sid
unpack_ace
unpack_acl
unpack_security_descriptor
unpack_series
make_multiple_subkey_iterator
make_multiple_value_iterator
make_multiple_subtree_iterator
compare_multiple_keys
compare_multiple_values
REG_NONE
REG_SZ
REG_EXPAND_SZ
REG_BINARY
REG_DWORD
REG_DWORD_BIG_ENDIAN
REG_LINK
REG_MULTI_SZ
REG_RESOURCE_LIST
REG_FULL_RESOURCE_DESCRIPTOR
REG_RESOURCE_REQUIREMENTS_LIST
REG_QWORD
);
our %EXPORT_TAGS = (
all => [@EXPORT_OK],
);
use constant REG_NONE => 0;
use constant REG_SZ => 1;
use constant REG_EXPAND_SZ => 2;
use constant REG_BINARY => 3;
use constant REG_DWORD => 4;
use constant REG_DWORD_BIG_ENDIAN => 5;
use constant REG_LINK => 6;
use constant REG_MULTI_SZ => 7;
use constant REG_RESOURCE_LIST => 8;
use constant REG_FULL_RESOURCE_DESCRIPTOR => 9;
use constant REG_RESOURCE_REQUIREMENTS_LIST => 10;
use constant REG_QWORD => 11;
our $WARNINGS = 0;
our $CODEPAGE = 'cp1252';
sub warnf {
my $message = shift;
warn sprintf "$message\n", @_ if $WARNINGS;
}
sub hexdump {
my $data = shift; # packed binary data
my $start = shift || 0; # starting value for displayed offset
return '' if !defined($data);
my $output = '';
my $fake_start = $start & ~0xf;
my $end = length($data);
my $pos = 0;
if ($fake_start < $start) {
$output .= sprintf '%8x ', $fake_start;
my $indent = $start - $fake_start;
$output .= ' ' x $indent;
my $row = substr($data, $pos, 16 - $indent);
my $len = length($row);
$output .= join(' ', unpack('H2' x $len, $row));
if ($indent + $len < 16) {
my $padding = 16 - $len - $indent;
$output .= ' ' x $padding;
}
$output .= ' ';
$output .= ' ' x $indent;
$row =~ tr/\x20-\x7e/./c;
$output .= $row;
$output .= "\n";
$pos += $len;
}
while ($pos < $end) {
$output .= sprintf '%8x ', $start + $pos;
my $row = substr($data, $pos, 16);
my $len = length($row);
$output .= join(' ', unpack('H2' x $len, $row));
if ($len < 16) {
my $padding = 16 - $len;
$output .= ' ' x $padding;
}
$output .= ' ';
$row =~ tr/\x20-\x7e/./c;
$output .= $row;
$output .= "\n";
$pos += 16;
}
return $output;
}
sub format_octets {
my $data = shift; # packed binary data
my $col = shift || 0; # starting column, e.g. length of initial string
return "\n" if !defined($data);
my $output = '';
$col = 76 if $col > 76;
my $max_octets = int((76 - $col) / 3) + 1;
my $end = length($data);
my $pos = 0;
my $num_octets = $end - $pos;
$num_octets = $max_octets if $num_octets > $max_octets;
while ($pos < $end) {
$output .= join(',', unpack("x$pos(H2)$num_octets", $data));
$pos += $num_octets;
$num_octets = $end - $pos;
$num_octets = 25 if $num_octets > 25;
if ($num_octets > 0) {
$output .= ",\\\n ";
}
}
$output .= "\n";
return $output;
}
sub unpack_windows_time {
my $data = shift;
if (!defined $data) {
return;
}
if (length($data) < 8) {
return;
}
# The conversion uses real numbers
# as 32-bit perl does not provide 64-bit integers.
# The equation can be found in several places on the Net.
# My thanks go to Dan Sully for Audio::WMA's _fileTimeToUnixTime
# which shows a perl implementation of it.
my ($low, $high) = unpack("VV", $data);
my $filetime = $high * 2 ** 32 + $low;
my $epoch_time = int(($filetime - 116444736000000000) / 10000000);
# adjust the UNIX epoch time to the local OS's epoch time
# (see perlport's Time and Date section)
my $epoch_offset = timegm(0, 0, 0, 1, 0, 70);
$epoch_time += $epoch_offset;
if ($epoch_time < 0 || $epoch_time > 0x7fffffff) {
$epoch_time = undef;
}
return wantarray ? ($epoch_time, 8) : $epoch_time;
}
sub iso8601 {
my $time = shift;
my $tz = shift;
if (!defined $time) {
return '(undefined)';
}
if (!defined $tz || $tz ne 'Z') {
$tz = 'Z'
}
# On Windows, gmtime will return undef if $time < 0 or > 0x7fffffff
if ($time < 0 || $time > 0x7fffffff) {
return '(undefined)';
}
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime $time;
# The final 'Z' indicates UTC ("zero meridian")
return sprintf '%04d-%02d-%02dT%02d:%02d:%02d%s',
1900+$year, 1+$mon, $mday, $hour, $min, $sec, $tz;
}
sub unpack_string {
my $data = shift;
if (!defined $data) {
return;
}
my $str;
my $str_len;
if ((my $end = index($data, "\0")) != -1) {
$str = substr($data, 0, $end);
$str_len = $end + 1; # include the final null in the length
}
else {
$str = $data;
$str_len = length($data);
}
return wantarray ? ($str, $str_len) : $str;
}
sub unpack_unicode_string {
my $data = shift;
if (!defined $data) {
return;
}
my $str_len = 0;
foreach my $v (unpack('v*', $data)) {
$str_len += 2;
last if $v == 0; # include the final null in the length
}
my $str = decode('UCS-2LE', substr($data, 0, $str_len));
# The decode function from Encode may create invalid unicode characters
# which cause subsequent warnings (e.g. during regex matching).
# For example, characters in the 0xd800 to 0xdfff range of the
# basic multilingual plane (0x0000 to 0xffff) are 'surrogate pairs'
# and are expected to appear as a 'high surrogate' (0xd800 to 0xdbff)
# followed by a 'low surrogate' (0xdc00 to 0xdfff).
# remove any final null
if (length($str) > 0 && substr($str, -1, 1) eq "\0") {
chop $str;
}
return wantarray ? ($str, $str_len) : $str;
}
sub unpack_guid {
my $guid = Parse::Win32Registry::GUID->new($_[0]);
return if !defined $guid;
return wantarray ? ($guid, $guid->get_length) : $guid;
}
sub unpack_sid {
my $sid = Parse::Win32Registry::SID->new($_[0]);
return if !defined $sid;
return wantarray ? ($sid, $sid->get_length) : $sid;
}
sub unpack_ace {
my $ace = Parse::Win32Registry::ACE->new($_[0]);
return if !defined $ace;
return wantarray ? ($ace, $ace->get_length) : $ace;
}
sub unpack_acl {
my $acl = Parse::Win32Registry::ACL->new($_[0]);
return if !defined $acl;
return wantarray ? ($acl, $acl->get_length) : $acl;
}
sub unpack_security_descriptor {
my $sd = Parse::Win32Registry::SecurityDescriptor->new($_[0]);
return if !defined $sd;
return wantarray ? ($sd, $sd->get_length) : $sd;
}
sub unpack_series {
my $function = shift;
my $data = shift;
if (!defined $function || !defined $data) {
croak "Usage: unpack_series(\\\&unpack_function, \$data)";
}
my $pos = 0;
my @items = ();
while (my ($item, $item_len) = $function->(substr($data, $pos))) {
push @items, $item;
$pos += $item_len;
}
return @items;
}
sub make_multiple_subkey_iterator {
my @keys = @_;
# check @keys contains keys
if (@keys == 0 ||
grep { defined && !UNIVERSAL::isa($_, 'Parse::Win32Registry::Key') }
@keys) {
croak 'Usage: make_multiple_subkey_iterator($key1, $key2, ...)';
}
my %subkeys_seen = ();
my @subkeys_queue;
for (my $i = 0; $i < @keys; $i++) {
my $key = $keys[$i];
next if !defined $key;
foreach my $subkey ($key->get_list_of_subkeys) {
my $name = $subkey->get_name;
$subkeys_seen{$name}[$i] = $subkey;
}
}
foreach my $name (sort keys %subkeys_seen) {
# make sure number of subkeys matches number of keys
if (@{$subkeys_seen{$name}} != @keys) {
@{$subkeys_seen{$name}}[@keys - 1] = undef;
}
push @subkeys_queue, $subkeys_seen{$name};
}
return Parse::Win32Registry::Iterator->new(sub {
my $subkeys = shift @subkeys_queue;
if (defined $subkeys) {
return $subkeys;
}
else {
return;
}
});
}
sub make_multiple_value_iterator {
my @keys = @_;
# check @keys contains keys
if (@keys == 0 ||
grep { defined && !UNIVERSAL::isa($_, 'Parse::Win32Registry::Key') }
@keys) {
croak 'Usage: make_multiple_value_iterator($key1, $key2, ...)';
}
my %values_seen = ();
my @values_queue;
for (my $i = 0; $i < @keys; $i++) {
my $key = $keys[$i];
next if !defined $key;
foreach my $value ($key->get_list_of_values) {
my $name = $value->get_name;
$values_seen{$name}[$i] = $value;
}
}
foreach my $name (sort keys %values_seen) {
# make sure number of values matches number of keys
if (@{$values_seen{$name}} != @keys) {
@{$values_seen{$name}}[@keys - 1] = undef;
}
push @values_queue, $values_seen{$name};
}
return Parse::Win32Registry::Iterator->new(sub {
my $values = shift @values_queue;
if (defined $values) {
return $values;
}
else {
return;
}
});
}
sub make_multiple_subtree_iterator {
my @keys = @_;
# check @keys contains keys
if (@keys == 0 ||
grep { defined && !UNIVERSAL::isa($_, 'Parse::Win32Registry::Key') }
@keys) {
croak 'Usage: make_multiple_subtree_iterator($key1, $key2, ...)';
}
my @start_keys = (\@keys);
push my (@subkey_iters), Parse::Win32Registry::Iterator->new(sub {
return shift @start_keys;
});
my $value_iter;
my $subkeys; # used to remember subkeys while iterating values
return Parse::Win32Registry::Iterator->new(sub {
if (defined $value_iter && wantarray) {
my $values = $value_iter->();
if (defined $values) {
return ($subkeys, $values);
}
}
while (@subkey_iters > 0) {
$subkeys = $subkey_iters[-1]->(); # depth-first
if (defined $subkeys) {
push @subkey_iters, make_multiple_subkey_iterator(@$subkeys);
$value_iter = make_multiple_value_iterator(@$subkeys);
return $subkeys;
}
pop @subkey_iters; # iter finished, so remove it
}
return;
});
}
sub compare_multiple_keys {
my @keys = @_;
# check @keys contains keys
if (@keys == 0 ||
grep { defined && !UNIVERSAL::isa($_, 'Parse::Win32Registry::Key') }
@keys) {
croak 'Usage: compare_multiple_keys($key1, $key2, ...)';
}
my @changes = ();
my $benchmark_key;
foreach my $key (@keys) {
my $diff = '';
# Skip comparison for the first value
if (@changes > 0) {
$diff = _compare_keys($benchmark_key, $key);
}
$benchmark_key = $key;
push @changes, $diff;
}
return @changes;
}
sub compare_multiple_values {
my @values = @_;
# check @values contains values
if (@values == 0 ||
grep { defined && !UNIVERSAL::isa($_, 'Parse::Win32Registry::Value') }
@values) {
croak 'Usage: compare_multiple_values($value1, $value2, ...)';
}
my @changes = ();
my $benchmark_value;
foreach my $value (@values) {
my $diff = '';
# Skip comparison for the first value
if (@changes > 0) {
$diff = _compare_values($benchmark_value, $value);
}
$benchmark_value = $value;
push @changes, $diff;
}
return @changes;
}
sub _compare_keys {
my ($key1, $key2) = @_;
if (!defined $key1 && !defined $key2) {
return ''; # 'MISSING'
}
elsif (defined $key1 && !defined $key2) {
return 'DELETED';
}
elsif (!defined $key1 && defined $key2) {
return 'ADDED';
}
my $timestamp1 = $key1->get_timestamp;
my $timestamp2 = $key2->get_timestamp;
if ($key1->get_name ne $key2->get_name) {
return 'CHANGED';
}
elsif (defined $timestamp1 && defined $timestamp2) {
if ($timestamp1 < $timestamp2) {
return 'NEWER';
}
elsif ($timestamp1 > $timestamp2) {
return 'OLDER';
}
}
else {
return ''; # comment out to check values...
my $value_iter = make_multiple_value_iterator($key1, $key2);
while (my ($val1, $val2) = $value_iter->get_next) {
if (_compare_values($val1, $val2) ne '') {
return 'VALUES';
}
}
return '';
}
}
sub _compare_values {
my ($val1, $val2) = @_;
if (!defined $val1 && !defined $val2) {
return ''; # 'MISSING'
}
elsif (defined $val1 && !defined $val2) {
return 'DELETED';
}
elsif (!defined $val1 && defined $val2) {
return 'ADDED';
}
my $data1 = $val1->get_data;
my $data2 = $val2->get_data;
if ($val1->get_name ne $val2->get_name ||
$val1->get_type != $val2->get_type ||
defined $data1 ne defined $data2 ||
(defined $data1 && defined $data2 && $data1 ne $data2)) {
return 'CHANGED';
}
else {
return '';
}
}
package Parse::Win32Registry::Iterator;
use Carp;
sub new {
my $class = shift;
my $self = shift;
my $type = ref $self;
croak 'Missing iterator subroutine' if $type ne 'CODE'
&& $type ne __PACKAGE__;
bless $self, $class;
return $self;
}
sub get_next {
$_[0]->();
}
package Parse::Win32Registry::GUID;
sub new {
my $class = shift;
my $data = shift;
if (!defined $data) {
return;
}
if (length($data) < 16) {
return;
}
my $guid = sprintf '{%08X-%04X-%04X-%02X%02X-%02X%02X%02X%02X%02X%02X}',
unpack('VvvC2C6', $data);
my $self = {
_guid => $guid,
_length => 16,
};
bless $self, $class;
return $self;
}
sub as_string {
my $self = shift;
return $self->{_guid};
}
sub get_length {
my $self = shift;
return $self->{_length};
}
package Parse::Win32Registry::SID;
sub new {
my $class = shift;
my $data = shift;
if (!defined $data) {
return;
}
# 0x00 byte = revision
# 0x01 byte = number of sub authorities
# 0x07 byte = identifier authority
# 0x08 dword = 1st sub authority
# 0x0c dword = 2nd sub authority
# ...
if (length($data) < 8) {
return;
}
my ($rev, $num_sub_auths, $id_auth) = unpack('CCx5C', $data);
if ($num_sub_auths == 0) {
return;
}
my $sid_len = 8 + 4 * $num_sub_auths;
if (length($data) < $sid_len) {
return;
}
my @sub_auths = unpack("x8V$num_sub_auths", $data);
my $sid = "S-$rev-$id_auth-" . join('-', @sub_auths);
my $self = {
_sid => $sid,
_length => $sid_len,
};
bless $self, $class;
return $self;
}
# See KB243330 for a list of well known sids
our %WellKnownSids = (
'S-1-0-0' => 'Nobody',
'S-1-1-0' => 'Everyone',
'S-1-3-0' => 'Creator Owner',
'S-1-3-1' => 'Creator Group',
'S-1-3-2' => 'Creator Owner Server',
'S-1-3-3' => 'Creator Group Server',
'S-1-5-1' => 'Dialup',
'S-1-5-2' => 'Network',
'S-1-5-3' => 'Batch',
'S-1-5-4' => 'Interactive',
'S-1-5-5-\\d+-\\d+' => 'Logon Session',
'S-1-5-6' => 'Service',
'S-1-5-7' => 'Anonymous',
'S-1-5-8' => 'Proxy',
'S-1-5-9' => 'Enterprise Domain Controllers',
'S-1-5-10' => 'Principal Self',
'S-1-5-11' => 'Authenticated Users',
'S-1-5-12' => 'Restricted Code',
'S-1-5-13' => 'Terminal Server Users',
'S-1-5-18' => 'Local System',
'S-1-5-19' => 'Local Service',
'S-1-5-20' => 'Network Service',
'S-1-5-\\d+-\\d+-\\d+-\\d+-500' => 'Administrator',
'S-1-5-\\d+-\\d+-\\d+-\\d+-501' => 'Guest',
'S-1-5-\\d+-\\d+-\\d+-\\d+-502' => 'KRBTGT',
'S-1-5-\\d+-\\d+-\\d+-\\d+-512' => 'Domain Admins',
'S-1-5-\\d+-\\d+-\\d+-\\d+-513' => 'Domain Users',
'S-1-5-\\d+-\\d+-\\d+-\\d+-514' => 'Domain Guests',
'S-1-5-\\d+-\\d+-\\d+-\\d+-515' => 'Domain Computers',
'S-1-5-\\d+-\\d+-\\d+-\\d+-516' => 'Domain Controllers',
'S-1-5-\\d+-\\d+-\\d+-\\d+-517' => 'Cert Publishers',
'S-1-5-\\d+-\\d+-\\d+-\\d+-518' => 'Schema Admins',
'S-1-5-\\d+-\\d+-\\d+-\\d+-519' => 'Enterprise Admins',
'S-1-5-\\d+-\\d+-\\d+-\\d+-520' => 'Group Policy Creator Owners',
'S-1-5-\\d+-\\d+-\\d+-\\d+-533' => 'RAS and IAS Servers',
'S-1-5-32-544' => 'Administrators',
'S-1-5-32-545' => 'Users',
'S-1-5-32-546' => 'Guest',
'S-1-5-32-547' => 'Power Users',
'S-1-5-32-548' => 'Account Operators',
'S-1-5-32-549' => 'Server Operators',
'S-1-5-32-550' => 'Print Operators',
'S-1-5-32-551' => 'Backup Operators',
'S-1-5-32-552' => 'Replicators',
'S-1-16-4096' => 'Low Integrity Level',
'S-1-16-8192' => 'Medium Integrity Level',
'S-1-16-12288' => 'High Integrity Level',
'S-1-16-16384' => 'System Integrity Level',
);
sub get_name {
my $self = shift;
my $sid = $self->{_sid};
foreach my $regexp (keys %WellKnownSids) {
if ($sid =~ m/^$regexp$/) {
return $WellKnownSids{$regexp};
}
}
return;
}
sub as_string {
my $self = shift;
return $self->{_sid};
}
sub get_length {
my $self = shift;
return $self->{_length};
}
package Parse::Win32Registry::ACE;
sub new {
my $class = shift;
my $data = shift;
if (!defined $data) {
return;
}
# 0x00 byte = type
# 0x01 byte = flags
# 0x02 word = length
# Types:
# ACCESS_ALLOWED_ACE_TYPE = 0
# ACCESS_DENIED_ACE_TYPE = 1
# SYSTEM_AUDIT_ACE_TYPE = 2
# SYSTEM_MANDATORY_LABEL_ACE_TYPE = x011
# Flags:
# OBJECT_INHERIT_ACE = 0x01
# CONTAINER_INHERIT_ACE = 0x02
# NO_PROPAGATE_INHERIT_ACE = 0x04
# INHERIT_ONLY_ACE = 0x08
# INHERITED_ACE = 0x10
# SUCCESSFUL_ACCESS_ACE_FLAG = 0x40 (Audit Success)
# FAILED_ACCESS_ACE_FLAG = 0x80 (Audit Failure)
if (length($data) < 4) {
return;
}
my ($type, $flags, $ace_len) = unpack('CCv', $data);
if (length($data) < $ace_len) {
return;
}
# The data following the header varies depending on the type.
# For ACCESS_ALLOWED_ACE, ACCESS_DENIED_ACE, SYSTEM_AUDIT_ACE
# the header is followed by an access mask and a sid.
# 0x04 dword = access mask
# 0x08 = SID
# Only the following types are currently unpacked:
# 0 (ACCESS_ALLOWED_ACE), 1 (ACCESS_DENIED_ACE), 2 (SYSTEM_AUDIT_ACE)
if ($type >= 0 && $type <= 2 || $type == 0x11) {
my $access_mask = unpack('x4V', $data);
my $sid = Parse::Win32Registry::SID->new(substr($data, 8,
$ace_len - 8));
# Abandon ace if sid is invalid
if (!defined $sid) {
return;
}
# Abandon ace if not the expected length
if (($sid->get_length + 8) != $ace_len) {
return;
}
my $self = {
_type => $type,
_flags => $flags,
_mask => $access_mask,
_trustee => $sid,
_length => $ace_len,
};
bless $self, $class;
return $self;
}
else {
return;
}
}
our @Types = qw(
ACCESS_ALLOWED
ACCESS_DENIED
SYSTEM_AUDIT
SYSTEM_ALARM
ALLOWED_COMPOUND
ACCESS_ALLOWED_OBJECT
ACCESS_DENIED_OBJECT
SYSTEM_AUDIT_OBJECT
SYSTEM_ALARM_OBJECT
ACCESS_ALLOWED_CALLBACK
ACCESS_DENIED_CALLBACK
ACCESS_ALLOWED_CALLBACK_OBJECT
ACCESS_DENIED_CALLBACK_OBJECT
SYSTEM_AUDIT_CALLBACK
SYSTEM_ALARM_CALLBACK
SYSTEM_AUDIT_CALLBACK_OBJECT
SYSTEM_ALARM_CALLBACK_OBJECT
SYSTEM_MANDATORY_LABEL
);
sub _look_up_ace_type {
my $type = shift;
if (exists $Types[$type]) {
return $Types[$type];
}
else {
return '';
}
}
sub get_type {
return $_[0]->{_type};
}
sub get_type_as_string {
return _look_up_ace_type($_[0]->{_type});
}
sub get_flags {
return $_[0]->{_flags};
}
sub get_access_mask {
return $_[0]->{_mask};
}
sub get_trustee {
return $_[0]->{_trustee};
}
sub as_string {
my $self = shift;
my $sid = $self->{_trustee};
my $string = sprintf '%s 0x%02x 0x%08x %s',
_look_up_ace_type($self->{_type}),
$self->{_flags},
$self->{_mask},
$sid->as_string;
my $name = $sid->get_name;
$string .= " [$name]" if defined $name;
return $string;
}
sub get_length {
my $self = shift;
return $self->{_length};
}
package Parse::Win32Registry::ACL;
use Carp;
sub new {
my $class = shift;
my $data = shift;
if (!defined $data) {
return;
}
# 0x00 byte = revision
# 0x01
# 0x02 word = length
# 0x04 word = number of aces
# 0x06
# 0x08 = first ace (variable length)
# ... = second ace (variable length)
# ...
if (length($data) < 8) {
return;
}
my ($rev, $acl_len, $num_aces) = unpack('Cxvv', $data);
if (length($data) < $acl_len) {
return;
}
my $pos = 8;
my @acl = ();
foreach (my $num = 0; $num < $num_aces; $num++) {
my $ace = Parse::Win32Registry::ACE->new(substr($data, $pos,
$acl_len - $pos));
# Abandon acl if any single ace is undefined
return if !defined $ace;
push @acl, $ace;
$pos += $ace->get_length;
}
# Abandon acl if not expected length, but don't use
# $pos != $acl_len as some acls contain unused space.
if ($pos > $acl_len) {
return;
}
my $self = {
_acl => \@acl,
_length => $acl_len,
};
bless $self, $class;
return $self;
}
sub get_list_of_aces {
my $self = shift;
return @{$self->{_acl}};
}
sub as_string {
croak 'Usage: ACLs do not have an as_string method; use as_stanza instead';
}
sub as_stanza {
my $self = shift;
my $stanza = '';
foreach my $ace (@{$self->{_acl}}) {
$stanza .= 'ACE: '. $ace->as_string . "\n";
}
return $stanza;
}
sub get_length {
my $self = shift;
return $self->{_length};
}
package Parse::Win32Registry::SecurityDescriptor;
use Carp;
sub new {
my $class = shift;
my $data = shift;
if (!defined $data) {
return;
}
# Unpacks "self-relative" security descriptors
# 0x00 word = revision
# 0x02 word = control flags
# 0x04 dword = offset to owner sid
# 0x08 dword = offset to group sid
# 0x0c dword = offset to sacl
# 0x10 dword = offset to dacl
# Offsets are relative to the start of the security descriptor
# Control Flags:
# SE_OWNER_DEFAULTED 0x0001
# SE_GROUP_DEFAULTED 0x0002
# SE_DACL_PRESENT 0x0004
# SE_DACL_DEFAULTED 0x0008
# SE_SACL_PRESENT 0x0010
# SE_SACL_DEFAULTED 0x0020
# SE_DACL_AUTO_INHERIT_REQ 0x0100
# SE_SACL_AUTO_INHERIT_REQ 0x0200
# SE_DACL_AUTO_INHERITED 0x0400
# SE_SACL_AUTO_INHERITED 0x0800
# SE_DACL_PROTECTED 0x1000
# SE_SACL_PROTECTED 0x2000
# SE_RM_CONTROL_VALID 0x4000
# SE_SELF_RELATIVE 0x8000
if (length($data) < 20) {
return;
}
my ($rev,
$flags,
$offset_to_owner,
$offset_to_group,
$offset_to_sacl,
$offset_to_dacl) = unpack('vvVVVV', $data);
my %sd = ();
my $sd_len = 20;
my $self = {};
if ($offset_to_owner > 0 && $offset_to_owner < length($data)) {
my $owner = Parse::Win32Registry::SID->new(substr($data,
$offset_to_owner));
return if !defined $owner;
$self->{_owner} = $owner;
if ($offset_to_owner + $owner->get_length > $sd_len) {
$sd_len = $offset_to_owner + $owner->get_length;
}
}
if ($offset_to_group > 0 && $offset_to_group < length($data)) {
my $group = Parse::Win32Registry::SID->new(substr($data,
$offset_to_group));
return if !defined $group;
$self->{_group} = $group;
if ($offset_to_group + $group->get_length > $sd_len) {
$sd_len = $offset_to_group + $group->get_length;
}
}
if ($offset_to_sacl > 0 && $offset_to_sacl < length($data)) {
my $sacl = Parse::Win32Registry::ACL->new(substr($data,
$offset_to_sacl));
return if !defined $sacl;
$self->{_sacl} = $sacl;
if ($offset_to_sacl + $sacl->get_length > $sd_len) {
$sd_len = $offset_to_sacl + $sacl->get_length;
}
}
if ($offset_to_dacl > 0 && $offset_to_dacl < length($data)) {
my $dacl = Parse::Win32Registry::ACL->new(substr($data,
$offset_to_dacl));
return if !defined $dacl;
$self->{_dacl} = $dacl;
if ($offset_to_dacl + $dacl->get_length > $sd_len) {
$sd_len = $offset_to_dacl + $dacl->get_length;
}
}
$self->{_length} = $sd_len;
bless $self, $class;
return $self;
}
sub get_owner {
my $self = shift;
return $self->{_owner};
}
sub get_group {
my $self = shift;
return $self->{_group};
}
sub get_sacl {
my $self = shift;
return $self->{_sacl};
}
sub get_dacl {
my $self = shift;
return $self->{_dacl};
}
sub as_string {
croak 'Usage: Security Descriptors do not have an as_string method; use as_stanza instead';
}
sub as_stanza {
my $self = shift;
my $stanza = '';
if (defined(my $owner = $self->{_owner})) {
$stanza .= 'Owner SID: ' . $owner->as_string;
my $name = $owner->get_name;
$stanza .= " [$name]" if defined $name;
$stanza .= "\n";
}
if (defined(my $group = $self->{_group})) {
$stanza .= 'Group SID: ' . $group->as_string;
my $name = $group->get_name;
$stanza .= " [$name]" if defined $name;
$stanza .= "\n";
}
if (defined(my $sacl = $self->{_sacl})) {
foreach my $ace ($sacl->get_list_of_aces) {
$stanza .= 'SACL ACE: ' . $ace->as_string . "\n";
}
}
if (defined(my $dacl = $self->{_dacl})) {
foreach my $ace ($dacl->get_list_of_aces) {
$stanza .= 'DACL ACE: ' . $ace->as_string . "\n";
}
}
return $stanza;
}
sub get_length {
my $self = shift;
return $self->{_length};
}
1;