line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Thrift::SASL::Transport; |
2
|
|
|
|
|
|
|
$Thrift::SASL::Transport::VERSION = '0.007'; |
3
|
1
|
|
|
1
|
|
62570
|
use strict; |
|
1
|
|
|
|
|
9
|
|
|
1
|
|
|
|
|
25
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
52
|
|
5
|
1
|
|
|
1
|
|
559
|
use Data::Dumper; |
|
1
|
|
|
|
|
5863
|
|
|
1
|
|
|
|
|
53
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
# Nasty hack to make the Thrift libs handle the extra 4-bytes |
8
|
|
|
|
|
|
|
# header put by GSSAPI in front of unencoded (auth only) replies |
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
394
|
use Thrift::BinaryProtocol; |
|
1
|
|
|
|
|
17899
|
|
|
1
|
|
|
|
|
39
|
|
11
|
|
|
|
|
|
|
my $real_readMessageBegin = \&Thrift::BinaryProtocol::readMessageBegin; |
12
|
|
|
|
|
|
|
{ |
13
|
1
|
|
|
1
|
|
6
|
no warnings 'redefine'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
105
|
|
14
|
|
|
|
|
|
|
*Thrift::BinaryProtocol::readMessageBegin = \&BinaryProtocolOverride_readMessageBegin; |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub BinaryProtocolOverride_readMessageBegin { |
18
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
19
|
0
|
0
|
0
|
|
|
|
if ( $self->{trans}{_sasl_client} && !$self->{trans}{_sasl_encode} ) { |
20
|
0
|
|
|
|
|
|
$self->readI32( \my $foo ); # discard GSSAPI auth header (message length) |
21
|
|
|
|
|
|
|
} |
22
|
0
|
|
|
|
|
|
return $real_readMessageBegin->( $self, @_ ); |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# end of nasty hack, phew. |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
use constant { |
28
|
1
|
|
|
|
|
1391
|
SASL_START => 1, |
29
|
|
|
|
|
|
|
SASL_OK => 2, |
30
|
|
|
|
|
|
|
SASL_BAD => 3, |
31
|
|
|
|
|
|
|
SASL_ERROR => 4, |
32
|
|
|
|
|
|
|
SASL_COMPLETE => 5, |
33
|
1
|
|
|
1
|
|
7
|
}; |
|
1
|
|
|
|
|
2
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub new { |
36
|
0
|
|
|
0
|
0
|
|
my ( $class, $transport, $sasl, $debug, $principal ) = @_; |
37
|
0
|
0
|
0
|
|
|
|
return bless { |
38
|
|
|
|
|
|
|
_transport => $transport, |
39
|
|
|
|
|
|
|
_sasl => $sasl, |
40
|
|
|
|
|
|
|
_debug => $debug || 0, |
41
|
|
|
|
|
|
|
($principal ? (_principal => $principal): ()), |
42
|
|
|
|
|
|
|
}, $class; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub _sasl_write { |
46
|
0
|
|
|
0
|
|
|
my ( $self, $code, $payload ) = @_; |
47
|
0
|
|
0
|
|
|
|
$payload //= ''; |
48
|
0
|
|
|
|
|
|
print STDERR "<< code $code + payload (@{[bytes::length($payload)]} bytes)\n" |
49
|
0
|
0
|
|
|
|
|
if $self->{_debug}; |
50
|
0
|
|
|
|
|
|
$self->{_transport}->write( pack "CN", $code, bytes::length($payload) ); |
51
|
0
|
|
|
|
|
|
$self->{_transport}->write($payload); |
52
|
0
|
|
|
|
|
|
$self->{_transport}->flush; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub _sasl_read { |
56
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
57
|
0
|
|
|
|
|
|
my $data = $self->read(5); |
58
|
0
|
0
|
|
|
|
|
die "No data from server" unless defined $data; |
59
|
0
|
|
|
|
|
|
my ( $code, $length ) = unpack "CN", $data; |
60
|
0
|
0
|
|
|
|
|
if ($length) { |
61
|
0
|
|
|
|
|
|
$data = $self->read($length); |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
else { |
64
|
0
|
|
|
|
|
|
$data = undef; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
print STDERR ">> code $code + response ($length bytes)\n" |
67
|
0
|
0
|
|
|
|
|
if $self->{_debug}; |
68
|
0
|
|
|
|
|
|
return ( $code, $data ); |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub open { |
72
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
73
|
0
|
0
|
0
|
|
|
|
$self->{_transport}->open if !( $self->{_transport} && $self->isOpen ); |
74
|
0
|
0
|
|
|
|
|
die "Could not open transport" if !$self->isOpen; |
75
|
0
|
|
0
|
|
|
|
return $self->{_sasl_client} || $self->_sasl_handshake; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub close { |
79
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
80
|
0
|
0
|
0
|
|
|
|
$self->{_transport}->close if $self->{_transport} && $self->isOpen; |
81
|
0
|
|
|
|
|
|
return 1; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub _sasl_handshake { |
85
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
print STDERR "SASL start: " |
88
|
0
|
0
|
|
|
|
|
if $self->{_debug}; |
89
|
0
|
|
|
|
|
|
$self->_sasl_write( SASL_START, $self->{_sasl}->mechanism ); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# The socket passed to BufferedTransport was put in that object's |
92
|
|
|
|
|
|
|
# "transport" property, this is a bit confusing imho |
93
|
0
|
|
|
|
|
|
my $client; |
94
|
0
|
0
|
|
|
|
|
if($self->{_sasl}->mechanism eq 'GSSAPI'){ |
|
|
0
|
|
|
|
|
|
95
|
0
|
0
|
|
|
|
|
if(!$self->{_principal}){ |
96
|
0
|
|
|
|
|
|
die "Principal needs to be specified for kerberos authentication." |
97
|
|
|
|
|
|
|
} |
98
|
0
|
|
|
|
|
|
my @kerberos_name_split = split('[/@]', $self->{_principal}); |
99
|
0
|
0
|
|
|
|
|
if(scalar @kerberos_name_split != 3){ |
100
|
0
|
|
|
|
|
|
die "Kerberos principal name should have 3 parts. Eg: hive/_HOST\@REALM.COM"; |
101
|
|
|
|
|
|
|
} |
102
|
0
|
|
|
|
|
|
$client = $self->{_sasl}->client_new( $kerberos_name_split[0], $kerberos_name_split[1] ); |
103
|
|
|
|
|
|
|
}elsif($self->{_sasl}->mechanism eq 'DIGEST-MD5'){ |
104
|
|
|
|
|
|
|
# Server is configured with null and default for authentication with delegationtoken. |
105
|
0
|
|
|
|
|
|
$client = $self->{_sasl}->client_new( 'null', 'default' ); |
106
|
|
|
|
|
|
|
}else{ |
107
|
|
|
|
|
|
|
#Keeping this line here for keep support for other mechanisms. |
108
|
0
|
|
|
|
|
|
$client = $self->{_sasl}->client_new( 'hive', $self->{_transport}{transport}{host} ); |
109
|
|
|
|
|
|
|
} |
110
|
0
|
|
|
|
|
|
my $resp = $client->client_start(); |
111
|
|
|
|
|
|
|
|
112
|
0
|
|
|
|
|
|
my $step; |
113
|
0
|
|
|
|
|
|
while ( ++$step ) { |
114
|
|
|
|
|
|
|
print STDERR "SASL step $step: " |
115
|
0
|
0
|
|
|
|
|
if $self->{_debug}; |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
#print STDERR Dumper{map {$_ => [$client->$_()]} qw(error code mechanism need_step)}; |
118
|
0
|
|
|
|
|
|
$self->_sasl_write( SASL_OK, $resp ); |
119
|
0
|
|
|
|
|
|
my ( $code, $data ) = $self->_sasl_read(); |
120
|
|
|
|
|
|
|
|
121
|
0
|
0
|
|
|
|
|
if ( $code == SASL_COMPLETE ) { |
122
|
|
|
|
|
|
|
print STDERR "Authentication OK\n" |
123
|
0
|
0
|
|
|
|
|
if $self->{_debug}; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
#$client->client_step($data // '') if $client->need_step; |
126
|
0
|
|
|
|
|
|
last; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
|
my $extra_msg = $self->__probe_env_and_xs_sasl_bug( $client ); |
130
|
|
|
|
|
|
|
|
131
|
0
|
0
|
0
|
|
|
|
if ( $code == SASL_BAD || $code == SASL_ERROR ) { |
132
|
0
|
0
|
|
|
|
|
die sprintf "Authentication failed: %s > %s%s", |
133
|
|
|
|
|
|
|
$code, |
134
|
|
|
|
|
|
|
$data, |
135
|
|
|
|
|
|
|
$extra_msg ? '. ' . $extra_msg : '', |
136
|
|
|
|
|
|
|
; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
|
$resp = $client->client_step($data); |
140
|
0
|
0
|
|
|
|
|
if ( ! defined $data ) { |
141
|
0
|
0
|
|
|
|
|
die sprintf 'Client rejected authentication%s', |
142
|
|
|
|
|
|
|
$extra_msg ? '. ' . $extra_msg : '', |
143
|
|
|
|
|
|
|
; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
$self->{_sasl_encode_check} = 1; |
148
|
0
|
|
|
|
|
|
$self->{_sasl_client} = $client; |
149
|
|
|
|
|
|
|
|
150
|
0
|
|
|
|
|
|
return $self->{_sasl_client}; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub __probe_env_and_xs_sasl_bug { |
154
|
|
|
|
|
|
|
# See: https://github.com/Perl-Hadoop/Thrift-SASL/issues/1 |
155
|
|
|
|
|
|
|
# |
156
|
0
|
|
|
0
|
|
|
my($self, $client) = @_; |
157
|
0
|
0
|
0
|
|
|
|
return if ! $client->isa('Authen::SASL::XS') |
158
|
|
|
|
|
|
|
&& ! $client->isa('Authen::SASL::Cyrus') |
159
|
|
|
|
|
|
|
; |
160
|
|
|
|
|
|
|
|
161
|
0
|
0
|
0
|
|
|
|
return if exists $ENV{USER} || exists $ENV{USERNAME}; |
162
|
|
|
|
|
|
|
|
163
|
0
|
|
|
|
|
|
my $sasl_class = ref $client; |
164
|
|
|
|
|
|
|
|
165
|
0
|
|
|
|
|
|
return join ' ', |
166
|
|
|
|
|
|
|
"cyrus-sasl and in turn $sasl_class needs either USER or USERNAME", |
167
|
|
|
|
|
|
|
'environment variable to be present and they seem to be missing', |
168
|
|
|
|
|
|
|
'in your environment.', |
169
|
|
|
|
|
|
|
'The error you have received might be caused by that.', |
170
|
|
|
|
|
|
|
; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub write { |
174
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
175
|
0
|
|
|
|
|
|
my $buffer = shift; |
176
|
|
|
|
|
|
|
print STDERR "<< writing " . bytes::length($buffer) . " bytes\n" |
177
|
0
|
0
|
|
|
|
|
if $self->{_debug} > 1; |
178
|
0
|
|
|
|
|
|
$self->{_out_buffer} .= $buffer; |
179
|
0
|
|
|
|
|
|
return 1; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub read { |
183
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
184
|
0
|
|
|
|
|
|
my @passthru_args = @_; |
185
|
|
|
|
|
|
|
print STDERR ">> reading\n" |
186
|
0
|
0
|
|
|
|
|
if $self->{_debug}; |
187
|
0
|
|
|
|
|
|
my $buf = $self->{_transport}->read(@passthru_args); |
188
|
0
|
0
|
|
|
|
|
return $buf if bytes::length($buf) > 0; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# not sure about this, it is copied over from the python version |
191
|
0
|
|
|
|
|
|
$self->_read_frame(); |
192
|
0
|
|
|
|
|
|
return $self->{_transport}->read(@passthru_args); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# completely unsure about this, taken from the python version when trying to |
196
|
|
|
|
|
|
|
# make the whole thing work, turned out my problem was with the BinaryProtocol |
197
|
|
|
|
|
|
|
# needing a 4-byte offset on readMessageBegin as kerberos auth adds a 4 bytes |
198
|
|
|
|
|
|
|
# header to replies, which was mistakenly used as the expected thrift header. |
199
|
|
|
|
|
|
|
# leaving this in place in case it is actually needed (probably not working |
200
|
|
|
|
|
|
|
# in the current state though) |
201
|
|
|
|
|
|
|
sub _read_frame { |
202
|
0
|
|
|
0
|
|
|
my $self = shift; |
203
|
0
|
|
|
|
|
|
my $header = $self->{_transport}->readAll(4); |
204
|
0
|
|
|
|
|
|
my $length = unpack( "N", $header ); |
205
|
0
|
|
|
|
|
|
my $decoded; |
206
|
0
|
0
|
|
|
|
|
if ( $self->{_sasl_encode} ) { |
207
|
0
|
|
|
|
|
|
my $encoded = $header . $self->{_transport}->readAll($length); |
208
|
0
|
0
|
|
|
|
|
my $decoded = $self->{_sasl_client}->decode($encoded) |
209
|
|
|
|
|
|
|
or die 'SASL decode returned nothing'; |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# TODO throw a real per TTransportException like the python version |
212
|
|
|
|
|
|
|
#die "SASL decode error: " . |
213
|
|
|
|
|
|
|
# raise TTransportException(type=TTransportException.UNKNOWN, |
214
|
|
|
|
|
|
|
# message=self.sasl.getError()) |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
else { |
217
|
0
|
|
|
|
|
|
$decoded = $self->{_transport}->readAll($length); |
218
|
|
|
|
|
|
|
} |
219
|
0
|
|
|
|
|
|
$self->{_transport}{rBuf} = $decoded; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
sub flush { |
223
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
print STDERR "<<< flush " . bytes::length( $self->{_out_buffer} ) . " bytes \n" |
226
|
0
|
0
|
|
|
|
|
if $self->{_debug}; |
227
|
|
|
|
|
|
|
|
228
|
0
|
0
|
|
|
|
|
if ( $self->{_sasl_encode_check} ) { |
229
|
0
|
|
|
|
|
|
my $encoded = $self->{_sasl_client}->encode( $self->{_out_buffer} ); |
230
|
0
|
0
|
0
|
|
|
|
if ( bytes::length($encoded) |
231
|
|
|
|
|
|
|
&& bytes::length($encoded) != bytes::length( $self->{_out_buffer} ) ) |
232
|
|
|
|
|
|
|
{ |
233
|
0
|
|
|
|
|
|
$self->{_sasl_encode} = 1; |
234
|
0
|
0
|
|
|
|
|
print STDERR "GSSAPI Will encode from now on\n" if $self->{_debug}; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
else { |
237
|
0
|
|
|
|
|
|
$self->{_sasl_encode} = 0; |
238
|
0
|
0
|
|
|
|
|
print STDERR "GSSAPI Will *not* encode from now on\n" if $self->{_debug}; |
239
|
|
|
|
|
|
|
} |
240
|
0
|
|
|
|
|
|
$self->{_sasl_encode_check} = undef; |
241
|
|
|
|
|
|
|
} |
242
|
0
|
0
|
|
|
|
|
if ( $self->{_sasl_encode} ) { |
243
|
0
|
|
|
|
|
|
$self->{_out_buffer} = $self->{_sasl_client}->encode( $self->{_out_buffer} ); |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
else { |
246
|
|
|
|
|
|
|
$self->{_out_buffer} |
247
|
0
|
|
|
|
|
|
= pack( "N", bytes::length( $self->{_out_buffer} ) ) . $self->{_out_buffer}; |
248
|
|
|
|
|
|
|
} |
249
|
0
|
|
|
|
|
|
$self->{_transport}->write( $self->{_out_buffer} ); |
250
|
0
|
|
|
|
|
|
$self->{_transport}->flush(); |
251
|
0
|
|
|
|
|
|
$self->{_out_buffer} = ''; |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
#print STDERR Dumper $self; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub isOpen { |
257
|
0
|
|
|
0
|
0
|
|
shift->{_transport}->isOpen(@_); |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub readAll { |
261
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
262
|
|
|
|
|
|
|
print STDERR ">>> readAll $_[0] bytes\n" |
263
|
0
|
0
|
|
|
|
|
if $self->{_debug} > 1; |
264
|
0
|
|
|
|
|
|
my $ret = $self->{_transport}->readAll(@_); |
265
|
0
|
|
|
|
|
|
return $ret; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
1; |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
#ABSTRACT: Thrift Transport allowing Kerberos auth/encryption through GSSAPI |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
__END__ |