This file is indexed.

/usr/lib/perl5/Net/SSL.pm is in libcrypt-ssleay-perl 0.57-2ubuntu1.

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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
package Net::SSL;

use strict;
use MIME::Base64;
use Socket;
use Carp;

use vars qw(@ISA $VERSION $NEW_ARGS);
$VERSION = '2.84';

require IO::Socket;
@ISA=qw(IO::Socket::INET);

my %REAL; # private to this package only
my $DEFAULT_VERSION = '23';
my $CRLF = "\015\012";
my $SEND_USERAGENT_TO_PROXY = 0;

require Crypt::SSLeay;

sub _default_context {
    require Crypt::SSLeay::MainContext;
    Crypt::SSLeay::MainContext::main_ctx(@_);
}

sub _alarm_set {
    return if $^O eq 'MSWin32' or $^O eq 'NetWare';
    alarm(shift);
}

sub new {
    my($class, %arg) = @_;
    local $NEW_ARGS = \%arg;
    $class->SUPER::new(%arg);
}

sub DESTROY {
    my $self = shift;
    delete $REAL{$self};
    local $@;
    eval { $self->SUPER::DESTROY; };
}

sub configure {
    my($self, $arg) = @_;
    my $ssl_version = delete $arg->{SSL_Version} ||
      $ENV{HTTPS_VERSION} || $DEFAULT_VERSION;
    my $ssl_debug = delete $arg->{SSL_Debug} || $ENV{HTTPS_DEBUG} || 0;

    my $ctx = delete $arg->{SSL_Context} || _default_context($ssl_version);

    *$self->{ssl_ctx} = $ctx;
    *$self->{ssl_version} = $ssl_version;
    *$self->{ssl_debug} = $ssl_debug;
    *$self->{ssl_arg} = $arg;
    *$self->{ssl_peer_addr} = $arg->{PeerAddr};
    *$self->{ssl_peer_port} = $arg->{PeerPort};
    *$self->{ssl_new_arg} = $NEW_ARGS;
    *$self->{ssl_peer_verify} = 0;

    ## Crypt::SSLeay must also aware the SSL Proxy before calling
    ## $socket->configure($args). Because the $sock->configure() will
    ## die when failed to resolve the destination server IP address,
    ## whether the SSL proxy is used or not!
    ## - dqbai, 2003-05-10
    if (my $proxy = $self->proxy) {
        ($arg->{PeerAddr}, $arg->{PeerPort}) = split(':',$proxy);
        $arg->{PeerPort} || croak("no port given for proxy server $proxy");
    }

    $self->SUPER::configure($arg);
}

# override to make sure there is really a timeout
sub timeout {
    shift->SUPER::timeout || 60;
}

sub blocking {
    my $self = shift;
    $self->SUPER::blocking(@_);
}

sub connect {
    my $self = shift;

    # configure certs on connect() time, so we can throw an undef
    # and have LWP understand the error
    eval { $self->configure_certs() };
    if($@) {
        $@ = "configure certs failed: $@; $!";
        $self->die_with_error($@);
    }

    # finished, update set_verify status
    if(my $rv = *$self->{ssl_ctx}->set_verify()) {
        *$self->{ssl_peer_verify} = $rv;
    }

    if ($self->proxy) {
        # don't die() in connect, just return undef and set $@
        my $proxy_connect = eval { $self->proxy_connect_helper(@_) };
        if(! $proxy_connect || $@) {
            $@ = "proxy connect failed: $@; $!";
            croak($@);
        }
    }
    else {
        *$self->{io_socket_peername}=@_ == 1 ? $_[0] : IO::Socket::sockaddr_in(@_);    
        if(!$self->SUPER::connect(@_)) {
            # better to die than return here
            $@ = "Connect failed: $@; $!";
            croak($@);
        }
    }

    my $debug = *$self->{ssl_debug} || 0;
    my $ssl = Crypt::SSLeay::Conn->new(*$self->{ssl_ctx}, $debug, $self);
    my $arg = *$self->{ssl_arg};
    my $new_arg = *$self->{ssl_new_arg};
    $arg->{SSL_Debug} = $debug;

    eval {
        local $SIG{ALRM} = sub { $self->die_with_error("SSL connect timeout") };
        # timeout / 2 because we have 3 possible connects here
        _alarm_set($self->timeout / 2);

        my $rv;
        {
            local $SIG{PIPE} = \¨
            $rv = eval { $ssl->connect; };
        }
        if (not defined $rv or $rv <= 0) {
            _alarm_set(0);
            $ssl = undef;
            my %args = (%$new_arg, %$arg);
            if(*$self->{ssl_version} == 23) {
                $args{SSL_Version} = 3;
                # the new connect might itself be overridden with a REAL SSL
                my $new_ssl = Net::SSL->new(%args);
                $REAL{$self} = $REAL{$new_ssl} || $new_ssl;
                return $REAL{$self};
            }
            elsif(*$self->{ssl_version} == 3) {
                # $self->die_with_error("SSL negotiation failed");
                $args{SSL_Version} = 2;
                my $new_ssl = Net::SSL->new(%args);
                $REAL{$self} = $new_ssl;
                return $new_ssl;
            }
			else {
                # don't die, but do set $@, and return undef
                eval { $self->die_with_error("SSL negotiation failed") };
                croak($@);
            }
        }
        _alarm_set(0);
    };

    # odd error in eval {} block, maybe alarm outside the evals
    if($@) {
        $@ = "$@; $!";
        croak($@);
    }

    # successful SSL connection gets stored
    *$self->{ssl_ssl} = $ssl;
    $self;
}

