view release on metacpan or  search on metacpan

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

			$mo->{ugfile} =sub{ugfile($_[0],$call,$fs,'q',@arg)};
		}
		return(1)
	}
 }
 elsif ($mo eq 'q') {					# queued mode
	if (ref($s)			# reverted reject
	&&  $s->{-w32IISdpsn} && ($s->{-w32IISdpsn} <2)
	&&  $s->{-c}->{-RevertToSelf}) {
		return(0)
	}
	elsif (1) {			# inline
	}
	elsif (eval("use Thread; 1")	# threads
	&& ($mo =eval{Thread->new(sub{ugfile($call=~/^(?:ugf_ldap)$/ ? $s : undef
					, $call, $fs, 't', @arg)})})
		) {
		$s->logRec('ugfile','thread',$mo);
		$mo->detach;
		return(1);
	}
	elsif ($mo =fork) {		# fork parent success
		$SIG{CHLD} ='IGNORE';
		$s->logRec('ugfile','fork',$mo);
		return(1);
	}
	elsif (!defined($mo)) {		# fork error, immediate interactive
	}
	else {				# fork child
		$mo ='f';
		ugfile($call=~/^(?:ugf_ldap)$/ ? $s : undef
			, $call, $fs, $mo, @arg);
		exit(0);
	}
 }
 my @tm=(time());
 local(*FG, *FL, *FW);
 open(FG, "+>>$fg.tmp")
	|| ($s && &{$s->{-die}}($s->lng(0, 'ugfile') .": open('$fg.tmp') -> $!" .$s->{-ermd}))
	|| croak("open('<$fg.tmp') -> $!");
 open(FL, "+>>$fl.tmp")
	|| ($s && &{$s->{-die}}($s->lng(0, 'ugfile') .": open('$fl.tmp') -> $!" .$s->{-ermd}))
	|| croak("open('<$fl.tmp') -> $!");
 while (!flock(FG,LOCK_EX|LOCK_NB) ||!flock(FL,LOCK_EX|LOCK_NB)) {
	next if !-f $fg;
	flock(FG,LOCK_UN); close(FG);
	flock(FL,LOCK_UN); close(FL);
	return(1)
 }
 truncate(FG,0); truncate(FL,0);
 seek(FG,0,0); seek(FL,0,0);

 if	($call eq 'ugf_w32')	{ugf_w32 ($s, \*FG, \*FL, \@tm, @arg)}
 elsif	($call eq 'ugf_w32ldap'){ugf_w32ldap($s, \*FG, \*FL, \@tm, @arg)}
 elsif	($call eq 'ugf_ldap')	{ugf_ldap($s, \*FG, \*FL, \@tm, @arg)}
 # my ($s, $tm, $df);
 # local (*FG, *FL);
 # ($s, *FG, *FL, $tm, @arg) =@_;
 # ualist/ugf_w32, used in uglist(), ":\t" delimited:
 # domain?\user : user@domain : ADsPath : 'User' : FullName : email : Description
 # domain?\group: group@domain: ADsPath : 'Group': 	    : email : Description : members
 # uagroup/ugf_w32, used in uglist(), "\t" delimited:
 # ?group : members		#  ?name	domain\name	name@domain
 # domain\group : members
 # group@domain : members
 #
 # ugf_w32, used in uglist():
 # standalone host:	local users, local groups
 # domain member:	domain users, local member groups, domain groups
 # domain controller:	domain users, local domain groups, domain groups
 # local member groups unqualified always (using simple 'fullname' without '@')
 # local controller groups unqualified usually

 seek(FG,0,0); seek(FL,0,0);
 open(FW, "+>>$fg") && flock(FW,LOCK_EX)
 	&& truncate(FW,0) && seek(FW,0,0)
	&& (do {while(my $rr =readline *FG){print FW $rr}; 1})
	&& flock(FW,LOCK_UN) && close(FW)
	|| ($s && $s->die($s->lng(0, 'ugfile') .": open('$fg') -> $!"))
	|| croak("open('<$fg') -> $!");
 flock(FG,LOCK_UN); close(FG); unlink("$fg.tmp");
 open(FW, "+>>$fl") && flock(FW,LOCK_EX) 
 	&& truncate(FW,0) && seek(FW,0,0)
	&& (do {while(my $rr =readline *FL){print FW $rr}; 1})
	&& flock(FW,LOCK_UN) && close(FW)
	|| ($s && $s->die($s->lng(0, 'ugfile') .": open('$fl') -> $!"))
	|| croak("open('<$fl') -> $!");
 flock(FL,LOCK_UN); close(FL); unlink("$fl.tmp");
 push @tm, time();
 $s->logRec('ugfile','timing',join('-', map {$tm[$_] -$tm[$_-1]} (1..$#tm)),'sec')
	if $s;
 1;
}


sub ugf_w32 {	# ugfile() module using Win32 ADSI WinNT://
 my ($s, $FG, $FL, $tm, $df) =@_;
 eval('use Win32::OLE'); Win32::OLE->Option('Warn'=>0);
 eval('use Win32::OLE::Enum');
 my $od =Win32::OLE->GetObject('WinNT://' .(Win32::NodeName()) .',computer');
 my $hdu=$od	&& $od->{Name}		|| ''; 		# host domain name
 my $hdn=$od	&& lc($od->{Name})	|| ''; 		# host domain name
 my $hdp=$od	&& $od->{ADsPath}	|| '';		# host domain path
 my $hdc=lc($hdp);					# host domain comparable
 my $ldp=$od	&& $od->{Parent}	|| '';		# local domain path
    $od =Win32::OLE->GetObject("$ldp,domain");
 my $ldu=$od	&& $od->{Name}		|| '';		# local domain name
 my $ldn=$od	&& lc($od->{Name})	|| '';		# local domain name
 my $ldc=lc($ldp);					# local domain comparable
 my $lds =$ldu && w32isDC($s) && $ldn	|| '';		# local DC service?
 $s->logRec('ugfile','ugf_w32','host',$hdp,'dc',$lds,'domain',$ldp)
	if $s;
 my %dnl=(!$hdn ||$lds ?() :($hdn=>1), !$ldn ?() :($ldn=>1));	# domains to list
 my @dnl=(!$hdu ||$lds ?() :$hdu, !$ldu ?() :$ldu);		# domains to list
 my $fgm;						# group lister/unfolder
    $fgm=sub{	return('') if !$_[1];
		my $om =$_[1]->{Members};
		return('') if !$om;
		my @rv;
		my $oi;
		$om->{Filter} =['User'];
		$oi =Win32::OLE::Enum->new($om);
		while (defined($oi) && defined(my $oe =$oi->Next())) {
			if (!$oe || !$oe->{Class} || !$oe->{Name}