File Coverage

lib/SMB/v2/Command/SetInfo.pm
Criterion Covered Total %
statement 12 42 28.5
branch 0 10 0.0
condition 0 10 0.0
subroutine 4 9 44.4
pod 0 5 0.0
total 16 76 21.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::Command::SetInfo;
17              
18 1     1   8 use strict;
  1         3  
  1         36  
19 1     1   8 use warnings;
  1         2  
  1         34  
20              
21 1     1   6 use parent 'SMB::v2::Command';
  1         3  
  1         6  
22              
23             use constant {
24 1         805 TYPE_FILE => 1,
25             TYPE_FILESYSTEM => 2,
26             TYPE_SECURITY => 3,
27             TYPE_QUOTA => 4,
28              
29             FILE_LEVEL_BASIC => 4,
30             FILE_LEVEL_RENAME => 10,
31             FILE_LEVEL_LINK => 11,
32             FILE_LEVEL_DISPOSITION => 13,
33             FILE_LEVEL_POSITION => 14,
34             FILE_LEVEL_FULLEA => 15,
35             FILE_LEVEL_MODE => 16,
36             FILE_LEVEL_ALLOCATION => 19,
37             FILE_LEVEL_ENDOFFILE => 20,
38             FILE_LEVEL_PIPE => 23,
39             FILE_LEVEL_QUOTA => 32,
40             FILE_LEVEL_VALIDDATALENGTH => 39,
41             FILE_LEVEL_SHORTNAME => 40,
42              
43             FS_LEVEL_CONTROLINFORMATION => 6,
44             FS_LEVEL_OBJECTIDINFORMATION => 8,
45              
46             FILE_DISPOSITION_DELETE_ON_CLOSE => 0x1,
47 1     1   130 };
  1         2  
48              
49             sub init ($) {
50 0     0 0   $_[0]->set(
51             type => 0,
52             level => 0,
53             additional => 0,
54             buffer => undef,
55             fid => 0,
56             openfile => undef,
57             )
58             }
59              
60             sub parse ($$) {
61 0     0 0   my $self = shift;
62 0           my $parser = shift;
63              
64 0 0         if ($self->is_response) {
65             # empty
66             } else {
67 0           $self->type($parser->uint8);
68 0           $self->level($parser->uint8);
69 0           my $length = $parser->uint32;
70 0           my $offset = $parser->uint16;
71 0           $parser->skip(2); # reserved
72 0           $self->additional($parser->uint32);
73 0           $self->fid($parser->fid2);
74 0           $self->buffer($parser->bytes($length));
75             }
76              
77 0           return $self;
78             }
79              
80             sub pack ($$) {
81 0     0 0   my $self = shift;
82 0           my $packer = shift;
83              
84 0           my $buffer = $self->buffer;
85              
86 0 0         if ($self->is_response) {
87             # empty
88             } else {
89 0 0 0       $packer
      0        
90             ->uint8($self->type)
91             ->uint8($self->level)
92             ->uint32(defined $buffer ? length($buffer) : 0)
93             ->uint16($packer->diff('smb-header') + 32 - 8)
94             ->uint16(0) # reserved
95             ->uint32($self->additional)
96             ->fid2($self->fid || die "No fid set")
97             ->bytes($buffer // '')
98             ;
99             }
100             }
101              
102             sub requested_rename_info ($) {
103 0     0 0   my $self = shift;
104              
105             return unless
106 0 0 0       $self->type == TYPE_FILE &&
107             $self->level == FILE_LEVEL_RENAME;
108              
109 0           my $parser = SMB::Parser->new($self->buffer);
110 0           my $replace = $parser->uint8;
111 0           $parser->skip(7); # reserved
112 0           $parser->skip(8); # root dir handle
113 0           my $new_name_len = $parser->uint16;
114 0           $parser->skip(2); # reserved
115 0           my $new_name = $parser->str($new_name_len);
116              
117             return {
118 0           new_name => $new_name,
119             replace => $replace,
120             };
121             }
122              
123             sub requested_delete_on_close ($) {
124 0     0 0   my $self = shift;
125              
126             return
127 0 0 0       $self->type == TYPE_FILE &&
128             $self->level == FILE_LEVEL_DISPOSITION &&
129             ord($self->buffer) & FILE_DISPOSITION_DELETE_ON_CLOSE ? 1 : 0;
130             }
131              
132             1;