# Delegate these calls to the Crypt::SSLeay::Conn object
sub get_peer_certificate { 
    my $self = shift;
    $self = $REAL{$self} || $self;
    *$self->{ssl_ssl}->get_peer_certificate(@_);
}

sub get_peer_verify {
    my $self = shift;
    $self = $REAL{$self} || $self;
    *$self->{ssl_peer_verify};
}

sub get_shared_ciphers { 
    my $self = shift;
    $self = $REAL{$self} || $self;
    *$self->{ssl_ssl}->get_shared_ciphers(@_);
}

sub get_cipher { 
    my $self = shift;
    $self = $REAL{$self} || $self;
    *$self->{ssl_ssl}->get_cipher(@_);
}

sub ssl_context {
    my $self = shift;
    $self = $REAL{$self} || $self;
    *$self->{ssl_ctx};
}

sub die_with_error {
    my $self=shift;
    my $reason=shift;

    my @err;
    while(my $err=Crypt::SSLeay::Err::get_error_string()) {
       push @err, $err;
    }
    croak("$reason: " . join( ' | ', @err ));
}

sub read {
    my $self = shift;
    $self = $REAL{$self} || $self;

    local $SIG{__DIE__} = \&Carp::confess;
    local $SIG{ALRM} = sub { $self->die_with_error("SSL read timeout") };

    _alarm_set($self->timeout);
    my $n = *$self->{ssl_ssl}->read(@_);
    _alarm_set(0);
    $self->die_with_error("read failed") if !defined $n;

    $n;
}

sub write {
    my $self = shift;
    $self = $REAL{$self} || $self;
    my $n = *$self->{ssl_ssl}->write(@_);
    $self->die_with_error("write failed") if !defined $n;
    $n;
}

*sysread  = \&read;
*syswrite = \&write;

sub print {
    my $self = shift;
    $self = $REAL{$self} || $self;
    # should we care about $, and $\??
    # I think it is too expensive...
    $self->write(join("", @_));
}

sub printf {
    my $self = shift;
    $self = $REAL{$self} || $self;
    my $fmt = shift;
    $self->write(sprintf($fmt, @_));
}

sub getchunk {
    my $self = shift;
    $self = $REAL{$self} || $self;
    my $buf = '';  # warnings
    my $n = $self->read($buf, 32768);
    return unless defined $n;
    $buf;
}

# This is really inefficient, but we only use it for reading the proxy response
# so that does not really matter.
sub getline {
    my $self = shift;
    $self = $REAL{$self} || $self;
    my $val="";
    my $buf;
    do {
        $self->SUPER::recv($buf, 1);
        $val .= $buf;
    } until ($buf eq "\n");

    $val;
}

# XXX: no way to disable <$sock>??  (tied handle perhaps?)

