summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Win32/Process/Info/NT.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Win32/Process/Info/NT.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Win32/Process/Info/NT.pm865
1 files changed, 0 insertions, 865 deletions
diff --git a/Master/tlpkg/tlperl/lib/Win32/Process/Info/NT.pm b/Master/tlpkg/tlperl/lib/Win32/Process/Info/NT.pm
deleted file mode 100644
index 26dd7ccba6e..00000000000
--- a/Master/tlpkg/tlperl/lib/Win32/Process/Info/NT.pm
+++ /dev/null
@@ -1,865 +0,0 @@
-=head1 NAME
-
-Win32::Process::Info::NT - Provide process information via NT-native calls.
-
-=head1 SYNOPSIS
-
-
-This package fetches process information on a given Windows
-machine, using Microsoft Windows NT's native process
-information calls.
-
- use Win32::Process::Info
- $pi = Win32::Process::Info->new (undef, 'NT');
- $pi->Set (elapsed_as_seconds => 0); # In clunks, not seconds.
- @pids = $pi->ListPids (); # Get all known PIDs
- @info = $pi->GetProcInfo (); # Get the max
-
-CAVEAT USER:
-
-This package does not support access to a remote machine,
-because the underlying API doesn't. If you specify a machine
-name (other than '', 0, or undef) when you instantiate a
-new Win32::Process::Info::NT object, you will get an exception.
-
-This package is B<not> intended to be used independently;
-instead, it is a subclass of Win32::Process::Info, and should
-only be called via that package.
-
-=head1 DESCRIPTION
-
-The main purpose of the Win32::Process::Info::NT package is to get whatever
-information is convenient (for the author!) about one or more Windows
-32 processes. GetProcInfo (which see) is therefore the most-important
-subroutine in the package. See it for more information.
-
-This package returns Windows process IDs, even under Cygwin.
-
-Unless explicitly stated otherwise, modules, variables, and so
-on are considered private. That is, the author reserves the right
-to make arbitrary changes in the way they work, without telling
-anyone. For subroutines, variables, and so on which are considered
-public, the author will make an effort keep them stable, and failing
-that to call attention to changes.
-
-Nothing is exported by default, though all the public subroutines are
-exportable, either by name or by using the :all tag.
-
-The following subroutines should be considered public:
-
-=over 4
-
-=cut
-
-
-package Win32::Process::Info::NT;
-
-use 5.006;
-
-use strict;
-use warnings;
-
-# The purpose of this is to provide a dummy Call
-# method for those cases where we might not be able
-# to map a subroutine.
-
-sub Win32::Process::Info::DummyRoutine::new {
-my $class = shift;
-$class = ref $class if ref $class;
-my $self = {};
-bless $self, $class;
-return $self;
-}
-
-sub Win32::Process::Info::DummyRoutine::Call {
-return undef; ## no critic (ProhibitExplicitReturnUndef)
-}
-
-use base qw{ Win32::Process::Info };
-
-our $VERSION = '1.020';
-
-our $AdjustTokenPrivileges;
-our $CloseHandle;
-our $elapsed_in_seconds;
-our $EnumProcesses;
-our $EnumProcessModules;
-our $FileTimeToSystemTime;
-our $GetCurrentProcess;
-our $GetModuleFileNameEx;
-our $GetPriorityClass;
-our $GetProcessAffinityMask;
-our $GetProcessIoCounters;
-our $GetProcessWorkingSetSize;
-our $GetProcessTimes;
-our $GetProcessVersion;
-our $GetTokenInformation;
-our $LookupAccountSid;
-our $LookupPrivilegeValue;
-our $OpenProcess;
-our $OpenProcessToken;
-
-our $GetSidIdentifierAuthority;
-our $GetSidSubAuthority;
-our $GetSidSubAuthorityCount;
-our $IsValidSid;
-
-use Carp;
-use File::Basename;
-use Win32;
-use Win32::API;
-
-use constant TokenUser => 1; # PER MSDN
-use constant TokenOwner => 4;
-
-my $setpriv;
-eval {
- require Win32API::Registry and
- $setpriv = sub {
- Win32API::Registry::AllowPriv (
- Win32API::Registry::SE_DEBUG_NAME (), 1)
- };
- };
-$setpriv ||= sub {};
-##0.013 use Win32API::Registry qw{:Func :SE_};
-
-
-my %_transform = (
- CreationDate => \&Win32::Process::Info::_date_to_time_t,
- KernelModeTime => \&Win32::Process::Info::_clunks_to_desired,
- UserModeTime => \&Win32::Process::Info::_clunks_to_desired,
- );
-
-sub _map {
-return Win32::API->new (@_) ||
- croak "Error - Failed to map $_[1] from $_[0]: $^E";
-}
-
-sub _map_opt {
-return Win32::API->new (@_) ||
- Win32::Process::Info::DummyRoutine->new ();
-}
-
-my %lglarg = map {($_, 1)} qw{assert_debug_priv variant};
-
-sub new {
-my $class = shift;
-$class = ref $class if ref $class;
-croak "Error - Win32::Process::Info::NT is unsupported under this flavor of Windows."
- unless Win32::IsWinNT ();
-my $arg = shift;
-if (ref $arg eq 'HASH') {
- my @ilg = grep {!$lglarg{$_}} keys %$arg;
- @ilg and
- croak "Error - Win32::Process::Info::NT argument(s) (@ilg) illegal";
- }
- else {
- croak "Error - Win32::Process::Info::NT does not support remote operation."
- if $arg;
- }
-my $self = {%Win32::Process::Info::static};
-delete $self->{variant};
-$self->{_xfrm} = \%_transform;
-bless $self, $class;
-# We want to fail silently, since that's probably better than nothing.
-##0.013 AllowPriv (SE_DEBUG_NAME, 1)
-$setpriv->() if $setpriv; ##0.013 ##1.005
-$setpriv = undef; ##1.005
-## or croak "Error - Failed to (try to) assert privilege @{[
-## SE_DEBUG_NAME]}; $^E"
- ;
-return $self;
-}
-
-
-=item @info = $pi->GetProcInfo ();
-
-This method returns a list of anonymous hashes, each containing
-information on one process. If no arguments are passed, the
-list represents all processes in the system. You can pass a
-list of process IDs, and get out a list of the attributes of
-all such processes that actually exist. If you call this
-method in scalar context, you get a reference to the list.
-
-What keys are available depend on the variant in use. With the NT
-variant you can hope to get at least the following keys for a "normal"
-process (i.e. not the idle process, which is PID 0, nor the system,
-which is _usually_ PID 8) to which you have access:
-
- CreationDate
- ExecutablePath
- KernelModeTime
- MaximumWorkingSetSize
- MinimumWorkingSetSize
- Name (generally the name of the executable file)
- OtherOperationCount
- OtherTransferCount (= number of bytes transferred)
- ProcessId
- ReadOperationCount
- ReadTransferCount (= number of bytes read)
- UserModeTime
- WriteOperationCount
- WriteTransferCount (= number of bytes read)
-
-All returns are Perl scalars. The I/O statistic keys represent counts
-if named *OperationCount, or bytes if named *TransferCount.
-
-Note that:
-
-- The I/O statistic keys will only be present on Windows 2000.
-
-- The MinimumWorkingSetSize and MaximumWorkingSetSize keys have
-no apparent relationship to the amount of memory actually
-consumed by the process.
-
-The output will contain all processes for which information was
-requested, but will not necessarily contain all information for
-all processes.
-
-The _status key of the process hash contains the status of
-GetProcInfo's request(s) for information. If all information is
-present, the status element of the hash will be zero. If there
-was any problem getting any of the information, the _status element
-will contain the Windows error code ($^E + 0, to be precise). You
-might want to look at it - or not count on the hashes being fully
-populated (or both!).
-
-Note that GetProcInfo is not, at the moment, able to duplicate the
-information returned by the resource kit tool pulist.exe. And it may
-never do so. Pulist.exe relies on the so-called internal APIs, which
-for NT are found in ntdll.dll, which may not be linked against.
-Pulist.exe gets around this by loading it at run time, and calling
-NtQuerySystemInformation. The required constants and structure
-definitions are in Winternl.h, which doesn't come with VCC. The caveat
-at http://msdn.microsoft.com/library/default.asp?url=/library/en-us/
-devnotes/winprog/calling_internal_apis.asp claims that they reserve
-the right to change this without notice, so I hesitate to program
-against it. Sorry. I guess the real purpose of this paragraph is to
-say that I _did_ try.
-
-=cut
-
-
-# The following manifest constants are from windef.h
-
-use constant MAX_PATH => 260;
-
-
-# The following manifest constants are from winerror.h
-
-use constant ERROR_ACCESS_DENIED => 5;
-
-
-# The following manifest constants are from winnt.h
-
-use constant READ_CONTROL => 0x00020000;
-use constant SYNCHRONIZE => 0x00100000;
-use constant STANDARD_RIGHTS_REQUIRED => 0x000F0000;
-use constant STANDARD_RIGHTS_READ => READ_CONTROL;
-use constant STANDARD_RIGHTS_WRITE => READ_CONTROL;
-use constant STANDARD_RIGHTS_EXECUTE => READ_CONTROL;
-
-use constant PROCESS_TERMINATE => 0x0001;
-use constant PROCESS_CREATE_THREAD => 0x0002;
-use constant PROCESS_VM_OPERATION => 0x0008;
-use constant PROCESS_VM_READ => 0x0010;
-use constant PROCESS_VM_WRITE => 0x0020;
-use constant PROCESS_DUP_HANDLE => 0x0040;
-use constant PROCESS_CREATE_PROCESS => 0x0080;
-use constant PROCESS_SET_QUOTA => 0x0100;
-use constant PROCESS_SET_INFORMATION => 0x0200;
-use constant PROCESS_QUERY_INFORMATION => 0x0400;
-use constant PROCESS_ALL_ACCESS => STANDARD_RIGHTS_REQUIRED | SYNCHRONIZE |
- 0xFFF;
-
-use constant SID_REVISION => 1; # Current revision level
-use constant SID_MAX_SUB_AUTHORITIES => 15;
-
-use constant TOKEN_ASSIGN_PRIMARY => 0x0001;
-use constant TOKEN_DUPLICATE => 0x0002;
-use constant TOKEN_IMPERSONATE => 0x0004;
-use constant TOKEN_QUERY => 0x0008;
-use constant TOKEN_QUERY_SOURCE => 0x0010;
-use constant TOKEN_ADJUST_PRIVILEGES => 0x0020;
-use constant TOKEN_ADJUST_GROUPS => 0x0040;
-use constant TOKEN_ADJUST_DEFAULT => 0x0080;
-use constant TOKEN_ADJUST_SESSIONID => 0x0100;
-
-use constant TOKEN_ALL_ACCESS => STANDARD_RIGHTS_REQUIRED |
- TOKEN_ASSIGN_PRIMARY | TOKEN_DUPLICATE |
- TOKEN_IMPERSONATE | TOKEN_QUERY |
- TOKEN_QUERY_SOURCE | TOKEN_ADJUST_PRIVILEGES |
- TOKEN_ADJUST_GROUPS | TOKEN_ADJUST_SESSIONID |
- TOKEN_ADJUST_DEFAULT;
-
-
-use constant TOKEN_READ => STANDARD_RIGHTS_READ | TOKEN_QUERY;
-
-
-use constant TOKEN_WRITE => STANDARD_RIGHTS_WRITE | TOKEN_ADJUST_PRIVILEGES |
- TOKEN_ADJUST_GROUPS | TOKEN_ADJUST_DEFAULT;
-
-use constant TOKEN_EXECUTE => STANDARD_RIGHTS_EXECUTE;
-
-
-# Crib notes:
-# MS type Perl type
-# Handle N
-# Bool I
-# DWord I
-# Pointer P
-
-sub GetProcInfo {
-my ( $self, @args ) = @_;
-my $opt = ref $args[0] eq 'HASH' ? shift @args : {};
-
-$CloseHandle ||= _map ('KERNEL32', 'CloseHandle', [qw{N}], 'V');
-$GetModuleFileNameEx ||=
- _map ('PSAPI', 'GetModuleFileNameEx', [qw{N N P N}], 'I');
-$GetPriorityClass ||=
- _map ('KERNEL32', 'GetPriorityClass', [qw{N}], 'I');
-$GetProcessAffinityMask ||=
- _map ('KERNEL32', 'GetProcessAffinityMask', [qw{N P P}], 'I');
-$GetProcessIoCounters ||=
- _map_opt ('KERNEL32', 'GetProcessIoCounters', [qw{N P}], 'I');
-$GetProcessTimes ||=
- _map ('KERNEL32', 'GetProcessTimes', [qw{N P P P P}], 'I');
-$GetProcessWorkingSetSize ||=
- _map ('KERNEL32', 'GetProcessWorkingSetSize', [qw{N P P}], 'I');
-$GetTokenInformation ||=
- _map ('ADVAPI32', 'GetTokenInformation', [qw{N N P N P}], 'I');
-$LookupAccountSid ||=
- _map ('ADVAPI32', 'LookupAccountSid', [qw{P P P P P P P}], 'I');
-$OpenProcess ||= _map ('KERNEL32', 'OpenProcess', [qw{N I N}], 'N');
-$OpenProcessToken ||=
- _map ('ADVAPI32', 'OpenProcessToken', [qw{N N P}], 'I');
-$EnumProcessModules ||=
- _map ('PSAPI', 'EnumProcessModules', [qw{N P N P}], 'I');
-
-
-my $dac = PROCESS_QUERY_INFORMATION | PROCESS_VM_READ;
-my $tac = TOKEN_READ;
-
-@args or @args = ListPids ($self);
-
-my @pinf;
-
-my $dat;
-my $my_pid = $self->My_Pid();
-my %sid_to_name;
-my @trydac = (
- PROCESS_QUERY_INFORMATION | PROCESS_VM_READ,
- PROCESS_QUERY_INFORMATION,
- );
-
-foreach my $pid (map {$_ eq '.' ? $my_pid : $_} @args) {
-
- local $^E = 0;
- $dat = $self->_build_hash (undef, ProcessId => $pid);
- $self->_build_hash ($dat, Name => 'System Idle Process')
- unless $pid;
-
- push @pinf, $dat;
-
- my $prchdl;
- foreach my $dac (@trydac) {
- $prchdl = $OpenProcess->Call ($dac, 0, $pid) and last;
- }
- next unless $prchdl;
-
- my ($cretim, $exttim, $knltim, $usrtim);
- $cretim = $exttim = $knltim = $usrtim = ' ' x 8;
- if ($GetProcessTimes->Call ($prchdl, $cretim, $exttim, $knltim, $usrtim)) {
- my $time = _to_char_date ($cretim);
- $self->_build_hash ($dat, CreationDate => $time) if $time;
- $self->_build_hash ($dat,
- KernelModeTime => _ll_to_bigint ($knltim),
- UserModeTime => _ll_to_bigint ($usrtim));
- }
-
- my ($minws, $maxws);
- $minws = $maxws = ' ';
- if ($GetProcessWorkingSetSize->Call ($prchdl, $minws, $maxws)) {
- $self->_build_hash ($dat,
- MinimumWorkingSetSize => unpack ('L', $minws),
- MaximumWorkingSetSize => unpack ('L', $maxws));
- }
-
- my $procio = ' ' x 6; # structure is 6 longlongs.
- if ($GetProcessIoCounters->Call ($prchdl, $procio)) {
- my ($ro, $wo, $oo, $rb, $wb, $ob) = _ll_to_bigint ($procio);
- $self->_build_hash ($dat,
- ReadOperationCount => $ro,
- ReadTransferCount => $rb,
- WriteOperationCount => $wo,
- WriteTransferCount => $wb,
- OtherOperationCount => $oo,
- OtherTransferCount => $ob);
- }
-
- my $modhdl = ' '; # Module handle better be 4 bytes.
- my $modgot = ' ';
-
- if ($EnumProcessModules->Call ($prchdl, $modhdl, length $modhdl, $modgot)) {
- $modhdl = unpack ('L', $modhdl);
- my $mfn = ' ' x MAX_PATH;
- if ($GetModuleFileNameEx->Call ($prchdl, $modhdl, $mfn, length $mfn)) {
- $mfn =~ s/\0.*//;
- $mfn =~ s/^\\(\w+)/$ENV{$1} ? $ENV{$1} : "\\$1"/ex;
- $mfn =~ s/^\\\?\?\\//;
- $self->_build_hash ($dat,
- ExecutablePath => $mfn);
- my $base = basename ($mfn);
- $self->_build_hash ($dat, Name => $base) if $base;
- }
- }
-
- my ($tokhdl);
- $tokhdl = ' ' x 4; # Token handle better be 4 bytes.
- { # Start block, to use as single-iteration loop
- last if $opt->{no_user_info};
- $OpenProcessToken->Call ($prchdl, $tac, $tokhdl)
- or do {$tokhdl = undef; last; };
- my ($dsize, $size_in, $size_out, $sid, $stat, $use, $void);
- $tokhdl = unpack 'L', $tokhdl;
-
- $size_out = ' ' x 4;
- $void = pack 'p', undef;
- my $token_type = TokenUser;
- $GetTokenInformation->Call ($tokhdl, $token_type, $void, 0, $size_out);
- $size_in = unpack 'L', $size_out;
- my $tokinf = ' ' x $size_in;
- $GetTokenInformation->Call ($tokhdl, $token_type, $tokinf, $size_in, $size_out)
- or last;
- my $sidadr = unpack "P$size_in", $tokinf;
-## NO! my $sidadr = unpack "P4", $tokinf;
-
- $sid = _text_sid ($sidadr) or last;
- $self->_build_hash ($dat, OwnerSid => $sid);
- if ($sid_to_name{$sid}) {
- $self->_build_hash ($dat, Owner => $sid_to_name{$sid});
- last;
- }
-
- $size_out = $dsize = pack 'L', 0;
- $use = pack 'S', 0;
- $stat = $LookupAccountSid->Call ($void, $sidadr, $void, $size_out, $void, $dsize, $use);
- my ($name, $domain);
- $name = " " x (unpack 'L', $size_out);
- $domain = " " x (unpack 'L', $dsize);
- my $pname = pack 'p', $name;
- my $pdom = pack 'p', $domain;
- $LookupAccountSid->Call ($void, $sidadr, $name, $size_out, $domain, $dsize, $use)
- or last;
- $size_out = unpack 'L', $size_out;
- $dsize = unpack 'L', $dsize;
- my $user = (substr ($domain, 0, $dsize) . "\\" .
- substr ($name, 0, $size_out));
- $sid_to_name{$sid} = $user;
- $self->_build_hash ($dat, Owner => $user);
- }
-
- $CloseHandle->Call ($tokhdl) if $tokhdl && $tokhdl ne ' ';
- $CloseHandle->Call ($prchdl);
- }
- continue {
- $self->_build_hash ($dat, _status => $^E + 0);
- }
-return wantarray ? @pinf : \@pinf;
-}
-
-sub _to_char_date {
-my @args = @_;
-my @result;
-( $FileTimeToSystemTime ||=
- Win32::API->new ('KERNEL32', 'FileTimeToSystemTime', [qw{P P}], 'I') )
- or croak "Error - Failed to map FileTimeToSystemTime: $^E";
-my $systim = ' ' x 8;
-foreach (@args) {
- $FileTimeToSystemTime->Call ($_, $systim) or
- croak "Error - FileTimeToSystemTime failed: $^E";
- my $time;
- my ($yr, $mo, $dow, $day, $hr, $min, $sec, $ms) = unpack ('S*', $systim);
- if ($yr == 1601 && $mo == 1 && $day == 1) {
- $time = undef;
- }
- else {
- $time = sprintf ('%04d%02d%02d%02d%02d%02d',
- $yr, $mo, $day, $hr, $min, $sec);
- }
- push @result, $time;
- }
-return @result if wantarray;
-return $result[0];
-}
-
-sub _ll_to_bigint {
-my @args = @_;
-my @result;
-foreach (@args) {
- my @data = unpack 'L*', $_;
- while (@data) {
- my $low = shift @data;
- my $high = shift @data;
- push @result, ($high <<= 32) + $low;
- }
- }
-return @result if wantarray;
-return $result[0];
-}
-
-sub _clunks_to_secs {
-my @args = @_;
-my @result;
-foreach (_ll_to_bigint (@args)) {
- push @result, $_ / 10_000_000;
- }
-return @result if wantarray;
-return $result[0];
-}
-
-=item @pids = $pi->ListPids ()
-
-This subroutine returns a list of all known process IDs in the
-system, in no particular order. If called in list context, the
-list of process IDs itself is returned. In scalar context, a
-reference to the list is returned.
-
-=cut
-
-sub ListPids {
-my ( $self, @args ) = @_;
-my $filter = undef;
-my $my_pid = $self->My_Pid();
-@args and $filter = {
- map { ($_ eq '.' ? $my_pid : $_) => 1 } @args
-};
-$EnumProcesses ||= _map ('PSAPI', 'EnumProcesses', [qw{P N P}], 'I');
-my $psiz = 4;
-my $bsiz = 0;
- {
- $bsiz += 1024;
- my $pidbuf = ' ' x $bsiz;
- my $pidgot = ' ';
- $EnumProcesses->Call ($pidbuf, $bsiz, $pidgot) or
- croak "Error - Failed to call EnumProcesses: $^E";
-# Note - 122 = The data area passed to a system call is too small
- my $pidnum = unpack ('L', $pidgot);
- redo unless $pidnum < $bsiz;
- $pidnum /= 4;
- my @pids;
- if ($filter) {
- @pids = grep {$filter->{$_}} unpack ("L$pidnum", $pidbuf);
- }
- else {
- @pids = unpack ("L$pidnum", $pidbuf);
- }
- return wantarray ? @pids : \@pids;
- }
-confess 'Programming error - should not get here';
-}
-
-
-
-# _text_sid (pointer to SID)
-
-# This subroutine translates the given sid in to a string.
-# The algorithm is from http://msdn.microsoft.com/library/
-# default.asp?url=/library/en-us/security/security/
-# converting_a_binary_sid_to_string_format.asp)
-#
-# As a general note: The SID is represented internally by an
-# opaque structure, which contains a bunch of things that we
-# need to know to format it. Rather than publishing the
-# structure, or providing a formatting routine, Microsoft
-# provided a bunch of subroutines which return pointers to the
-# various pieces/parts of the structure that we need to do it
-# ourselves. This presents us with with the situation of an
-# opaque structure, essentially all of whose parts are public.
-# This, I presume, is an example of the superior engineering that
-# makes Microsoft the darling of the industry.
-#
-# It also means we play some serious games, since Win32::API has
-# no mechanism to return a pointer. The next best thing is to
-# tell Win32::API that the return is a number of the appropriate
-# size, "pack" the number to get an honest-to-God pointer, and
-# then unpack again as a pointer to a structure of the
-# appropriate size. A further unpack may be necessary to extract
-# data from the finally-obtained structure. You'll be seeing a
-# lot of this pack/unpack idiom in the code that follows.
-#
-# Interestingly enough in February 2013 I found (fairly easily)
-# ConvertSidToStringSid(), which seems to do what I need, and
-# seems to have the same vintage as the other calls used above.
-# But in September of 2002 when I was writing this code I never
-# found it - certainly the docs cited never mentioned it.
-
-sub _text_sid {
-my $sid = shift;
-
-
-# Make sure we have a valid SID
-
-$IsValidSid ||= _map ('ADVAPI32', 'IsValidSid', [qw{P}], 'I');
-my $stat = $IsValidSid->Call ($sid)
- or return;
-
-
-# Get the identifier authority.
-
-$GetSidIdentifierAuthority ||=
- _map ('ADVAPI32', 'GetSidIdentifierAuthority', [qw{P}], 'N');
-my $sia = $GetSidIdentifierAuthority->Call ($sid);
-$sia = pack 'L', $sia;
-# Occasionally we end up with an undef value here, which indicates a
-# failure. The docs say this only happens with an invalid SID, but what
-# do they know?
-defined( $sia = unpack 'P6', $sia )
- or return;
-
-
-# Get the number of subauthorities.
-
-$GetSidSubAuthorityCount ||=
- _map ('ADVAPI32', 'GetSidSubAuthorityCount', [qw{P}], 'N');
-my $subauth = $GetSidSubAuthorityCount->Call ($sid);
-$subauth = pack 'L', $subauth;
-$subauth = unpack 'P1', $subauth;
-$subauth = unpack 'C*', $subauth;
-
-
-# Start by formatting the revision number. Note that this is
-# hard-coded. It's in a .h file if you're using "C". The
-# revision is actually in the SID if you trust the include
-# file, but the docs make it look like the SID structure is
-# supposed to be opaque, and in Microsoft's example comes from
-# the .h
-
-my $sidout = sprintf 'S-%lu', SID_REVISION;
-
-
-# Format the identifier authority. The rules are different
-# depending on whether the first 2 bytes are in use.
-
-if (unpack 'S', $sia) {
- $sidout .= sprintf ('-0x%s', unpack 'H*', $sia);
- }
- else {
- $sidout .= sprintf '-%lu', unpack 'x2N', $sia;
- }
-
-
-# Now tack on all the subauthorities. Because of Microsoft's
-# high-quality design, the subauthorities are in a different
-# byte order than the identifier authority.
-
-$GetSidSubAuthority ||=
- _map ('ADVAPI32', 'GetSidSubAuthority', [qw{P I}], 'N');
-for (my $subctr = 0; $subctr < $subauth; $subctr++) {
- my $subid = $GetSidSubAuthority->Call ($sid, $subctr);
- $subid = pack 'L', $subid;
- $subid = unpack 'P4', $subid;
- $sidout .= sprintf '-%lu', unpack 'L', $subid;
- }
-
-
-# Return the formatted string.
-
-return $sidout;
-}
-
-=back
-
-=head1 REQUIREMENTS
-
-This library uses the following libraries:
-
- Carp
- Time::Local
- Win32
- Win32::API
- Win32API::Registry (if available)
-
-As of this writing, all but Win32 and Win32::API are part of the
-standard Perl distribution. Win32 is not part of the standard Perl
-distribution, but comes with the ActivePerl distribution. Win32::API
-comes with ActivePerl as of about build 630, but did not come with
-earlier versions. It must be installed before installing this module.
-
-=head1 ACKNOWLEDGMENTS
-
-This module would not exist without the following people:
-
-Aldo Calpini, who gave us Win32::API.
-
-The folks of Cygwin (F<http://www.cygwin.com/>), especially Christopher
-Faylor, author of ps.cc.
-
-Jenda Krynicky, whose "How2 create a PPM distribution"
-(F<http://jenda.krynicky.cz/perl/PPM.html>) gave me a leg up on
-both PPM and tar distributions.
-
-Judy Hawkins of Pitney Bowes, for providing testing and patches for
-NT 4.0 without WMI.
-
-=head1 AUTHOR
-
-Thomas R. Wyant, III (F<wyant at cpan dot org>)
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2001-2003 by E. I. DuPont de Nemours and Company, Inc.
-
-Copyright (C) 2007-2011, 2013 by Thomas R. Wyant, III
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl 5.10.0. For more details, see the full text
-of the licenses in the directory LICENSES.
-
-This program is distributed in the hope that it will be useful, but
-without any warranty; without even the implied warranty of
-merchantability or fitness for a particular purpose.
-
-=cut
-
-1;
-__END__
-
-Sample code from MSDN
-
-Set privilege (http://msdn.microsoft.com/library/default.asp?url=/library/en-us/security/security/enabling_and_disabling_privileges.asp)
-
-BOOL SetPrivilege(
- HANDLE hToken, // access token handle
- LPCTSTR lpszPrivilege, // name of privilege to enable/disable
- BOOL bEnablePrivilege // to enable or disable privilege
- )
-{
-TOKEN_PRIVILEGES tp;
-LUID luid; // 64-bit identifier
-
-if ( !LookupPrivilegeValue(
- NULL, // lookup privilege on local system
- lpszPrivilege, // privilege to lookup
- &luid ) ) // receives LUID of privilege
-{
- printf("LookupPrivilegeValue error: %u\n", GetLastError() );
- return FALSE;
-}
-
-tp.PrivilegeCount = 1;
-tp.Privileges[0].Luid = luid;
-if (bEnablePrivilege)
- tp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
-else
- tp.Privileges[0].Attributes = 0;
-
-// Enable the privilege or disable all privileges.
-
-if ( !AdjustTokenPrivileges(
- hToken,
- FALSE,
- &tp,
- sizeof(TOKEN_PRIVILEGES),
- (PTOKEN_PRIVILEGES) NULL,
- (PDWORD) NULL) )
-{
- printf("AdjustTokenPrivileges error: %u\n", GetLastError() );
- return FALSE;
-}
-
-return TRUE;
-}
-
-
-# _set_priv ([priv_name, ...])
-
-# This subroutine turns on the desired privilege (or privileges).
-# If no arguments are passed it turns on the "Debug" privilege.
-# The algorithm is from
-# http://msdn.microsoft.com/library/default.asp?url=/library/
-# en-us/security/security/enabling_and_disabling_privileges.asp
-#
-# We return zero for success, or $^E if an error occurs.
-#
-# The complication _here_ is that there is no standard internal
-# representation of a privilege. Microsoft encodes them as LUIDs
-# (locally-unique identifiers), which means we have to take as
-# input the strings representing the names of the privileges, and
-# translate each to a LUID, since LUIDS are _local_ to a given
-# instance of an operating system.
-
-sub _set_priv {
-
-my $self = shift;
-@_ = (SE_DEBUG_NAME ()) unless @_;
-
-
-# First we have to get our own access token, because that's what
-# we actually set the privilege on. And we'd better declare the
-# correct access intent ahead of time, or Microsoft will be very
-# upset.
-
-$GetCurrentProcess ||= _map ('KERNEL32', 'GetCurrentProcess', [], 'N');
-my $prchdl = $GetCurrentProcess->Call () or return $^E + 0;
-$OpenProcessToken ||=
- _map ('ADVAPI32', 'OpenProcessToken', [qw{N N P}], 'I');
-my $tokhdl;
-$tokhdl = ' ' x 4; # Token handle better be 4 bytes.
-my $tac = TOKEN_READ | TOKEN_ADJUST_PRIVILEGES;
-$OpenProcessToken->Call ($prchdl, $tac, $tokhdl) or return $^E + 0;
-$tokhdl = unpack 'L', $tokhdl;
-
-
-# OK, now we get to build up a TOKEN_PRIVILEGES structure
-# representing the privileges we want to assert. This looks like:
-# A dword count (number of privileges)
-# The specified number of LUID_AND_ATTRIBUTES structures,
-# each of which looks like:
-# Luid (64 bits = 8 bytes, as noted above)
-# Attributes (4 bytes).
-# Each LUID gets looked up and slapped on the end of the growing
-# TOKEN_PRIVILEGES structure.
-
-my $enab = pack 'L', SE_PRIVILEGE_ENABLED ();
-my %gotprv;
-$LookupPrivilegeValue ||=
- _map ('ADVAPI32', 'LookupPrivilegeValue', [qw{P P P}], 'I');
-my $null = pack 'p', undef;
-my $num = 0;
-my $tp = '';
-foreach my $priv (@_) {
- next if $gotprv{$priv};
- my $luid = '.' x 8; # An LUID is 64 bits.
- $LookupPrivilegeValue->Call ($null, $priv, $luid) or
- return $^E + 0;
- $gotprv{$priv} = $luid;
- $num++;
- $tp .= $luid . $enab;
- }
-
-
-# Okay, the TOKEN_PRIVILEGES structure needs the number of
-# privileges slapped on the front. So:
-
-$num = pack 'L', $num;
-$tp = $num . $tp;
-
-
-# At long last we turn on the desired privileges. As another
-# example of Microsoft's inspired design, note that we need to
-# tell the subroutine how big the structure is, even though the
-# structure contains the number of elements. Or, alternately,
-# that we have to pass the number of elements even though we told
-# the subroutine how big the structure is.
-
-$AdjustTokenPrivileges ||=
- _map ('ADVAPI32', 'AdjustTokenPrivileges', [qw{N I P N P P}], 'I');
-$AdjustTokenPrivileges->Call (
- $tokhdl, 0, $tp, length $tp, $null, $null) or
- return $^E + 0;
-
-
-return 0;
-}
-