#!/tvbin/tivosh

# Copyright 2017 TiVo Inc. All Rights Reserved.
#
#

package require uri
package require uri::urn

# It's important for Support to capture the curl exit codes from the Http{Get,Put} routines. 
# We do that by biasing the curl codes. Of the 10 reserved slots, the first 5 are mapped to 
# return's Exceptional Return Codes. That leaves 5 slots for errors representing session
# failures after connecting the Service.

set ecBias	    10
set maxLogErrors    5
set curl	    /bin/curl
set execDir	    [pwd]
set slsUrl	     "http://sls.tivoservice.com/Get?bodyId=tsn:@@TSN@@&service=hserver"
set slsOptions	    ""
set urlfile         "/var/tmp/imageurls.txt"
set hserver         ""

set params(tsn)     $::env(SerialNumber)
set params(version) $::env(SwSystem)
set params(impl)    [exec HpkPlatform -implementation]
set params(dir)     /db

if {[info exist ::env(TIVO_ROOT)] && $::env(TIVO_ROOT) != {} && $::env(TIVO_ROOT) != "/"} {
    set ::params(dir)  $::env(TIVO_ROOT)/$::params(dir)
}

array set response {
    hserver {}
    sls {}
}


#
# Regexp expressions used to validate strings coming from the XML.
#
set validUrlRegexp    {[A-Za-z0-9\.:/?@=\-~%_+&|]*}
set validShaRegexp    {[A-Za-z0-9]*}
set validStringRegexp {[A-Za-z0-9\-\.@/]*}

set fRunning false
set statusfile "/tmp/FirstStageInstaller.status"
set manifestFile ""
set URLs {}

#
# check a string and make sure it matches a regexp, used for checking 
# valid fields in XML if the string does not match, exit
#
proc ValidateString {str expr} {
    regexp -- $expr $str match
    
    if {$match != $str} {
        ErrorExit "Bad string: $str\nafter: $match"
    }
}

proc GetMfsVersion {} {
    puts "Getting mfs version"
    set db [dbopen]
    set major 0
    set minor 0
    RetryTransaction {
	set obj [db $db open /State/Database]
	set major [dbobj $obj get VersionMajor]
	set minor [dbobj $obj get VersionMinor]
    }
    return [list major $major minor $minor]
}

proc PreInstall {} {
    puts "In PreInstall"
    set manifestUrl [FindUrl "manifest.txt.gz"]
    
    if {$manifestUrl == ""} {
	ErrorExit "Error: no manifest URL found"
    }

    set ::manifestFile /var/tmp/manifest.txt

    # download the manifest, max size 128K bytes
    file delete -force $::manifestFile

    if {[catch {
	if {[catch {
	    exec $::curl --max-filesize 131072 -L -m 60 -s -S --retry 5 $manifestUrl | gzip -d -c - > $::manifestFile
	} text]} {
	    error "curl error (check file existence)\nurl: $manifestUrl\n$text"
	}
	
	puts "parsing manifest file"

	# parse the manifest
	if {[catch {
	    set fd [open $::manifestFile {RDWR}]
	    array set ::manifest [read $fd]
	    close $fd
	} text]} {
	    error "opening manifest: $text"
	}
	
	if {![info exists ::manifest(version)]} {
	    error "no software version specified in manifest"
	}
	
	if {$::params(version) == $::manifest(version)} {
	    error "version $::manifest(version) already installed"
	}

	puts "Checking mfs" 

        if {![info exists ::manifest(mfs)]} {
            error "manifest does not include the MFS version info"
        }
        # pull the current MFS version from MFS
        array set current [GetMfsVersion]
        puts "Current Mfs Minor-Major Version is $current(major)-$current(minor)" 
        array set new $::manifest(mfs)
        puts "Minor-Major Version mentioned in manifest file is $new(major)-$new(minor)" 
        
        # compare the new MFS version with the current MFS version
        if {$new(major) < $current(major) || ($new(major) == $current(major) && $new(minor) < $current(minor))} {
            error "downgrade detected, not allowed... from $current(major).$current(minor) to $new(major).$new(minor)"
	}
    } errortext]} {
	file delete -force $::manifestFile
	ErrorExit "error: $errortext"
    }
}

