Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
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 chanting in the Monastery: (8)
As of 2014-08-21 16:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (138 votes), past polls