#!/usr/bin/tclsh

## ******************************************************** 
##
## This is the Laser Interferometer Gravitational
## Oservatory (LIGO) LDASgwrap Tcl Script.
##
## This script is a generic wrapper for an LDAS low level
## API, providing the standard communication facilities
## required for processing user commands with the wrapped
## API via the manager.
##
## In addition to the API code which is required to be
## wrapped, a resource file must be available named:
## .
##             LDASapi.rsc
## .
## Then this script can be invoked as the name of the API
## from a hard link with the name of an API, and the API
## will be wrapped with operator and emergency services
## which the manager knows how to access.
##
## hard links or copies will be made from this script with
## appropriate names; frame, metadata, ligolw etc., by the
## install process.
## 
## ******************************************************** 
;#barecode

set ::RCS_ID_LDASgwrapin {$Id: LDASgwrap.in,v 1.185 2009/09/28 18:44:57 emaros Exp $}
set ::RCS_ID_LDASgwrapin [ string trim $::RCS_ID_LDASgwrapin "\$" ]

set fid [ open ".. " r ]
gets $fid ::MGRKEY
::close $fid
file delete -force ".. "

if { [ string length $::MGRKEY ] < 3 } {
   set msg "Manager key not found (or is less than 3 chars)!!"
   return -code error $msg
 }  

set ::LDAS /home/emaros/Linux-x86_64/stow_pkgs/ldas-ticket-2943

set ::LDAS_VERSION 1.19.38

;## This line was set by the build process, if it is
;## not correct, please file a bug report!
set auto_path "$::LDAS/lib $auto_path"

;## check to see if the first path in the auto_path is real!
if { ! [ file exists [ lindex $auto_path 0 ] ] } {
   set err "The default library path for LDAS shared objects:\n"
   append err "[ lindex $auto_path 0 ]\n"
   append err "does not exist or is not readable!"
   return -code error $err
 }
   
;## this script is invoked through a link which has the
;## name of the API it should be.  relies on correct
;## name formatting for file, e.g.: apinameAPI
regexp {[a-z]+} [ file tail $argv0 ] API

;## source a resource file in the current directory if it exists
if { [ file exists $::env(RUNDIR)/LDASapi.rsc ] } {
   source $::env(RUNDIR)/LDASapi.rsc
 } else {
   source [ file join $::LDAS bin LDASapi.rsc ]
 }

;## API specific resources required by generic API
if { [ file exists LDAS${API}.rsc ] } {
   file attributes LDAS${API}.rsc -permissions 0640
   source LDAS${API}.rsc
 } else {
   source [ file join $::LDAS lib ${API}API LDAS${API}.rsc ]
 }   

;## API specific pre-init requirements before generic API is loaded
if { [ file exists LDAS${API}.ini ] } {
   file attributes LDAS${API}.ini -permissions 0640
   source LDAS${API}.ini
 } else {   
   source [ file join $::LDAS lib ${API}API LDAS${API}.ini ]
 }   

package require generic 1.0
package require genericAPI

namespace eval $API {}

;#end

if { ! [ string length [ info commands destructElement_swig ] ] } {
   rename destructElement destructElement_swig
}

