#  DCOM.pl
#  Example 3.13:
#  ----------------------------------------
#  From "Win32 Perl Scripting: Administrators Handbook" by Dave Roth
#  Published by New Riders Publishing.
#  ISBN # 1-57870-215-1
#
#  This script displays DCOM configurations.
#
print "From the book 'Win32 Perl Scripting: The Administrator's Handbook' by Dave Roth\n\n";


use Win32::Registry;
use Win32::Perms;

# Prevent aggressive domain controller lookups
Win32::Perms::LookupDC( 0 );
%PATH = (
    ole     =>  'SOFTWARE\Microsoft\Ole',
    rpc     =>  'SOFTWARE\Microsoft\RPC',
);

$Perm = new Win32::Perms() || die "Cannot create Permissions object";
if( scalar @ARGV )
{
    $Machine = "\\\\" . shift @ARGV;
}
else
{
    $Machine = "\\\\" . Win32::NodeName();
}
$Machine =~ s/^\\+/\\\\/;
$HKEY_LOCAL_MACHINE->Connect( $Machine, $Root ) 
    || die "Can not connect";
print "\nDCOM settings for $Machine:\n";
if( $Root->Open( $PATH{ole}, $Key ) )
{
  my( $Flag, $Type, $Value, $Sd );

  undef $Value;
  $Key->QueryValueEx( "EnableDCOM", $Type, $Value );
  print "  DCOM is ", ( "y" eq lc $Value )? "":"not ", "enabled.\n";
  
  $Key->QueryValueEx( "EnableDCOMHTTP", $Type, $Value );
  print "  COM Internet Services are ", 
        ( "y" eq lc $Value )? "":"not ", "enabled.\n";

  print "\n  The following accounts are allowed to "
        . "launch COM applications:\n";
  if( $Key->QueryValueEx( "DefaultLaunchPermission", $Type, $Sd ) )
  {
    DisplayPerms( $Sd ) if( REG_BINARY == $Type );
  }

  print "\n  Accounts with access to this machine via DCOM:\n";
  if( $Key->QueryValueEx( "DefaultAccessPermission", $Type, $Sd ) )
  {
    DisplayPerms( $Sd ) if( REG_BINARY == $Type );
  }

  print "\n  Accounts with access to COM/OLE configuration:\n";
  DisplayPerms( "$Machine\\HKEY_CLASSES_ROOT" );

  print "\n  The following protocols are permitted "
        . "for use with DCOM:\n";
  if( $Root->Open( $PATH{rpc}, $Key2 ) )
  {
    my $MString;
    if( $Key2->QueryValueEx( "DCOM Protocols", $Type, $MString ) )
    {
      foreach my $Protocol ( split( "\x00", $MString ) )
      {
        print "    $Protocol\n";
      }
    }
    $Key2->Close();
  }
  $Key->Close();
}
$Root->Close();

sub DisplayPerms
{
  my( $Sd ) = @_;
  my @List;

  $Perm->Import( $Sd );
  $Perm->Dump( \@List );

  foreach my $Ace ( @List )
  {
    my $Account;
    if( "" ne $Ace->{Account} )
    {
      $Account = "$Ace->{Domain}\\" if( "" ne $Ace->{Domain} );
      $Account .= $Ace->{Account};
    }
    else
    {
      $Account = $Ace->{SID};
    }

    # Object Type of 1 represents a DACL
    next if( 1 != $Ace->{ObjectType} );

    printf( "    %-6s %-30s\n", $Ace->{Access}, $Account );
  }
  return;
}