'chunked' transfer encoding

[kanibus]

hello im using a script to search a site, but the site recently changed over to using 'chunked' encoding. i was wondering how i would edit the following script to allow for this/decode the 'chunked' data. thanks.

Code: Select all

namespace eval steam {
  
  variable search "!steamid"
  variable flag "-|-"

  variable hostname "czleague.org"
  variable urlstring "/index.php?div=&action=steamidsearch&submit=1"
  variable urldivision "/index.php?div=&action=viewuser&id="

  proc steam_search {nick host hand chan arg} {
    variable hostname
    if {[regexp {^[\x20]{0,100}([0-9]{1,100})[\x20]{0,100}$} $arg -> id]} {
      if {[catch {socket -async $hostname 80} s]} {
        putserv "NOTICE $nick :Sorry couldn't connect to the webserver."
      } else {
        fileevent $s writable [list [namespace current]::steam_callback $s $nick $chan $id]
      }
    } else {
    	putserv "NOTICE $nick :Invalid steam id."
    }
  }

  proc steam_callback {s nick chan sid} {
    variable urlstring; variable hostname
    if {[string equal {} [fconfigure $s -error]]} {
      fconfigure $s -translation crlf
      flush $s
      puts $s "POST $urlstring HTTP/1.1"
      puts $s "Host: $hostname"
      puts $s "Connection: Close"
      puts $s "User-Agent: ofloo.net scripts"
      puts $s "Content-Type: application/x-www-form-urlencoded"
      puts $s "Content-Length: [expr 8 + [string bytelength $sid]]"
      puts $s "Referer: ${hostname}${urlstring}\n"
      puts $s "steamid=$sid"
      flush $s
      set switch 0
      while {![eof $s]} {
        gets $s x
        if {[regexp -nocase {<td valign="top"><a href="index.php\?div=&action=viewuser&id=([0-9]{1,100})&PHPSESSID=[0-9a-f]{32}">View</a></td>} $x -> id]} {
          break
        }
      }
    } else {
    	putserv "NOTICE $nick :Sorry couldn't connect to the webserver."
    }
    close $s
    if {[info exists id]} {
      if {[catch {socket -async $hostname 80} s]} {
        putserv "NOTICE $nick :Sorry couldn't connect to the webserver."
      } else {
        fileevent $s writable [list [namespace current]::division_callback $s $nick $chan $sid $id]
      }    	
    } else {
    	putserv "NOTICE $nick :No results found for ${sid}."
    }
  }

  proc division_callback {s nick chan sid id} {
    variable urldivision; variable hostname
    if {[string equal {} [fconfigure $s -error]]} {
      puts $s "GET ${urldivision}${id} HTTP/1.1"
      puts $s "Host: $hostname"
      puts $s "Connection: Close"
      puts $s "User-Agent: ofloo.net scripts"
      puts $s "\n\r"
      flush $s
      while {![eof $s]} {
        gets $s x
        regexp -nocase {<b>Name:</b> (.*?)<br />} $x -> name
        regexp -nocase {<b>Alias:</b> (.*?)<br />} $x -> alias
        regexp -nocase {<b>SteamID:</b> ([0-9]{1,100}:[0-9]{1,100}:[0-9]{1,100})<br />} $x -> steamid
        if {[regexp -nocase {<b>Team:</b> <a href="(index.php\?div=czli&action=viewteam&id=[0-9]{1,100}&PHPSESSID=[0-9a-f]{32})">(.*?)</a><br /><br />} $x -> turl team]} {
          set div "invite"
          break
        }
        if {[regexp -nocase {<b>Team:</b> <a href="(index.php\?div=czlo&action=viewteam&id=[0-9]{1,100}&PHPSESSID=[0-9a-f]{32})">(.*?)</a><br /><br />} $x -> turl team]} {
          set div "open"
          break
        }
        if {[regexp -nocase {<b>Team:</b> <a href="(index.php\?div=czlm&action=viewteam&id=[0-9]{1,100}&PHPSESSID=[0-9a-f]{32})">(.*?)</a><br /><br />} $x -> turl team]} {
          set div "main"
          break
        }
      }
      if {[info exists name] && [info exists alias] && [info exists steamid] && [info exists team]} {
        putserv "NOTICE $nick :CZL\($steamid\) Name: $name Alias: $alias Team: $team\($div\) MoreInfo: http://$hostname/$turl"
      } else {
      	putserv "NOTICE $nick :Sorry $nick no results for ${sid}."
      }
    } else {
    	putserv "NOTICE $nick :Sorry couldn't connect to the webserver."
    }
    close $s
  }

  bind pub $flag $search [namespace current]::steam_search

}

thanks for your help

[demond]

tell Ofloo to rewrite his stuff using tclhttp

[kanibus]

so there is no way to just add in the decoding? as ofloo is a bit difficult to reach atm.

[demond]

if by "no way" you mean "there's nobody interested in wasting their time to patch a script that works on ONE version of ONE website only" - then I guess you are right

[kanibus]

interj.no way
Used to express emphatic negation.

actually thats the only definition of 'no way.' but thanks for your witty reply. i was asking if there was possibly a script written already to decode chunked data so i could then just call that function as opposed to rewriting the whole script based off of a package.

[demond]

I doubt there is one

Handling 'chunked' encoding the way Ofloo has written his stuff is not too easy, and the chance someone has done that for eggdrop purposes is slim to none

on the other hand, the http package that comes bundled with Tcl supports HTTP 1.0 only, and 'chunked' encoding is HTTP 1.1 feature

[kanibus]

so i am trying to do this with the tclhttp package demond was so kind to link me too, but i dont think i am doing it right. i get an error that says

can't read "state(-urlencoding)": no such variable

from

Code: Select all

set url "czleague.org/index.php?div=&action=steamidsearch&submit=1"
set czid [::http::formatQuery steamid $string]
        if {[catch {set tok [::http::geturl $url -query $czid]} error]} {
                set text "An error occured while connecting to the CZL database."
                putserv "NOTICE $ic :$text"
                return
        }
        if {[::http::ncode $tok] != 200} {
                set text "An error occured while connecting to the CZL database."
                putserv "NOTICE $ic :$text"
                ::http::cleanup $tok ; return
        }
        set thedata [::http::data $tok]

and i have tried to define the urlencoding as utf-8 with ::http::config -urlencoding but that didnt work either. any help is appreciated.

[stdragon]

You could try changing all the "HTTP/1.1" strings to "HTTP/1.0" in the original script and seeing if that works.