Subversion Repositories DevTools

Rev

Rev 7460 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1038 dpurdie 1 
package Utils;
2 
use File::Basename;
3 
use Data::Dumper;
6776 dpurdie 4 
$Data::Dumper::Sortkeys  = 1;
1038 dpurdie 5 
 
6 
sub trunc ($) {
5398 dpurdie 7 
    my $file = shift;
8 
    open my $fh, ">$file" or die "Can't write $file: $!\n";
9 
    print $fh '';
10 
    close $fh;
1038 dpurdie 11 
}
12 
 
13 
sub checkpid ($) {
5398 dpurdie 14 
    my $conf = shift;
15 
    my $pidfile = $conf->{'pidfile'};
16 
    my $logger = $conf->{logger};
1038 dpurdie 17 
 
5398 dpurdie 18 
    trunc $pidfile unless -f $pidfile;
1038 dpurdie 19 
 
5398 dpurdie 20 
    open my $fh, $pidfile or $logger->err("Can't read pidfile $pidfile: $!");
21 
    my ($pid) = <$fh>;
22 
    close $fh;
1038 dpurdie 23 
 
5398 dpurdie 24 
    if (defined $pid) {
25 
        chomp $pid;
26 
        $logger->err("Process with pid $pid already running") if 0 < int $pid && kill 0, $pid;
27 
    }
1038 dpurdie 28 
}
29 
 
30 
sub writepid ($) {
5398 dpurdie 31 
    my $conf = shift;
32 
    my $logger = $conf->{logger};
33 
    my $pidfile = $conf->{'pidfile'};
1038 dpurdie 34 
 
5398 dpurdie 35 
    open my $fh, ">$pidfile" or $logger->err("Can't write pidfile: $!");
36 
    print $fh "$$\n";
37 
    close $fh;
1038 dpurdie 38 
}
39 
 
40 
#-------------------------------------------------------------------------------
41 
# Function        : trimstr
42 
#
43 
# Description     : Trim a string
44 
#
45 
# Inputs          : Array of strings
46 
#
47 
# Returns         : Array of trimmed strings
48 
#
49 
sub trimstr (@) {
5398 dpurdie 50 
    my @str = @_;
1038 dpurdie 51 
 
5398 dpurdie 52 
    for (@str) {
53 
        chomp;
54 
        s/^[\t\s]+//;
55 
        s/[\t\s]+$//;
56 
    }
1038 dpurdie 57 
 
5398 dpurdie 58 
    return @str;
1038 dpurdie 59 
}
60 
 
61 
#-------------------------------------------------------------------------------
62 
# Function        : readconf
63 
#
64 
# Description     : Process config data
65 
#
66 
# Inputs          : $conffile   - Config file to read
67 
#                   $pdata      - Ref to hash of controlling data
68 
#                                 hashed by config item and '.ignore'
69 
#                                 Values are:
70 
#                                   default     - Default value
71 
#                                   mandatory   - Must be present
7387 dpurdie 72 
#                                   requires    - Items must also be defined (accept comma sep list)
1038 dpurdie 73 
#                                   fmt         - Format
74 
#                                                   'size'      - convert to block
75 
#                                                   'period'    - convert to time
76 
#                                                   'dir'       - Directory
7397 dpurdie 77 
#                                                   'mkdir'     - Directory - last element can be created
1038 dpurdie 78 
#                                                   'file'      - File
79 
#                                                   'vfile'     - File. Path must exist
80 
#                                                   'int'       - integer
81 
#                                                   'int_list'  - A list of integers
82 
#                                                   'text'      - Random Text
83 
#                                                   'bool'      - y/n 1/0
84 
#                               .ignore       - Regexp of items to ignore
7387 dpurdie 85 
#                               .oneOf        - Array of Array of config items. One item in each array must be defined
1038 dpurdie 86 
#
87 
#
88 
#
89 
# Returns         : $conf       - Ref to config data
90 
#                   $errors     - Ref to an array of error messages
91 
#
92 
 
