Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

fcntl failure after eval

by flipper (Beadle)
on Aug 11, 2011 at 13:51 UTC ( #919873=perlquestion: print w/ replies, xml ) Need Help??
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:~#

Comment on fcntl failure after eval
Select or Download Code
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

      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
Re: fcntl failure after eval
by ikegami (Pope) on Aug 11, 2011 at 21:58 UTC

    This ain't right.

    pack('sslli', F_WRLCK, SEEK_SET, 0, 0); 12345 1 2 3 4

    So I gotta wonder if the string is at all right.

      Ok, omitting the last input appears to be acceptable.

      $ 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

        This does look like the right answer.

        There are 3 different cases to consider:

        1. a 32 bit system with large file support (-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64)
        2. a 32 bit system without large file support
        3. a 64 bit system

        ikegami's c program for each of the three:

        1. 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
          
        2. 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
          
        3. 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:

        1. stock perl-5.10.0, running on a 32 bit system with large file support
        2. debian perl-5.10.0, running on a 32 bit system with large file support
        3. 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..

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://919873]
Approved by moritz
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (6)
As of 2014-08-30 03:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (291 votes), past polls