[ExtractStream] httpd.tcl changes

David Gerdes dpgerdes at r...
Sun, 10 Jun 2001 02:49:51 -0500 (CDT)
Previous message: httpd.tcl changes
Next message: audio ok, but corrupted video?
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
This is off-topic and probably doesn't belong here
(But maybe my next post will include NowShowing fixes)

Below is a modified version of the Extract version of httpd.tcl which
will display the images referenced in the /mfs/Resource/Image section.


Tested only on Tivux 2.0.1

Use at your own risk. 


-- 
David


=============================================================================
#!/tvbin/tivosh

# TiVo web server written by Stephen Rothwell (sfr@l...)
# SendKeys Tivo Remote Mod by Jon Squire (jsquire@j...)
# Note: SendKeys TiVo remote has currently only been tested on a 
# DirecTiVo, but should be fine on others, if a key doesn't work
# look at your sendkeys.tcl file and makesure that the proper key
# is being sent.
#
# Remount added 11/10/2000 1:44am EST but Jon Squire
#
# /Image added 06/10/2001 -dpg
#
source $tcl_library/tv/log.tcl
source $tcl_library/tv/mfslib.tcl
source $tcl_library/tv/sendkey.tcl

proc html_start {title} {
set ret "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2//EN\">\n"
append ret "<HTML><HEAD>"
if {$title != ""} {
append ret "<TITLE>$title</TITLE>"
}
append ret "</HEAD><BODY>"
}

proc html_end {} {
return "</BODY></HTML>"
}

proc html_link {link anchor} {
return "<A HREF=\"$link\">$anchor</A>"
}

proc html_table_start {tattr cap capattr} {
set ret "<TABLE"
if {$tattr != ""} {
append ret " $tattr"
}
append ret ">"
if {$cap != ""} {
append ret "<CAPTION"
if {$capattr != ""} {
append ret " $capattr"
}
append ret ">$cap</CAPTION>"
}
return $ret
}

proc html_table_end {} {
return "</TABLE>"
}

proc DumpObject_html {db obj} {

set filename ""

set typ [dbobj $obj type]

# Show type and open bracket
append ret [dbobj $obj type] " " [dbobj $obj fsid] "/" [dbobj $obj subobjid] " {\n"

# Show the construction status
if { [dbobj $obj construction] } {
append ret " UNDER CONSTRUCTION\n"
}

# dump the body of the object	
foreach attr [dbobj $obj attrs] {

append ret [format { %-14s =} $attr]
if { [dbobj $obj attrtype $attr] == "object" } {
foreach subObj [dbobj $obj gettarget $attr] {
append ret " " [html_link "/object/$subObj" $subObj]
}
} else {
set val [dbobj $obj get $attr]
append ret " " $val

if {$attr == "File"} { set filename $val }
}
append ret "\n"
}

# close bracket
append ret "}"

if {$typ == "Image"} {
append ret "<hr> <img src=/Image/$filename>"
}

return $ret
}

proc do_dir {chan path} {
puts $chan [html_start "Directory listing of $path"]
puts $chan [html_table_start "" "Directory listing of $path" "ALIGN=TOP"]
puts $chan "<TR ALIGN=LEFT><TH>Name</TH><TH>Type</TH><TH>Id</TH><TH>Date Time</TH><TH>Size</TH></TR>"
ForeachMfsFile fsid name type $path "" {
transaction {
if {[catch {set size [FileSize $type $fsid]}] != 0} {
set size "N/A"
}
if {[catch {set date [FileDate $fsid]}] != 0} {
set date "N/A"
}
}
if {[string range $path end end] != "/"} {
append path "/"
}
puts -nonewline $chan "<TR><TD>"
puts -nonewline $chan [html_link "/mfs$path$name" $name]
puts -nonewline $chan "</TD><TD>$type</TD><TD>"
if {$type == "tyDb"} {
puts -nonewline $chan [html_link "/object/$fsid" $fsid]
} else {
puts -nonewline $chan $fsid
}
puts $chan "</TD><TD>$date</TD><TD>$size</TD></TR>"
}
puts -nonewline $chan [html_table_end]
puts $chan [html_end]
}

proc do_object {chan path objectid} {
puts $chan [html_start $path]
puts $chan "<PRE>"

set db [dbopen]
transaction {
if { [regexp {([0-9]*)/(.*)} $objectid junk fsid subobjid] } {
set obj [db $db openidconstruction $fsid $subobjid]
} else {
set obj [db $db openid $objectid]
}
puts $chan [DumpObject_html $db $obj]
}
puts $chan "</PRE>"
puts $chan [html_end]
}

proc action_object {chan objectid} {
if {[string index $objectid 0] == "/"} {
set objectid [string range $objectid 1 end]
}
do_object $chan "" $objectid
}

proc action_mfs {chan path} {
if {$path == "" } {
set path "/"
}
if {[catch {transaction {mfs find $path}} l] != 0} {
puts $chan [html_start ""]
puts $chan $l
puts $chan [html_end]
} else {
set type [lindex $l 1]
if {$type == "tyDir"} {
do_dir $chan $path
} elseif {$type == "tyDb"} {
do_object $chan $path [lindex $l 0]
}
}
}