93 
sub readconf
94 
{
95 
    my ($conffile, $pdata) = @_;
96 
    my @errors;
5398 dpurdie 97 
    my $conf;
1038 dpurdie 98 
    my $ignored;
99 
 
100 
    if ( open my $fh, $conffile )
101 
    {
5398 dpurdie 102 
        while (<$fh>) {
7469 dpurdie 103 
            next if /^[\t\w]*#/;
104 
            s/\s+#.*//;
1038 dpurdie 105 
 
5398 dpurdie 106 
            my ($key, $val) = trimstr split '=', $_, 2;
107 
            next unless defined $val;
2571 dpurdie 108 
 
109 
            #
110 
            #   Create hash of key : value
111 
            #   Special handling of int_list. Multiple definitions are allowed
112 
            #
113 
            if ( exists $conf->{$key} ) {
114 
                if ( exists $pdata->{$key} && $pdata->{$key}{'fmt'} eq 'int_list' ) {
115 
                    $conf->{$key} = join (' ', $conf->{$key} ,$val);
116 
                } else {
117 
                    push @errors, "Multiple configuration of: $key";
118 
                }
119 
            } else {
120 
                $conf->{$key} = $val;
121 
            }
5398 dpurdie 122 
        }
123 
        close $fh;
1038 dpurdie 124 
 
125 
        #
126 
        #   Validate mandatory entries
127 
        #   Insert defaults that are not present
7387 dpurdie 128 
        #   Check conflicts
129 
        #   Check required entries
1038 dpurdie 130 
        #
131 
        while ( (my ($key, $entry)) = each %{$pdata} )
132 
        {
7387 dpurdie 133 
            next if $key =~ m~^\.~;
1040 dpurdie 134 
            if ( exists ($entry->{mandatory}) && $entry->{mandatory}  )
1038 dpurdie 135 
            {
136 
                if ( !exists $conf->{$key} )
137 
                {
138 
                    push @errors, "Mandatory config not found: $key";
139 
                }
140 
            }
141 
 
7387 dpurdie 142 
            if ( exists $entry->{requires} && exists $conf->{$key} ) {
143 
                foreach my $rkey (split (',',  $entry->{requires}))
144 
                {
145 
                    if ( !exists $conf->{$rkey} )
146 
                    {
147 
                        push @errors, "$key requires that $rkey also be specified";
148 
                    }
149 
                }
150 
            }
151 
 
1040 dpurdie 152 
            if ( exists $entry->{default} )
1038 dpurdie 153 
            {
154 
                if ( !exists $conf->{$key} )
155 
                {
1040 dpurdie 156 
                    $conf->{$key} = $entry->{default};
1038 dpurdie 157 
                }
158 
            }
159 
        }
160 
 
161 
        #
7387 dpurdie 162 
        #   oneOf processing
163 
        #
164 
        if ($pdata->{'.oneOf'}) {
165 
            foreach my $set ( @{$pdata->{'.oneOf'}} ) {
166 
                my $found = 0;
167 
                foreach my $key ( @{$set}) {
168 
                    if (exists $conf->{$key} && defined $conf->{$key}) {
169 
                        $found++;
170 
                    }
171 
                }
172 
                if ($found ne 1) {
173 
                    push @errors, "Require exactly one of " . join(',',  @{$set});
174 
                }
175 
            }
176 
 
177 
        }
178 
 
179 
        #
1038 dpurdie 180 
        #   Scan all user items
181 
        #
182 
        my $ignore_re = $pdata->{'.ignore'} ;
183 
        while ( (my ($key, $data)) = each %{$conf} )
184 
        {
185 
            if ( $ignore_re )
186 
            {
187 
                #
188 
                #   Ignore entry is a hash of entries to ignore
189 
                #       Key is RE with a group
190 
                #       Value is the name of config item under which the
191 
                #       data will be stored. The re group will be used to
192 
                #       as the key for the final hash.
193 
                #
194 
                my $done = 0;
195 
                while ( (my ($re, $ename)) = each %{$ignore_re} )
196 
                {
197 
                    if ( $key =~ m~$re~ )
198 
                    {
199 
                        $ignored->{$ename}{$1} = $data;
200 
                        $done = 1;
201 
                    }
202 
                }
203 
                if ( $done )
204 
                {
205 
                    delete $conf->{$key};
206 
                    next;
207 
                }
208 
            }
209 
 
210 
            if ( !exists $pdata->{$key} )
211 
            {
212 
                push @errors, "Unknown config item: $key";
213 
                next;
214 
            }
215 
 
216 
            my $fmt = $pdata->{$key}{'fmt'};
217 
            unless ( $fmt )
218 
            {
219 
                push @errors, "Unconfigured config item: $key";
220 
                next;
221 
            }
222 
 
223 
            if ( $fmt eq 'size' ) {
224 
                $conf->{$key} = toBytes( $data );
2571 dpurdie 225 
 
1038 dpurdie 226 
            } elsif ( $fmt eq 'period' ) {
227 
                $conf->{$key} = timeToSecs( $data );
228 
 
229 
            } elsif ( $fmt eq 'dir' ) {
230 
                if ( ! -d $data ) {
231 
                    push @errors, "Directory not found:$key: $data";
232 
                }
7397 dpurdie 233 
            } elsif ( $fmt eq 'mkdir' ) {
234 
                if ( ! -d $data ) {
235 
                    mkdir $data;
236 
                    chmod 0777, $data;
237 
                    if ( ! -d $data ) {
238 
                        push @errors, "Directory not created:$key: $data";
239 
                    }
240 
                }
1038 dpurdie 241 
            } elsif ( $fmt eq 'file' ) {
242 
                if ( ! -f $data ) {
243 
                    push @errors, "File not found:$key: $data";
244 
                }
245 
            } elsif ( $fmt eq 'vfile' ) {
246 
                 my($filename, $pdir, $suffix) = fileparse($data);
247 
                if ( ! -d $pdir ) {
248 
                    push @errors, "Directory not found:$key: $pdir";
249 
                }
250 
            } elsif ( $fmt eq 'int' ) {
251 
                unless ( $data =~ m~^\d+$~ ) {
252 
                    push @errors, "Invalid Number:$key: $data";
253 
                }
254 
            } elsif ( $fmt eq 'int_list' ) {
255 
                unless ( $data =~ m~^((\d+)[, ]*)*$~ ) {
256 
                    push @errors, "Invalid Number List:$key: $data";
257 
                }
258 
            } elsif ( $fmt eq 'bool' ) {
259 
                $data = lc $data;
260 
                if ( $data eq '1' || $data eq 'y'  || $data eq 'yes') {
261 
                    $conf->{$key} = 1;
262 
                } elsif ( $data eq '0' || $data eq 'n' || $data eq 'no') {
263 
                    $conf->{$key} = 0;
264 
                } else {
265 
                    push @errors, "Invalid Boolean:$key: $data";
266 
                }
267 
 
268 
            } elsif ( $fmt eq 'text' ) {
269 
 
270 
            } else {
271 
                push @errors, "Unknown config fmt:$key, $fmt";
272 
            }
273 
        }
274 
    }
275 
    else
276 
    {
277 
        push @errors, "Can't read $conffile: $!";
278 
    }
279 
 
280 
    #
281 
    #   Merge in ignored entries
282 
    #
283 
    while ( my ($key, $data ) = each %{$ignored})
284 
    {
285 
        $conf->{$key} = $data;
286 
    }
287 
 
288 
#DebugDumpData('config', $conf );
1040 dpurdie 289 
#DebugDumpData('errors' , \@errors);
1038 dpurdie 290 
    return $conf, \@errors;
291 
}
292 
 
