#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec tclsh "$0" ${1+"$@"}
##
## by Aaron Hurt // Flex I.T., LLC
## Copyright 2008; All Rights Reserved
##
## positouch dbf transporter and error corrector
##
## transmits dbfs to server portion for processing
## also handles errors in positouch closeout and regens
## dbf files via posidbfw.exe
##
#

namespace eval ::cgc {

    ## settings ##
    variable AuthKey "9afgEuzFArZtRfoR89y0GRaCo24W5lJI2P56puA6"
    ## end settings ##
    
    ## initialize session array
    variable sess; array set sess [list]
    
    proc doIt {conf} {
        ## check file validity
        if {![file exists $conf] || ![file readable $conf]} {
            ::cgc::log "ERROR: Non-existent or unreadable config file: '$conf'"; return
        }
        ## read our config file into a parsable list
        set config [split [read [set fid [open $conf r]]] \n]; close $fid
        foreach line $config {
            switch -exact -- [lindex [split $line] 0] {
                DBPATH {set dbpath [lindex [split $line] 1]}
                DBFS {set dbfs [lrange [split $line] 1 end]}
                HOST {foreach {host port} [split [join [lindex [split $line] 1]] {:}] {}}
                LOGT {set ::cgc::logType [lrange [split $line] 1 end]}
                LOGF {set ::cgc::logFile [lrange [split $line] 1 end]}
            }
        }
        ## sanity check for config file values
        if {![info exists dbpath] || ![llength $dbfs]} {
            ::cgc::log "ERROR: Incomplete configuration file: db path or dbf files not specified"; return
        }
        if {![info exists host] || ![info exists port]} {
            ::cgc::log "ERROR: Incomplete configuration file: host or port not specified"; return
        }
        ## start the file transfer(s)
        ::cgc::init $dbpath $dbfs $host $port
    }
    
    ## handle our logging
    proc log {text} {
        if {![info exists ::cgc::logType]} {return}
        set ltext "[clock format [clock seconds] -format {%a %b %d %H:%M:%S %Z %Y}] :: $text"
        if {$::cgc::logType == 1 || $::cgc::logType == 3} {puts $ltext}
        if {$::cgc::logType == 2 || $::cgc::logType == 3} {
            if {[info exists ::cgc::logFile]} {
                ## check for existing log...if it's already there make sure we can use it
                if {[file exists $::cgc::logFile] && ![file writable $::cgc::logFile]} {return}
                puts [set fid [open $::cgc::logFile a+]] $ltext; close $fid
            }
        }
    }
    
    proc purge {dbpath} {
        ::cgc::log "Attempting to regenerate DBFs..."
        ::cgc::log "Purging *.* from $dbpath..."
        foreach tmp [glob -nocomplain -directory $dbpath -type f -- *.*] {
            ::cgc::log "Deleting $tmp ...."; file delete -force -- $tmp
        }
        ::cgc::log "Calling posidbfw.exe /daily ..."
        set cpwd [pwd]; cd [file join ${dbpath} ../sc]
        if {[catch {exec -- cmd.exe /c posidbfw.exe /daily} err] != 0} {
            ::cgc::log "ERROR: Failed to run [file join [pwd] posidbfw.exe] /daily: $err"
        }; cd $cpwd; ::cgc::log "Done, DBF files regenerated, continuing..."
    }
    
    proc init {dbpath dbfs host port} {
        ## check for stale index files...these always mean posi messed up it's closeout
        if {[llength [glob -nocomplain -directory $dbpath -type f -- *.CDX]]} {
            ::cgc::log "ERROR: Stale DBF indexes detected \*\.CDX"
            ::cgc::purge $dbpath
        }
        ## loop through our dbf files
        foreach dbf $dbfs {
            ## form a complete filename with path
            set fname [file join $dbpath $dbf]
            ## make sure our dbfs exist
            if {![file exists $fname] || ![file readable $fname]} {
                ::cgc::log "ERROR: Non-existent or unreadable dbf file: '$fname'"
                ::cgc::purge $dbpath
            }
            ## check one more time...if still not right...abort...
            if {![file exists $fname] || ![file readable $fname]} {
                ::cgc::log "ERROR: Non-existent or unreadable dbf file: '$fname' ... aborting ..."; return
            }
            ## check file dates...if file is older than today...we need to regenerate them
            if {[expr {[clock seconds]-[file mtime $fname]}] > 86400} {
                ::cgc::log "ERROR: File '$fname' is older than allowed time span of 1 day"
                ::cgc::purge $dbpath
            }
            ## start the transfer
            ::cgc::xfer $fname $host $port
        }
    }
    
