Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

accept() cores interpreter #4369

Closed
p5pRT opened this issue Sep 3, 2001 · 14 comments
Closed

accept() cores interpreter #4369

p5pRT opened this issue Sep 3, 2001 · 14 comments

Comments

@p5pRT
Copy link

p5pRT commented Sep 3, 2001

Migrated from rt.perl.org#7614 (status was 'resolved')

Searchable as RT7614$

@p5pRT
Copy link
Author

p5pRT commented Sep 3, 2001

From corbe@atlantis.corbe.net

-----------------------------------------------------------------
This little tidbit of code seems to core the perl interpreter. A
copy of the core file can be furnished upon request.

#!/usr/bin/perl

use strict;
use Socket;
use Fcntl;

# pseudo-constants
my $BLOCKSIZE = 1024;

my $socklist = { };

my $roof; # Highest numbered FD
my $rin = ''; # Read set
my $ein = ''; # Exception set

# Temporary variables
my $sock;
my $fileno;
my($rout, $eout);
my $nready;
my($i, $buf, $count);

# Create the listening socket
my $proto = getprotobyname('tcp');
socket($sock, PF_INET, SOCK_STREAM, $proto);
setsockopt($sock, SOL_SOCKET, SO_REUSEADDR, 1);
my $paddr = sockaddr_in(2999, INADDR_ANY);
bind($sock, $paddr);
listen($sock, SOMAXCONN);

# Prepare the event loop
$fileno = fileno($sock); # Store sock's fileno for vec()
$socklist->{$fileno}->{fh} = $sock; # Perminant storage place
$socklist->{$fileno}->{sv} = "server"; # This is a listening socket
$roof = $fileno + 1; # Highest numbered FD
vec($rin, $fileno, 1) = 1; # Add listening sock to read set

# Start the event loop
for ( ; ; )
{
  ($rout, $eout) = $rin;
  $nready = select($rout, undef, $eout, undef);
  if ($nready < 0) # Select returned an error
  {
  die("Select returned an error\n");
  }
  for ($i = 0; $i < $roof; $i++)
  {
  if (vec($rout, $i, 1))
  {
  if ($socklist->{$i}->{sv})
  {
  accept($sock, $socklist->{$i}->{fh});
  print "CORE!!!\n";
  fcntl($sock, F_SETFL, O_NONBLOCK);
  $fileno = fileno($sock);
  $socklist->{$fileno}->{fh} = $sock;
  if ($fileno > $roof)
  {
  $roof = $fileno;
  }
  $buf = sprintf("Hello, I'm Mizner! Pleased to meet you,,,\n");
  syswrite($sock, $buf);
  } else {
  $count = read($socklist->{$i}->{fh}, $buf, $BLOCKSIZE);
  if ($count < 1)
  {
  delete($socklist->{$i});
  next;
  }
  print $buf;
  }
  }
  }
}

Perl Info


This perlbug was built using Perl 5.00503 - Sun Mar  5 13:39:27 SAST 2000
It is being executed now by  Perl 5.006 - Sun May 27 13:04:45 EDT 2001.

Site configuration information for perl 5.006:

Configured by corbe at Sun May 27 13:04:45 EDT 2001.

Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration:
  Platform:
    osname=freebsd, osvers=4.1-release, archname=i386-freebsd
    uname='freebsd atlantis.corbe.net 4.1-release freebsd 4.1-release #0: sun dec 10 20:57:57 est 2000 corbe@atlantis.corbe.net:usrsrcsyscompileatlantis i386 '
    config_args='-ds -e'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=undef d_sfio=undef uselargefiles=define 
    use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef
  Compiler:
    cc='cc', optimize='-O', gccversion=2.95.2 19991024 (release)
    cppflags='-fno-strict-aliasing -I/usr/local/include'
    ccflags ='-fno-strict-aliasing -I/usr/local/include'
    stdchar='char', d_stdstdio=undef, usevfork=true
    intsize=4, longsize=4, ptrsize=4, doublesize=8
    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, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='cc', ldflags ='-Wl,-E  -L/usr/local/lib'
    libpth=/usr/lib /usr/local/lib
    libs=-lgdbm -lm -lc -lcrypt
    libc=, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-DPIC -fpic', lddlflags='-shared  -L/usr/local/lib'