proc action_Image {chan path} {


set fsid [string trimleft $path "/"]
transaction { set size [mfs size $fsid] }
set blocksize 4096


puts $chan "HTTP/1.0 200 OK\r"
puts $chan [format "Date: %s GMT\r" [clock format [clock seconds] -format "%a, %d %b %Y %T" -gmt true]]
puts $chan "Connection: close\r"
puts $chan "Content-Length: $size\r"
puts $chan "Content-Type: image/png\r"
puts $chan "\r"

catch {fconfigure $chan -translation binary}

transaction {
for {set i 0} {$i < $size} {incr i $blocksize} {
set s [min $blocksize [expr $size - $i]]
set block [mfs getpart $fsid $i $s]
puts -nonewline $chan $block
}
}
}

proc action_NowShowing {chan path} {
puts $chan [html_start "Now Showing"]

ForeachMfsFile fsid name type "/Recording/NowShowing" "" { 
if {$type == "tyDb"} {
set db [dbopen]
transaction { 
set obj [db $db openidconstruction $fsid 11]
foreach attr [dbobj $obj attrs] { 
if {$attr == "Program"} { 
if { [dbobj $obj attrtype $attr] == "object" } { 
foreach subObj [dbobj $obj gettarget $attr] { 
regexp {([0-9]*)/(.*)} $subObj junk part1 part2
puts $chan "<BR>"
set subSubObj [db $db openidconstruction $part1 $part2]
foreach attr2 [dbobj $subSubObj attrs] {
if {$attr2 == "Title" || 
$attr2 == "Description" || 
$attr2 == "EpisodeTitle" } {
foreach subSubSubObj [dbobj $subSubObj get $attr2] { 
puts -nonewline $chan $attr2 
puts -nonewline $chan ": " 
puts -nonewline $chan $subSubSubObj 
puts $chan "<BR>"
}
} 
}
}
}
}
}
set tystreams ""
foreach id {12 14 15 16 17 18 19} {
if {[catch {set obj [db $db openidconstruction $fsid $id]}] == 0} {
foreach attr [dbobj $obj attrs] { 
if {$attr == "File"} {
foreach subObj [dbobj $obj get $attr] {
append tystreams "/$subObj"
}
}
}
} else {break}
}
puts -nonewline $chan [html_link "/tystream$tystreams" "TyStream: $tystreams"]
puts $chan "<BR><BR>"
}
}
}
puts $chan [html_end]
}

proc action_tystream {chan path} {
set second ""
while { 0 < [regexp {^/([0-9]+)(.*)$} $path dummy first path]} {
set second "$second $first"
}
puts "ExtractStream -s $second 2>/dev/null >/var/tmp/mpeg &"
catch {exec "mknod" "/var/tmp/mpeg" "p" }
fconfigure $chan -buffering none -translation binary -blocking 1
exec /bin/bash -c "/hack/bin/ExtractStream -s $second >/var/tmp/mpeg 2>/dev/null" &
set handle [open "/var/tmp/mpeg" r]
fconfigure $handle -blocking 1 -translation binary -buffering none 
while { ![eof $handle ] } {puts -nonewline $chan [read $handle 1048576]}
close $handle
}

proc action_remount {chan path} {
if {[string index $path 0] == "/"} {
set path [string range $path 1 end]
}
puts $chan [html_start ""]
puts $chan "TiVoHack Web Root Remount $path<BR>"

if {$path == "ro" } {
puts $chan "/ Remounted Read Only"
exec mount -oremount,ro /
} elseif {$path == "rw" } {
puts $chan "/ remounted Read Write"
exec mount -oremount,rw /
}
puts $chan "Remount /<BR>"
puts -nonewline $chan [html_link "ro" "Read Only"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "rw" "Read Write"]
puts $chan [html_end]
}