sub get_lwp_object {
    my $self = shift;

    my $lwp_object;
    my $i = 0;
    while(1) {
        package DB;
        my @stack = caller($i++);
        last unless @stack;
        my @stack_args = @DB::args;
        my $stack_object = $stack_args[0] || next;
        return $stack_object
            if ref($stack_object)
                and $stack_object->isa('LWP::UserAgent');
    }
    return undef;
}

sub send_useragent_to_proxy {
    if (my $val = shift) {
        $SEND_USERAGENT_TO_PROXY = $val;
    }
    return $SEND_USERAGENT_TO_PROXY;
}

sub proxy_connect_helper {
    my $self = shift;

    my $proxy = $self->proxy;
    my ($proxy_host, $proxy_port) = split(':',$proxy);
    $proxy_port || croak("no port given for proxy server $proxy");

    my $proxy_addr = gethostbyname($proxy_host);
    $proxy_addr || croak("can't resolve proxy server name: $proxy_host, $!");
    
    my($peer_port, $peer_addr) = (*$self->{ssl_peer_port}, *$self->{ssl_peer_addr});
    $peer_addr || croak("no peer addr given");
    $peer_port || croak("no peer port given");

    # see if the proxy should be bypassed
    my @no_proxy = split( /\s*,\s*/, $ENV{NO_PROXY} || $ENV{no_proxy} || '');
    my $is_proxied = 1;
    my $domain;
    for $domain (@no_proxy) {
        if ($peer_addr =~ /\Q$domain\E$/) {
            $is_proxied = 0;
            last;
        }
    }

    if ($is_proxied) {
        $self->SUPER::connect($proxy_port, $proxy_addr)
          || croak("proxy connect to $proxy_host:$proxy_port failed: $!");
    }
    else {
        $self->SUPER::connect($peer_port, $peer_addr)
          || croak("proxy bypass to $peer_addr:$peer_addr failed: $!");
    }

    my $connect_string;
    if ($ENV{"HTTPS_PROXY_USERNAME"} || $ENV{"HTTPS_PROXY_PASSWORD"}) {
        my $user = $ENV{"HTTPS_PROXY_USERNAME"};
        my $pass = $ENV{"HTTPS_PROXY_PASSWORD"};

        my $credentials = encode_base64("$user:$pass", "");
        $connect_string = join($CRLF, 
            "CONNECT $peer_addr:$peer_port HTTP/1.0",
            "Proxy-authorization: Basic $credentials"
        );
    }
    else {
        $connect_string = "CONNECT $peer_addr:$peer_port HTTP/1.0";
    }
    $connect_string .= $CRLF;

    if (send_useragent_to_proxy()) {
        my $lwp_object = $self->get_lwp_object;
        if($lwp_object && $lwp_object->agent) {
            $connect_string .= "User-Agent: ".$lwp_object->agent.$CRLF;
        }
    }

    $connect_string .= $CRLF;
    $self->SUPER::send($connect_string);
    my $header;
    my $n = $self->SUPER::sysread($header, 8192);
    my $conn_ok = ($header =~ /HTTP\/\d+\.\d+\s+200\s+/is) ? 1 : 0;

    if (not $conn_ok) {
        croak("PROXY ERROR HEADER, could be non-SSL URL:\n$header");
    }

    $conn_ok;
}

# code adapted from LWP::UserAgent, with $ua->env_proxy API
sub proxy {
    my $proxy_server = $ENV{HTTPS_PROXY} || $ENV{https_proxy};
    return unless $proxy_server;

    $proxy_server =~ s|\Ahttps?://||i;
    $proxy_server;
}

sub configure_certs {
    my $self = shift;
    my $ctx = *$self->{ssl_ctx};

    my $count = 0;
    for (qw(HTTPS_PKCS12_FILE HTTPS_CERT_FILE HTTPS_KEY_FILE)) {
        my $file = $ENV{$_};
        if ($file) {
            (-e $file) or croak("$file file does not exist: $!");
            (-r $file) or croak("$file file is not readable");
            $count++;
            if (/PKCS12/) {
                $count++;
                $ctx->use_pkcs12_file($file ,$ENV{'HTTPS_PKCS12_PASSWORD'}) || croak("failed to load $file: $!");
                last;
            }
            elsif (/CERT/) {
                $ctx->use_certificate_file($file ,1) || croak("failed to load $file: $!");
            }
            elsif (/KEY/) {
                $ctx->use_PrivateKey_file($file, 1) || croak("failed to load $file: $!");
            }
            else {
                croak("setting $_ not supported");
            }
        }
    }

    # if both configs are set, then verify them
    if ($count == 2) {
        if (! $ctx->check_private_key) {
            croak("Private key and certificate do not match");
        }
    }
    
    $count; # number of successful cert loads/checks
}

