egghelp/eggheads community

Can someone check why this tcl doesnt work on my egg?

2010-10-16T14:02:23-04:00

it works for me

need just add tinyurl for the cservice link

Statistics: Posted by Ashoq — Sat Oct 16, 2010 2:02 pm

Can someone check why this tcl doesnt work on my egg?

2008-11-29T12:59:55-04:00

Code:

set valchan [join [lindex [split $arg] 0]]if { $valchan == "" } { return 0 }set token [http::config -useragent "lynx"]set dachan [wt:filter $valchan]set token [http::geturl "http://194.109.147.174/live/check_app.php?name=$dachan"]

I suggest changing that to look like below.

Code:

if {![string length $arg]} {return 0}set token [http::config -useragent "lynx"]set dachan [::http::formatQuery name [lindex [$split arg] 0]]set token [http::geturl "http://194.109.147.174/live/check_app.php$dachan"]

Upon checking, it appears it does do a one step redirect chase/traversal.

Code:

    set token [http::geturl "http://194.109.147.174/live/check_app.php?name=$dachan"]        set html [http::data $token]         ...        upvar #0 $token state        foreach {name value} $state(meta) {                if {[regexp -nocase ^location$ $name]} {                        set regurl "http://cservice.undernet.org/live/$value"                        set token [http::geturl $regurl]                        set html [http::data $token]

It is just after this point it attempts to parse the data by looping through each line while using string match to determine which line gets which regexp fed to it. This part could be condensed to one single regexp as well. But this does suggest the script does do a simple redirect and assumes it will always get one at the first url given. This is why it doesn't check for ncode it assumes the meta array will always have a location for the redirect.

Statistics: Posted by speechles — Sat Nov 29, 2008 12:59 pm

Can someone check why this tcl doesnt work on my egg?

2008-11-29T12:27:46-04:00

Switch pattern starting with #. This could be a bad comment.
Code:
"#" {append y "%23"}

Since the hash is within a string, that would not be a concern. The issue is indeed with the script being unable to follow 302 Redirect response codes from the web server.

Statistics: Posted by nml375 — Sat Nov 29, 2008 12:27 pm

Can someone check why this tcl doesnt work on my egg?

2008-11-29T08:25:34-04:00

Switch pattern starting with #. This could be a bad comment.

Code:

"#" {append y "%23"}

Statistics: Posted by Maiki — Sat Nov 29, 2008 8:25 am

Can someone check why this tcl doesnt work on my egg?

2008-11-27T20:00:57-04:00

Without any logged error messages or such, one could only guess at best.

I did some further investigation though, and it would seem that the check_app.php script simply generates a 302 redirect response. The http package does not follow these redirects automatically, and this would probably be the reason you get no output.

Solution would be using ::http::ncode to retrive the response numeric (checking for 302 or other responsecode), and when needed, check the status array for the meta data "Location" (in order to yield the proper address).

Statistics: Posted by nml375 — Thu Nov 27, 2008 8:00 pm

Can someone check why this tcl doesnt work on my egg?

2008-11-27T19:30:18-04:00

Check CService Application

it should work like this:

Code:

[01:29:26]  !csc Cimislia[01:29:29] <@|RoHack> | Aplicatie CService | Canal: Cimislia | Stadiu: Incoming | Username: 1C | Data: Nov 27 2008 20:40:21 CSST | Obiectii:  | Comentarii: n/a | URL:http://cservice.undernet.org/live/view_app.php?id=1227814821-20840&back=checkapp |

but it doesnt do anything

Statistics: Posted by Danik — Thu Nov 27, 2008 7:30 pm

Can someone check why this tcl doesnt work on my egg?

2008-11-27T19:14:23-04:00

It would be very helpful if you could provide some information on how it's not working, any error messages, version of eggdrop and tcl, and so on...

A quick check of the script shows one inappropriate join when setting valchan. This might cause some unexpected behaviours on some very rare channelnames.
Also, the scripter uses his own function wt:filter in order to generate an url, rather than using the one provided with the http-package. His/her is unfortunately rather limited, and will only handle a very small subset of accented letters, injecting the others unaltered. This could cause problems with very exotic channelnames.

Statistics: Posted by nml375 — Thu Nov 27, 2008 7:14 pm

Can someone check why this tcl doesnt work on my egg?

