## $HeadURL$ $LastChangedRevision$ # ## Name of this package #package ADE; # ## Packages required by this package #use strict; #no strict 'subs'; # Allow bare words, so &ade_err_error() calls look nicer. #use warnings; #no warnings qw(once); # Duplicating file handles makes causes only used once' warning #use Tie::RefHash; # for 'callonexit' hash, which contains code refs #use Cwd; # this is needed for _ade_tmp_cleanup()'s call to getcwd #use Data::Dumper; #use Net::SMTP; #use IO::Handle; # for (auto)flushing handles import subprocess import re import os import sys # ## Declare exports #BEGIN { # use Exporter (); # our (@ISA, @EXPORT); # @ISA = qw(Exporter); # @EXPORT = qw(ade_gep_main $ade_tmp_dir $ade_app_progname $ade_err_ok $ade_err_fail ade_fnm_basename ade_err_warning ade_err_info ade_err_debug ade_tmp_registerfile ade_tmp_deregisterfile ade_err_internal ade_err_error ade_msg_usage $ade_app_progname ade_fnm_basename ade_fnm_makeabsolute stupid_error_in_ade_space ade_err_registerdefderrs %ade_defined_errors ade_fcm_openwritecompressed ade_fcm_openreadcompressed ade_msg_version ade_smf_extractversionfromsvnstring ade_msg_listpaths ade_spc_autogendheader ade_spc_rollingstatusmanager ade_smf_isvalidregexp ade_mua_addmailheader ade_mua_sendmail ade_err_resetstack ade_usr_amiroot ade_fnm_dirname ade_spc_procopts ade_std_true ade_std_false ade_err_instack ade_msg_askquestion ade_smf_validate_float ade_smf_validate_integer); #} # #END { #} # ## Instantiate exported data #our($ade_err_ok, $ade_err_fail); #our($ade_tmp_dir); #our($ade_app_progname); # ## Initialise exported data #($ade_err_ok, $ade_err_fail) = (0, 1); [ ade_err_ok, ade_err_fail ] = [ 0, 1 ] #($ade_app_progname) = ($0 =~ /.*\/([^\/]*)$/); # ## Instantiate private data #my($sendmail_cmd, %ade_defined_errors); #my(@ade_registered_defined_errors_hash_refs_array); #my($ade_err_dumpwholestack, $ade_msg_writer_logfile_filename, @ade_err_writerfunc_refs); #my(%ade_registers); ade_registers = 0 # this is mean to be instantiation only #my($ade_msg_verboselevel); ade_msg_verboselevel = 0 # this is mean to be instantiation only # ## Initialise private data ## This could be moved inside ade-config.sh #$sendmail_cmd = "/usr/lib/sendmail"; ## Outside ADE, nobody should *use* ADE error codes, but maybe some ## people will test for them (e.g. to reset the errorstack in the event ## of a handlable error). But on the other handle the *tag* will be ## made public, not the array. #%ade_defined_errors = ( # ade_err_undefined => { fmt => "%s: undefined %s" }, # ade_err_access => { fmt => "%s: can't %s" }, # ade_err_locked => { fmt => "%s: locked by %s" }, # ade_err_convert => { fmt => "%s: couldn't convert from %s to %s" }, # ade_err_seeabove => { fmt => "error detected; see higher frames for more information" }, # ade_err_invalid => { fmt => "%s: invalid %s" }, # ade_err_misc => { fmt => "%s" }, # ade_err_eof => { fmt => "%s: end of file" }, # ade_err_notimplemented => { fmt => "%s: not implemented" }, #); ## ADE can deal with the follow errors (initial none) #@ade_registered_defined_errors_hash_refs_array = (); #$ade_err_dumpwholestack = 1; #$ade_msg_writer_logfile_filename = undef; #@ade_err_writerfunc_refs = (\&_ade_msg_writer_stderr); #%ade_registers = (); ade_registers = {} #$ade_msg_verboselevel = 2; ade_msg_verboselevel = 2 # ############################################################################### ## ## PUBLIC FUNCTIONS/ENTRY FUNCTIONS ## ############################################################################### # #sub ade_gep_main(\&) #{ # my($app_main_ref) = @_; # my($rc); # my($errstack_ref) = []; # # # Initialise a stack. # &ade_err_resetstack($errstack_ref, stack=>$errstack_ref, dumpall=>1); # # # Perform initialisation that requires an error stack. These calls continue # # but do not do later calls, so as to be sure to display the stack and # # exit correctly. # $rc = &_ade_gep_initialise_with_stack($errstack_ref); # # # Call the application (but only if the above calls succeeded. # if ($rc == $ade_err_ok) { # $rc = &_ade_gep_main_withstack($errstack_ref, $app_main_ref); # } # # if ($rc != $ade_err_ok) { # &ade_err_displaystack($errstack_ref); # &ade_err_resetstack($errstack_ref, stack=>$errstack_ref); # } # # # Do not return because there is no higher function to convert the # # return code into an exit code, and incredible perl does not do it # # itself (try: perl -e 'sub f { return(1); }; &f'; echo $?). Do an # # exit instead. # &_ade_gep_exit($errstack_ref, $rc); #} def ade_gep_main(app_main_ref): errstack_ref = [] ade_err_resetstack(errstack_ref, stack=errstack_ref, dumpall=1) rc = _ade_gep_initialise_with_stack(errstack_ref) if (rc == ade_err_ok): rc = _ade_gep_main_withstack(errstack_ref, app_main_ref) if (rc != ade_err_ok): ade_err_displaystack(errstack_ref) ade_err_resetstack(errstack_ref, stack=errstack_ref) _ade_gep_exit(errstack_ref, rc) # ############################################################################### ## ## PUBLIC FUNCTIONS/ERROR STACK FUNCTIONS ## ############################################################################### # #sub ade_err_resetstack #{ # my($errstack_ref) = @_; # shift; # my(%parameters) = @_; # my($key); # # # Look at what was passed # foreach $key (keys %parameters) { # # ade_err_resetstack(stack=>blah): reset stack 'blah' # if ($key eq "stack") { # @{$parameters{$key}} = (); # # ade_err_resetstack(dumpall=>1 or 0): on error dump whole / top of stack # } elsif ($key eq "dumpall") { # $ade_err_dumpwholestack = $parameters{$key}; # # ade_err_resetstack(logfile=>blah): set log file to 'blah' # } elsif ($key eq "logfile") { # $ade_msg_writer_logfile_filename = $parameters{$key}; # # ade_err_resetstack(level=>99): set debug level to 99 # } elsif ($key eq "level") { # $ade_msg_verboselevel = $parameters{$key}; # # ade_err_resetstack(writers=>(\&func1, \&func2)): set writers to funcs # } elsif ($key eq "writers") { # @ade_err_writerfunc_refs = @{$parameters{$key}}; # # unknown key # } else { # &ade_err_internal($errstack_ref, "ade_err_resetstack: $key: unexpected key"); # } # } # # return($ade_err_ok); #} def ade_err_resetstack(errstack_ref, stack=None, dumpall=None, logfile=None, level=None, writers=None): global ade_err_dumpwholestack, ade_msg_writer_logfile_filename, ade_msg_verboselevel, ade_err_writerfunc_refs if stack != None: stack=[] if dumpall != None: ade_err_dumpwholestack = dumpall if logfile != None: ade_msg_writer_logfile_filename = logfile if level != None: ade_msg_verboselevel = level if writers != None: ade_err_writerfunc_refs.append(writers) return # ## ## Is a specified error in the stack? ## ## (This is used to say things like "Did that function fail ## because there are no mails available? If so then don't ## treat that as an error, and I will handle the situation ## myself.") ## # #sub ade_err_instack #{ # my($errstack_ref, $err, $instack_flagref) = @_; # my($i, $framecount); # # # Facilitate doing it the C way with '<' in the 'for' loop instead of '<='. # $framecount = $#{$errstack_ref}+1; # # Assume not found to proved otherwise. # ${$instack_flagref} = undef; # # Scan the stack for the error # for ($i=0; $i<$framecount; $i++) { # if (${$errstack_ref}[$i]{err} eq $err) { # ${$instack_flagref} = $i; # } # } # # return($ade_err_ok); #} # #sub ade_err_registerdefderrs #{ # my($defined_errors_hash_ref) = @_; # # # Currently there are no registration-time checks or actions other than # # the registration. We *could* check that the reference refers to a non-empty # # hash, or we could even copy the errors out of it, so that it becomes impossible # # to add or delete errors to the set of defined errors *after* registration. # push(@ade_registered_defined_errors_hash_refs_array, $defined_errors_hash_ref); # # return($ade_err_ok); #} def ade_err_registerdefderrs(defined_errors_hash_ref): """Build a connection string from a dictionary of parameters. Returns string.""" return ade_err_ok # #sub ade_err_displaystack #{ # my($errstack_ref, $displayfunc_ref) = @_; # my($i, $j, $fmt, $framecount, @errpars, $defined_errors_hash_ref, $error_message); # my($number_of_percent_signs_in_format, $number_of_parameters_supplied); # # &ade_err_debug($errstack_ref, 40, "ade_err_displaystack: sof"); # # # # # Check/sanitize parameters. # # # # # There is a default display function based on assumption most calls to ade_err_displaystack # # are because of errors (not warnings). # if (!defined($displayfunc_ref)) { # $displayfunc_ref = \&_ade_err_displayerror; # } # # # # # For each error frame on the stack ... # # # # for ($i=0; $i<=$#{$errstack_ref}; $i++) { # # Skip all but the top frame if requested so to do # next if ($i != 0 && !$ade_err_dumpwholestack); # # # # # ... Locate the description of the error message in one of the error message hashes ... # # # # # Locate which hash of defined error messages contains the key # for ($j=0; $j<=$#ade_registered_defined_errors_hash_refs_array; $j++) { # last if (defined(${$ade_registered_defined_errors_hash_refs_array[$j]}{${$errstack_ref}[$i]{err}})); # } # if (!defined(${$ade_registered_defined_errors_hash_refs_array[$j]}{${$errstack_ref}[$i]{err}})) { # &ade_err_internal($errstack_ref, "${$errstack_ref}[$i]{err}: unknown error"); # } # $defined_errors_hash_ref = $ade_registered_defined_errors_hash_refs_array[$j]; # # # # # Check sufficient parameters provided # # # # $number_of_percent_signs_in_format = (${${$defined_errors_hash_ref}{${$errstack_ref}[$i]{err}}}{fmt} =~ tr/%//); # $number_of_parameters_supplied = scalar(@{${$errstack_ref}[$i]{par}}); # if ($number_of_percent_signs_in_format != $number_of_parameters_supplied) { # &ade_err_internal($errstack_ref, "error message argument count mismatch (tag: ${$errstack_ref}[$i]{err}, args supplied: $number_of_parameters_supplied, args requires: $number_of_percent_signs_in_format)"); # } # # # # # Expand the description's format with the parameters in the same stack frame # # # # $error_message = sprintf(${${$defined_errors_hash_ref}{${$errstack_ref}[$i]{err}}}{fmt} , @{${$errstack_ref}[$i]{par}}); # # # # # Display the error. # # # # &$displayfunc_ref($errstack_ref, (($ade_err_dumpwholestack)?"frame#$i: ":"") . $error_message); # } # # # # # If we get this far all is ok. # # # # return($ade_err_ok); #} # #sub ade_err_internal #{ # my($errstack_ref, $message) = @_; # # &_ade_err_displayinternal($errstack_ref, $message); # &_ade_gep_exit($errstack_ref, 5); #} # #sub ade_err_error #{ # my($errstack_ref, $defined_errors_hash_key, @errpars) = @_; # my($rc); # # # Deliberately no third parameter as we don't care about getting the # # definition frame at the moment. # if (($rc=_ade_err_validate_errorkey($errstack_ref, $defined_errors_hash_key)) != $ade_err_ok) { # return($rc); # } # # # Create an anonymous hash consisting of the key leading to the # # error format etc and and an anoymous array for the error message's # # parameters. (Note that we *don't* note the hash in which the # # key is defined; we will look for it again when we come to print # # the stack out. # push(@{$errstack_ref}, { err => $defined_errors_hash_key, par => \@errpars }); # # # # # If we get this far all is ok. # # # # return($ade_err_ok); #} # #sub ade_err_warning #{ # my($errstack_ref, $defined_errors_hash_key, @errpars) = @_; # my($rc); # # if (($rc=_ade_err_validate_errorkey($errstack_ref, $defined_errors_hash_key)) != $ade_err_ok) { # return($rc); # } # # push(@{$errstack_ref}, { err => $defined_errors_hash_key, par => \@errpars }); # # # Do an immediate stack dump and reset # if (($rc=&ade_err_displaystack($errstack_ref, \&_ade_err_displaywarning)) != $ade_err_ok) { # return($rc); # } # &ade_err_resetstack($errstack_ref, stack=>$errstack_ref); # # return($ade_err_ok); #} # #sub ade_err_info #{ # my($errstack_ref, $message) = @_; # # # We could stack the message and then demand its immediate display, like # # the error case, but here the $message is really free text and not something # # in the error stack. Therefore we make a shortcut. Perhaps in the future # # I could use a specially registered error with format as just '%s' to # # inject the message to the stack and then call the display function # # immediately - simply for conformancy, but for the moment not. See also # # ade_err_debug(). # # return(&_ade_err_displayinfo($errstack_ref, $message)); #} # #sub ade_err_debug #{ # my($errstack_ref, $level, $message) = @_; # # # We could stack the message and then demand its immediate display, like # # the error case, but here the $message is really free text and not something # # in the error stack. Therefore we make a shortcut. Perhaps in the future # # I could use a specially registered error with format as just '%s' to # # inject the message to the stack and then call the display function # # immediately - simply for conformancy, but for the moment not. See also # # ade_err_info(). # # return(&_ade_err_displaydebug($errstack_ref, $level, $message)); #} def ade_err_debug(errstack, level, message): return _ade_err_displaydebug(errstack, level, message) # ############################################################################### ## ## PUBLIC FUNCTIONS/MESSAGING FUNCTIONS ## ############################################################################### # #sub ade_msg_usage #{ # my($errstack_ref, $text_generator_funcref, $exit_code) = @_; # # #print "ade_msg_usage: sof\n"; # # if ($exit_code != 0) { # print STDERR "$ade_app_progname: ERROR: type '$ade_app_progname --help' for correct usage.\n"; # # } else { # print "Usage: $ade_app_progname [ ] "; # &$text_generator_funcref($errstack_ref, 1); # print "\n"; # print "Options: -V | --version display program version\n"; # print " -v | --verbose verbose\n"; # print " -d | --debug= set debug level\n"; # print " -h | --help display this text\n"; # print " -p | --list-paths list used paths\n"; # #print " -f | --config-file= load alternative config file\n"; # &$text_generator_funcref($errstack_ref, 2); # print "\n"; # } # # &_ade_gep_exit($errstack_ref, $exit_code); # # We do not return from this function #} # #sub ade_msg_version #{ # my($errstack_ref, $version_returner_funcref) = @_; # my($version, $rc); # # # The shell equivalent checks that $version_returner_funcref is a function here. But # # out of laziness I've not done that yet here. # # if (($rc=&$version_returner_funcref($errstack_ref, \$version)) != $ade_err_ok) { # &ade_err_internal($errstack_ref, "ade_msg_version: failed to determine my own version number!"); # } # # print "$ade_app_progname version $version\n"; # &_ade_gep_exit($errstack_ref, 0); #} # #sub ade_msg_listpaths #{ # my($errstack_ref, $listpaths_returner_funcref) = @_; # my($version, $rc, %pathlist, $key); # # if (($rc=&$listpaths_returner_funcref($errstack_ref, \%pathlist)) != $ade_err_ok) { # &ade_err_internal($errstack_ref, "ade_msg_listpaths: failed to determine paths"); # } # # foreach $key (sort keys %pathlist) { # printf "%s: %s\n", $key, $pathlist{$key}; # } # # &_ade_gep_exit($errstack_ref, 0); #} # ## Very very few programs actually need to know the verbosity level themselves; ## mostly they just get ADE to display messages for them, knowing that ADE will ## decide whether to display the message or not on their behalf, but *some* ## programs will need to know. But $ade_msg_verboselevel is to be ## considered private to ADE, so we need to provide a public function to ## read it. # #sub ade_msg_getverboselevel #{ # my ($errstack_ref, $verboselevel_ref) = @_; # # ${$verboselevel_ref} = $ade_msg_verboselevel; # # return($ade_err_ok); #} # #sub ade_msg_askquestion #{ # my($errstack_ref, $hint, $prompt, $default, $validate_fnc, $rationalise_fnc, $rationalised_response_ref) = @_; # my($response, $rc, $validated); # # if (defined($hint)) { # &ade_err_debug($errstack_ref, 20, "ade_msg_askquestion: hint is defined; displaying ..."); # print "$hint\n"; # } # # while (1) { # print "$ade_app_progname: QUESTION: $prompt [$default]: "; # # If this an error occurs below (e.g. 'cos user hits CTRL-D and this function # # returns ade_err_eof) then the error output will arrive *before* the text # # printed above. This is due to it not having a new line and the output being # # buffered. To avoid this confusion we flush immediately. This uses IO::Handle. # STDOUT->flush(); # $response = ; # if (!defined($response)) { # &ade_err_error($errstack_ref, ade_err_eof, "stdin"); # return($ade_err_fail); # } # chomp($response); # ($response eq '') && ($response = $default); # ($response eq '.') && ($response = ''); # &ade_err_debug($errstack_ref, 20, "ade_msg_askquestion: \$response=[$response]"); # if (($rc=&$validate_fnc($errstack_ref, $response, \$validated)) != $ade_err_ok) { # return($rc); # } elsif ($validated) { # last; # } # &ade_err_warning($errstack_ref, iofdb_err_misc, "invalid response; please retry"); # } # # if (!defined($rationalise_fnc)) { # ${$rationalised_response_ref} = $response; # } elsif (($rc=&$rationalise_fnc($errstack_ref, $response, $rationalised_response_ref)) != $ade_err_ok) { # return($rc); # } # # return($ade_err_ok); #} # ############################################################################### ## ## PUBLIC FUNCTIONS/MATHS FUNCTIONS ## ############################################################################### # #sub ade_mth_minimum #{ # my($errstack_ref, $a, $b, $returnval_ref) = @_; # # ${$returnval_ref} = (($a<$b)?$a:$b); # # return($ade_err_ok); #} # ################################################################################ ## ## PUBLIC FUNCTIONS/TEMPORARY FILE MANAGEMENT ## ################################################################################ # #sub ade_tmp_registerfunc #{ # my($errstack_ref, @items) = @_; # # return(&_ade_tmp_register($errstack_ref, "callonexit", @items)); #} # #sub ade_tmp_deregisterfunc #{ # my($errstack_ref, @items) = @_; # # return(&_ade_tmp_deregister($errstack_ref, "callonexit", @items)); #} # #sub ade_tmp_registerfile #{ # my($errstack_ref, @items) = @_; # my($item, $rc); # # # We must enforce that registered items are absolute. This is to protect # # the cleanup routings from risking 'shell-init: getcwd failed' errors # # if the user presses CTRL-C. # # Note that same must be done at deregistration time or we'll not be able # # to make a match in the list of registered items. # @items = map { # &ade_err_debug($errstack_ref, 200, "ade_tmp_registerfile: pre-absolution: $_"); # if (($rc=&ade_fnm_makeabsolute($errstack_ref, $_, undef, \$_)) != $ade_err_ok) { return($rc); } # &ade_err_debug($errstack_ref, 200, "ade_tmp_registerfile: post-absolution: $_"); # $_; # } @items; # # return(&_ade_tmp_register($errstack_ref, "delonexit", @items)); #} # #sub ade_tmp_deregisterfile #{ # my($errstack_ref, @items) = @_; # my($rc); # # @items = map { # &ade_err_debug($errstack_ref, 200, "ade_tmp_deregisterfile: pre-absolution: $_"); # if (($rc=&ade_fnm_makeabsolute($errstack_ref, $_, undef, \$_)) != $ade_err_ok) { return($rc); } # &ade_err_debug($errstack_ref, 200, "ade_tmp_deregisterfile: post-absolution: $_"); # $_; # } @items; # # return(&_ade_tmp_deregister($errstack_ref, "delonexit", @items)); #} # ################################################################################ ## ## PUBLIC FUNCTIONS/STANDARDIZED COMMANDS ## ################################################################################ # #sub ade_std_true #{ # my ($errstack_ref) = @_; # # return($ade_err_ok); #} # #sub ade_std_false #{ # my ($errstack_ref) = @_; # # &ade_err_error($errstack_ref, ade_err_misc, "false-forced error"); # # return($ade_err_fail); #} # #sub ade_std_which #{ # my ($errstack_ref, $program, $return_value_ref) = @_; # my ($dir, $found); # # if ($program =~ /^\// && -f $program && -x $program) { # ${$return_value_ref} = $program; # } elsif ($program =~ /^\//) { # &ade_err_error($errstack_ref, ade_err_access, $program, "find"); # return($ade_err_fail); # } else { # $found = 0; # foreach $dir (split(/:/, $ENV{'PATH'})) { # if (-f "$dir/$program" && -x "$dir/$program") { # ${$return_value_ref} = "$dir/$program"; # $found = 1; # last; # } # } # if (!$found) { # &ade_err_error($errstack_ref, ade_err_access, $program, "find"); # return($ade_err_fail); # } # } # # return($ade_err_ok); #} # ################################################################################ ## ## PUBLIC FUNCTIONS/STRING MANIPULATION FUNCTIONS ## ################################################################################ # #sub ade_smf_extractversionfromsvnstring #{ # my($errstack_ref, $svnstring, $version_ref) = @_; # # &ade_err_debug($errstack_ref, 50, "ade_smf_extractversionfromsvnstring: sof (svnstring=$svnstring)"); # $svnstring =~ m@\$HeadURL: .*?/(trunk|tags/([^/]+)|branches/([^/]+))/.*?\$ \$LastChangedRevision: (\d+) \$@; # #&ade_err_debug($errstack_ref, 50, "ade_smf_extractversionfromsvnstring: \$1=$1, \$2=$2, \$3=$3, \$4=$4"); # if ($1 eq "trunk") { # $$version_ref = "svn/trunk/$4"; # } elsif ($1 =~ /^tags\/(.*)/) { # $$version_ref = "$1"; # } elsif ($1 =~ /^branches\/(.*)/) { # $$version_ref = "svn/branch/$1"; # } else { # &ade_err_internal($errstack_ref, "ade_smf_extractversionfromsvnstring: handling of \"$1\" not implemented yet"); # } # # return($ade_err_ok); #} # #sub ade_smf_isvalidregexp #{ # my($errstack_ref, $regex) = @_; # my($coderef); # # if ($coderef = eval { "junk" =~ /$regex/ }) { } # # if (!defined($coderef)) { # &ade_err_error($errstack_ref, ade_err_invalid, $regex, "regexp"); # return($ade_err_fail); # } # # return($ade_err_ok); #} # #sub ade_smf_validate_float #{ # my($errstack_ref, $value, $validated_ref) = @_; # # # ABC.DEF (where A is 1-9) # # 0.DEF # # .DEF # # ABC (where A is 1-9) # # 0 # # ${$validated_ref} = ($value =~ /^[1-9][0-9]*\.[0-9]+$/ || # $value =~ /^0?\.[0-9]+$/ || # $value =~ /^[1-9][0-9]*$/ || # $value =~ /^0$/); # # return($ade_err_ok); #} # # #sub ade_smf_validate_integer #{ # my($errstack_ref, $value, $validated_ref) = @_; # # # ABC (where A is 1-9) # # 0 # # ${$validated_ref} = ($value =~ /^[1-9][0-9]*$/ || # $value =~ /^0$/); # # return($ade_err_ok); #} # ################################################################################ ## ## PUBLIC FUNCTIONS/FILENAME MANIPULATION ## ################################################################################ # #sub ade_fnm_dirname #{ # my($errstack_ref, $file, $dir_ref) = @_; # # if (!defined($file)) { # # We use error rather than internal so as to be able to report more information in the caller. # &ade_err_error($errstack_ref, "ade_fnm_dirname: \$file: undefined"); # return($ade_err_fail); # # } elsif (!defined($dir_ref)) { # # We use error rather than internal so as to be able to report more information in the caller. # &ade_err_error($errstack_ref, "ade_fnm_dirname: \$dir_ref: undefined"); # return($ade_err_fail); # } # # # Strip trailing slashes (if not made entirely of slashes). I'm sure POSIX has something to # # say on how multiple slashes should be interpreted but this will be okay for now. # $file =~ s/\/+$// if ($file !~ /^\/+$/); # # # aaa --> . # if ($file =~ /^[^\/]+$/) { # ${$dir_ref} = "."; # # # /aaa --> / # } elsif ($file =~ /^\/[^\/]+$/) { # ${$dir_ref} = "/"; # # # aaa/bbb/ccc --> aaa/bbb # # /aaa/bbb/ccc --> /aaa/bbb # # aaa/bbb/ccc/ --> aaa/bbb # # /aaa/bbb/ccc/ --> /aaa/bbb # } else { # (${$dir_ref}) = ($file =~ /^(.*)\/[^\/]+$/); # } # # return($ade_err_ok); #} # #sub ade_fnm_basename #{ # my($errstack_ref, $file, $basename_ref) = @_; # # $file =~ /^.*\/([^\/]+)/; # ${$basename_ref} = $1; # # return($ade_err_ok); #} # ## Name: ade_fnm_makeabsolute - convert paths to absolute paths ## Synopsis: ade_fnm_makeabsolute(, , { | undef }, ) #sub ade_fnm_makeabsolute #{ # my($errstack_ref, $what, $cwd, $return_ref) = @_; # # chomp($cwd = `pwd`) if (!defined($cwd)); # # # If it starts with a slash return it as it is # if ($what =~ /^\//) { # ${$return_ref} = $what; # # If it has ./ or even ././././ at the beginning strip it and prepend cwd # } elsif ($what =~ /^(?:\.\/)+(.*)/) { # ${$return_ref} = "$cwd/$1"; # # else just prepend cwd # } else { # ${$return_ref} = "$cwd/$what"; # } # # return($ade_err_ok); #} # ############################################################################### ## ## PUBLIC FUNCTIONS/DIRECTORY CONTENT MANIPULATION ## ############################################################################### # #sub ade_dcm_movecompressedfile #{ # my($errstack_ref, $srcname, $dstname) = @_; # my($rc); # # &ade_err_debug($errstack_ref, 50, "ade_dcm_movecompressedfile: sof (srcname=$srcname, dstname=$dstname"); # # if (($srcname =~ /\.gz$/ && $dstname =~ /\.gz$/) || # ($srcname =~ /\.Z$/ && $dstname =~ /\.Z$/) || # ($srcname !~ /\.(?:Z|gz)$/ && $dstname !~ /\.(?:Z|gz)$/)) { # &ade_err_debug($errstack_ref, 50, "ade_dcm_movecompressedfile: using 'mv' ..."); # # Linux 'mv' can go interactive, so stdin redirected to avoid this. # if (($rc=system("mv $srcname $dstname < /dev/null 2>/dev/null")) != 0) { # &ade_err_debug($errstack_ref, 50, sprintf("ade_dcm_movecompressedfile: exit: %d, sig: %d, dump: %d", ($rc>>8), ($rc&127), ($rc&128))); # &ade_err_error($errstack_ref, ade_err_access, $srcname, "mv"); # return($ade_err_fail); # } # &ade_err_debug($errstack_ref, 50, "ade_dcm_movecompressedfile: using 'mv' done"); # } else { # &ade_err_debug($errstack_ref, 50, "ade_dcm_movecompressedfile: using ade_fcm_openreadcompressed|ade_fcm_openwritecompressed ..."); # if (($rc=&ade_fcm_openreadcompressed($errstack_ref, $srcname, \*SRC_HANDLE)) != $ade_err_ok) { # &ade_err_error($errstack_ref, ade_err_access, $srcname, "open"); # return($rc); # } # if (($rc=&ade_fcm_openwritecompressed($errstack_ref, $dstname, \*DST_HANDLE)) != $ade_err_ok) { # &ade_err_error($errstack_ref, ade_err_access, $dstname, "open"); # return($rc); # } # while () { # print DST_HANDLE; # } # close(SRC_HANDLE); # close(DST_HANDLE); # if (!unlink($srcname)) { # &ade_err_error($errstack_ref, ade_err_access, $srcname, "unlink"); # return($ade_err_fail); # } # } # # return($ade_err_ok); #} # ################################################################################ ## ## PUBLIC FUNCTIONS/USER-RELATED ## ################################################################################ # #sub ade_usr_getmyloginname #{ # my ($errstack_ref, $id_ref) = @_; # # ${$id_ref} = (getpwuid($<))[0]; # # return($ade_err_ok); #} # #sub ade_usr_amiroot #{ # my ($errstack_ref, $i_am_root_ref) = @_; # # ${$i_am_root_ref} = ($> == 0) ? 1 : 0; # # return($ade_err_ok); #} # ################################################################################ ## ## FILE CONTENT MANIPULATION ## ################################################################################ # #sub ade_fcm_openreadcompressed #{ # my($errstack_ref, $filename, $handle) = @_; # my($rc, $gunzip_cmd, $uncompress_cmd); # # return($ade_err_fail) if (! -r $filename); # # if (! -r $filename) { # &ade_err_error($errstack_ref, ade_err_access, $filename, "read"); # return($ade_err_fail); # } elsif ($filename =~ /^.*\.gz$/) { # if (($rc=&ade_std_which($errstack_ref, 'gunzip', \$gunzip_cmd)) != $ade_err_ok) { # return($rc); # } elsif (!open($handle, "$gunzip_cmd < $filename |")) { # &ade_err_error($errstack_ref, ade_err_access, $filename, "open with '$gunzip_cmd'"); # return($ade_err_fail); # } # } elsif ($filename =~ /^.*\.Z$/) { # if (($rc=&ade_std_which($errstack_ref, 'uncompress', \$uncompress_cmd)) != $ade_err_ok) { # return($rc); # } elsif (!open($handle, "$uncompress_cmd < $filename |")) { # &ade_err_error($errstack_ref, ade_err_access, $filename, "open with '$uncompress_cmd'"); # return($ade_err_fail); # } # } else { # if (!open($handle, $filename)) { # &ade_err_error($errstack_ref, ade_err_access, $filename, "open"); # return($ade_err_fail); # } # } # # return($ade_err_ok); #} # #sub ade_fcm_openwritecompressed #{ # my($errstack_ref, $filename, $handle) = @_; # my($rc, $gzip_cmd, $compress_cmd); # # if ($filename =~ /^.*\.gz$/) { # if (($rc=&ade_std_which($errstack_ref, 'gzip', \$gzip_cmd)) != $ade_err_ok) { # return($rc); # } elsif (!open($handle, "| $gzip_cmd > $filename")) { # &ade_err_error($errstack_ref, ade_err_access, $filename, "open with '$gzip_cmd'"); # return($ade_err_fail); # } # } elsif ($filename =~ /^.*\.Z$/) { # if (($rc=&ade_std_which($errstack_ref, 'compress', \$compress_cmd)) != $ade_err_ok) { # return($rc); # } elsif (!open($handle, "| $compress_cmd > $filename")) { # &ade_err_error($errstack_ref, ade_err_access, $filename, "open with '$compress_cmd'"); # return($ade_err_fail); # } # } else { # if (!open($handle, ">$filename")) { # &ade_err_error($errstack_ref, ade_err_access, $filename, "open"); # return($ade_err_fail); # } # } # # return($ade_err_ok); #} # ################################################################################ ## ## PUBLIC FUNCTIONS/LOCKING ## ################################################################################ # #sub ade_lck_lock #{ # my($errstack_ref, $lock_what, $gen_lock_file_name_fnc) = @_; # my($lock_file, $tmp_lock_file, $old_umask, $lock_text, $holding_pid, $rc, $running_flag); # # # If $lock_what looks like an absolute path then just use that # # as the lock file name, otherwise assume that it is an 'entity' # # of some type (maybe a table name, or a username or something) # # and that the third parameter to this function is a reference to # # a function which will take the entity name and produce a lock # # file name from it. # $lock_file = ($lock_what =~ /^\//) ? $lock_what : &$gen_lock_file_name_fnc($errstack_ref, $lock_what); # &ade_err_debug($errstack_ref, 20, "ade_lck_lock: lock_file=$lock_file"); # $tmp_lock_file = $lock_file . ".$$"; # # # assign the lock text # $lock_text = $$; # # # create temporary lock (world readable) # unlink $tmp_lock_file; # $old_umask = umask(0022); # &ade_tmp_registerfile($errstack_ref, $tmp_lock_file); # if (!open(TMP_LOCK_HANDLE, ">$tmp_lock_file")) { # &ade_err_error($errstack_ref, ade_err_access, $tmp_lock_file, "create"); # return($ade_err_fail); # } # umask($old_umask); # print TMP_LOCK_HANDLE "$$\n"; # close TMP_LOCK_HANDLE; # # # slide the temporary lockfile into place - link() returns 1 for success # &ade_err_debug($errstack_ref, 20, "ade_lck_lock: sliding temp lock into place ..."); # &ade_tmp_registerfile($errstack_ref, $lock_file); # if (link($tmp_lock_file, $lock_file) == 1) { # unlink $tmp_lock_file; # &ade_tmp_deregisterfile($errstack_ref, $tmp_lock_file); # return($ade_err_ok); # } # # # If we get this far then the lock did not success. # # # Make sure we don't delete somebody else's lock file on error. # &ade_tmp_deregisterfile($errstack_ref, $lock_file); # # # Check who is locking us out. # &ade_err_debug($errstack_ref, 20, "ade_lck_lock: sliding temp lock into place failed, checking existing lock ..."); # if (!open(LOCK_HANDLE, $lock_file)) { # &ade_err_error($errstack_ref, ade_err_access, $lock_file, "open"); # return($ade_err_fail); # } # $holding_pid = ; # close(LOCK_HANDLE); # chop($holding_pid); # # Check lock file contents looks like a PID. # if ($holding_pid !~ /^\d+$/) { # unlink($tmp_lock_file); # &ade_tmp_deregisterfile($errstack_ref, $tmp_lock_file); # &ade_err_error($errstack_ref, ade_err_misc, "$lock_file: corrupt lock file"); # return($ade_err_fail); # } # # # Check if the PID is running or is stale. # &ade_err_debug($errstack_ref, 20, "ade_lck_lock: checking if pid $holding_pid running ..."); # if (($rc=&ade_lck_checklock($errstack_ref, $holding_pid, \$running_flag)) != $ade_err_ok) { # &ade_err_debug($errstack_ref, 20, "ade_lck_lock: ade_lck_checklock failed"); # return($rc); # } # if ($running_flag) { # &ade_err_debug($errstack_ref, 20, "ade_lck_lock: ade_lck_checklock said PID exists"); # # If PID is running then clean up and return that it is is locked. # unlink($tmp_lock_file); # &ade_tmp_deregisterfile($errstack_ref, $tmp_lock_file); # &ade_err_error($errstack_ref, ade_err_locked, $ade_app_progname, "PID $holding_pid"); # return($ade_err_fail); # } # # # if lock is stale (it must be if we get here) remove lock # &ade_err_info($errstack_ref, "removing stale lock (pid=$holding_pid) ..."); # unlink($lock_file); # # # try locking again # &ade_err_debug($errstack_ref, 20, "ade_lck_lock: sliding temporary lock into place - second try ..."); # &ade_tmp_registerfile($errstack_ref, $lock_file); # if (link($tmp_lock_file, $lock_file) == 1) { # unlink($tmp_lock_file); # &ade_tmp_deregisterfile($errstack_ref, $tmp_lock_file); # return($ade_err_ok); # } # # # if we still haven't successfully locked by now then there is something # # seriously wrong # unlink($tmp_lock_file); # &ade_tmp_deregisterfile($errstack_ref, $tmp_lock_file); # &ade_err_internal($errstack_ref, "ade_lck_lock: couldn't lock even after removing stale lockfile"); #} # #sub ade_lck_getgenericlockfilename #{ # return("$ade_tmp_dir/$ade_app_progname.pid"); #} # #sub ade_lck_checklock #{ # my($errstack_ref, $pid, $runningflag_ref) = @_; # my($found, $pspid, $junk, $ps_cmd, $unames); # # if (-d "/proc/$pid") { # &ade_err_debug($errstack_ref, 20, "ade_lck_checklock: /proc/$pid exists, returning ..."); # ${$runningflag_ref} = 1; # return($ade_err_ok); # } # $pid = sprintf("%05d", $pid); # if (-d "/proc/$pid") { # &ade_err_debug($errstack_ref, 20, "ade_lck_checklock: /proc/$pid exists, returning ..."); # ${$runningflag_ref} = 1; # return($ade_err_ok); # } # # chop($unames = `uname -s`); # if ($unames eq "Linux") { # $ps_cmd = "ps ax"; # } elsif ($unames eq "SunOS") { # $ps_cmd = "ps -ae"; # } elsif ($unames eq "HP-UX") { # $ps_cmd = "ps -e"; # } else { # &ade_err_internal($errstack_ref, "ade_lck_checklock: don't know who to handle OS $unames (this function needs to be updated)"); # } # # if (!open(PS_HANDLE, "$ps_cmd|")) { # &ade_err_internal($errstack_ref, "ade_lck_checklock: failed to get ps listing with '$ps_cmd'"); # } # # # Assume not running until we discover otherwise. # ${$runningflag_ref} = 0; # while () { # ($pspid, $junk) = split; # ${$runningflag_ref} = 1 if ($pspid == $pid); # } # close PS_HANDLE; # # # # # If we get this far everything is ok. # # # # return($ade_err_ok); #} # #sub ade_lck_unlock #{ # my($errstack_ref, $lock_what, $gen_lock_file_name_fnc) = @_; # my($lock_file); # # &ade_err_debug($errstack_ref, 50, "ade_lck_lock: sof"); # # # If $lock_what looks like an absolute path then just use that # # as the lock file name, otherwise assume that it is an 'entity' # # of some type (maybe a table name, or a username or something) # # and that the third parameter to this function is a reference to # # a function which will take the entity name and produce a lock # # file name from it. # $lock_file = ($lock_what =~ /^\//) ? $lock_what : &$gen_lock_file_name_fnc($errstack_ref, $lock_what); # # unlink $lock_file; # # # # # If we get this far everything is ok. # # # # return($ade_err_ok); #} # ############################################################################### ## ## PUBLIC FUNCTIONS/SPECIAL ## ############################################################################### # #sub ade_spc_procopts #{ # my($errstack_ref, $app_listpaths_funcref, $app_usage_funcref, $app_version_funcref, $config_hasharray_ref, $hash_of_option_handlers_ref) = @_; # my($key, $old_sigwarn_handler, $i, %hash_of_option_handlers, $want_to_show_help, $want_to_show_paths); # # # # # Unset everything. # # # # (This function needs to be re-entrant;it can be called when the # # program starts, but it can also be called when SIGHUP is recieved.) # # # # for ($i=0; $i<=$#{$config_hasharray_ref}; $i++) { # undef ${${$config_hasharray_ref}[$i]{var}}; # } # # # # # Some options can be handled only once we have processed all other options # # # # $want_to_show_paths = 0; # $want_to_show_help = 0; # # %hash_of_option_handlers = ( # # Standard opts # "V|version" => sub { &ade_msg_version($errstack_ref, $app_version_funcref); }, # "v|verbose" => sub { &ade_err_resetstack($errstack_ref, level=>3); }, # "d|debug=i" => sub { &ade_err_resetstack($errstack_ref, level=>$_[1]); }, # "h|help" => \$want_to_show_help, # "p|list-paths" => \$want_to_show_paths, # #"f|config-file" => sub { &ade_err_error($errstack_ref, ade_err_notimplemented, "support for -f/--config-file option"); return($ade_err_fail); }, # # Application specific opts # %{$hash_of_option_handlers_ref} # ); # # # # # Process command line options (top priority). # # # # # Redirect GetOptions's alerts to our alerter. # $old_sigwarn_handler = $SIG{'__WARN__'}; # $SIG{'__WARN__'} = sub { &ade_msg_usage($errstack_ref, $app_usage_funcref, 1); }; # Getopt::Long::GetOptions(%hash_of_option_handlers); # $SIG{'__WARN__'} = $old_sigwarn_handler; # # # # # Assign defaults (third priority therefore done third) # # # # for ($i=0; $i<=$#{$config_hasharray_ref}; $i++) { # #print "examining ${${$config_hasharray_ref}[$i]}{dsc} ...\n"; # # Skip using default if variable already has value # next if (defined(${${$config_hasharray_ref}[$i]{var}})); # # Skip using default if there is no default! # next if (!defined(${$config_hasharray_ref}[$i]{dfl})); # # Use default # ${${$config_hasharray_ref}[$i]{var}} = ${$config_hasharray_ref}[$i]{dfl}; # } # # # # # Derivations # # # # Some values depend on others. Work those out now. # # # # Note that the order in which they are worked out is important # # (e.g. mail_log_dir needs to be determined *before* mail_log_file # # because if the second is not absolute then the first is used as # # a prefix). Hence the 'sort' and 'if (key is ...) elsif (key is ..)' # # # ## foreach $key (sort { if (!defined($a{pri})) { return($ade_err_fail); } elsif (!defined($b{pri})) { return(-1); } else { return ($a{pri} <=> $b{pri}); }} @{$config_hasharray_ref}) { ## &ade_err_debug($errstack_ref, 10, "load_options_and_config_file: key: $key"); ## if ($key =~ /mail_retr_port/ && !defined(${$confighash_map{$key}{var}})) { ## ${$confighash_map{$key}{var}} = (${$confighash_map{mail_retr_method}{var}} eq "IMAP") ##? 143 : 110; ## } elsif ($key =~ /mail_retr_(username|password)/ && !defined(${$confighash_map{$key}{var}}) && ${$confighash_map{mail_retr_authenticate}{var}} eq "NONE") { ## # Put dummy text in so that the 'is everything set?' test below passes. ## # Put dummy text in so that the 'is everything set?' test below passes. ## ${$confighash_map{$key}{var}} = "unused"; ## } elsif ($key =~ /mail_send_(username|password)/ && !defined(${$confighash_map{$key}{var}}) && ${$confighash_map{mail_send_authenticate}{var}} eq "NONE") { ## # Put dummy text in so that the 'is everything set?' test below passes. ## ${$confighash_map{$key}{var}} = "unused"; ## } elsif ($key =~ /mail_.*_dir/) { ## # If a directtory specification is not absolute, make it so. ## ${$confighash_map{$key}{var}} =~ s/^(?!\/)/getcwd."\/"/e; ## } elsif ($key =~ /mail_lock_file/) { ## # If lock file not absolute, make it so. ## ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$lock_dir\//; ## } elsif ($key =~ /mail_log_file/) { ## # If log file not absolute, make it so. ## ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$log_dir\//; ## } elsif ($key =~ /mail_(retr|send)_mbox_file/) { ## # If log file not absolute, make it so. ## ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$log_dir\//; ## } elsif ($key =~ /mail_(status|stats_archive)_table/) { ## # If status table not absolute, make it so. ## ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$state_dir\//; ## } ## } # # # # # Handle list paths option only now we have all relevent info. (Do this *before* # # we check everything now set, as we want to print paths even if enough info # # for doing *other* stuff has not been supplied.) The same goes for help, which # # may display stuff set by defaulting code. # # # # &ade_msg_listpaths($errstack_ref, $app_listpaths_funcref) if ($want_to_show_paths); # &ade_msg_usage($errstack_ref, $app_usage_funcref, 0) if ($want_to_show_help); # # # # # Verify that everything is now set. # # # # for ($i=0; $i<=$#{$config_hasharray_ref}; $i++) { # next if (defined(${${$config_hasharray_ref}[$i]{var}})); # &ade_err_error($errstack_ref, ade_err_undefined, ${$config_hasharray_ref}[$i]{dsc}, "configuration parameter"); # return($ade_err_fail); # } # # # # # Miscellaneous sanity checks # # # ## if (!$retr_interval && !$send_interval && !$stat_interval) { ## &ade_err_error($errstack_ref, ade_err_config, "retrieve, send and stat intervals are all zero!"); ## return($ade_err_fail); ## } # # # # # If we get this far everything is ok. # # # # return($ade_err_ok); #} # ## Rolling Status Manager #sub ade_spc_rollingstatusmanager #{ # my ($errstack_ref, $mode, $sched_file, $scan_funcref, $comp_funcref, $midhook_funcref, # $oldscan_stem, $oldscan_compext, $log_file, $scanarg, $tmp_dir, $rollcount) = @_; # my($rc, $newest_status_file, $i, $newer_status_file, $older_status_file); # # &ade_err_debug($errstack_ref, 10, "ade_spc_rollingstatusmanager: mode=$mode, sched_file=$sched_file, oldscan_stem=$oldscan_stem, oldscan_compext=$oldscan_compext, log_file=$log_file, scanarg=$scanarg, tmp_dir=$tmp_dir, rollcount=$rollcount"); # # $newest_status_file = "$tmp_dir/$ade_app_progname.$$.snap"; # # # For init, check or refresh, do a new scan. # if ($mode eq "init" || $mode eq "check" || $mode eq "refresh") { # &ade_tmp_registerfile($errstack_ref, $newest_status_file); # # Get ready to write to the (compressed) new scan file. # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: opening new scan file $newest_status_file ..."); # if (($rc=&ade_fcm_openwritecompressed($errstack_ref, $newest_status_file, \*NEWSCAN_HANDLE)) != $ade_err_ok) { # &ade_err_error($errstack_ref, ade_err_access, $newest_status_file, "open"); # return($rc); # } # # In a moment we'll redirect stdout, but before we do we need to # # remember where stdout is pointing now so that we can restore it # # in a moment. # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: remembering stdout ..."); # # Avoid names that might clash with user applications for the handle, since it is a global. # if (!open(ADESPCRSM_OLD_STDOUT, ">&STDOUT")) { # &ade_err_internal($errstack_ref, "ade_spc_rollingstatusmanager: can't dup stdout"); # } # # Here we redirect it. # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: redirecting stdout ..."); # open(STDOUT, ">&NEWSCAN_HANDLE"); # # Now scan_funcref() can just merrily output to stdout. # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: calling the scanning callback ..."); # if (($rc=&$scan_funcref($errstack_ref, $scanarg)) != $ade_err_ok) { # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: scanning callback failed"); # close NEWSCAN_HANDLE; # open(STDOUT, ">&ADESPCRSM_OLD_STDOUT") || &ade_err_internal($errstack_ref, "ade_spc_rollingstatusmanager: can't dup stdout"); # } # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: scanning callback successful"); # # Restore stdout. # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: restoring stdout ..."); # if (!open(STDOUT, ">&ADESPCRSM_OLD_STDOUT")) { # &ade_err_internal($errstack_ref, "ade_spc_rollingstatusmanager: can't restore stdout"); # } # # Close the (compressed) new scan file. # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: closing scan handle ..."); # close NEWSCAN_HANDLE; # } # # # For check or refresh, compare the old and new scans. # if ($mode eq "check" || $mode eq "refresh") { # for ($i=$rollcount; $i>0; $i--) { # if ($i == 1) { # $newer_status_file = $newest_status_file; # $older_status_file = sprintf("%s%s", $oldscan_stem, $oldscan_compext); # } elsif ($i == 2) { # $newer_status_file = sprintf("%s%s", $oldscan_stem, $oldscan_compext); # $older_status_file = sprintf("%s.%s%s", $oldscan_stem, $i, $oldscan_compext); # } else { # $newer_status_file = sprintf("%s.%s%s", $oldscan_stem, $i-1, $oldscan_compext); # $older_status_file = sprintf("%s.%s%s", $oldscan_stem, $i, $oldscan_compext); # } # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: \$rollcount=$rollcount, \$i=$i, \$older_status_file=$older_status_file, \$newer_status_file=$newer_status_file"); # # # When first running this, there may not be enough 'old' # # scan logs to make all the desired comparisons. i.e. # # oldest with second-to-oldest, second-to-oldest with # # third-from-oldest, etc. This isn't really an error; it's # # just a natural part of the initial use of this rolling # # state monitor. If/when it does happen, then clearly we # # need to move on to the 'slightly newer' - which may # # exist - for comparison. # # # # Actually, there is an exception to this; and that is # # when we only maintain *one* file older than the temporary # # copy. And in that case this older file should *always* # # exist; if it doesn't then we've obviously gone wrong # # in reaching this point in the program. # if (! -f $older_status_file) { # if ($rollcount > 1) { # next; # } else { # &ade_err_error($errstack_ref, ade_err_access, $older_status_file, "access"); # return($ade_err_fail); # } # } # # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: doing a comparision ..."); # if (defined($log_file)) { # if (($rc=&ade_fcm_openwritecompressed($errstack_ref, $log_file, \*LOG_HANDLE)) != $ade_err_ok) { # &ade_err_error($errstack_ref, ade_err_access, $log_file, "open"); # return($rc); # } else { # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: \$log_file not defined; not an error"); # } # # Avoid names that might clash with user applications for the handle, since it is a global. # if (!open(ADESPCRSM_OLD_STDOUT, ">&STDOUT")) { # &ade_err_internal($errstack_ref, "ade_spc_rollingstatusmanager: can't dup stdout"); # } # open(STDOUT, ">&LOG_HANDLE"); # } # if (($rc=&$comp_funcref($errstack_ref, $older_status_file, $newer_status_file, $i)) != $ade_err_ok) { # # don't bother checking if open produces an error when we are # # already in an error situation. # if (defined($log_file)) { # open(STDOUT, ">&ADESPCRSM_OLD_STDOUT"); # close LOG_HANDLE; # # We have to inform the user of where they can get the error # # because zdiff (called from anonymous callback in wkrep) # # is not well behaved about where it sends errors to. Try # # 'zdiff asdfg sdfdfg > /dev/null' and there is no error # # message on stdout saying 'files do not exist'. But to # # assume that the error is *never* displayed and cat the # # log file *here* would be too presumtive. # &ade_err_error($errstack_ref, ade_err_misc, "comparison failed; $log_file may provide more information"); # } else { # &ade_err_error($errstack_ref, ade_err_misc, "comparison failed"); # } # return($rc); # } # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: comparing callback successful"); # if (defined($log_file)) { # if (!open(STDOUT, ">&ADESPCRSM_OLD_STDOUT")) { # &ade_err_internal($errstack_ref, "ade_spc_rollingstatusmanager: can't restore STDOUT: $!"); # } # close LOG_HANDLE; # } # } # } # # # This hook is specifically for checkntp to allow it to write # # 'marking NTP ok even though it failed and is about to be restarted # # so that in five minutes when checkntp runs again, even though NTP # # will not be ok and all historical records show it never was ok we # # still do not restart it.' # if (defined($midhook_funcref)) { # if (($rc=&$midhook_funcref($errstack_ref, $newest_status_file)) != $ade_err_ok) { # &ade_err_error($errstack_ref, ade_err_misc, "midhook function failed"); # return($rc); # } # } # # # For check with schedule, or refresh, or init, make the new snap the # # old snap. Don't do it by moving or copying 'cos we may move a gzipped # # file to a non-gzipped name, which will cause problems. # if (($mode eq "check" && defined($sched_file) && -f $sched_file) || $mode eq "refresh" || $mode eq "init") { # for ($i=$rollcount; $i>0; $i--) { # if ($i == 1) { # $newer_status_file = $newest_status_file; # $older_status_file = sprintf("%s%s", $oldscan_stem, $oldscan_compext); # } elsif ($i == 2) { # $newer_status_file = sprintf("%s%s", $oldscan_stem, $oldscan_compext); # $older_status_file = sprintf("%s.%s%s", $oldscan_stem, $i, $oldscan_compext); # } else { # $newer_status_file = sprintf("%s.%s%s", $oldscan_stem, $i-1, $oldscan_compext); # $older_status_file = sprintf("%s.%s%s", $oldscan_stem, $i, $oldscan_compext); # } # # # This is the same as the comparsion case when there isn't # # the needed 'old' scan files. # if (! -f $newer_status_file) { # if ($rollcount > 1) { # next; # } else { # &ade_err_error($errstack_ref, ade_err_access, $newer_status_file, "access for stealing"); # return($ade_err_fail); # } # } # # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: shuffling up ($newer_status_file -> $older_status_file) ..."); # if (($rc=&ade_dcm_movecompressedfile($errstack_ref, $newer_status_file, $older_status_file)) != $ade_err_ok) { # &ade_err_error($errstack_ref, ade_err_access, $newer_status_file, "move"); # return($rc); # } # } # # # The temporary snapshot file has been preserved under a proper name, so # # we no longer need to delete it. # &ade_tmp_deregisterfile($errstack_ref, $newest_status_file); # } # # # For check with schedule, or refresh, delete the schedule file. # if (defined($sched_file) && (($mode eq "check" && -f $sched_file) || $mode eq "refresh")) { # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: removing sched file ..."); # unlink($sched_file); # } # # # For scheduling, create the schedule file. # if ($mode eq "schedule") { # if (!defined($sched_file)) { # &ade_err_internal($errstack_ref, "ade_spc_rollingstatusmanager: called in 'schedule' mode, but the schedule file is undefined"); # } # &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: creating sched file ..."); # if (!open(HANDLE, ">$sched_file")) { # &ade_err_error($errstack_ref, ade_err_access, $sched_file, "create"); # return($ade_err_fail); # } # close HANDLE; # } # # # For checks without a schedule file we can now delete the temporary snapshot. # unlink($newest_status_file); # &ade_tmp_deregisterfile($errstack_ref, $newest_status_file); # # return($ade_err_ok); #} # #sub ade_spc_autogendheader #{ # my($errstack_ref, $outhandle, $comment_start, $comment_end, $headersize_ref) = @_; # my($user, $unamen, $date, $linelength, $textlength, $rc); # # &ade_err_debug($errstack_ref, 4, "ade_spc_autogendheader: sof (COS=$comment_start, COE=$comment_end)"); # # $comment_start = '#' if (!defined($comment_start)); # $comment_end = '' if (!defined($comment_end)); # # if (($rc=&ade_usr_getmyloginname($errstack_ref, \$user)) != $ade_err_ok) { # return($rc); # } # chop($unamen = `uname -n`); # $linelength = 78; # chop($date = `date`); # $textlength = $linelength - (length($comment_start) + length($comment_end)); # printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "=" x $textlength, $comment_end; # printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "", $comment_end; # printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, " T H I S I S A G E N E R A T E D F I L E", $comment_end; # printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "", $comment_end; # printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, " M A N U A L E D I T S M A Y B E L O S T", $comment_end; # printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "", $comment_end; # printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, " Generated by: $user", $comment_end; # printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, " Generated with: $ade_app_progname", $comment_end; # printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, " Generated on host: $unamen", $comment_end; # printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, " Generated on date: $date", $comment_end; # printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "", $comment_end; # printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "=" x $textlength, $comment_end; # # # pass the number of lines add to the the parent. # ${$headersize_ref} = 12 if (defined($headersize_ref)); # # return($ade_err_ok); #} # #sub ade_spc_cachemanager #{ # my ($errstack_ref, $cache_file, $cache_expiry_period, $desired_cache_expiry, $new_cache_tester_fncref, $new_cache_getter_fncref, $cache_id) = @_; # my ($actual_cache_expiry, $cache_dir, $refresh_cache, $rc); # # # Determine if cache actually expired # $actual_cache_expiry = (time - (stat($cache_file))[9] >= 86400 * $cache_expiry_period); # # # This is the logic for combining the desired cache expiry status and # # the actual cache expiry status to determine if the cache should be # # refreshed. # # # # DESIRED EXPIRY # # Y N don't care # # ----------+is-cache--+---------- # # | | | | # # A | | no | | # # C | | update | | # # T | | | | # # U Y | update |no-cache--| update | # # A | | | | # # L | | update | | # # | | | | # # ----------+----------+---------- # # E | | | | # # X | | | | # # P | | | | # # I | | no | no | # # R N | update | update | update | # # Y | | | | # # | | | | # # | | | | # # ----------+----------+---------- # # # # And now here it is in code, using the usual 'bite off the big # # bits first' approach. # # if ($desired_cache_expiry) { # $refresh_cache = 1; # } elsif (!$actual_cache_expiry) { # $refresh_cache = 0; # } elsif (!defined($desired_cache_expiry)) { # $refresh_cache = 1; # } elsif (-f $cache_file) { # $refresh_cache = 0; # } else { # &ade_err_warning($errstack_ref, "cache will be refreshed against user's desire because no cache file exists yet"); # $refresh_cache = 1; # } # # &ade_err_debug($errstack_ref, 4, "ade_spc_cachemanager: desired_cache_expiry=$desired_cache_expiry, actual_cache_expiry=$actual_cache_expiry, refresh_cache=$refresh_cache"); # # if ($refresh_cache) { # return($rc) if (($rc=&ade_fnm_dirname($errstack_ref, $cache_file, \$cache_dir)) != $ade_err_ok); # # # sanity check cache # if (-f $cache_file) { # if (! -w $cache_file) { # &ade_err_error($errstack_ref, ade_err_misc, "$cache_file: cache file exists but is not writable!") if (! -w $cache_file); # return($ade_err_fail); # } # } elsif (-d $cache_dir) { # if (! -w $cache_dir) { # &ade_err_error($errstack_ref, ade_err_misc, "$cache_file: cannot create cache file") if (! -w $cache_dir); # return($ade_err_fail); # } # } else { # &ade_err_error($errstack_ref, ade_err_misc, "$cache_dir: cache file's directory does not exist"); # return($ade_err_fail); # } # # # update cache # &ade_err_info($errstack_ref, "updating '$cache_id' cache, please wait ... "); # &ade_tmp_registerfile($errstack_ref, "$ade_tmp_dir/$ade_app_progname.$$.newcache"); # &ade_err_debug($errstack_ref, 4, "ade_spc_cachemanager: calling $new_cache_getter_fncref() ..."); # if (!open(TMPCACHE_HANDLE, ">$ade_tmp_dir/$ade_app_progname.$$.newcache")) { # &ade_err_error($errstack_ref, ade_err_access, "$ade_tmp_dir/$ade_app_progname.$$.newcache", "open"); # return($ade_err_fail); # } # # Avoid names that might clash with user applications for the handle, since it is a global. # if (!open(ADESPCCM_OLD_STDOUT, ">&STDOUT")) { # &ade_err_internal($errstack_ref, "ade_spc_cachemanager: can't dup stdout"); # } # open(STDOUT, ">&TMPCACHE_HANDLE"); # &$new_cache_getter_fncref; # if (!open(STDOUT, ">&ADESPCCM_OLD_STDOUT")) { # &ade_err_internal($errstack_ref, "ade_spc_cachemanager: can't dup stdout"); # } # close(TMPCACHE_HANDLE); # # # if tests pass, accept it. # if (&$new_cache_tester_fncref("$ade_tmp_dir/$ade_app_progname.$$.newcache") == 0) { # system("cat $ade_tmp_dir/$ade_app_progname.$$.newcache > $cache_file"); # unlink("$ade_tmp_dir/$ade_app_progname.$$.newcache"); # &ade_tmp_deregisterfile($errstack_ref, "$ade_tmp_dir/$ade_app_progname.$$.newcache"); # &ade_err_info($errstack_ref, "'$cache_id' cache update succeeded"); # # # if tests fail but we have an old version, reject with warning # } elsif (-f $cache_file) { # &ade_tmp_deregisterfile($errstack_ref, "$ade_tmp_dir/$ade_app_progname.$$.newcache"); # &ade_err_warning($errstack_ref, "'$cache_id' cache update failed, old cache available (see $ade_tmp_dir/$ade_app_progname.$$.newcache for new data which failed acceptance test)"); # # # if tests fail and we don't have an old version, reject with error # } else { # &ade_tmp_deregisterfile($errstack_ref, "$ade_tmp_dir/$ade_app_progname.$$.newcache"); # &ade_err_error($errstack_ref, ade_err_misc, "'$cache_id' cache update failed, old cache not available (see $ade_tmp_dir/$ade_app_progname.$$.newcache for new data which failed acceptance test)"); # return($ade_err_fail); # } # } # # # Pass cache to parent # system("cat $cache_file"); # # # success return code # return($ade_err_ok); #} # ############################################################################### ## ## PUBLIC FUNCTIONS/MAIL ## ############################################################################### # #sub ade_mua_addmailheader #{ # my($errstack_ref, $headers_ref, $header_line) = @_; # my($header_name, $header_value, $current_element_count); # # ($header_name, $header_value) = split(/:\s+/, $header_line, 2); # $current_element_count = scalar keys(%$headers_ref); # &ade_err_debug($errstack_ref, 4, "ade_mua_addmailheader: number of elements so far is $current_element_count"); # $$headers_ref{$header_name} = { # lineno => $current_element_count, # value => $header_line # }; # # return($ade_err_ok); #} # #sub ade_mua_delmailheader #{ # my($errstack_ref, $headers_ref, $header_name) = @_; # # delete($$headers_ref{$header_name}); # # return($ade_err_ok); #} # ##sub ade_mua_loadrcfile ##{ ## my($headers_ref) = @_; ## my($mymailrc_file, $rc); ## ## $mymailrc_file = $ENV{'HOME'} . "/.mymailrc"; ## # It is not an error for this file to be inaccessible. ## if (open(MYMAILRC_HANDLE, $mymailrc_file)) { ## while () { ## chomp; ## &ade_err_debug($errstack_ref, 4, "ade_mua_loadrcfile: read line $_"); ## if (/^\s*$/) { ## next; ## } elsif (/^\s*#.*$/) { ## next; ## } else { ## if (($rc=&ade_mua_addmailheader($headers_ref, $_)) != 0) { ## &ade_err_error($errstack_ref, ade_err_misc, "ade_mua_addmailheader() failed, returning early ..."); ## return($rc); ## } ## } ## } ## close(MYMAILRC_HANDLE); ## } ## ## return($ade_err_ok); ##} # #sub ade_mua_sendmail #{ # my($errstack_ref, $headers_ref, $body_handle, $mailto_ref) = @_; # my($user, $smtp, $mymailrc_file, $key, $rc); # # # # # Catch relative and unexecutable sendmail. (Previously these were done at start-time, not # # at when-sendmail-actually-needed-time, but this presents problems to users - e.g. Thomas - # # who don't have sendmail and don't want it and won't write programs that use it. # # # # if ($sendmail_cmd && $sendmail_cmd !~ /^\//) { # &ade_err_error($errstack_ref, ade_err_misc, "sendmail command ($sendmail_cmd) is not absolute"); # return($ade_err_fail); # # } elsif ($sendmail_cmd && ! -x $sendmail_cmd) { # &ade_err_error($errstack_ref, ade_err_misc, "can't execute $sendmail_cmd"); # return($ade_err_fail); # # # # # If sendmail command defined then use it. # # # # } elsif ($sendmail_cmd) { # &ade_err_debug($errstack_ref, 4, "ade_mua_sendmail: mailing with $sendmail_cmd"); # if (!open(PIPE_HANDLE, "| $sendmail_cmd " . join(' ', @$mailto_ref))) { # &ade_err_error($errstack_ref, ade_err_access, "open pipe to $sendmail_cmd"); # return($ade_err_fail); # } # print PIPE_HANDLE map { $$headers_ref{$_}{value} . "\n" } (sort { $$headers_ref{$a}{lineno} <=> $$headers_ref{$b}{lineno} } keys %$headers_ref); # print PIPE_HANDLE "\n"; # while (<$body_handle>) { # print PIPE_HANDLE; # } # close PIPE_HANDLE; # # # # # Else use SMTPSERVER # # # # } elsif ($ENV{'SMTPSERVER'}) { # &ade_err_debug($errstack_ref, 4, "ade_mua_sendmail: mailing with Net::SMTP to $ENV{'SMTPSERVER'} for " . join(' ', @$mailto_ref)); # $smtp = Net::SMTP->new($ENV{'SMTPSERVER'}); # # this is about the safest definition of our own email address, # if (($rc=&ade_usr_getmyloginname($errstack_ref, \$user)) != $ade_err_ok) { # return($rc); # } # $smtp->mail($user . "\@[127.0.0.1]"); # $smtp->to(@$mailto_ref); # $smtp->data(); # $smtp->datasend(map { $$headers_ref{$_}{value} . "\n" } (sort { $$headers_ref{$a}{lineno} <=> $$headers_ref{$b}{lineno} } keys %$headers_ref)); # $smtp->datasend("\n"); # while (<$body_handle>) { # $smtp->datasend($_); # } # $smtp->dataend(); # $smtp->quit; # # # # # Otherwise give up. # # # # } else { # &ade_err_error($errstack_ref, ade_err_misc, "no deliver method available"); # return($ade_err_fail); # } # # # return($ade_err_ok); #} # #sub ade_mua_parsemail #{ # my($errstack_ref, $letter_handle, $headers_ref, $body_handle) = @_; # my($header_name, $header_value, $finished_processing_headers); # my($last_header_line_was_received_leader, %new_headers); # # # Put lines into 'new' headers and bodylines # $finished_processing_headers = 0; # %new_headers = (); # while (<$letter_handle>) { # chomp; # # &ade_err_debug($errstack_ref, 4, "ade_mua_parsemail: line=[$_]"); # ($header_name, $header_value) = split(/:\s+/, $_, 2); # # if ($finished_processing_headers) { # ; # # } elsif ($header_name !~ /^(?:From|Reply-To|Date|Subject|Received|Keywords|X-Newsreader|Summary|Distribution|Message-Id|Return-Path|Newsgroups|References)$/) { # $finished_processing_headers = 1; # } # # if ($finished_processing_headers) { # print $body_handle "$_\n"; # } else { # &ade_mua_addmailheader(\%new_headers, $_); # } # } # # &ade_mua_mergemailheaders($headers_ref, \%new_headers); # undef %new_headers; # # return($ade_err_ok); #} # #sub ade_mua_mergemailheaders #{ # my($headers_ref, $new_headers_ref) = @_; # my($new_header_key); # #my($new_bodyline); # # #foreach $new_bodyline (@$new_bodylines_ref) { # # push(@$bodylines_ref, $new_bodyline); # #} # # foreach $new_header_key (keys %$new_headers_ref) { # $$headers_ref{$new_header_key} = $$new_headers_ref{$new_header_key}; # } # # return($ade_err_ok); #} # ################################################################################ ## ## PRIVATE FUNCTIONS ## ################################################################################ # #sub _ade_gep_main_withstack #{ # my($errstack_ref, $app_main_ref) =@_; # my($rc); # # #printf "_ade_gep_main_withstack: sof\n"; # # # In perl we check if functions return $ade_err_ok, but this is not # # really practical in a shell script; '|| ...' is such a natural # # construct that we don't want to change it to 'RC=$?; if [ $RC != 0 ]; then' # # #printf "_ade_gep_main_withstack: calling _ade_gep_getosid ...\n"; # if (($rc=&_ade_gep_getosid($errstack_ref)) != $ade_err_ok) { # &ade_err_error($errstack_ref, ade_err_misc, "failed to determine OS"); # return($rc); # } # # #print "_ade_gep_main_withstack: calling app_main_ref function (btw: \$ade_err_ok is $ade_err_ok) ...\n"; # if(($rc=&{$app_main_ref}($errstack_ref)) != $ade_err_ok) { # #print "_ade_gep_main_withstack: app_main_ref function failed\n"; # &ade_err_error($errstack_ref, ade_err_misc, "application's entry function failed"); # return($rc); # } else { # #print "_ade_gep_main_withstack: app_main_ref function succeeded! (\$rc=$rc)\n"; # } # # # # # If we get this far then everything is ok. # # # # return($ade_err_ok); #} def _ade_gep_main_withstack(errstack, app_main_ref): rc = _ade_gep_getosid(errstack) if rc != ade_err_ok: ade_err_error(errstack, ade_err_misc, "failed to determine OS") return rc rc = app_main_ref(errstack) if rc != ade_err_ok: ade_err_error(errstack_ref, ade_err_misc, "application's entry function failed") return rc # # If we get this far then everything is ok. # return ade_err_ok # ## This contains the *only* call to exit. #sub _ade_gep_exit #{ # my($errstack_ref, $rc) = @_; # # # Should be expanded as the shell version to call all # # registered functions. # # &_ade_tmp_cleanup($errstack_ref); # &_ade_tmp_funcup($errstack_ref); # # # This line maps ADE function return codes into Unix program exit codes. # # It should be the only call to 'exit' anywhere. # exit(($rc==$ade_err_ok)?0:1); #} def _ade_gep_exit(errstack, rc): _ade_tmp_cleanup(errstack) _ade_tmp_funcup(errstack) sys.exit(0 if rc == ade_err_ok else 1) # #sub _ade_gep_signalhandler #{ # my($errstack_ref) = []; # # &ade_err_resetstack($errstack_ref, stack=>$errstack_ref); # # &ade_err_info($errstack_ref, "clearing up ..."); # &_ade_gep_exit($errstack_ref, 4); #} # #sub _ade_gep_getosid #{ # my($errstack_ref) = @_; # my($ade_unames, $ade_unamer, $ade_unamen, $ade_unamem, $ade_osid); # # # Very useful settings # chomp($ade_unames=`uname -s`); # chomp($ade_unamer=`uname -r`); # chomp($ade_unamen=`uname -n`); # chomp($ade_unamem=`uname -m`); # # # Don't differentiate Intel processors # $ade_unamem = "i386" if ($ade_unamem =~ /^i[3456]86$/); # # # ADE_OSID is the absolute OS reference. It has no spaces or slashes in # # it for safer use later on. Linux requires some massaging here, # # since revision comes from the kernel version and this is not # # really terribly useful. # if ($ade_unames ne "Linux") { # chomp($ade_osid=`uname -sr | sed 's/[ \/]/_/g'`); # } elsif (-f '/etc/redhat-release') { # chomp($ade_osid=`sed -n 's/.*release \([^ ][^ ]*\) .*/\1/p' /etc/redhat-release`); # $ade_osid="Linux_Redhat_${ade_osid}_$ade_unamem"; # } elsif (-f '/etc/debian_version') { # chomp($ade_osid=`cat /etc/debian_version`); # $ade_osid="Linux_Debian_${ade_osid}_$ade_unamem"; # } else { # $ade_osid="Linux_Unknown_$ade_unamem"; # } # if ($ade_osid =~ /^Linux_Redhat_6\.1_i.*86$/) { # $ade_osid='Linux_Redhat_6.1_i386'; # } elsif ($ade_osid =~ /^Linux_Debian_2\.2_i.*86$/) { # $ade_osid='Linux_Debian_2.2_i386'; # } elsif ($ade_osid =~ /^HP-UX_B\.11\.00$/) { # chomp($ade_osid="${ade_osid}_`/usr/bin/getconf KERNEL_BITS`"); # } # # # # # If we get this far then everything is ok. # # # # return($ade_err_ok); #} def _ade_gep_getosid(errstack): global ade_unames, ade_unamer, ade_unamen, ade_unamem, ade_osid ade_unames = subprocess.Popen(["uname", "-s"], stdout=subprocess.PIPE).communicate()[0].rstrip() ade_unamer = subprocess.Popen(["uname", "-r"], stdout=subprocess.PIPE).communicate()[0].rstrip() ade_unamen = subprocess.Popen(["uname", "-n"], stdout=subprocess.PIPE).communicate()[0].rstrip() ade_unamem = subprocess.Popen(["uname", "-m"], stdout=subprocess.PIPE).communicate()[0].rstrip() if re.search('^i[3456]86$', ade_unamem): ade_unamem = "i386" # # ADE_OSID is the absolute OS reference. It has no spaces or slashes in # # it for safer use later on. Linux requires some massaging here, # # since revision comes from the kernel version and this is not # # really terribly useful. if ade_unames != 'Linux': # if ($ade_unames ne "Linux") { # chomp($ade_osid=`uname -sr | sed 's/[ \/]/_/g'`); ade_osid = subprocess.Popen(["uname", "-sr"], stdout=subprocess.PIPE).communicate()[0].rstrip().replace(' /', '_') # } elsif (-f '/etc/redhat-release') { # chomp($ade_osid=`sed -n 's/.*release \([^ ][^ ]*\) .*/\1/p' /etc/redhat-release`); # $ade_osid="Linux_Redhat_${ade_osid}_$ade_unamem"; elif os.access("/etc/redhat-release", os.F_OK): subprocess.Popen(["cat", "/etc/redhat-release"], stdout=subprocess.PIPE).communicate()[0].rstrip() ade_osid = 'Linux_Redhat_' + subprocess.Popen(["uname", "-sr"], stdout=subprocess.PIPE).communicate()[0].rstrip().replace(' ', '_') + '_' + ade_unamem # } elsif (-f '/etc/debian_version') { # chomp($ade_osid=`cat /etc/debian_version`); # $ade_osid="Linux_Debian_${ade_osid}_$ade_unamem"; elif os.access("/etc/debian_version", os.F_OK): ade_osid = 'Linux_Debian_' + subprocess.Popen(["cat", "/etc/debian_version"], stdout=subprocess.PIPE).communicate()[0].rstrip() + '_' + ade_unamem # } else { # $ade_osid="Linux_Unknown_$ade_unamem"; # } else: ade_osid = 'Linux_Unknown_$ade_unamem' # if ($ade_osid =~ /^Linux_Redhat_6\.1_i.*86$/) { # $ade_osid='Linux_Redhat_6.1_i386'; # } elsif ($ade_osid =~ /^Linux_Debian_2\.2_i.*86$/) { # $ade_osid='Linux_Debian_2.2_i386'; # } elsif ($ade_osid =~ /^HP-UX_B\.11\.00$/) { # chomp($ade_osid="${ade_osid}_`/usr/bin/getconf KERNEL_BITS`"); # } # # # # # If we get this far then everything is ok. # # # # return($ade_err_ok); #} return ade_err_ok #sub _ade_err_validate_errorkey #{ # # my($errstack_ref, $defined_errors_hash_key) = @_; # my($i); # # # Scan over the list of registered hashes ... # for ($i=0; $i<=$#ade_registered_defined_errors_hash_refs_array; $i++) { # last if (defined(${$ade_registered_defined_errors_hash_refs_array[$i]}{$defined_errors_hash_key})); # } # if (!defined(${$ade_registered_defined_errors_hash_refs_array[$i]}{$defined_errors_hash_key})) { # &ade_err_internal($errstack_ref, "$defined_errors_hash_key: unknown error"); # } # # return($ade_err_ok); #} # #sub _ade_msg_message #{ # my($errstack_ref, $level, $template, $message) = @_; # my($writerfunc_ref); # # # Don't bother continuing if the message is not sufficiently important. # return($ade_err_ok) if ($level > $ade_msg_verboselevel); # # $template =~ s/%MESSAGE/$message/; # $template =~ s/%LEVEL/$level/; # # #printf "_ade_msg_message: about to check which writer functions to call ...\n"; # foreach $writerfunc_ref (@ade_err_writerfunc_refs) { # &$writerfunc_ref($errstack_ref, $template); # } # # return($ade_err_ok); #} def _ade_msg_message(errstack, level, template, message): global ade_msg_verboselevel, ade_err_writerfunc_refs if level > ade_msg_verboselevel: return(ade_err_ok) template.replace('%MESSAGE', message) template.replace('%LEVEL', level) for writerfunc_ref in ade_err_writerfunc_refs: writerfunc_ref(errstack, template) return ade_err_ok # #sub _ade_tmp_register #{ # my($errstack_ref, $listname, @items) = @_; # my($item); # # # Add all the specified items to the specified list. # foreach $item (@items) { # $ade_registers{$listname}{$item} = 1; # } # # return($ade_err_ok); #} # #sub _ade_tmp_deregister #{ # my($errstack_ref, $listname, @items) = @_; # my($item); # # # Delete all the specified items from the specified list. # foreach $item (@items) { # delete $ade_registers{$listname}{$item}; # } # # return($ade_err_ok); #} # #sub _ade_tmp_deregisterallfunc #{ # my($errstack_ref) = @_; # # return(&_ade_tmp_deregisterall($errstack_ref, "callonexit")); #} def _ade_tmp_deregisterallfunc(errstack): return _ade_tmp_deregisterall(errstack, "callonexit") # #sub _ade_tmp_deregisterallfile #{ # my($errstack_ref) = @_; # # return(&_ade_tmp_deregisterall($errstack_ref, "delonexit")); #} def _ade_tmp_deregisterallfile(errstack): return _ade_tmp_deregisterall(errstack, "delonexit") # #sub _ade_tmp_deregisterall #{ # my($errstack_ref, $listname) = @_; # my($item); # # foreach $item (keys %{$ade_registers{$listname}}) { # &_ade_tmp_deregister($errstack_ref, $listname, $item); # } # # return($ade_err_ok); #} def _ade_tmp_deregisterall(errstack, listname): try: for item in ade_registers[listname].keys(): _ade_tmp_deregister(errstack, listname, item) except KeyError: pass return ade_err_ok # #sub _ade_tmp_cleanup #{ # my($errstack_ref) = @_; # my($item, $pwd); # # &ade_err_debug($errstack_ref, 40, "_ade_tmp_cleanup: sof"); # # # Avoid 'shell-init: error retrieving current directory' # chdir("/"); # # foreach $item (keys %{$ade_registers{delonexit}}) { # # unlink is not enough, 'cos directories are sometimes registered, # # and what's more the caller does not expect to have to register # # the contents of directories one by one. # system("rm -fr $item 2>/dev/null"); # } # return(&_ade_tmp_deregisterallfile($errstack_ref)); #} def _ade_tmp_cleanup(errstack): global ade_registers ade_err_debug(errstack, 40, "_ade_tmp_cleanup: sof") os.chdir('/') try: for item in ade_registers['delonexit'].keys(): os.system("echo rm -fr " + item) except KeyError: pass return _ade_tmp_deregisterallfile(errstack) # #sub _ade_tmp_funcup #{ # my($errstack_ref) = @_; # my($item); # # &ade_err_debug($errstack_ref, 40, "_ade_tmp_funcup: sof"); # foreach $item (keys %{$ade_registers{callonexit}}) { # &$item; # } # return(&_ade_tmp_deregisterallfunc($errstack_ref)); #} def _ade_tmp_funcup(errstack): global ade_registers ade_err_debug(errstack, 40, "_ade_tmp_funcup: sof") try: for item in ade_registers['callonexit'].keys(): item() except KeyError: pass return _ade_tmp_deregisterallfunc(errstack) #sub _ade_err_displayinternal #{ # my($errstack_ref, $message) = @_; # # return(&_ade_msg_message($errstack_ref, 0, "INTERNAL ERROR: %MESSAGE", $message)); #} # #sub _ade_err_displayerror #{ # my($errstack_ref, $message) = @_; # # #print "ade_err_error: writing messafge \"$message\" ...\n"; # # return(&_ade_msg_message($errstack_ref, 1, "ERROR: %MESSAGE", $message)); #} # #sub _ade_err_displaywarning #{ # my($errstack_ref, $message) = @_; # # return(&_ade_msg_message($errstack_ref, 2, "WARNING: %MESSAGE", $message)); #} # #sub _ade_err_displayinfo #{ # my($errstack_ref, $message) = @_; # # return(&_ade_msg_message($errstack_ref, 3, "INFO: %MESSAGE", $message)); #} # #sub _ade_err_displaydebug #{ # my($errstack_ref, $level, $message) = @_; # # return(&_ade_msg_message($errstack_ref, $level, "DEBUG[%LEVEL]: %MESSAGE", $message)); #} def _ade_err_displaydebug(errstack, level, message): return _ade_msg_message(errstack, level, "DEBUG[%LEVEL]: %MESSAGE", message) # #sub _ade_msg_writer_stderr #{ # my($errstack_ref, $text) = @_; # # print STDERR "$ade_app_progname: $text\n"; # # return($ade_err_ok); #} # #sub _ade_msg_writer_logfile #{ # my($errstack_ref, $text) = @_; # # return if (!defined($ade_msg_writer_logfile_filename)); # # open(HANDLE, ">>$ade_msg_writer_logfile_filename"); # # The 'eval { ... }' is there *only* to provide some grouping # # on the elements "5, 4, 3, 2, 1, 0, $text"; otherwise 'map' # # greedily eats all of that array leaving no string for printf # # to match against the '%s'. # printf HANDLE "%04d/%02d/%02dT%02d:%02d:%02d: %s\n", eval { map { (localtime)[$_]+(0,0,0,0,1,1900)[$_] } (5,4,3,2,1,0) }, $text; # close HANDLE; # # return($ade_err_ok); #} # #sub _ade_gep_initialise_with_stack #{ # my($errstack_ref) = @_; # # return($ade_err_ok); #} def _ade_gep_initialise_with_stack(errstack): return(ade_err_ok) # ## This should only be stuff guaranteed to succeed. #sub _ade_gep_initialise_without_stack #{ # # CDPATH causes all sorts of trouble! # delete($ENV{'CDPATH'}); # # # ADE will always use $ade_tmp_dir and it makes this available to clients. # if ($ENV{'TMPDIR'} && -d $ENV{'TMPDIR'}) { # $ade_tmp_dir = $ENV{'TMPDIR'}; # } elsif ($ENV{'TMP_DIR'} && -d $ENV{'TMP_DIR'}) { # $ade_tmp_dir = $ENV{'TMP_DIR'}; # } elsif (-d '/var/tmp') { # $ade_tmp_dir = '/var/tmp'; # } # # # There is no point in passing an error stack to ade_err_registerdefderrs(), # # because if it failed then it cannot report the error since no error formats # # have been successfully register. # &ade_err_registerdefderrs(\%ade_defined_errors); # # # Set up auto-clean-up. # $SIG{HUP} = \&_ade_gep_signalhandler; # $SIG{INT} = \&_ade_gep_signalhandler; # $SIG{TERM} = \&_ade_gep_signalhandler; # # # The callonexit hash uses code references (of the functions to be called # # at exit-time) as the keys in the hash. But this is only possible if # # this line is done; otherwise hash keys must be strings (and code references # # will be stringified and thereafter uncallable). # tie %{$ade_registers{callonexit}}, 'Tie::RefHash'; #} # ############################################################################### ## ## CODE ## ############################################################################### # #&_ade_gep_initialise_without_stack; ## Initialisation which requires a stack will be done inside ade_gep_main. # ############################################################################### ## ## NON-ZERO MODULE EXIT CODE ## ############################################################################### # #1;