I downloaded 5.8.2 yesterday, and after tried for one day, most, if not all, of my multi-threading programs are now broken. Those programs are stable with 5.8.1.
As a maintainance release, 5.8.2 does not offer much new stuff, and you can confirm this by reading its perldelta. According to perldelta, there are only two core enhancements:
- hash randomisation, to most of our monks this is not important any way
- threading, fixed some problems, but introduced some new problems that I consider even worse
I would suggest people not to upgrade, especially if you used thread in some of your main programs. This kind of situation might happen pretty often in the future, as they now changed their strategy and try to have maintainance releases more frequently:
- 5.8.3 23:59:59 GMT, Wednesday December 31st 2003
- 5.8.4 23:59:59 GMT, Wednesday March 31st 2004
- 5.8.5 23:59:59 GMT, Wednesday June 30th 2004
Also, I suggest people to share your experiences with other monks once you downloaded a new version, and help others to decide whether to upgrade.
One of my borken program is a proxy I used to filter web content and speed up the connection. This program now core dumps almost every minute.
use threads;
use Socket;
use strict;
use warnings;
my $banned_type = {
"cab" => 1,
"class" => 1,
"dat" => 1,
"exe" => 1,
"gif" => 1,
"ico" => 1,
"jpg" => 1,
"js" => 1,
"jsp" => 1,
"png" => 1,
"swf" => 1
};
my $banned_site = {
"ad.doubleclick.net" => 1,
"lz.mainentrypoint.com" => 1,
"s.abetterinternet.com" => 1,
"search-itnow.com" => 1,
"www.ftstock.com" => 1,
"www.mainentrypoint.com" => 1,
"www.newshub.com" => 1
};
my $trusted_site = {
"a248.e.akamai.net" => 1,
"www.hsbc.ca" => 1
};
use constant RES_400 => "HTTP/1.1 400 Bad Request\r\n\r\n";
my $proto = getprotobyname('tcp');
socket(BROWSER_LISTENER, PF_INET, SOCK_STREAM, $proto) || die "Failed
+to create socket: $!";
setsockopt(BROWSER_LISTENER, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) |
+| die "Failed to setsockopt: $!";
bind(BROWSER_LISTENER, sockaddr_in(8080, INADDR_ANY)) || die "Failed t
+o bind: $!";
listen(BROWSER_LISTENER, SOMAXCONN) || die "Failed to listen: $!";
print "Internet filter started\n";
while (1) {
my $browser;
accept($browser, BROWSER_LISTENER);
my $req;
my $chunk;
do {
} until (!sysread($browser, $chunk, 10000) || ($req .= $chunk) =~
+m/\r\n\r\n/);
my $host = ($req =~ m/Host:\s*(.*?)\r/)[0];
my ($method, $page) = ($req =~ m/^(.*?)\s+(.*?)\s/);
if ($host && $page) {
if (is_trusted_site($host)) {
threads->create(\&process_one_req, $browser, $req, $method
+, $host)->detach();
print "requested [$page] from a trusted site\n";
} else {
if (is_banned_site($host) || is_banned_type($page)) {
print "[$host, $page] is banned\n";
print $browser RES_400;
close($browser);
} else {
print "[$host, $page] is not banned\n";
threads->create(\&process_one_req, $browser, $req, $me
+thod, $host)->detach();
}
}
} else {
close($browser);
}
}
sub process_one_req {
my ($browser, $req, $method, $host) = @_;
my $iaddr = inet_aton($host) || die "no host: $host";
my $paddr = sockaddr_in(80, $iaddr);
$proto = getprotobyname('tcp');
my $remote;
socket($remote, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect($remote, $paddr) || die "connect: $!";
print $remote $req, "\r\n";
my $chunk;
while (sysread($remote, $chunk, 10000)) {
print $browser $chunk;
open(LOG, ">>log.txt");
print LOG $chunk;
close LOG;
}
close($remote);
undef($remote);
close($browser);
undef($browser);
undef($req);
undef($host);
}
sub is_banned_site {
my $site = shift;
return 1 if (exists($banned_site->{$site}));
if ($site =~ m/offeroptimizer/) {
return 1;
}
if ($site =~ m/revenue.net$/) {
return 1;
}
if ($site =~ m/popupsponsor.com$/) {
return 1;
}
if ($site =~ m/hitbox.com$/) {
return 1;
}
return 0;
}
sub is_trusted_site {
my $site = shift;
return 1 if (exists($trusted_site->{$site}));
}
sub is_banned_type {
my $tmp = lc(shift);
=document
$tmp =~ m/(.*?)\:\/\/((?:(?:.*)\/)*)(.*)/;
my $proto = $1;
my $path = $2;
my $file = $3;
my $query;
my $type;
if ($file) {
($file, $query) = split(/\?/, $file);
($file, $type) = split(/\./, $file);
}
=cut
$tmp = (split /\//, $tmp)[-1];
my $type = (split /\./, $tmp)[-1];
print "type = $type\n" if ($type);
if ($type && exists($banned_type->{$type})) {
return 1;
} else {
return 0;
}
}