broken alarm in 5.8.0?

[p5pRT]

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

Searchable as RT17160$

[p5pRT]

From briank@briank.com

The attached scrip fails to work in 5.8.0 (it worked fine in 5.0 patchlevel 5 subversion 3 on the same machine). It hangs indefinately\, presumably because the alarm doesn't do the right thing.

I made the mistake of using CPAN to install spamassassin\, and it forced 5.8.0 upon me without asking whether I wanted it or not. :(

-brian briank@​briank.com

Summary of my perl5 (revision 5.0 version 8 subversion 0) configuration​:   Platform​:   osname=freebsd\, osvers=4.6.2-release\, archname=i386-freebsd   uname='freebsd oe8.briank.com 4.6.2-release freebsd 4.6.2-release #0​: thu aug 22 08​:49​:01 pdt 2002 root@​oe8.briank.com​:usrobjusrsrcsysold_english_800 i386 '   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 ='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -I/usr/local/include'\,   optimize='-O'\,   cppflags='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -I/usr/local/include'   ccversion=''\, gccversion='2.95.3 20010315 (release) [FreeBSD]'\, 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 ='-Wl\,-E -L/usr/local/lib'   libpth=/usr/lib /usr/local/lib   libs=-lm -lc -lcrypt -lutil   perllibs=-lm -lc -lcrypt -lutil   libc=\, so=so\, useshrplib=false\, libperl=libperl.a   gnulibc_version=''   Dynamic Linking​:   dlsrc=dl_dlopen.xs\, dlext=so\, d_dlsymun=undef\, ccdlflags=' '   cccdlflags='-DPIC -fpic'\, lddlflags='-shared -L/usr/local/lib'

Characteristics of this binary (from libperl)​:   Compile-time options​: USE_LARGE_FILES   Built under freebsd   Compiled at Sep 11 2002 00​:42​:10   @​INC​:   /usr/local/lib/perl5/5.8.0/i386-freebsd   /usr/local/lib/perl5/5.8.0   /usr/local/lib/perl5/site_perl/5.8.0/i386-freebsd   /usr/local/lib/perl5/site_perl/5.8.0   /usr/local/lib/perl5/site_perl/5.6.0   /usr/local/lib/perl5/site_perl/5.005   /usr/local/lib/perl5/site_perl   .

[p5pRT]

From briank@briank.com

#!/usr/local/bin/perl -w # # rblchk # # Rblchk is a mail filter intended to catch spam by checking "Received" # headers for invalid IP addresses or IP addresses recognized as sources # of spam by inclusion in the MAPS Realtime Blackhole List or other # black hole lists. # # If rblchk thinks a message is spam\, it will add a user-specified header # line after the first defective "Received" header. Otherwise it will # add nothing. In either case the message is passed through to standard # output. # # This is based on a fairly detailed specification by Anne Bennett. # # Author​: Michael Assels \mjassels@​cs\.concordia\.ca # Date​: v1.0 December 4\, 1997 # Date​: v1.1 December 12\, 1997 # # See ChangeLog file in distribution for modification history. # # COPYRIGHT # Copyright (c) 1997 Concordia University. All rights # reserved. This program is free software; you may # redistribute it and/or modify it under the same terms as # Perl itself. #

# \,'.dul.maps.vix.com' # -- dul seems to result in a lot of false positives @​MAPS = ( '.rbl.maps.vix.com'   \,'.rss.maps.vix.com'   \,'.inputs.orbz.org'   \,'.bl.spamcop.net'   \,'.orbs.gst-group.co.uk'   \,'.manual.orbs.gst-group.co.uk'   \,'.relays.ordb.org'   \,'.spamhaus.relays.osirusoft.com'   \,'.relays.visi.com' # the following seem broken right now -- blackholing everything # \,'.orbz.gst-group.co.uk' # \,'.inputs.orbs.org'   ); # friendly hosts that should never be rejected -- irregardless of # what any spam-blocker says @​NEVER_REJECT = ( 'uucp.tsoft.net' # a relay at my ISP   \,'shell.tsoft.net' # a relay at my ISP   \,'MANAWATU-MAIL-CENTRE.MIT.EDU' # MIT sucks   \,'smtp.briank.com' # me   \,'cs.stanford.edu' # my main email account   \,'xenon.stanford.edu' # my main email account server   \,'oe8.briank.com' # my email server   \,'127.0.0.1' # some servers give this as an address   ); $OK = ''; $InvalidIP = '1 Invalid IP address '; $RcvBlackHole = '2 Received from RBL-registered spam site '; $RlyBlackHole = '3 Relayed through RBL-registered spam site ';

# *I* think rblchk's a nice name\, but I can be anyone you like. ($myname = $0) =~ s#.*/##;

$USAGE=\<\<EOUSAGE; usage​: $myname spamheader timeout   spamheader​: a message header type (e.g.​: X-Antispam)   timeout​: maximum time (1-15 seconds) to wait for DNS reply EOUSAGE

die $USAGE unless @​ARGV == 2;

($spamheader\, $timeout) = (shift\, shift);

# spamheader should not be colon-terminated\, and should start with # X-some-non-control-chars. die $USAGE unless $spamheader =~ /^X-[\041-\071\073-\176]+(​:[^​:]+)*$/; die $USAGE unless $timeout =~ /^1[0-5]?|[2-9]$/; # 1-15

# # Catch ALRM signals so we can timeout DNS lookups # sub myALRM { die "alarm\n" } $SIG{ALRM} = 'myALRM'; &myALRM() if 0; # make -w shut up # # Loop through headers and add a spam tag if necessary. # $rcvCount = 0; $_ = \<>; defined($_) || exit; # Don't bomb on empty input. LOOP​: {   if ( /^$/ ) { # A blank line means end of headers.   print;   last LOOP;   }   # Gather a complete header line with its continuation lines.   local($header) = $_;   while ( \<> ) {   /^[ \t]/ || last;   $header .= $_;   }   # Note​: $_ now contains the line *after* $header   print $header;   if ( $header =~ /^Received​:/i ) { # Test any Received headers.   local($tag) = &checkit($rcvCount\,$header);   if ( $tag ) {   #   # It's spam. Tag it and get out of loop.   #   print "$spamheader​: $myname​: $tag\n";   print;   last LOOP;   }   $rcvCount++; # Any further Received lines won't be the first.   }   last LOOP unless defined $_;   redo LOOP; } # # Pass everything else through. # print while \<>; exit;

# # checkit​: $relay is false on the first call\, true on all others. # $rcvd is a "Received​:" header. # Returns OK or an error code. # sub checkit {   local($relay\,$rcvd) = @​_;   local($IP\,@​IP) = $rcvd =~ /\[((\d{1\,3})\.(\d{1\,3})\.(\d{1\,3})\.(\d{1\,3}))\]/;   local($name\,$x);   #   # We can't complain if there's no IP address in this Received header.   #   return ($OK) unless defined $IP;   #   # There may be some hosts which we always want to consider OK\,   # irregardless of what any spam protection tells us   #   foreach $name (@​NEVER_REJECT) {   return ($OK) if $IP eq &getaddrbyname($name);   }   #   # Outer limits lose   #   return ($InvalidIP.$IP) if $IP eq '0.0.0.0';   return ($InvalidIP.$IP) if $IP eq '255.255.255.255';   #   # All @​IP components must be >= 0 and \<= 255   #   foreach $x ( @​IP ) {   return ($InvalidIP.$IP) if $x > 255;   return ($InvalidIP.$IP) if $x =~ /^0\d/; # no leading zeroes allowed   }   foreach $MAPS ( @​MAPS ) {   undef $name;   #   # Wrap the gethostbyname call with eval in case it times out.   #   eval {   alarm($timeout);   ($name) = gethostbyname(join('.'\,reverse @​IP) . $MAPS);   alarm(0);   };   #   # If it IS NOT ok with MAPS\, it's not OK with us.   #   if ($name) {   #   # Wrap the gethostbyaddr call with eval in case it times out.   #   local($lookup) = "";   local($hostname) = "";   eval {   alarm(10);   if ($lookup = gethostbyaddr(pack("cccc"\, @​IP)\, 2)) {   $hostname = $lookup;   }   alarm(0);   };   local($date) = `date`;   chop($date);   return(($relay ? $RlyBlackHole.$IP : $RcvBlackHole.$IP)   . (length($hostname)?" ($hostname)"​:"")   . " [" . join('.'\, reverse @​IP)   . "$MAPS; $date]");   }   }   return($OK); # If MAPS never returned a name\, then it's OK with us }

sub getaddrbyname () {   local($name) = @​_;   local(@​hostent);

  if (! defined($HOST_ADDRESS{$name})) {   undef @​hostent;   #   # Make sure the mapping is set to something   #   $HOST_ADDRESS{$name} = "";   #   # Wrap the gethostbyname call with eval in case it times out.   #   eval {   alarm($timeout);   @​hostent = gethostbyname($name);   alarm(0);   };   #   # Grab the IP address   #   if ($#hostent == 4) {   $HOST_ADDRESS{$name} = join("."\, unpack("C4"\, $hostent[4]));   }   }

  return $HOST_ADDRESS{$name}; }

[p5pRT]

From @jhi

Since I think this problem ticket is essentially the same as the #17341\, I'm marking also this problem ticket as resolved. (In other words\, the POSIX​::sigaction workaround needs to be used to break out from gethostbyname()\, at least in FreeBSD.)

[p5pRT]

@jhi - Status changed from 'new' to 'resolved'