rendered paste body#!/tvbin/tivosh
#
# resource_dump.tcl
# adh, 2003
#
# Limit size of transactions for 7.x
# Jamie, 2005
#
# creates a tarball containing scripts, utilities, and tystreams
# needed to recreate:
#
# /Genre
# /Component
# /Resource/LoopSet
# /Resource/VideoClip
#
# mfs_uberexport and mfs_import MUST be present in
# the current dir, as well as support.tcl. You should have tar in your
# PATH somewhere.
#
# tested with 3.1.1b on a S2 DTiVo
#
# derived from the following works:
# dumpobj-tcl from mbm
# vplay/mfs_export stuff from tridge
# mfs_import from tivodvlpr
#
# original "mfs from scratch" concept by d18c7db
proc dump { db f fsid subid parent depth prefix needtrans } {
set out $f
if { $depth == 0 } {return "-max-"}
RetryTransaction {
set obj [db $db openid $fsid $subid]
set subid [dbobj $obj subobjid]
if [catch {
set tyname [dbobj $obj get Name]
}] {
set tyname ""
}
set otype [dbobj $obj type]
set primary [dbobj $obj primary]
set attrlist [dbobj $obj attrs]
set attrtypelist {}
set attrvauelist {}
foreach attr $attrlist {
if { [string match "0x*" $attr] } {
append ret " (attribute $attr not in schema)\n"
continue
}
set atype [dbobj $obj attrtype $attr]
lappend attrtypelist $atype
if {$atype == "object"} {
lappend attrvaluelist [dbobj $obj gettarget $attr]
} else {
lappend attrvaluelist [dbobj $obj get $attr]
}
}
}
regsub -all {[a-z]} $otype {} oshort
if { [info exists ::seen($fsid/$subid)] } {
puts "Skipping visited object: $fsid/$subid"
return $::seen($fsid/$subid)
} else {
puts "Dumping object: $fsid/$subid"
}
if { ![info exists ::count($oshort)] } {
set ocount [set ::count($oshort) 0]
} else {
set ocount [incr ::count($oshort)]
}
set myobj "${oshort}_$ocount"
set ::seen($fsid/$subid) $myobj
if {$needtrans != 0} {
puts $out "${prefix}if \[catch \{"
puts $out "${prefix} RetryTransaction \{"
set ::notstale(1) 1
unset ::notstale
}
if {$primary} {
puts $out "${prefix} set $myobj \[db \$db create $otype\]"
} else {
if { ! [info exists ::notstale($parent)] } {
puts $out "${prefix} set $parent \[db \$db openid \[lindex \$id_$parent 0\] \[lindex \$id_$parent 1\]\]"
set ::notstale($parent) 1
}
puts $out "${prefix} set $myobj \[db \$db createsub $otype \$$parent\]"
}
set ::notstale($myobj) 1
puts $out "${prefix} set id_$myobj \[list \[dbobj \$$myobj fsid\] \[dbobj \$$myobj subobjid\]\]"
set nobject 0
foreach attr $attrlist atype $attrtypelist attrs $attrvaluelist {
if { [string match "0x*" $attr] } {
continue
}
switch $attr {
Version -
IndexUsed -
IndexUsedBy -
IndexPath {continue}
}
set aindex 0
foreach a $attrs {
switch $atype {
string { set a "{$a}" }
object {
# subobjects must be created in the same transaction as the parent
if { [regexp {([0-9]*)/(.*)} $a junk cfsid csubobjid] && $cfsid == $fsid } {
set a \$[dump $db $f $cfsid $csubobjid $myobj [expr $depth -1] " $prefix" 0]
} else {
set a ""
}
incr nobject
}
file {
# warning: assumes all files are tystreams
# FromMfs "${a}.file" $a
if {$tyname == ""} {
set tyname "${a}.ty"
}
# XXX bug alert
# this does not cache "seen" tystreams as it does for objects
# also this strategy may result in mfs_stdinsert being
# called for streams which do not exist due to a transaction
# failure
puts "Extracting tystream: fsid $a -> $tyname"
exec mfs_uberexport $a -o "work/${tyname}" >/dev/console 2>/dev/console
puts $out "${prefix} set fsid \[tycreate \"${tyname}\"\]"
puts $out "${prefix} lappend inserts \"\$fsid ${tyname}\""
set a "\$fsid"
}
}
if { $a != "" } {
set act set
if { $aindex != 0} { set act add }
puts $out "${prefix} dbobj \$$myobj $act $attr $a"
}
incr aindex
}
}
if {$needtrans !=0} {
puts $out "${prefix} \}"
puts $out "${prefix}\}\] \{"
puts $out "${prefix} puts \"Creation failed\""
puts $out "${prefix}\}"
}
#
# Construct each subobject in its own transaction
#
if {$nobject != 0} {
foreach attr $attrlist atype $attrtypelist attrs $attrvaluelist {
if { [string match "0x*" $attr] } {
continue
}
if { $atype != "object" } {
continue
}
switch $attr {
Version -
IndexUsed -
IndexUsedBy -
IndexPath {continue}
}
set aindex 0
set aindex 0
foreach a $attrs {
# Dump the object
if { [regexp {([0-9]*)/(.*)} $a junk cfsid csubobjid]} {
if { $cfsid == $fsid } {
# subojbects already handled above
continue;
}
set fsid $a
set csubobjid -1
}
set a [dump $db $f $cfsid $csubobjid $myobj [expr $depth -1] " $prefix" $needtrans]
# Add it to the attribute value
if {$needtrans != 0} {
puts $out "${prefix}if \[catch \{"
puts $out "${prefix} RetryTransaction \{"
set ::notstale(1) 1
unset ::notstale
}
if { ! [info exists ::notstale($a)] } {
puts $out "${prefix} set $a \[db \$db openid \[lindex \$id_$a 0\] \[lindex \$id_$a 1\]\]"
set ::notstale($a) 1
}
if { ! [info exists ::notstale($myobj)] } {
puts $out "${prefix} set $myobj \[db \$db openid \[lindex \$id_$myobj 0\] \[lindex \$id_$myobj 1\]\]"
set ::notstale($myobj) 1
}
set act set
if { $aindex != 0} { set act add }
incr aindex
puts $out "${prefix} dbobj \$$myobj $act $attr \$$a"
if {$needtrans != 0} {
puts $out "${prefix} \}"
puts $out "${prefix}\}\] \{"
puts $out "${prefix} puts \"Add failed\""
puts $out "${prefix}\}"
}
}
}
}
return $myobj
}
proc makelist { db dir } {
set subdirs {}
set objlist {}
set prefix "$dir/"
if { $prefix == "//" } {
$prefix = "/"
}
ForeachMfsFile id name type $dir "" {
if { $type == "tyDir" } {
lappend subdirs "${prefix}${name}"
} elseif { $type == "tyDb" } {
lappend objlist "${prefix}${name}"
}
}
foreach name $subdirs {
set objlist [concat $objlist [makelist $db $name]]
}
return $objlist
}
#exec rm -rf work resources.tgz
#exec mkdir work
#exec cp support.tcl dbload.tcl work/
#exec cp mfs_import work/
set f [open "keyring_restore.tcl" "w"]
puts $f {#!/tvbin/tivosh}
#puts $f {source "support.tcl"}
puts $f "set db \[dbopen\]"
puts $f {# nuke old keys}
puts $f {ForeachMfsFile fsid name type \/State\/Keyring "" \{}
puts $f { RetryTransaction \{}
puts $f { set obj \[db $db openid $fsid\]}
puts $f { puts "Removing old key $name"}
puts $f { dbobj $obj markasrubbish}
puts $f { \}}
puts $f {\}}
set db [dbopen]
# assumption: there are no tyfiles anywhere in these paths
set list {}
set list [concat $list [makelist $db /State/Keyring]]
#set list [concat $list [makelist $db /Component]]
#set list [concat $list [makelist $db /Genre]]
#set list [concat $list [makelist $db /Resource/LoopSet]]
# Interesting values for debugging
#set list "/Genre/1009"
#set list "/Resource/LoopSet/RCA_WatchTV_2"
foreach x $list {
RetryTransaction {
set obj [db $db open $x]
set fsid [dbobj $obj fsid]
set subid [dbobj $obj subobjid]
}
# this check is redundant but is included so that all
# index paths are accounted for in the info output
if { [info exists ::seen($fsid/$subid)] } {
puts "Skipping visited object: $x ($fsid/$subid)"
} else {
puts "Extracting object: $x ($fsid/$subid)"
puts $f "puts \"Creating object: $x\""
set myobj [dump $db $f $fsid $subid "{no parent}" 10 " " 1]
}
# <----------------------------------- added pauses to allow me to shrink *.mpv files (for space reasons)
#puts -nonewline stdout "Press Enter to continue: "
#flush stdout
#set cont [gets stdin]
}
puts $f "dbclose \$db"
#puts $f "tyinsert \$inserts"
puts $f "puts \"Finished.\""
close $f
dbclose $db
#exec chmod 755 work/resource_create.tcl work/dbload.tcl
exec chmod 755 keyring_restore.tcl
#puts "Creating resources.tgz"
puts "All done."
# <---------------------------------- altered tar output dir for space reasons
#exec tar zcf resources.tgz work/
#exec tar zcf /var/hack/resources.tgz work/
#exec rm -rf work/
exit 0