" show_link_backup_summary $chan puts $chan "
"
puts $chan "This was in the channel lineup at the time the backup was made."
puts $chan "However it cannot be found in the current channel lineup. Any"
puts $chan "season passes on this channel will not be restored until you"
puts $chan "map this defunct channel onto a good one. There are no ill"
puts $chan "effects if you don't do this - all that will happen is that any"
puts $chan "season pass on this channel will not be restored."
}
puts $chan [html_end]
}
proc action_backup_perform_remap_channel {chan path env} {
puts $chan [html_start "Remap Channel"]
eval $env
if {$fsid == ""} {
puts $chan "No fsid supplied"
} else {
global restore_station
set restore_data $restore_station($fsid)
agwrite restore_data agwMap fsid $map_fsid
set restore_station($fsid) $restore_data
if {$map_fsid == ""} {
puts $chan "The channel is now unmapped - while in this state you"
puts $chan "cannot restore season passes to it"
} else {
global snapshot_station
set snapshot_data $snapshot_station($map_fsid)
set original_number [agextract $restore_data agwChannelNum]
set new_number [agextract $snapshot_data agwChannelNum]
set original_name [string trim [agextract $restore_data Name] "{}"]
set new_name [string trim [agextract $snapshot_data Name] "{}"]
puts $chan "Mapped channel $new_number ($new_name) onto the defunct"
puts $chan "channel $original_number ($original_name)"
}
# Loop through the season passes and turn on/off any passes for this
puts $chan "
Please wait while the season passes are updated..."
puts $chan "this may take a while
"
# Take a snapshot of the current season passes - the find_matching_sp
# function will use this, and will remove entries from it as it sees fit
take_snapshot_sp 0 0
# Loop through the restore season pass list and check them off...
global restore_sp
foreach spfsid [array names restore_sp] {
set spdata $restore_sp($spfsid)
set spmap [agextract $spdata agwMap]
if {$spmap == ""} {
set station [agextract $spdata Station]
set uses_this_stn 0
if {$station == $fsid} {
set uses_this_stn 1
}
if {$uses_this_stn} {
# Set the restore value to 0 if this season pass is already on
# this station... also this is quite expensive so save the value
set agwReMap ""
if {$map_fsid != ""} {
set spdatadummy $spdata
agwrite spdatadummy Station fsid $map_fsid
set agwReMap [find_matching_sp $spdatadummy]
}
agwrite spdata agwReMap fsid $agwReMap
# Establish the restore value
set restore_value 1
if {$map_fsid == "" || $agwReMap != ""} {
set restore_value 0
}
# Update the restore value for this station
agwrite spdata agwRestore bool $restore_value
set restore_sp($spfsid) $spdata
}
}
}
wipe_snapshot_sp_arrays 1 0
puts $chan "Season passes updated
"
}
puts $chan "
" show_link_station_summary $chan puts $chan [html_end] } proc action_backup_show_theme {chan path env} { global restore_theme global restore_theme_by_name puts $chan [html_start "Wishlists from Backup File"] set count_restorable [get_missing_theme_count] write_fsid_toggle_script $chan $count_restorable show_link_backup_summary $chan if {$count_restorable != 0} { puts $chan [html_form_start "POST" "/backup_toggle_theme" "name=\"form\""] } puts $chan [html_table_start "" "Wishlists from Backup" "COLSPAN=4"] puts $chan [tr "ALIGN=CENTER" [th "Name"] [th "Type"] [th "Status"] [th [write_fsid_toggle_checkall "Toggle Restore" $count_restorable]]] set type_labels [wishlist_type_labels] foreach name [lsort [array names restore_theme_by_name]] { set fsid $restore_theme_by_name($name) set data $restore_theme($fsid) set type_index [expr [defaultval 1 [agextract $data ThemeType]] - 1] set type_text [lindex $type_labels $type_index] set theme_status "Already Exists" set do_restore [td ""] if {[agextract $data agwMap] == ""} { set theme_status "Restorable" set default_restore "" if {[agextract $data agwRestore] != 0} { set default_restore "1" } set do_restore [td "ALIGN=CENTER" [html_form_checkbox "fsid_$fsid" $default_restore]] } puts $chan [tr "" [td $name] [td $type_text] [td $theme_status] $do_restore] } puts $chan [html_table_end] if {$count_restorable != 0} { puts $chan [html_form_input "submit" "submit" "Save"] puts $chan [html_form_end] puts $chan "
" puts $chan "This screen allows you to choose which wishlists to restore - it" puts $chan "does not actually restore anything" puts $chan "
" } show_link_backup_summary $chan puts $chan [html_end] } proc action_backup_toggle_theme {chan path env} { puts $chan [html_start "Toggle Wishlist Restores"] eval $env # Get a list of all of the wishlists that are ticked... set fsidlist "" foreach raw_fsid [info locals "fsid_*"] { lappend fsidlist [lindex [split $raw_fsid "_"] 1] } # ... and apply those to the wishlists we've got in store global restore_theme global restore_theme_by_name puts $chan [html_table_start "" "Restorable Wishlists" "COLSPAN=3"] puts $chan [tr "ALIGN=CENTER" [th "Name"] [th "Type"] [th "Restore"]] set type_labels [wishlist_type_labels] foreach name [lsort [array names restore_theme_by_name]] { set fsid $restore_theme_by_name($name) set data $restore_theme($fsid) if {[agextract $data agwMap] == ""} { set restorable 0 if {[lsearch $fsidlist $fsid] != -1} { set restorable 1 } agwrite data agwRestore bool $restorable set restore_theme($fsid) $data set type_index [expr [defaultval 1 [agextract $data ThemeType]] - 1] set type_text [lindex $type_labels $type_index] set will_restore No if {$restorable != 0} { set will_restore Yes } puts $chan [tr "" [td $name] [td $type_text] [td $will_restore]] } } puts $chan [html_table_end] show_link_backup_summary $chan puts $chan [html_end] } proc action_backup_show_series {chan path env} { global restore_series global snapshot_series global temporary_series_by_tmsid set orphans [get_orphaned_series] puts $chan [html_start "Series from Backup File"] # We don't build a sorted list of fsid's for the series because, aside from # here, we never really need it. So we'll just nip through and build one up # in-situ set series_by_name(0) "" reset_load_array series_by_name 0 foreach fsid [array names restore_series] { set data $restore_series($fsid) set title [string trim [agextract $data Title] "{}"] set series_by_name($title) $fsid } puts $chan "This is for reference purposes only. If a series is required by" puts $chan "a season pass and it isn't already on the TiVo then it will be" puts $chan "added back in." puts $chan "
" show_link_backup_summary $chan puts $chan "
"
puts $chan [html_table_start "" "Series from Backup" "COLSPAN=4"]
puts $chan [tr "ALIGN=CENTER" [th "Title"] [th "TmsId"] [th "IndexPath"] [th "Status"]]
set deep_search_reqd 0
foreach name [lsort [array names series_by_name]] {
set fsid $series_by_name($name)
set data $restore_series($fsid)
set title $name
set tmsid [agextract $data TmsId]
set indexpath ""
set status ""
set agwMap [agextract $data agwMap]
if {$agwMap == "" || $agwMap == "0"} {
set status "Not present, will add if used"
} else {
set real $snapshot_series($agwMap)
set realname [string trim [agextract $real Title] "{}"]
set indexpath [agextract $real IndexPath]
set status "Already on TiVo as \"$realname\""
if {[lsearch -exact $orphans $fsid] != -1} {
set deep_search_reqd 1
set status "Orphaned series - deep search required!"
}
if {[lsearch -exact [array names temporary_series_by_tmsid] $tmsid] != -1} {
set status "$status
(added by restore, not yet indexed)"
}
}
puts $chan [tr "" [td $title] [td $tmsid] [td $indexpath] [td $status]]
}
puts $chan [html_table_end]
if {$deep_search_reqd} {
puts $chan "The program guide data appears to be quite new on this TiVo."
puts $chan "Before season passes can be restored to some of these series"
puts $chan "the program will have to perform a deep search of the database"
puts $chan "to get the correct series mappings.
"
puts $chan "
"
puts $chan "This can take over half an hour!
"
puts $chan "If you want to run the deep search then click the 'Search' button
"
puts $chan [html_form_start "POST" "/backup_deep_search_series"]
puts $chan [html_form_input "submit" "submit" "Search"]
puts $chan [html_form_end]
}
show_link_backup_summary $chan
puts $chan [html_end]
reset_load_array series_by_name 1
}
proc action_backup_deep_search_series {chan path env} {
puts $chan [html_start "Deep Search for Series Identifiers"]
eval $env
puts $chan "TiVo Web has determined that some series on the TiVo"
puts $chan "are orphaned. This can happen when the program data guide is"
puts $chan "only a few days old. Tivo Web will now have to look for the"
puts $chan "correct identifiers the hard way. At present, this means doing"
puts $chan "a deep search for the values it needs.
"
puts $chan "
"
puts $chan "This will take a LONG time. Occasionally you will see"
puts $chan "a message pop up. After about 30 or 40 minutes(!) you will"
puts $chan "get a prompt right at the bottom of the list (scroll down)"
puts $chan "back to the series summary. When you can see that then"
puts $chan "the search has completed.
"
puts $chan "
"
puts $chan "Moving away from this page will interrupt the search.
"
puts $chan "
"
# Ok - get the list of orphans and build up a corresponding list of ID's
global restore_series
global snapshot_series
set orphan_fsid [get_orphaned_series]
set orphan_tmsid ""
set orphan_count [llength $orphan_fsid]
foreach fsid $orphan_fsid {
set series $restore_series($fsid)
lappend orphan_tmsid [agextract $series TmsId]
}
if {$orphan_count == 0} {
puts $chan "No orphans to search for!"
} else {
# I hate this. But it'll do as a first step.
# Loop through /Server... this is going to take a while!
puts $chan "Looking for $orphan_count series...
"
global db
set count 0
ForeachMfsFileTrans fsid name type "/Server" "" 20 {
# Show a pulse
incr count
if {[expr $count % 500] == 0} {
puts $chan "Examined $count records
"
}
# Read the object and check to see if it's a series
if {[catch {set object [db $db openid $fsid]}]} {
puts $chan "Warning - could not open object $fsid
"
} else {
set objtype [dbobj $object type]
if {$objtype == "Series"} {
# Right tmsid?
set tmsid [dbobj $object get TmsId]
set orphan [lsearch -exact $orphan_tmsid $tmsid]
if {$orphan != -1} {
# Blimey! Found one... yay... record the real fsid and get it out
# of the lists. Stop searching if it's the last orphan
set restore_fsid [lindex $orphan_fsid $orphan]
set series $restore_series($restore_fsid)
agwrite series agwMap fsid $fsid
set restore_series($restore_fsid) $series
set title [string trim [agextract $series Title] "{}"]
puts $chan "Found the correct FSID for series $title
"
set series_data [db $db openid $fsid]
set series_fields [dbobj $series_data attrs]
set content [construct_record_content $series_data $series_fields]
snapshot_add_series $fsid $content 0
set orphan_fsid [lreplace $orphan_fsid $orphan $orphan]
set orphan_tmsid [lreplace $orphan_tmsid $orphan $orphan]
incr orphan_count -1
puts $chan "$orphan_count more series to find...
"
if {$orphan_count == 0} {
break
}
}
}
}
}
}
if {$orphan_count == 0} {
puts $chan "All done!
"
} else {
puts $chan "Couldn't find the identifiers for $orphan_count series!
"
puts $chan "It will not be possible to restore the season passes for"
puts $chan "these series...
"
}
show_link_series_summary $chan
puts $chan [html_end]
}
proc action_backup_show_sp {chan path env} {
global restore_sp
global restore_sp_by_priority
global restore_station
puts $chan [html_start "Season Passes from Backup File"]
set count_restorable [get_missing_sp_count]
write_fsid_toggle_script $chan $count_restorable
show_link_backup_summary $chan
if {$count_restorable != 0} {
puts $chan [html_form_start "POST" "/backup_toggle_sp" "name=\"form\""]
}
puts $chan [html_table_start "" "Season Passes from Backup" "COLSPAN=6"]
puts $chan [tr "ALIGN=CENTER" [th "Priority"] [th "Type"] [th "Name"] [th "Channel"] [th "Status"] [th [write_fsid_toggle_checkall "Toggle Restore" $count_restorable]]]
foreach priority [lsort -dictionary [array names restore_sp_by_priority]] {
set fsid $restore_sp_by_priority($priority)
set data $restore_sp($fsid)
set type [agextract $data agwSPType]
set name [get_sp_name $data 1]
set callsign [get_sp_callsign $data 1]
set status [get_sp_status $data 1]
set do_restore [td ""]
if {[lindex $status 0] == "Restorable"} {
set default_restore ""
if {[agextract $data agwRestore] != 0} {
set default_restore "1"
}
set do_restore [td "ALIGN=CENTER" [html_form_checkbox "fsid_$fsid" $default_restore]]
}
puts $chan [tr "" [td [expr $priority + 1]] [td $type] [td $name] [td $callsign] [td $status] $do_restore]
}
puts $chan [html_table_end]
if {$count_restorable != 0} {
puts $chan [html_form_input "submit" "submit" "Save"]
puts $chan [html_form_end]
puts $chan "
" puts $chan "This screen allows you to choose which season passes to restore" puts $chan "- it does not actually restore anything" puts $chan "
"
}
show_link_backup_summary $chan
puts $chan [html_end]
}
proc action_backup_toggle_sp {chan path env} {
puts $chan [html_start "Toggle Season Pass Restores"]
eval $env
# Get a list of all of the season passes that are ticked...
set fsidlist ""
foreach raw_fsid [info locals "fsid_*"] {
lappend fsidlist [lindex [split $raw_fsid "_"] 1]
}
# ... and apply those to the season passes we've got in store
global restore_sp
global restore_sp_by_priority
puts $chan [html_table_start "" "Restorable Season Passes" "COLSPAN=5"]
puts $chan [tr "ALIGN=CENTER" [th "Priority"] [th "Type"] [th "Name"] [th "Channel"] [th "Restore"]]
foreach priority [lsort -dictionary [array names restore_sp_by_priority]] {
set fsid $restore_sp_by_priority($priority)
set data $restore_sp($fsid)
if {[agextract $data agwMap] == ""} {
set restorable 0
if {[lsearch $fsidlist $fsid] != -1} {
set restorable 1
}
agwrite data agwRestore bool $restorable
set restore_sp($fsid) $data
set type [agextract $data agwSPType]
set name [get_sp_name $data 1]
set callsign [get_sp_callsign $data 1]
set will_restore No
if {$restorable != 0} {
set will_restore Yes
}
puts $chan [tr "" [td $priority] [td $type] [td $name] [td $callsign] [td $will_restore]]
}
}
puts $chan [html_table_end]
show_link_backup_summary $chan
puts $chan [html_end]
}
proc action_backup_perform_restore {chan path env} {
puts $chan [html_start]
set global_trace $chan
puts $chan "In the first few versions of this module the restore will dump"
puts $chan "a trace of what it is doing to screen. If there is anything to"
puts $chan "restore then you will see the trace scrolling off underneath"
puts $chan "this text as you're reading it."
puts $chan "
"
puts $chan "Scroll down through the trace until you see the link back to the"
puts $chan "summary page. If you see an error please make a copy of the text"
puts $chan "of the error message and report the problem."
puts $chan "
"
perform_restore_themes $chan
perform_restore_sps $chan
puts $chan "
"
show_link_backup_summary $chan
puts $chan [html_end]
}
proc show_link_backup_summary {chan} {
puts $chan [html_link "/backup_present_restore" "Return to Summary"]
}
proc show_link_backup_menu {chan} {
puts $chan [html_link "/backup" "Return to Backup Menu"]
}
proc show_link_series_summary {chan} {
puts $chan [html_link "/backup_show_series" "Return to the series summary"]
}
proc show_link_station_summary {chan} {
puts $chan [html_link "/backup_show_station" "Return to the channel summary"]
}
proc write_fsid_toggle_script {chan count_restorable} {
if {$count_restorable != 0} {
puts $chan ""
puts $chan ""
puts $chan ""
}
}
proc write_fsid_toggle_checkall {title count_restorable} {
set result "Restore"
if {$count_restorable} {
set result ""
}
return $result
}
proc take_snapshot_for_backup {} {
take_snapshot_station 1
take_snapshot_theme 1
take_snapshot_sp 1 1
# Trim off the stations that are not used by any season pass
trim_station_list
}
proc take_snapshot_for_restore {} {
take_snapshot_station 0
take_snapshot_theme 0
take_snapshot_sp 0 1
}
proc take_snapshot_station {full_info} {
reset_snapshot_station 0
global db
global channeltablenum
foreach channum [lsort -integer [array names channeltablenum]] {
set stationfsid $channeltablenum($channum)
RetryTransaction {
set station [db $db openid $stationfsid]
set fields [dbobj $station attrs]
set content [construct_record_content $station $fields]
snapshot_add_station $stationfsid $content $channum $full_info
}
}
}
proc snapshot_add_station {fsid content channum full_info} {
global snapshot_station
global snapshot_station_by_num
set content "agwChannelNum int $channum $content"
if {!$full_info} {
set content [filter_content $content "agwChannelNum CallSign Name TmsId" ""]
}
set snapshot_station($fsid) $content
set snapshot_station_by_num($channum) $fsid
}
proc take_snapshot_theme {full_info} {
global snapshot_theme
global snapshot_theme_by_name
reset_load_array snapshot_theme 0
reset_load_array snapshot_theme_by_name 0
global db
ForeachMfsFileTrans fsid name type "/Theme" "" 20 {
set theme [db $db openid $fsid]
set fields [dbobj $theme attrs]
set content [construct_record_content $theme $fields]
snapshot_add_theme $fsid $content $full_info
}
}
proc snapshot_add_theme {fsid content full_info} {
global snapshot_theme
global snapshot_theme_by_name
if {!$full_info} {
set content [filter_content $content "Name ThemeType" ""]
}
set snapshot_theme($fsid) $content
if {$full_info} {
set snapshot_theme_by_name([agextract $content Name]) $fsid
}
#check_store "on taking snapshot theme"
}
proc take_snapshot_sp {full_info wipe_series} {
global snapshot_sp
global snapshot_sp_by_priority
global snapshot_series
wipe_snapshot_sp_arrays 0 $wipe_series
global db
global seasonpassdir
ForeachMfsFileTrans fsid name type $seasonpassdir "" 20 {
set sp [db $db openid $fsid]
set fields [dbobj $sp attrs]
set content [construct_record_content $sp $fields]
agappend content agwSPType string [sptype $content]
snapshot_add_sp $fsid $content $full_info
set series [dbobj $sp get Series]
if {[string length $series] != 0} {
set seriesfsid [dbobj $series fsid]
if {![info exists snapshot_series($seriesfsid)]} {
set seriesfields [dbobj $series attrs]
set seriescontent [construct_record_content $series $seriesfields]
snapshot_add_series $seriesfsid $seriescontent $full_info
}
}
}
# Load the persistent temporary series from disk
load_temporary_series
}
proc wipe_snapshot_sp_arrays {full_wipe wipe_series} {
global snapshot_sp
global snapshot_sp_by_priority
reset_load_array snapshot_sp $full_wipe
reset_load_array snapshot_sp_by_priority $full_wipe
if {$wipe_series} {
global snapshot_series
reset_load_array snapshot_series $full_wipe
}
}
proc snapshot_add_sp {fsid content full_info} {
if {!$full_info} {
set content [filter_content $content "agwSPType Series Station Theme DayOfWeekLocal StartTimeLocal Duration" ""]
}
set ::snapshot_sp($fsid) $content
if {$full_info} {
set ::snapshot_sp_by_priority([agextract $content Priority]) $fsid
}
#check_store "on taking snapshot season pass"
}
proc snapshot_add_series {fsid content full_info} {
if {!$full_info} {
set content [filter_content $content "Title IndexPath TmsId ServerId" ""]
}
set ::snapshot_series($fsid) $content
#check_store "on taking snapshot series"
}
proc create_backup {chan fname} {
global global_trace
set global_trace $chan
backup_zap_store 0
set open_action "Create"
set backup_previous ""
if {[file exists $fname]} {
set open_action "Overwrite"
set backup_previous "$fname.old"
file copy -force $fname $backup_previous
}
set fd 0
if {[open_file fd $chan $fname 1]} {
# show_store_usage_text_2 $chan "before snapshot"
puts $chan "Taking snapshot of season passes - please wait
"
take_snapshot_for_backup
# show_store_usage_text_2 $chan "after snapshot"
puts $chan "
"
puts $chan [html_table_start "" "Backup Checklist" "COLSPAN=2"]
if {$backup_previous != ""} {
create_backup_progress $chan "Copy existing backup file to '$backup_previous'" ""
}
create_backup_progress $chan "$open_action backup file '$fname'" ""
create_backup_write_header $chan $fd
create_backup_write_version $chan $fd
create_backup_write_channels $chan $fd
create_backup_write_themes $chan $fd
create_backup_write_season_passes $chan $fd
show_store_usage_row $chan "after writing file"
puts $chan [html_table_end]
puts $fd "\}"
close $fd
# Release the store allocated to the snapshot
backup_zap_store 1
# Put in a link to the backup file
puts $chan "You can save this backup file on your computer by right-clicking "
puts $chan "the link below and choosing the browser's 'save target as' option:
"
puts $chan "
"
puts $chan [html_link "/backup$fname/" "$fname"]
puts $chan "
(Don't worry if it saves it as a HTML file, it will still work)
"
puts $chan "
"
# Put up the back button
show_link_backup_menu $chan
}
}
proc create_backup_progress {chan message result} {
if {$result == ""} {
set result "Done"
}
puts $chan [tr "" [td $message] [td $result]]
# puts $chan "$message: $result
"
}
proc create_backup_write_header {chan fd} {
puts $fd "$::global_backup_magic_number - do not edit on or before this line"
puts $fd "# Layout: $::global_backup_layout_version"
puts $fd "# The latest version of backup.itcl can be found somewhere under"
puts $fd "# http://www.boygenius.co.uk/tivo"
puts $fd "# This is executable code - TiVo Web runs it to load the data into store. If"
puts $fd "# you must edit it then please be careful."
puts $fd ""
puts $fd "# The load procedure"
puts $fd "proc load_file_content \{\} \{"
puts $fd " # Store the date that the backup was taken"
set todaystr [clock format [clock seconds] -format "%a %b %d %Y %H:%M:%S"]
puts $fd " load_backup_date \"$todaystr\""
create_backup_progress $chan "Write header" ""
}
proc create_backup_write_version {chan fd} {
puts $fd ""
puts $fd " # Load the layout version"
puts $fd " load_layout_version \"$::global_backup_layout_version\""
puts $fd ""
create_backup_progress $chan "Store layout version number $::global_backup_layout_version" ""
puts $fd " # Load the TiVo software version running on the TiVo that was backed up"
puts $fd " load_version \{$::tivoswversion\}"
create_backup_progress $chan "Store TiVo version number $::tivoswversion" ""
}
proc create_backup_write_channels {chan fd} {
puts $fd ""
puts $fd " # These are the channels used by the season passes in the backup"
puts $fd " # The list is for reference only and doesn't reflect the full"
puts $fd " # list of channels in the lineup at the time of the backup"
global snapshot_station
global snapshot_station_by_num
set count 0
foreach channum [lsort -integer [array names snapshot_station_by_num]] {
incr count
set fsid $snapshot_station_by_num($channum)
puts $fd " load_channel {$fsid} \{$snapshot_station($fsid)\}"
}
create_backup_progress $chan "Store details for $count channels (for reference only, may contain duplicates)" ""
}
proc create_backup_write_themes {chan fd} {
puts $fd ""
puts $fd " # Load the wishlists on the TiVo at the time of backup"
global snapshot_theme
global snapshot_theme_by_name
set count 0
foreach name [lsort [array names snapshot_theme_by_name]] {
incr count
set fsid $snapshot_theme_by_name($name)
puts $fd " load_theme {$fsid} \{$snapshot_theme($fsid)\}"
}
create_backup_progress $chan "Store details for $count wishlists" ""
}
proc create_backup_write_season_passes {chan fd} {
puts $fd ""
puts $fd " # Load the season passes on the TiVo at the time of backup"
global snapshot_sp
global snapshot_sp_by_priority
set count 0
foreach priority [lsort -dictionary [array names snapshot_sp_by_priority]] {
set fsid $snapshot_sp_by_priority($priority)
set data $snapshot_sp($fsid)
if {[sanity_check_sp $chan $fsid $data] == 1} {
incr count
agremove data agwSPType
puts $fd " load_season_pass {$fsid} \{$data\}"
}
}
create_backup_progress $chan "Store details for $count season passes" ""
global snapshot_series
if {[array size snapshot_series] != 0} {
puts $fd ""
puts $fd " # Load the series used by the season passes"
set count 0
foreach seriesfsid [array names snapshot_series] {
incr count
puts $fd " load_series {$seriesfsid} \{$snapshot_series($seriesfsid)\}"
}
create_backup_progress $chan "Store details for $count series" ""
}
}
proc sanity_check_sp {chan fsid data} {
set result 1
# Double-check that the wishlist is there - snoopy had a bizarre backup that
# had an SP referring to a missing theme
set sptype [agextract $data agwSPType]
set sppri [agextract $data Priority]
incr sppri
if {$sptype == "Wishlist"} {
set chkthm_fsid [agextract $data Theme]
if {[lsearch -exact [array names ::snapshot_theme] $chkthm_fsid] == -1} {
set result 0
create_backup_progress $chan "Season pass #$sppri NOT written to backup - refers to missing wishlist $chkthm_fsid" "WARNING"
}
}
return $result
}
proc load_backup {chan fname} {
global global_trace
set global_trace $chan
set errorCode ""
set errorInfo ""
backup_zap_store 0
global restore_cbl1
global restore_cby1
get_store_usage restore_cbl1 restore_cby1
# We won't catch errors in the generated file... the screen display will help
# when debugging glitches in the thing...
source $fname
global timing_load_file
set timing_load_file [agtime {load_file_content}]
# What we have here is a bunch of data. We need to figure out what channels
# are missing, ditto wishlists, season passes etc.
global timing_automap_stations
global timing_automap_themes
global timing_automap_series
global timing_automap_sps
take_snapshot_for_restore
set timing_automap_stations [agtime {automap_restore_stations}]
set timing_automap_themes [agtime {automap_restore_themes}]
set timing_automap_series [agtime {automap_restore_series}]
# This one uses the map values established by automap_themes and
# automap_series - it *MUST* run after those have finished...
set timing_automap_sps [agtime {automap_restore_sps}]
# How many bad themes did we see?
if {$::restore_ignored_sp_badthm != 0} {
set t_pass "pass"
set t_wlst "a wishlist"
set t_has "has"
if {$::restore_ignored_sp_badthm > 1} {
set t_pass "passes"
set t_wlst "wishlists"
set t_has "have"
}
puts $chan "The TiVo that this backup was taken on had "
puts $chan "$::restore_ignored_sp_badthm season $t_pass "
puts $chan "for $t_wlst that did not exist. The season $t_pass $t_has "
puts $chan "been removed from the restore. Please check your wishlist "
puts $chan "SPs after the restore.
"
puts $chan "
"
}
# Release any remaining snapshot SP data
wipe_snapshot_sp_arrays 1 0
return 1
}
proc reset_load_slots {full} {
reset_load_arrays $full
set $::restore_backup_date ""
set $::restore_layout_version ""
set $::restore_load_version ""
}
proc reset_snapshot {full} {
reset_snapshot_station $full
reset_snapshot_theme $full
reset_snapshot_sp $full
global temporary_series_by_tmsid
reset_load_array temporary_series_by_tmsid $full
}
proc reset_snapshot_station {full} {
global snapshot_station
global snapshot_station_by_num
reset_load_array snapshot_station $full
reset_load_array snapshot_station_by_num $full
}
proc reset_snapshot_theme {full} {
global snapshot_theme
global snapshot_theme_by_name
reset_load_array snapshot_theme $full
reset_load_array snapshot_theme_by_name $full
}
proc reset_snapshot_sp {full} {
global snapshot_sp
global snapshot_sp_by_priority
global snapshot_series
reset_load_array snapshot_sp $full
reset_load_array snapshot_sp_by_priority $full
reset_load_array snapshot_series $full
}
proc reset_load_arrays {full} {
global restore_series
global restore_sp
global restore_sp_by_priority
global restore_station
global restore_station_by_num
global restore_theme
global restore_theme_by_name
reset_load_array restore_series $full
reset_load_array restore_sp $full
reset_load_array restore_sp_by_priority $full
reset_load_array restore_station $full
reset_load_array restore_station_by_num $full
reset_load_array restore_theme $full
reset_load_array restore_theme_by_name $full
}
proc reset_load_array {arrayref full} {
upvar $arrayref arr
if {[info exists arr]} {
unset arr
}
if {!$full} {
array set arr ""
}
}
proc load_backup_date {v} {
set ::restore_backup_date $v
check_store "on loading backup date"
}
proc load_channel {fsid data} {
# Channels are unique amongst the arrays that are built up in that they do
# not get written into the database. The backup file contains an awful lot of
# information about the channel that we can just discard.
set data [filter_content $data "agwChannelNum CallSign Name TmsId" ""]
set num [agextract $data agwChannelNum]
set ::restore_station_by_num($num) $fsid
set ::restore_station($fsid) $data
check_store "on loading channel"
}
proc load_layout_version {v} {
set ::restore_layout_version $v
check_store "on loading version"
}
proc load_season_pass {fsid data} {
# To reduce store requirements we'll remove large and unnecessary fields
set data [filter_content $data "" "IndexPath IndexUsedBy"]
# Override the Priority in the file and set it to the next available slot
# in the array - this way we can change priority just by changing the order
# of the lines in the file, and not have to worry about changing values
set pri [array size ::restore_sp]
agwrite data Priority int $pri
# Figure out what type of season pass we have.
# This information was present in the snapshot that was originally used to
# create the backup but I didn't like to rely on it. The backup should be
# raw data and values inferred from the raw data should be current as of
# the restore script, not current as of the backup script.
set agwSPType [sptype $data]
agappend data agwSPType string $agwSPType
set ::restore_sp($fsid) $data
set ::restore_sp_by_priority($pri) $fsid
check_store "on loading season pass"
}
proc load_series {seriesfsid data} {
# To reduce store requirements we'll remove large and unnecessary fields
set data [filter_content $data "" "IndexPath IndexUsedBy"]
set ::restore_series($seriesfsid) $data
check_store "on loading series"
}
proc load_theme {fsid data} {
# To reduce store requirements we'll remove large and unnecessary fields
set data [filter_content $data "" "IndexPath IndexUsedBy"]
set ::restore_theme($fsid) $data
set ::restore_theme_by_name([agextract $data Name]) $fsid
check_store "on loading theme"
}
proc load_version {v} {
set ::restore_load_version $v
# This has been copied from the http-td.tcl module - it figures out if this
# backup was made on a version3 TiVo or not...
set ::restore_version3 0
if {[string range $::restore_load_version 0 2] >= 3.0} {
set ::restore_version3 1
}
check_store "on loading version"
}
proc automap_restore_stations {} {
global restore_station
global snapshot_station
# Loop through the channels we're restoring and write a agwMap fsid value
# that refers back to the channel on the TiVo we're currently running on. If
# the channel no longer exists then write a null agwMap entry. In order to
# keep things as quick as possible the snapshot stations are not looped in
# the main loop - the relevent TmsId and fsid are kept in a list and searched
set snapstat_fsid ""
set snapstat_tmsid ""
foreach snapfsid [array names snapshot_station] {
lappend snapstat_fsid $snapfsid
lappend snapstat_tmsid [agextract $snapshot_station($snapfsid) TmsId]
}
foreach restore_fsid [array names restore_station] {
set restore_data $restore_station($restore_fsid)
set tmsid [agextract $restore_data TmsId]
set map_fsid ""
set snap_element [lsearch -exact $snapstat_tmsid $tmsid]
if {$snap_element != -1} {
set map_fsid [lindex $snapstat_fsid $snap_element]
}
agappend restore_data agwMap fsid $map_fsid
if {$map_fsid == ""} {
agappend restore_data agwWasMissing bool 1
}
unset restore_station($restore_fsid)
set restore_station($restore_fsid) $restore_data
}
}
proc automap_restore_themes {} {
global restore_theme
global snapshot_theme
# Loop through the wishlists and see if there is already a wishlist entry for
# each one that was backed up. If there is then write this into agwMap for
# the restore. A missing agwMap indicates a wishlist that can be restored.
# A wishlist exists if there is another wishlist for the same name and type.
foreach restore_fsid [array names restore_theme] {
set restore_data $restore_theme($restore_fsid)
set restore_name [agextract $restore_data Name]
set restore_type [agextract $restore_data ThemeType]
set agwMap ""
foreach snapshot_fsid [array names snapshot_theme] {
set snapshot_data $snapshot_theme($snapshot_fsid)
if {[agextract $snapshot_data Name] == $restore_name} {
if {[agextract $snapshot_data ThemeType] == $restore_type} {
set agwMap $snapshot_fsid
break
}
}
}
agappend restore_data agwMap fsid $agwMap
if {$agwMap == ""} {
agappend restore_data agwRestore bool "1"
}
unset restore_theme($restore_fsid)
set restore_theme($restore_fsid) $restore_data
}
}
proc automap_restore_series {} {
# Loop through and see if this series is already on the TiVo. There is no
# snapshot of the series on the TiVo - there could be tons of them - so this
# will have to read the database
global restore_series
foreach restore_fsid [array names restore_series] {
set restore_data $restore_series($restore_fsid)
set agwMap [get_series_fsid $restore_data]
agappend restore_data agwMap fsid $agwMap
unset restore_series($restore_fsid)
set restore_series($restore_fsid) $restore_data
}
}
proc automap_restore_sps {} {
# Loop through the season passes we loaded in and figure out which ones can
# be restored and which ones can't. We can NEVER restore a season pass if it
# is already in the database - an SP is in the database if it is for a theme
# and there is already an SP for the theme, or if it is for a series and
# there is already an SP for the series AND channel.
#
# If the SP is missing then we need to make sure we have a good map for the
# channel it is for. If we don't then we can't restore it (at least until the
# user maps the channel).
#
# It is likely that this validation will take a long time.
global restore_sp
# Get the list of stations in the backup file - this is used to add dummy
# stations for any backup files affected by the pre-1.00.0005 bug that could
# leave some stations out of the backup file
global restore_station
global restore_station_by_num
set restore_stnlist [array names restore_station]
set next_unused_channel 0
foreach num [array names restore_station_by_num] {
if {$num > $next_unused_channel} {
set next_unused_channel $num
}
}
set next_unused_channel [expr $next_unused_channel + 1]
set remove_list_badthm ""
# Finally! Loop through the season passes
foreach restore_fsid [array names restore_sp] {
set restore_data $restore_sp($restore_fsid)
# There was a problem where one user (snoopy) had a backup that contained a
# season pass that referred to a non-existent wishlist. This was the only
# report so for the time being I'll test for it here and print a report but
# leave it out of the main summary. That way the rest of the backup will
# still work.
set restore_type [agextract $restore_data agwSPType]
set sp_removed 0
if {$restore_type == "Wishlist"} {
set chkthm_fsid [agextract $restore_data Theme]
if {[lsearch -exact [array names ::restore_theme] $chkthm_fsid] == -1} {
set sp_removed 1
lappend remove_list_badthm $restore_fsid
}
}
if {$sp_removed == 0} {
# Check that the station for this season pass is in the backup file. There
# was a problem whereby the station list could be incomplete
# (fixed 1.00.0005)
set station [agextract $restore_data Station]
if {$station != "" && [lsearch -exact $restore_stnlist $station] == -1} {
# Create a dummy entry in the restored stations list - the user will have
# to remap entries on this season pass
set content ""
agappend content agwChannelNum int $next_unused_channel
agappend content agwMap fsid ""
agappend content agwWasMissing bool 1
agappend content CallSign string "MISSING"
agappend content Name string "Missing"
agappend content TmsId string "agwMISSING"
set restore_station($station) $content
set restore_station_by_num($next_unused_channel) $station
lappend restore_stnlist $station
# Figure new unique channel number
set next_unused_channel [expr $next_unused_channel + 1]
}
# Loop through the snapshot season passes looking for a match for this one
# The FSID of the matching pass is written, as usual, into agwMap
set agwMap [find_matching_sp $restore_data]
# If the season pass can be restored then we need to see if the station it
# uses is good... if it has one that is...
agappend restore_data agwMap fsid $agwMap
set agwRestore 0
if {$agwMap == ""} {
if {[station_is_mapped $station]} {
set agwRestore 1
}
}
# Update the array
agappend restore_data agwRestore bool $agwRestore
unset restore_sp($restore_fsid)
set restore_sp($restore_fsid) $restore_data
}
}
# Remove any season passes that need zapping because they had a bad theme id
set ::restore_ignored_sp_badthm [llength $remove_list_badthm]
foreach badthm_fsid $remove_list_badthm {
unset restore_sp($badthm_fsid)
foreach badthm_priority [array names ::restore_sp_by_priority] {
set badthm_pri_fsid $::restore_sp_by_priority($badthm_priority)
if {$badthm_pri_fsid == $badthm_fsid} {
unset ::restore_sp_by_priority($badthm_priority)
break
}
}
}
}
proc find_matching_sp {restore_data} {
set result ""
set restore_type [agextract $restore_data agwSPType]
global snapshot_sp
foreach snapshot_fsid [array names snapshot_sp] {
if {[sp_matches $restore_data $snapshot_sp($snapshot_fsid) $restore_type]} {
# We have a match - if this is a series or wishlist SP then remove the
# SP to shorten future matches
set result $snapshot_fsid
if {$restore_type == "Series" || $restore_type == "Wishlist"} {
unset snapshot_sp($snapshot_fsid)
}
break
}
}
return $result
}
proc sp_matches {restore snapshot restore_type} {
set result 0
if {$restore_type == [agextract $snapshot agwSPType]} {
switch -exact $restore_type {
Series {
set restore_fsid [agextract $restore Series]
set snapshot_fsid [agextract $snapshot Series]
if {[are_same_series $restore_fsid $snapshot_fsid]} {
# The series match... do the channels match?
set rstn [extract_station $restore ::restore_station]
set sstn [extract_station $snapshot ::snapshot_station]
if {[agextract $rstn TmsId] == [agextract $sstn TmsId]} {
set result 1
}
}
}
Wishlist {
set restore_fsid [agextract $restore Theme]
set snapshot_fsid [agextract $snapshot Theme]
set result [are_same_theme $restore_fsid $snapshot_fsid]
}
Manual {
set result [are_same_manual $restore $snapshot]
}
default {
set result 0
}
}
}
return $result
}
proc get_unmapped_stations_count {} {
global restore_station
return [get_empty_agwMap_count restore_station]
}
proc get_missing_theme_count {} {
global restore_theme
return [get_empty_agwMap_count restore_theme]
}
proc get_missing_sp_count {} {
global restore_sp
return [get_empty_agwMap_count restore_sp]
}
proc get_restore_theme_count {} {
global restore_theme
return [get_restore_count restore_theme]
}
proc get_restore_sp_count {} {
global restore_sp
return [get_restore_count restore_sp]
}
proc get_empty_agwMap_count {arrref} {
upvar $arrref arr
set result 0
foreach fsid [array names arr] {
if {[agextract $arr($fsid) agwMap] == ""} {
incr result
}
}
return $result
}
proc get_restore_count {arrref} {
upvar $arrref arr
set result 0
foreach fsid [array names arr] {
set data $arr($fsid)
if {[agextract $data agwMap] == "" && [agextract $data agwRestore]} {
incr result
}
}
return $result
}
proc present_backup {chan} {
global restore_series
global restore_station
global restore_sp
global restore_theme
puts $chan [html_table_start "" "Backup Contents" "COLSPAN=2"]
puts $chan [tr "" [td "Blocks / bytes before loading file"] [td "$::restore_cbl1 / $::restore_cby1"]]
puts $chan [tr "" [td "Backup file"] [td "$::restore_fname"]]
puts $chan [tr "" [td "Creation date and time"] [td $::restore_backup_date]]
puts $chan [tr "" [td "Version of TiVo that produced backup"] [td $::restore_load_version]]
puts $chan [tr "" [td "Version of backup file layout"] [td $::restore_layout_version]]
puts $chan [tr "" [td "Time taken to load backup file"] [td $::timing_load_file]]
puts $chan [tr "" [td "Time taken to validate stations"] [td $::timing_automap_stations]]
puts $chan [tr "" [td "Time taken to validate wishlists"] [td $::timing_automap_themes]]
puts $chan [tr "" [td "Time taken to validate series"] [td $::timing_automap_series]]
puts $chan [tr "" [td "Time taken to validate season passes"] [td $::timing_automap_sps]]
puts $chan [tr "" [td "Number of season pass channels in lineup at time of backup"] [td [array size restore_station]]]
puts $chan [tr "" [td "Number of wishlists in backup"] [td [array size restore_theme]]]
puts $chan [tr "" [td "Number of unique series in backup"] [td [array size restore_series]]]
puts $chan [tr "" [td "Number of season passes in backup"] [td [array size restore_sp]]]
if {$::restore_ignored_sp_badthm != 0} {
puts $chan [tr "" [td "Number of ignored season passes thru missing wishlists"] [td $::restore_ignored_sp_badthm]]
}
show_store_usage_row $chan "currently free"
puts $chan [html_table_end]
set unmapped_stations [get_unmapped_stations_count]
if {$unmapped_stations != 0} {
puts $chan "There are $unmapped_stations unmapped channels. Click"
puts $chan [html_link "/backup_show_station" "here"]
puts $chan "to map them to the channels you now have.
"
}
set count_restore_themes [get_restore_theme_count]
puts $chan "There are currently $count_restore_themes wishlists to restore. Click"
puts $chan [html_link "/backup_show_theme" "here"]
puts $chan "to examine the wishlists.
"
set count_restore_sp [get_restore_sp_count]
puts $chan "There are currently $count_restore_sp season passes to restore. Click"
puts $chan [html_link "/backup_show_sp" "here"]
puts $chan "to examine the season passes.
"
set orphans [get_orphaned_series]
set orphan_count [llength $orphans]
# Show the restore button if we've got anything to restore
puts $chan "
"
if {$orphan_count != 0} {
puts $chan ""
puts $chan "There are orphaned series - any season pass attached to an"
puts $chan "orphaned series will be SKIPPED. You should examine the"
puts $chan [html_link "/backup_show_series" "series"]
puts $chan "link and run a deep search to fathom the correct identifiers"
puts $chan "for the orphans.
"
puts $chan ""
}
if {[get_missing_sp_count] == 0 && [get_missing_theme_count] == 0} {
puts $chan "All of the wishlists and season passes in this backup file are"
puts $chan "already on the TiVo. There is nothing to restore.
"
} else {
puts $chan [html_form_start "POST" "/backup_perform_restore"]
puts $chan "Use the links above to select the wishlists and season passes"
puts $chan "you want to restore, and then click the 'Restore' button below"
puts $chan "when you're ready:
"
puts $chan [html_form_input "submit" "submit" "Restore"]
puts $chan [html_form_end]
}
show_link_backup_menu $chan
puts $chan [html_end]
}
proc get_default_backup_dir {} {
global source_dir
global global_backup_default_dir
# Create the default backup directory on the TiVo, if not already there
# and if we can't manage it (bad perms etc.) fallback to /tmp
set result $global_backup_default_dir
if {![file isdirectory $result]} {
catch {file mkdir $result}
if {![file isdirectory $result]} {
set result "/tmp"
}
}
set result [ensure_absolute_path $result]
return $result
}
proc validate_file {chan fname is_write} {
set failmsg ""
# In all cases they must not supply a directory name
if {[file isdirectory $fname]} {
set failmsg "$fname is a directory - you must supply a filename"
} else {
# All the other tests rather depend on whether this is a read or a write
if {$is_write} {
# Does the file exist? If so then check perms. If not then create it and
# check result
if {[file exists $fname]} {
if {![file writable $fname]} {
set failmsg "$fname cannot be overwritten - please choose another file"
}
}
} else {
# We're reading the file - it has to exist and be readable
if {![file exists $fname]} {
set failmsg "$fname does not exist - please choose a file that exists"
} elseif {![file readable $fname]} {
set failmsg "$fname exists, but permissions stop it from being read"
}
}
}
set result 1
if {$failmsg != ""} {
puts $chan "$failmsg"
set result 0
}
return $result
}
proc validate_is_backup_file {chan fname} {
set result 0
set fd 0
if {[open_file fd $chan $fname 0]} {
set magic_number [read $fd [string length $::global_backup_magic_number]]
close $fd
set result 1
if {$magic_number != $::global_backup_magic_number} {
puts $chan "$fname is not a TiVo Web backup file"
set result 0
}
}
return $result
}
proc open_file {handleref chan fname is_write} {
upvar $handleref fd
set flags r
if {$is_write} {
set flags w
}
set result 1
set failed [catch {set fd [open $fname $flags]}]
if {$failed == 1} {
puts $chan "Cannot open $fname"
set result 0
}
return $result
}
proc construct_record_content {dbobjid fields} {
set result ""
foreach field $fields {
# Get the basic information
set field_type [dbobj $dbobjid attrtype $field]
set field_value [dbobj $dbobjid get $field]
set subvalue ""
if {$field_type == "object"} {
foreach sub $field_value {
set subfsid [dbobj $sub fsid]
lappend subvalue $subfsid
}
set field_type fsid
set field_value $subvalue
}
# Add the field, type and value to the list
lappend result $field $field_type $field_value
}
return $result
}
proc agcount {source} {
set result [expr [llength $source] / 3]
return $result
}
proc agextract {source field} {
set items [expr [llength $source] / 3]
for {set i 0; set element 0} {$i < $items} {incr i; incr element 3} {
if {[lindex $source $element] == $field} {
return [lindex $source [expr $element + 2]]
}
}
return ""
}
proc agexists {source field} {
set result 0
set items [agcount $source]
for {set i 0} {$i < $items} {incr i} {
set element [expr $i * 3]
set ifield [lindex $source $element]
if {$ifield == $field} {
set result 1
break
}
}
return $result
}
proc agfindelement {arrref field value} {
upvar $arrref arr
set result ""
foreach element [array names arr] {
set field_value [agextract $arr($element) $field]
if {$field_value == $value} {
set result $element
break
}
}
return $result
}
proc agwrite {sourceref field type value} {
upvar $sourceref source
set items [agcount $source]
set replaced 0
for {set i 0} {$i < $items} {incr i} {
set element [expr $i * 3]
set ifield [lindex $source $element]
if {$ifield == $field} {
set source [lreplace $source [expr $element + 1] [expr $element + 2] $type $value]
set replaced 1
break
}
}
if {$replaced == 0} {
lappend source $field $type $value
}
}
proc agprepend {sourceref field type value} {
upvar $sourceref source
lappend result $field $type $value $source
set source $result
}
proc agappend {sourceref field type value} {
upvar $sourceref source
lappend source $field $type $value
}
proc agremove {sourceref field} {
upvar $sourceref source
set items [agcount $source]
for {set i 0} {$i < $items} {incr i} {
set element [expr $i * 3]
set ifield [lindex $source $element]
if {$ifield == $field} {
set source [lreplace $source $element [expr $element + 2]]
break
}
}
}
proc wishlist_type_labels {} {
return "Keyword Actor Director Advanced Category Title"
}
proc agtime {script} {
set result [time {$script}]
set result [lindex $result 0]
set result [expr $result / 1000000.0]
set result "$result seconds"
return $result
}
proc get_series_fsid {data} {
global temporary_series_by_tmsid
set result [agextract $data agwMap]
if {$result == ""} {
# Because no snapshot is taken of the series we should always check the db
# if we've not found an FSID for the show up until now...
set tmsid [agextract $data TmsId]
if {$tmsid != ""} {
# Try the server ID first - easier but may fail over version differences
set fsid [serverid_to_fsid [agextract $data ServerId] $tmsid]
if {$fsid == ""} {
set fsid [safe_tms_to_fsid $tmsid]
}
if {$fsid == "" || $fsid < 0} {
# Can't find it in the guide data - is it in the temporary list?
if {[lsearch -exact [array names temporary_series_by_tmsid] $tmsid] != -1} {
set fsid $temporary_series_by_tmsid($tmsid)
} else {
set fsid ""
}
}
set result $fsid
if {$fsid != ""} {
RetryTransaction {
set series_data [db $::db openid $fsid]
set series_fields [dbobj $series_data attrs]
set content [construct_record_content $series_data $series_fields]
snapshot_add_series $fsid $content 0
}
}
}
}
return $result
}
proc are_same_theme {restore_fsid snapshot_fsid} {
global restore_theme
set restore_data $restore_theme($restore_fsid)
return [are_same_agwMap $restore_data $snapshot_fsid]
}
proc are_same_series {restore_fsid snapshot_fsid} {
global snapshot_series
global restore_series
set restore_data $restore_series($restore_fsid)
set result [are_same_agwMap $restore_data $snapshot_fsid]
if {!$result && $snapshot_fsid != ""} {
# If the user is suffering from orphan series then the fsid's could be
# different but the TMSID the same...
set snapshot_data $snapshot_series($snapshot_fsid)
if {[agextract $snapshot_data TmsId] == [agextract $restore_data TmsId]} {
set result 1
}
}
return $result
}
proc are_same_agwMap {restore_data snapshot_fsid} {
set restore_map [agextract $restore_data agwMap]
set result 0
if {$restore_map == $snapshot_fsid} {
set result 1
}
return $result
}
proc are_same_manual {restore snapshot} {
# Are they for the same channel?
set result 0
set rs [extract_station $restore ::restore_station]
set ss [extract_station $snapshot ::snapshot_station]
if {$rs != "" && $ss != ""} {
if {[agextract $rs TmsId] == [agextract $ss TmsId]} {
# OK, they're the same station. Do the recording days overlap?
set rdow [agextract $restore DayOfWeekLocal]
set sdow [agextract $snapshot DayOfWeekLocal]
set dowmatch 0
foreach dow $rdow {
if {[lsearch $sdow $dow] != -1} {
set dowmatch 1
break
}
}
if {$dowmatch} {
# Same station and same day. Do the times overlap?
set rstart [agextract $restore StartTimeLocal]
set sstart [agextract $snapshot StartTimeLocal]
set rend [expr $rstart + [agextract $restore Duration]]
set ssend [expr $sstart + [agextract $snapshot Duration]]
if {($rstart >= $sstart && $rstart <= $ssend) || ($rend >= $sstart && $rend <= $ssend)} {
# We have a match...
set result 1
}
}
}
}
return $result
}
proc extract_station {data arrref} {
upvar $arrref arr
set result ""
set station [agextract $data Station]
if {$station != ""} {
set result $arr($station)
}
return $result
}
proc station_is_mapped {fsid} {
# A station is mapped if it is missing (i.e. it came from a wishlist SP) or
# if the fsid we were sent corresponds to a mapped entry in restore_station.
global restore_station
set result 1
if {$fsid != ""} {
set result 0
set data $restore_station($fsid)
if {[agextract $data agwMap] != ""} {
set result 1
}
}
return $result
}
proc sptype {sp} {
set result "Unknown"
switch -exact [agextract $sp Type] {
1 {set result "Series"}
2 {set result "Manual"}
3 {set result "Wishlist"}
default {
if {[agexists $sp Series]} {
set result "Series"
} elseif {[agexists $sp Theme]} {
set result "Theme"
} elseif {[agexists $sp DayOfWeek]} {
set result "Manual"
}
}
}
return $result
}
proc get_sp_name {data use_restore} {
switch -exact [agextract $data agwSPType] {
Series {
set series_fsid [agextract $data Series]
set series [get_series $series_fsid $use_restore]
set result [agextract $series Title]
}
Wishlist {
set theme_fsid [agextract $data Theme]
set theme [get_theme $theme_fsid $use_restore]
set result [agextract $theme Name]
}
Manual {
set result [get_manual_description $data]
}
default {
set result "Unknown"
}
}
return [string trim $result "{}"]
}
proc get_series {fsid use_restore} {
set result ""
if {$use_restore} {
global restore_series
set result $restore_series($fsid)
} else {
global db
RetryTransaction {
set series [db $db openid $fsid]
set fields [dbobj $series attrs]
set result [construct_record_content $series $fields]
}
}
return $result
}
proc get_theme {fsid use_restore} {
set result ""
if {$use_restore} {
global restore_theme
set result $restore_theme($fsid)
} else {
global snapshot_theme
set result $snapshot_theme($fsid)
}
return $result
}
proc get_manual_description {data} {
set dow [agextract $data DayOfWeekLocal]
set datelabel "Sun Mon Tue Wed Thu Fri Sat"
set days ""
switch -exact [llength $dow] {
7 {set days "Every Day"}
5 {set days "Mon-Fri"}
default {
foreach day $dow {
if {$day != ""} {
set days "$days "
}
set days "$days[lindex $datelabel $day]"
}
}
}
global tzoffset
set start [agextract $data StartTimeLocal]
set start [expr $start - $tzoffset]
set start_time [agdispsecs $start]
set end [expr $start + [agextract $data Duration]]
set end_time [agdispsecs $end]
set result "$days $start_time-$end_time"
return $result
}
proc agdispsecs {secs} {
set hours [expr $secs / 3600]
set secs [expr $secs - ($hours * 3600)]
set mins [expr $secs / 60]
# If I ever need the seconds it's... set secs [expr secs - ($mins * 60)]
return [format "%02d:%02d" $hours $mins]
}
proc get_sp_station {data use_restore} {
if {$use_restore} {
global restore_station
set station [extract_station $data restore_station]
} else {
global snapshot_station
set station [extract_station $data snapshot_station]
}
return $station
}
proc get_sp_callsign {data use_restore} {
set station [get_sp_station $data $use_restore]
set callsign [agextract $station CallSign]
if {$callsign == ""} {
set callsign "Any"
}
return $callsign
}
proc get_sp_status {data use_restore} {
set station [get_sp_station $data $use_restore]
set result ""
if {[agextract $data agwMap] != ""} {
set result "Already on TiVo"
} else {
set stnmap [agextract $station agwMap]
if {$station != "" && $stnmap == ""} {
set result "Channel no longer exists"
} else {
set result "Restorable"
if {$station != ""} {
global snapshot_station
set sstn $snapshot_station($stnmap)
set sstn_callsign [agextract $sstn CallSign]
# Check that the season pass isn't already on the channel they're
# mapped to
set agwReMap [agextract $data agwReMap]
if {$agwReMap != "" && $agwReMap != "0"} {
set result "Already on TiVo
(after remap to $sstn_callsign)"
} else {
if {[agextract $station CallSign] != $sstn_callsign} {
set result "$result to $sstn_callsign"
}
}
}
}
}
return $result
}
proc perform_restore_themes {chan} {
global restore_theme
global restore_theme_by_name
set good_count 0
set bad_count 0
foreach name [lsort [array names restore_theme_by_name]] {
set fsid $restore_theme_by_name($name)
set theme $restore_theme($fsid)
set agwMap [agextract $theme agwMap]
set agwRestore [agextract $theme agwRestore]
if {$agwMap == "" && $agwRestore == "1"} {
if {![conditional_restore_theme $chan $fsid]} {
incr bad_count
} else {
incr good_count
set name [string trim [agextract $theme Name] "{}"]
puts $chan "Restored wishlist $name
"
}
}
}
puts $chan "Restored $good_count wishlists"
if {$bad_count} {
puts $chan "and failed to restore $bad_count!"
}
puts $chan "
"
}
proc perform_restore_sps {chan} {
global restore_sp
global restore_sp_by_priority
# Get the list of orphaned series - we skip anything that is in this list!
set orphans [get_orphaned_series]
set good_count 0
set bad_count 0
foreach priority [lsort -dictionary [array names restore_sp_by_priority]] {
set fsid $restore_sp_by_priority($priority)
set sp $restore_sp($fsid)
set agwMap [agextract $sp agwMap]
set agwRestore [agextract $sp agwRestore]
if {($agwMap == "" || $agwMap == "0") && $agwRestore == "1"} {
if {[station_is_mapped [agextract $sp Station]]} {
set type [sptype $sp]
set name [get_sp_name $sp 1]
set series [agextract $sp Series]
if {$series != "" && [lsearch -exact $orphans $series] != -1} {
puts $chan "SKIPPING $type season pass $name
"
puts $chan "It is associated with an orphaned series
"
} else {
if {[conditional_restore_theme $chan [agextract $sp Theme]]} {
if {[conditional_restore_series $chan [agextract $sp Series]]} {
set real_priority [establish_next_priority]
agwrite sp Priority int $real_priority
set agwMap [create_object $chan SeasonPass $sp]
agwrite sp Priority int $priority
if {$agwMap == "" || $agwMap == 0} {
incr bad_count
} else {
incr good_count
puts $chan "Restored $type season pass $name
"
event send $TmkEvent::EVT_DATA_CHANGED $TmkDataChanged::SEASON_PASS $agwMap
}
agwrite sp agwMap fsid $agwMap
unset restore_sp($fsid)
set restore_sp($fsid) $sp
}
}
}
}
}
}
puts $chan "Restored $good_count season passes"
if {$bad_count} {
puts $chan "and failed to restore $bad_count!"
}
puts $chan "
"
if {$good_count} {
puts $chan "It may take some time to schedule the new season passes
"
}
puts $chan "
"
}
proc conditional_restore_theme {chan fsid} {
global restore_theme
set created_item 0
return [conditional_restore $chan $fsid Theme restore_theme created_item]
}
proc conditional_restore_series {chan fsid} {
global restore_series
set created_item 0
set result [conditional_restore $chan $fsid Series restore_series created_item]
if {$created_item} {
global temporary_series_by_tmsid
set series $restore_series($fsid)
set tmsid [agextract $series TmsId]
set agwMap [agextract $series agwMap]
set temporary_series_by_tmsid($tmsid) $agwMap
# That database has been changed... make damn sure we record the new fsid
# right away, just in case the script goes arse over tit and we forget the
# fsid in a future run
save_temporary_series
# Finally just run the ID through get_series_fsid so that it gets read into
# the snapshot, just in case the user displays series details later on
agremove series agwMap
get_series_fsid $series
}
return $result
}
proc conditional_restore {chan fsid object_id arrref ciref} {
set result 1
upvar $ciref created_item
set created_item 0
if {$fsid != "" && $fsid != "0"} {
upvar $arrref arr
set object $arr($fsid)
set agwMap [agextract $object agwMap]
if {$agwMap == "" || $agwMap == "0"} {
set agwMap [create_object $chan $object_id $object]
if {$agwMap == "" || $agwMap == "0"} {
set result 0
} else {
agwrite object agwMap fsid $agwMap
set arr($fsid) $object
set created_item 1
}
}
}
return $result
}
proc create_object {chan object_id object} {
# The basis of this code was lifted from the original backup routine by Angra
set result ""
# Check that we're not going to run out of store while we're doing this
check_store "BEFORE creating an object"
# Make absolutely positively sure that every object this object refers to is
# now in the database
if {[validate_references $object_id $object]} {
# OK - we're good. Start the transaction.
global db
RetryTransaction {
# Create the object - this starts off empty...
global global_backup_nowrite
set global_backup_nowrite 0
if {!$global_backup_nowrite} {
set new_object [db $db create $object_id]
set fsid [dbobj $new_object fsid]
puts $chan "Created new $object_id (fsid $fsid)
"
} else {
puts $chan "set new_object \[db \$db create \$object_id ($object_id)\]
"
set fsid 1
}
# Now loop through the members of the object and fill it in
set item_count [agcount $object]
for {set i 0} {$i < $item_count} {incr i} {
# Extract the field and value
set element [expr $i * 3]
set field [lindex $object $element]
set type [lindex $object [expr $element + 1]]
set value [lindex $object [expr $element + 2]]
# If the version that made the backup isn't the same as current then
# check to see if we need to rename the field or normalise the value
if {$::version3 != $::restore_version3} {
modify_field_for_version $object_id field type value
}
# If the field is one of my internal fields then discard it
if {$field == "agwMap" || $field == "agwReMap" || $field == "agwRestore" || $field == "agwSPType"} {
continue
}
# If we're inserting a theme and this is the IndexUsedBy or SeasonPass
# items them discard them both... we're just inserting a plain theme
if {[can_skip_field $object_id $field]} {
continue
}
# If the type is an index then retrieve the mapped value
if {$type == "fsid"} {
set value [get_map_value $field $value]
set value [db $db openid $value]
}
# If the value is a string then add it in one go
if {$type == "string"} {
set goodvalue [string trim $value "{}"]
if {$global_backup_nowrite} {
puts $chan " dbobj \$new_object set \$field ($field) \$goodvalue ($goodvalue)
"
} else {
puts $::global_trace "Setting $field $goodvalue
"
dbobj $new_object set $field $goodvalue
}
} else {
# Add the value(s - could be a list) to the object
set index 0
foreach subvalue $value {
if {$index == 0} {
if {$global_backup_nowrite} {
puts $chan " dbobj \$new_object set \$field ($field) \$subvalue ($subvalue)
"
} else {
puts $::global_trace "Setting $field $subvalue
"
dbobj $new_object set $field $subvalue
}
} else {
if {$global_backup_nowrite} {
puts $chan " dbobj \$new_object add \$field ($field) \$subvalue ($subvalue)
"
} else {
puts $::global_trace "(adding to $field - $subvalue)
"
dbobj $new_object add $field $subvalue
}
}
incr index
}
}
}
set result $fsid
}
}
return $result
}
proc modify_field_for_version {object_id fieldref typeref valueref} {
# At the moment we only care about season passes. If we're currently running
# on V3 then (at time of writing) the backup must be V2, so check for the
# FirstRun field and rename it. Ditto the other way, if we're on V2 then the
# backup must be V3 if we're here, so rename ShowStatus to FirstRun and check
# for the V3-only value "2"... nearest equiv. is 0
if {$object_id == "SeasonPass"} {
upvar $fieldref field
if {$::version3 && $field == "FirstRun"} {
set field "ShowStatus"
} elseif {$::restore_version3 && $field == "ShowStatus"} {
set field "FirstRun"
upvar $valueref value
if {$value == "2"} {
set value "0"
}
}
}
}
proc validate_references {object_id object} {
global restore_theme
global restore_series
set result 1
set item_count [agcount $object]
for {set i 0} {$result && $i < $item_count} {incr i} {
set element [expr $i * 3]
set type [lindex $object [expr $element + 1]]
if {$type == "fsid"} {
set field [lindex $object $element]
set value [lindex $object [expr $element + 2]]
if {![can_skip_field $object_id $field]} {
switch $field {
Theme {
global restore_theme
set result [validate_stored_reference restore_theme $field $object_id $object $value]
}
Station {
global restore_station
set result [validate_stored_reference restore_station $field $object_id $object $value]
}
Series {
global restore_series
set result [validate_stored_reference restore_series $field $object_id $object $value]
}
agwMap {}
agwReMap {}
default {
puts $::global_trace "
Unknown sub-object $field seen for $object_id $object
"
puts $::global_trace "SKIPPING THE ABOVE OBJECT - IT WILL NOT BE RESTORED
"
set result 0
}
}
}
}
}
return $result
}
proc validate_stored_reference {arrref field object_id object value} {
set result 1
upvar $arrref arr
set sub_object $arr($value)
set agwMap [agextract $sub_object agwMap]
if {$agwMap == "" || $agwMap == "0"} {
puts $::global_trace "
Unrestored $field seen for $object_id $object
"
puts $::global_trace "SKIPPING THIS OBJECT - IT WILL NOT BE RESTORED
"
set result 0
}
return $result
}
proc get_map_value {field value} {
set result ""
# These should all have been validated before we get here, so SHOULD be
# plain sailing...
switch $field {
Theme {
global restore_theme
set theme $restore_theme($value)
set result [agextract $theme agwMap]
}
Series {
global restore_series
set series $restore_series($value)
set result [agextract $series agwMap]
}
Station {
global restore_station
set station $restore_station($value)
set result [agextract $station agwMap]
}
default {}
}
return $result
}
proc can_skip_field {object_id field} {
set result 0
# Any of the IndexPath / IndexUsedBy / IndexUsed etc. fields can be discounted
if {[regexp "^Index" $field]} {
set result 1
} elseif {$object_id == "Theme" && $field == "SeasonPass"} {
set result 1
} elseif {$object_id == "Series" && $field == "SeriesStationOBSOLETE"} {
set result 1
}
return $result
}
# Based on CreateSeasonPass in sched.itcl, except this version will cope with
# there being no season passes... the original returned a base priority of 1,
# not 0
proc establish_next_priority {} {
set result 0
global seasonpassdir
ForeachMfsFile fsid name type $seasonpassdir "" {
scan $name "%d~%d" num dummy
if {$num >= $result} {
set result [expr $num + 1]
}
}
return $result
}
proc load_temporary_series {} {
global temporary_series_by_tmsid
reset_load_array temporary_series_by_tmsid 0
set fname "[get_default_backup_dir]/$::global_temporary_series_fname"
if {[file exists $fname]} {
source $fname
perform_load_temporary_series temporary_series_by_tmsid
# We have the list in store... we now need to go through and check that
# everything is in order
global db
foreach tmsid [array names temporary_series_by_tmsid] {
set fsid $temporary_series_by_tmsid($tmsid)
set remove_record 0
# Is it in the TMS index? If so then we can ditch it from this
set guide_fsid [safe_tms_to_fsid $tmsid]
if {$guide_fsid >= 0} {
set remove_record 1
} else {
# Is this file so old that the fsid has since been wiped by the TiVo? If
# so then we will need to recreate the series, so we can't have it here
RetryTransaction {
set obj ""
if {[catch {set obj [db $db openid $fsid]}]} {
# It errored... we'll assume it isn't there
set remove_record 1
}
}
}
# Remove the record if we no longer require it
if {$remove_record} {
unset temporary_series_by_tmsid($tmsid)
}
}
}
}
proc save_temporary_series {} {
set fname "[get_default_backup_dir]/$::global_temporary_series_fname"
set fd 0
if {![catch {set fd [open $fname w]}]} {
puts $fd "# $::global_temporary_series_fname"
puts $fd "# This is a temporary file generated by backup.itcl - it holds a list of the"
puts $fd "# series restored by the backup module. These series will not show up in the"
puts $fd "# list of series held by the TiVo until after the next re-index, a few hours"
puts $fd "# after the next call home. Until then backup.itcl cannot quickly find out"
puts $fd "# if the series exists on the TiVo. So it keeps a list internally of all of"
puts $fd "# the series that it creates, and it stores it in this file. If it doesn't"
puts $fd "# find the series on the TiVo then it checks this file before it creates a"
puts $fd "# new series. Every time it loads this file it checks to see whether the"
puts $fd "# series in here is now indexed, and so no longer required. If it is - it"
puts $fd "# it removes it from the file."
puts $fd "#"
puts $fd "# The short version of the spiel is - please do not edit this file"
# Whew! Now to actually do some work. I wonder if anyone will read that?
puts $fd ""
puts $fd "proc perform_load_temporary_series \{arrref\} \{"
puts $fd " upvar \$arrref arr"
global temporary_series_by_tmsid
foreach tmsid [array names temporary_series_by_tmsid] {
set fsid $temporary_series_by_tmsid($tmsid)
puts $fd " set arr($tmsid) $fsid"
}
puts $fd "\}"
close $fd
}
}
proc get_orphaned_series {} {
global restore_series
global snapshot_series
set result ""
foreach fsid [array names restore_series] {
set series $restore_series($fsid)
set agwMap [agextract $series agwMap]
if {$agwMap != ""} {
set real $snapshot_series($agwMap)
set indexpath [agextract $real IndexPath]
if {[regexp "^/Database/Orphan" $indexpath]} {
lappend result $fsid
}
}
}
return $result
}
proc filter_content {content include_fields exclude_fields} {
set result ""
# Save time - is this an "include only include_fields" or "include everything
# except the exclude fields"?
set include_all_but 1
set exclude_all_but 0
if {$include_fields != ""} {
set include_all_but 0
set exclude_all_but 1
}
# Loop through every field
set items [agcount $content]
for {set i 0} {$i < $items} {incr i} {
set element [expr $i * 3]
set field [lindex $content $element]
# Does this field get included?
set do_include 0
if {$include_all_but} {
set do_include 1
if {[lsearch -exact $exclude_fields $field] != -1} {
set do_include 0
}
} else {
set do_include 0
if {[lsearch -exact $include_fields $field] != -1} {
set do_include 1
}
}
if {$do_include} {
set type [lindex $content [expr $element + 1]]
set value [lindex $content [expr $element + 2]]
lappend result $field $type $value
}
}
return $result
}
proc check_store {msg} {
return
set result 1
get_store_usage blocksfree memfree
global global_trace
if {$blocksfree < 500} {
puts $global_trace "
Cannot continue - less than 500 blocks free in the pool $msg"
set result 0
}
if {$memfree < 16000} {
puts $global_trace "
Cannot continue - less than 16K free in the pool $msg"
set result 0
}
if {!$result} {
# Running low on store, stop the backup or restore
# Easiest way for now is to force a parser error
puts $global_trace "
Forcing an 'INTERNAL SERVER ERROR' to stop the module now"
stopthisscriptnow
}
}
set global_pinfo_good 0
set global_pinfo_est 0
proc get_store_usage {blocksfreeref memfreeref} {
upvar $blocksfreeref blocksfree
upvar $memfreeref memfree
set blocksfree 0
set memfree 0
# Just in case this pool stuff only works on some versions of the TiVo we'll
# do a check, first time in, to see if the call looks alright
global global_pinfo_good
global global_pinfo_est
if {!$global_pinfo_est} {
set global_pinfo_good 0
set global_pinfo_est 1
if {![catch {set phandles [pool handles]}]} {
if {$phandles != ""} {
set phandle [lindex $phandles 0]
if {![catch {set pinfo [pool $phandle info]}]} {
if {[llength $pinfo] > 7 } {
if {[lindex $pinfo 0] == "nblocks" && [lindex $pinfo 2] == "maxblocks"} {
if {[lindex $pinfo 4] == "nbytes" && [lindex $pinfo 6] == "maxbytes"} {
set global_pinfo_good 1
}
}
}
}
}
}
}
if {!$global_pinfo_good} {
# Can't trust it - disable memory checks with reasonable figures
set blocksfree 99999
set memfree 99999
} else {
foreach p [pool handles] {
set pinfo [pool $p info]
set nblocks [lindex $pinfo 1]
set maxblocks [lindex $pinfo 3]
set nbytes [lindex $pinfo 5]
set maxbytes [lindex $pinfo 7]
set blocksfree [expr $blocksfree + ($maxblocks - $nblocks)]
set memfree [expr $memfree + ($maxbytes - $nbytes)]
}
}
}
proc show_store_usage_row {chan msg} {
return
get_store_usage blocks bytes
puts $chan [tr "" [td "Blocks / bytes free $msg"] [td "$blocks / $bytes"]]
}
proc show_store_usage_text {chan} {
return
get_store_usage blocks bytes
puts $chan "
($blocks blocks and $bytes bytes free)"
}
proc show_store_usage_text_2 {chan msg} {
get_store_usage blocks bytes
puts $chan "$blocks blocks / $bytes bytes free $msg
"
}
proc serverid_to_fsid {serverid tmsid} {
set result ""
if {$serverid != "" && $tmsid != ""} {
RetryTransaction {
if {![catch {mfs find "/Server/$serverid"} res]} {
if {![catch {set series [db $::db openid [lindex $res 0]]}]} {
if {[dbobj $series type] == "Series"} {
if {[dbobj $series get TmsId] == $tmsid} {
set result [dbobj $series fsid]
}
}
}
}
}
}
return $result
}
proc trim_station_list {} {
# This is called after the snapshots of the stations and season passes has
# been taken for a backup. It removes those stations that are not used by
# any season pass.
#
# As well as trimming unused stations this function will also add in any
# stations that TiVo Web didn't pick up
global snapshot_station
global snapshot_station_by_num
global snapshot_sp
global db
# Figure out the next unused channel number, just in case we need to add one
set next_unused_channel 0
foreach num [array names snapshot_station_by_num] {
if {$num > $next_unused_channel} {
set next_unused_channel $num
}
}
set next_unused_channel [expr $next_unused_channel + 1]
# To save time get the list of station fsid's
set stnfsid [array names snapshot_station]
set copyfsid ""
# Loop through the season passes taken in the backup
foreach fsid [array names snapshot_sp] {
set sp $snapshot_sp($fsid)
set station [agextract $sp Station]
if {$station != ""} {
# Have we already copied this station?
if {[lsearch -exact $copyfsid $station] == -1} {
# Is this station in the snapshot?
if {[lsearch -exact $stnfsid $station] == -1} {
# The station doesn't exist in the snapshot - add it
RetryTransaction {
set new_station [db $db openid $station]
set fields [dbobj $new_station attrs]
set content [construct_record_content $new_station $fields]
snapshot_add_station $station $content $next_unused_channel 1
lappend stnfsid $station
set next_unused_channel [expr $next_unused_channel + 1]
}
}
# Copy this station into the list of copied stations
lappend copyfsid $station
}
}
}
# Destroy the entries in the snapshot arrays that are not in the copy list
foreach fsid [array names snapshot_station] {
if {[lsearch -exact $copyfsid $fsid] == -1} {
unset snapshot_station($fsid)
}
}
# Had a bit of a wierd error report whereby a _by_num element referred back
# to an fsid that wasn't there. Can only think that the wipe above of _by_num
# was incomplete. So now I go through each by_num and explicitly zap those
# that aren't in the fsid list, as opposed to extracting the channel number
# above and zapping that
foreach num [array names snapshot_station_by_num] {
set num_fsid $snapshot_station_by_num($num)
if {[lsearch -exact $copyfsid $num_fsid] == -1} {
unset snapshot_station_by_num($num)
}
}
}
# tms_to_fsid is an experimental function in tivo web that is not used by any
# other module. It maps the TMS ID bad to an FSID. TMS IDs seem to be constant
# over different releases of TiVo software, whereas the ServerID is not, so we
# prefer them to ServerID. However we have to make sure we can cope if the
# function fails. All calls to it pass through here and this function makes
# sure it copes with unexpected failures.
#
# If you change this to just return 0 then the rest of the module will cope -
# it will use the ServerID, which will work if the software versions remain
# constant between backup and restore, and if that fails it will tell the user
# to do a deep search.
proc safe_tms_to_fsid {tmsid} {
# return 0
# Remove the hash from the line above to stop the module using tms_to_fsid
# The code below calls tms_to_fsid and returns 0 if it has a total breakdown
set result 0
if {[catch {set result [tms_to_fsid $tmsid]}]} {
set result 0
}
return $result
}
# This function processes calls to the backup module that happen because we
# were called with a URL of "/backup/YADDA" - this gets the "/YADDA" part and
# processes it. I'm using it to dump the file out through the browser. This
# is probably a big security hole if the TiVo is on the Internet! I may have
# to have an option to turn this off or something.
proc process_root_path {chan path formatted} {
# Remove the hash from the line below if this function makes you nervous:
# return
# Remove the trailing slash from the filename. I had to put this in here so
# that files with full-stops in them wouldn't cause TiVoWeb to issue error
# 401
#
# After playing around I noticed that the trailing slash is ignored when the
# file gets opened, so strictly speaking I don't need this bit. I think I'll
# leave it in though, just in case.
global global_root_token
set path [string trimright $path "/"]
if {$path == "/$global_root_token"} {
set path "/"
}
# If the file is a directory then pass it onto browse_directory
if {[file isdirectory $path]} {
browse_directory $chan $path
} else {
# Copy the file out through the browser
set failed [catch {set fd [open $path r]}]
if {$failed == 1} {
puts $chan "Cannot open $path"
} else {
# Unformatted output (useful for saving file contents etc.) is easy...
if {$formatted == 0} {
fcopy $fd $chan
} else {
# Formatted output is slightly more tedious... start by producing a
# simple HTML header that says we're sending pre-formatted text
puts $chan "
"
# Loop through each line in the file
set text ""
set line_length [gets $fd text]
while {$line_length != -1} {
# Convert the HTML characters
regsub -all {\&} $text {\&} text
regsub -all {\"} $text {\"} text
regsub -all {<} $text {\<} text
regsub -all {>} $text {\>} text
# Display the result and fetch the next line
puts $chan "$text"
set line_length [gets $fd text]
}
# Finish off the HTML page
puts $chan ""
}
close $fd
}
}
}
proc browse_directory {chan path} {
# Normalise the path - note that / for root would get us the backup menu
# so we have to code that as &ROOT&/ - an invalid Unix filename
global global_root_token
set rawpath [string trimright $path "/"]
if {$rawpath == "/$global_root_token"} {
set rawpath ""
}
set path "$rawpath/"
# Display the contents of the directory
puts $chan [html_start "Listing of '$path'"]
if {[file isdirectory $path] == 0} {
puts $chan "'$path' is not a directory