if (ret >= 0) {
SvCUR_set(mstr, sizeof(long)+ret);
*SvEND(mstr) = '\0';
+#ifndef INCOMPLETE_TAINTS
+ /* who knows who has been playing with this message? */
+ SvTAINTED_on(mstr);
+#endif
}
return ret;
#else
msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or
return;
my $type;
- ($type,$_[0]) = unpack("L a*",$buf);
+ ($type,$_[0]) = unpack("l! a*",$buf);
$type;
}
sub snd {
@_ <= 4 && @_ >= 3 or croak '$msg->snd( TYPE, BUF, FLAGS )';
my $self = shift;
- msgsnd($$self,pack("L a*",$_[0],$_[1]), $_[2] || 0);
+ msgsnd($$self,pack("l! a*",$_[0],$_[1]), $_[2] || 0);
}
=head1 SYNOPSIS
- use IPC::SysV qw(IPC_PRIVATE S_IRWXU S_IRWXG S_IRWXO);
+ use IPC::SysV qw(IPC_PRIVATE S_IRWXU);
use IPC::Msg;
- $msg = new IPC::Msg(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO);
+ $msg = new IPC::Msg(IPC_PRIVATE, S_IRWXU);
- $msg->snd(pack("L a*",$msgtype,$msg));
+ $msg->snd(pack("l! a*",$msgtype,$msg));
$msg->rcv($buf,256);
=item rcv ( BUF, LEN [, TYPE [, FLAGS ]] )
-Read a message from the queue. Returns the type of the message read. See
-L<msgrcv>
+Read a message from the queue. Returns the type of the message read.
+See L<msgrcv>. The BUF becomes tainted.
=item remove
the password and shell returned by the getpwent(), getpwnam(), and
getpwuid() functions are tainted.
-=head2 The shmread() now taints its variable
+=head2 The msgrcv() and shmread() now taint
-Because other (untrusted) processes can modify shared memory segments
-for their own nefarious purposes, the variable modified by shmread()
-becomes tainted.
+Because other (untrusted) processes can modify messages and shared
+memory segments for their own nefarious purposes, the messages
+returned by msgrcv() (and its object-oriented interface,
+IPC::SysV::Msg::rcv) and the variable modified by shmread() are tainted.
=back
id, or the undefined value if there is an error. See also C<IPC::SysV>
and C<IPC::Msg> documentation.
-=item msgsnd ID,MSG,FLAGS
-
-Calls the System V IPC function msgsnd to send the message MSG to the
-message queue ID. MSG must begin with the native long integer message
-type, which may be created with C<pack("l!", $type)>. Returns true if
-successful, or false if there is an error. See also C<IPC::SysV> and
-C<IPC::SysV::Msg> documentation.
-
=item msgrcv ID,VAR,SIZE,TYPE,FLAGS
Calls the System V IPC function msgrcv to receive a message from
message queue ID into variable VAR with a maximum message size of
-SIZE. Note that if a message is received, the message type will be
-the first thing in VAR, and the maximum length of VAR is SIZE plus the
-size of the message type. Returns true if successful, or false if
-there is an error. See also C<IPC::SysV> and C<IPC::SysV::Msg> documentation.
+SIZE. Note that when a message is received, the message type as a
+native long integer will be the first thing in VAR, followed by the
+actual message. This packing may be opened with C<unpack("l! a*")>.
+Taints the variable. Returns true if successful, or false if there is
+an error. See also C<IPC::SysV> and C<IPC::SysV::Msg> documentation.
+
+=item msgsnd ID,MSG,FLAGS
+
+Calls the System V IPC function msgsnd to send the message MSG to the
+message queue ID. MSG must begin with the native long integer message
+type, and be followed by the length of the actual message, and finally
+the message itself. This kind of packing can be achieved with
+C<pack("l! a*", $type, $message)>. Returns true if successful,
+or false if there is an error. See also C<IPC::SysV>
+and C<IPC::SysV::Msg> documentation.
=item my EXPR
Here's a small example showing shared memory usage.
- use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU S_IRWXG S_IRWXO);
+ use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU);
$size = 2000;
- $key = shmget(IPC_PRIVATE, $size, S_IRWXU|S_IRWXG|S_IRWXO) || die "$!";
- print "shm key $key\n";
+ $id = shmget(IPC_PRIVATE, $size, S_IRWXU) || die "$!";
+ print "shm key $id\n";
$message = "Message #1";
- shmwrite($key, $message, 0, 60) || die "$!";
+ shmwrite($id, $message, 0, 60) || die "$!";
print "wrote: '$message'\n";
- shmread($key, $buff, 0, 60) || die "$!";
+ shmread($id, $buff, 0, 60) || die "$!";
print "read : '$buff'\n";
# the buffer of shmread is zero-character end-padded.
print "un" unless $buff eq $message;
print "swell\n";
- print "deleting shm $key\n";
- shmctl($key, IPC_RMID, 0) || die "$!";
+ print "deleting shm $id\n";
+ shmctl($id, IPC_RMID, 0) || die "$!";
Here's an example of a semaphore:
use IPC::SysV qw(IPC_CREAT);
$IPC_KEY = 1234;
- $key = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
- print "shm key $key\n";
+ $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
+ print "shm key $id\n";
Put this code in a separate file to be run in more than one process.
Call the file F<take>:
# create a semaphore
$IPC_KEY = 1234;
- $key = semget($IPC_KEY, 0 , 0 );
- die if !defined($key);
+ $id = semget($IPC_KEY, 0 , 0 );
+ die if !defined($id);
$semnum = 0;
$semflag = 0;
# 'take' semaphore
# wait for semaphore to be zero
$semop = 0;
- $opstring1 = pack("sss", $semnum, $semop, $semflag);
+ $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);
# Increment the semaphore count
$semop = 1;
- $opstring2 = pack("sss", $semnum, $semop, $semflag);
+ $opstring2 = pack("s!s!s!", $semnum, $semop, $semflag);
$opstring = $opstring1 . $opstring2;
- semop($key,$opstring) || die "$!";
+ semop($id,$opstring) || die "$!";
Put this code in a separate file to be run in more than one process.
Call this file F<give>:
# that the second process continues
$IPC_KEY = 1234;
- $key = semget($IPC_KEY, 0, 0);
- die if !defined($key);
+ $id = semget($IPC_KEY, 0, 0);
+ die if !defined($id);
$semnum = 0;
$semflag = 0;
# Decrement the semaphore count
$semop = -1;
- $opstring = pack("sss", $semnum, $semop, $semflag);
+ $opstring = pack("s!s!s!", $semnum, $semop, $semflag);
- semop($key,$opstring) || die "$!";
+ semop($id,$opstring) || die "$!";
The SysV IPC code above was written long ago, and it's definitely
clunky looking. For a more modern look, see the IPC::SysV module
which is included with Perl starting from Perl 5.005.
+A small example demonstrating SysV message queues:
+
+ use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU);
+
+ my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU);
+
+ my $sent = "message";
+ my $type = 1234;
+ my $rcvd;
+ my $type_rcvd;
+
+ if (defined $id) {
+ if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
+ if (msgrcv($id, $rcvd, 60, 0, 0)) {
+ ($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
+ if ($rcvd eq $sent) {
+ print "okay\n";
+ } else {
+ print "not okay\n";
+ }
+ } else {
+ die "# msgrcv failed\n";
+ }
+ } else {
+ die "# msgsnd failed\n";
+ }
+ msgctl($id, IPC_RMID, 0) || die "# msgctl failed: $!\n";
+ } else {
+ die "# msgget failed\n";
+ }
+
=head1 NOTES
Most of these routines quietly but politely return C<undef> when they
something else outside your program--at least, not by accident. All
command line arguments, environment variables, locale information (see
L<perllocale>), results of certain system calls (readdir(),
-readlink(), the variable of() shmread, the password, gcos and shell
-fields of the getpwxxx() calls), and all file input are marked as
-"tainted". Tainted data may not be used directly or indirectly in any
-command that invokes a sub-shell, nor in any command that modifies
-files, directories, or processes. (B<Important exception>: If you pass
-a list of arguments to either C<system> or C<exec>, the elements of
-that list are B<NOT> checked for taintedness.) Any variable set to a
-value derived from tainted data will itself be tainted, even if it is
+readlink(), the variable of shmread(), the messages returned by
+msgrcv(), the password, gcos and shell fields returned by the
+getpwxxx() calls), and all file input are marked as "tainted".
+Tainted data may not be used directly or indirectly in any command
+that invokes a sub-shell, nor in any command that modifies files,
+directories, or processes. (B<Important exception>: If you pass a list
+of arguments to either C<system> or C<exec>, the elements of that list
+are B<NOT> checked for taintedness.) Any variable set to a value
+derived from tainted data will itself be tainted, even if it is
logically impossible for the tainted data to alter the variable.
Because taintedness is associated with each scalar value, some
elements of an array can be tainted and others not.
# These constants are common to all tests.
# Later the sem* tests will import more for themselves.
-use IPC::SysV qw(IPC_PRIVATE IPC_NOWAIT IPC_STAT IPC_RMID
- S_IRWXU S_IRWXG S_IRWXO S_IWGRP S_IROTH S_IWOTH);
+use IPC::SysV qw(IPC_PRIVATE IPC_NOWAIT IPC_STAT IPC_RMID S_IRWXU);
use strict;
print "1..16\n";
exit(1);
};
-my $perm;
-
-$perm = S_IRWXU | S_IRWXG | S_IRWXO | S_IWGRP | S_IROTH | S_IWOTH
- if $^O eq 'vmesa';
-
-$perm = S_IRWXU | S_IRWXG | S_IRWXO unless defined $perm;
+my $perm = S_IRWXU;
if ($Config{'d_msgget'} eq 'define' &&
$Config{'d_msgctl'} eq 'define' &&
close PROG;
my $echo = "$Invoke_Perl $ECHO";
-print "1..150\n";
+print "1..151\n";
# First, let's make sure that Perl is checking the dangerous
# environment variables. Maybe they aren't set yet, so we'll
my $sent = "foobar";
my $rcvd;
my $size = 2000;
- my $key = shmget(IPC_PRIVATE, $size, S_IRWXU|S_IRWXG|S_IRWXO) ||
+ my $id = shmget(IPC_PRIVATE, $size, S_IRWXU|S_IRWXG|S_IRWXO) ||
warn "# shmget failed: $!\n";
- if ($key >= 0) {
- if (shmwrite($key, $sent, 0, 60)) {
- if (shmread($key, $rcvd, 0, 60)) {
+ if (defined $id) {
+ if (shmwrite($id, $sent, 0, 60)) {
+ if (shmread($id, $rcvd, 0, 60)) {
substr($rcvd, index($rcvd, "\0")) = '';
} else {
warn "# shmread failed: $!\n";
} else {
warn "# shmwrite failed: $!\n";
}
- shmctl($key, IPC_RMID, 0) || warn "# shmctl failed: $!\n";
+ shmctl($id, IPC_RMID, 0) || warn "# shmctl failed: $!\n";
+ } else {
+ warn "# shmget failed: $!\n";
}
if ($rcvd eq $sent) {
print "ok 150 # Skipped: SysV shared memory operation failed\n";
}
} else {
- for (150) { print "ok $_ # Skipped: SysV shared memory is not available\n"; }
+ print "ok 150 # Skipped: SysV shared memory is not available\n";
}
}
+
+# test msgrcv
+{
+ if ($Config{d_msg}) {
+ use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU);
+
+ my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU);
+
+ my $sent = "message";
+ my $type_sent = 1234;
+ my $rcvd;
+ my $type_rcvd;
+
+ if (defined $id) {
+ if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
+ if (msgrcv($id, $rcvd, 60, 0, 0)) {
+ ($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
+ } else {
+ warn "# msgrcv failed\n";
+ }
+ } else {
+ warn "# msgsnd failed\n";
+ }
+ msgctl($id, IPC_RMID, 0) || warn "# msgctl failed: $!\n";
+ } else {
+ warn "# msgget failed\n";
+ }
+
+ if ($rcvd eq $sent && $type_sent == $type_rcvd) {
+ test 151, tainted $rcvd;
+ } else {
+ print "ok 151 # Skipped: SysV message queue operation failed\n";
+ }
+ } else {
+ print "ok 151 # Skipped: SysV message queues are not available\n";
+ }
+}
+
projects / p5sagit/p5-mst-13.2.git / commitdiff