|
0
|
1 #!/usr/local/bin/perl -w
|
|
|
2
|
|
|
3 #
|
|
|
4 # Library with definitions and common routines for MPIWG storage system
|
|
|
5 # scripts
|
|
|
6 #
|
|
|
7
|
|
|
8 package MPIWGStor;
|
|
|
9
|
|
|
10 use strict;
|
|
|
11 use vars qw(@ISA @EXPORT $VERSION
|
|
|
12 $debug %junk_files %index_files $index_file_perm $archived_index_file_perm
|
|
|
13 $file_perm);
|
|
|
14 use Exporter;
|
|
|
15
|
|
10
|
16 $VERSION = 0.4; # ROC 20.1.2005
|
|
0
|
17
|
|
|
18 @ISA = qw(Exporter);
|
|
|
19
|
|
|
20 @EXPORT = qw($debug %junk_files %index_files $index_file_perm $archived_index_file_perm
|
|
|
21 $file_perm
|
|
|
22 &parseargs &logger &stime &s2stime &ymd_date &split_file_path &sstrip
|
|
10
|
23 &valid_file_name &valid_dir_name &park_file &unpark_file &read_xml &write_xml);
|
|
0
|
24
|
|
|
25 # debug level
|
|
|
26 $debug = 0;
|
|
|
27
|
|
|
28 # junk files
|
|
|
29 %junk_files = (
|
|
|
30 '.HSResource' => '.HSResource',
|
|
|
31 '.HSancillary' => '.HSancillary',
|
|
|
32 '.HSicon' => '.HSicon',
|
|
|
33 'Network Trash Folder' => 'Network Trash Folder',
|
|
|
34 'TheVolumeSettingsFolder' => 'TheVolumeSettingsFolder',
|
|
|
35 '.DS_Store' => '.DS_Store'
|
|
|
36 );
|
|
|
37
|
|
|
38 # filenames to not delete (but archive)
|
|
|
39 %index_files = (
|
|
|
40 'index.meta' => 'index.meta',
|
|
|
41 'index.meta.old' => 'index.meta.old'
|
|
|
42 );
|
|
|
43
|
|
|
44 # default permissions for normal index files (rw-rw-r--)
|
|
|
45 $index_file_perm = 0664;
|
|
|
46 # default permissions for archived index files (rw-r--r--)
|
|
|
47 $archived_index_file_perm = 0644;
|
|
|
48 # default permissions for other files (rw-rw-r--)
|
|
|
49 $file_perm = 0664;
|
|
|
50
|
|
|
51
|
|
|
52 #
|
|
|
53 # $param_hash = parseargs;
|
|
|
54 #
|
|
|
55 # reads @ARGV and returns a hash with all options like "-option=value"
|
|
|
56 # and the last part of the string as "path"
|
|
|
57 #
|
|
|
58 sub parseargs {
|
|
|
59 my %opts;
|
|
|
60 foreach my $s (@ARGV) {
|
|
|
61 if ($s =~ /^-([^=]+)=*(.*)$/) {
|
|
|
62 $opts{$1} = ($2) ? $2 : $1;
|
|
|
63 } else {
|
|
|
64 $opts{'path'} = $s;
|
|
|
65 }
|
|
|
66 }
|
|
|
67 return \%opts;
|
|
|
68 }
|
|
|
69
|
|
|
70
|
|
|
71 #
|
|
|
72 # logger($level, $message)
|
|
|
73 #
|
|
|
74 # logs the $message (mostly to stdout)
|
|
|
75 #
|
|
|
76 sub logger {
|
|
|
77 my ($level, $message) = @_;
|
|
|
78 if ($debug || ($level ne "DEBUG")) {
|
|
|
79 print "$level: $message\n";
|
|
|
80 }
|
|
|
81 }
|
|
|
82
|
|
|
83 #
|
|
|
84 # $stime = stime($utime)
|
|
|
85 #
|
|
|
86 # format utime (seconds since epoch) into string
|
|
|
87 # representation: "YYYY/MM/DD HH:MM:SS"
|
|
|
88 #
|
|
|
89 sub stime {
|
|
|
90 my ($utime) = @_;
|
|
|
91 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
|
|
|
92 localtime($utime);
|
|
|
93 my $yy = $year + 1900;
|
|
|
94 my $mm = $mon + 1;
|
|
|
95 my $stime = sprintf("%d/%02d/%02d %02d:%02d:%02d",
|
|
|
96 $yy, $mm, $mday, $hour, $min, $sec);
|
|
|
97 return $stime;
|
|
|
98 }
|
|
|
99
|
|
|
100 #
|
|
|
101 # $stime = s2stime($stime2)
|
|
|
102 #
|
|
|
103 # format db-like time (2003-09-19 12:43:32+02) into string
|
|
|
104 # representation: "YYYY/MM/DD HH:MM:SS"
|
|
|
105 #
|
|
|
106 sub s2stime {
|
|
|
107 my ($s2time) = @_;
|
|
|
108 my $stime = "";
|
|
|
109 if ($s2time =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/) {
|
|
|
110 my ($year,$mon,$mday,$hour,$min,$sec) = ($1, $2, $3, $4, $5, $6);
|
|
|
111 $stime = sprintf("%d/%02d/%02d %02d:%02d:%02d",
|
|
|
112 $year, $mon, $mday, $hour, $min, $sec);
|
|
|
113 }
|
|
|
114 return $stime;
|
|
|
115 }
|
|
|
116
|
|
|
117 #
|
|
|
118 # $date = ymd_date($olddate)
|
|
|
119 #
|
|
|
120 # converts a date string in mm/dd/yy format to yyyy/mm/dd format
|
|
|
121 #
|
|
|
122 sub ymd_date {
|
|
|
123 my ($mdy) = @_;
|
|
|
124 my $ydm;
|
|
|
125 if ($mdy =~ /(\d+)\/(\d+)\/(\d+)/) {
|
|
|
126 my $m = $1;
|
|
|
127 my $d = $2;
|
|
|
128 my $y = $3;
|
|
|
129 # extend yy to yyyy
|
|
|
130 $y = ($y < 70) ? (2000 + $y) : (($y < 100) ? ($y + 1900) : $y);
|
|
|
131 $ydm = sprintf "%d/%02d/%02d", $y, $m, $d;
|
|
|
132 }
|
|
|
133 return $ydm;
|
|
|
134 }
|
|
|
135
|
|
|
136 #
|
|
|
137 # ($name, $path) = split_file_path($fn)
|
|
|
138 #
|
|
|
139 # splits the file path $fn into
|
|
|
140 # file name (the last path element) and path
|
|
|
141 #
|
|
|
142 sub split_file_path {
|
|
|
143 my ($fn) = @_;
|
|
|
144
|
|
|
145 if ($fn =~ /^(.*)\/([^\/]+)$/) {
|
|
|
146 return ($2, $1);
|
|
|
147 }
|
|
|
148 return $fn;
|
|
|
149 }
|
|
|
150
|
|
|
151
|
|
|
152 #
|
|
|
153 # $name = sstrip($name)
|
|
|
154 #
|
|
|
155 # strips leading and trailing whitespace from $name
|
|
|
156 #
|
|
|
157 sub sstrip {
|
|
|
158 my ($name) = @_;
|
|
|
159
|
|
|
160 if ($name =~ /\s*(.*)\s*/) {
|
|
|
161 return $1;
|
|
|
162 }
|
|
|
163 return $name;
|
|
|
164 }
|
|
|
165
|
|
|
166
|
|
|
167 #
|
|
|
168 # $valid = valid_file_name($name)
|
|
|
169 #
|
|
|
170 # checks if $name is a valid file name
|
|
|
171 #
|
|
|
172 sub valid_file_name {
|
|
|
173 return valid_name($_[0], 0);
|
|
|
174 }
|
|
|
175
|
|
|
176
|
|
|
177 #
|
|
|
178 # $valid = valid_dir_name($name)
|
|
|
179 #
|
|
|
180 # checks if $name is a valid directory name
|
|
|
181 #
|
|
|
182 sub valid_dir_name {
|
|
|
183 return valid_name($_[0], 1);
|
|
|
184 }
|
|
|
185
|
|
|
186
|
|
|
187 #
|
|
|
188 # $valid = valid_name($name, $mode)
|
|
|
189 #
|
|
|
190 # checks if $name is a valid file ($mode=0) or directory name (mode=1)
|
|
|
191 #
|
|
|
192 sub valid_name {
|
|
|
193 my ($name, $mode) = @_;
|
|
|
194
|
|
|
195 # whitespace?
|
|
|
196 if ($name =~ /\s+/) {
|
|
|
197 return 0;
|
|
|
198 }
|
|
|
199 # invalid characters
|
|
|
200 if ($name !~ /^[-\w.\/]+$/) {
|
|
|
201 return 0;
|
|
|
202 }
|
|
|
203 # files have extension
|
|
|
204 if ($mode == 0) {
|
|
|
205 if ($name !~ /\.[-\w]+$/) {
|
|
|
206 return 0;
|
|
|
207 }
|
|
|
208 }
|
|
|
209 return 1;
|
|
|
210 }
|
|
|
211
|
|
|
212
|
|
|
213 #
|
|
10
|
214 # $newfilename = park_file($filename)
|
|
|
215 #
|
|
|
216 # parks a file under a new name (*.bak)
|
|
|
217 #
|
|
|
218 sub park_file {
|
|
|
219 my ($filename) = @_;
|
|
|
220 my $newfn = "";
|
|
|
221 if (-f $filename) {
|
|
|
222 $newfn = "$filename.bak";
|
|
|
223 if (! rename $filename, $newfn) {
|
|
|
224 logger("ABORT", "unable to rename file $filename!");
|
|
|
225 exit 1;
|
|
|
226 }
|
|
|
227 }
|
|
|
228 return $newfn;
|
|
|
229 }
|
|
|
230
|
|
|
231 #
|
|
|
232 # $filename = unpark_file($filename)
|
|
|
233 #
|
|
|
234 # unparks a file
|
|
|
235 #
|
|
|
236 sub unpark_file {
|
|
|
237 my ($filename) = @_;
|
|
|
238 my $newfn = "$filename.bak";
|
|
|
239 if (-f $newfn) {
|
|
|
240 if (! rename $newfn, $filename) {
|
|
|
241 logger("ABORT", "unable to rename file $newfn!");
|
|
|
242 exit 1;
|
|
|
243 }
|
|
|
244 return $filename;
|
|
|
245 }
|
|
|
246 return "";
|
|
|
247 }
|
|
|
248
|
|
|
249
|
|
|
250
|
|
|
251 #
|
|
0
|
252 # ($document, $rootnode) = read_xml($file)
|
|
|
253 #
|
|
|
254 # reads xml meta file $file
|
|
|
255 # returns root node element
|
|
|
256 #
|
|
|
257 sub read_xml {
|
|
|
258 my ($file) = @_;
|
|
|
259 my $document;
|
|
|
260
|
|
|
261 my $parser = XML::LibXML->new();
|
|
|
262 if (! $parser) {
|
|
|
263 logger("ABORT", "unable to create parser for metadata index file!!");
|
|
|
264 exit 1;
|
|
|
265 }
|
|
|
266
|
|
|
267 logger("INFO", "index file: $file");
|
|
|
268 eval { $document = $parser->parse_file($file) };
|
|
|
269 # catch parsing errors
|
|
|
270 if ($@) {
|
|
|
271 logger("ABORT", "XML syntax error in index file!!");
|
|
|
272 exit 1;
|
|
|
273 }
|
|
|
274 my $rootnode = $document->documentElement;
|
|
|
275 logger("INFO", "root element: \'" . $rootnode->nodeName . "\'");
|
|
|
276
|
|
|
277 return ($document, $rootnode);
|
|
|
278 }
|
|
|
279
|
|
|
280
|
|
|
281 #
|
|
|
282 # write_xml($document, $file)
|
|
|
283 #
|
|
|
284 # saves the XML tree of $document to the file $file
|
|
|
285 #
|
|
|
286 sub write_xml {
|
|
|
287 my ($document, $filename) = @_;
|
|
|
288 # keep backup copy
|
|
|
289 if (-f $filename) {
|
|
|
290 if (! rename $filename, "$filename.old") {
|
|
|
291 logger("ABORT", "unable to change file $filename!");
|
|
|
292 exit 1;
|
|
|
293 }
|
|
|
294 }
|
|
|
295 # write new file
|
|
|
296 if ($document->toFile($filename)) {
|
|
|
297 logger("INFO", "written new file $filename");
|
|
|
298 chmod $index_file_perm, $filename;
|
|
|
299 } else {
|
|
|
300 logger("ABORT", "unable to write file $filename!");
|
|
|
301 exit 1;
|
|
|
302 }
|
|
|
303 }
|
|
|
304
|
|
|
305
|
|
|
306 # module init
|
|
|
307 return 1;
|
