#  DumpShares.pl
#  Example 4.1:
#  ----------------------------------------
#  From "Win32 Perl Scripting: Administrators Handbook" by Dave Roth
#  Published by New Riders Publishing.
#  ISBN # 1-57870-215-1
#
#  This script makes a backup of all shared directories. This is
#  done by creating a configuration file that details each share.
#  Example_4_2.pl uses this resulting configuration file to recreate
#  the shares.
#
print "From the book 'Win32 Perl Scripting: The Administrator's Handbook' by Dave Roth\n\n";


use Win32::Lanman;
use Win32::Perms;

$DELIMITER = ";";

# Create a hash to get the name of the share type based on the type value
%SHARE_TYPE = (
    eval( STYPE_DEVICE )    =>  'STYPE_DEVICE',
    eval( STYPE_PRINTQ )    =>  'STYPE_PRINTQ',
    eval( STYPE_DISKTREE )  =>  'STYPE_DISKTREE',
    eval( STYPE_IPC )       =>  'STYPE_IPC',
    eval( STYPE_SPECIAL )   =>  'STYPE_SPECIAL',
);

%PERM_SHARE_TYPE = (
    eval( STYPE_PRINTQ )    =>  5,  # Shared Printers
    eval( STYPE_DISKTREE )  =>  4,  # Shared Directories
);

# Default to the local machine
$Machine = Win32::NodeName() unless( $Machine = shift @ARGV );
# Fix any double backslashes on the machine name
( $Machine = "\\\\$Machine" ) =~ s/^\\{2,}/\\\\/;
# We don't want to use rigorous domain controler lookups
Win32::Perms::LookupDC( 0 );
$Perm = new Win32::Perms() || die "Can not create an empty Perm object\n";

if( Win32::Lanman::NetShareEnum( $Machine, \@ShareList ) )
{
    foreach my $Share ( @ShareList )
    {
        my( $Perm, @Acl );
        my $ObjectType = $PERM_SHARE_TYPE{$Share->{type}};
        print "[$Share->{netname}]\n";
        $Share->{type} = ComputeType( $Share->{type} );
        foreach my $Attribute ( sort( keys( %$Share ) ) )
        {
            if( "security_descriptor" eq $Attribute )
            {
                DumpSD( $Share->{$Attribute}, $ObjectType );
            }
            else
            {
                print "$Attribute=$Share->{$Attribute}\n";
            }
        }
    print "\n";
    }
}

sub ComputeType
{
    my( $Type ) = @_;
    my( @List );

    push( @List, $SHARE_TYPE{ &STYPE_SPECIAL } ) if( $Type & &STYPE_SPECIAL );
    $Type &= ~ &STYPE_SPECIAL;
    push( @List, $SHARE_TYPE{$Type} );
    return( join( "|",  @List ) );
}

sub DumpSD
{
    my( $SD, $ObjectType ) = @_;
    $Perm->Remove( -1 );
    $Perm->Import( $SD );
    $Perm->Dump( \@Acl );
    foreach my $Ace ( @Acl )
    {
        my $Account = $Ace->{Account};
        my( @MaskPerms, @FriendlyPerms, @Flags, @Types );

        $Account = $Ace->{Domain} . "\\" . $Account if( "" ne $Ace->{Domain} );

        # Neither Owner nor Group are applicable on shares
        next if( "Owner" eq $Ace->{Entry} || "Group" eq $Ace->{Entry} );

        # Set the Ace to be of type "Share". Since we imported the
        # security descriptor there is no way for Win32::Perms to know that
        # it was for a share.
        $Ace->{ObjectType} = $ObjectType;
        Win32::Perms::DecodeMask( $Ace, \@MaskPerms, \@FriendlyPerms );
        Win32::Perms::DecodeType( $Ace->{Type}, \@Types );
        Win32::Perms::DecodeFlag( $Ace->{Flag}, \@Flags );
        print "Perm=$Account", $DELIMITER;
        print join( "|", @Types ), $DELIMITER;
        print join( "|", @Flags ), $DELIMITER;
        print join( "|", @MaskPerms ), "\n";
    }
}

# For some reason Win32::Lanman forgot to export this constant
sub STYPE_SPECIAL
{
    return( 0x80000000 );
}