1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
####################################################################################################################################
# Base Storage Module
####################################################################################################################################
package pgBackRestTest::Common::StorageBase;
use strict;
use warnings FATAL => qw(all);
use Carp qw(confess);
use English '-no_match_vars';
use Digest::SHA qw(sha1_hex);
use Exporter qw(import);
our @EXPORT = qw();
use File::Basename qw(dirname);
use pgBackRestDoc::Common::Exception;
use pgBackRestDoc::Common::Log;
use pgBackRestTest::Common::Io::Base;
####################################################################################################################################
# Storage constants
####################################################################################################################################
use constant STORAGE_LOCAL => '<LOCAL>';
push @EXPORT, qw(STORAGE_LOCAL);
use constant STORAGE_OBJECT => 'object';
push @EXPORT, qw(STORAGE_OBJECT);
use constant STORAGE_POSIX => 'posix';
push @EXPORT, qw(STORAGE_POSIX);
####################################################################################################################################
# Filter constants
####################################################################################################################################
use constant STORAGE_FILTER_CIPHER_BLOCK => 'pgBackRest::Storage::Filter::CipherBlock';
push @EXPORT, qw(STORAGE_FILTER_CIPHER_BLOCK);
####################################################################################################################################
# Capability constants
####################################################################################################################################
# Does the storage support symlinks and hardlinks?
use constant STORAGE_CAPABILITY_LINK => 'link';
push @EXPORT, qw(STORAGE_CAPABILITY_LINK);
####################################################################################################################################
# new
####################################################################################################################################
sub new
{
my $class = shift;
# Create the class hash
my $self = {};
bless $self, $class;
# Assign function parameters, defaults, and log debug info
(
my $strOperation,
$self->{lBufferMax},
) =
logDebugParam
(
__PACKAGE__ . '->new', \@_,
{name => 'lBufferMax', optional => true, default => COMMON_IO_BUFFER_MAX, trace => true},
);
# Return from function and log return values if any
return logDebugReturn
(
$strOperation,
{name => 'self', value => $self}
);
}
####################################################################################################################################
# Calculate sha1 hash and size of file. If special encryption settings are required, then the file objects from openRead/openWrite
# must be passed instead of file names.
####################################################################################################################################
sub hashSize
{
my $self = shift;
# Assign function parameters, defaults, and log debug info
my
(
$strOperation,
$xFileExp,
$bIgnoreMissing,
) =
logDebugParam
(
__PACKAGE__ . '->hashSize', \@_,
{name => 'xFileExp'},
{name => 'bIgnoreMissing', optional => true, default => false},
);
# Set operation variables
my $strHash;
my $lSize;
# Is this an IO object or a file expression?
my $rtContent = $self->get($xFileExp, {bIgnoreMissing => $bIgnoreMissing});
if (defined($rtContent))
{
if (defined($$rtContent))
{
$strHash = sha1_hex($$rtContent);
$lSize = length($$rtContent);
}
else
{
$strHash = sha1_hex('');
$lSize = 0;
}
}
# Return from function and log return values if any
return logDebugReturn
(
$strOperation,
{name => 'strHash', value => $strHash},
{name => 'lSize', value => $lSize}
);
}
####################################################################################################################################
# pathAbsolute - generate an absolute path from an absolute base path and a relative path
####################################################################################################################################
sub pathAbsolute
{
my $self = shift;
# Assign function parameters, defaults, and log debug info
my
(
$strOperation,
$strBasePath,
$strPath
) =
logDebugParam
(
__PACKAGE__ . '::pathAbsolute', \@_,
{name => 'strBasePath', trace => true},
{name => 'strPath', trace => true}
);
# Working variables
my $strAbsolutePath;
# If the path is already absolute
if (index($strPath, '/') == 0)
{
$strAbsolutePath = $strPath;
}
# Else make it absolute using the base path
else
{
# Make sure the absolute path is really absolute
if (index($strBasePath, '/') != 0 || index($strBasePath, '/..') != -1)
{
confess &log(ERROR, "${strBasePath} is not an absolute path", ERROR_PATH_TYPE);
}
while (index($strPath, '..') == 0)
{
$strBasePath = dirname($strBasePath);
$strPath = substr($strPath, 2);
if (index($strPath, '/') == 0)
{
$strPath = substr($strPath, 1);
}
}
$strAbsolutePath = "${strBasePath}/${strPath}";
}
# Make sure the result is really an absolute path
if (index($strAbsolutePath, '/') != 0 || index($strAbsolutePath, '/..') != -1)
{
confess &log(ERROR, "result ${strAbsolutePath} was not an absolute path", ERROR_PATH_TYPE);
}
# Return from function and log return values if any
return logDebugReturn
(
$strOperation,
{name => 'strAbsolutePath', value => $strAbsolutePath, trace => true}
);
}
1;
|
