This file is indexed.

/usr/share/perl5/Perlbal/SocketSSL.pm is in libperlbal-perl 1.80-3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
# Base class for SSL sockets.
#
# This is a simple class that extends Danga::Socket and contains an IO::Socket::SSL
# for the purpose of allowing non-blocking SSL in Perlbal.
#
# Copyright 2007, Mark Smith <mark@plogs.net>.
#
# This file is licensed under the same terms as Perl itself.

package Perlbal::SocketSSL;

use strict;
use warnings;
no  warnings qw(deprecated);

use Danga::Socket 1.44;
use IO::Socket::SSL 0.98;
use Errno qw( EAGAIN );
use Perlbal::Socket;

use base 'Danga::Socket';
use fields qw( listener create_time alive_time);

Perlbal::Socket->set_socket_idle_handler('Perlbal::SocketSSL' => sub {
    my Perlbal::SocketSSL $v = shift;

    my $max_age = eval { $v->max_idle_time } || 0;
    return unless $max_age;

    # Attributes are in another class, don't violate object boundaries.
    $v->{sock}->close(SSL_no_shutdown => 1, SSL_ctx_free => 1)
        if $v->{alive_time} < $Perlbal::tick_time - $max_age;
});

# called: CLASS->new( $sock, $tcplistener )
sub new {
    my Perlbal::SocketSSL $self = shift;
    $self = fields::new( $self ) unless ref $self;

    Perlbal::objctor($self);

    my ($sock, $listener) = @_;

    ${*$sock}->{_danga_socket} = $self;
    $self->{listener} = $listener;
    $self->{alive_time} = $self->{create_time} = time;

    $self->SUPER::new($sock);

    # TODO: would be good to have an overall timeout so that we can
    # kill sockets that are open and just sitting there.  "ssl_handshake_timeout"
    # or something like that...

    return $self;
}

# this is nonblocking, it attempts to setup SSL and if it can't then
# it returns whether it needs to read or write.  we then setup to wait
# for the event it indicates and then wait.  when that event fires, we
# call down again, and repeat the process until we have setup the
# SSL connection.
sub try_accept {
    my Perlbal::SocketSSL $self = shift;

    my $sock = $self->{sock}->accept_SSL;

    if (defined $sock) {
        # looks like we got it!  let's steal it from ourselves
        # so Danga::Socket gives up on it and we can send
        # it out to someone else.  (we discard the return value
        # as we already have it in $sock)
        #
        # of course, life isn't as simple as that.  we have to do
        # some trickery with the ordering here to ensure that we
        # don't setup the new class until after the Perlbal::SocketSSL
        # goes away according to Danga::Socket.
        # 
        # if we don't do it this way, we get nasty errors because
        # we (this object) still exists in the DescriptorMap of
        # Danga::Socket when the new Perlbal::ClientXX tries to
        # insert itself there.

        # removes us from the active polling, closes up shop, but
        # save our fd first!
        my $fd = $self->{fd};
        $self->steal_socket;

        # finish blowing us away
        my $ref = Danga::Socket->DescriptorMap();
        delete $ref->{$fd};

        # now stick the new one in
        my Perlbal::ClientHTTPBase $cb = $self->{listener}->class_new_socket($sock);
        $cb->{is_ssl} = 1;
        return;
    }

    # nope, let's see if we can continue the process
    if ($! == EAGAIN) {
        if ($SSL_ERROR == SSL_WANT_READ) {
            $self->watch_read(1);
        } elsif ($SSL_ERROR == SSL_WANT_WRITE) {
            $self->watch_write(1);
        } else {
            $self->close('invalid_ssl_state');
        }
    } else {
        $self->close('invalid_ssl_error');
    }
}

sub event_read {
    $_[0]->watch_read(0);
    $_[0]->{alive_time} = $Perlbal::tick_time;
    $_[0]->try_accept;
}

sub event_write {
    $_[0]->watch_write(0);
    $_[0]->{alive_time} = $Perlbal::tick_time;
    $_[0]->try_accept;
}

sub event_err {
    $_[0]->close('invalid_ssl_state');
}

# You can tuna-fish, but you can't tune a Perlbal::SocketSSL
sub max_idle_time {
    return 60;
}

package Perlbal::SocketSSL2;

use strict;
use warnings;

use IO::Socket::SSL;

use base 'IO::Socket::SSL';

sub close {
    my $self = shift
        or return IO::Socket::SSL::_invalid_object();

    # If we our Danga::Socket sibling has a sock then we're being called for the first time.
    # NOTE: this isn't strictly safe, ->close can get called on a sock multiple times. We
    #       really could use a safe way to know if this handle is being called from the post-
    #       event-loop cleanup code in Danga::Socket.
    if (my $ds = ${*$self}->{_danga_socket}) {
        ${*$self}->{__close_args} = [ @_ ];
        delete ${*$self}->{_danga_socket};
        $ds->close('intercepted_ssl_close')
            if $ds->sock;
    } else {
        return $self->SUPER::close(@{${*$self}->{__close_args}});
    }
}

1;