1*256a93a4Safresh1use strict; 2*256a93a4Safresh1use warnings; 3*256a93a4Safresh1 4*256a93a4Safresh1use Test; 5*256a93a4Safresh1use Win32; 6*256a93a4Safresh1use Config; 7*256a93a4Safresh1use File::Temp; 8*256a93a4Safresh1 9*256a93a4Safresh1plan tests => 7; 10*256a93a4Safresh1 11*256a93a4Safresh1ok(ref(Win32::GetProcessPrivileges()) eq 'HASH'); 12*256a93a4Safresh1ok(ref(Win32::GetProcessPrivileges(Win32::GetCurrentProcessId())) eq 'HASH'); 13*256a93a4Safresh1 14*256a93a4Safresh1# All Windows PIDs are divisible by 4. It's an undocumented implementation 15*256a93a4Safresh1# detail, but it means it's extremely unlikely that the PID below is valid. 16*256a93a4Safresh1ok(!Win32::GetProcessPrivileges(3423237)); 17*256a93a4Safresh1 18*256a93a4Safresh1my $whoami = `whoami /priv 2>&1`; 19*256a93a4Safresh1my $skip = ($? == -1 || $? >> 8) ? '"whoami" command is missing' : 0; 20*256a93a4Safresh1 21*256a93a4Safresh1skip($skip, sub{ 22*256a93a4Safresh1 my $privs = Win32::GetProcessPrivileges(); 23*256a93a4Safresh1 24*256a93a4Safresh1 while ($whoami =~ /^(Se\w+)/mg) { 25*256a93a4Safresh1 return 0 unless exists $privs->{$1}; 26*256a93a4Safresh1 } 27*256a93a4Safresh1 28*256a93a4Safresh1 return 1; 29*256a93a4Safresh1}); 30*256a93a4Safresh1 31*256a93a4Safresh1# there isn't really anything to test, we just want to make sure that the 32*256a93a4Safresh1# function doesn't segfault 33*256a93a4Safresh1Win32::IsDeveloperModeEnabled(); 34*256a93a4Safresh1ok(1); 35*256a93a4Safresh1 36*256a93a4Safresh1Win32::IsSymlinkCreationAllowed(); 37*256a93a4Safresh1ok(1); 38*256a93a4Safresh1 39*256a93a4Safresh1$skip = $^O ne 'MSWin32' ? 'MSWin32-only test' : 0; 40*256a93a4Safresh1$skip ||= !$Config{d_symlink} ? 'this perl doesn\'t have symlink()' : 0; 41*256a93a4Safresh1 42*256a93a4Safresh1skip($skip, sub { 43*256a93a4Safresh1 my $tmpdir = File::Temp->newdir; 44*256a93a4Safresh1 my $dirname = $tmpdir->dirname; 45*256a93a4Safresh1 46*256a93a4Safresh1 if (Win32::IsSymlinkCreationAllowed()) { 47*256a93a4Safresh1 # we expect success 48*256a93a4Safresh1 return symlink("foo", $tmpdir->dirname . "/new_symlink") == 1; 49*256a93a4Safresh1 } 50*256a93a4Safresh1 else { 51*256a93a4Safresh1 # we expect failure 52*256a93a4Safresh1 return symlink("foo", $tmpdir->dirname . "/new_symlink") == 0; 53*256a93a4Safresh1 } 54*256a93a4Safresh1}); 55*256a93a4Safresh1 56