#  Members.pm
#  Module that maganges group memberships
#  Chapter 5
#  ----------------------------------------
#  From "Win32 Perl Scripting: Administrators Handbook" by Dave Roth
#  Published by New Riders Publishing.
#  ISBN # 1-57870-215-1
#
print "From the book 'Win32 Perl Scripting: The Administrator's Handbook' by Dave Roth\n\n";

package Win32::Members;

use Win32::NetAdmin;
use Win32::API;

$VERSION = 1.0;

$PROCESS_QUERY_INFORMATION = 0x0400;
$TOKEN_QUERY = 0x0008;
$iTemp = 1;
$iResult = 1;
%TOKEN = (
    user            =>  $iTemp++,
    groups          =>  $iTemp++,
    privileges      =>  $iTemp++,
    owner           =>  $iTemp++,
    primarygroup    =>  $iTemp++,
    defaultacl      =>  $iTemp++,
    source          =>  $iTemp++,
    type            =>  $iTemp++,
    impersonationlevel  =>  $iTemp++,
    statistics      =>  $iTemp++,
    restrictedsids  =>  $iTemp++,
);

%TYPE = (
  $Win32::NetAdmin::SidTypeUser             =>  'user',
  $Win32::NetAdmin::SidTypeGroup            =>  'global group',
  $Win32::NetAdmin::SidTypeDomain           =>  'domain',
  $Win32::NetAdmin::SidTypeAlias            =>  'local group',
  $Win32::NetAdmin::SidTypeWellKnownGroup   =>  'system group',
  $Win32::NetAdmin::SidTypeDeletedAccount   =>  'deleted account',
  $Win32::NetAdmin::SidTypeInvalid          =>  'invalid or corrupt account',
  $Win32::NetAdmin::SidTypeUnknown          =>  'unknown type of account',
);

$iResult = 0 unless( $OpenProcess = new Win32::API( "kernel32.dll", "OpenProcess", [I,I,N], N ) );
$iResult = 0 unless( $GetCurrentProcess = new Win32::API( "kernel32.dll", "GetCurrentProcess", [], N ) );
$iResult = 0 unless( $GetCurrentProcessId = new Win32::API( "kernel32.dll", "GetCurrentProcessId", [], N ) );
$iResult = 0 unless( $OpenProcessToken = new Win32::API( "advapi32.dll", "OpenProcessToken", [N,N,P], I ) );
$iResult = 0 unless( $GetTokenInformation = new Win32::API( "advapi32.dll", "GetTokenInformation", [N,I,P,N,P], I ) );
$iResult = 0 unless( $LookupSid = new Win32::API( "advapi32.dll", "LookupAccountSid", [P,N,P,P,P,P,P], I ) );
$iResult = 0 unless( $CloseHandle = new Win32::API( "kernel32.dll", "CloseHandle", [N], I ) );

sub Get
{
    my $Pid;
    my @Groups;
    my $hProcess;
    if( scalar @_ )
    {
        $Pid = shift @_;
    }
    else
    {
        $Pid = $GetCurrentProcessId->Call();
    }
    $hProcess = $OpenProcess->Call( $PROCESS_QUERY_INFORMATION, 0, $Pid );
    if( $hProcess )
    {
        my $pHandle = pack( "L", 0 );
        if( $OpenProcessToken->Call( $hProcess, $TOKEN_QUERY, $pHandle ) )
        {
            my $hToken = unpack( "L", $pHandle );
            my $pdwBuffer = pack( "L", 0 );
            my $pBuffer;
            my $dwSize;

            # First we need to determine how big of a buffer we need...
            $GetTokenInformation->Call( $hToken, $TOKEN{groups}, 0, 0, $pdwBuffer );
            $dwSize = unpack( "L", $pdwBuffer );

            $pBuffer = "\x00" x $dwSize;
            if( $GetTokenInformation->Call( $hToken, $TOKEN{groups}, $pBuffer, $dwSize, $pdwBuffer ) )
            {
                my( $GroupCount, $Data ) = unpack( "La*", $pBuffer );
                my @Sids;

                do
                {
                    my( $pSid, $dwAttributes );
                    ( $pSid, $dwAttributes, $Data ) = unpack( "LLa*", $Data );
                    push( @Sids, $pSid );
                } while( --$GroupCount && ( 0 < length( $Data ) ) );

                foreach my $pSid ( reverse( @Sids ) )
                {
                    my( $StringSize ) = 512;
                    my( $szGroup, $szDomain ) = ( "\x00" x $StringSize, "\x00" x $StringSize );
                    my( $szMachine ) = Win32::NodeName() . "\x00" x 4;
                    my( $sSidType ) = pack( "s", 0 );
                    my( $dwNameSize, $dwDomainSize ) = ( pack( "L", $StringSize ), pack( "L", $StringSize ) );

                    if( $LookupSid->Call( $szMachine, $pSid, $szGroup, $dwNameSize, $szDomain, $dwDomainSize, $sSidType ) )
                    {
                        TrimString( \$szDomain );
                        TrimString( \$szGroup );
                        $SidType = unpack( "s", $sSidType );
                        push( @Groups, { 'domain' => $szDomain, 'group' => $szGroup, 'type' => $SidType } );
                    }
                }
                $CloseHandle->Call( $hToken );
            }
            $CloseHandle->Call( $hToken );
        }
        $CloseHandle->Call( $hProcess );
    }
    return( @Groups );
}

sub TrimString
{
    my( $StringRef ) = @_;

    $$StringRef =~ s/\x00//g;
}

# Always return a TRUE value otherwise the loading of this module
# reports an error...
#
print "From the book 'Win32 Perl Scripting: The Administrator's Handbook' by Dave Roth\n\n";

return( $iResult );