Во многих компаниях принято помимо личных папок пользователей заводить т.н. «обменники» или «exchange».
С правами доступа «всем можно просмотреть содержимое папок, положить новый файл, но открывать документы нельзя».
Реализуется это заданием соответствующих прав для корневой папки, и полного доступа для владельца.
Данный скрипт проверяет AD, и если появился новый пользователь создает для него папку и выставляет права, а если пользователь удален, то перемещает его папку во временное хранилище для удаленных.


Предполагается, что в AD корректно заполнены поля «Фамилия» и «Инициалы»(Иванов АА).

Для работы требуется Xcacls.

Также необходим Perl модуль ISG::Win32::ActiveDirectory, брать тут.
После его установки модуль будет приблизительно по такому пути: «C:\Perl\lib\ISG\Win32\ActiveDirectory.pm».
В конец этого файла надо добавить следующий код:

sub AD_enumerate_dn_sn_initials ($) {
    my $dn = shift;
    my $type = 'user';
    $dn =~ s|^(LDAP://)?|LDAP://|;
    disable_ole_warnings;
    my $ou_hand = Win32::OLE->GetObject("$dn");
    enable_ole_warnings;
    if (not $ou_hand) {
	carp "WARNING: ".Win32::OLE::LastError."\n";
	return undef;
    }
    my %list;
    foreach  my $hand ( in $ou_hand ){
        next unless $hand->{Class} eq $type; #simpler than filter
my $sa = $hand->{SAMAccountname}; 
my $sn = $hand->{sn}; 
my $initials = $hand->{initials}; 
$list{$sa} =  "$sn $initials";
    };
    return %list;
}

Это мы добавили процедуру возвращающую имена в нужном нам формате «Иванов АА».
Криво, конечно, можно было и самому модуль сделать, а можно и прямо в код запихнуть... Но лень 🙂

#!/usr/bin/perl
 
###################################################################
#Name:		create_exchg.pl
#Version:	0.9.0
#Created:	Andrey Orlov
#Email:		tangarus(a)gmail.com
#Web:		http://www.tangarus.ru/
#Date:		10.2009
#Description:Создание и синхронизация личных папок пользователей
####################################################################
 
use ISG::Win32::ActiveDirectory qw(AD_enumerate_dn_sn_initials);
 
#Имя домена
my $domain = 'MYDOMAIN';
#Основной каталог
my $base_dir = 'D:\\eXchange\\Алфавитный список\\';
#Каталог для удалённых пользователей
my $del_dir = 'D:\\Deleted users\\';
#Пользователи которых не обрабатываем
my %skip_users = (
"testuser" => 'testuser',
"Techline" => 'Techline',
);
 
#OU из которых нужно брать пользователей			   
my %list_sub_1 = AD_enumerate_dn_sn_initials "LDAP://OU=Admins,OU=Users,DC=mydomain";
my %list_sub_2 = AD_enumerate_dn_sn_initials "LDAP://OU=GR1,OU=Users,DC=mydomain";
my %list_sub_3 = AD_enumerate_dn_sn_initials "LDAP://OU=GR2,OU=Users,DC=mydomain";
my %list = (%list_sub_1, %list_sub_2, %list_sub_3);
 
foreach $key (sort keys %list) {
	unless ( exists $skip_users{$key} ) {	$active_users{$list{$key}} = 1; };
 
	my $user = $list{$key};
	my $home = $base_dir.$user;
	if(-e $home){
#Выставляем права для существующих папок
#Надо только один раз, и выполняется долго, поэтому закоментировано
#		system("c:\\windows\\system32\\cscript c:\\windows\\xcacls.vbs \"$home\" /I ENABLE /SPEC E /G $domain\\$key:F"); 
#		system("c:\\windows\\system32\\cscript c:\\windows\\xcacls.vbs \"$home\" /I ENABLE /SPEC A /G $domain\\$key:1 /E"); 		
	}else{	
		unless ( exists $skip_users{$key} ) {
#Создаем папку и выставляем права		
			mkdir $home;
			system("c:\\windows\\system32\\cscript c:\\windows\\xcacls.vbs \"$home\" /I ENABLE /SPEC E /G $domain\\$key:F"); 
			system("c:\\windows\\system32\\cscript c:\\windows\\xcacls.vbs \"$home\" /I ENABLE /SPEC A /G $domain\\$key:1 /E"); 					
		};
	};
};
 
#Чистим от удаленных
opendir BASEDIR, $base_dir;
@contents = grep !/^\.\.?$/, readdir BASEDIR;
closedir BASEDIR;
foreach $listitem ( @contents )
{
	if (-d $base_dir.$listitem ){
		 unless ( exists $active_users{$listitem} ) {
		 	unless ( exists $skip_users{$listitem} ) {
			 	print "Try to move $listitem to deleted.";
			 	system("move /Y \"$base_dir$listitem\" \"$del_dir$listitem\"");
		 	};
		 };
	};
};
print "Exiting...";
exit;