############################################################################# # # File: SvrResp.itcl # # Description: Outbound response to a clients identification block # for TCD to Server conversations. # # $$$TIVO COPYRIGHT (Jak Mang, Brian Beach)$$$ # # This data block is created on the server, and read on the TCD. # There are multiple versions of this structure. The version created by # the server always matches the version of the Ident structure received # from the TCD. # # Version 1: initial version # Version 2: add swSystemName field # Version 3: moved to HTTP text/plain # # NOTE: The version numbers of Ident and SvrResp are always incremented # together. # # Modified by AltEPG Project # ************************************************************ # AltEPG Project Source Code Version Control # $FileID: git::root/tvlib/tcl/tv/SvrResp.itcl $ # $Revision: altepg1.0c root 2011-09-17 23:39:32 +0100 Finalising altepg1.0c $ # Description: See above # ************************************************************ ############################################################################# source $tcl_library/tv/Inc.itcl source $tcl_library/tv/StatusStrings.itcl tvsource $tcl_library/tv/Setup.itcl tvsource $tcl_library/tv/CmdStr.itcl tvsource $tcl_library/tv/unbundler.tcl tvsource $tcl_library/tv/makefakekeys.tcl source $tcl_library/tv/UrlEncode.tcl tvsource $tcl_library/tv/PartialDownloadList.itcl namespace import Inc::* class SvrResp { variable partialDnldList "" private variable netVersion "" private variable netMagic "" private variable SvrRespMagic "" private variable SvrRespVersion "" private variable code "" private variable softwareList "" private variable backChannelThumb "" private variable backChannelPrv "" private variable backChannelPub "" private variable backChannelLog "" private variable timeService "" private variable sequenceCookie "" private variable inventoryFile "" private variable noPrivBackhaul "" private variable serviceState "" private variable stateExpiration "" private variable swSystemName "" ;# version 2 private variable infoCode "" private variable lastKnownState "" private variable errMessage "" private variable tcdMessage "" private variable globalMessages "" private variable dbLoadOrder "" private variable debug 0 private variable curBlockLen 0 private variable writeHeader 1 # private variable irdbVersion "" private variable genreVersion "" private variable showcaseVersion "" private variable centerId "UNKNOWN" private variable callId "UNDEFINED" private variable backHaulDone 0 private variable keyServer "" private variable forceBackhaul 1 private variable dataGroupList "" private variable publicLogFilter "" private variable regenToken "" private variable backhaulDataOn "" private variable personalDataOn "" private variable db "" private variable hserverAddr "" private variable hserverPort "" private variable useAPG "" private variable tclientRef private variable got411Data 0 constructor {} { set db [dbopen] set SvrRespMagic 0xdeadcafe set SvrRespVersion 1 set netMagic $SvrRespMagic set netVersion $SvrRespVersion set noPrivBackhaul -1 set serviceState -1 set stateExpiration 0 set partialDnldList [PartialDownloadList #auto] } destructor { if {$db != ""} { dbclose $db } delete object $partialDnldList } method readBlock {name} method writeBlock {name} method getBlockField {conn name} method print {} method setVal {field val} method getVal {field} method process {locationID headendID} method processTcdMessage {} method updateKeys {filename} method loadSoftware {locationID headendID} method endConnection {zeroMeansEnterHangupState} method updateStatus {msg} method setDebug {dbgVal} method noHeader {} method setCallId {id} method setTcdId {id} method unEscapeMsg {inLine} method getBackHaulDone {} method setHServerAddr {ip} method setHServerPort {port} method setUseAPG {val} method setTclientRef {ref} method compareDbloadFiles {left right} method new411Data {} method getClientToken {setup regen} method regenerateToken {setup} method makeToken {} method storeOptStatus {setup backhaul personal uList} method checkLastPrivBackhaul {setup} } ###################################################################### # # TCD -- these methods are run only on the TCD. # # Only one version of the structure needs to be supported. The server # is expected to be able to understand whatever version the TCD sends. # ###################################################################### body SvrResp::setTclientRef {ref} { set tclientRef $ref } body SvrResp::getBlockField {conn name} { gets $conn next if {$next != ""} { incr curBlockLen [expr [string length $next] + 1] } set fields [split $next =] if {[lindex $fields 0] != $name} { set errStr "Expected field $name not found, got: $next" putlog $errStr error $errStr } return [lindex $fields 1] } ######## # # readBlock - read the SRB from a file # ######## body SvrResp::readBlock {name} { set ret 1 set recvFileName "/var/tmp/${name}.recv" if { [catch {set conn [open $recvFileName "r"]}]} { putlog "failed to open $recvFileName" set ret 0 } else { if { [catch {fconfigure $conn -translation binary}]} { putlog "failed to fconfigure $conn" set ret 0 } } if { $ret } { # get past the HTTP header, but look for Content-Length putlog "reading HTTP header..." set headerLine [gets $conn] set blockLength 0 while {$headerLine != "\r" && ! [eof $conn]} { putlog "HTTP header: $headerLine" regexp "Content-Length: (.+)" $headerLine match blockLength set headerLine [gets $conn] } if {$headerLine == "\r"} { putlog "Got end of Header" } if {[eof $conn]} { putlog "Got end of File" } # version 3 fields: try { set errMessage [getBlockField $conn ERR_MSG] set netVersion [getBlockField $conn VERSION] set code [getBlockField $conn CODE] set softwareList [getBlockField $conn SW_LIST] set backChannelPrv [urlDecode [getBlockField $conn BACK_CH_PRV]] set backChannelPub [urlDecode [getBlockField $conn BACK_CH_PUB]] set backChannelLog [urlDecode [getBlockField $conn BACK_CH_LOG]] set timeService [getBlockField $conn TIME_SVC] set sequenceCookie [getBlockField $conn SEQ_COOKIE] set inventoryFile [getBlockField $conn INV_FILE] set noPrivBackhaul [getBlockField $conn NO_PRV_BACKHAUL] set serviceState [getBlockField $conn SERVICE_STATE] set stateExpiration [getBlockField $conn STATE_EXPIRE] set swSystemName [getBlockField $conn SW_SYSTEM_NAME] } catch err { set ret 0 } } if { $ret } { set field INFO_CODE try { set infoCode [getBlockField $conn INFO_CODE] set field TCD_MESSAGE set tcdMessage [getBlockField $conn TCD_MESSAGE] set field GLOBAL_MESSAGES set globalMessages [getBlockField $conn GLOBAL_MESSAGES] set field KEY_SERVER set keyServer [getBlockField $conn KEY_SERVER] set field BACK_CH_THUMB set backChannelThumb [urlDecode [getBlockField $conn BACK_CH_THUMB]] set field FORCE_BACKHAUL set forceBackhaul [getBlockField $conn FORCE_BACKHAUL] set field PUBLIC_LOG_FILTER set publicLogFilter [getBlockField $conn PUBLIC_LOG_FILTER] set field DBLOAD_ORDER set dbLoadOrder [getBlockField $conn DBLOAD_ORDER] set field REGEN_TOKEN set regenToken [getBlockField $conn REGEN_TOKEN] set field BACKHAUL_DATA_ON set backhaulDataOn [getBlockField $conn BACKHAUL_DATA_ON] set field PERSONAL_DATA_ON set personalDataOn [getBlockField $conn PERSONAL_DATA_ON] set field DATA_GROUP_LIST set dataGroupList [getBlockField $conn DATA_GROUP_LIST] } catch err { putlog "error reading $field: $err" } if {$curBlockLen != $blockLength} { putlog "read $curBlockLen but Content-Length = $blockLength" } } catch {close $conn} return $ret } ######## # # getVal # ######## body SvrResp::getVal {field} { switch -exact $field { code { return $code } softwareList { return $softwareList } backChannelPrv { return $backChannelPrv } backChannelThumb { return $backChannelThumb } backChannelPub { return $backChannelPub } backChannelLog { return $backChannelLog } timeService { return $timeService } sequenceCookie { return $sequenceCookie } inventoryFile { return $inventoryFile } noPrivBackhaul { return $noPrivBackhaul } serviceState { return $serviceState } stateExpiration { return $stateExpiration } swSystemName { return $swSystemName } infoCode { return $infoCode } tcdMessage { return $tcdMessage } globalMessages { return $globalMessages } irdbVersion { return $irdbVersion } genreVersion { return $genreVersion } showcaseVersion { return $showcaseVersion } keyServer { return $keyServer } forceBackhaul { return $forceBackhaul } dataGroupList { return $dataGroupList } publicLogFilter { return $publicLogFilter } dbLoadOrder { return $dbLoadOrder } regenToken { return $regenToken } backhaulDataOn { return $backhaulDataOn } personalDataOn { return $personalDataOn } default { putlog "unknown field: $field" } } } ######## # # endConnection # # Takes an arguemnt (that is the return value of the caller function) # that when 0 means "enter the hangup state" when hanging up, and on # non-zero hangs up silently (thus preventing obfuscation of previously # generated errors # ######## body SvrResp::endConnection {returnValue} { # Done with downloads. Kill off pppd to hang up the phone if [file exists /var/tmp/pppaddr] { # this would not be the case when it was do to a failure # when retval is non-zero, we have a failure, and so do not # obfuscate where we died by entering the Hangup phase. if {$returnValue == 0} { #updateStatus "HU|Hanging up..." $tclientRef setPhase $PhaseNames::Hangup } else { putlog "Skipping entering the hangup phase. returnValue = $returnValue" } killproc pppd after 5000 } $tclientRef setConnectionEndTime # Turn off online led. event send $TmkEvent::EVT_DIALUPEVENT 11 0 # If the returnValue is 0, then we know that we were "okay" with the call, # and so had a successful one. Otherwise, we know that the call failed in # the actual phone call itself, and so increment the successive failures set sucFail 0 if { $returnValue != 0 } { set sucFail [$tclientRef incrementSuccessiveFailures] } else { $tclientRef clearSuccessiveFailures } $tclientRef svclog "tclient_hangup" "CODE=$returnValue" # Re-enable transaction holdoff so that dbloading doesn't bog down # the UI. holdoff 1 } ######## # # process # ######## body SvrResp::process {locationID headendID} { global env set ret 0 set setup [Setup setupObj#auto] $setup loadDb cleanPools "process response" if {$centerId == "UNKNOWN" || $centerId == ""} { if [catch {set centerId $env(SerialNumber)}] { set centerId 123456123456 } } if {$code == $Inc::TS_SR_ACCEPTED || $code == $Inc::TS_SR_TSTRING || $code == $Inc::TS_SR_LOOP || $code == $Inc::TS_SR_SETUPHEAD || $code == $Inc::TS_SR_SETUP} { set pwd [pwd] set cmdStr [CmdStr cms#auto] $cmdStr setTcdId $centerId $cmdStr setCallId $callId $cmdStr setDebug $debug set postcode {} set hasVersion 1 set newList [split $locationID |] foreach loc $newList { # find the headend versions for the locations if {$loc != ""} { set sloc [split $loc -] lappend postcode [lindex $sloc 0] set locationVers [lindex $sloc 1] # if any versions are zero, set hasVersion 0. if {$locationVers == 0} { set hasVersion 0 } } } #updateStatus "ST|Account Status" $tclientRef setPhase $PhaseNames::AccountStatus # # Handle any service state changes. # set updateList {} if {$serviceState != -1} { $setup setVal serviceState $serviceState $setup setVal stateExpiration $stateExpiration lappend updateList serviceState } # # Store the sequence cookie # if {[string length $sequenceCookie] > 0} { $setup setVal sequenceCookie $sequenceCookie lappend updateList sequenceCookie } # Set the DataGroupList attribute on the ServiceInfo Object if { [llength $dataGroupList] > 0 } { putlog "Setting ServiceInfo DataGroupList attribute to $dataGroupList" $setup setVal dataGroupList $dataGroupList lappend updateList dataGroupList } else { putlog "ServiceInfo DataGroupList attribute was not sent by the service" } # Set the PublicLogFilter attribute on the ServiceInfo Object if { [llength $publicLogFilter] > 0 } { putlog "Setting ServiceInfo PublicLogFilter attribute to $publicLogFilter" $setup setVal publicLogFilter $publicLogFilter lappend updateList publicLogFilter } else { putlog "ServiceInfo PublicLogFilter attribute was not sent by the service" } # # Talk to the keyserver # file delete $Inc::TC_KEY_RESPONSE # Temporary hack # set keyServer "http://192.168.1.41:80/cgi-bin/keyserver" if {$keyServer != "" && [file exists $Inc::TC_KEY_QUERY]} { # PPS: must check for proper phase for key checking $tclientRef setPhase $PhaseNames::AccountStatus # updateStatus "ST|Checking keys" if {[catch {exec $Inc::TS_DEF_HPOST_BACKHAULPROG $Inc::TC_KEY_QUERY $keyServer $Inc::TC_KEY_RESPONSE ON ON >> $Inc::TC_HTTP_LOG} oops]} { # error occured during key query putlog "Error occured during keyserver query: $oops" file delete $Inc::TC_KEY_RESPONSE } else { putlog "Successful interaction with keyserver" } } # # Save the opt in/out status # storeOptStatus $setup $backhaulDataOn $personalDataOn updateList # # handle the backchannel transfer # $tclientRef setPhase $PhaseNames::BackHaul set curPrivBackhaul [$setup getVal noPrivBackhaul] # -1 is no change, 1 is no private backhaul, 0 is private backhaul ok. if {$noPrivBackhaul == -1} { if {$curPrivBackhaul == "{}" || $curPrivBackhaul == ""} { # Bootstrap case. putlog "Bootstrap - enable anonymous backhaul" set curPrivBackhaul 0 $setup setVal noPrivBackhaul 0 lappend updateList noPrivBackhaul } set noPrivBackhaul $curPrivBackhaul } else { putlog "Setting NoPrivateBackhaul to $noPrivBackhaul" $setup setVal noPrivBackhaul $noPrivBackhaul lappend updateList noPrivBackhaul } # # Save all of the above changes to setup # if {[llength $updateList]} { $setup storeDb $updateList } putlog "starting backhaul: $noPrivBackhaul" if {$noPrivBackhaul == 0} { if {[string compare $backChannelPrv NONE] && [file exists $Inc::TC_PRVLOG_FILE$Inc::TS_ZIP_CRYPT_EXT]} { regsub "$Inc::TS_SPECIFY_PP" $backChannelPrv \ $Inc::TS_ZIP_CRYPT_EXT backChannelPrv set doPriv 1 set token "" if {[string first $Inc::TS_SPECIFY_TOKEN $backChannelPrv] >= 0} { if {[checkLastPrivBackhaul $setup]} { set tooSoon 1 if {[catch {eval exec $Inc::TS_RANDOM_PROG 32 1} sess]} { putlog "Error generating session Id: $sess" # Session is only to help prevent ever clobbering # our own logs and that should not happen with # "checkLastPrivBackhaul" so use a fixed one # if we fail here set sess "12345678" } else { # lop off the 0x set sess [string range $sess 2 end] } set token [getClientToken $setup $regenToken] if {$token == ""} { endConnection 1 return } regsub "fn=$Inc::TS_SPECIFY_TOKEN" $backChannelPrv \ "fn=$token.$sess" backChannelPrv } else { set doPriv 0 putlog "too soon to do a private backhaul" } } if {$doPriv} { $cmdStr setCmd $backChannelPrv if {$token != ""} { $cmdStr setURLHideList {fn} } if {[$cmdStr process \ $Inc::TC_PRVLOG_FILE$Inc::TS_ZIP_CRYPT_EXT ] != 0} { endConnection 1 return 1 } $setup setVal lastPrivBackhaul [clock seconds] $setup storeDb lastPrivBackhaul } file delete -force $Inc::TC_PRVLOG_FILE$Inc::TS_ZIP_EXT file delete -force $Inc::TC_PRVLOG_FILE$Inc::TS_ZIP_CRYPT_EXT } elseif {[file exists $Inc::TC_PRVLOG_FILE$Inc::TS_ZIP_EXT]} { file delete -force $Inc::TC_PRVLOG_FILE$Inc::TS_ZIP_EXT file delete -force $Inc::TC_PRVLOG_FILE$Inc::TS_ZIP_CRYPT_EXT } # string compare returning non-zero means NOT THE SAME! if {[string compare $backChannelThumb NONE] && [file exists $Inc::TC_THUMBSLOG_FILE$Inc::TS_ZIP_CRYPT_EXT]} { regsub "$Inc::TS_SPECIFY_PP" $backChannelThumb \ $Inc::TS_ZIP_CRYPT_EXT backChannelThumb $cmdStr setCmd $backChannelThumb if {[$cmdStr process \ $Inc::TC_THUMBSLOG_FILE$Inc::TS_ZIP_CRYPT_EXT] != 0} { endConnection 1 return 1 } file delete -force $Inc::TC_THUMBSLOG_FILE$Inc::TS_ZIP_EXT file delete -force $Inc::TC_THUMBSLOG_FILE$Inc::TS_ZIP_CRYPT_EXT } elseif {[file exists $Inc::TC_THUMBSLOG_FILE$Inc::TS_ZIP_EXT]} { file delete -force $Inc::TC_THUMBSLOG_FILE$Inc::TS_ZIP_EXT file delete -force $Inc::TC_THUMBSLOG_FILE$Inc::TS_ZIP_CRYPT_EXT } } # check if we really need to send this file set errorFound 0 try { set errorFound [$setup getVal forceBackhaul] putlog "Setting ServiceInfo ForceBackhaul attribute to $forceBackhaul" $setup setVal forceBackhaul $forceBackhaul $setup storeDb forceBackhaul } catch errCode { putlog "Error setting ServiceInfo ForceBackhaul attribute! ($errCode)" } putlog "starting backhaul2" if {[string compare $backChannelPub NONE] && [file exists $Inc::TC_PUBLOG_FILE$Inc::TS_ZIP_EXT]} { # Now only backhaul if we really need to if {$errorFound == 1 || $forceBackhaul == 1} { regsub "$Inc::TS_SPECIFY_PP" $backChannelPub \ $Inc::TS_ZIP_EXT backChannelPub $cmdStr setCmd $backChannelPub if {[$cmdStr process \ $Inc::TC_PUBLOG_FILE$Inc::TS_ZIP_EXT ] != 0} { endConnection 1 return 1 } } file delete -force $Inc::TC_PUBLOG_FILE$Inc::TS_ZIP_EXT } putlog "starting backhaul3" if {[string compare $backChannelLog NONE] && [file exists $Inc::TC_SYSLOG_COMP$Inc::TS_ZIP_EXT]} { # Now only backhaul if we really need to if {$errorFound == 1 || $forceBackhaul == 1} { regsub "$Inc::TS_SPECIFY_PP" $backChannelLog \ $Inc::TS_ZIP_EXT backChannelLog $cmdStr setCmd $backChannelLog if {[$cmdStr process \ $Inc::TC_SYSLOG_COMP$Inc::TS_ZIP_EXT ] != 0} { endConnection 1 return 1 } } file delete -force $Inc::TC_SYSLOG_COMP$Inc::TS_ZIP_EXT } set backHaulDone 1 cleanPools "finished upload" #updateStatus "ST|Setting clock" $tclientRef setPhase $PhaseNames::SetClock # update the time if {[string compare $timeService NONE]} { putlog "processing timeService: $timeService" $cmdStr setCmd $timeService $cmdStr process foo } #updateStatus "DL|Retrieving msgs" $tclientRef setPhase $PhaseNames::RetrieveMessages if {$tcdMessage != ""} { cleanPools "individual messsages" set ret [processTcdMessage] if {$ret != 0} { putlog "Error loading indiv message: $ret" putlog "Continuing with remaining downloads..." } else { putlog "Sending EVT_DATA_CHANGED::MESSAGES" event send $TmkEvent::EVT_DATA_CHANGED $TmkDataChanged::MESSAGES 0 } } set gotGlobalMessages 0 if { $globalMessages != "" } { cleanPools "global messsages" $cmdStr setCmd $globalMessages set ret [$cmdStr process $Inc::TC_DOWNLOAD_DIR ] if {$ret != 0} { putlog "Global Message download failure: $ret" putlog "Continuing with remaining downloads..." } else { set gotGlobalMessages 1 } } #updateStatus "DL|Retrieving data" $tclientRef setPhase $PhaseNames::Download # Save the name of the SwSystem object that this Tivo Center # should be running if { $swSystemName != "" } { set current "unknown" catch { set current [$setup getVal swSystemName] } oops if { $swSystemName != $current} { putlog "saving sw system name: $swSystemName" $setup setVal swSystemName $swSystemName $setup storeDb swSystemName } else { putlog "sw system name $swSystemName is already current" } } # Download software, resources and program data. set gotSoftware [string compare $softwareList NONE] if {$gotSoftware} { set newSoftwareList "" set gotChksum 0 set index 0 # We can't just split the list on "|" and foreach over the result # because of the way tcl will see every space as a foreach match # Instead we'll break to list up into separate indexed entries set currentEntry [lindex [split $softwareList "|"] $index] while {[llength $currentEntry]} { incr index set url [lindex [split $currentEntry " "] 0] set filename [lindex [split $url "/"] end] # We need the full filename for logging purposes if ![regexp {.*://[^/]+(.*)} $url all fullfilename] { set fullfilename "Unknown-$filename" putlog "Could not match fullfilename. Using $fullfilename" } # Pull the checksum from the string, we can't assume # the position in the string, so we'll be careful if {[regexp {chksum\#(.*)$} $currentEntry dummy chksumStr]} { set chksum [lindex [split $chksumStr " "] 0] } else { set chksum "" } # check if any URL contains a checksum if {$chksum == ""} { # this came from a old HServer or an old ddserver # Add the file to the newSoftwareList in case we # have some files with and without checksums regsub "^ *" $currentEntry "" currentEntry lappend newSoftwareList "$currentEntry|" # Get the next entry and process it set currentEntry [lindex [split $softwareList "|"] $index] continue } else { set gotChksum 1 } set res [$partialDnldList compareEntry $filename $chksum] if {$res != 1} { # strip the checksum out of the URL, but use the rest # in case extra arguments are used (-t 180) regsub " chksum#$chksum" $currentEntry "" currentEntry regsub "^ *" $currentEntry "" currentEntry lappend newSoftwareList "$currentEntry|" } else { putlog "Found $filename on disk, skipping HTTP GET..." # Write to svclog this cached file, not downloaded $tclientRef svclog "tclient_download" "FILE=$fullfilename STATUS=Cached" } $partialDnldList addEntry $filename $chksum # Get the next entry and process it set currentEntry [lindex [split $softwareList "|"] $index] } # clean the unneeded files from disk $partialDnldList purgeUnused if {$gotChksum == 0} { putlog "Using older HServer, will NOT use PartialDownloadList" set newSoftwareList $softwareList } # remove the silly brackets that tcl puts in lists regsub -all {[\}\{]+} $newSoftwareList "" newSoftwareList cleanPools "download" set index 0 set currentEntry [lindex [split $newSoftwareList "|"] $index] while {[llength $currentEntry]} { incr index # trim off any lead spaces regsub "^ *" $currentEntry "" currentEntry set url [lindex [split $currentEntry " "] 0] set filename [lindex [split $url "/"] end] # We need the full filename for logging purposes if ![regexp {.*://[^/]+(.*)} $url all fullfilename] { set fullfilename "Unknown-$filename" putlog "Could not match fullfilename. Using $fullfilename" } # remove any spaces - chomp regsub -all " " $filename "" filename $cmdStr setCmd $currentEntry set ret [$cmdStr process $Inc::TC_DOWNLOAD_DIR ] if {$ret != 0} { putlog "Download failure: $ret" # Write to svclog this failed file download $tclientRef svclog "tclient_download" "FILE=$fullfilename STATUS=Failed" # Doubtful it will work, but try anyway... #POST the svclog and the commerce log $tclientRef postSvcLog $tclientRef postCommLog delete object $cmdStr cd $pwd endConnection $ret return $ret } else { set res [$partialDnldList entryDone $filename] # Write to svclog this new file download $tclientRef svclog "tclient_download" "FILE=$fullfilename STATUS=New" } # move on to the next entry set currentEntry [lindex [split $newSoftwareList "|"] $index] } #POST the svclog and the commerce log $tclientRef postSvcLog $tclientRef postCommLog } else { # # If there is no data to download, fine. In some cases # this may be bad (SETUPHEAD => your zip code not found) # But those problems are detected elsewhere after the call # and should not be seen as "call failures" which would lead # to checking the phone line, modem, etc. etc. # #POST the svclog and the commerce log $tclientRef postSvcLog $tclientRef postCommLog } # Terminate the connection, and tell MyWorld to turn off the # LED and say "Phone not in use" endConnection $ret # Update the keyring if the keyserver sent us anything if { [file exists $Inc::TC_KEY_RESPONSE] } { if { [catch {updateKeys $Inc::TC_KEY_RESPONSE} oops]} { putlog "Keyring update failure: $oops" } } if {$gotSoftware || $gotGlobalMessages || $got411Data } { if {$code != $Inc::TS_SR_TSTRING} { set ret [loadSoftware $postcode $headendID] } # Now any global messages have been loaded, tell MW if {$gotGlobalMessages} { putlog "Sending EVT_DATA_CHANGED::MESSAGES" event send $TmkEvent::EVT_DATA_CHANGED $TmkDataChanged::MESSAGES 0 } } if {$infoCode != ""} { # # Write the new info code into the DB. # $setup setVal dialConfig $infoCode $setup storeDb dialConfig putlog "Re-directing future calls to $infoCode" } cleanPools "done download" delete object $cmdStr cd $pwd } else { if {$code == $Inc::TS_SR_DENIED} { #updateStatus "ST|Account Status" $tclientRef setPhase $PhaseNames::AccountStatus # # Handle any service state changes. # if {$serviceState != -1} { $setup setVal serviceState $serviceState $setup setVal stateExpiration $stateExpiration $setup storeDb serviceState } set pwd [pwd] set cmdStr [CmdStr cms#auto] # update the time #updateStatus "ST|Setting clock" $tclientRef setPhase $PhaseNames::SetClock if {[string compare $timeService NONE]} { putlog "processing timeService: $timeService" $cmdStr setCmd $timeService $cmdStr process foo } putlog "Server access denied." cd $pwd set ret 0 } elseif {$code == $Inc::TS_SR_UNAVAIL} { putlog "Server access unavailable." set ret 1 } elseif {$code == $Inc::TS_SR_TPING || $code == $Inc::TS_SR_TSTRING} { putlog "PIIIINGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG!!!!" set pwd [pwd] set cmdStr [CmdStr cms#auto] # update the time #updateStatus "ST|Setting clock" $tclientRef setPhase $PhaseNames::SetClock if {[string compare $timeService NONE]} { putlog "processing timeService: $timeService" $cmdStr setCmd $timeService $cmdStr process foo } # # Handle any service state changes. # set updateList {} $tclientRef setPhase $PhaseNames::AccountStatus if {$serviceState != -1} { $setup setVal serviceState $serviceState $setup setVal stateExpiration $stateExpiration lappend updateList serviceState } if { [llength $dataGroupList] > 0 } { putlog "Setting ServiceInfo DataGroupList attribute to $dataGroupList" $setup setVal dataGroupList $dataGroupList lappend updateList dataGroupList } else { putlog "ServiceInfo DataGroupList attribute was not sent by the service" } # # Save all of the above changes to setup # if {[llength $updateList]} { $setup storeDb $updateList } putlog "Test loop completed." cd $pwd } elseif {$code == $Inc::TS_SR_ADMIN} { putlog "Admin task completed." } else { putlog "Unknown server response code '$code'." set ret 1 } endConnection $ret } delete object $setup putlog "SvrResp::process returning $ret" return $ret } ######## # # unEscapeMsg - deal with escaped chars in a TCD message. # ######## body SvrResp::unEscapeMsg {inLine} { # # Subsitute the two characters "\n" for the single char '\n' # Otherwise, replace \ with . # Also, replace any single '&' characters with '|' so we can # split the message on '|' and allow '&' in the message. # ('|' is illegal because tosvc.txt uses it) # set outLine "" set inLen [string length $inLine] set inIndex 0 for {} {$inIndex < $inLen} {incr inIndex} { set inChar [string index $inLine $inIndex] set outChar $inChar # # Have to escape the \ in the test below # if {$inChar == "\\" } { incr inIndex set inChar [string index $inLine $inIndex] if {$inChar == "n"} { set outChar "\n" } else { set outChar $inChar } } elseif {$inChar == "&"} { set outChar "|" } append outLine $outChar } return $outLine } ######## # # processTcdMessage - parse the fields of an individual message and # create and store them in a DB message object. # ######## body SvrResp::processTcdMessage {} { set tcdMessage [unEscapeMsg $tcdMessage] set msgFieldList [split $tcdMessage "|"] set msgSubject "" set msgBody "" set msgFrom "" set msgDateStr "" set msgExpireStr "" set msgPriority "" set msgDestStr "" set msgFreq [expr 60 * 60 * 24 * 100] set msgMaxCount 1 foreach msgField $msgFieldList { set fieldText "" set fieldName "" set colonIndx [string first ":" $msgField] set fieldName [string range $msgField 0 $colonIndx] set fieldName [string trimright $fieldName ": "] incr colonIndx set lastIndx [expr [string length $msgField] - 1] set fieldText [string range $msgField $colonIndx $lastIndx] putlog "fieldName = $fieldName" putlog "fieldText = $fieldText" set fieldText [string trim $fieldText] switch -exact $fieldName { Date { set msgDateStr $fieldText } From { set msgFrom [string trim $fieldText]} Subject { set msgSubject [string trim $fieldText]} Body { set msgBody [string trim $fieldText]} Expire { set msgExpireStr $fieldText } Priority { set msgPriority $fieldText } Destination { set msgDestStr $fieldText } Frequency { set msgFreq $fieldText } MaxCount { set msgMaxCount $fieldText } default { putlog "unknown field $fieldName" } } } # First check for invalid conditions if {$msgSubject == "" || $msgFrom == "" || $msgBody == ""} { putlog "Invalid message: From, Subject or Body is NULL" return 1 } if {$msgPriority == ""} { set msgPriority 3 } set msgDestList {} if {$msgDestStr != ""} { set msgDestList [split $msgDestStr " "] } else { lappend msgDestList 1 } set now [clock seconds] set msgDate [expr $now / 86400] set msgTime [expr $now % 86400] if { $msgDateStr != ""} { putlog "ignoring date ($msgDateStr) using now instead" } if { $msgExpireStr == ""} { set msgExpire [expr ($now / 86400) + 14] } else { set sec [clock scan $msgExpireStr -gmt 1] set msgExpire [expr $sec / 86400] } if { $msgMaxCount == 0 } { set msgMaxCount 1 } putlog "Found Individual Message:" putlog " Subject = $msgSubject" putlog " From = $msgFrom" putlog " Body = $msgBody" putlog " Prior = $msgPriority" putlog " Expire = $msgExpireStr ($msgExpire)" putlog " Date = $msgDateStr ($msgDate)" putlog "Destination = $msgDestStr" putlog "Frequency = $msgFreq" putlog "MaxCount = $msgMaxCount" try { RetryTransaction { putlog "creating Individual Message..." set obj [db $db create MessageItem] dbobj $obj set DateGenerated $msgDate dbobj $obj set TimeGenerated $msgTime dbobj $obj set From $msgFrom dbobj $obj set Subject $msgSubject dbobj $obj set ExpirationDate $msgExpire dbobj $obj set Body $msgBody dbobj $obj set FromId $Inc::MSG_SRC_INDIV dbobj $obj set Priority $msgPriority dbobj $obj remove Destination foreach d $msgDestList { if {$d != ""} { dbobj $obj add Destination $d } } if {$msgFreq != ""} { dbobj $obj set DisplayFrequency $msgFreq } dbobj $obj set PtcmCountRemaining $msgMaxCount } } catch errCode { putlog "error storing message: $errCode" return 1 } return 0 } ######## # # Percentage # # This is a helper function to figure out what percentage a part-done # is of a total amount. The result is rounded down to the nearest # whole percentage point. # ######## proc Percentage {part total min max} { # Figure out the range over which we are running. set range [expr $max - $min] # Avoid division by 0 and infinite loops. if { $range <= 0 } { return $min } # First, scale down the part (and total) so that multiplying # by 100 will not overflow 31 bits (signed numbers). (I don't see an # INT_MAX in tcl.) while { $part > 2147483647 / $range } { set total [expr $total / 2] set part [expr $part / 2] } # Avoid division by 0. if { $total == 0 } { return $min } # Now, use the obvious formula return [expr ($range * $part) / $total + $min] } ######## # # updateKeys - load new keys from keyserver response file into keyring # ######## body SvrResp::updateKeys {filename} { # PPS: must check for proper phase for key loading $tclientRef setPhase $PhaseNames::LoadToDB putlog "Parsing key response file $filename" set actions {} set responsefile [open $filename r] set done 0 set iscomplete 0 while { ! $done } { if {[catch {set action [gets $responsefile]}]} { putlog "End of key response file, done" set done 1 } elseif { $action == "" } { putlog "Empty line in key response, done" set done 1 } else { lappend actions $action if {[regexp ^END $action]} { set iscomplete 1 } } } close $responsefile if {!$iscomplete} { putlog "Key response file had no END, cannot trust it" return 0 } putlog "Starting keyring update" foreach action $actions { if { [regexp ^NOTE $action] || [regexp ^ERROR $action] } { putlog $action # Nothing to do here, although we might want to treat ERROR # differently... e.g. log something? fail the call? } elseif { [regexp ^ADD $action] } { regsub "^ADD " $action "" keystring regsub {,.*$} $keystring "" keyname putlog "ADD $keyname" set duplicate 0 RetryTransaction { set setup [FindOrCreateObject $db Setup /Setup] set mykeys [dbobj $setup get EncryptionKeys] foreach key $mykeys { regsub {,.*$} $key "" oldkeyname if { $keyname == $oldkeyname } { set duplicate 1 } } if {$duplicate} { putlog "Key $keyname is already in the keyring!" } else { putlog "Added $keyname to the keyring" dbobj $setup add EncryptionKeys $keystring } } } elseif { [regexp ^DROP $action] } { regsub "^DROP " $action "" keystring regsub {,.*$} $keystring "" keyname putlog "DROP $keyname" set found 0 RetryTransaction { set setup [FindOrCreateObject $db Setup /Setup] set mykeys [dbobj $setup get EncryptionKeys] foreach key $mykeys { regsub {,.*$} $key "" oldkeyname if { $keyname == $oldkeyname } { set found 1 dbobj $setup remove EncryptionKeys $key } } if {$found} { putlog "Key $keyname removed from the keyring!" } else { putlog "Key $keyname was not in the keyring" } } } else { # Nothing to do here - ignore END and anything we don't grok. } } dbclose $db } ###### # # This is used to sort the downloaded files. If the file's basename # is found in the matchList (which came from the server) then we # use that as the primary order. Otherwise, we use the alphabetic # order to sort either within matchList matches or after there are # no matches (modified from Dean's idea 2000.11.17) # ###### body SvrResp::compareDbloadFiles { left right } { set doFirstList [split $dbLoadOrder |] # # get the basenames of the files (a/genre-1.slice -> genre-1.slice). # set leftBasename [ file tail $left ] set rightBasename [ file tail $right ] set leftScore [llength $doFirstList] set rightScore [llength $doFirstList] set indx 0 foreach doFirst $doFirstList { if [ regexp ^$doFirst $leftBasename ] { set leftScore $indx } incr indx } set indx 0 foreach doFirst $doFirstList { if [ regexp ^$doFirst $rightBasename ] { set rightScore $indx } incr indx } if { $leftScore < $rightScore } { return -1 } if { $leftScore > $rightScore } { return 1 } return [ string compare $leftBasename $rightBasename ] } ######## # # loadSoftware - load newly downloaded software into the DB. This includes # uncompression. The uncompression acts as a checksum to # ensure the outer object's integrity. # ######## body SvrResp::loadSoftware {postcodeList headendID} { global env set ret 0 cleanPools "load software" cd $Inc::TC_DOWNLOAD_DIR set dbase [Database dbase#auto $Inc::TS_DEF_DBSIZE_KB] set headend [lindex [split $headendID -] 0] #updateStatus "IM|Preparing data" $tclientRef setPhase $PhaseNames::PrepareData # Install any keys that were previously unpacked. This # makes the keys available for unpacking software objects. cleanPools "move keys 1" if [catch {MoveKeysToSetup} res] { putlog "Failed MoveKeysToSetup 1: $res" } set dbHandle [$dbase getHandle] # First, look for any files with the .runme extension. These are # routine or emergency cleanup programs or scripts. If any are # present, execute each one (and log the results). Do this # prior to loading anything into the database, as we may need # to use a .runme to clean up a stale or damaged database... if {![catch {set f [glob *]}] && $f != ""} { foreach i $f { if {[file extension $i] == $Inc::TS_RUNME_EXT} { try { putlog "Found an emergency cleanup file $i" set basefile [file rootname $i] set runfile $basefile$Inc::TS_BEINGRUN_EXT file rename $i $runfile file attributes $runfile -permissions 0555 set sigfile $i$Inc::TS_SIG_EXT if { ! [file exists $sigfile] } { putlog "runme signiture $sigfile not found" $tclientRef svclog "tclient_runme" "SCRIPT=$runfile SIG=NOT_FOUND STATUS=0" } elseif {[catch {eval exec $Inc::TS_CRYPTO_PROG -vfs $i$Inc::TS_SIG_EXT $runfile $Inc::TS_SERVICE_PUB} msg]} { putlog "$runfile sigcheck failed: $msg" $tclientRef svclog "tclient_runme" "SCRIPT=$runfile SIG=FAILED STATUS=0" } elseif {[catch {eval exec ./$runfile} msg]} { putlog "$runfile failed: $msg" $tclientRef svclog "tclient_runme" "SCRIPT=$runfile SIG=OK STATUS=0" set ret 1 } else { putlog "$runfile succeeded: $msg" $tclientRef svclog "tclient_runme" "SCRIPT=$runfile SIG=OK STATUS=1" } } catch errMsg { $tclientRef svclog "tclient_runme" "SCRIPT=$runfile SIG=UNCHECKED STATUS=0" putlog "Error running cleanup: $errMsg" } file delete -force $i file delete -force $i$Inc::TS_SIG_EXT file delete -force $runfile } } } # # Now, get the list of files again, and unbundle any that need # unbundling. # if {[catch {set f [glob *]}] || $f == ""} { delete object $dbase return $ret } foreach i $f { if {[file extension $i] == $Inc::TS_BONDED_EXT} { if {[catch {unbundle $i} msg]} { putlog "ERROR: $i failed to unbundle: $msg." set ret 1 } file delete -force $i } } # # Get the list of files one more time. Gather the aggregate size # of all files so that dbload can fudge the "percent done". Then, # decompress and load each one. # if {[catch {set f [glob *]}] || $f == ""} { delete object $dbase return $ret } set sizeTotal 0 set sizeDone 0 foreach i $f { incr sizeTotal [file size $i] } # Sort the dbload list based on what the server told us # to load first set f [ lsort -command compareDbloadFiles $f ] set env(DBLOAD_START_TIME) [clock seconds] putlog "DBLOAD_START_TIME = $env(DBLOAD_START_TIME)" set newHeadend 0 set newProg 0 foreach i $f { set sizeThisFile [file size $i] set sizeAfterThisFile [expr $sizeDone + $sizeThisFile] set env(DBLOAD_START_PERCENT) [Percentage $sizeDone $sizeTotal 0 100] set env(DBLOAD_END_PERCENT) [Percentage $sizeAfterThisFile $sizeTotal 0 100] putlog "DBLOAD_START_PERCENT = $env(DBLOAD_START_PERCENT)" putlog "DBLOAD_END_PERCENT = $env(DBLOAD_END_PERCENT)" #updateStatus "IM|Expanding data" $tclientRef setPhase $PhaseNames::Decompress cleanPools "unpack $i" if {[file extension $i] == $Inc::TS_BZIP_EXT} { if {[catch {eval exec $Inc::TS_BUZIP_PROG < $i} msg]} { putlog "ERROR: $i found to be corrupt, removing: $msg." file delete -force $i set ret 1 continue } set i [file rootname $i] } if {[file extension $i] == $Inc::TS_ZIP_EXT} { if {[catch {eval exec $Inc::TS_UZIP_PROG $i} msg]} { putlog "ERROR: $i found to be corrupt, removing: $msg." set ret 1 file delete -force $i continue } set i [file rootname $i] } if {[string first $headend $i] != -1} { set newProg 1 } else { foreach pcode $postcodeList { if {[string first $pcode $i] != -1} { set newHeadend 1 } } } # Look only at files which are real .slice files after (optional) # decompression. Temporarily we must also look at .cpio files, # as these are really slices-containing-objects-containing-cpio # (yuck). if { [ eval regexp {$Inc::TS_SLICE_EXT$} $i ] || [ eval regexp {$Inc::TS_CPIO_EXT$} $i ] } { cleanPools "checksig $i" # PPS: must check for proper phase for signature loading # updateStatus "IM|Checking sig." $tclientRef setPhase $PhaseNames::LoadToDB set sigstatus "No signature" catch { foreach file [glob -nocomplain $i#*$Inc::TS_SIG_EXT] { putlog "Found signature file $file" regsub {^.*#} $file "" sigfile regsub {$$Inc::TS_SIG_EXT} $sigfile $Inc::TS_PUB_EXT keyfile putlog "Need public-key file $keyfile" if {[file exists $Inc::TS_KEY_DIR/$keyfile]} { putlog "Key file exists" set fault [catch {eval exec $Inc::TS_KEY_PROG -vfs $file $i $keyfile}] putlog "Return from signature verifier is $fault" } else { set sigstatus "No key file" } } } putlog "Final result of signature check is '$sigstatus'" cleanPools "dbload $i" #updateStatus "IM|Loading data" $tclientRef setPhase $PhaseNames::LoadToDB putlog "dbload $i..." if [catch {dbload $dbHandle $i} res] { putlog "dbload $i: $res" set ret 1 } file delete -force $i incr sizeDone $sizeThisFile putlog "sizeTotal = $sizeTotal" putlog "sizeThisFile = $sizeThisFile" putlog "sizeDone = $sizeDone" } } cleanPools "finished loading" unset env(DBLOAD_START_TIME) unset env(DBLOAD_START_PERCENT) unset env(DBLOAD_END_PERCENT) if {$newHeadend == 1} { # Tell MyWorld that there is new or updated headend data. event send $TmkEvent::EVT_DATA_CHANGED $TmkDataChanged::HEADEND 0 } if {$newProg == 1} { # If everthing went OK, # Set the inventory file in the database to match the one that came # back from the server response. if {$ret == 0} { set setup [Setup setupObj#auto] $setup loadDb $setup setVal inventoryFile $inventoryFile $setup storeDb inventoryFile delete object $setup } # Tell MyWorld that there is new program data. event send $TmkEvent::EVT_DATA_CHANGED $TmkDataChanged::PROGRAM_GUIDE 0 } # Post an event that new showcases have arrived. This needs # to be more intelligent, but they probably will arrive everyday anyway. event send $TmkEvent::EVT_DATA_CHANGED $TmkDataChanged::SHOWCASE 0 delete object $dbase # # Install any keys that were unpacked this download. # cleanPools "move keys 2" if [catch {MoveKeysToSetup} res] { putlog "Failed MoveKeysToSetup 2: $res" } return $ret } ###################################################################### # # Server -- these methods are run only on the server. # And the server uses HSvrResp.itcl not this file!!!! # ###################################################################### ######## # # writeBlock - write out the SRB to the HTTP connection # ######## body SvrResp::writeBlock {conn} { # version 2 fields: lappend srbList "ERR_MSG=$errMessage" lappend srbList "VERSION=$netVersion" lappend srbList "CODE=$code" lappend srbList "SW_LIST=$softwareList" lappend srbList "BACK_CH_THUMB=$backChannelThumb" lappend srbList "BACK_CH_PRV=$backChannelPrv" lappend srbList "BACK_CH_PUB=$backChannelPub" lappend srbList "BACK_CH_LOG=$backChannelLog" lappend srbList "TIME_SVC=$timeService" lappend srbList "SEQ_COOKIE=$sequenceCookie" lappend srbList "INV_FILE=$inventoryFile" lappend srbList "NO_PRV_BACKHAUL=$noPrivBackhaul" lappend srbList "SERVICE_STATE=$serviceState" lappend srbList "STATE_EXPIRE=$stateExpiration" lappend srbList "SW_SYSTEM_NAME=$swSystemName" lappend srbList "INFO_CODE=$infoCode" lappend srbList "TCD_MESSAGE=$tcdMessage" lappend srbList "GLOBAL_MESSAGES=$globalMessages" lappend srbList "KEY_SERVER=$keyServer" lappend srblist "FORCE_BACKHAUL=$forceBackhaul" lappend srblist "DATA_GROUP_LIST=$dataGroupList" lappend srblist "PUBLIC_LOG_FILTER=$publicLogFilter" set listSize 0 foreach listItem $srbList { set listSize [incr listSize [expr [string length $listItem] + 1]] } if {$writeHeader} { puts $conn "Content-Length: $listSize" puts $conn "Content-Type: text/plain" puts $conn "" } foreach listItem $srbList { puts $conn $listItem } } ######## # # print # ######## body SvrResp::print {} { putlog "" putlog " Start SvrResp =====================" putlog " errMessage: $errMessage" putlog " version: $netVersion" putlog " code: $code" putlog " softwareList: $softwareList" putlog " backChannelPrv: $backChannelPrv" putlog " backChannelPub: $backChannelPub" putlog " backChannelLog: $backChannelLog" putlog " backChannelThumb: $backChannelThumb" putlog " timeService: $timeService" putlog " sequenceCookie: $sequenceCookie" putlog " inventoryFile: $inventoryFile" putlog " noPrivBackhaul: $noPrivBackhaul" putlog " serviceState: $serviceState" putlog " stateExpiration: $stateExpiration" putlog " swSystemName: $swSystemName" putlog " infoCode: $infoCode" putlog " tcdMessage: $tcdMessage" putlog " globalMessages: $globalMessages" putlog " keyServer: $keyServer" putlog " forceBackhaul: $forceBackhaul" putlog " publicLogFilter: $publicLogFilter" putlog " dbLoadOrder: $dbLoadOrder" putlog " regenToken: $regenToken" putlog " backhaulDataOn: $backhaulDataOn" putlog " personalDataOn: $personalDataOn" putlog " dataGroupList: $dataGroupList" putlog " End SvrResp =======================\n" } ######## # # setVal # ######## body SvrResp::setVal {field val} { switch -exact $field { version { set netVersion $val; set SvrRespVersion $val } code { set code $val } softwareList { set softwareList $val } backChannelPrv { set backChannelPrv $val } backChannelPub { set backChannelPub $val } backChannelLog { set backChannelLog $val } backChannelThumb { set backChannelThumb $val } timeService { set timeService $val } sequenceCookie { set sequenceCookie $val } inventoryFile { set inventoryFile $val } noPrivBackhaul { set noPrivBackhaul $val } serviceState { set serviceState $val } stateExpiration { set stateExpiration $val } swSystemName { set swSystemName $val } infoCode { set infoCode $val } errMessage { set errMessage $val } tcdMessage { set tcdMessage $val } globalMessages { set globalMessages $val } irdbVersion { set irdbVersion $val } genreVersion { set genreVersion $val } showcaseVersion { set showcaseVersion $val } keyServer { set keyServer $val } forceBackhaul { set forceBackhaul $val } dataGroupList { set dataGroupList $val } publicLogFilter { set publicLogFilter $val } dbLoadOrder { set dbLoadOrder $val } regenToken { set regenToken $val } backhaulDataOn { set backhaulDataOn $val } personalDataOn { set personalDataOn $val } default { if {$debug} {putlog "unknown field: $field" }} } } body SvrResp::setDebug {dbgVal} { set debug $dbgVal } body SvrResp::noHeader {} { set writeHeader 0 } body SvrResp::setTcdId {id} { set centerId $id } body SvrResp::setCallId {id} { set callId $id } body SvrResp::setUseAPG {val} { set useAPG $val } body SvrResp::getBackHaulDone {} { return $backHaulDone } body SvrResp::setHServerAddr {ip} { set hserverAddr $ip } body SvrResp::setHServerPort {port} { set hserverPort $port } body SvrResp::new411Data {} { set got411Data 1 } body SvrResp::getClientToken {setup regen} { # Do not log the token value! if {$regen} { set retToken [regenerateToken $setup] } # # We don't use the actual token if we're also backhauling # commerce log data; don't want to create possibilities for # associating the CAT with the TCD ID # set useTempToken 0 if { [file exists $Inc::TC_COMM_LOG_TEMP] } { if { [file size $Inc::TC_COMM_LOG_TEMP] } { set useTempToken 1 } } if {$useTempToken} { set retToken [makeToken] } else { set retToken [$setup getVal clientToken] if {$retToken == "" || $retToken == "{}" } { set retToken [regenerateToken $setup] } } return $retToken } body SvrResp::makeToken {} { set retToken "" if {[catch {eval exec $Inc::TS_RANDOM_PROG 128 1} retToken]} { putlog "error generating client token: $retToken" } else { # lop off the 0x set retToken [string range $retToken 2 end] } return $retToken } body SvrResp::regenerateToken {setup} { # Do not log the token value! set retToken [makeToken] if {[string length $retToken]} { $setup setVal clientToken $retToken $setup storeDb clientToken } return $retToken } body SvrResp::storeOptStatus {setup backhaul personal uList} { upvar $uList updateList set curBackhaul [$setup getVal backhaulDataOn] set curPersonal [$setup getVal personalDataOn] set nukeToken 0 if {$curBackhaul != $backhaul} { $setup setVal backhaulDataOn $backhaul lappend updateList backhaulDataOn set nukeToken 1 } if {$curPersonal != $personal} { $setup setVal personalDataOn $personal lappend updateList personalDataOn set nukeToken 1 } # Any change to opt status and we clear the token! if {$nukeToken} { $setup setVal clientToken "" lappend updateList clientToken } } body SvrResp::checkLastPrivBackhaul {setup} { # Do not log the time of last priv backhaul! set lastPrivBackhaul [$setup getVal lastPrivBackhaul] if {[llength $lastPrivBackhaul] > 0} { set now [clock seconds] # Handle clock warp! set diffSec [expr $now - $lastPrivBackhaul] if {$diffSec < 0 || $diffSec > 86400} { return 1 } else { return 0 } } else { return 1 } }