Initial Windows agent repository

This commit is contained in:
Frank Harris 2026-06-08 10:45:20 -05:00
commit a0db0c2e5b
10589 changed files with 3844063 additions and 0 deletions

View file

@ -0,0 +1,238 @@
################################################################################
#
# Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz <mhx@cpan.org>.
# Version 1.x, Copyright (C) 1997, Graham Barr <gbarr@pobox.com>.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
package IPC::Msg;
use IPC::SysV qw(IPC_STAT IPC_SET IPC_RMID);
use strict;
use vars qw($VERSION);
use Carp;
$VERSION = '2.09';
# Figure out if we have support for native sized types
my $N = do { my $foo = eval { pack "L!", 0 }; $@ ? '' : '!' };
{
package IPC::Msg::stat;
use Class::Struct qw(struct);
struct 'IPC::Msg::stat' => [
uid => '$',
gid => '$',
cuid => '$',
cgid => '$',
mode => '$',
qnum => '$',
qbytes => '$',
lspid => '$',
lrpid => '$',
stime => '$',
rtime => '$',
ctime => '$',
];
}
sub new {
@_ == 3 || croak 'IPC::Msg->new( KEY , FLAGS )';
my $class = shift;
my $id = msgget($_[0],$_[1]);
defined($id)
? bless \$id, $class
: undef;
}
sub id {
my $self = shift;
$$self;
}
sub stat {
my $self = shift;
my $data = "";
msgctl($$self,IPC_STAT,$data) or
return undef;
IPC::Msg::stat->new->unpack($data);
}
sub set {
my $self = shift;
my $ds;
if(@_ == 1) {
$ds = shift;
}
else {
croak 'Bad arg count' if @_ % 2;
my %arg = @_;
$ds = $self->stat
or return undef;
my($key,$val);
$ds->$key($val)
while(($key,$val) = each %arg);
}
msgctl($$self,IPC_SET,$ds->pack);
}
sub remove {
my $self = shift;
(msgctl($$self,IPC_RMID,0), undef $$self)[0];
}
sub rcv {
@_ <= 5 && @_ >= 3 or croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )';
my $self = shift;
my $buf = "";
msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or
return;
my $type;
($type,$_[0]) = unpack("l$N a*",$buf);
$type;
}
sub snd {
@_ <= 4 && @_ >= 3 or croak '$msg->snd( TYPE, BUF, FLAGS )';
my $self = shift;
msgsnd($$self,pack("l$N a*",$_[0],$_[1]), $_[2] || 0);
}
1;
__END__
=head1 NAME
IPC::Msg - SysV Msg IPC object class
=head1 SYNOPSIS
use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR);
use IPC::Msg;
$msg = IPC::Msg->new(IPC_PRIVATE, S_IRUSR | S_IWUSR);
$msg->snd($msgtype, $msgdata);
$msg->rcv($buf, 256);
$ds = $msg->stat;
$msg->remove;
=head1 DESCRIPTION
A class providing an object based interface to SysV IPC message queues.
=head1 METHODS
=over 4
=item new ( KEY , FLAGS )
Creates a new message queue associated with C<KEY>. A new queue is
created if
=over 4
=item *
C<KEY> is equal to C<IPC_PRIVATE>
=item *
C<KEY> does not already have a message queue associated with
it, and C<I<FLAGS> & IPC_CREAT> is true.
=back
On creation of a new message queue C<FLAGS> is used to set the
permissions. Be careful not to set any flags that the Sys V
IPC implementation does not allow: in some systems setting
execute bits makes the operations fail.
=item id
Returns the system message queue identifier.
=item rcv ( BUF, LEN [, TYPE [, FLAGS ]] )
Read a message from the queue. Returns the type of the message read.
See L<msgrcv(2)>. The BUF becomes tainted.
=item remove
Remove and destroy the message queue from the system.
=item set ( STAT )
=item set ( NAME => VALUE [, NAME => VALUE ...] )
C<set> will set the following values of the C<stat> structure associated
with the message queue.
uid
gid
mode (oly the permission bits)
qbytes
C<set> accepts either a stat object, as returned by the C<stat> method,
or a list of I<name>-I<value> pairs.
=item snd ( TYPE, MSG [, FLAGS ] )
Place a message on the queue with the data from C<MSG> and with type C<TYPE>.
See L<msgsnd(2)>.
=item stat
Returns an object of type C<IPC::Msg::stat> which is a sub-class of
C<Class::Struct>. It provides the following fields. For a description
of these fields see you system documentation.
uid
gid
cuid
cgid
mode
qnum
qbytes
lspid
lrpid
stime
rtime
ctime
=back
=head1 SEE ALSO
L<IPC::SysV>, L<Class::Struct>
=head1 AUTHORS
Graham Barr <gbarr@pobox.com>,
Marcus Holland-Moritz <mhx@cpan.org>
=head1 COPYRIGHT
Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz.
Version 1.x, Copyright (c) 1997, Graham Barr.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut

View file

@ -0,0 +1,314 @@
################################################################################
#
# Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz <mhx@cpan.org>.
# Version 1.x, Copyright (C) 1997, Graham Barr <gbarr@pobox.com>.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
package IPC::Semaphore;
use IPC::SysV qw(GETNCNT GETZCNT GETVAL SETVAL GETPID GETALL SETALL
IPC_STAT IPC_SET IPC_RMID);
use strict;
use vars qw($VERSION);
use Carp;
$VERSION = '2.09';
# Figure out if we have support for native sized types
my $N = do { my $foo = eval { pack "L!", 0 }; $@ ? '' : '!' };
{
package IPC::Semaphore::stat;
use Class::Struct qw(struct);
struct 'IPC::Semaphore::stat' => [
uid => '$',
gid => '$',
cuid => '$',
cgid => '$',
mode => '$',
ctime => '$',
otime => '$',
nsems => '$',
];
}
sub new {
@_ == 4 || croak __PACKAGE__ . '->new( KEY, NSEMS, FLAGS )';
my $class = shift;
my $id = semget($_[0],$_[1],$_[2]);
defined($id)
? bless \$id, $class
: undef;
}
sub id {
my $self = shift;
$$self;
}
sub remove {
my $self = shift;
my $result = semctl($$self,0,IPC_RMID,0);
undef $$self;
$result;
}
sub getncnt {
@_ == 2 || croak '$sem->getncnt( SEM )';
my $self = shift;
my $sem = shift;
my $v = semctl($$self,$sem,GETNCNT,0);
$v ? 0 + $v : undef;
}
sub getzcnt {
@_ == 2 || croak '$sem->getzcnt( SEM )';
my $self = shift;
my $sem = shift;
my $v = semctl($$self,$sem,GETZCNT,0);
$v ? 0 + $v : undef;
}
sub getval {
@_ == 2 || croak '$sem->getval( SEM )';
my $self = shift;
my $sem = shift;
my $v = semctl($$self,$sem,GETVAL,0);
$v ? 0 + $v : undef;
}
sub getpid {
@_ == 2 || croak '$sem->getpid( SEM )';
my $self = shift;
my $sem = shift;
my $v = semctl($$self,$sem,GETPID,0);
$v ? 0 + $v : undef;
}
sub op {
@_ >= 4 || croak '$sem->op( OPLIST )';
my $self = shift;
croak 'Bad arg count' if @_ % 3;
my $data = pack("s$N*",@_);
semop($$self,$data);
}
sub stat {
my $self = shift;
my $data = "";
semctl($$self,0,IPC_STAT,$data)
or return undef;
IPC::Semaphore::stat->new->unpack($data);
}
sub set {
my $self = shift;
my $ds;
if(@_ == 1) {
$ds = shift;
}
else {
croak 'Bad arg count' if @_ % 2;
my %arg = @_;
$ds = $self->stat
or return undef;
my($key,$val);
$ds->$key($val)
while(($key,$val) = each %arg);
}
my $v = semctl($$self,0,IPC_SET,$ds->pack);
$v ? 0 + $v : undef;
}
sub getall {
my $self = shift;
my $data = "";
semctl($$self,0,GETALL,$data)
or return ();
(unpack("s$N*",$data));
}
sub setall {
my $self = shift;
my $data = pack("s$N*",@_);
semctl($$self,0,SETALL,$data);
}
sub setval {
@_ == 3 || croak '$sem->setval( SEM, VAL )';
my $self = shift;
my $sem = shift;
my $val = shift;
semctl($$self,$sem,SETVAL,$val);
}
1;
__END__
=head1 NAME
IPC::Semaphore - SysV Semaphore IPC object class
=head1 SYNOPSIS
use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR IPC_CREAT);
use IPC::Semaphore;
$sem = IPC::Semaphore->new(IPC_PRIVATE, 10, S_IRUSR | S_IWUSR | IPC_CREAT);
$sem->setall( (0) x 10);
@sem = $sem->getall;
$ncnt = $sem->getncnt;
$zcnt = $sem->getzcnt;
$ds = $sem->stat;
$sem->remove;
=head1 DESCRIPTION
A class providing an object based interface to SysV IPC semaphores.
=head1 METHODS
=over 4
=item new ( KEY , NSEMS , FLAGS )
Create a new semaphore set associated with C<KEY>. C<NSEMS> is the number
of semaphores in the set. A new set is created if
=over 4
=item *
C<KEY> is equal to C<IPC_PRIVATE>
=item *
C<KEY> does not already have a semaphore identifier
associated with it, and C<I<FLAGS> & IPC_CREAT> is true.
=back
On creation of a new semaphore set C<FLAGS> is used to set the
permissions. Be careful not to set any flags that the Sys V
IPC implementation does not allow: in some systems setting
execute bits makes the operations fail.
=item getall
Returns the values of the semaphore set as an array.
=item getncnt ( SEM )
Returns the number of processes waiting for the semaphore C<SEM> to
become greater than its current value
=item getpid ( SEM )
Returns the process id of the last process that performed an operation
on the semaphore C<SEM>.
=item getval ( SEM )
Returns the current value of the semaphore C<SEM>.
=item getzcnt ( SEM )
Returns the number of processes waiting for the semaphore C<SEM> to
become zero.
=item id
Returns the system identifier for the semaphore set.
=item op ( OPLIST )
C<OPLIST> is a list of operations to pass to C<semop>. C<OPLIST> is
a concatenation of smaller lists, each which has three values. The
first is the semaphore number, the second is the operation and the last
is a flags value. See L<semop(2)> for more details. For example
$sem->op(
0, -1, IPC_NOWAIT,
1, 1, IPC_NOWAIT
);
=item remove
Remove and destroy the semaphore set from the system.
=item set ( STAT )
=item set ( NAME => VALUE [, NAME => VALUE ...] )
C<set> will set the following values of the C<stat> structure associated
with the semaphore set.
uid
gid
mode (only the permission bits)
C<set> accepts either a stat object, as returned by the C<stat> method,
or a list of I<name>-I<value> pairs.
=item setall ( VALUES )
Sets all values in the semaphore set to those given on the C<VALUES> list.
C<VALUES> must contain the correct number of values.
=item setval ( N , VALUE )
Set the C<N>th value in the semaphore set to C<VALUE>
=item stat
Returns an object of type C<IPC::Semaphore::stat> which is a sub-class of
C<Class::Struct>. It provides the following fields. For a description
of these fields see your system documentation.
uid
gid
cuid
cgid
mode
ctime
otime
nsems
=back
=head1 SEE ALSO
L<IPC::SysV>, L<Class::Struct>, L<semget(2)>, L<semctl(2)>, L<semop(2)>
=head1 AUTHORS
Graham Barr <gbarr@pobox.com>,
Marcus Holland-Moritz <mhx@cpan.org>
=head1 COPYRIGHT
Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz.
Version 1.x, Copyright (c) 1997, Graham Barr.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut

View file

@ -0,0 +1,271 @@
################################################################################
#
# Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz <mhx@cpan.org>.
# Version 1.x, Copyright (C) 1997, Graham Barr <gbarr@pobox.com>.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
package IPC::SharedMem;
use IPC::SysV qw(IPC_STAT IPC_RMID shmat shmdt memread memwrite);
use strict;
use vars qw($VERSION);
use Carp;
$VERSION = '2.09';
# Figure out if we have support for native sized types
my $N = do { my $foo = eval { pack "L!", 0 }; $@ ? '' : '!' };
{
package IPC::SharedMem::stat;
use Class::Struct qw(struct);
struct 'IPC::SharedMem::stat' => [
uid => '$',
gid => '$',
cuid => '$',
cgid => '$',
mode => '$',
segsz => '$',
lpid => '$',
cpid => '$',
nattch => '$',
atime => '$',
dtime => '$',
ctime => '$',
];
}
sub new
{
@_ == 4 or croak 'IPC::SharedMem->new(KEY, SIZE, FLAGS)';
my($class, $key, $size, $flags) = @_;
my $id = shmget $key, $size, $flags;
return undef unless defined $id;
bless { _id => $id, _addr => undef, _isrm => 0 }, $class
}
sub id
{
my $self = shift;
$self->{_id};
}
sub addr
{
my $self = shift;
$self->{_addr};
}
sub stat
{
my $self = shift;
my $data = '';
shmctl $self->id, IPC_STAT, $data or return undef;
IPC::SharedMem::stat->new->unpack($data);
}
sub attach
{
@_ >= 1 && @_ <= 2 or croak '$shm->attach([FLAG])';
my($self, $flag) = @_;
defined $self->addr and return undef;
$self->{_addr} = shmat($self->id, undef, $flag || 0);
defined $self->addr;
}
sub detach
{
my $self = shift;
defined $self->addr or return undef;
my $rv = defined shmdt($self->addr);
undef $self->{_addr} if $rv;
$rv;
}
sub remove
{
my $self = shift;
return undef if $self->is_removed;
my $rv = shmctl $self->id, IPC_RMID, 0;
$self->{_isrm} = 1 if $rv;
return $rv;
}
sub is_removed
{
my $self = shift;
$self->{_isrm};
}
sub read
{
@_ == 3 or croak '$shm->read(POS, SIZE)';
my($self, $pos, $size) = @_;
my $buf = '';
if (defined $self->addr) {
memread($self->addr, $buf, $pos, $size) or return undef;
}
else {
shmread($self->id, $buf, $pos, $size) or return undef;
}
$buf;
}
sub write
{
@_ == 4 or croak '$shm->write(STRING, POS, SIZE)';
my($self, $str, $pos, $size) = @_;
if (defined $self->addr) {
return memwrite($self->addr, $str, $pos, $size);
}
else {
return shmwrite($self->id, $str, $pos, $size);
}
}
1;
__END__
=head1 NAME
IPC::SharedMem - SysV Shared Memory IPC object class
=head1 SYNOPSIS
use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR);
use IPC::SharedMem;
$shm = IPC::SharedMem->new(IPC_PRIVATE, 8, S_IRWXU);
$shm->write(pack("S", 4711), 2, 2);
$data = $shm->read(0, 2);
$ds = $shm->stat;
$shm->remove;
=head1 DESCRIPTION
A class providing an object based interface to SysV IPC shared memory.
=head1 METHODS
=over 4
=item new ( KEY , SIZE , FLAGS )
Creates a new shared memory segment of C<SIZE> bytes size associated
with C<KEY>. A new segment is created if
=over 4
=item *
C<KEY> is equal to C<IPC_PRIVATE>
=item *
C<KEY> does not already have a shared memory segment associated
with it, and C<I<FLAGS> & IPC_CREAT> is true.
=back
On creation of a new shared memory segment C<FLAGS> is used to
set the permissions. Be careful not to set any flags that the
Sys V IPC implementation does not allow: in some systems setting
execute bits makes the operations fail.
=item id
Returns the shared memory identifier.
=item read ( POS, SIZE )
Read C<SIZE> bytes from the shared memory segment at C<POS>. Returns
the string read, or C<undef> if there was an error. The return value
becomes tainted. See L<shmread>.
=item write ( STRING, POS, SIZE )
Write C<SIZE> bytes to the shared memory segment at C<POS>. Returns
true if successful, or false if there is an error. See L<shmwrite>.
=item remove
Remove the shared memory segment from the system or mark it as
removed as long as any processes are still attached to it.
=item is_removed
Returns true if the shared memory segment has been removed or
marked for removal.
=item stat
Returns an object of type C<IPC::SharedMem::stat> which is a sub-class
of C<Class::Struct>. It provides the following fields. For a description
of these fields see you system documentation.
uid
gid
cuid
cgid
mode
segsz
lpid
cpid
nattch
atime
dtime
ctime
=item attach ( [FLAG] )
Permanently attach to the shared memory segment. When a C<IPC::SharedMem>
object is attached, it will use L<memread> and L<memwrite> instead of
L<shmread> and L<shmwrite> for accessing the shared memory segment.
Returns true if successful, or false on error. See L<shmat(2)>.
=item detach
Detach from the shared memory segment that previously has been attached
to. Returns true if successful, or false on error. See L<shmdt(2)>.
=item addr
Returns the address of the shared memory that has been attached to in a
format suitable for use with C<pack('P')>. Returns C<undef> if the shared
memory has not been attached.
=back
=head1 SEE ALSO
L<IPC::SysV>, L<Class::Struct>
=head1 AUTHORS
Marcus Holland-Moritz <mhx@cpan.org>
=head1 COPYRIGHT
Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz.
Version 1.x, Copyright (c) 1997, Graham Barr.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut

