File Coverage

lib/SMB/v1/Command/Negotiate.pm
Criterion Covered Total %
statement 9 24 37.5
branch 0 6 0.0
condition 0 3 0.0
subroutine 3 6 50.0
pod 0 3 0.0
total 12 42 28.5


line stmt bran cond sub pod time code
1             # SMB Perl library, Copyright (C) 2014-2018 Mikhael Goikhman, migo@cpan.org
2             #
3             # This program is free software: you can redistribute it and/or modify
4             # it under the terms of the GNU General Public License as published by
5             # the Free Software Foundation, either version 3 of the License, or
6             # (at your option) any later version.
7             #
8             # This program is distributed in the hope that it will be useful,
9             # but WITHOUT ANY WARRANTY; without even the implied warranty of
10             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11             # GNU General Public License for more details.
12             #
13             # You should have received a copy of the GNU General Public License
14             # along with this program. If not, see .
15              
16             package SMB::v1::Command::Negotiate;
17              
18 1     1   4284 use strict;
  1         3  
  1         35  
19 1     1   8 use warnings;
  1         3  
  1         37  
20              
21 1     1   7 use parent 'SMB::v1::Command';
  1         3  
  1         7  
22              
23             sub init ($) {
24 0     0 0   $_[0]->set(
25             dialect_names => [],
26             );
27             }
28              
29             sub parse ($$%) {
30 0     0 0   my $self = shift;
31 0           my $parser = shift;
32              
33 0 0         if ($self->is_response) {
34             # unsupported
35             } else {
36 0           $parser->skip(1); # word count
37             $self->dialect_names([
38 0           map { substr($_, 1) } grep { substr($_, 0, 1) eq "\x02" }
  0            
  0            
39             split("\x00", $parser->bytes($parser->uint16))
40             ]);
41             }
42              
43 0           return $self;
44             }
45              
46             sub supports_smb_dialect ($$) {
47 0     0 0   my $self = shift;
48 0           my $dialect0 = shift;
49              
50 0           for (@{$self->dialect_names}) {
  0            
51 0 0 0       return 1 if /^SMB (\d+)\.[0?](\d{2}|\?\?)/ && ($1 << 8 + ($2 eq '??' ? 0 : $2)) > $dialect0;
    0          
52             }
53              
54 0           return 0;
55             }
56              
57             1;