develooper Front page | perl.perl5.porters | Postings from November 2000

[ID 20001112.006] IO::Seekable::getpos doesn't check forfgetpos() failure

From:
Nicholas Clark
Date:
November 12, 2000 14:40
Subject:
[ID 20001112.006] IO::Seekable::getpos doesn't check forfgetpos() failure
Message ID:
E13v4hQ-0000mn-00@Bagpuss.unfortu.net

This is a bug report for perl from nick@talking.bollo.cx,
generated with the help of perlbug 1.32 running under perl v5.7.0.


-----------------------------------------------------------------
[Please enter your report here]

IO::Seekable::getpos doesn't check the return result of fgetpos to
see whether fgetpos() failed.

The following patch makes getpos return undef if fgetpos() fails, adds
a regression test to t/lib/io_xs.t to test this, and documents the
return values for getpos and setpos.

--- ext/IO/lib/IO/Seekable.pm.orig	Tue Aug  1 03:31:40 2000
+++ ext/IO/lib/IO/Seekable.pm	Sun Nov 12 20:17:31 2000
@@ -18,18 +18,69 @@
 be inherited by other C<IO::Handle> based objects. It provides methods
 which allow seeking of the file descriptors.
 
-If the C functions fgetpos() and fsetpos() are available, then
-C<$io-E<lt>getpos> returns an opaque value that represents the
-current position of the IO::File, and C<$io-E<gt>setpos(POS)> uses
-that value to return to a previously visited position.
+=over 4
+
+=item $io->getpos
+
+Returns an opaque value that represents the current position of the
+IO::File, or C<undef> if this is not possible (eg an unseekable stream such
+as a terminal, pipe or socket). If the fgetpos() function is available in
+your C library it is used to implements getpos, else perl emulates getpos
+using C's ftell() function.
+
+=item $io->setpos
+
+Uses the value of a previous getpos call to return to a previously visited
+position. Returns 0 on success, -1 on failure.
+
+=back
 
 See L<perlfunc> for complete descriptions of each of the following
 supported C<IO::Seekable> methods, which are just front ends for the
 corresponding built-in functions:
 
-  $io->seek( POS, WHENCE )
-  $io->sysseek( POS, WHENCE )
-  $io->tell
+=over 4
+
+=item $io->setpos ( POS, WHENCE )
+
+Seek the IO::File to position POS, relative to WHENCE:
+
+=over 8
+
+=item WHENCE=0 (SEEK_SET)
+
+POS is absolute position. (Seek relative to the start of the file)
+
+=item WHENCE=1 (SEEK_CUR)
+
+POS is an offset from the current position. (Seek relative to current)
+
+
+=item WHENCE=1 (SEEK_END)
+
+POS is an offset from the end of the file. (Seek relative to end)
+
+=back
+
+The SEEK_* constants can be imported from the C<Fcntl> module if you
+don't wish to use the numbers C<0> C<1> or C<2> in your code.
+
+Returns C<1> upon success, C<0> otherwise.
+
+=item $io->sysseek( POS, WHENCE )
+
+Similar to $io->seek, but sets the IO::File's position using the system
+call lseek(2) directly, so will confuse most perl IO operators except
+sysread and syswrite (see L<perlfunc> for full details)
+
+Returns the new position, or C<undef> on failure.  A position
+of zero is returned as the string C<"0 but true">
+
+=item $io->tell
+
+Returns the IO::File's current position, or -1 on error.
+
+=back
 
 =head1 SEE ALSO
 
--- ext/IO/IO.xs.orig	Tue Aug  1 03:31:40 2000
+++ ext/IO/IO.xs	Sun Nov 12 19:32:16 2000
@@ -142,12 +142,17 @@
     CODE:
 	if (handle) {
 	    Fpos_t pos;
+	    if (
 #ifdef PerlIO
-	    PerlIO_getpos(handle, &pos);
+		PerlIO_getpos(handle, &pos)
 #else
-	    fgetpos(handle, &pos);
+		fgetpos(handle, &pos)
 #endif
-	    ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
+		) {
+		ST(0) = &PL_sv_undef;
+	    } else {
+		ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
+	    }
 	}
 	else {
 	    ST(0) = &PL_sv_undef;
--- t/lib/io_xs.t.orig	Tue Aug 29 13:54:12 2000
+++ t/lib/io_xs.t	Sun Nov 12 19:30:23 2000
@@ -21,7 +21,7 @@
 use IO::File;
 use IO::Seekable;
 
-print "1..4\n";
+print "1..6\n";
 
 $x = new_tmpfile IO::File or print "not ";
 print "ok 1\n";
@@ -40,3 +40,23 @@
 $! = 0;
 $x->setpos(undef);
 print $! ? "ok 4 # $!\n" : "not ok 4\n";
+
+# These shenanigans are intended to make a perl IO pointing to C FILE *
+# (or equivalent) on a closed file handle. Something that will fail fgetops()
+# Might be easier to use STDIN if (-t STDIN || -P STDIN) if ttys/pipes on
+# all platforms fail to fgetpos()
+$fn = $x->fileno();
+$y = new IO::File;
+if ($y->fdopen ($fn, "r")) {
+  print "ok 5\n";
+  $x->close() or die $!;
+  $!=0;
+  $p = $y->getpos;
+  if (defined $p) {
+    print "not ok 6 # closed handle returned defined position, \$!='$!'\n";
+  } else {
+    print "ok 6 # $!\n";
+  }
+} else {
+  print "not ok 5 # failed to duplicated file number $fd\n", "not ok 6\n";
+}


Nicholas Clark

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=library
    severity=low
---
Site configuration information for perl v5.7.0:

Configured by nick at Sat Oct 21 11:14:10 BST 2000.

Summary of my perl5 (revision 5.0 version 7 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.2.17-rmk1, archname=armv4l-linux-64int
    uname='linux bagpuss.unfortu.net 2.2.17-rmk1 #5 mon sep 18 19:03:46 bst 2000 armv4l unknown '
    config_args=''
    hint=previous, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=define d_sfio=define uselargefiles=define usesocks=undef
    use64bitint=define use64bitall=undef uselongdouble=undef
  Compiler:
    cc='/usr/local/bin/gcc', ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
    ccversion='', gccversion='2.95.2 20000516 (release) [Rebel.com]', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=8
    ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lsfio -lnsl -lndbm -ldb -ldl -lm -lc -lposix -lcrypt -lutil
    perllibs=-lsfio -lnsl -ldl -lm -lc -lposix -lcrypt -lutil
    libc=/lib/libc-2.1.3.so, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    DEVEL7385

---
@INC for perl v5.7.0:
    /usr/local/lib/perl5/5.7.0/armv4l-linux
    /usr/local/lib/perl5/5.7.0
    /usr/local/lib/perl5/site_perl/5.7.0/armv4l-linux
    /usr/local/lib/perl5/site_perl/5.7.0
    /usr/local/lib/perl5/site_perl
    .

---
Environment for perl v5.7.0:
    HOME=/home/nick
    LANG (unset)
    LANGUAGE (unset)
    LC_CTYPE=en_GB.ISO-8859-1
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/nick/bin:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/games:/sbin:/usr/sbin:/usr/local/sbin
    PERL_BADLANG (unset)
    SHELL=/bin/bash




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About