open sometimes ignores perlio layers when duping #7854

p5pRT · 2005-03-28T14:46:53Z

Migrated from rt.perl.org#34595 (status was 'open')

Searchable as RT34595$

p5pRT · 2005-03-28T14:46:54Z

From ambrus@math.bme.hu

Created by ambrus@math.bme.hu

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__

-----------------------------------------------------------------

Perl Info


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

p5pRT · 2005-03-29T07:43:30Z

From @demerphq

On 28 Mar 2005 14:46:54 -0000, via RT Zsban Ambrus
<perlbug-followup@perl.org> wrote:

# 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-archive.perl.org/perl5/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\, "\<&=&#8203;: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\, "&#8203;: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/"

p5pRT · 2005-03-29T07:43:31Z

The RT System itself - Status changed from 'new' to 'open'

Grinnz · 2020-04-19T01:33:15Z

I believe this bug still exists on 5.30.2. Test script below. What seems to be happening is the PerlIO layers are copied from the handle being duped to the new handle, and any layer specification in the 3 arg open is completely ignored. I get the same results whether the $target handle is STDOUT or a handle I've opened myself.

use strict;
use warnings;
use feature 'say';

my $target = *STDOUT;

say for PerlIO::get_layers($target), '';

open my $encoded, '>&:encoding(UTF-8)', $target or die "dup failed: $!";

say for PerlIO::get_layers($encoded), '';

binmode $encoded, ':encoding(UTF-8)' or die "binmode failed: $!";

say for PerlIO::get_layers($encoded), '';

binmode $target, ':encoding(UTF-8)' or die "binmode failed: $!";

open my $raw, '>&:raw', $target or die "dup failed: $!";

say for PerlIO::get_layers($raw), '';

binmode $raw or die "binmode failed: $!";

say for PerlIO::get_layers($raw), '';

Output:

unix
perlio

# this should have the encoding layers set in open
unix
perlio

# encoding layers added by binmode
unix
perlio
encoding(utf-8-strict)
utf8

# these encoding layers should be removed by :raw in open
unix
perlio
encoding(utf-8-strict)
utf8

# encoding layers removed by binmode
unix
perlio

Grinnz · 2020-04-19T01:46:11Z

And also the output is identical whether using a >& or >&= dup.

…icate utf8 encoding for regular output. The combined call to open() that was supposed to duplicate the STDOUT file descriptor and select a raw encoding at the same time did not work. It is a bug in Perl: Perl/perl5#7854 But a separate call to binmode worked, as documented here: https://stackoverflow.com/a/27802183 The fault was not apparent when Lintian ran in a terminal. It only became a problem when piping JSON output to a file in the archive tag sieve. Maybe gnome-terminal reversed the duplicate encoding magically. Removes a duplicate encoding layer on STDOUT, which was apparently not a problem here. PerlIO::get_layers reported for $RAW: unix perlio encoding(utf-8-strict) utf8 encoding(utf-8-strict) utf8 After this commit it gave the expected values: unix perlio

DabeDotCom · 2023-01-04T21:08:10Z

FWIW — I just ran into this under 5.36, even when I don't specify any encoding layers in the 3-arg open. (I also find it interesting that I get different behavior when STDOUT is a pipe versus a TTY, etc.)

###########################################################
###   Run interactively using: `perl utf8-test`         ###
###   Then make STDOUT a pipe: `perl utf8-test | cat`   ###
###########################################################

use strict;
use warnings;
use feature 'say';

binmode *STDOUT, ":encoding(UTF-8)";
say "\N{BULLET} 1";   # OKAY

# dup() to a temporary FH, then back...
open my $FH, ">&", *STDOUT;
open *STDOUT, ">&", $FH;

# Now, when STDOUT is a TTY (or ">/dev/null"), this gives a "Wide character in say"
# warning, but not when STDOUT is a pipe, like "| cat"
say "\N{BULLET} 2";

# Curiously, this still lists the UTF-8 layers: unix perlio encoding(utf-8-strict) utf8
say join " ", PerlIO::get_layers(*STDOUT);


##########################################
###  Why is this necessary to fix it?  ###
##########################################

for my $layer ( ":raw", PerlIO::get_layers(*STDOUT) ) {
    binmode *STDOUT, $layer unless grep { $_ eq $layer } PerlIO::get_layers(*STDOUT);
}

say join " ", PerlIO::get_layers(*STDOUT);
say "\N{BULLET} 3";

p5pRT added Severity Low distro-All type-core labels Oct 18, 2019

karenetheridge added the affects-5.30 label Apr 19, 2020

xenu removed affects-5.8 labels Nov 19, 2021

xenu removed the Severity Low label Dec 29, 2021

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

open sometimes ignores perlio layers when duping #7854

open sometimes ignores perlio layers when duping #7854

p5pRT commented Mar 28, 2005

p5pRT commented Mar 28, 2005

p5pRT commented Mar 29, 2005

p5pRT commented Mar 29, 2005

Grinnz commented Apr 19, 2020 •

edited

Grinnz commented Apr 19, 2020 •

edited

DabeDotCom commented Jan 4, 2023

open sometimes ignores perlio layers when duping #7854

open sometimes ignores perlio layers when duping #7854

Comments

p5pRT commented Mar 28, 2005

p5pRT commented Mar 28, 2005

From ambrus@math.bme.hu

Created by ambrus@math.bme.hu

p5pRT commented Mar 29, 2005

From @demerphq

p5pRT commented Mar 29, 2005

Grinnz commented Apr 19, 2020 • edited

Grinnz commented Apr 19, 2020 • edited

DabeDotCom commented Jan 4, 2023

Grinnz commented Apr 19, 2020 •

edited

Grinnz commented Apr 19, 2020 •

edited