File Coverage

lib/SMB/v2/Header.pm
Criterion Covered Total %
statement 12 22 54.5
branch 0 2 0.0
condition 0 14 0.0
subroutine 4 8 50.0
pod 1 4 25.0
total 17 50 34.0


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::v2::Header;
17              
18 2     2   16 use strict;
  2         6  
  2         67  
19 2     2   14 use warnings;
  2         4  
  2         68  
20              
21 2     2   14 use parent 'SMB::Header';
  2         6  
  2         10  
22              
23             use constant {
24             # the command is a response, otherwise a request
25 2         873 FLAGS_RESPONSE => 0x1,
26             # the command is asynchronous
27             FLAGS_ASYNC_COMMAND => 0x2,
28             # the command is continued, part of the chain
29             FLAGS_CHAINED => 0x4,
30             # the command is signed */
31             FLAGS_SIGNED => 0x8,
32             # DFS resolution is required
33             FLAGS_DFS => 0x10000000,
34 2     2   148 };
  2         5  
35              
36             sub new ($%) {
37 0     0 1   my $class = shift;
38 0           my %options = @_;
39              
40             return $class->SUPER::new(
41             aid => delete $options{aid} || 0,
42             credits => delete $options{credits} || 0,
43             credit_charge => delete $options{credit_charge} || ($options{code} ? 1 : 0),
44             chain_offset => delete $options{chain_offset} || 0,
45 0   0       struct_size => delete $options{struct_size} || 2,
      0        
      0        
      0        
      0        
46             %options,
47             );
48             }
49              
50             sub is_response ($) {
51 0     0 0   my $self = shift;
52              
53 0 0         return $self->flags & FLAGS_RESPONSE ? 1 : 0;
54             }
55              
56             sub is_signed ($) {
57 0     0 0   my $self = shift;
58 0           my $signature = $self->signature;
59              
60 0   0       return ref($signature) eq 'ARRAY' && @$signature == 16 &&
61             (join('', $signature) ne "\0" x 16) &&
62             ($self->flags & FLAGS_SIGNED) != 0;
63             }
64              
65             sub is_chained ($) {
66 0     0 0   my $self = shift;
67              
68             return
69 0           ($self->flags & FLAGS_CHAINED) != 0;
70             }
71              
72             1;