proc action_sendkey {chan path} {
if {[string index $path 0] == "/"} {
set path [string range $path 1 end]
}
puts $chan [html_start "TivoHack Web Remote"]
if {$path != "" } {
SendKey $path
puts $chan "Last Key Sent $path<HR>"
}
puts $chan [html_table_start "BORDER=1" "" ""]
puts -nonewline $chan "<TR ALIGN=center><TD WIDTH=33%>"
puts -nonewline $chan [html_link "power" "Power"]
puts -nonewline $chan "</TD><TD WIDTH=33%>"
puts -nonewline $chan [html_link "tivo" "TiVo"]
puts -nonewline $chan "</TD><TD WIDTH=33%>"
puts -nonewline $chan [html_link "livetv" "Live TV/Guide"]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR><TD ALIGN=center COLSPAN=3>"
puts $chan [html_table_start "BORDER=1" "" ""]
puts -nonewline $chan "<TR><TD COLSPAN=2 ALIGN=CENTER>"
puts -nonewline $chan [html_link "up" "Up"]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR><TD>"
puts -nonewline $chan [html_link "left" "Left"]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link "right" "Right"]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR><TD COLSPAN=2 ALIGN=CENTER>"
puts -nonewline $chan [html_link "down" "Down"]
puts -nonewline $chan "</TD></TR>"
puts -nonewline $chan [html_table_end]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR ALIGN=center><TD>"
puts -nonewline $chan [html_link "thumbsdown" "Thumbs Down"]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link "select" "Select"]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link "thumbsup" "Thumbs Up"]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR ALIGN=center><TD>"
puts -nonewline $chan [html_link "volumeUp" "volumeUp"]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link "mute" "mute"]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link "surfup" "surfup"]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR ALIGN=center><TD>"
puts -nonewline $chan [html_link "volumeDown" "volumeDown"]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link "save" "save"]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link "surfdown" "surfdown"]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR ALIGN=center><TD COLSPAN=3>"
puts -nonewline $chan [html_link "play" "play"]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR ALIGN=center><TD>"
puts -nonewline $chan [html_link "reverse" "reverse"]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link "pause" "pause"]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link "forward" "forward"]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR ALIGN=center><TD>"
puts -nonewline $chan [html_link "replay" "replay"]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link "playslow" "playslow"]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link "catchup" "catchup"]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR ALIGN=CENTER><TD WIDTH=33%>"
puts -nonewline $chan [html_link 1 1]
puts -nonewline $chan "</TD><TD WIDTH=33%>"
puts -nonewline $chan [html_link 2 2]
puts -nonewline $chan "</TD><TD WIDTH=33%>"
puts -nonewline $chan [html_link 3 3]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR ALIGN=CENTER><TD>"
puts -nonewline $chan [html_link 4 4]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link 5 5]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link 6 6]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR ALIGN=CENTER><TD>"
puts -nonewline $chan [html_link 7 7]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link 8 8]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link 9 9]
puts $chan "</TD></TR>"
puts -nonewline $chan "<TR ALIGN=CENTER><TD>"
puts -nonewline $chan [html_link "clear" "Clear"]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link 0 0]
puts -nonewline $chan "</TD><TD>"
puts -nonewline $chan [html_link "enter" "Enter"]
puts $chan "</TD></TR>"
puts -nonewline $chan [html_table_end]
puts $chan "<P>"
puts -nonewline $chan [html_link "bookmark" "bookmark"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "display" "display"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "directv" "directv"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "surfCommit" "surfCommit"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "standby" "standby"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "nowShowing" "nowShowing"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "replay" "replay"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "delimiter" "delimiter"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "guide" "guide"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "displayAndLeft" "displayAndLeft"]
puts $chan " (System Test on Combo)<BR>"
puts -nonewline $chan [html_link "displayAndRight" "displayAndRight"]
puts $chan " (System Diagnostics on Combo))<BR>"
puts -nonewline $chan [html_link "selectAndDown" "selectAndDown"]
puts $chan " (Clear Program Data on Combo)<BR>"
puts -nonewline $chan [html_link "selectAndUp" "selectAndUp"]
puts $chan " (System Information on Combo)<BR>"
puts -nonewline $chan [html_link "power" "power"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "dumpState" "dumpState"]
puts $chan "<BR>"
puts $chan [html_end]
}

proc action_quit {chan dummy} {
global quit

puts $chan [html_start ""]
puts $chan "Server has terminated."
puts $chan [html_end]
set quit 1
}

proc action_ {chan dummy} {
puts $chan [html_start ""]
puts -nonewline $chan [html_link "NowShowing" "Now Showing"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "mfs/" "mfs"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "sendkey/" "TiVo Web Remote"]
puts $chan "<BR>"
puts -nonewline $chan [html_link "remount/" "Remount Root Filesystem"]
puts $chan "<BR><HR>"
puts -nonewline $chan [html_link "quit" "Terminate the web server"]
puts $chan [html_end]
}

proc session {chan addr port} {
set head_req 0
while {[gets $chan line] >= 0} {
if {$line == "\r"} break
if {$line == ""} break
if {[regexp -nocase {^get +(.*) +http/[0-9]+\.[0-9]+.?$} $line dummy path] == 1} {
continue
}
if {[regexp -nocase {^head +(.*) +http/[0-9]+\.[0-9]+.?$} $line dummy path] == 1} {
set head_req 1
continue
}
}
if {$path == ""} {
close $chan
return
}


if {[regexp {^/([-_A-Za-z0-9]*)(.*)} $path dummy action part] == 1} {

if {$action != "Image"} {
puts $chan "HTTP/1.0 200 OK\r"
puts $chan [format "Date: %s GMT\r" [clock format [clock seconds] -format "%a, %d %b %Y %T" -gmt true]]
puts $chan "Connection: close\r"
puts $chan "Content-Type: text/html; charset=iso-8859-1\r"
puts $chan "\r"
}
if {$head_req == 1} {
close $chan
return
}

if {[info procs "action_$action"] == "action_$action"} {
catch [action_$action $chan $part]
} else {
action_ $chan $part
}

} else {
action_ $chan ""
}

close $chan
}

global quit

set quit 0
socket -server session 80
vwait quit
=============================================================================
Previous message: httpd.tcl changes
Next message: audio ok, but corrupted video?
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]