#!/tvbin/tivosh 

## IP identification utilities for dailymail_jazz v1.0
## created and transformed by Chris Stennett (tivo-onion) at www.tivocommunity.com
##
## all usual disclaimers apply.
## much / most of this code donated from other modules - thanks where appropriate.
##
## 13 Sep 05
##

# Code from http://www.beedub.com/book/2nd/socket.doc.html

proc Http_Open {url} {
	global http
	if {![regexp -nocase {^(http://)?([^:/]+)(:([0-9])+)?(/.*)} $url x protocol server y port path]} {
		error "bogus URL: $url"
	}
	if {[string length $port] == 0} {
		set port 80
	}
	set sock [socket $server $port]
	puts $sock "GET $path HTTP/1.0"
	puts $sock "Host: $server"
	puts $sock "User-Agent: Tcl/Tk Http_Open"
	puts $sock ""
	flush $sock
	return $sock
}

proc Http_Proxy {{new {}}} {
	global http
	if ![info exists http(proxy)] {
		return {}
	}
	if {[string length $new] == 0} {
		return $http(proxy):$http(proxyPort)
	} else {
		regexp {^([^:]+):([0-9]+)$} $new x http(proxy) http(proxyPort)
	}
}



proc Http_Open {url {command GET} {query {}}} {
	global http
	if {![regexp -nocase {^(http://)?([^:/]+)(:([0-9])+)?(/.*)} $url x protocol server y port path]} {
		error "bogus URL: $url"
	}
	if {[string length $port] == 0} {
		set port 80
	}
	if {[info exists http(proxy)] && [string length $http(proxy)]} {
		set sock [socket $http(proxy) $http(proxyPort)]
		puts $sock "$command http://$server:$port$path HTTP/1.0"
	} else {
		set sock [socket $server $port]
		puts $sock "$command $path HTTP/1.0"
	}
	puts $sock "User-Agent: Tcl/Tk Http_Open"
	puts $sock "Host: $server"
	if {[string length $query] > 0} {
		puts $sock "Content-Length: [string length $query]"
		puts $sock ""
		puts $sock $query
	}
	puts $sock ""
	flush $sock
	fconfigure $sock -blocking 0
	return $sock
}

proc Http_Head {url} {
	upvar #0 $url state
	catch {unset state}
	set state(sock) [Http_Open $url HEAD]
	fileevent $state(sock) readable [list HttpHeader $url]
	# Specify the real name, not the upvar alias, to vwait
	vwait $url\(status)
	catch {close $state(sock)}
	return $state(status)
}

proc HttpHeader {url} {
	upvar #0 $url state
	if [eof $state(sock)] {
		set state(status) eof
		close $state(sock)
		return
	}
	if [catch {gets $state(sock) line} nbytes] {
		set state(status) error
		lappend state(headers) [list error $nbytes]
		close $state(sock)
		return
	}
	if {$nbytes < 0} {
		# Read would block
		return
	} elseif {$nbytes == 0} {
		# Header complete
		set state(status) head
	} elseif {![info exists state(headers)]} {
		# Initial status reply from the server
		set state(headers) [list http $line]
	} else {
		# Process key-value pairs
		regexp {^([^:]+): *(.*)$} $line x key value
		lappend state(headers) [string tolower $key] $value
	}
}

proc Http_Get {url {query {}}} {
	upvar #0 $url state ;# Alias to global array
	catch {unset state} ;# Aliases still valid.
	if {[string length $query] > 0} {
		set state(sock) [Http_Open $url POST $query]
	} else {
		set state(sock) [Http_Open $url GET]
	}
	set sock $state(sock)
	fileevent $sock readable [list HttpHeader $url]
	# Specify the real name, not the upvar alias, to vwait
	vwait $url\(status)
	set header(content-type) {}
	set header(http) "500 unknown error"
	array set header $state(headers)
	# Check return status.
	# 200 is OK, other codes indicate a problem.
	regsub "HTTP/1.. " $header(http) {} header(http)
	if {![string match 2* $header(http)]} {
		catch {close $sock}
		if {[info exists header(location)] && [string match 3* $header(http)]} {
			# 3xx is a redirection to another URL
			set state(link) $header(location)
			puts "REDIRECTION REQUIRED"
			return [Http_Get $header(location) $query]
		}
		return -code error $header(http)
	}
	# Set up to read the content data
	switch -glob -- $header(content-type) {
		text/* {
			# Read HTML into memory
			fileevent $sock readable [list HttpGetText $url]
		}
		default			{
			# Copy content data to a file
			fconfigure $sock -translation binary
			set state(filename) [File_TempName http]
			if [catch {open $state(filename) w} out] {
				set state(status) error
				set state(error) $out
				close $sock
				return $header(content-type)
			}
			set state(fd) $out
			fileevent $sock readable [list HttpCopyData $url]
		}
	}
	vwait $url\(status)
	return $header(content-type)
}

proc HttpGetText {url} {
	upvar #0 $url state
	if [eof $state(sock)] {
		# Content complete
		set state(status) done
		close $state(sock)
	} elseif {[catch {read $state(sock)} block]} {
		set state(status) error
		lappend state(headers) [list error $block]
		close $state(sock)
	} else {
		append state(body) $block
	}
}

proc HttpCopyData {url} {
	upvar #0 $url state
	if [eof $state(sock)] {
		# Content complete
		set state(status) done
		close $state(sock)
		close $state(fd)
	} elseif {[catch {fcopy $state(sock) $state(fd)} x]} {
		set state(status) error
		lappend state(headers) [list error $x]
		close $state(sock)
		close $state(fd)
	}
}

# custom code


proc fake_dns {domain_name} {
	global debuglvl
	if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-FAKE DNS SERVICE MODULE - STARTED" }
	if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-domain passed in : >>$domain_name<<" }
	set our_url "http://66.98.244.117/default.asp?prog=lookup&Netnic=whois.arin.net&host=$domain_name"
	set start_map "IP address: "
	set end_map "<br>"
	set output [Http_Get $our_url ""]
	upvar #0 $our_url state
	set our_body $state(body)
	set our_ip [string range $our_body [expr [string first $start_map $our_body] + [string length $start_map] ] [expr [string first $start_map $our_body] + 100] ]
	set our_ip [string range $our_ip 0 [expr [string first $end_map $our_ip] - 1] ]
	if {$our_ip == ""} {
		set our_ip $domain_name 
	}
	if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-ip passed out : >>$our_ip<<" }
	if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-FAKE DNS SERVICE MODULE - FINISHED" }
	catch { unset $our_url}
	catch { unset output }
	catch { unset our_body }
	catch { unset our_url}
	catch { unset startmap }
	catch { unset end_map }
	catch { unset state }
	return $our_ip	
}

proc get_external_IP {our_url start_map end_map} {
	# visits http://www.whatismyipaddress.com/ (no redirection on this site)
	# DNS lookup not available on TiVo by default - so must find site with no redirection else failure will occur
	global debuglvl
	if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-GET EXTERNAL IP MODULE - STARTED" }
	if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-url passed in : >>$our_url<<" }
	# tidy up url
	set our_url [string trim $our_url]	
	if {$our_url != ""} {
		if { [string toupper [string range $our_url 0 3] ] == "HTTP" } {
		i	f {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-clean http from url" }
			set our_url [string range $our_url [expr [string first "//" $our_url] + 2] ]
		}
		if { [string first "/" $our_url] != -1 } {
			if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-clean path from url" }
			set our_url [string range $our_url 0 [expr [string first "/" $our_url] - 1] ]
		}
		if { [string first [string range $our_url 0 0] "0123456789"] < 0 } {
			if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-not an ip - attempt to get ip via fake dns" }
			set our_url [fake_dns $our_url]
		}
		set our_url "http://$our_url/"
	} else {
		set our_url "http://66.166.123.30/"
		set start_map "<BR><B>Your IP address is "
		set end_map "</B></font></center>"
	}
	if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-url after manipulation : >>$our_url<<" }
	set output [Http_Get $our_url ""]
	upvar #0 $our_url state
	set our_body $state(body)
	set our_ip [string range $our_body [expr [string first $start_map $our_body] + [string length $start_map] ] [expr [string first $start_map $our_body] + 100] ]
	set our_ip [string range $our_ip 0 [expr [string first $end_map $our_ip] - 1] ]
	if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-external ip passed out : >>$our_ip<<" }
	if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-GET EXTERNAL IP MODULE - FINISHED" }
	catch { unset $our_url}
	catch { unset our_url }
	catch { unset start_map }
	catch { unset end_map }
	catch { unset our_body }
	catch { unset state }
	return $our_ip
}

proc send_details {emailrecipient tivoname localtime softver softreldate softdebuglvl hoursreq tivosoftver tivomod tivoman tivoopt tivosrone tivouk}  {
	global debuglvl
	if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-SEND DETAILS - STARTED" }
	set our_url [fake_dns {deepinthejungle.servehttp.com}]
	set our_url "http://${our_url}/cgi-bin/record_dailymail_details.cgi?emailrecipient=${emailrecipient}&tivoname=${tivoname}&localtime=${localtime}&softver=${softver}&softreldate=${softreldate}&softdebuglvl=${softdebuglvl}&hoursreq=${hoursreq}&tivosoftver=${tivosoftver}&tivomod=${tivomod}&tivoman=${tivoman}&tivoopt=${tivoopt}&tivosrone=${tivosrone}&tivouk=${tivouk}"
	set output [Http_Get $our_url ""]
	if {$debuglvl>2} { puts "[clock format [clock seconds] -format {%H:%M:%S} -gmt true]-SEND DETAILS - FINISHED" }
	catch { unset our_url }
	catch { unset output }
	return "ok"
	
	
}