2008-11-27T18:38:24-04:00

Code:

package require httpbind pub -|- !csc checkcscproc checkcsc {nick host hand chan arg} {        set valchan [join [lindex [split $arg] 0]]        if { $valchan == "" } { return 0 }        set token [http::config -useragent "lynx"]        set dachan [wt:filter $valchan]        set token [http::geturl "http://194.109.147.174/live/check_app.php?name=$dachan"]        set html [http::data $token]if {[string match "*No applications*" $html]} {                puthelp "PRIVMSG $chan :$valchan: No existe ninguna aplicación en CService para este canal o ya esta registrado"    return 0        }        if {[string match "*DB is currently being maintained*" $html]} {                puthelp "PRIVMSG $chan :$valchan: La Base de Datos de CService esta fuera de servicio en este momento"    return 0        }        upvar #0 $token state        foreach {name value} $state(meta) {                if {[regexp -nocase ^location$ $name]} {                        set regurl "http://cservice.undernet.org/live/$value"                        set token [http::geturl $regurl]                        set html [http::data $token]                        set html [split $html "\n"]                        set regobj 0set regcomment ""                        foreach line $html {                                 if {[string match "*by user :*" $line]} {                                        regexp {(.*)(.*)(.*)} $line match blah reguser blah                                 }                                 if {[string match "*Posted on :*" $line]} {                                        regexp {(.*)(.*)(.*)} $line match blah regdate blah                                 }                                if {[string match "*Current status :*" $line]} {                       regexp {(.*)(.*)(.*)} $line match blah regstatus blahregsub -all {<[^>]*>} $regstatus {} regstatus                                }                                if {[string match "*Decision comment :*" $line]} {  regexp {(.*)(.*)(.*)} $line match blah regcomment blahregsub -all {<[^>]*>} $regcomment {} regcomment2                                }                                if {[string match "*Comment :*" $line]} {                                        incr regobj 1                                }                                if {![info exists regcomment2]} {                                        set regcomment2 "n/a"                                }                        }}        }        set regstatus2 [string tolower $regstatus]        if {$regstatus2 == "pending"} {  set regstatus "\00312$regstatus"        } elseif {$regstatus2 == "incoming"} {          set regstatus "\00308$regstatus"        } elseif {$regstatus2 == "rejeced"} {  set regstatus "\00304$regstatus"} elseif {$regstatus2 == "accepted"} {  set regstatus "\00309$regstatus"        } elseif {$regstatus2 == "ready for review"} {  set regstatus "\00306$regstatus"        } elseif {$regstatus2 == "cancelled by the applicant"} {  set regstatus "\00314$regstatus"        }    putserv "PRIVMSG $chan :\0031\002\00302|\0031\002 \0031\002Aplicación CService\0031\002 \0031\002\00302|\0031\002\0031\002\00302|\0031\002\0031\002\00302|\0031\002 \0031\002#Canal:\0031\002 $valchan \0031\002\00302|\0031\002 \0031\002Estado:\0031\002 \002$regstatus\002 \0031\002\00302|\0031\002 \0031\002Username:\0031\002 $reguser \0031\002\00302|\0031\002 \0031\002Fecha:\0031\002 $regdate \0031\002\00302|\0031\002 \0031\002Objeciones:\0031\002 $regobj \0031\002\00302|\0031\002 \0031\002Comentarios:\0031\002 $regcomment2 \0031\002\00302|\0031\002 \0031\002URL:\0031\002 $regurl \0031\002\00302|\0031\002"        return 0}proc wt:filter {x {y ""} } {        for {set i 0} {$i < [string length $x]} {incr i} {                switch -- [string index $x $i] {                        "é" {append y "%E9"}                        "è" {append y "%E8"}                        "î" {append y "%CE"}                        "É" {append y "%E9"}                        "È" {append y "%E8"}                        "Î" {append y "%CE"}                        "&" {append y "%26"}                        "#" {append y "%23"}                        " " {append y "+"}                        default {append y [string index $x $i]}                }        }        return $y}#################################################################################putlog "Check CService Channel Aplication para #AyudaIRC @ UnderNet by 1BaRDaHL * 1bardahl@linuxmail.org 1v1.0 cargado."

Statistics: Posted by Danik — Thu Nov 27, 2008 6:38 pm