Locally applied patches:
    


@INC for perl 5.006:
    /usr/local/lib/perl5/5.6.0/i386-freebsd
    /usr/local/lib/perl5/5.6.0
    /usr/local/lib/perl5/site_perl/5.6.0/i386-freebsd
    /usr/local/lib/perl5/site_perl/5.6.0
    /usr/local/lib/perl5/site_perl/5.005/i386-freebsd
    /usr/local/lib/perl5/site_perl/5.005
    /usr/local/lib/perl5/site_perl
    .


Environment for perl 5.006:
    HOME=/usr/home/corbe
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/sbin:/bin:/usr/sbin:/usr/bin:/usr/games:/usr/local/bin:/usr/X11R6/bin:/usr/home/corbe/bin
    PERL_BADLANG (unset)
    SHELL=/usr/local/bin/tcsh

@p5pRT
Copy link
Author

p5pRT commented Sep 3, 2001

From @schwern

This continues to core on 5.6.1, but bleadperl has fixed it.

Can anyone cut that code down a bit into something testable?

@p5pRT
Copy link
Author

p5pRT commented Sep 3, 2001

From @gbarr

Yes. Reading the code they are passing the listen socket as both arguments
to accept. So thier code is essentially

#!/usr/bin/perl

use strict;
use Socket;
use Fcntl;

my $rin = ''; # Read set

# Temporary variables
my $sock;
my $fileno;
my($rout, $eout);

# Create the listening socket
my $proto = getprotobyname('tcp');
socket($sock, PF_INET, SOCK_STREAM, $proto);
setsockopt($sock, SOL_SOCKET, SO_REUSEADDR, 1);
my $paddr = sockaddr_in(2999, INADDR_ANY);
bind($sock, $paddr);
listen($sock, SOMAXCONN);

# Prepare the event loop
$fileno = fileno($sock); # Store sock's fileno for vec()
vec($rin, $fileno, 1) = 1; # Add listening sock to read set

($rout, $eout) = $rin;
select($rout, undef, $eout, undef);
accept($sock, $sock);

Graham.

@p5pRT
Copy link
Author

p5pRT commented Sep 3, 2001

