enable_ssl returns incorrect MAC
Jim Blomo
jim at pbwiki.com
Fri Dec 14 15:10:16 UTC 2007
On Dec 13, 2007 2:12 PM, Jim Blomo <jim at pbwiki.com> wrote:
> Hi all, I'm trying out Perlbal 1.60 with SSL but I'm getting back
> responses with an "incorrect Message Authentication Code" (error from
> Firefox).
It looks like the occurs when reproxying a local file.
Perlbal::Socket::sendfile writes directly to the socket file
descriptor, bypassing the IO::Socket::SSL layer and writing plaintext
to an SSL socket. Here is a patch to work around this problem, though
this probably isn't the cleanest solution.
Jim
diff -Naur /usr/local/share/perl/5.8.8/Perlbal/ClientHTTPBase.pm
Perlbal/ClientHTTPBase.pm
--- /usr/local/share/perl/5.8.8/Perlbal/ClientHTTPBase.pm 2007-10-23
15:39:17.000000000 +0000
+++ Perlbal/ClientHTTPBase.pm 2007-12-14 14:54:43.000000000 +0000
@@ -279,9 +279,14 @@
my $postread = sub {
return if $self->{closed};
- my $sent = Perlbal::Socket::sendfile($self->{fd},
- fileno($self->{reproxy_fh}),
- $to_send);
+ my $sent = ref $self->{sock} eq 'IO::Socket::SSL' ?
+ Perlbal::SocketSSL::writefile($self->{sock},
+ fileno($self->{reproxy_fh}),
+ $to_send)
+ :
+ Perlbal::Socket::sendfile($self->{fd},
+ fileno($self->{reproxy_fh}),
+ $to_send);
#warn "to_send = $to_send, sent = $sent\n";
print "REPROXY Sent: $sent\n" if Perlbal::DEBUG >= 2;
diff -Naur /usr/local/share/perl/5.8.8/Perlbal/SocketSSL.pm Perlbal/SocketSSL.pm
--- /usr/local/share/perl/5.8.8/Perlbal/SocketSSL.pm 2007-10-24
04:00:51.000000000 +0000
+++ Perlbal/SocketSSL.pm 2007-12-14 14:48:55.000000000 +0000
@@ -132,4 +132,25 @@
$_[0]->try_accept;
}
+our $max_sf_readwrite = 128 * 1024;
+sub writefile {
+ my ($sock, $fd, $bytes) = @_;
+
+ my $buf;
+ $bytes = $max_sf_readwrite if $bytes > $max_sf_readwrite;
+
+ my $rv = POSIX::read($fd, $buf, $bytes);
+ return -1 unless defined $rv;
+ return -1 unless $rv == $bytes;
+
+ my $wv = $sock->write($buf, $rv);
+ return -1 unless defined $wv;
+
+ if (my $over_read = $rv - $wv) {
+ POSIX::lseek($fd, -$over_read, &POSIX::SEEK_CUR);
+ }
+
+ return $wv;
+}
+
1;
More information about the perlbal
mailing list