# ----------------------------------------
# From "Win32 Perl Programming: Administrators Handbook" by Dave Roth
# Published by Macmillan Technical Publishing.
# ISBN # 1-57870-215-1
use vars qw( $VERSION %Data $PATH $USERS );
use Win32;
use Getopt::Long;
use Win32::Lanman;
$VERSION = 20040219;
%PATH = (
max => 45,
filler => ' ... ',
);
Configure( \%Config );
if( $Config{help} )
{
Syntax();
exit();
}
$USERS = ";" . join( ";", @{$Config{users}} ) . ";";
if( ! scalar @{$Config{servers}} )
{
push( @{$Config{servers}}, Win32::NodeName() );
}
foreach my $Server ( sort( @{$Config{servers}} ) )
{
my @FileInfo;
print "Open files on \\\\$Server:\n";
$~ = OUTPUT_HEADER;
write;
$~ = OUTPUT;
$: = "\\-_+";
foreach my $Path ( @$Config{paths} )
{
my( @Info, $User );
if( Win32::Lanman::NetFileEnum( $Server, $Path, $User, \@Info ) )
{
push( @FileInfo, @Info );
}
}
foreach my $File ( @FileInfo )
{
undef %Data;
$Data{path} = $File->{pathname};
$Data{user} = $File->{username};
$Data{locks} = $File->{num_locks};
$Data{id} = $File->{id};
if( scalar @{$Config{users}} )
{
next unless( $USERS =~ /;$Data{user};/i );
}
if( ! $Config{full} )
{
if( $PATH{max} < length( $Data{path} ) )
{
my $PathLength = int( ( $PATH{max} - length( $PATH{filler} ) ) / 2 );
my $FillerLength = length( $PATH{filler} );
( $Data{path} = $File->{pathname} ) =~ s/^(.{$PathLength})(.*?)(.{$PathLength})$/$1$PATH{filler}$3/;
}
}
write;
}
print "\n";
}
sub Configure
{
my( $Config ) = @_;
my $Result;
my %ServerList;
Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
$Result = GetOptions( $Config,
qw(
users|u=s@
full|f
servers|s|m=s@
help|?
) );
$Config->{help} = 1 unless( $Result );
push( @{$Config->{paths}}, @ARGV );
# Filter out any duplicate server names
# and remove any prepended backslashes
foreach my $Server ( @{$Config->{servers}} )
{
$Server =~ s#\\##g;
$ServerList{lc $Server} = 1;
}
if( defined $ServerList{'*'} )
{
my @List;
my $Domain = Win32::DomainName();
if( Win32::Lanman::NetServerEnum( '', $Domain, SV_TYPE_SERVER, \@List ) )
{
map{ $ServerList{lc $_->{name}} = 1 } @List;
}
}
@{$Config->{servers}} = sort( keys( %ServerList ) );
}
sub Syntax
{
my( $Script ) = ( $0 =~ /([^\\\/]*?)$/ );
my( $Line ) = "-" x length( $0 );
print <<EOT;
$0
$Line
Display what files are open on a server.
Version $VERSION
Syntax:
perl $0 [-f] [-u User] [-m Machine] Path [$Path2 [...]]
-u..........Display only files opened by this user.
Use as many -u switches as needed.
-f..........Display full path of each open file.
-m..........Examine this machine.
Specify * for all machines sharing files.
Default is the local machine.
Path........The path to examine local to the specified server.
This can be either a file or a directory path.
Default will be ALL files on the server.
EOT
}
format OUTPUT_HEADER=
@<<<<<< @<<<<< @<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'ID', 'Locks', 'User', 'Path'
------- ------ ------------------ ---------------------------------------------
.
format OUTPUT =
@>>>>>> @>>>>> @<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Data{id}, $Data{locks}, $Data{user}, $Data{path}
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Data{path}
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Data{path}
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Data{path}
.
__END__
History:
20000411 roth
-Created
20040219 roth
-Rewrote the Configure() subroutine.