From [Unknown Contact. See original ticket]

  if ($socklist->{$i}->{sv})
  {
  undef $sock; # Our temporary variable
  accept($sock, $socklist->{$i}->{fh});

fixes my original problem. I apologize for the oversite.

On Tue, 4 Sep 2001, Graham Barr wrote​:

On Mon, Sep 03, 2001 at 07​:08​:04PM -0400, Michael G Schwern wrote​:

On Mon, Sep 03, 2001 at 04​:32​:37AM -0000, corbe@​atlantis.corbe.net wrote​:

This little tidbit of code seems to core the perl interpreter. A
copy of the core file can be furnished upon request.

This continues to core on 5.6.1, but bleadperl has fixed it.

Can anyone cut that code down a bit into something testable?

Yes. Reading the code they are passing the listen socket as both arguments
to accept. So thier code is essentially

#!/usr/bin/perl

use strict;
use Socket;
use Fcntl;

my $rin = ''; # Read set

# Temporary variables
my $sock;
my $fileno;
my($rout, $eout);

# Create the listening socket
my $proto = getprotobyname('tcp');
socket($sock, PF_INET, SOCK_STREAM, $proto);
setsockopt($sock, SOL_SOCKET, SO_REUSEADDR, 1);
my $paddr = sockaddr_in(2999, INADDR_ANY);
bind($sock, $paddr);
listen($sock, SOMAXCONN);

# Prepare the event loop
$fileno = fileno($sock); # Store sock's fileno for vec()
vec($rin, $fileno, 1) = 1; # Add listening sock to read set

($rout, $eout) = $rin;
select($rout, undef, $eout, undef);
accept($sock, $sock);

Graham.

@p5pRT
Copy link
Author

p5pRT commented Sep 4, 2001

From @nwc10

You're absolutly right, I didn't catch that. sock is supposed to be a
temporary variable​: so doing something along the lines of​:

                    if \($socklist\->\{$i\}\->\{sv\}\)
                    \{
                            undef $sock;            \# Our temporary variable
                            accept\($sock\, $socklist\->\{$i\}\->\{fh\}\);

fixes my original problem. I apologize for the oversite.

Simple test cases that cause perl to coredump are still welcome.
(Well, we'd prefer it if none existed, but given that they do it's better to
know about them and fix the problem they reveal in the perl interpreter)

Thanks for reporting this problem.

Nicholas Clark

@p5pRT
Copy link
Author

p5pRT commented Jul 25, 2008

From p5p@spam.wizbit.be

Reduced version of the code from Graham Barr​:

#!/usr/bin/perl

use strict;
use Socket;

my $sock;
my $proto = getprotobyname('tcp');
socket($sock, PF_INET, SOCK_STREAM, $proto);
accept($sock, $sock);
__END__

perl-5.6.1 rt-7614.pl
Segmentation fault

perl-5.6.2 rt-7614.pl
Segmentation fault

perl-5.8.0 rt-7614.pl
(no output)

(This was not added as a test - there appear to be no tests for
accept().)

@p5pRT
Copy link
Author

p5pRT commented May 5, 2012

From @Hugmeir

On Fri Jul 25 14​:51​:56 2008, animator wrote​:

Reduced version of the code from Graham Barr​:

#!/usr/bin/perl

use strict;
use Socket;

my $sock;
my $proto = getprotobyname('tcp');
socket($sock, PF_INET, SOCK_STREAM, $proto);
accept($sock, $sock);
__END__

perl-5.6.1 rt-7614.pl
Segmentation fault

perl-5.6.2 rt-7614.pl
Segmentation fault

perl-5.8.0 rt-7614.pl
(no output)

(This was not added as a test - there appear to be no tests for
accept().)

Looks like this was already fixed, so I'm marking as resolved, but I'll
have to echo animator, since I can't find this tested anywhere in the
core; Can someone get around adding that?

@p5pRT
Copy link
Author

p5pRT commented May 5, 2012

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

@p5pRT
Copy link
Author

p5pRT commented May 7, 2012

From @nwc10

On Sat May 05 06​:44​:23 2012, Hugmeir wrote​:

Looks like this was already fixed, so I'm marking as resolved, but I'll
have to echo animator, since I can't find this tested anywhere in the
core; Can someone get around adding that?

In which case, surely the ticket should remain open, until tests have
been written? This is what Rakudo does, and it seems to work well for them.

Nicholas Clark

@p5pRT
Copy link
Author

p5pRT commented May 7, 2012

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

@p5pRT
Copy link
Author

p5pRT commented May 7, 2012

From @nwc10

On Sat, May 05, 2012 at 06​:44​:24AM -0700, Brian Fraser via RT wrote​:

On Fri Jul 25 14​:51​:56 2008, animator wrote​:

(This was not added as a test - there appear to be no tests for
accept().)

Looks like this was already fixed, so I'm marking as resolved, but I'll

git bisect thinks that it was fixed by this commit​:

commit 882162d
Author​: Jarkko Hietaniemi <jhi@​iki.fi>
Date​: Mon Apr 23 23​:52​:25 2001 +0000

  More PerlIO robustness.
 
  p4raw-id​: //depot/perl@​9803

Nicholas Clark

@p5pRT
Copy link
Author

p5pRT commented Oct 21, 2016

From @dcollinsn

Test added in c778487, closing.

--
Respectfully,
Dan Collins

@p5pRT
Copy link
Author

p5pRT commented Oct 21, 2016

From [Unknown Contact. See original ticket]

Test added in c778487, closing.

--
Respectfully,
Dan Collins

@p5pRT
Copy link
Author

p5pRT commented Oct 21, 2016

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant