| View previous topic :: View next topic |
| Author |
Message |
Danik Halfop
Joined: 15 Jun 2008 Posts: 49 Location: Moldova
|
Posted: Thu Nov 27, 2008 6:38 pm Post subject: Can someone check why this tcl doesnt work on my egg? |
|
|
| Code: | package require http
bind pub -|- !csc checkcsc
proc 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 0
set regcomment ""
foreach line $html {
if {[string match "*by user :*" $line]} {
regexp {(.*)<b>(.*)</b>(.*)} $line match blah reguser blah
}
if {[string match "*Posted on :*" $line]} {
regexp {(.*)<b>(.*)</b>(.*)} $line match blah regdate blah
}
if {[string match "*Current status :*" $line]} {
regexp {(.*)<b>(.*)</b>(.*)} $line match blah regstatus blah
regsub -all {<[^>]*>} $regstatus {} regstatus
}
if {[string match "*Decision comment :*" $line]} {
regexp {(.*)<b>(.*)</b>(.*)} $line match blah regcomment blah
regsub -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." |
|
|
| Back to top |
|
 |
nml375 Revered One
Joined: 04 Aug 2006 Posts: 2857
|
Posted: Thu Nov 27, 2008 7:14 pm Post subject: |
|
|
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. _________________ NML_375, idling at #eggdrop@IrcNET |
|
| Back to top |
|
 |
Danik Halfop
Joined: 15 Jun 2008 Posts: 49 Location: Moldova
|
Posted: Thu Nov 27, 2008 7:30 pm Post subject: |
|
|
Check CService Application
it should work like this:
| Code: | [01:29:26] <CimisliaIRC> !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 |
|
| Back to top |
|
 |
nml375 Revered One
Joined: 04 Aug 2006 Posts: 2857
|
Posted: Thu Nov 27, 2008 8:00 pm Post subject: |
|
|
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). _________________ NML_375, idling at #eggdrop@IrcNET |
|
| Back to top |
|
 |
Maiki Voice
Joined: 20 May 2007 Posts: 28
|
Posted: Sat Nov 29, 2008 8:25 am Post subject: |
|
|
Switch pattern starting with #. This could be a bad comment.
| Code: |
"#" {append y "%23"} |
|
|
| Back to top |
|
 |
nml375 Revered One
Joined: 04 Aug 2006 Posts: 2857
|
Posted: Sat Nov 29, 2008 12:27 pm Post subject: |
|
|
| Maiki wrote: | 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. _________________ NML_375, idling at #eggdrop@IrcNET |
|
| Back to top |
|
 |
speechles Revered One

Joined: 26 Aug 2006 Posts: 1398 Location: emerald triangle, california (coastal redwoods)
|
Posted: Sat Nov 29, 2008 12:59 pm Post subject: |
|
|
| 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. _________________ speechles' eggdrop tcl archive |
|
| Back to top |
|
 |
Ashoq Voice

Joined: 17 Jul 2010 Posts: 11
|
Posted: Sat Oct 16, 2010 2:02 pm Post subject: |
|
|
it works for me
need just add tinyurl for the cservice link  |
|
| Back to top |
|
 |
|