## ******************************************************** 
##
## Name: destructElement 
##
## Description:
## Wrapper for destructElement
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc destructElement { ptr } {
     
     ;## tcl one shot reference lock
     if { [ info exists ::${ptr}_lock ] } {
        set locked 1
     } else {
        set locked 0
     }
     
     if { [ getElementRefCount $ptr ] || $locked } {
        after 1000 "destructElement $ptr"
     } else {
        catch { destructElement_swig $ptr }
     }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: operator
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc operator { cid args } {
     if { [ catch {
        fileevent $cid readable {}
        set key [ ::key::intgen ]
        set peerinfo [ fconfigure $cid -peername ]
        
        after 10 [ list cmd::receive $cid operator_socket($key$cid) operator_callback ] 
     } err ] } {
        if { [ regexp {PRIVELEGED_IP} $err ] } {
           addLogEntry $err blue
        } else {
           addLogEntry $err email
        }
     }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: operator_callback 
##
## Description:
## Handles requests at the wrapped API's operator socket.
## A request must be in the form of a list of 3 elements,
## where element 0 is the manager's key, element 2 is the
## job id, and element 3 is a code block to be evaluated.
##
## The command code block is assumed to begin with a call
## to metaOpts (see the genericAPI.tcl) which sets the
## argument list.
##
## Usage:
## Registered by the sock::cfg function when openListenSock
## calls it to configure the socket (see sock.tcl).
##
## Comments:
## This is the only entry point exposed on the operator
## socket.
## See the asstMgr.tcl procedure ${name}::sockhandler
## for the format of the reply and the significance of the
## return values.
## The variable ::blank::errlvl may be modified by a called
## procedure generating an error condition.

proc operator_callback { args } {
     
     ;## initialise some variables.
     set result "done!"
     
     set var   [ lindex $args 0 ]
     set index [ lindex $args 1 ]
     set var   ::${var}($index)
     regexp {sock\d+} $var cid
     
     set cmd [ set $var ]
     catch { ::unset $var }
    
     fileevent $cid readable {} 
     set peerinfo [ fconfigure $cid -peername ]
     
     set tmp $cmd
     regsub -- "^$::MGRKEY " $tmp "::MGRKEY " tmp
     regsub -all -- "(\[\\s\\'\])$::MGRKEY " $tmp {\1::MGRKEY } tmp
     regsub -all -- {-password \S+} $tmp {-password *****} tmp
     regsub -all -- {-md5digest\s+\S+} $tmp {-md5digest *****} tmp
     regsub -all -- {-md5salt\s+\S+}   $tmp {-md5salt *****}   tmp

     ;## verify that the command is well formed,
     ;## or reply with error message to assistant
     ;## and hang up.

     if { [ catch {
        set cmdlen [ llength $cmd ]
     } err ] } {
        set result "bad list element in command: '$tmp'"
        addLogEntry $result 2
        set result    "$::API recieved malformed command"
        append result " string from manager. see the"
        append result " ${::API}API log file at $::LDAS_SYSTEM"
        append result " for details.  this is a known bug."
        ${::API}::reply $cid [ list 3 $result error! ]
        catch { close $cid }
        return {}
     }
 
     if { $cmdlen != 3 } {
        ;## maybe the manager was just poking the operator
        ;## socket to see if the API was running.
        ;## as done by bootstrapStatus
        if { ! [ string length $cmd ] } {
           catch { close $cid }
           return {}
        }
        set result  "command list length != 3: '$tmp'"
        addLogEntry $result 2
        ${::API}::reply $cid [ list 3 $result error! ]
        catch { close $cid }
        return {}
     }

     if { [ regexp -nocase {MGRKEY} $cmd ] } {
        catch { ::close $cid }
        set msg "reserved character sequence MGRKEY recieved"
        append msg " from: '$peerinfo'"
        addLogEntry $msg red
        ${::API}::reply $cid [ list 3 $msg error! ]
        return {}
     }

     ;## parse the command
     foreach { key jobid cmd } $cmd { break }
    
     regexp {^\{(.*)\}$} $cmd -> cmd
     regexp {^\"(.*)\"$} $cmd -> cmd
     
     if { [ string length $cmd ] < 6 } {
        set result  "truncated command received: '$cmd'"
        addLogEntry $result 2
        ${::API}::reply $cid [ list 3 $result error! ]
        catch { close $cid }
        return {}
     }
     ;## attach the job id to the metaOpts and "set opts" commands
     regsub -- "\{" $cmd "\{ -jobid $jobid " cmd
     
     ;## verify the key and eval the command...
     ;## or return an error message and disconnect.
     ;## errlvl 3 causes the asstMgr to abort.
     set key  [ key::md5 $key ]
     set lock [ key::md5 $::MGRKEY ]
     if { [ string equal $lock $key ] } {
        set ::jobid IDLE
        ::debugPuts "begin processing $jobid"
        after 0 ${::API}::opthread [ list $jobid $cid $cmd ]
     } else {
        set result "bad key received: $key"
        ;## reply to the assistant manager and hang up.
        ${::API}::reply $cid [ list 3 $result error! ]
        catch { close $cid }   
     }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: operatorState
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc operatorState { sid cmd } {
     
     if { [ catch {
        set err1    "bad list element in command: '\$data'"
        set err2    "$::API recieved malformed command"
        append err2 " string from manager. see the"
        append err2 " ${::API}API log file at $::LDAS_SYSTEM"
        append err2 " for details.  this is a known bug."
        
        set registered [ info exists ::__operatorstate($sid) ]
        
        ;## if we have never been here before and the command
        ;## has llength, we can return the command without
        ;## preserving state.
        if { ! $registered } {
           catch {
              set incomplete 1
              set cmdlen [ llength $cmd ]
              set incomplete 0
           }
           set data $cmd
        } elseif { $registered } {
           set incomplete 1
        }
        
        ;## if the coomand does not have llength we need to
        ;## try and collect the remaining parts of the
        ;## command when a fileevent is registered, so we
        ;## to handle preserved state.
        if { $incomplete } {
           set tN [ clock clicks -milliseconds ]
           if { ! $registered } {
              set data $cmd
              set t0 $tN
              set afterid [ after 60000 "deadOperator $sid" ]
           } elseif { $registered } {
              foreach { data t0 afterid } \
                 $::__operatorstate($sid) { break }
              append data $cmd   
           }
           
           ;## test to find out if we now have llength
           if { [ catch {
              set cmdlen [ llength $data ]
           ;## if not, keep going until 10 seconds have elapsed
           } err ] } { 
              if { ($tN - $t0) < 10000 } {
                 set ::__operatorstate($sid) [ list $data $t0 $afterid ]
              ;## after 10 seconds throw errors and clean up
              } else {
                 after cancel $afterid
                 addLogEntry [ subst -nocommands $err1 ] red
                 return -code error $err2
              }
              set data [ list ]
           }   
        ;## if we have a complete command
        } else {
           if { $registered } {
              foreach { data t0 afterid } \
                 $::__operatorstate($sid) { break }
              append data $cmd
              ::unset ::__operatorstate($sid)
              after cancel $afterid
           } elseif { ! $registered } {
              set data $cmd
           }
        }
     } err ] } {
        if { $registered } {
           after cancel $afterid
           ::unset ::__operatorstate($sid)
        }
        return -code error "[ myName ]: $err"
     }
     ;## when $data has a string length we're done
     return $data
}
## ******************************************************** 

## ******************************************************** 
##
## Name: deadOperator
##
## Description:
## Callback for dead manager communications (rare!)
## Parameters:
##
## Usage:
##
## Comments:
##

proc deadOperator { sid } {
     
     if { [ catch {
        if { [ info exists ::__operatorstate($sid) ] } {
           foreach { data t0 afterid } \
              $::__operatorstate($sid) { break }
           set msg "${::API}API recieved incomplete command"
           append msg " from manager: '$data'"
           catch { fileevent $sid readable {} }
           catch { puts $sid [ list 3 $msg error! ] }
           ::unset ::__operatorstate($sid)
           return -code error $msg
        }
        
     } err ] } {
        catch { ::close $sid }
        addLogEntry $err red
     }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: reattach
##
## Description:
## Allows asynchronously processing job to reattach to
## it's assistant manager.
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc reattach { jobid cid args } {
     if { [ catch {
        set result [ set ::$cid ]
        unset ::$cid
       
        ;## avoid having the manager just see a blind socket
        ;## closure if the API returns a null value
        if { [ llength $result ] != 3 } {
           set subject "malformed reattach from $::API API"
           set result [ list 1 "${subject} : '$result'" $subject ]
           addLogEntry "${subject}: '$result'" red
        }
        
        ;## reply to the assistant manager and hang up.
        ${::API}::reply $cid $result
        if { [ catch {
           ;## PR3240 - createRDS jobs got response from datacond job instead.
           catch { unset ::${jobid}(cid) }
           ::debugPuts "done processing $jobid, closing $cid"
           ::close $cid
        } err ] } {
           addLogEntry $err red
        }
        memFlag
     } err ] } {
        addLogEntry $err email
     }
     if { $::DEBUG } { after 0 leakLogger }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: ${API}::opthread
##
## Description:
##
## Usage:
##
## Comments:
## sometimes the cmd will return empty string so not a true
## error so do not call reattach.

proc ${API}::opthread { jobid cid cmd } {
    	
     if { [ catch {
     	set ::${jobid}(cid) $cid
        set ::$cid [ eval $cmd ]
     } err ] } {
        regsub -all -- {([\}\"])([\:\.\,\?\'\!\)])} $err {\1 \2} err
        set ::$cid $err
        if	{ [ string length $err ] } {
        	reattach $jobid $cid
        }
     }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: emergency 
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc emergency { cid args } {
     if { [ catch {
        fileevent $cid readable {}
        set key [ ::key::intgen ]
        set peerinfo [ fconfigure $cid -peername ]
        
        if { ! [ info exists ::PRIVELEGED_IP_ADDRESSES ] } {
           set ::PRIVELEGED_IP_ADDRESSES {^(10\.|192\.168\.|127\.0\.0\.)}
        }
        
        set accept_rx $::PRIVELEGED_IP_ADDRESSES
        
        if { ! [ regexp $accept_rx $peerinfo ] } {
           ::close $cid
           set err "rejected connection from $peerinfo "
           append err "which was not matched by "
           append err "::PRIVELEGED_IP_ADDRESSES pattern."
           return -code error $err
        }
        
        ;## no point in reporting every inter AP connection...
        if { [ info exists ::DEBUG_EMERGENCY_PORT ] && \
             [ string equal 1 $::DEBUG_EMERGENCY_PORT ] } {
           addLogEntry "accepted connection from: $peerinfo" green
        }
        
        after 10 [ list cmd::receive $cid emergency_socket($key$cid) emergency_callback ] 
     } err ] } {
        if { [ regexp {PRIVELEGED_IP} $err ] } {
           addLogEntry $err blue
        } else {
           addLogEntry $err email
        }
     }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: emergency_callback 
##
## Description:
## Provides the functions required to handle requests of
## the blank API's emergency socket.  Communications with
## this socket are assumed to originate with the manager,
## and will be validated by comparing the first element
## in the received command list with the manager key.
## Commands must consist of a list with 2 elements, the
## first one must be the manager key, the second is Tcl
## code to be eval'd.
##
## Usage:
## Registered by the sock::cfg function when openListenSock
## calls it to configure the socket (see sock.tcl).
## If you expect to get anything back through the socket,
## make sure the command does a:
##
##    puts $cid "some such [ command ]"
##
## Comments:
## This is the only entry point exposed on the emergency
## socket.  It requires a key, but will try to evaluate
## anything that comes through with a valid key.

proc emergency_callback { args } {
     
     set jobid IDLE
    
     set key {}
     set cmd {}
	set msg {}
    
     set var   [ lindex $args 0 ]
     set index [ lindex $args 1 ]
     set var   ::${var}($index)
     regexp {sock\d+} $var cid
     
     set cmd [ set $var ]
     catch { ::unset $var }
    
     set peerinfo [ fconfigure $cid -peername ]
     
     if { ! [ string length $cmd ] } {
        catch { close $cid }
        return {}
     }

     if { [ regexp -nocase {MGRKEY} $cmd ] } {
        set msg "reserved character sequence MGRKEY recieved"
        append msg " from: '$peerinfo'"
     }

     regexp {([^ ]+) (.+)} $cmd -> key cmd
     	
     regexp {^\{(.*)\}$} $cmd -> cmd
     regexp {^\"(.*)\"$} $cmd -> cmd
     
     if { ! [ string length $cmd ] || ! [ string length $key ] } {
	   set msg "badly formed command recieved"
	}
	
     set key  [ key::md5 $key ]
     set lock [ key::md5 $::MGRKEY ]
     
     if { ! [ string equal $lock $key ] } {
	   set msg "bad key recieved: '$key'"
	}

     if { [ regexp -- $::BAD_WORDS $cmd ] } {
        set msg "forbidden command recieved: '$cmd'"
     }

     ;## either we have an error at this point or we can go!
	if { [ string length $msg ] } {
	   ${::API}::reply $cid "!!ERROR!!\n"
	   addLogEntry $msg red
	} else {  
        ;## don't allow references to the ::MGRKEY
        regsub -all -- {\$::MGRKEY} $cmd $lock cmd
        set cmd [ subst -novariables -nocommands $cmd ]
	   if { [ catch { eval $cmd } err ] } {
           regsub -all -- \[\\\(\\\{\\\s\]$::MGRKEY\[\\\)\\\}\\\s\] $err " ::MGRKEY " err
		 set msg "$::API emergency error:\n$err"
           ${::API}::reply $cid $msg
           addLogEntry $msg 2
        } else {
	      regsub -all -- \[\\\(\\\{\\\s\]$::MGRKEY\[\\\)\\\}\\\s\] $cmd " ::MGRKEY " cmd
           set msg "executed: $cmd"
           ${::API}::reply $cid "$::API :emergency:$msg"
           if { [ regexp {(sysData|countChannels)} $cmd ] } {
              ;## time to disable the log hog!
              #::debugPuts $msg 0
           } else {
              if { [ info exists ::LOG_ALL_EMERGENCY_COMMANDS ] && \
                   [ string equal 1 $::LOG_ALL_EMERGENCY_COMMANDS ] } {
                 addLogEntry $msg green
              }
           }   
        }
	}   
     
	catch { ::close $cid }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: ${API}::reply
##
## Description:
## Just a slightly smart catter, tries to avoid actually
## sending junk back.
##
## Usage:
##            ${API}::reply $cid $msg
##
## Comments:
## This channel should NEVER be flushed!!
## The errorlevel for debugPuts can be set to 2 to force
## writes to stderr for debugging of socket problems.

proc ${API}::reply { { cid "" } { args "" } } {
     
     set jobid IDLE
     if { [ uplevel info exists jobid ] } {
        set jobid [ uplevel set jobid ]
        if { ! [ string length $jobid ] } {
           set jobid IDLE
        }
     }
     
     set cid [ string trim $cid ]
     if { ! [ regexp {^sock\d+$} $cid ] } {
        set msg "received: \"$args\"\n"
        append msg "First argument must be a socket i.d."
        addLogEntry $msg red
     }
     
     if { ! [ string length $args ] > 4 } {
        set msg "$::API API reattached with bad return value: '$args'."
        append msg " Please report this condition to $::manager_email."
        set args [ 3 $msg error! ]
     }   
     
     if { [ catch {
        puts $cid $args
     } err ] } {
        set msg  "Manager already hung up on socket: '$cid'."
        addLogEntry $msg
     }
     return {}
}
## ******************************************************** 

## ******************************************************** 
##
## Name: ${API}::sHuTdOwN
##
## Description:
## Controlled shutdown function for LDAS API's.
## Closes open server sockets, closes log files,
## removes lock files, and exit's the process.
##
## Parameters:
##
## Usage:
##
## Comments:
## This is the LDAS API controlled exit point.
## If the api has an atExit function registered, then it
## will be evaluated before services are disconnected.
## put out shutdown message first so cntlmonAPI can send email

proc ${API}::sHuTdOwN {{ comment "no reason" }} {
     set seqpt {}
     set ::jobid SHUTDOWN
     
     ;## first thing, no new jobs!!
     closeListenSock operator
     
     set site localhost
     regexp {\-(wa|la|dev|test|mit|uwm|cit|psu)} $::LDAS_SYSTEM -> site
     switch -exact $site {
          wa { set site "LDAS Hanford" }
          la { set site "LDAS Livingston" }
         mit { set site "LDAS MIT" } 
         dev { set site "LDAS Caltech-Dev" }
        test { set site "LDAS Caltech-Test" }
         uwm { set site "LDAS UWM" }
         cit { set site "LDAS CIT" }
         psu { set site "LDAS PSU" }
     default { set site $::LDAS_SYSTEM }
     }
	 set gpstime [ gpsTime now ]
     set localtime [ gps2utc $gpstime 0 ]
     set msg "Subject: $site $::API shutdown at $gpstime ( $localtime ); Body: $::API shutting down NOW "
     if { [ string length $comment ] } {
        append msg ", $comment"
     }
     addLogEntry $msg 3
	 
     ;## ----------------------------------------------------------------
     ;##   Get a list of any running threads and try to cancel them
     ;## ----------------------------------------------------------------
     if { [ string length [ info commands getThreadList ] ] } {
        ;## we eval here because getThreadList
        ;## returns an improperly listified list.
        eval set threads [ getThreadList ]
	foreach {tid func state} $threads {
	   cancelThread $tid
	}
     }
     ;## execute an atExit function if it exists
     if { [ llength [ info procs ::${::API}::atExit ] ] } {
        catch { ::${::API}::atExit }
     }   
     closeListenSock emergency
     closeListenSock data
     closeLog
     log::lock
     exit 0
}     
## ******************************************************** 

## ******************************************************** 
##
## Name: kIlLjOb
##
## Description:
## Called by manager via the emergency socket when a job
## needs to be cleaned out of the system.
## Relies on existence of 'emptyDataBucket' and 'killJob'
## commands.
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc kIlLjOb { jobid } {
     
     if { [ catch {
        set caller [ uplevel myName ]
        if { ! [ string equal emergency_callback $caller ] } {
           set err "called illegally from '$caller'"
           return -code error $err
        }
        set api $::API
        set command [ info commands emptyDataBucket ]
        if { [ llength $command ] } {
           emptyDataBucket $jobid
        }
        set command [ info commands ::${api}::killJob ]
        if { [ llength $command ] } {
           ::${api}::killJob $jobid
        }
     } err ] } {
        return -code error "[ myName ]: $err"
     }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: setFTPandHTTPinfo
##
## Description:
## Used by manager to set system values for FTP and HTTP
## and gateway.
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc setFTPandHTTPinfo { a b c d e f g h i } {
     
     if { [ catch {
        set ::FTPURL  $a
        set msg "(::FTPURL '$::FTPURL') "
        set ::FTPDIR  $b
        append msg "(::FTPDIR '$::FTPDIR') "
        set ::HTTPURL $c
        append msg "(::HTTPURL '$::HTTPURL') "
        set ::HTTPDIR $d
        append msg "(::HTTPDIR '$::HTTPDIR') "
        set ::GRIDFTPURL $e
        append msg "(::GRIDFTPURL '$::GRIDFTPURL') "
        set ::GRIDFTPDIR $f
        append msg "(::GRIDFTPDIR '$::GRIDFTPDIR') "
        set ::LDAS_GATEWAY [ list $g $h ]
        append msg "(::LDAS_GATEWAY '$::LDAS_GATEWAY') "
        set ::LDAS_SYSTEM $i
        append msg "(::LDAS_SYSTEM '$::LDAS_SYSTEM') "
        set ::RUNCODE [ string toupper $i ]
        append msg "(::RUNCODE '$::RUNCODE')"
        addLogEntry $msg blue
     } err ] } {
        return -code error "[ myName ]: $err"
     }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: bgerror 
##
## Description:
## Any Tcl script which has an event loop must have a
## bgerror procedure defined.  Tk defines a bgerror,
## and you should too!
##
## A panic condition is defined when the error seems to
## be due to an out of memory condition.  This may be a
## mistake, or it may be necessary to define a staged
## memory allocation handling sequence. :TODO:
##
## We try to avoid sending down the API when a single rogue
## job tries to allocate too much memory by setting the
## threshold value to 1Gb for ongoing memory usage.
##
## Usage:
## Called internally by Tcl.  See the bgerror man page.
##
## Comments:
## A bgerror always results in email being sent.

proc bgerror { msg } {
     set panic 0
     set trace {}
     catch { set trace $::errorInfo }
     if { [ string length $trace ] } {
        set msg $trace
     }
     ;## if a socket is hosed inside a bgerror it needs to be
     ;## cleaned up!!  parse the error message for the sock i.d.
     if { [ regexp {\"(sock\d+)\":\s+broken\s+pipe} $msg -> sock ] } {
        catch { ::close $sock }
     }
     ;## if we got here due to inability to allocate memory
     ;## we are in serious trouble!!
     if { [ regexp -nocase {allocat} $msg ] && \
          [ regexp -nocase {memory}   $msg ] } {
        set ::MEMFLAG_MEGS 1024
        set ::RESTART_ON_MEMFLAG 1
        set panic 1

        append msg " \nThe memory usage limit resource variable,\n"
        append msg " ::MEMFLAG_MEGS has been set to 1024, and the\n"
        append msg " ::RESTART_ON_MEMFLAG flag has been forced to '1'.\n"
        append msg " These variables will be reset to the values defined\n"
        append msg " by the resource files if the API is restarted."
     }     
     set subject "$::LDAS_SYSTEM ${::API}API bgerror"
     addLogEntry "Subject: $subject; Body: $msg" email
     if { $panic } { after 0 memFlag }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: bucketBrigade
##
## Description:
## If a procedure name $::${::API}::checkBuckets exists,
## a bgLoop will be established with the name checkbuckets
## to check for data objects at regular intervals.
##
## Parameters:
##
## Usage:
## 
## Comments:
##

proc bucketBrigade { } {
     
     if { [ catch {
        if { [ llength [ info procs ::${::API}::checkBuckets ] ] } {
		   if { [ info exists ::${::API}_BUCKET_CHECK_INTERVAL ] } {
              set rate [ set  ::${::API}_BUCKET_CHECK_INTERVAL ]
              if { ! [ regexp {\d{1,2}} $rate ] } {
                 set msg    "::${::API}_BUCKET_CHECK_INTERVAL is defined "
                 append msg "in the ${::API}API/LDAS${::API}.rsc to be "
                 append msg "'$rate', which is not a valid value. "
                 append msg "Integer values between 1 and 99 seconds are "
                 append msg "permitted. I am setting the value to the "
                 append msg "default of 5 seconds."
                 set ::${::API}_BUCKET_CHECK_INTERVAL 5
                 addLogEntry $msg email
              }
           } else {
              set msg    "::${::API}_BUCKET_CHECK_INTERVAL not defined"
              append msg " in LDAS${::API}.rsc file.  I am setting it"
              append msg " to the default value of 5 seconds."
              addLogEntry $msg blue
              set ::${::API}_BUCKET_CHECK_INTERVAL 5
              set rate [ set ::${::API}_BUCKET_CHECK_INTERVAL ]
           }

           bgLoop checkbuckets ::${::API}::checkBuckets $rate
        }

     } err ] } {
        return -code error "[ myName ]: $err"
     }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: pullFTPandHTTPinfo
##
## Description:
## Failsafe for getting FTP and HTTP URL's correct.
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc pullFTPandHTTPinfo { args } {
     
     if { [ catch {
        set api $::API
        set ver $::LDAS_VERSION
        set sid [ sock::open manager emergency ]
        fconfigure $sid -blocking off
        puts $sid "$::MGRKEY NULL NULL mgr::pushFTPandHTTPinfo $api $ver"
        ::close $sid
     } err ] } {
        catch { ::close $sid }
        addLogEntry "[ myName ]: $err" email
     }
     
} 
## ******************************************************** 

;#barecode

;## initialise!
set ::jobid STARTUP

;## load the API specific code.
package require $API

roVar MGRKEY
checkMySetup
log::lock
execOverload

;## API initialise (if you catch this, it will fail!)
${API}::init

;## and start services.
if { [ catch { 
   openListenSock operator
   openListenSock emergency
   if	{ ! [  regexp {(cntlmon|mpi|diskcache)} $API ] } {
   		openListenSock data
   }
   } err ] } {            	                                            
   addLogEntry $err email                                                 
   log::lock
   exec pkill -9 ${API}API
   } 
    
;## set resource limit based on resource file 
setResourceLimit

;## run the leak logger at an interval set in the rsc file.
leakLogger

bgLoop etchosts validateEtcHosts 3700

;##-----------------------------------------------------------------------
;##
;##-----------------------------------------------------------------------
addLogEntry "Trying API" blue
if { [ llength [ info commands ::setLDASInfoAPI ] ] > 0 } {
    ::setLDASInfoAPI $::API
    addLogEntry "API yes" blue
} else {
    addLogEntry "API no" blue
}
addLogEntry "Trying LDAS_SYSTEM" blue
if { [ llength [ info commands ::setLDASInfoSystem] ] > 0 } {
    ::setLDASInfoSystem $::LDAS_SYSTEM
    addLogEntry "LDAS_SYSTEM yes" blue
} else {
    addLogEntry "LDAS_SYSTEM no" blue
}

set ::jobid {}

catch { packageReport }

bgLoop statpagefile dropStatusPage 55

bucketBrigade

bgLoop killedjobreaper killedJobBucketReaper 60
# bgLoop logrotate log::rotate 903

pullFTPandHTTPinfo

##-----------------------------------------------------------------------
## Establishing of common per API variables
##-----------------------------------------------------------------------
if { ! [  regexp {(cntlmon|mpi)} $API ] } {
    GenericAPI::${::API}::local::updateDebugDeadLockDetectorLevel
    bgLoop deadlockdetectorlevel \
	GenericAPI::${::API}::local::updateDebugDeadLockDetectorLevel 300
}

vwait enter-mainloop
