enable_ssl returns incorrect MAC

[Jim Blomo]

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;