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

sub warnf {
    my $message = shift;
    warn sprintf "$message\n", @_ if $WARNINGS;
}

sub hexdump {
    my $data = shift; # packed binary data
    my $pos = shift || 0; # starting value for displayed offset

    return "" if !defined($data);

    my $output = "";

    for (my $i = 0; $i < length($data); $i += 16) {
        $output .= sprintf "%8x  ", $i + $pos;

        my $row = substr($data, $i, 16);

        my $row_length = 16;
        $row_length = length($data) - $i if $i + 16 > length($data);
        for (my $j = 0; $j < $row_length; $j++) {
            my $ch = substr($data, $i + $j, 1);
            $output .= sprintf "%02x ", ord $ch;
            if ($j % 4 == 3) { $output .= " "; } # dword gaps
        }
        for (my $j = $row_length; $j < 16; $j++) {
            $output .= "   ";
            if ($j % 4 == 3) { $output .= " "; } # dword gaps
        }

        for (my $j = 0; $j < $row_length; $j++) {
            my $ch = substr($data, $i + $j, 1);

            if (ord $ch >= 32 && ord $ch <= 126) {
                $output .= "$ch";
            } else {
                $output .= ".";
            }
        }

        $output .= "\n"; # end of row
    }
    return $output;
}

sub format_octets {
    my $data = shift; # packed binary data
    my $col = shift || 0; # starting column, e.g. length of initial string

    return "" if !defined($data);

    my @data = unpack("C*", $data);

    my $output = "";

    for (my $i = 0; $i < @data; $i++) {
        if ($col > 76) { # insert line break at column 76
            $output .= "\\\n  ";
            $col = 2;
        }

        $output .= sprintf "%02x", $data[$i];
        $col += 2;

        if ($i < @data - 1) {
            $output .= ",";
            $col++;
        }
    }
    return $output;
}

sub qquote_line {
    my $line = shift;

    return "" if !defined($line);

    my $output = "";
    if (index($line, '"') >= 0) { # line contains " characters
        $line =~ s/([\{\}])/\\$1/g;
        $output .= "qq{$line}"; # quote using qq{}
    }
    else {
        $output .= qq{"$line"}; # quote using ""
    }
    return $output;
}

sub qquote {
    my $data = shift;
    my $octets_per_line = shift || 16;

    return "undef" if !defined($data);
    return q{""} if length($data) == 0;

    my $output = "";

    if ($octets_per_line < 0) { # break at newlines
        # escape special string characters
        $data =~ s/([\\\@\$])/\\$1/g;
        # escape null characters
        $data =~ s/\0(?![0-9])/\\0/g;
        $data =~ s/\0/\\c\@/g;
        # escape newline characters, and add a real newline
        $data =~ s/([\n])/\\n\n/g;
        # escape unicode characters
        $data =~ s/([^\x00-\xff])/sprintf("\\x{%04x}",ord($1))/ge;
        # escape remaining non-ascii characters
        $data =~ s/([^\0\n\x20-\x7e])/sprintf("\\x%02x",ord($1))/ge;
        $output = join(".\n", map { qquote_line($_) } split("\n", $data));
        $output .= "\n";
    }
    else { # break at $octets_per_line
        if (($data =~ tr/\0\n\x20-\x7e//c) > 0) { # binary data
            for (my $i = 0; $i < length($data); $i += $octets_per_line) {
                my $line = substr($data, $i, $octets_per_line);
                $line =~ s/([\x00-\xff])/sprintf("\\x%02x",ord($1))/ge;
                $line =~ s/([^\x00-\xff])/sprintf("\\x{%04x}",ord($1))/ge;
                $output .= qq{"$line"};
                if ($i < (length($data) - $octets_per_line)) {
                    $output .= ".\n"; # period and line break if not last line
                }
            }
            $output .= "\n";
        }
        else { # text data
            $octets_per_line *= 4;
            for (my $i = 0; $i < length($data); $i += $octets_per_line) {
                my $line = substr($data, $i, $octets_per_line);
                # escape special string characters
                $line =~ s/([\\\@\$])/\\$1/g;
                # escape null characters
                $line =~ s/\0(?![0-9])/\\0/g;
                $line =~ s/\0/\\c\@/g;
                # escape newline characters
                $line =~ s/([\n])/\\n/g;
                $output .= qquote_line($line);
                if ($i < (length($data) - $octets_per_line)) {
                    $output .= ".\n"; # period and line break if not last line
                }
            }
            $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 = undef;
    }

    return wantarray ? ($epoch_time, 8) : $epoch_time;
}

sub iso8601 {
    my $time = shift;

    if (!defined $time) {
        return "(undefined)";
    }

    # 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:%02dZ",
        1900+$year, 1+$mon, $mday, $hour, $min, $sec;
}

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, ...\)";
    }

    push my @subkey_iters, make_multiple_subkey_iterator(@keys);
    my $value_iter;
    my $subkeys;

    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;

    croak "Missing iterator subroutine" if ref $self ne 'CODE';

    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",
);

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_ALARM_ACE_TYPE   = 3

    # 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) {
        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
);

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 $string = sprintf "%s 0x%02x 0x%08x %s",
        _look_up_ace_type($self->{_type}),
        $self->{_flags},
        $self->{_mask},
        $self->{_trustee}->as_string;
    return $string;
}

sub get_length {
    my $self = shift;

    return $self->{_length};
}

package Parse::Win32Registry::ACL;

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

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;
        $sd_len += $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;
        $sd_len += $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;
        $sd_len += $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;
        $sd_len += $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_stanza {
    my $self = shift;

    my $stanza = "";
    if (defined(my $owner = $self->{_owner})) {
        $stanza .= "Owner SID: " . $owner->as_string . "\n";
    }
    if (defined(my $group = $self->{_group})) {
        $stanza .= "Group SID: " . $group->as_string . "\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;
