package Utils; use File::Basename; use Data::Dumper; $Data::Dumper::Sortkeys = 1; sub trunc ($) { my $file = shift; open my $fh, ">$file" or die "Can't write $file: $!\n"; print $fh ''; close $fh; } sub checkpid ($) { my $conf = shift; my $pidfile = $conf->{'pidfile'}; my $logger = $conf->{logger}; trunc $pidfile unless -f $pidfile; open my $fh, $pidfile or $logger->err("Can't read pidfile $pidfile: $!"); my ($pid) = <$fh>; close $fh; if (defined $pid) { chomp $pid; $logger->err("Process with pid $pid already running") if 0 < int $pid && kill 0, $pid; } } sub writepid ($) { my $conf = shift; my $logger = $conf->{logger}; my $pidfile = $conf->{'pidfile'}; open my $fh, ">$pidfile" or $logger->err("Can't write pidfile: $!"); print $fh "$$\n"; close $fh; } #------------------------------------------------------------------------------- # Function : trimstr # # Description : Trim a string # # Inputs : Array of strings # # Returns : Array of trimmed strings # sub trimstr (@) { my @str = @_; for (@str) { chomp; s/^[\t\s]+//; s/[\t\s]+$//; } return @str; } #------------------------------------------------------------------------------- # Function : readconf # # Description : Process config data # # Inputs : $conffile - Config file to read # $pdata - Ref to hash of controlling data # hashed by config item and '.ignore' # Values are: # default - Default value # mandatory - Must be present # requires - Items must also be defined (accept comma sep list) # fmt - Format # 'size' - convert to block # 'period' - convert to time # 'dir' - Directory # 'mkdir' - Directory - last element can be created # 'file' - File # 'vfile' - File. Path must exist # 'int' - integer # 'int_list' - A list of integers # 'text' - Random Text # 'bool' - y/n 1/0 # .ignore - Regexp of items to ignore # .oneOf - Array of Array of config items. One item in each array must be defined # # # # Returns : $conf - Ref to config data # $errors - Ref to an array of error messages # sub readconf { my ($conffile, $pdata) = @_; my @errors; my $conf; my $ignored; if ( open my $fh, $conffile ) { while (<$fh>) { next if /^[\t\w]*#/; s/\s+#.*//; my ($key, $val) = trimstr split '=', $_, 2; next unless defined $val; # # Create hash of key : value # Special handling of int_list. Multiple definitions are allowed # if ( exists $conf->{$key} ) { if ( exists $pdata->{$key} && $pdata->{$key}{'fmt'} eq 'int_list' ) { $conf->{$key} = join (' ', $conf->{$key} ,$val); } else { push @errors, "Multiple configuration of: $key"; } } else { $conf->{$key} = $val; } } close $fh; # # Validate mandatory entries # Insert defaults that are not present # Check conflicts # Check required entries # while ( (my ($key, $entry)) = each %{$pdata} ) { next if $key =~ m~^\.~; if ( exists ($entry->{mandatory}) && $entry->{mandatory} ) { if ( !exists $conf->{$key} ) { push @errors, "Mandatory config not found: $key"; } } if ( exists $entry->{requires} && exists $conf->{$key} ) { foreach my $rkey (split (',', $entry->{requires})) { if ( !exists $conf->{$rkey} ) { push @errors, "$key requires that $rkey also be specified"; } } } if ( exists $entry->{default} ) { if ( !exists $conf->{$key} ) { $conf->{$key} = $entry->{default}; } } } # # oneOf processing # if ($pdata->{'.oneOf'}) { foreach my $set ( @{$pdata->{'.oneOf'}} ) { my $found = 0; foreach my $key ( @{$set}) { if (exists $conf->{$key} && defined $conf->{$key}) { $found++; } } if ($found ne 1) { push @errors, "Require exactly one of " . join(',', @{$set}); } } } # # Scan all user items # my $ignore_re = $pdata->{'.ignore'} ; while ( (my ($key, $data)) = each %{$conf} ) { if ( $ignore_re ) { # # Ignore entry is a hash of entries to ignore # Key is RE with a group # Value is the name of config item under which the # data will be stored. The re group will be used to # as the key for the final hash. # my $done = 0; while ( (my ($re, $ename)) = each %{$ignore_re} ) { if ( $key =~ m~$re~ ) { $ignored->{$ename}{$1} = $data; $done = 1; } } if ( $done ) { delete $conf->{$key}; next; } } if ( !exists $pdata->{$key} ) { push @errors, "Unknown config item: $key"; next; } my $fmt = $pdata->{$key}{'fmt'}; unless ( $fmt ) { push @errors, "Unconfigured config item: $key"; next; } if ( $fmt eq 'size' ) { $conf->{$key} = toBytes( $data ); } elsif ( $fmt eq 'period' ) { $conf->{$key} = timeToSecs( $data ); } elsif ( $fmt eq 'dir' ) { if ( ! -d $data ) { push @errors, "Directory not found:$key: $data"; } } elsif ( $fmt eq 'mkdir' ) { if ( ! -d $data ) { mkdir $data; chmod 0777, $data; if ( ! -d $data ) { push @errors, "Directory not created:$key: $data"; } } } elsif ( $fmt eq 'file' ) { if ( ! -f $data ) { push @errors, "File not found:$key: $data"; } } elsif ( $fmt eq 'vfile' ) { my($filename, $pdir, $suffix) = fileparse($data); if ( ! -d $pdir ) { push @errors, "Directory not found:$key: $pdir"; } } elsif ( $fmt eq 'int' ) { unless ( $data =~ m~^\d+$~ ) { push @errors, "Invalid Number:$key: $data"; } } elsif ( $fmt eq 'int_list' ) { unless ( $data =~ m~^((\d+)[, ]*)*$~ ) { push @errors, "Invalid Number List:$key: $data"; } } elsif ( $fmt eq 'bool' ) { $data = lc $data; if ( $data eq '1' || $data eq 'y' || $data eq 'yes') { $conf->{$key} = 1; } elsif ( $data eq '0' || $data eq 'n' || $data eq 'no') { $conf->{$key} = 0; } else { push @errors, "Invalid Boolean:$key: $data"; } } elsif ( $fmt eq 'text' ) { } else { push @errors, "Unknown config fmt:$key, $fmt"; } } } else { push @errors, "Can't read $conffile: $!"; } # # Merge in ignored entries # while ( my ($key, $data ) = each %{$ignored}) { $conf->{$key} = $data; } #DebugDumpData('config', $conf ); #DebugDumpData('errors' , \@errors); return $conf, \@errors; } #------------------------------------------------------------------------------- # Function : mtime # # Description : Return the modification time of a file # # Inputs : $path # # Returns : modification time # mode # sub mtime { my ($path) = @_; my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat($path); return (($mtime || 0), $mode); } #------------------------------------------------------------------------------- # Function : timeToSecs # # Description : Process a string and convert it to seconds # Handle: # 100 -> 100 seconds # 100s -> 100 seconds # 5m -> 5 minutes # 10h -> 10 hours # 1d -> 1 day # 1d10h -> 1d and 10 hours # # # Inputs : String # # Returns : Seconds # sub timeToSecs { my ($src) = @_; my $result = 0; while ( $src =~ s~(\d+)([smhd])?~~ ) { my $factor = 1; my $base = $1; my $mode = $2 || 's'; if ( $mode eq 'd' ) { $factor = 24 * 60 * 60; } elsif ( $mode eq 'h' ) { $factor = 60 * 60; } elsif ( $mode eq 'm' ) { $factor = 60; } $result += $base * $factor; } return $result; } #------------------------------------------------------------------------------- # Function : TouchFile # # Description : touch a file # Real use is to touch a marker file # # Inputs : path - path to the file # # Returns : TRUE if an error occured in creating the file # sub TouchFile($$) { my ($conf, $path) = @_; my $logger = $conf->{logger}; my $result = 0; my $tfh; $logger->verbose( "Touching: $path" ); if ( ! -f $path ) { open ($tfh, ">>", $path) || ($result = 1); close $tfh; } else { # # Modify the file # # Need to physically modify the file # Need to change the 'change time' on the file. Simply setting the # last-mod and last-access is not enough to get past WIN32 # OR 'utime()' does not work as expected # # Read in the first character of the file, rewind and write it # out again. # my $data; open ($tfh , "+<", $path ) || return 1; if ( read ( $tfh, $data, 1 ) ) { seek ( $tfh, 0, 0 ); print $tfh $data; } else { # # File must have been of zero length # Delete the file and create it # close ($tfh); unlink ( $path ); open ($tfh, ">>", $path) || ($result = 1); } close ($tfh); } # # Ensure all can remove the file # May be created by root and need to be deleted by the blatDaemon # chmod 0666, $path; return $result; } #------------------------------------------------------------------------------- # Function : toBytes # # Description : Process a string and convert it to a byte count # Handle: # 100 -> 100 bytes # 10k -> 10 kilobytes # 5m -> 5 Megabytes # 1g -> 1 Gigabytes # 10b -> 10 Blocks # # Inputs : String # # Returns : Byte Count # sub toBytes { my ($src) = @_; my $result = 0; if ( $src =~ m~(\d+)([kmgb]?)~i ) { my $factor = 1; my $base = $1; my $mode = lc($2) || '-'; if ( $mode eq 'g' ) { $factor = 1024 * 1024 * 1024; } elsif ( $mode eq 'm' ) { $factor = 1024 * 1024; } elsif ( $mode eq 'k' ) { $factor = * 1024; } elsif ( $mode eq 'b' ) { $factor = 1024; } $result = $base * $factor; } return $result; } #------------------------------------------------------------------------------- # Function : DebugDumpData # # Description : Dump a data structure # # Inputs : $name - A name to give the structure # @refp - An array of references # # Returns : # sub DebugDumpData { my ($name, @refp) = @_; my $ii = 0; foreach ( @refp ) { print Data::Dumper->Dump ( [$_], ["*[Arg:$ii] $name" ]); $ii++ } } #------------------------------------------------------------------------------- # Function : resetWedge # # Description : Called to indicate that the main processing loop is not wedged # # Inputs : None # # Returns : Nothing # my $wedgeTime = 0; sub resetWedge { $wedgeTime = time(); } #------------------------------------------------------------------------------- # Function : isWedged # # Description : Determine if the current process is wedged # ie: Main processing loop is not cyling # # Inputs : $conf - Config data # # Returns : True - is Wedged # sub isWedged { my ($conf) = @_; $conf->{logger}->verbose("isWedged ($conf->{wedgeTime}) : " . (time() - $wedgeTime) ); return (time() > ($wedgeTime + $conf->{wedgeTime}) ); } 1;