    proc xferDone {in sock fname stime bytes {error {}}} {
        ## fcopy is finished..cleanup..set performance countes...
        set etime [expr {[clock seconds] - $stime}]
        set ::cgc::sess($sock,$fname,done) 1; array unset ::cgc::sess $sock,$fname,*
        catch {close $in}; catch {close $sock}
        ## check for error or eof on input file
        if {[string length $error]} {
            ## oops...we had an error...log it...set done..cleanup array...and close file channels
            ::cgc::log "ERROR: error during file copy: $error"; return
        }
        ## finish up and show some stats..woooo....pretty....
        if {$etime != 0} {
            set speed [format %0.2f [expr {($bytes / $etime) / 1024.0}]]
        } else {set speed 0}
        ## we're done...log it...cleanup array...and set done
        ::cgc::log "DONE: transfered $bytes total bytes in $etime seconds ($speed Kbps)."
        array unset ::cgc::sess $sock,$fname,*; catch {close $in}; catch {close $sock}
        set ::cgc::sess($sock,$fname,done) 1; return
    }
    
    proc xferWrite {sock fname host port} {
        ## clear writable event
        fileevent $sock writable {}
        ## put header info to socket...
	if {[catch {puts $sock "+HEADER $::cgc::AuthKey\:[file tail $fname]"} err] != 0} {
            ::cgc::log "ERROR: error writing to socket: $err"; set ::cgc::sess($sock,$fname,done) 1
            array unset ::cgc::sess $sock,$fname,*; catch {close $sock}; return
        }
        ## change buffering and configure for binary data...
	fconfigure $sock -buffering full -buffersize 2048 -encoding binary -translation binary
        ## open and configure our source file channel
        if {[catch {set in [open $fname r]} err] != 0} {
            ::cgc::log "ERORR: error opening file $fname: $err"
            set ::cgc::sess($sock,$fname,done) 1; array unset ::cgc::sess $sock,$fname,*
            catch {close $in}; catch {close $sock}; return
        }
	fconfigure $in -buffering full -buffersize 1024 -encoding binary -translation binary
        ## log it...
        ::cgc::log "Starting transfer of $fname ([file size $fname] bytes) to $host:$port ..."
        ## initialize our performance counters...and start copy...
        set stime [clock seconds]; fcopy $in $sock -command [list ::cgc::xferDone $in $sock $fname $stime]
    }
    
    proc xfer {fname host port} {
        ## open and configure our socket
        if {[catch {set sock [socket -async $host $port]} err] != 0} {
            ::cgc::log "ERROR: error opening socket: $err"; return
        }
        ## configure the socket
        fconfigure $sock -buffering line
        ## setup initial file event
        fileevent $sock writable [list ::cgc::xferWrite $sock $fname $host $port]
        ## enter the event loop
        set ::cgc::sess($sock,$fname,done) 0; vwait ::cgc::sess($sock,$fname,done) 
    }
}

## handle background errors
proc ::bgerror {text} {
    ::cgc::log "ERROR: unhandled error occured: $text"
    foreach line [split $::errorInfo \n] {::cgc::log $line}; exit 0
}

## check our argument numbers
if {$argc != 1} {
    puts "Usage: $argv0 <config file>\n"
    puts "Config Example:"
    puts "\tDBPATH D:/DBF/"
    puts "\tDBFS ITMSALES.DBF OTHER.DBF"
    puts "\tHOST 10.0.90.10:65520"
    puts "\tLOGT 3"
    puts "\tLOGF /path/to/logfile" ;return
}

## we're good...let's do it
::cgc::doIt [lindex $argv 0]