Front page | perl.perl5.porters |
Postings from November 2013
[perl #120635] Perl 64 bit big-endian semctl SETVAL bug
Thread Previous
From:
perlbug-followup
Date:
November 26, 2013 19:34
Subject:
[perl #120635] Perl 64 bit big-endian semctl SETVAL bug
Message ID:
rt-4.0.18-32414-1385491097-39.120635-75-0@perl.org
# New Ticket Created by
# Please include the string: [perl #120635]
# in the subject line of all future correspondence about this issue.
# <URL: https://rt.perl.org/Ticket/Display.html?id=120635 >
This is a bug report for perl from brian@rentec.com,
generated with the help of perlbug 1.39 running under perl 5.16.0.
-----------------------------------------------------------------
[Please describe your issue here]
calls to semctl(id,semnum,SETVAL,$wantedval)
On 64 bit big-endian boxes, will ignore the passed
in $wantedval, and always use 0
Here's a script that shows the bug in action....
=================
use strict;
use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR IPC_CREAT IPC_RMID SETALL SETVAL GETALL);
my $nsem = 10;
my $id = semget(IPC_PRIVATE, $nsem, S_IRUSR | S_IWUSR | IPC_CREAT);
my $ret = semctl($id, "ignore", SETALL, pack("s!*",(0)x$nsem));
warn "semctl setall: $!\n" unless(defined($ret));
$ret = semctl($id, 3, SETVAL, 17);
warn "semctl setval: $!\n" unless(defined($ret));
my $semvals;
$ret = semctl($id, "ignore", GETALL, $semvals);
if(!defined($ret))
{
warn "semctl GETALL: $!\n" unless(defined($ret));
}
else
{
my @semvals = unpack("s!*", $semvals);
print "semvals=@semvals\n";
}
$ret = semctl($id, "ignored", IPC_RMID, "ignored");
die "semctl rmid: $!\n" unless(defined($ret));
=================
On a linux 64 bit box, the output is correct:
semvals=0 0 0 17 0 0 0 0 0 0
On solaris 64 bit box, this is the output:
semvals=0 0 0 0 0 0 0 0 0 0
when I truss the perl process I see this:
semctl(100, 3, SETVAL, 0) = 0
I looked into it, and I think I found the problem:
The problem begins in union semun, defined as...
union semun {
int val; /* Value for SETVAL */
struct semid_ds *buf; /* Buffer for IPC_STAT, IPC_SET */
unsigned short *array; /* Array for GETALL, SETALL */
};
In a 64 bit build, val will be a 32 bit signed integer.
It will share the first 32 bits of buf.
In the perl code, doio.c:2128, we have...
const IV i = SvIV(astr);
a = INT2PTR(char *,i); /* ouch */
That takes the passed in 17, and coerces it into a char*,
and assigns it to "a"
Finally, doio.c:2147 does
unsemds.buf = (struct semid_ds *)a;
Now, on little endian (intel linux) boxes, val gets set to the lower
32bits of a, and things work pretty much like we want.
On a big endian box (Sun Sparc), val gets set to the upper 32 bits,
which are all zeros, and it does not do what we want.
Here's a patch against the git tree...
>From 1752788b779244024f086167a5517d50aa6af5bc Mon Sep 17 00:00:00 2001
From: Brian Childs <brian@rentec.com>
Date: Tue, 26 Nov 2013 13:12:30 -0500
Subject: [PATCH] Fixes the case where on 64bit big-endian boxes, calls to
semctl(id,semnum,SETVAL,$wantedval) will ignore the passed
in $wantedval, and always use 0
---
doio.c | 9 +++++++--
1 file changed, 7 insertions(+), 2 deletions(-)
diff --git a/doio.c b/doio.c
index 3ee975d..e7e90d3 100644
--- a/doio.c
+++ b/doio.c
@@ -2141,11 +2141,16 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
#ifdef Semctl
union semun unsemds;
+ if(cmd == SETVAL) {
+ unsemds.val = PTR2nat(a);
+ }
+ else {
#ifdef EXTRA_F_IN_SEMUN_BUF
- unsemds.buff = (struct semid_ds *)a;
+ unsemds.buff = (struct semid_ds *)a;
#else
- unsemds.buf = (struct semid_ds *)a;
+ unsemds.buf = (struct semid_ds *)a;
#endif
+ }
ret = Semctl(id, n, cmd, unsemds);
#else
/* diag_listed_as: sem%s not implemented */
--
1.7.10.4
[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=core
severity=medium
---
This perlbug was built using Perl 5.16.0 - Mon Mar 11 10:57:50 UTC 2013
It is being executed now by Perl 5.16.0 - Mon Mar 11 10:54:42 UTC 2013.
Site configuration information for perl 5.16.0:
Configured by abuild at Mon Mar 11 10:54:42 UTC 2013.
Summary of my perl5 (revision 5 version 16 subversion 0) configuration:
Platform:
osname=linux, osvers=3.4.6-2.10-default, archname=x86_64-linux-thread-multi
uname='linux build30 3.4.6-2.10-default #1 smp thu jul 26 09:36:26 utc 2012 (641c197) x86_64 x86_64 x86_64 gnulinux '
config_args='-ds -e -Dprefix=/usr -Dvendorprefix=/usr -Dinstallusrbinperl -Dusethreads -Di_db -Di_dbm -Di_ndbm -Di_gdbm -Dd_dbm_open -Duseshrplib=true -Doptimize=-fmessage-length=0 -O2 -Wall -D_FORTIFY_SOURCE=2 -fstack-protector -funwind-tables -fasynchronous-unwind-tables -g -Wall -pipe -Accflags=-DPERL_USE_SAFE_PUTENV -Dotherlibdirs=/usr/lib/perl5/site_perl'
hint=recommended, useposix=true, d_sigaction=define
useithreads=define, usemultiplicity=define
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
use64bitint=define, use64bitall=define, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DPERL_USE_SAFE_PUTENV -fno-strict-aliasing -pipe -fstack-protector -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-fmessage-length=0 -O2 -Wall -D_FORTIFY_SOURCE=2 -fstack-protector -funwind-tables -fasynchronous-unwind-tables -g -Wall -pipe',
cppflags='-D_REENTRANT -D_GNU_SOURCE -DPERL_USE_SAFE_PUTENV -fno-strict-aliasing -pipe -fstack-protector'
ccversion='', gccversion='4.7.1 20120723 [gcc-4_7-branch revision 189773]', gccosandvers=''
intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -L/usr/local/lib64 -fstack-protector'
libpth=/lib64 /usr/lib64 /usr/local/lib64
libs=-lm -ldl -lcrypt -lpthread
perllibs=-lm -ldl -lcrypt -lpthread
libc=/lib64/libc-2.15.so, so=so, useshrplib=true, libperl=libperl.so
gnulibc_version='2.15'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/lib/perl5/5.16.0/x86_64-linux-thread-multi/CORE'
cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib64 -fstack-protector'
Locally applied patches:
---
@INC for perl 5.16.0:
/usr/lib/perl5/site_perl/5.16.0/x86_64-linux-thread-multi
/usr/lib/perl5/site_perl/5.16.0
/usr/lib/perl5/vendor_perl/5.16.0/x86_64-linux-thread-multi
/usr/lib/perl5/vendor_perl/5.16.0
/usr/lib/perl5/5.16.0/x86_64-linux-thread-multi
/usr/lib/perl5/5.16.0
/usr/lib/perl5/site_perl/5.16.0/x86_64-linux-thread-multi
/usr/lib/perl5/site_perl/5.16.0
/usr/lib/perl5/site_perl
.
---
Environment for perl 5.16.0:
HOME=/home/brian
LANG=en_US.UTF-8
LANGUAGE (unset)
LD_LIBRARY_PATH=/usr/lib64/mpi/gcc/openmpi/lib64
LOGDIR (unset)
PATH=/usr/lib64/mpi/gcc/openmpi/bin:/home/brian/bin:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/X11R6/bin:/usr/games:/opt/kde3/bin:/usr/lib/mit/bin:/usr/lib/mit/sbin
PERL_BADLANG (unset)
SHELL=/bin/bash
Thread Previous