From alexander_bluhm@genua.de

Created by alexander_bluhm@genua.de

If the select() system call fails, the following error handling in
Net​::Ping​::ping_icmp is broken.

This little program causes select() to fail by returning from a
signal handler. The user has to press Ctrl-C twice while Net​::Ping
is waiting to receive the packet.

#!/usr/bin/perl
use strict;
use warnings;
use Net​::Ping;
$SIG{INT} = sub {};
Net​::Ping->new("icmp")->ping("1.2.3.4", 60);

And here is the output​:
$ sudo perl ping.pl
^C^CBad arg length for Socket​::unpack_sockaddr_in, length is 0, should be 16 at /usr/libdata/perl5/i386-openbsd/5.8.6/Socket.pm line 370.

There are two Bugs in Net​::Ping​::ping_icmp that cause this strange
behavior.

  454 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for packet
  455 $timeout = $finish_time - &time(); # Get remaining time
  456 if (!defined($nfound)) # Hmm, a strange error
  457 {
  458 $ret = undef;
  459 $done = 1;
  460 }
  461 elsif ($nfound) # Got a packet from somewhere
  462 {
  463 $recv_msg = "";
  464 $from_pid = -1;
  465 $from_seq = -1;
  466 $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, ICMP_FLAGS);
  467 ($from_port, $from_ip) = sockaddr_in($from_saddr);

The author of Net​::Ping thought that if select() fails, it returns
undef. The return value of select() in the case of an error is not
documented in perldoc -f select. This little program helps​:

$ perl -e'$SIG{INT}=sub {}; print select(undef,undef,undef,undef), $!, "\n"'
^C-1Interrupted system call

After pressing Ctrl-C it is obvious, that select() returns -1, not undef
in case of an error.

So with correct error checking Net​::Ping​::ping_icmp looks like this​:

--- /usr/libdata/perl5/Net/Ping.pm      Mon Apr  4 22:25:33 2005
+++ Net/Ping.pm Tue Dec 13 18:36:04 2005
@@ -453,7 +453,7 @@
   {
     $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for packet
     $timeout = $finish_time - &time();    # Get remaining time
-    if (!defined($nfound))                # Hmm, a strange error
+    if ($nfound == -1)                    # Hmm, a strange error
     {
       $ret = undef;
       $done = 1;

With the patched Net​::Ping the test program terminates after the
first SIGINT.

The second bug is that the return value of recv() in line 466 is
not checked. In case of an error it is given to sockaddr_in() what
causes the stange error messages from Socket.pm.

So I think there are three things to be done​:

1. Fix the select error handling in Net​::Ping.
2. Handle errors of all system calls in Net​::Ping.
3. Document the error code of select in perlfunc.

Fixing only 1. helps to avoid the problem I ran into.

Flags:
    category=core
    severity=medium

Site configuration information for perl v5.8.6:

Configured by root at Thu Jan  1  0:00:00 UTC 1970.

Summary of my perl5 (revision 5 version 8 subversion 6) configuration:
  Platform:
    osname=openbsd, osvers=3.7, archname=i386-openbsd
    uname='openbsd'
    config_args='-dsE -Dopenbsd_distribution=defined'
    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 -fno-delete-null-pointer-checks -pipe -I/usr/local/include',
    optimize='-O2',
    cppflags='-fno-strict-aliasing -fno-delete-null-pointer-checks -pipe -I/usr/local/include'
    ccversion='', gccversion='3.3.5 (propolice)', gccosandvers='openbsd3.7'
    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 ='-Wl,-E '
    libpth=/usr/lib
    libs=-lm -lutil -lc
    perllibs=-lm -lutil -lc
    libc=/usr/lib/libc.so.34.2, so=so, useshrplib=true, libperl=libperl.so.10.0
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-R/usr/libdata/perl5/i386-openbsd/5.8.6/CORE'
    cccdlflags='-DPIC -fPIC ', lddlflags='-shared -fPIC '

Locally applied patches:
    SUIDPERLIO1 - fix PERLIO_DEBUG buffer overflow (CAN-2005-0156)


@INC for perl v5.8.6:
    /usr/libdata/perl5/i386-openbsd/5.8.6
    /usr/local/libdata/perl5/i386-openbsd/5.8.6
    /usr/libdata/perl5
    /usr/local/libdata/perl5
    /usr/local/libdata/perl5/site_perl/i386-openbsd
    /usr/libdata/perl5/site_perl/i386-openbsd
    /usr/local/libdata/perl5/site_perl
    /usr/libdata/perl5/site_perl
    /usr/local/lib/perl5/site_perl
    .


Environment for perl v5.8.6:
    HOME=/home/bluhm
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/usr/bin:/bin:/usr/sbin:/sbin:/usr/X11R6/bin:/usr/local/bin:/home/bluhm/bin
    PERL_BADLANG (unset)
    SHELL=/bin/ksh

From @rgs

alexander_bluhm@​genua.de (via RT) wrote​:

If the select() system call fails, the following error handling in
Net​::Ping​::ping_icmp is broken.
...
So with correct error checking Net​::Ping​::ping_icmp looks like this​:
--- /usr/libdata/perl5/Net/Ping.pm Mon Apr 4 22​:25​:33 2005
+++ Net/Ping.pm Tue Dec 13 18​:36​:04 2005

Thanks, I've applied your patch as change #26367 in the development
version of perl ; note that in this version, the return value of
select() on error is already correctly documented in perlfunc.

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

From @rgs

Rafael Garcia-Suarez wrote​:

alexander_bluhm@​genua.de (via RT) wrote​:

If the select() system call fails, the following error handling in
Net​::Ping​::ping_icmp is broken.
...
So with correct error checking Net​::Ping​::ping_icmp looks like this​:
--- /usr/libdata/perl5/Net/Ping.pm Mon Apr 4 22​:25​:33 2005
+++ Net/Ping.pm Tue Dec 13 18​:36​:04 2005

Thanks, I've applied your patch as change #26367 in the development
version of perl ; note that in this version, the return value of
select() on error is already correctly documented in perlfunc.

More generally, I've reverted this with #26368, choosing the more
general approach suggested by the OP, i.e. making the mselect() wrapper
return undef() on error instead of -1.

@rgs - Status changed from 'open' to 'resolved'