proc Install {} {
    puts "Installing"
    set utilUrl [FindUrl utils.tar.gz]
    set utilSize [FindSize utils.tar.gz]

    if {$utilUrl == ""} {
	ErrorExit "error: unable to find utils"
    }
    
    set bundleName installer.$::params(impl)

    cd /var/tmp
    file delete -force $bundleName

    if {[catch {

        file delete -force utils.tar.gz
        
	if {[catch {
	    exec $::curl --max-filesize $utilSize -L -m 60 -s -S --retry 5 $utilUrl > utils.tar.gz 
	} text]} {
	    error "curl error (check file existence)\nurl: $utilUrl\n$text"
	}

        if {[catch {
            exec gzip -d -c utils.tar.gz | cpio -iud --no-absolute-filenames --quiet $bundleName
        } text ]} {
            error "gzip/cpio error extracting $bundleName from utils.tar.gz: $text"
        }
        
	puts "Locating bundle"
	if {![file exists $bundleName]} {
	    error "unable to locate bundle $bundleName"
	}

	# First 4 bytes of the bundle contain the size of the bundle
	# without the signature attached.
	set fd [open $bundleName {RDONLY}]
	fconfigure $fd -translation binary -encoding binary
	
	if {![binary scan [read $fd 4] I cpioSize]} {
	    close $fd
	    error "unable to determine bundle cpioSize"
	}
	close $fd
	set bundleSize [file size $bundleName]
	set sigSize [expr {$bundleSize -4 -$cpioSize}]
	
	puts "Checking binary sizes"    
	# check the sizes
	if {$bundleSize <= 0 || $sigSize <= 0 || $cpioSize <= 0 ||
	    $bundleSize < $cpioSize || $bundleSize < $sigSize } {
	    error "sizes are out of bounds: $bundleSize $cpioSize $sigSize"
	}

	puts "Validating bundle signature against platform key"
	# signature is the 2K tail of the file
	file delete -force /var/tmp/$bundleName.sig
	exec tail -c $sigSize $bundleName > $bundleName.sig

	file delete -force /var/tmp/$bundleName.unsigned

        # this code differs from FirstStageInstaller because the older versions of 'head'
        # do not support using negative sizes.  So instead, we calculate the size to use
        # and use a positive number for head.
        set unsignedBundleSize [expr {$bundleSize - 4 - $sigSize}]
        exec tail -c +5 $bundleName | head -c $unsignedBundleSize > $bundleName.unsigned

	# use crypto check the signature of the file
	if {[catch {
	    exec /tvbin/crypto -vfs $bundleName.sig $bundleName.unsigned /platform/etc/platform.pub
	} txt]} {
	    error "signature validation failed for $bundleName: $txt"
	}

	puts "Bundle signature validated successfully against platform key"
	# gunzip and untar the remainder
	file delete -force $bundleName.dir
	file mkdir $bundleName.dir
	cd $bundleName.dir
	if {[catch {
	    exec gzip -d -c ../$bundleName.unsigned | cpio -iud --no-absolute-filenames --quiet
	} txt]} {
	    error "unable to expand $bundleName: $txt"
	}
	puts "Executing Second Stage Installer"
        exec ./SecondStageInstaller -urlfile $::urlfile -manifest $::manifestFile >@ stdout
	
	file delete -force /var/tmp/$bundleName.dir
	
    } errortext]} {
	file delete -force /var/tmp/$bundleName
	file delete -force /var/tmp/$bundleName.sig
	file delete -force /var/tmp/$bundleName.unsigned
	file delete -force /var/tmp/$bundleName.dir
	file delete -force $::manifestFile
	ErrorExit "error: $errortext"
    }
    # now clean everything up
    puts "DONE Clean everything up"
    cd $::execDir
    file delete -force /var/tmp/$bundleName
    file delete -force /var/tmp/$bundleName.sig
    file delete -force /var/tmp/$bundleName.unsigned
    file delete -force /var/tmp/$bundleName.dir
    file delete -force $::manifestFile
}

proc PostInstall {} {
    set fd [open $::statusfile {WRONLY CREAT TRUNC}]
    puts $fd "reboot"
    close $fd
}

