flipper has asked for the wisdom of the Perl Monks concerning the following question:
Hi Monks,
I recently came across a very strange problem where fcntl() would fail if I had previously used a string eval - I worked around it by doing a require instead, but I'd be interested to hear an explanation of what's going on...
Without the eval, the program below produces output:
root@geedorah:~# perl foo.pl
eval error - ''
lock says: 0 but true
unlock says: 0 but true
If I do the string eval, I get:
included by eval at (eval 1) line 2.
eval error - ''
lock says: UNDEFINED - Invalid argument
unlock says: 0 but true
Any suggestions or explanations welcome...
#!/usr/bin/perl -w
use strict;
use Fcntl qw(:DEFAULT :seek);
use 5.10.0;
our @extraoptions = ();
my %fh;
my $str = "#push \@extraoptions, '--bvtonly';\npush \@extraoptions, '-
+-debug';warn 'included by eval'";
1 && eval($str);
print "eval error - '$@'\n";
doit();
exit;
sub doit {
my $file = '/tmp/z';
say "lock says: ".(lockf($file) // "UNDEFINED - $!");
say "unlock says: ".(unlockf($file) // "UNDEFINED - $!");
}
sub lockf {
my $version = shift;
open $fh{$version}, ">>$version" or die;
my $flags = pack('sslli', F_WRLCK, SEEK_SET, 0, 0);# struct fl
+ock from fcntl - flock doesn't work on NFS
return fcntl($fh{$version}, F_SETLK, $flags);
}
sub unlockf {
my $version = shift;
if($fh{$version}){
my $flags = pack('sslli', F_UNLCK, SEEK_SET, 0, 0);# s
+truct flock from fcntl - flock doesn't work on NFS
my $ret= fcntl($fh{$version}, F_SETLK, $flags);
delete $fh{$version};
return $ret;
}else{
die "Cannot release lock I don't hold for $version!";
}
}
root@geedorah:~# perl -V
Summary of my perl5 (revision 5 version 10 subversion 1) configuration
+:
Platform:
osname=linux, osvers=2.6.32-5-amd64, archname=x86_64-linux-gnu-thr
+ead-multi
uname='linux brahms 2.6.32-5-amd64 #1 smp tue jun 14 09:42:28 utc
+2011 x86_64 gnulinux '
config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dccc
+dlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/us
+r/share/perl/5.10 -Darchlib=/usr/lib/perl/5.10 -Dvendorprefix=/usr -D
+vendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/
+usr/local -Dsitelib=/usr/local/share/perl/5.10.1 -Dsitearch=/usr/loca
+l/lib/perl/5.10.1 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/
+man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/m
+an/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -
+Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -DDEBUGGING=-g -Doptimize=-
+O2 -Duseshrplib -Dlibperl=libperl.so.5.10.1 -Dd_dosuid -des'
hint=recommended, useposix=true, d_sigaction=define
useithreads=define, usemultiplicity=define
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=und
+ef
use64bitint=define, use64bitall=define, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict
+-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_S
+OURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2 -g',
cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing
+ -pipe -fstack-protector -I/usr/local/include'
ccversion='', gccversion='4.4.5', gccosandvers=''
intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=1
+6
ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t',
+ lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib /lib64 /usr/lib64
libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
perllibs=-ldl -lm -lpthread -lc -lcrypt
libc=/lib/libc-2.11.2.so, so=so, useshrplib=true, libperl=libperl.
+so.5.10.1
gnulibc_version='2.11.2'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/lib -fs
+tack-protector'
Characteristics of this binary (from libperl):
Compile-time options: MULTIPLICITY PERL_DONT_CREATE_GVSV
PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP USE_64_
+BIT_ALL
USE_64_BIT_INT USE_ITHREADS USE_LARGE_FILES
USE_PERLIO USE_REENTRANT_API
Locally applied patches:
DEBPKG:debian/arm_thread_stress_timeout - http://bugs.debian.o
+rg/501970 Raise the timeout of ext/threads/shared/t/stress.t to accom
+modate slower build hosts
DEBPKG:debian/cpan_config_path - Set location of CPAN::Config
+to /etc/perl as /usr may not be writable.
DEBPKG:debian/cpan_definstalldirs - Provide a sensible INSTALL
+DIRS default for modules installed from CPAN.
DEBPKG:debian/db_file_ver - http://bugs.debian.org/340047 Remo
+ve overly restrictive DB_File version check.
DEBPKG:debian/doc_info - Replace generic man(1) instructions w
+ith Debian-specific information.
DEBPKG:debian/enc2xs_inc - http://bugs.debian.org/290336 Tweak
+ enc2xs to follow symlinks and ignore missing @INC directories.
DEBPKG:debian/errno_ver - http://bugs.debian.org/343351 Remove
+ Errno version check due to upgrade problems with long-running proces
+ses.
DEBPKG:debian/extutils_hacks - Various debian-specific ExtUtil
+s changes
DEBPKG:debian/fakeroot - Postpone LD_LIBRARY_PATH evaluation t
+o the binary targets.
DEBPKG:debian/instmodsh_doc - Debian policy doesn't install .p
+acklist files for core or vendor.
DEBPKG:debian/ld_run_path - Remove standard libs from LD_RUN_P
+ATH as per Debian policy.
DEBPKG:debian/libnet_config_path - Set location of libnet.cfg
+to /etc/perl/Net as /usr may not be writable.
DEBPKG:debian/m68k_thread_stress - http://bugs.debian.org/4958
+26 Disable some threads tests on m68k for now due to missing TLS.
DEBPKG:debian/mod_paths - Tweak @INC ordering for Debian
DEBPKG:debian/module_build_man_extensions - http://bugs.debian
+.org/479460 Adjust Module::Build manual page extensions for the Debia
+n Perl policy
DEBPKG:debian/perl_synopsis - http://bugs.debian.org/278323 Re
+arrange perl.pod
DEBPKG:debian/prune_libs - http://bugs.debian.org/128355 Prune
+ the list of libraries wanted to what we actually need.
DEBPKG:debian/use_gdbm - Explicitly link against -lgdbm_compat
+ in ODBM_File/NDBM_File.
DEBPKG:fixes/assorted_docs - http://bugs.debian.org/443733 [38
+4f06a] Math::BigInt::CalcEmu documentation grammar fix
DEBPKG:fixes/net_smtp_docs - http://bugs.debian.org/100195 [rt
+.cpan.org #36038] Document the Net::SMTP 'Port' option
DEBPKG:fixes/processPL - http://bugs.debian.org/357264 [rt.cpa
+n.org #17224] Always use PERLRUNINST when building perl modules.
DEBPKG:debian/perlivp - http://bugs.debian.org/510895 Make per
+livp skip include directories in /usr/local
DEBPKG:fixes/pod2man-index-backslash - http://bugs.debian.org/
+521256 Escape backslashes in .IX entries
DEBPKG:debian/disable-zlib-bundling - Disable zlib bundling in
+ Compress::Raw::Zlib
DEBPKG:fixes/kfreebsd_cppsymbols - http://bugs.debian.org/5330
+98 [3b910a0] Add gcc predefined macros to $Config{cppsymbols} on GNU/
+kFreeBSD.
DEBPKG:debian/cpanplus_definstalldirs - http://bugs.debian.org
+/533707 Configure CPANPLUS to use the site directories by default.
DEBPKG:debian/cpanplus_config_path - Save local versions of CP
+ANPLUS::Config::System into /etc/perl.
DEBPKG:fixes/kfreebsd-filecopy-pipes - http://bugs.debian.org/
+537555 [16f708c] Fix File::Copy::copy with pipes on GNU/kFreeBSD
DEBPKG:fixes/anon-tmpfile-dir - http://bugs.debian.org/528544
+[perl #66452] Honor TMPDIR when open()ing an anonymous temporary file
DEBPKG:fixes/abstract-sockets - http://bugs.debian.org/329291
+[89904c0] Add support for Abstract namespace sockets.
DEBPKG:fixes/hurd_cppsymbols - http://bugs.debian.org/544307 [
+eeb92b7] Add gcc predefined macros to $Config{cppsymbols} on GNU/Hurd
+.
DEBPKG:fixes/autodie-flock - http://bugs.debian.org/543731 All
+ow for flock returning EAGAIN instead of EWOULDBLOCK on linux/parisc
DEBPKG:fixes/archive-tar-instance-error - http://bugs.debian.o
+rg/539355 [rt.cpan.org #48879] Separate Archive::Tar instance error s
+trings from each other
DEBPKG:fixes/positive-gpos - http://bugs.debian.org/545234 [pe
+rl #69056] [c584a96] Fix \G crash on first match
DEBPKG:debian/devel-ppport-ia64-optim - http://bugs.debian.org
+/548943 Work around an ICE on ia64
DEBPKG:fixes/trie-logic-match - http://bugs.debian.org/552291
+[perl #69973] [0abd0d7] Fix a DoS in Unicode processing [CVE-2009-362
+6]
DEBPKG:fixes/hppa-thread-eagain - http://bugs.debian.org/55421
+8 make the threads-shared test suite more robust, fixing failures on
+hppa
DEBPKG:fixes/crash-on-undefined-destroy - http://bugs.debian.o
+rg/564074 [perl #71952] [1f15e67] Fix a NULL pointer dereference when
+ looking for a DESTROY method
DEBPKG:fixes/tainted-errno - http://bugs.debian.org/574129 [pe
+rl #61976] [be1cf43] fix an errno stringification bug in taint mode
DEBPKG:fixes/safe-upgrade - http://bugs.debian.org/582978 Upgr
+ade Safe.pm to 2.25, fixing CVE-2010-1974
DEBPKG:fixes/tell-crash - http://bugs.debian.org/578577 [f4817
+f3] Fix a tell() crash on bad arguments.
DEBPKG:fixes/format-write-crash - http://bugs.debian.org/57953
+7 [perl #22977] [421f30e] Fix a crash in format/write
DEBPKG:fixes/arm-alignment - http://bugs.debian.org/289884 [f1
+c7503] Prevent gcc from optimizing the alignment test away on armel
DEBPKG:fixes/fcgi-test - Fix a failure in CGI/t/fast.t when FC
+GI is installed
DEBPKG:fixes/hurd-ccflags - http://bugs.debian.org/587901 Make
+ hints/gnu.sh append to $ccflags rather than overriding them
DEBPKG:debian/squelch-locale-warnings - http://bugs.debian.org
+/508764 Squelch locale warnings in Debian package maintainer scripts
DEBPKG:fixes/lc-numeric-docs - http://bugs.debian.org/379329 [
+perl #78452] [903eb63] LC_NUMERIC documentation fixes
DEBPKG:fixes/lc-numeric-sprintf - http://bugs.debian.org/60154
+9 [perl #78632] [b3fd614] Fix sprintf not to ignore LC_NUMERIC with c
+onstants
DEBPKG:fixes/concat-stack-corruption - http://bugs.debian.org/
+596105 [perl #78674] [e3393f5] Fix stack pointer corruption in pp_con
+cat() with 'use encoding'
DEBPKG:fixes/cgi-multiline-header - http://bugs.debian.org/606
+995 [CVE-2010-2761 CVE-2010-4410 CVE-2010-4411] CGI.pm MIME boundary
+and multiline header vulnerabilities
DEBPKG:fixes/casing-taint-cve-2011-1487 - http://bugs.debian.o
+rg/622817 [perl #87336] fix unwanted taint laundering in lc(), uc() e
+t al.
DEBPKG:fixes/safe-reval-rdo-cve-2010-1447 - [PATCH] Wrap by de
+fault coderefs returned by rdo and reval
DEBPKG:patchlevel - http://bugs.debian.org/567489 List package
+d patches for 5.10.1-17squeeze2 in patchlevel.h
Built under linux
Compiled at Jun 30 2011 22:28:00
@INC:
/etc/perl
/usr/local/lib/perl/5.10.1
/usr/local/share/perl/5.10.1
/usr/lib/perl5
/usr/share/perl5
/usr/lib/perl/5.10
/usr/share/perl/5.10
/usr/local/lib/site_perl
.
root@geedorah:~#
Re: fcntl failure after eval
by Animator (Hermit) on Aug 11, 2011 at 15:04 UTC
|
I ran your code on my system with perl-5.10.0, perl-5.11.0, perl-5.11.3, perl-5.11.4, perl-5.12.0 and perl-5.13.8 and all behave as expected.
I also tested it on another debian machine with perl-5.10.0 and that behaves as expected as well.
This of course does not tell that much since you are using perl-5.10.1 with different ./Configure options and with different patches...
What I suggest: install strace and strace the program to see what the system fcntl call really returns.
A second suggestion, maybe more complex, is to install a stock perl-5.10.1 (without patches that is) and attempt to reproduce it with that.
Update (2011-08-22 07:09 UTC): I ran my tests on 32 bit systems; running it on a 64 bit system confirms the same problem
| [reply] |
|
Something utterly bizarre is going on - if I add a line warn "flags '$flags'"; in lockf() just above the return statement, it works, even with the eval!
It happens on different machines, all debian stable 64bit . I will try a vanilla perl tomorrow. From strace, the length parameter which I'm trying to pass through pack as 0 is (sometimes) corrupted. strace when it goes wrong:
root@geedorah:~# strace perl foo.pl 2>&1 |grep fcntl
fcntl(3, F_SETFD, FD_CLOEXEC) = 0
fcntl(3, F_SETFD, FD_CLOEXEC) = 0
fcntl(3, F_SETLK, {type=F_WRLCK, whence=SEEK_SET, start=0, len=-858311
+8848}) = -1 EINVAL (Invalid argument)
fcntl(3, F_SETLK, {type=F_UNLCK, whence=SEEK_SET, start=0, len=0}) = 0
root@geedorah:~#
And when it goes right:
root@geedorah:~# strace perl foo.pl 2>&1 |grep fcntl
fcntl(3, F_SETFD, FD_CLOEXEC) = 0
fcntl(3, F_SETFD, FD_CLOEXEC) = 0
fcntl(3, F_SETLK, {type=F_WRLCK, whence=SEEK_SET, start=0, len=0}) = 0
fcntl(3, F_SETLK, {type=F_UNLCK, whence=SEEK_SET, start=0, len=0}) = 0
| [reply] [d/l] [select] |
Re: fcntl failure after eval
by ikegami (Patriarch) on Aug 11, 2011 at 21:58 UTC
|
pack('sslli', F_WRLCK, SEEK_SET, 0, 0);
12345 1 2 3 4
So I gotta wonder if the string is at all right.
| [reply] [d/l] |
|
$ perl -wE'say length pack "sslli", 0, 0, 0, 0;'
16
$ perl -wE'say length pack "sslli", 0, 0, 0, 0, 0;'
16
However, that's far shorter than expected, at least on the 64-bit system I used.
$ cat a.c
#include <fcntl.h>
#include <stddef.h>
#include <stdio.h>
int main() {
struct flock lock;
printf("flock: %lu\n", sizeof(lock));
printf("flock.l_type: %lu @ %2lu\n", sizeof(lock.l_type ), offse
+tof(struct flock, l_type ));
printf("flock.l_whence: %lu @ %2lu\n", sizeof(lock.l_whence), offse
+tof(struct flock, l_whence));
printf("flock.l_start: %lu @ %2lu\n", sizeof(lock.l_start ), offse
+tof(struct flock, l_start ));
printf("flock.l_len: %lu @ %2lu\n", sizeof(lock.l_len ), offse
+tof(struct flock, l_len ));
printf("flock.l_pid: %lu @ %2lu\n", sizeof(lock.l_pid ), offse
+tof(struct flock, l_pid ));
return 0;
}
$ gcc -Wall a.c -o a && a
flock: 32
flock.l_type: 2 @ 0
flock.l_whence: 2 @ 2
flock.l_start: 8 @ 8
flock.l_len: 8 @ 16
flock.l_pid: 4 @ 24
On that system, one would need
$ perl -wE'say length pack "s s x4 q q L x4", 0, 0, 0, 0, 0;'
32
| [reply] [d/l] [select] |
|
This does look like the right answer.
There are 3 different cases to consider:
- a 32 bit system with large file support (-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64)
- a 32 bit system without large file support
- a 64 bit system
ikegami's c program for each of the three:
- 32 bit system with LFS:
$ gcc -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -Wall a.c -o a && a
flock: 24
flock.l_type: 2 @ 0
flock.l_whence: 2 @ 2
flock.l_start: 8 @ 4
flock.l_len: 8 @ 12
flock.l_pid: 4 @ 20
- 32 bit system without LFS:
$ gcc -Wall a.c -o a && a
flock: 16
flock.l_type: 2 @ 0
flock.l_whence: 2 @ 2
flock.l_start: 4 @ 4
flock.l_len: 4 @ 8
flock.l_pid: 4 @ 12
- 64 bit system:
$ gcc -Wall a.c -o a && a
flock: 32
flock.l_type: 2 @ 0
flock.l_whence: 2 @ 2
flock.l_start: 8 @ 8
flock.l_len: 8 @ 16
flock.l_pid: 4 @ 24
The test perls:
- stock perl-5.10.0, running on a 32 bit system with large file support
- debian perl-5.10.0, running on a 32 bit system with large file support
- debian perl-5.10.1, running on a 64 bit system
Changing the op's code to:
- my $flags = pack('sslli', F_WRLCK, SEEK_SET, 5, 0);
- perl 1: length of flags: 16 bits, expected length: 24 bits
fcntl64(3, F_SETLK64, {type=F_WRLCK, whence=SEEK_SET, start=5, len=0}, 0x9d827d0) = 0
=> this probably works by accident
- perl 2: length of flags: 16 bits, expected length: 24 bits (running as a normal user)
fcntl64(3, F_SETLK64, {type=F_WRLCK, whence=SEEK_SET, start=5, len=0}, 0x819b4a8) = 0
=> this probably works by accident
- perl 2: length of flags: 16 bits, expected length: 24 bits (running as root)
fcntl64(3, F_SETLK64, {type=F_WRLCK, whence=SEEK_SET, start=5, len=2314885392840523776}, 0x81ed670) = 0
=> the length parameter does not contain the expected value
- perl 3: length of flags: 16 bits, expected length: 32 bits
fcntl(3, F_SETLK, {type=F_WRLCK, whence=SEEK_SET, start=0, len=0}) = 0
=> not correct, start is 0 but 'expected' value is 5
- my $flags = pack('sslllli', F_WRLCK, SEEK_SET, 5, 0, 2, 0, 0);
- perl 1: length of flags: 24 bits, expected length: 24 bits
fcntl64(3, F_SETLK64, {type=F_WRLCK, whence=SEEK_SET, start=5, len=2}, 0x970c7d0) = 0
- perl 2: length of flags: 24 bits, expected length: 24 bits (running as a normal user and as root)
fcntl64(3, F_SETLK64, {type=F_WRLCK, whence=SEEK_SET, start=5, len=2}, 0x819b4a8) = 0
- perl 3: length of flags: 24 bits, expected length: 32 bits
fcntl(3, F_SETLK, {type=F_WRLCK, whence=SEEK_SET, start=8589934592, len=0}) = 0
- my $flags = pack("s s x4 q q L x4", F_WRLCK, SEEK_SET, 5, 2, 0);
- perl 3: length of flags: 32 bits, expected length: 32 bits
fcntl(3, F_SETLK, {type=F_WRLCK, whence=SEEK_SET, start=5, len=2}) = 0
What this all means is that the value you need for $flags depends highly on the system it is running.. Which makes me wonder wheter or not there is a better way to accomplish what the op wants..
| [reply] [d/l] [select] |
|
|
|
|
|