1#
2# Licensed to the Apache Software Foundation (ASF) under one
3# or more contributor license agreements. See the NOTICE file
4# distributed with this work for additional information
5# regarding copyright ownership. The ASF licenses this file
6# to you under the Apache License, Version 2.0 (the
7# "License"); you may not use this file except in compliance
8# with the License. You may obtain a copy of the License at
9#
10#   http://www.apache.org/licenses/LICENSE-2.0
11#
12# Unless required by applicable law or agreed to in writing,
13# software distributed under the License is distributed on an
14# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15# KIND, either express or implied. See the License for the
16# specific language governing permissions and limitations
17# under the License.
18#
19
20use 5.10.0;
21use strict;
22use warnings;
23
24use Thrift;
25use Thrift::Socket;
26
27use IO::Socket::SSL;
28
29package Thrift::SSLSocket;
30use base qw( Thrift::Socket );
31use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
32
33#
34# Construction and usage
35#
36# my $opts = {}
37# my $socket = Thrift::SSLSocket->new(\%opts);
38#
39# options:
40#
41# Any option from Socket.pm is valid, and then:
42#
43# ca          => certificate authority file (PEM file) to authenticate the
44#                server against; if not specified then the server is not
45#                authenticated
46# cert        => certificate to use as the client; if not specified then
47#                the client does not present one but still connects using
48#                secure protocol
49# ciphers     => allowed cipher list
50#                (see http://www.openssl.org/docs/apps/ciphers.html#CIPHER_STRINGS)
51# key         => certificate key for "cert" option
52# version     => acceptable SSL/TLS versions - if not specified then the
53#                default is to use SSLv23 handshake but only negotiate
54#                at TLSv1.0 or later
55#
56
57sub new
58{
59    my $classname = shift;
60    my $self      = $classname->SUPER::new(@_);
61
62    return bless($self, $classname);
63}
64
65sub __open
66{
67    my $self = shift;
68    my $opts = {PeerAddr      => $self->{host},
69                PeerPort      => $self->{port},
70                Proto         => 'tcp',
71                Timeout       => $self->{sendTimeout} / 1000};
72
73    my $verify = IO::Socket::SSL::SSL_VERIFY_PEER | IO::Socket::SSL::SSL_VERIFY_FAIL_IF_NO_PEER_CERT | IO::Socket::SSL::SSL_VERIFY_CLIENT_ONCE;
74
75    $opts->{SSL_ca_file}      = $self->{ca}      if defined $self->{ca};
76    $opts->{SSL_cert_file}    = $self->{cert}    if defined $self->{cert};
77    $opts->{SSL_cipher_list}  = $self->{ciphers} if defined $self->{ciphers};
78    $opts->{SSL_key_file}     = $self->{key}     if defined $self->{key};
79    $opts->{SSL_use_cert}     = (defined $self->{cert}) ? 1 : 0;
80    $opts->{SSL_verify_mode}  = (defined $self->{ca}) ? $verify : IO::Socket::SSL::SSL_VERIFY_NONE;
81    $opts->{SSL_version}      = (defined $self->{version}) ? $self->{version} : 'SSLv23:!SSLv3:!SSLv2';
82
83    return IO::Socket::SSL->new(%$opts);
84}
85
86sub __close
87{
88    my $self = shift;
89    my $sock = ($self->{handle}->handles())[0];
90    if ($sock) {
91      $sock->close(SSL_no_shutdown => 1);
92    }
93}
94
95sub __recv
96{
97  my $self = shift;
98  my $sock = shift;
99  my $len = shift;
100  my $buf = undef;
101  if ($sock) {
102    sysread($sock, $buf, $len);
103  }
104  return $buf;
105}
106
107sub __send
108{
109    my $self = shift;
110    my $sock = shift;
111    my $buf = shift;
112    return syswrite($sock, $buf);
113}
114
115sub __wait
116{
117    my $self = shift;
118    my $sock = ($self->{handle}->handles())[0];
119    if ($sock and $sock->pending() eq 0) {
120        return $self->SUPER::__wait();
121    }
122    return $sock;
123}
124
125
1261;
127