proc LoadUrls {} {
    puts "In LoadUrls"

    puts "Validate urls"
    set fd [open $::urlfile {RDONLY}]
    set ::URLs [read $fd]
    foreach url $::URLs {
	ValidateString $url $::validUrlRegexp
    }
    close $fd
}

proc FirstStageInstaller {} {

    puts "First Stage Installer (runme) starting up"
    
    if {[catch {
	LoadUrls
	PreInstall
	Install
	PostInstall
    } text]} {
	puts $text
    }
}

proc FindUrl {pattern} {
    puts "In FindUrl pattern $pattern"

    foreach url $::URLs {
	array set urlInfo [uri::split $url]
	set filename [file tail $urlInfo(path)]
	if {[string match $pattern $filename]} {
        puts "Found url $url"
	    return $url
	    break
	}
    }
    return ""
}

proc FindSize {pattern} {
    puts "In FindSize pattern $pattern"
    foreach url $::URLs {
	array set urlInfo [uri::split $url]
	set filename [file tail $urlInfo(path)]
	if {[string match $pattern $filename]} {
        puts "Found url $url"
	    set found $url
	    break
	}
    }
    # FUTURE get the size out of the manifest for this file
    # return 2MB for now
    return [expr 2048 * 1024]
}

proc ErrorExit {{text {}}} {
    puts stderr $text

    if {$::fRunning} {
	#
	# remove the status file
	#
	file delete -force $::statusfile
    }

    exit 1
}


proc DoExit {text {code 1}} {

    Log ERROR: "rc\($code\): $text"
    exit $code
}

set logErrorCount 0

proc Log {args} {
    set scriptname [file rootname [file tail [info script]]]
    set procname [lindex [info level [expr [info level] -1]] 0]
    puts "$scriptname\($procname) $args"
}


proc HttpGet {url} {

    Log url $url
    set rc  0

    if {[catch {exec $::curl --location -sS --max-time 60 $url} result]} {
	# capture and return the curl exit code
	switch -exact -- [lindex $::errorCode 0] {
	    NONE {
		# output on stderr but no problem
		set rc 0
	    }
	    ARITH {
		# ARITH code msg
		# -- bias the curl exit-code value above Tcl's as needed
		set rc [lindex $::errorCode 1]
		if {$rc != 0} {
		    incr rc $::ecBias
		}
	    }
	    CHILDSTATUS {
		# CHILDSTATUS pid code
		# -- bias the curl exit-code value above Tcl's as needed
		set rc [lindex $::errorCode 2]
		if {$rc != 0} {
		    incr rc $::ecBias
		}
	    }
	    default {
		# something went wrong
		set rc 1
	    }
	}
    }

    # no problems, done
    return -code $rc "$result"
}

proc HttpPost {url postdata} {

    Log url $url
    set rc  0

    if {[catch {exec $::curl -d $postdata --location -Ss --max-time 60 $url} result]} {
	# capture and return the curl exit code
	switch -exact -- [lindex $::errorCode 0] {
	    NONE {
		# output on stderr but no problem
		set rc 0
	    }
	    ARITH {
		# ARITH code msg
		# -- bias the curl exit-code value above Tcl's as needed
		set rc [lindex $::errorCode 1]
		if {$rc != 0} {
		    incr rc $::ecBias
		}
	    }
	    CHILDSTATUS {
		# CHILDSTATUS pid code
		# -- bias the curl exit-code value above Tcl's as needed
		set rc [lindex $::errorCode 2]
		if {$rc != 0} {
		    incr rc $::ecBias
		}
	    }
	    default {
		# something went wrong
		set rc 1
	    }
	}
    }

    # no problems, done
    return -code $rc "$result"
}

proc CallSLS {} {
    set ::hserver  ""
    set rc	    0

    set rc [catch {HttpGet [string map "@@TSN@@ $::params(tsn)" $::slsUrl]} ::response(SLS:api)]
    # parse the result code
    switch $rc {
	0 {
	    ;
	}
	default {
	    Log "rc: $rc, hResponse: $::response(SLS:api)"
	    return -code $rc $::response(SLS:api)
	}
    }

    Log response $::response(SLS:api)

    ValidateString $::response(SLS:api) $::validUrlRegexp

    if {[regexp -- {hserver:(.+):([0-9]+)} $::response(SLS:api) match server port]} {
	set ::hserver "$server:$port"

	Log hserver $::hserver
    } elseif {$::response(SLS:api) == ""} {
        Log "empty response from SLS, falling back to h1.tivoservice.com:80"
        set ::hserver "h1.tivoservice.com:80"
    }
        
    return -code 0 $::hserver
}