View file

@ -0,0 +1,180 @@
################################################################################
#
# Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz <mhx@cpan.org>.
# Version 1.x, Copyright (C) 1997, Graham Barr <gbarr@pobox.com>.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
package IPC::SysV;
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $AUTOLOAD);
use Carp;
use Config;
require Exporter;
@ISA = qw(Exporter);
$VERSION = '2.09';
# To support new constants, just add them to @EXPORT_OK
# and the C/XS code will be generated automagically.
@EXPORT_OK = (qw(
GETALL GETNCNT GETPID GETVAL GETZCNT
IPC_ALLOC IPC_CREAT IPC_EXCL IPC_GETACL IPC_INFO IPC_LOCKED
IPC_M IPC_NOERROR IPC_NOWAIT IPC_PRIVATE IPC_R IPC_RMID
IPC_SET IPC_SETACL IPC_SETLABEL IPC_STAT IPC_W IPC_WANTED
MSG_EXCEPT MSG_FWAIT MSG_INFO MSG_LOCKED MSG_MWAIT MSG_NOERROR
MSG_QWAIT MSG_R MSG_RWAIT MSG_STAT MSG_W MSG_WAIT MSG_WWAIT
SEM_A SEM_ALLOC SEM_DEST SEM_ERR SEM_INFO SEM_ORDER SEM_R
SEM_STAT SEM_UNDO
SETALL SETVAL
SHMLBA
SHM_A SHM_CLEAR SHM_COPY SHM_DCACHE SHM_DEST SHM_ECACHE
SHM_FMAP SHM_HUGETLB SHM_ICACHE SHM_INFO SHM_INIT SHM_LOCK
SHM_LOCKED SHM_MAP SHM_NORESERVE SHM_NOSWAP SHM_R SHM_RDONLY
SHM_REMAP SHM_REMOVED SHM_RND SHM_SHARE_MMU SHM_SHATTR
SHM_SIZE SHM_STAT SHM_UNLOCK SHM_W
S_IRUSR S_IWUSR S_IXUSR S_IRWXU
S_IRGRP S_IWGRP S_IXGRP S_IRWXG
S_IROTH S_IWOTH S_IXOTH S_IRWXO
ENOSPC ENOSYS ENOMEM EACCES
), qw(
ftok shmat shmdt memread memwrite
));
%EXPORT_TAGS = (
all => [@EXPORT, @EXPORT_OK],
);
sub AUTOLOAD
{
my $constname = $AUTOLOAD;
$constname =~ s/.*:://;
die "&IPC::SysV::_constant not defined" if $constname eq '_constant';
my ($error, $val) = _constant($constname);
if ($error) {
my (undef, $file, $line) = caller;
die "$error at $file line $line.\n";
}
{
no strict 'refs';
*$AUTOLOAD = sub { $val };
}
goto &$AUTOLOAD;
}
BOOT_XS: {
# If I inherit DynaLoader then I inherit AutoLoader and I DON'T WANT TO
use XSLoader ();
XSLoader::load( 'IPC::SysV', $VERSION );
}
1;
__END__
=head1 NAME
IPC::SysV - System V IPC constants and system calls
=head1 SYNOPSIS
use IPC::SysV qw(IPC_STAT IPC_PRIVATE);
=head1 DESCRIPTION
C<IPC::SysV> defines and conditionally exports all the constants
defined in your system include files which are needed by the SysV
IPC calls. Common ones include
IPC_CREAT IPC_EXCL IPC_NOWAIT IPC_PRIVATE IPC_RMID IPC_SET IPC_STAT
GETVAL SETVAL GETPID GETNCNT GETZCNT GETALL SETALL
SEM_A SEM_R SEM_UNDO
SHM_RDONLY SHM_RND SHMLBA
and auxiliary ones
S_IRUSR S_IWUSR S_IRWXU
S_IRGRP S_IWGRP S_IRWXG
S_IROTH S_IWOTH S_IRWXO
but your system might have more.
=over 4
=item ftok( PATH )
=item ftok( PATH, ID )
Return a key based on PATH and ID, which can be used as a key for
C<msgget>, C<semget> and C<shmget>. See L<ftok(3)>.
If ID is omitted, it defaults to C<1>. If a single character is
given for ID, the numeric value of that character is used.
=item shmat( ID, ADDR, FLAG )
Attach the shared memory segment identified by ID to the address
space of the calling process. See L<shmat(2)>.
ADDR should be C<undef> unless you really know what you're doing.
=item shmdt( ADDR )
Detach the shared memory segment located at the address specified
by ADDR from the address space of the calling process. See L<shmdt(2)>.
=item memread( ADDR, VAR, POS, SIZE )
Reads SIZE bytes from a memory segment at ADDR starting at position POS.
VAR must be a variable that will hold the data read. Returns true if
successful, or false if there is an error. memread() taints the variable.
=item memwrite( ADDR, STRING, POS, SIZE )
Writes SIZE bytes from STRING to a memory segment at ADDR starting at
position POS. If STRING is too long, only SIZE bytes are used; if STRING
is too short, nulls are written to fill out SIZE bytes. Returns true if
successful, or false if there is an error.
=back
=head1 SEE ALSO
L<IPC::Msg>, L<IPC::Semaphore>, L<IPC::SharedMem>, L<ftok(3)>, L<shmat(2)>, L<shmdt(2)>
=head1 AUTHORS
Graham Barr <gbarr@pobox.com>,
Jarkko Hietaniemi <jhi@iki.fi>,
Marcus Holland-Moritz <mhx@cpan.org>
=head1 COPYRIGHT
Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz.
Version 1.x, Copyright (c) 1997, Graham Barr.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut