File Coverage

lib/SMB/v1/Header.pm
Criterion Covered Total %
statement 12 22 54.5
branch 0 2 0.0
condition 0 7 0.0
subroutine 4 8 50.0
pod 1 4 25.0
total 17 43 39.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::Header;
17              
18 1     1   8 use strict;
  1         3  
  1         29  
19 1     1   6 use warnings;
  1         3  
  1         43  
20              
21 1     1   10 use parent 'SMB::Header';
  1         3  
  1         8  
22              
23             use constant {
24             # the command is a response, otherwise a request
25 1         385 FLAGS_RESPONSE => 0x80,
26             # client supports signing, server forces signing
27             FLAGS2_SECURITY_SIGNATURE => 0x0004,
28             # client desires compression, server agrees to compress
29             FLAGS2_COMPRESSED => 0x0008,
30             # client supports signing, server forces signing
31             FLAGS2_SECURITY_SIGNATURE_REQUIRED => 0x0010,
32             # extended security negotiation is supported
33             FLAGS2_EXTENDED_SECURITY_NEGOTIATION => 0x0800,
34             # string are in Unicode (UTF-16LE) encoding
35             FLAGS2_UNICODE => 0x8000,
36             # NT statuses used
37             FLAGS2_NT_STATUS => 0x4000,
38 1     1   68 };
  1         2  
39              
40             sub new ($%) {
41 0     0 1   my $class = shift;
42 0           my %options = @_;
43              
44             return $class->SUPER::new(
45             pid => delete $options{pid} || 0,
46 0   0       flags2 => delete $options{flags2} || 0,
      0        
47             %options,
48             );
49             }
50              
51             sub is_response ($) {
52 0     0 0   my $self = shift;
53              
54 0 0         return $self->flags & FLAGS_RESPONSE ? 1 : 0;
55             }
56              
57             sub is_signed ($) {
58 0     0 0   my $self = shift;
59 0           my $signature = $self->signature;
60              
61 0   0       return ref($signature) eq 'ARRAY' && @$signature == 8 &&
62             (join('', $signature) ne "\0" x 8) &&
63             ($self->flags2 & FLAGS2_SECURITY_SIGNATURE) != 0;
64             }
65              
66             sub is_chained ($) {
67 0     0 0   my $self = shift;
68              
69 0           return 0;
70             }
71              
72             1;