diff options
| -rw-r--r-- | doio.c | 4 | ||||
| -rw-r--r-- | ext/IPC/SysV/Msg.pm | 14 | ||||
| -rw-r--r-- | pod/perldelta.pod | 9 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 27 | ||||
| -rw-r--r-- | pod/perlipc.pod | 67 | ||||
| -rw-r--r-- | pod/perlsec.pod | 17 | ||||
| -rwxr-xr-x | t/lib/ipc_sysv.t | 10 | ||||
| -rwxr-xr-x | t/op/taint.t | 54 |
8 files changed, 138 insertions, 64 deletions
@@ -1926,6 +1926,10 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) 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 diff --git a/ext/IPC/SysV/Msg.pm b/ext/IPC/SysV/Msg.pm index 099329826f..120a5b2d3a 100644 --- a/ext/IPC/SysV/Msg.pm +++ b/ext/IPC/SysV/Msg.pm @@ -90,14 +90,14 @@ sub rcv { 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); } @@ -111,12 +111,12 @@ IPC::Msg - SysV Msg IPC object class =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); @@ -157,8 +157,8 @@ 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> +Read a message from the queue. Returns the type of the message read. +See L<msgrcv>. The BUF becomes tainted. =item remove diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 52a6fba599..d4d82f3c2d 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -212,11 +212,12 @@ Because the user can affect her own encrypted password and login shell 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 diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index cc84d737ce..2c96d1d310 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -2497,22 +2497,25 @@ Calls the System V IPC function msgget(2). Returns the message queue 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 diff --git a/pod/perlipc.pod b/pod/perlipc.pod index a9c7e48106..8760257821 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -1305,16 +1305,16 @@ you weren't wanting it to. 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. @@ -1322,16 +1322,16 @@ Here's a small example showing shared memory usage. 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>: @@ -1339,8 +1339,8 @@ 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; @@ -1348,14 +1348,14 @@ Call the file F<take>: # '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>: @@ -1365,22 +1365,53 @@ 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 diff --git a/pod/perlsec.pod b/pod/perlsec.pod index b271f7016c..4185e84803 100644 --- a/pod/perlsec.pod +++ b/pod/perlsec.pod @@ -33,14 +33,15 @@ You may not use data derived from outside your program to affect 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. diff --git a/t/lib/ipc_sysv.t b/t/lib/ipc_sysv.t index e2ffd76ff1..a4f3e3f367 100755 --- a/t/lib/ipc_sysv.t +++ b/t/lib/ipc_sysv.t @@ -23,8 +23,7 @@ BEGIN { # 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"; @@ -55,12 +54,7 @@ EOM 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' && diff --git a/t/op/taint.t b/t/op/taint.t index 51dcbd8e5b..c32a1c41fb 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -94,7 +94,7 @@ print PROG 'print "@ARGV\n"', "\n"; 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 @@ -614,11 +614,11 @@ else { 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"; @@ -626,7 +626,9 @@ else { } 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) { @@ -635,6 +637,44 @@ else { 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"; + } +} + |