view release on metacpan or  search on metacpan

lib/DBIx/Web.pm  view on Meta::CPAN

 my $d =rfdName(@_[0..2]);
 my $p =rfdPath($_[0],-path=>$d);
 my $e =rfdEdmd(@_[0..2]);
 my $r =$_[2];
 my $w =$_[3];

 if ($e && !-d $p) {
	$_[0]->w32IISdpsn()	if $_[0]->{-w32IISdpsn} && !$_[0]->{-c}->{-RevertToSelf};
	$_[0]->pthMk($p);
 }	

 if (-d $p)	{ $r->{-file} =$d; $r->{-fupd} =$d if $e}
 else		{ delete $r->{-file}; delete $r->{-fupd}}

 if ($r->{-file} && $w) {	# set ACL
	$_[0]->w32IISdpsn()	if $_[0]->{-w32IISdpsn} && !$_[0]->{-c}->{-RevertToSelf};
	my $s =$_[0];
	my $m =$s->{-table}->{ref($_[1]) ? $_[1]->{-table} : $_[1]};
	my $wr=$m->{-racReader} ||$s->{-racReader};
	   $wr=[map {defined($r->{$_}) ? (split /\s*[,;]\s*/i, $r->{$_}) : ()} @$wr] if $wr;
	my $ww=$m->{-racWriter} ||$s->{-racWriter};
	   $ww=[map {defined($r->{$_}) ? (split /\s*[,;]\s*/i, $r->{$_}) : ()} @$ww] if $ww;
	if ($wr ||$ww) {
		my $ld=$^O eq 'MSWin32' && $s->w32domain() || '';
		my @wa=	map {$_ =~s/ /_/g; $_}
			map {$_ =~/^([^\\@]+)([\\@])([^\\@]+)$/ 
				? ($_, $3 .($2 eq '@' ? '\\' : '@') .$1) 
				: $ld
				? ($_, $ld .'\\' .$_, $_ .'@' .$ld)
				: $_}
			(map {!$_ ? () : ref($_) ? @$_ : ($_)
				} $s->{-fswtr}, $s->{-fsrdr}, $ww, $wr);
					# ||getlogin()
		my $wf=$s->hfNew('+>',"$p/.htaccess");
		$wf->store('<Files "*">', "\n"
			,"require user\t"	.join(' ',@wa), "\n"
			,"require group\t"	.join(' ',@wa), "\n"
			,'</Files>',"\n");
		$wf->close();
	}
	if (($wr ||$ww) && $^O eq 'MSWin32' && Win32::IsWinNT()) { # $ENV{OS} && $ENV{OS}=~/Windows_NT/i
		# !!! WMI may be better/faster for all filesystem security
		# MSDN:	WMI Security Descriptor Objects
		#	Win32_LogicalFileSecuritySetting
		#	Win32_LogicalFileSecuritySetting.GetSecurityDescriptor
		#	Win32_LogicalFileSecuritySetting.SetSecurityDescriptor
		#	Win32_SecurityDescriptor
		#	Win32_ACE	# how to create?
		#	Win32_Trustee	# how to create?
		# $wmiobj=Win32::OLE->GetObject("winmgmts:Win32_LogicalFileSecuritySetting.path='$obj'")
		# $out=$wmiobj->ExecMethod_("GetSecurityDescriptor");
		# die if !$out ||$out->{ReturnValue};
		# $out->{Descriptor}->{Owner}->{Domain}
		# 	.'\\' .$out->{Descriptor}->{Owner}->{Name};
		# $dacl=$out->{Descriptor}->{DACL};
		# die if !$dacl;
		# foreach my $k (@$dacl) {
		# $k->{Trustee}->{Domain}
		# $k->{Trustee}->{Name}
		# $k->{AceType}
		#	0 ADS_ACETYPE_ACCESS_ALLOWED
		#		=| $k->{AccessMask}
		#	1 ADS_ACETYPE_ACCESS_DENIED
		# 		=& $k->{AccessMask}
		# %permf=('FULL'=>2032127,'CHANGE'=>1245631,'ADD&READ&EXECUTE'=>1180095,'ADD&READ'=>1180063,'READ&EXECUTE'=>1179817,'READ'=>1179785,'ADD'=>1048854);
		# %permd=('FULL'=>2032127,'CHANGE'=>1245631,'ADD&READ'=>1180095,'READ'=>1179817,'LIST'=>1179785,'ADD'=>1048854);
		# $k->{AccessMask} >=$perm{$k->{AccessMask}}
		# xcacls.vbs
		# objLocator.ConnectServer.Get("Win32_SecurityDescriptor").Spawninstance_
		#
		$p =~s/\//\\/g;
		$s->pthStamp($p);			# access control
		delete $s->{-c}->{-pthStamp};
		if ($e && $ww) {
			foreach my $u (map {m/([^@]+)\@([^@]+)/ ? "$2\\$1" : $_} @$ww) {
				$s->osCmd('-i'
				, $s->{-w32xcacls} ? 'xcacls' : 'cacls'
				, "\"$p\""
				, '/E','/T','/C','/G'
				, ($u =~/\s/ ? "\"$u\"" : $u) .':F'
				, $s->{-w32xcacls} ? '/Y' : ())
			}
			foreach my $u (map {m/([^@]+)\@([^@]+)/ ? "$2\\$1" : $_} $wr ? @$wr : ()) {
				$s->osCmd('-i'
				, $s->{-w32xcacls} ? 'xcacls' : 'cacls'
				, "\"$p\""
				, '/E','/T','/C','/G'
				, ($u =~/\s/ ? "\"$u\"" : $u) .':R'
				, $s->{-w32xcacls} ? '/Y' : ())
			}
		}
		else {
			foreach my $u (map {m/([^@]+)\@([^@]+)/ ? "$2\\$1" : $_
					} map {$_ ? @$_ : ()} $ww, $wr) {
				$s->osCmd('-i'
				, $s->{-w32xcacls} ? 'xcacls' : 'cacls'
				, "\"$p\""
				, '/E','/T','/C','/G'
				, ($u =~/\s/ ? "\"$u\"" : $u) .':R'
				, $s->{-w32xcacls} ? '/Y' : ())
			}
		}
	}
	if ($w && ($w =~/^\d+$/)) {
		my $wa =(stat($p))[8];
		$s->logRec('utime', $s->strtime($wa||$w), $s->strtime($w), $r->{-file});
		utime($wa ||$w, $w, $p);
	}
 }

 $r->{-file}
}


sub rfdCp {	# Copy record's files directory to another record
		# self, source {record} |rfdName, dest {command} |table, {record}
 $_[0]->w32IISdpsn()	if $_[0]->{-w32IISdpsn} && !$_[0]->{-c}->{-RevertToSelf};
 my $fd =ref($_[1]) ? $_[1]->{-file} : $_[1];
    return(0) if !$fd;
 my $fp =rfdPath($_[0],-path=>$fd);
    return(0) if ! -d $fp;
 my $td =rfdName($_[0], @_[2..$#_]);
 my $tp =rfdPath($_[0],-path=>$td);