proc CallHServer {hserver} {
    
    Log hserver $hserver

    #REASONCODE=8 is TS_ID_SOFTWARE, ping plus software lookup

    set postdata "IDB_CENTERID=$::params(tsn)&IDB_AGNOSTICIDS=1&IDB_VERSION=3&IDB_REASONCODE=8&IDB_SWDESC=&IDB_LOCATIONID=&IDB_SEQCOOKIE=&IDB_HEADEND=&IDB_SHOWCASES=&IDB_INVFILE=&IDB_WAITCOUNT=0&IDB_CUR_SWNAME=$::params(version)&CALL_ID="

    set url "http://$hserver/tivo-service/HServer.cgi"

    set rc  [catch {HttpPost "$url" "$postdata"} ::response(hserver)]
    # parse the result code
    switch $rc {
	0 {
	    ;
	}
	default {
	    Log "rc: $rc, hResponse: $::response(hserver)"
	}
    }

    return -code $rc "$::response(hserver)"
}

proc FIsGuidedSetupComplete {} {

    set type [tvidl enum TvSettingsCommonType -valueof GUIDED_SETUP_COMPLETE]
    
    set reqData [list .type TvSettingsTypesValueList settings [list [list .type TvSettingsTypesValue type $type]]]
    
    set request [tvidl listtoserial $reqData]
    set response [tvbus simplecall TvSettingsCommonProtocol $request]

    array set valueList [tvidl serialtolist $response]
    set settingsList $valueList(settings)

    foreach settingData $settingsList {
        array set setting $settingData

        if {$setting(type) == $type && [info exists setting(longValue)]} {
            return $setting(longValue)
        }
    }
    return 0
}

    
proc DoUpgrade {} {

    set targetVersion ""

    regexp -- "SW_SYSTEM_NAME=($::validUrlRegexp)" $::response(hserver) match targetVersion

    if {$targetVersion == "" || $targetVersion == "none"} {
	DoExit "No target SwSystemName"
    } elseif {$targetVersion == $::params(version)} {
	DoExit "Software version is current"
    }

    Log Installing $targetVersion

    if {[regexp -- "SW_IMAGE_LIST=($::validUrlRegexp)" $::response(hserver) match softwareList]} {

	set fd [open $::urlfile {WRONLY CREAT TRUNC}]
	foreach image [split $softwareList "&|"] {
	    set image [string trim $image]
	    if {$image != ""} {
		puts $fd $image
	    }
	}
	close $fd

        set response ""
        
	if {[catch {
            set response [FirstStageInstaller]
	} text]} {
            puts "FSI response:\n$text"
	    DoExit "FSI returned an error"
	}
	Log "FSI response:\n$response"
	Log "Installation Complete"

        set gscomplete [FIsGuidedSetupComplete]
        Log "GS Complete: $gscomplete"
        
        # Put the box in Pending Restart
        # if the box has not completed Guided Seutp, reboot now
        if {$gscomplete} {
            tvbus sendandforget TvSystemRebootRequest \
                [tvidl listtoserial {
                    .type TvSystemRebootRequestOptions
                    logText tivo3SoftwareUpgrade.runme
                    waitForIdle true
                }]
        } else {
            #
            # the TvBus service is pretty slow while still in GS
            #
            exec reboot
        }
    } else {
	DoExit "No s/w images to install"
    }
}

proc CheckFirstStageInstaller {} {
    if {[file exists $::statusfile]} {
	set fd [open $::statusfile {RDONLY}]
	set text [read $fd 100]
	close $fd

        set fRunning true
	DoExit "FSI status already $text"
    }
}

proc main {} {

    CheckFirstStageInstaller

    set hserver [CallSLS]
    
    #
    # See if the hserver hs instructions for us
    #
    if {$hserver != {}} {
	CallHServer $hserver
    }
    
    DoUpgrade
}

set rc [catch {main} text]
switch $rc {
    0 {
	;
    }
    default {
	puts $::errorInfo
	DoExit "$text" $rc
    }
}

exit 0