293 
#-------------------------------------------------------------------------------
294 
# Function        : mtime
295 
#
296 
# Description     : Return the modification time of a file
297 
#
298 
# Inputs          : $path
299 
#
300 
# Returns         : modification time
301 
#                   mode
302 
#
303 
sub mtime
304 
{
305 
    my ($path) = @_;
306 
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
307 
       $atime,$mtime,$ctime,$blksize,$blocks) = stat($path);
308 
    return (($mtime || 0), $mode);
309 
}
310 
 
311 
#-------------------------------------------------------------------------------
312 
# Function        : timeToSecs
313 
#
314 
# Description     : Process a string and convert it to seconds
315 
#                   Handle:
316 
#                       100     -> 100 seconds
317 
#                       100s    -> 100 seconds
318 
#                       5m      -> 5 minutes
319 
#                       10h     -> 10 hours
320 
#                       1d      -> 1 day
321 
#                       1d10h   -> 1d and 10 hours
322 
#
323 
#
324 
# Inputs          : String
325 
#
326 
# Returns         : Seconds
327 
#
328 
sub timeToSecs
329 
{
330 
    my ($src) = @_;
331 
    my $result = 0;
332 
    while ( $src =~ s~(\d+)([smhd])?~~ )
333 
    {
334 
        my $factor = 1;
335 
        my $base = $1;
336 
        my $mode = $2 || 's';
337 
        if ( $mode eq 'd' ) {
338 
            $factor = 24 * 60 * 60;
339 
        } elsif ( $mode eq 'h' ) {
340 
            $factor = 60 * 60;
341 
        } elsif ( $mode eq 'm' ) {
342 
            $factor = 60;
343 
        }
344 
        $result += $base * $factor;
345 
    }
346 
    return $result;
347 
}
348 
 
