#  VPerm.pl
#  Example 3.11:
#  ----------------------------------------
#  From "Win32 Perl Scripting: Administrators Handbook" by Dave Roth
#  Published by New Riders Publishing.
#  ISBN # 1-57870-215-1
#
#  This script displays who has permissions on specified securable objects.
#  The display is broken out into verboseful Win32 permission style information.
#
print "From the book 'Win32 Perl Scripting: The Administrator's Handbook' by Dave Roth\n\n";


use Getopt::Long;
use Win32::Perms;

# Turn off aggressive domain controller lookups
Win32::Perms::LookupDC( 0 );
Configure( \%Config );
if( $Config{help} )
{
    Syntax();
    exit();
}

foreach my $Mask ( @{$Config{masks}} )
{
    my( @List ) = glob( $Mask );
    if( ! scalar @List )
    {
        push( @List, $Mask );
    }
    foreach $Path ( @List )
    {
        print "\nPermissions for '$Path':\n";
        ReportPerms( $Path );
        print "\n\n";
    }
}

sub ReportPerms
{
  my( $Path ) = @_;
  my( $Acct, @List );
  my( $Perm ) = new Win32::Perms( $Path );

  if( ! $Perm )
  {
    print "Can not obtain permissions for '$Path'\n";
    return;
  };

  printf( "  Owner: %s\n  Group: %s\n", $Perm->Owner(), $Perm->Group() );
  $Perm->Dump( \@List );
  $~ = PermissionHeader;
  write;
  foreach $Acct ( @List )
  {
    my( $PermMask );
    my( @String ) = split( //, "-" x scalar( keys( %PERM ) ) );
    my( $Mask, @Permissions, @Friendly );
    local $DaclType;
    local $Access = $Acct->{Access};
    local $Account;

    $~ = Permission;

    next if( $Acct->{Entry} ne "DACL" );
    $iTotal++;

    DecodeMask( $Acct, \@Permissions, \@Friendly );
    DecodeFlag( $Acct, \@Flag );
    # Pad each flag and permission with spaces so that they correctly
    # break into one permission/flag per line when printed. This is a 
    # trick when working with write/formats
    $Flags = join( " " x 10 . "\n", @Flag );
    $Perms = join( " " x 10 . "\n", 
                   ( $Config{friendly} )? @Friendly : @Permissions );
    if( "" eq $Acct->{Account} )
    {
      $Account = $Acct->{SID};
    }
    else
    {
      $Account = "$Acct->{Domain}\\" if( "" ne $Acct->{Domain} );
      $Account .= $Acct->{Account};
    }
    $DaclType = $Acct->{ObjectName};
    if( 2 == $Acct->{ObjectType} )
    {
      # We have either a file or directory. Therefore we need to
      # figure out if this DACL represents an object (file) or
      # a container (dir)...
      if( $Acct->{Flag} & DIR )
      {
        $DaclType = "Directory";
      }
      else
      {
        $DaclType = "File";
      }
    }
    write;
    print "\n";
  }

  if( ! $iTotal )
  {
    print "\t Everyone has full permissions.\n";
  }
}

sub Configure
{
  my( $Config ) = @_;
  my $Result;

  Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
  $Result = GetOptions( $Config, 
                        qw(
                          friendly|f
                          help|?|h
                        )
  );
  push( @{$Config->{masks}}, @ARGV );
  $Config->{help} = 1 unless( $Result &&  scalar @{$Config->{masks}} );
}

sub Syntax
{
  my( $Script ) = ( $0 =~ /([^\\\/]*?)$/ );
  my( $Line ) = "-" x length( $Script );

  print <<EOT;

$Script
$Line
Displays verbose permissions set on securable objects.

Syntax:
    perl $Script [-f] Path [ Path2 ... ]
        -f..........Show "friendly" permissions.
        Path........The path to a securable object.
                    This path can consist of ? and * wildcards.

EOT
}

format PermissionHeader =
@||||||||||||||||||||||||| @||||||||||||||||||||| @||||||||||||||||||||||
"Account",                 "Permissions",         "Flags"
-------------------------- ---------------------- -----------------------
.

format Permission =
^<<<<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<
$Account,                  $Perms,                $Flags
^<<<<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<
$Account,                  $Perms,                $Flags
@<<<<<<<<<<<<<<            ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<
"$Access Access",          $Perms,                $Flags
@<<<<<<<<<<<<<<            ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<
"($DaclType)",             $Perms,                $Flags
~                          ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<
                           $Perms,                $Flags
~                          ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<
                           $Perms,                $Flags
~                          ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<
                           $Perms,                $Flags
~                          ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<
                           $Perms,                $Flags
~                          ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<
                           $Perms,                $Flags
~                          ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<
                           $Perms,                $Flags
~                          ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<
                           $Perms,                $Flags
~                          ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<
                           $Perms,                $Flags
.