Skip Menu |
 
Report information
Id: 34595
Status: open
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: b_jonas <ambrus [at] math.bme.hu>
Cc:
AdminCc:

Operating System: Linux
PatchStatus: (no value)
Severity: low
Type: core
Perl Version: 5.8.5
Fixed In: (no value)



CC: ambrus [...] math.bme.hu
Subject: open sometimes ignores perlio layers when duping
Date: Mon, 28 Mar 2005 16:46:23 +0200
To: perlbug [...] perl.org
From: "Zsban Ambrus" <ambrus [...] math.bme.hu>
Download (untitled) / with headers
text/plain 7.3k
This is a bug report for perl from ambrus@math.bme.hu, generated with the help of perlbug 1.35 running under perl v5.8.5. ----------------------------------------------------------------- [Please enter your report here] In some cases, the 3 argument open statement of perl ignores perlio layers, when I use it to duplicate file handles. For example, this command: 'open $dup, "<&=:encoding(iso-8859-2)", *STDIN or die $!; opens a duplicate filehandle for STDIN successfully, but does not apply the encoding layer to it. In contrast, these commands open $dup, "<&=", *STDIN or die $!; binmode $dup, ":encoding(iso-8859-2)" or die $!; successfully apply the encoding layer to the dupe handle, while the original filehandle STDIN is unaffected: it still reads bytes by default. The io layer part of the string is sometimes ignored, sometimes it is scanned for io layers, but are not applied. For example, both of these open $dup, ">&=encoding(iso-8859-2)", *STDOUT or die $!; open $dup2, "<&=encoding(iso-8859-2)", *STDIN or die $!; open a dupe filehandle but not apply the layer. If you mis-spell the encoding like this: open $dup2, ">&=encoding(iso-8895-2)", *STDOUT or die $!; fails with EINVAL and warns 'Cannot find encoding "iso-8895-2"' (which is, btw, a warning not documented in perldiag), while this: open $dup2, "<&=encoding(iso-8895-2)", *STDIN or die "$!"; opens the dupe ignoring the layer part completely. I've written a test script to test some of these bugs. This one does not check whether open fails if given an incorrect layer, it only checks what I think should be valid. I include the test script below. When I run it, the following tests fail: 28-30, 33-35, 38-40, 43-45, 48-50, 88-90, 93-95, 98-100, 103-105, 108-110 I also get a few wide character warnings from the test, which are also caused by the missing layers. Even though this perlbug is that of perl 5.8.5, I've also got the same results from perl v5.8.6 on the same machine. These are both vanilla perls built from source, not the ones installed by Gentoo system. I tried to trace the error to its origins. I belive the error is in the Perl_do_openn function (doio.c), but that function was too complicated for me (600+ lines and I'm no perl wizard), so I'm afraid I won't be able to write a patch. ambrus ----------------------------------------------------------------- #!perl -w use warnings; use strict; use Test::More tests => 120; use IO::Handle; use PerlIO; use File::Temp; sub any { my $f = $_[0]; my $r; for (@_[1 .. @_ - 1]) { $r = &$f($_); $r and return $r; }; $r; } for my $dup_descriptor (0, 1) { for my $open_argc (3, 2) { for my $layer_in_open (0, ($open_argc == 3 ? 1 : ())) { for my $copy_what ($open_argc == 3 ? ("ioref", "glob", "globref") : (), "fileno", "symref") { my $iter_summary = ", " . $open_argc . "-arg open, " . $copy_what . ", dup " . ($dup_descriptor ? "descriptor" : "handle") . ", " . ($layer_in_open ? "perlio layer in open" : "separate binmode"); #warn "+$iter_summary\n"; my($file, $name) = File::Temp::tempfile(undef, "REMOVE", 1); defined(fileno($file)) or die "error: no fileno found on tempfile"; my $copy_arg = $copy_what eq "ioref" ? *$file{IO} : $copy_what eq "glob" ? *$file : $copy_what eq "globref" ? $file : $copy_what eq "fileno" ? fileno($file) : $copy_what eq "symref" ? do { *FILE = *$file; "FILE" } : (); defined($copy_arg) or die "error: copy argument is wrong"; my @open_arg3 = $open_argc == 3 ? $copy_arg : (); my $open_arg2 = $open_argc == 2 ? $copy_arg : ""; my $equals_sign = $dup_descriptor ? "" : "="; my $layer = ":encoding(iso-8859-2)"; my $open_layer = $layer_in_open ? $layer : ""; open my $copy, "+<&" . $equals_sign . $open_layer . $open_arg2, @open_arg3 or die "error copy: $!"; defined(fileno($file)) or die "error: no fileno found on copy"; is((fileno($copy) != fileno($file)), !!$dup_descriptor, "fileno equalty" . $iter_summary); !$layer_in_open and do { binmode $copy, $layer or die "error binmode: $!"; }; my @file_layers = PerlIO::get_layers($file); ok (!any (sub { /^encoding/ }, @file_layers), "orig has no encoding layer" . $iter_summary); my @copy_layers = PerlIO::get_layers($copy); ok (any (sub { /^encoding/ }, @copy_layers), "copy has encoding layer" . $iter_summary); print $copy chr(0x151) or die "error write: $!"; flush $copy or die "error flush: $!"; seek $file, 0, 0 or die "error seek: $!"; my $s = <$file>; defined($s) or die($! ? "eof reading file" : "error reading file: $!"); is(ord($s), 0xf5, "encoding test" . $iter_summary); seek $copy, 0, 0 or die "error seek: $!"; print $file chr(0xf5) or die "error write: $!"; flush $file; seek $copy, 0, 0 or die "error seek: $!"; $s = <$copy>; defined($s) or die($! ? "eof reading file" : "error reading file: $!"); is(ord($s), 0x151, "decoding test" . $iter_summary); close $file or die "error close: $!"; close $copy or die "error close copy: $!"; } } } } __END__ ----------------------------------------------------------------- [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=low --- Site configuration information for perl v5.8.5: Configured by ambrus at Thu Sep 2 22:17:37 CEST 2004. Summary of my perl5 (revision 5 version 8 subversion 5) configuration: Platform: osname=linux, osvers=2.4.25-gentoo-r2, archname=i686-linux uname='linux king 2.4.25-gentoo-r2 #4 fri jun 11 18:55:54 cest 2004 i686 pentium ii (deschutes) genuineintel gnulinux ' config_args='' hint=recommended, useposix=true, d_sigaction=define usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef useperlio=define d_sfio=undef uselargefiles=define usesocks=undef use64bitint=undef use64bitall=undef uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cc', ccflags ='-fno-strict-aliasing -pipe -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2', cppflags='-fno-strict-aliasing -pipe' ccversion='', gccversion='3.3.2 20031218 (Gentoo Linux 3.3.2-r5, propolice-3.3-7)', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=4, prototype=define Linker and Libraries: ld='cc', ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lnsl -lndbm -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc libc=/lib/libc-2.3.2.so, so=so, useshrplib=false, libperl=libperl.a gnulibc_version='2.3.2' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib' Locally applied patches: --- @INC for perl v5.8.5: /usr/local/lib/perl5/5.8.5/i686-linux /usr/local/lib/perl5/5.8.5 /usr/local/lib/perl5/site_perl/5.8.5/i686-linux /usr/local/lib/perl5/site_perl/5.8.5 /usr/local/lib/perl5/site_perl . --- Environment for perl v5.8.5: HOME=/home/ambrus LANG (unset) LANGUAGE (unset) LC_CTYPE=hu_HU LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/home/ambrus/local/bin:/usr/local/bin:/bin:/usr/bin:/usr/games/bin:/usr/X11R6/bin:/usr/qt/3/bin:/usr/kde/3.2/bin:/opt/Acrobat5 PERL_BADLANG (unset) SHELL=/bin/bash
CC: bugs-bitbucket [...] rt.perl.org
Subject: Re: [perl #34595] open sometimes ignores perlio layers when duping
Date: Tue, 29 Mar 2005 09:42:58 +0200
To: perl5-porters [...] perl.org
From: demerphq <demerphq [...] gmail.com>
Download (untitled) / with headers
text/plain 8.6k
On 28 Mar 2005 14:46:54 -0000, via RT Zsban Ambrus <perlbug-followup@perl.org> wrote: Show quoted text
> # New Ticket Created by "Zsban Ambrus" > # Please include the string: [perl #34595] > # in the subject line of all future correspondence about this issue. > # <URL: https://rt.perl.org/rt3/Ticket/Display.html?id=34595 > > > This is a bug report for perl from ambrus@math.bme.hu, > generated with the help of perlbug 1.35 running under perl v5.8.5. > > ----------------------------------------------------------------- > [Please enter your report here] > > In some cases, the 3 argument open statement of perl ignores perlio > layers, when I use it to duplicate file handles. > > For example, this command: > > 'open $dup, "<&=:encoding(iso-8859-2)", *STDIN or die $!; > > opens a duplicate filehandle for STDIN successfully, but does not apply the > encoding layer to it. In contrast, these commands > > open $dup, "<&=", *STDIN or die $!; > binmode $dup, ":encoding(iso-8859-2)" or die $!; > > successfully apply the encoding layer to the dupe handle, while the original > filehandle STDIN is unaffected: it still reads bytes by default. > > The io layer part of the string is sometimes ignored, sometimes it is > scanned for io layers, but are not applied. For example, both of these > > open $dup, ">&=encoding(iso-8859-2)", *STDOUT or die $!; > open $dup2, "<&=encoding(iso-8859-2)", *STDIN or die $!; > > open a dupe filehandle but not apply the layer. If you mis-spell the > encoding like this: > > open $dup2, ">&=encoding(iso-8895-2)", *STDOUT or die $!; > > fails with EINVAL and warns 'Cannot find encoding "iso-8895-2"' (which is, > btw, a warning not documented in perldiag), while this: > > open $dup2, "<&=encoding(iso-8895-2)", *STDIN or die "$!"; > > opens the dupe ignoring the layer part completely. > > I've written a test script to test some of these bugs. This one does not > check whether open fails if given an incorrect layer, it only checks what I > think should be valid. I include the test script below. When I run it, the > following tests fail: > > 28-30, 33-35, 38-40, 43-45, 48-50, 88-90, 93-95, 98-100, 103-105, 108-110 > > I also get a few wide character warnings from the test, which are also > caused by the missing layers. > > Even though this perlbug is that of perl 5.8.5, I've also got the same > results from perl v5.8.6 on the same machine. These are both vanilla perls > built from source, not the ones installed by Gentoo system. > > I tried to trace the error to its origins. I belive the error is in the > Perl_do_openn function (doio.c), but that function was too complicated for > me (600+ lines and I'm no perl wizard), so I'm afraid I won't be able to > write a patch. > > ambrus > > ----------------------------------------------------------------- > #!perl -w > > use warnings; > use strict; > > use Test::More tests => 120; > > use IO::Handle; > use PerlIO; > use File::Temp; > > sub any { > my $f = $_[0]; > my $r; > for (@_[1 .. @_ - 1]) { > $r = &$f($_); > $r and return $r; > }; > $r; > } > > for my $dup_descriptor (0, 1) { > for my $open_argc (3, 2) { > for my $layer_in_open (0, ($open_argc == 3 ? 1 : ())) { > for my $copy_what ($open_argc == 3 ? ("ioref", "glob", "globref") : (), "fileno", "symref") { > my $iter_summary = ", " . $open_argc . "-arg open, " . $copy_what . > ", dup " . ($dup_descriptor ? "descriptor" : "handle") . > ", " . ($layer_in_open ? "perlio layer in open" : "separate binmode"); > #warn "+$iter_summary\n"; > my($file, $name) = File::Temp::tempfile(undef, "REMOVE", 1); > defined(fileno($file)) or > die "error: no fileno found on tempfile"; > my $copy_arg = $copy_what eq "ioref" ? *$file{IO} : > $copy_what eq "glob" ? *$file : > $copy_what eq "globref" ? $file : > $copy_what eq "fileno" ? fileno($file) : > $copy_what eq "symref" ? do { *FILE = *$file; "FILE" } : (); > defined($copy_arg) or die "error: copy argument is wrong"; > my @open_arg3 = $open_argc == 3 ? $copy_arg : (); > my $open_arg2 = $open_argc == 2 ? $copy_arg : ""; > my $equals_sign = $dup_descriptor ? "" : "="; > my $layer = ":encoding(iso-8859-2)"; > my $open_layer = $layer_in_open ? $layer : ""; > open my $copy, "+<&" . $equals_sign . $open_layer . $open_arg2, @open_arg3 or > die "error copy: $!"; > defined(fileno($file)) or > die "error: no fileno found on copy"; > is((fileno($copy) != fileno($file)), !!$dup_descriptor, "fileno equalty" . $iter_summary); > !$layer_in_open and do { > binmode $copy, $layer or > die "error binmode: $!"; > }; > my @file_layers = PerlIO::get_layers($file); > ok (!any (sub { /^encoding/ }, @file_layers), "orig has no encoding layer" . $iter_summary); > my @copy_layers = PerlIO::get_layers($copy); > ok (any (sub { /^encoding/ }, @copy_layers), "copy has encoding layer" . $iter_summary); > print $copy chr(0x151) or > die "error write: $!"; > flush $copy or > die "error flush: $!"; > seek $file, 0, 0 or die "error seek: $!"; > my $s = <$file>; > defined($s) or > die($! ? "eof reading file" : "error reading file: $!"); > is(ord($s), 0xf5, "encoding test" . $iter_summary); > seek $copy, 0, 0 or die "error seek: $!"; > print $file chr(0xf5) or die "error write: $!"; > flush $file; > seek $copy, 0, 0 or die "error seek: $!"; > $s = <$copy>; > defined($s) or > die($! ? "eof reading file" : "error reading file: $!"); > is(ord($s), 0x151, "decoding test" . $iter_summary); > close $file or > die "error close: $!"; > close $copy or > die "error close copy: $!"; > } } } } > > __END__ > > ----------------------------------------------------------------- > > [Please do not change anything below this line] > ----------------------------------------------------------------- > --- > Flags: > category=core > severity=low > --- > Site configuration information for perl v5.8.5: > > Configured by ambrus at Thu Sep 2 22:17:37 CEST 2004. > > Summary of my perl5 (revision 5 version 8 subversion 5) configuration: > Platform: > osname=linux, osvers=2.4.25-gentoo-r2, archname=i686-linux > uname='linux king 2.4.25-gentoo-r2 #4 fri jun 11 18:55:54 cest 2004 i686 pentium ii (deschutes) genuineintel gnulinux ' > config_args='' > hint=recommended, useposix=true, d_sigaction=define > usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef > useperlio=define d_sfio=undef uselargefiles=define usesocks=undef > use64bitint=undef use64bitall=undef uselongdouble=undef > usemymalloc=n, bincompat5005=undef > Compiler: > cc='cc', ccflags ='-fno-strict-aliasing -pipe -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', > optimize='-O2', > cppflags='-fno-strict-aliasing -pipe' > ccversion='', gccversion='3.3.2 20031218 (Gentoo Linux 3.3.2-r5, propolice-3.3-7)', gccosandvers='' > intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 > d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 > ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 > alignbytes=4, prototype=define > Linker and Libraries: > ld='cc', ldflags =' -L/usr/local/lib' > libpth=/usr/local/lib /lib /usr/lib > libs=-lnsl -lndbm -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc > perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc > libc=/lib/libc-2.3.2.so, so=so, useshrplib=false, libperl=libperl.a > gnulibc_version='2.3.2' > Dynamic Linking: > dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' > cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib' > > Locally applied patches: > > --- > @INC for perl v5.8.5: > /usr/local/lib/perl5/5.8.5/i686-linux > /usr/local/lib/perl5/5.8.5 > /usr/local/lib/perl5/site_perl/5.8.5/i686-linux > /usr/local/lib/perl5/site_perl/5.8.5 > /usr/local/lib/perl5/site_perl > . > > --- > Environment for perl v5.8.5: > HOME=/home/ambrus > LANG (unset) > LANGUAGE (unset) > LC_CTYPE=hu_HU > LD_LIBRARY_PATH (unset) > LOGDIR (unset) > PATH=/home/ambrus/local/bin:/usr/local/bin:/bin:/usr/bin:/usr/games/bin:/usr/X11R6/bin:/usr/qt/3/bin:/usr/kde/3.2/bin:/opt/Acrobat5 > PERL_BADLANG (unset) > SHELL=/bin/bash
FWIW: I checked this on blead and i got the same results as Ambrus. cheers, yves -- perl -Mre=debug -e "/just|another|perl|hacker/"


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org