349 
#-------------------------------------------------------------------------------
7387 dpurdie 350 
# Function        : TouchFile
351 
#
352 
# Description     : touch a file
353 
#                   Real use is to touch a marker file
354 
#
355 
# Inputs          : path        - path to the file
356 
#
357 
# Returns         : TRUE if an error occured in creating the file
358 
#
359 
sub TouchFile($$)
360 
{
361 
 
362 
    my ($conf, $path) = @_;
363 
    my $logger = $conf->{logger};
364 
    my $result = 0;
365 
    my $tfh;
366 
 
367 
    $logger->verbose( "Touching: $path" );
368 
    if ( ! -f $path )
369 
    {
370 
        open ($tfh, ">>", $path) || ($result = 1);
371 
        close $tfh;
372 
    }
373 
    else
374 
    {
375 
 
376 
        #
377 
        #   Modify the file
378 
        #
379 
        #   Need to physically modify the file
380 
        #   Need to change the 'change time' on the file. Simply setting the
381 
        #   last-mod and last-access is not enough to get past WIN32
382 
        #   OR 'utime()' does not work as expected
383 
        #
384 
        #   Read in the first character of the file, rewind and write it
385 
        #   out again.
386 
        #
387 
        my $data;
388 
        open ($tfh , "+<", $path ) || return 1;
389 
        if ( read ( $tfh, $data, 1 ) )
390 
        {
391 
            seek  ( $tfh, 0, 0 );
392 
            print $tfh $data;
393 
        }
394 
        else
395 
        {
396 
            #
397 
            #   File must have been of zero length
398 
            #   Delete the file and create it
399 
            #
400 
            close ($tfh);
401 
            unlink ( $path );
402 
            open ($tfh, ">>", $path) || ($result = 1);
403 
        }
404 
        close ($tfh);
405 
    }
406 
 
407 
    #
408 
    #   Ensure all can remove the file
409 
    #   May be created by root and need to be deleted by the blatDaemon
410 
    #
411 
    chmod 0666, $path;
412 
    return $result;
413 
}
414 
 
415 
#-------------------------------------------------------------------------------
1038 dpurdie 416 
# Function        : toBytes
417 
#
418 
# Description     : Process a string and convert it to a byte count
419 
#                   Handle:
420 
#                       100     -> 100 bytes
421 
#                       10k     -> 10 kilobytes
422 
#                       5m      -> 5 Megabytes
423 
#                       1g      -> 1 Gigabytes
424 
#                       10b     -> 10 Blocks
425 
#
426 
# Inputs          : String
427 
#
428 
# Returns         : Byte Count
429 
#
430 
sub toBytes
431 
{
432 
    my ($src) = @_;
433 
    my $result = 0;
434 
    if ( $src =~ m~(\d+)([kmgb]?)~i )
435 
    {
436 
        my $factor = 1;
437 
        my $base = $1;
438 
        my $mode = lc($2) || '-';
439 
        if ( $mode eq 'g' ) {
440 
            $factor = 1024 * 1024 * 1024;
441 
        } elsif ( $mode eq 'm' ) {
442 
            $factor = 1024 * 1024;
443 
        } elsif ( $mode eq 'k' ) {
444 
            $factor = * 1024;
445 
        } elsif ( $mode eq 'b' ) {
446 
            $factor = 1024;
447 
        }
448 
        $result = $base * $factor;
449 
    }
450 
    return $result;
451 
}
452 
 
453 
#-------------------------------------------------------------------------------
454 
# Function        : DebugDumpData
455 
#
456 
# Description     : Dump a data structure
457 
#
458 
# Inputs          : $name           - A name to give the structure
459 
#                   @refp           - An array of references
460 
#
461 
# Returns         :
462 
#
463 
sub DebugDumpData
464 
{
465 
    my ($name, @refp) = @_;
466 
 
467 
    my $ii = 0;
468 
    foreach  ( @refp )
469 
    {
470 
        print Data::Dumper->Dump ( [$_], ["*[Arg:$ii] $name" ]);
471 
        $ii++
472 
    }
473 
}
474 
 
7460 dpurdie 475 
#-------------------------------------------------------------------------------
476 
# Function        : resetWedge
477 
#
478 
# Description     : Called to indicate that the main processing loop is not wedged
479 
#
480 
# Inputs          : None
481 
#
482 
# Returns         : Nothing
483 
#
484 
my $wedgeTime = 0;
485 
sub resetWedge {
486 
    $wedgeTime = time();
487 
}
1038 dpurdie 488 
 
7460 dpurdie 489 
#-------------------------------------------------------------------------------
490 
# Function        : isWedged
491 
#
492 
# Description     : Determine if the current process is wedged
493 
#                   ie: Main processing loop is not cyling
494 
#
495 
# Inputs          : $conf   - Config data
496 
#
497 
# Returns         : True - is Wedged
498 
#
499 
sub isWedged
500 
{
501 
    my ($conf) = @_;
502 
    $conf->{logger}->verbose("isWedged ($conf->{wedgeTime}) : " .  (time() - $wedgeTime) );
503 
    return (time() > ($wedgeTime + $conf->{wedgeTime}) );
504 
}
505 
 
1038 dpurdie 506 
1;