blackadder has asked for the wisdom of the Perl Monks concerning the following question:

I am really stuck now so Please (SOS)

I have a perl/Tk based form where on the left it displayed a directory tree structure of a given drive, and on the right there will be a top box where a snap shot of the permission status of the object (directory or drive) will be displayed. Underneath will be a box that only the users filtered from the top box will be displayed. And at the bottom box there will be a display of all Local groups available on the machine housing the drive. The idea is to move all users that permission to access directory into a group, the way to do this is to get an instant picture of permission on directory level of a given object (only drives or directories) so that if there are any users that have access to a directory will be moved to a group and that group will be granted full access to the that specific area in the drive or directory. A Saint (.dave.) that was sent by God, has help me immensely, in getting started, however I am completely lost now and out sorts. I have tried numerous ways in getting this script to be what I wan but to no avail (me3aning that I have been doing my homework - Honestly). Below is the list of Bugs (problems) encountered and the code. I really need some help here please.

List of bugs in my script
1- Permissions box (top right): I have 2 problems with it; first is: entries into this box should be displayed as such: a user Icon if it was a user account and group Icon if it was a groups, and on the same line I should have the account name and type of access granted. However, the script will always use a user icon to display users and groups and the access type is displayed on a separate line rather than on the same line which is a bit confusing. The second problem is that, if a local group was to be displayed in this box then the group name is always blank, I am really not sure why is this happening?.

2- Users list box (middle right), the way I obtain the users group is as this: first I get the permissions on the object directory “example: $perms-> Get (\ @list). Then for each item in this array I check if it’s a user by using Win32::AdminMisc::UsersExist(‘’, $item), if the item exists as a user then I push it into an array (I called it @found) and return this array so that its items are displayed in this box. I have tested this bit as a seperate script and it works however when I encorporate it into the script I do not get any display?

3- The groups list box (bottom right), I should be able to drag a group and drop it on top a Directory (or the drive) and this will grant this group a full access to this object. I can do this bit – (I have written a script that enables me to remove or grant a user or a group access permission to that object recursively), however I am not sure on how to incorporate this into this script?.

4- Directory refresh: if no parameters entered on the command line then the script will pick the local “C:\” drive by default. However, if I change to another drive “say drive D:\ which is a remote drive mapped to a remote server” then the dir list does not refresh, and it shows the “C:\” as a sub folder of which ever drive that been chosen. Obviously this is not correct, and I need to ensure that the Dir Tree only displays what ever drive were entered in the entry box.