sub accept   { shift->_unimpl("accept") }
sub getc     { shift->_unimpl("getc")   }
sub ungetc   { shift->_unimpl("ungetc") }
sub getlines { shift->_unimpl("getlines"); }

sub _unimpl {
    my($self, $meth) = @_;
    croak("$meth not implemented for Net::SSL sockets");
}

1;

__END__

=head1 NAME

Net::SSL - support for Secure Sockets Layer

=head1 METHODS

=over 4

=item new

Creates a new C<Net::SSL> object.

=item configure

Configures a C<Net::SSL> socket for operation.

=item configure_certs

Sets up a certificate file to use for communicating with on
the socket.

=item connect

=item die_with_error

=item get_cipher

=item get_lwp_object

Walks up the caller stack and looks for something blessed into
the C<LWP::UserAgent> namespace and returns it. Vaguely deprecated.

=item get_peer_certificate

Gets the peer certificate from the underlying C<Crypt::SSLeay::Conn>
object.

=item get_peer_verify

=item get_shared_ciphers

=item getchunk

Attempts to read up to 32KiB of data from the socket. Returns
C<undef> if nothing was read, otherwise returns the data as
a scalar.

=item getline

Reads one character at a time until a newline is encountered,
and returns the line, including the newline. Grossly
inefficient.

=item print

Concatenates the input parameters and writes them to the socket.
Does not honour C<$,> nor C<$/>. Returns the number of bytes written.

=item printf

Performs a C<sprintf> of the input parameters (thus, the first
parameter must be the format), and writes the result to the socket.
Returns the number of bytes written.

=item proxy

Returns the hostname of an https proxy server, as specified by the
C<HTTPS_PROXY> environment variable.

=item proxy_connect_helper

Helps set up a connection through a proxy.

=item read

Performs a read on the socket and returns the result.

=item ssl_context

=item sysread

Is an alias of C<read>.

=item timeout

Returns the timeout value of the socket as defined by the implementing
class or 60 seconds by default.

=item blocking

Returns a boolean indicating whether the underlying socket is in
blocking mode. By default, Net::SSL sockets are in blocking mode.

    $sock->blocking(0); # set to non-blocking mode

This method simply calls the underlying C<blocking> method of the
IO::Socket object.

=item write

Writes the parameters passed in (thus, a list) to the socket. Returns
the number of bytes written.

=item syswrite

Is an alias of C<write>.

=item accept

Not yet implemented. Will die if called.

=item getc

Not yet implemented. Will die if called.

=item getlines

Not yet implemented. Will die if called.

=item ungetc

Not yet implemented. Will die if called.

=item send_useragent_to_proxy

By default (as of version 2.80 of C<Net::SSL> in the 0.54 distribution
of Crypt::SSLeay), the user agent string is no longer sent to the
proxy (but will continue to be sent to the remote host).

The previous behaviour was of marginal benefit, and could cause
fatal errors in certain scenarios (see CPAN bug #4759) and so no
longer happens by default.

To reinstate the old behaviour, call C<Net::SSL::send_useragent_to_proxy>
with a true value (usually 1).

=back

=head1 DIAGNOSTICS

  "no port given for proxy server <proxy>"

A proxy was specified for configuring a socket, but no port number
was given. Ensure that the proxy is specified as a host:port pair,
such as C<proxy.example.com:8086>.

  "configure certs failed: <contents of $@>; <contents of $!>"

  "proxy connect failed: <contents of $@>; <contents of $!>"

  "Connect failed: <contents of $@>; <contents of $!>"

During connect().

=head2 SEE ALSO

=over 4

=item IO::Socket::INET

C<Net::SSL> is implemented by subclassing C<IO::Socket::INET>, hence
methods not specifically overridden are defined by that package.

=item Net::SSLeay

A package that provides a Perl-level interface to the C<openssl>
secure sockets layer library.

=back

=cut