ps: apologies about my last posting - I didn't proof read it before posting it.
use Win32::perms; use Win32::AdminMisc; use Win32::NetAdmin; use Win32::NetResource; use strict; use Tk 800.005; use Tk::TList; use Tk::DirTree; use Tk::Frame; use Tk::Scrollbar; use Tk::Adjuster; # These are required for drag-n-drop operations use Tk::DragDrop; use Tk::DropSite; use File::Find; use Win32::Perms; # $tk{widget_refs}, $dr{data_refs}, $im{image_refs} use vars qw/%tk %dr %im @users @list @groups $dnd_token $dnd_token2/; $dr{PATH} = shift @ARGV || "C:/"; $dr{perms} = "Permissions: ".$dr{PATH}; $tk{mw} = MainWindow->new(-background => 'white'); $tk{mw}->geometry('500x400'); $tk{top_frame} = $tk{mw}->Frame; $tk{left_frame} = $tk{mw}->Frame; $tk{adjuster} = $tk{mw}->Adjuster(-widget=> $tk{left_frame}, -side= +>'left'); $tk{right_frame} = $tk{mw}->Frame; $tk{entry_box} = $tk{top_frame}->Entry(-textvariable=>\$dr{PATH}); $tk{dir_tree} = $tk{left_frame}->Scrolled('DirTree', -height=>'0', -width=>'0', -scrollbars=>'e', ); $tk{output_list} = $tk{right_frame}->Scrolled('TList', -height=>'1', -width=>'1', -scrollbars=>'osoe',); $tk{user_list} = $tk{right_frame}->Scrolled('TList', -height=>'1', -width=>'1', -scrollbars=>'osoe',); $tk{group_list} = $tk{right_frame}->Scrolled('TList', -height=>'1', -width=>'1', -scrollbars=>'osoe',); $tk{user_label} = $tk{right_frame}->Label(-text => "User List:"); $tk{group_label} = $tk{right_frame}->Label(-text => "Group List:"); $tk{output_label} = $tk{right_frame}->Label(-textvariable => \$dr{perm +s}); $im{ONE} = $tk{mw}->Photo(-file => 'one.gif'); $im{GROUP} = $tk{mw}->Photo(-file => 'group.gif'); $tk{dir_tree}->chdir( $dr{PATH} ); $tk{dir_tree}->bind('<ButtonRelease-1>',sub {get_perms();}); $tk{entry_box}->bind('<Key-Return>',sub {OnNewPath();}); $tk{top_frame}->pack(qw/-side top -fill x/); $tk{left_frame}->pack(qw/-side left -fill y/); $tk{adjuster}->pack(qw/-side left -fill y/); $tk{right_frame}->pack(qw/-side right -fill both -expand 1/); $tk{entry_box} ->pack(qw/-side top -fill both -expand 1/); $tk{dir_tree} ->pack(qw/-side left -fill both -expand 1/); $tk{output_label}->pack(qw/-side top -fill both/); $tk{output_list} ->pack(qw/-side top -fill both -expand 1/); $tk{user_label} ->pack(qw/-side top -fill both/); $tk{user_list} ->pack(qw/-side top -fill both -expand 1/); $tk{group_label} ->pack(qw/-side top -fill both/); $tk{group_list} ->pack(qw/-side top -fill both -expand 1/); # Define the source for drags. # Drags are started while pressing the left mouse button and moving th +e # mouse. Then the StartDrag callback is executed. # # The DragDrop method returns a "token", which is a Label widget for # the text or image displayed during the drag action. # This to drag a group icon from the group list to drop on the DirTree + box. $dnd_token2 = $tk{group_list}->DragDrop (-event =>'<B1-Motion>', -sitetypes => [qw/Local/], -startcommand=> \&DragStart, ); # Define the target for groups to drop in. $tk{dir_tree}->DropSite (-droptypes => [qw/Local/], -dropcommand => [\&Drop, $tk{dir_tree}, $dnd_token2 ], ); # This to drag a user from the user list and drop on the groups icon $dnd_token = $tk{user_list}->DragDrop (-event => '<B1-Motion>', -sitetypes => [qw/Local/], -startcommand => \&DragStart, ); # Define the target for users to drop in. $tk{group_list}->DropSite (-droptypes => [qw/Local/], -dropcommand => [\&Drop, $tk{group_list}, $dnd_token ], ); # Add the users to the user list and the groups to the group list @users = GetUsers(); map { $tk{user_list}->insert('end', -itemtype=>'imagetext', -text=>"$_", -image=>$im{ONE}) } @users; @groups = GetGroups(); map { $tk{group_list}->insert('end', -itemtype=>'imagetext', -text=>"$_", -image=>$im{GROUP}) } @groups; MainLoop; exit 0; sub DragStart { my($token) = @_; my $w = $token->parent; # $w is the source listbox my $e = $w->XEvent; my $idx = $w->GetNearest($e->x, $e->y); # get the listbox entry un +der cursor if (defined $idx) { # Configure the dnd token to show the listbox entry $token->configure(-text => $w->entrycget($idx, '-text') ); # Show the token my($X, $Y) = ($e->X, $e->Y); $token->MoveToplevelWindow($X, $Y); $token->raise; $token->deiconify; $token->FindSite($X, $Y, $e); } } # Accept a drop and insert a new item in the destination sub Drop { my($lb, $dnd_source) = @_; my $user_item = $dnd_source->cget('-text'); # figure out where in the group listbox the drop occurred my $y = $lb->pointery - $lb->rooty; my $x = $lb->pointerx - $lb->rootx; my $nearest = $lb->nearest($x,$y); if (defined $nearest) { my $group_item = $lb->entrycget($nearest, '-text'); &AddUserToGroup($user_item, $group_item); $lb->see($nearest); } } sub get_perms { my $path = $tk{dir_tree}->selectionGet(); &ShowPathInfo($path); } # This method is bound to the 'enter' key so that we can update # the path information from the entry widget. sub OnNewPath { $tk{dir_tree}->chdir( $dr{PATH} ); &ShowPathInfo( $dr{PATH} ); } sub ShowPathInfo { my ($path) = @_; my $perms = new Win32::Perms($path) || die "\n$^E\n"; print "Path: " . $perms->Path(); my $counter = $perms->Get(\ @list); $dr{perms} = "Permisssions: $path"; $tk{output_list}->delete('0.1','end'); $tk{output_list}->insert('end', -itemtype=>'text', -text=>"$path"); foreach my $item (@list) { while (@_ = each %$item) { next unless $_[0] =~ /account|access/i; $tk{output_list}->insert('end', -itemtype=>'imagetext', -text=> $_[0].":". $_[1], -image=>$im{ONE}); } } } # I do not get the correct returned data here - a refernce to and arra +y of hashes is returned sub GetUsers { my $data; my $field; my @found foreach my $item (@list) { while (my ($field, $data) = each %{$item}) { next if $field !~ /account/i; if (Win32::NetAdmin::UsersExist('',$data)) { print "This '$data' is a user account\n"; push (@found, $data); } } } return @found; #[qw/One Two Three/]; } sub GetGroups { my ($srv); print "\nAnalysing $dr{PATH}\n"; # # Check $dr{PATH} before getting local group information, # if (Win32::NetResource::GetUNCName(my $unc, $dr{PATH})) { $unc =~ s/^\\\\(\w)+//; $srv = $&; print "\n Path is $dr{PATH} and server is: $srv\n"; } else { $srv = Win32::NodeName(); print "\nPath is $dr{PATH} and server is: $srv\n"; } if (Win32::AdminMisc::GetGroups("$srv", GROUP_TYPE_LOCAL, \ @group +s)) { print "\n\nThis is the list of groups\n"; foreach my $item (@groups) { print "$item\n"; } } return @groups; #[qw/RED BLUE GREEN/]; } sub AddUserToGroup { my ($user, $group) = @_; # # Do something with $user_item and with $group_item #I wil remove the user's ACL permission from the target drive and +add them to the grop they drop in $dr{perms} = "User $user added to $group"; } sub AddGroupsToDir { my ($group, $path); # # # here I will add the groupe acceess permission (always as full ac +cess) to the selected dir. # # $dr{perms} = "Groupe $group are permissioned to access $path"; }
Many Thanks in advance
Tim <:-(

2002-07-26 Edit by Corion: Added readmore tag

Replies are listed 'Best First'.
Re: Perl/Tk + Perms problems.
by blackadder (Hermit) on Jul 26, 2002 at 12:41 UTC
    Have I been deserted and abandoned? Or just impatient! Well in any case I don't blame you.