04-27-2017, 22:38 +0200
AuthorPost
thommey  05-12-2004, 18:29   | [EGG] Get the Q-Auth of a user (ircu AC token, X-Auth) Jabber
(Administrator)
Member since 03/2004
62 Posts
1. Asynchronous WHOIS
                                                                                                                              
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
bind raw - 330 whois_info_login
bind raw - 318 whois_endof
bind raw - 401 whois_notfound
bind pub - !auth whois_pubcmd
proc whois_pubcmd {nick host hand chan text} {
    # Here we store where the answer for the WHOIS-request has to be send to
    global whois_replyarray
    if {$text == ""} {
        putserv "PRIVMSG $chan :Please specify a nickname"
        return 0
    }
    set whois_replyarray($text) $chan
    # And send the WHOIS-request
    putserv "WHOIS $text"
    return 0
}
# ANSWER from server: No such nick
proc whois_notfound {from keyword text} {
    global whois_replyarray
    # Filter out the whois'ed nickname
    set targetnick [lindex [split $text] 1]
    if {[info exists whois_replyarray($targetnick)]} {
        # Send that answer to where it belongs to
        putserv "PRIVMSG $whois_replyarray($targetnick) :$targetnick is not on the network."
        unset whois_replyarray($targetnick)
    }
}
# We got the 330 Information -> User is authed as
proc whois_info_login {from key text} {
    global whois_replyarray
    set targetnick [lindex [split $text] 1]
    if {[info exists whois_replyarray($targetnick)]} {
        # Filter out the auth and send it to channel
        putserv "PRIVMSG $whois_replyarray($targetnick) :$targetnick is authed as [lindex [split $text] 2]"
        unset whois_replyarray($targetnick)
    }
}
proc whois_endof {from keyword text} {
    global whois_replyarray
    set targetnick [lindex [split $text] 1]
    if {[info exists whois_replyarray($targetnick)]} {
        # END OF /WHOIS LIST. But no 330 received => User is not authed
        putserv "PRIVMSG $whois_replyarray($targetnick) :$targetnick is not authed."
        unset whois_replyarray($targetnick)
    }
}

This post was edited 2 times, last on 04-29-2009, 22:02 by thommey
  The user has attached a file: whois.tcl (Save, 1,643 Bytes, downloaded 90 times)
thommey  07-11-2004, 14:40   Jabber
(Administrator)
Member since 03/2004
62 Posts
2. Asynchronous WHO nick n%na

                                                                                                                              
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
bind raw - 354 who_info
bind raw - 315 end_of_who
bind pub - !auth who_pubcmd

proc who_pubcmd {nick host hand chan text} {
    # Here we store where the answer for the WHO-request has to be send to
    global whois_replyarray
    if {$text == ""} {
        putserv "PRIVMSG $chan :Please specify a nickname"
        return 0
    }
    set text [lindex [split $text] 0]
    set whois_replyarray([string tolower $text]) $chan
    putserv "WHO $text n%na"
    return 0
}
# ANSWER from server: End of /who - we got reply already?
proc end_of_who {from keyword text} {
    global whois_replyarray
    set targetnick [lindex [split $text] 1]
    if {[info exists whois_replyarray([string tolower $targetnick])]} {
        # Send that answer to where it belongs to
        putserv "PRIVMSG $whois_replyarray([string tolower $targetnick]) :$targetnick is not on the network."
        unset whois_replyarray([string tolower $targetnick])
    }
}

proc who_info {from keyword text} {
    if {[llength [set text [split $text]]] != 3} {
        return 0
    }
    global whois_replyarray
    set targetnick [lindex $text 1]
    set auth [lindex $text 2]
    if {[info exists whois_replyarray([string tolower $targetnick])]} {
        if {$auth == "0"} {
            putserv "PRIVMSG $whois_replyarray([string tolower $targetnick]) :$targetnick is not authed."
        } else {
            putserv "PRIVMSG $whois_replyarray([string tolower $targetnick]) :$targetnick is authed as \"$auth\""
        }
        unset whois_replyarray([string tolower $targetnick])
        return 1
        # return 1: Eggdrop will not parse it, so you can use a format you like
    }
}

This post was edited 3 times, last on 04-29-2009, 22:03 by thommey
  The user has attached a file: who.tcl (Save, 1,507 Bytes, downloaded 76 times)
CyBex  10-24-2005, 16:27   | [EGG] TCL-Only implementation for non-blocking q-auth lookup Jabber  ICQ  AOL IM  Yahoo IM  MSN  Homepage
nie da
(Administrator)

Avatar

Member since 01/2004
260 Posts
Location: Berlin
moved from one lonely thread to this one .. original is from GM!
                                                                                                                              
001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041
042
043
044
045
046
047
048
049
050
051
052
053
054
055
056
057
058
059
060
061
062
063
064
065
066
067
068
069
070
071
072
073
074
075
076
077
078
079
080
081
082
083
084
085
086
087
088
089
090
091
092
093
094
095
096
097
098
099
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
# Change this according to what you prefer more... Lower values give faster updates,
# but cause more lag on your bot, higher values cause less lag, but the qauthes take a while
# until they reach they actually get found....
set qa_delay 10
# This specifies whether you want debugging info in your log (very spammy).
set qa_debug 0
#-----------------------------------------------------
bind time - * qa_refresh_time
bind part - * qa_remove_p
bind sign - * qa_remove_p
bind kick - * qa_remove_k
bind nick - * qa_rename_nick
bind raw - 354 qa_newauth
bind dcc - qa_queue qa_queue
bind join - * qa_checkhost

proc qa_refresh_time {{args ""}} {
    if {[info exists ::qa_blocked]} {
        return 0
    }
    set ::qa_blocked 1
    qa_refresh $::qa_delay
}
proc qa_refresh {delay {chan ""}} {
    set x 0
    set toask [list]
    set toask1 [list]
    if {$chan == ""} {
        foreach chn [channels] {
            foreach nick [chanlist $chn] {
                if {[getchanlogin $nick $chn] == ""} {
                    lappend toask $nick
                } elseif {[getchanlogin $nick $chn] == "0"} {
                    lappend toask1 $nick
                }
            }
        }
        if {[llength $toask] || [llength $toask1]} {
            set toask [lsort -unique $toask]
            set toask2 [list]
            foreach n $toask {
                lappend toask2 $n
                if {[string length [join $toask2]] > 400} {
                    utimer $x [list qa_sendask $toask2]
                    set toask2 [list]
                    incr x $delay
                }
            }
            foreach n $toask1 {
                lappend toask2 $n
                if {[string length [join $toask2]] > 400} {
                    utimer $x [list qa_sendask $toask2]
                    set toask2 [list]
                    incr x $delay
                }
            }
            if {[llength $toask2]} {
                utimer $x [list qa_sendask $toask2]
            }
        }
    } {
        puthelp "WHO $chan c%na"
    }
    qa_cleanup
    utimer [expr $x + $delay] [list unset ::qa_blocked]
    return 0
}

proc qa_sendask {asklist} {
    foreach curnick $asklist {
        if {[onchan $curnick]} {lappend newlist $curnick}
    }
    if {[info exist newlist]} {puthelp "WHO [join $newlist ","] n%na"}
}

proc qa_cleanup {} {
    global qa_autharr
    if {[info exist qa_autharr]} {
        foreach curname [array names qa_autharr] {
            if {![onchan $curname]} {unset qa_autharr($curname); if {$::qa_debug == "1"} {putlog "Cleaned up \"$curname\""}}
        }
    }
}

proc getchanlogin {nick {chan ""}} {
    global qa_autharr
    if {![info exist qa_autharr($nick)]} {return ""} {return $qa_autharr($nick)}
}

proc qa_newauth {from key text} {
    global qa_autharr
    if {[llength [set text [split $text]]] != 3} {return}
    if {![onchan [set nick [lindex $text 1]]]} {return}
    set auth [lindex $text 2]
    if {$::qa_debug == "1"} {putlog "Authlist updated, added \"$auth\" for \"$nick\""}
    set qa_autharr($nick) $auth
    return 0
}

proc qa_rename_nick {nick u h c newnick} {
    global qa_autharr
    if {[info exist qa_autharr($nick)]} {
        set qa_autharr($newnick) $qa_autharr($nick)
        if {$::qa_debug == "1"} {putlog "Authlist updated, \"$nick\" renamed to \"$newnick\""}
        unset qa_autharr($nick)
    }
}

proc qa_remove_k {n u h c t {r ""}} {
    qa_remove_nick $t
}

proc qa_remove_p {n u h c {r ""}} {
    qa_remove_nick $n
}

proc qa_remove_nick {nick} {
    global qa_autharr
    if {[onchan $nick]} {return}
    if {[info exist qa_autharr($nick)]} {
        unset qa_autharr($nick)
        if {$::qa_debug == "1"} {putlog "Authlist updated, removed \"$nick\""}
    }
}

proc qa_queue {hand idx text} {
    set nicklist ""
    set unklist ""
    foreach curchan [channels] {
        foreach curnick [chanlist $curchan] {
            if {[getchanlogin $curnick] == "" || [getchanlogin $curnick] == "0"} {lappend nicklist $curnick}
            if {[getchanlogin $curnick] == ""} {lappend unklist $curnick}
        }
    }
    putidx $idx "Current ask-queue is: [set tot [llength [lsort -unique $nicklist]]] ([set unk [llength [lsort -unique $unklist]]] unknown, [expr $tot - $unk] unauthed)."
}

proc qa_checkhost {n u h c} {
    global qa_autharr
    if {[regexp {^.+?\@(.+?)\.users\.quakenet\.org$} $h tmp auth]} {
        if {[getchanlogin $n] == "" || [getchanlogin $n] == "0"} {
            set qa_autharr($n) $auth
            if {$::qa_debug == "1"} {putlog "Authlist updated, added \"$auth\" for \"$nick\" (joined)"}
        }
    }
}


usage is: getchanlogin <nick>
it will return "0" if the user is not authed, "" if the user has not been checked yet, and the authnick if the auth is known.

On the partyline you have a nifty command named ".qa_queue"

script can be downloaded here: http://hates.us:8080/qauthes.tcl

Thanks to l8a for providing an eggdrop for testing :)

mfG CyBex @ QuakeNet, UnderNet, EFNet, Freenode, euIRC, GameSurge & ShadowWorld - Files
This post was edited 1 times, last on 08-03-2007, 11:54 by CyBex
  The user has attached a file: nonblock.tcl (Save, 4,144 Bytes, downloaded 25 times)
CyBex  10-24-2005, 16:39   Jabber  ICQ  AOL IM  Yahoo IM  MSN  Homepage
nie da
(Administrator)

Avatar

Member since 01/2004
260 Posts
Location: Berlin
Here is another good place to link to thommeys patch for eggdrop, to use simple "getchanlogin" for get the qauth of a user...

http://thommey.tclhelp.net

Good luck :)

mfG CyBex @ QuakeNet, UnderNet, EFNet, Freenode, euIRC, GameSurge & ShadowWorld - Files
thommey  07-20-2007, 21:30   | Synchronous (Blocking) attempt Jabber
(Administrator)
Member since 03/2004
62 Posts
THIS IS A DEPRECATED HACK AND SHOULD NOT BE USED. SCROLL DOWN FOR PROPER SYNCHRONOUS ATTEMPTS

Due to popular demand for the most-obvious and intuitive approach, I wrote the following solution:

How to use it in your code?
                                                                                                                              
1
2
3
4
5
bind pub - !test test
proc test {nick host hand chan text} {
    set qauth [getqauth $nick]
    putserv "PRIVMSG $chan :$nick, dein auth ist $qauth (0 = nicht geauthed)"
}


This also works for users not on the bot's channels!

Keep in mind that this method may take a few seconds and block your bot!

And here is how it works:

You need 2 Bots for it.
Bot1 is the one you want to use [getqauth] on.
Bot2 is the slave-bot getting the Q-authes.


You have to put this somewhere on your shell of Bot1 (as a textfile..) (I made it /home/tcl/getqauth.tcl but it doesnt matter)

                                                                                                                              
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
#!/usr/bin/tclsh
# CONFIGURE ME! IP/Host of Bot2 !!!
set remotehost 127.0.0.1
# CONFIGURE ME! Port of Bot2 !!!
set remoteport 4756

set nick [lindex $argv 0]
if {$nick == ""} { puts "Syntax: $argv0 <nickname>"; exit 1 }
set sid [socket $remotehost $remoteport]
fconfigure $sid -buffering line -blocking 1
puts $sid $nick
set auth ""
while {$auth == ""} {
    gets $sid auth
    set auth [string trim $auth]
}
puts $auth
exit 0


Then, bot1 has to load this script:

                                                                                                                              
01
02
03
04
05
06
07
08
09
10
# CONFIGURE ME: The absolute path to the file you just created (the textfile from above)
set path_to_exfile /home/user/eggdrop/qauth.tcl

# CONFIGURE ME: Path to tclsh executable (most likely you dont need to change it)
set path_to_tcl /usr/bin/tclsh

proc getqauth {nick} {
    set auth [exec $::path_to_tcl $::path_to_exfile $nick]
    return $auth
}



Last but not least, Bot2 has to load this script:

                                                                                                                              
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
# CONFIGURE ME! Port to listen on (Remember to change it in the other file as well)
set ::qport 4756
if {![info exists ::qauthlisten]} { set ::qauthlisten [socket -server qauthacc $::qport] }
proc qauthacc {cid ip port} {
    putlog "Q-Auth: Incoming connection ($cid) from $ip:$port"
    fconfigure $cid -buffering line -blocking 0
    fileevent $cid readable "qread $cid"
}
proc qread {cid} {
    if {[gets $cid req] < 0} { putlog "$cid closed."; catch {close $cid} }
    set req [string trim $req]
    set req [string tolower $req]
    if {$req == ""} { return }
    set hash [expr {[rand 900]+100}]
    if {[info exists ::qcallback($req)]} {
        lappend ::qcallback($req) $cid
    } else {
        set ::qcallback($req) $cid
    }
    putquick "WHO $req n%nat,734"
}
bind raw - 354 qcall
bind raw - 315 qend
proc qcall {f k t} {
    set t [string tolower $t]
    foreach {bn num nick auth} [split $t] break
    if {$num != 734} { return 0 }
    if {![info exists ::qcallback($nick)]} { return 1 }
    sendresult $nick $auth
    return 1
}
proc sendresult {nick auth} {
    foreach sid $::qcallback($nick) {
        puts $sid $auth; utimer 5 [list catch [list close $sid]]
    }
    unset ::qcallback($nick)
}
proc qend {f k t} {
    set t [string tolower $t]
    foreach {bn nick} [split $t] break
    if {![info exists ::qcallback($nick)]} { return 0 }
    sendresult $nick -1
    return 1
}


That's it.

Additional information:

[getqauth $nick] returning "-1" means: nick is not on the network (are your bots on the same network? :) )
[getqauth $nick] returning "0" means: nick is not authed

P.S.: You can, of course, cross-use it (files of bot1 copied and properly loaded to bot2 and vice versa) to make both bots able to use each other to retrieve authes
This post was edited 3 times, last on 05-21-2009, 02:22 by thommey
thommey  05-21-2009, 02:23   Jabber
(Administrator)
Member since 03/2004
62 Posts
Synchronous WHO Version (TCL 8.6 required)

                                                                                                                              
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
package require Tcl 8.6

bind raw - 354 who_info
bind raw - 315 end_of_who
bind pub - !auth who_pubcmd

proc who_pubcmd {nick host hand chan text} {
    if {$text == ""} {
        putserv "PRIVMSG $chan :Please specify a nickname"
        return 0
    }
    set text [lindex [split $text] 0]
    if {[info commands lookupwho_$text] ne ""} {
        putserv "PRIVMSG $chan :Sorry, already resolving the auth for that nickname, wait"
        return 0
    }
    coroutine lookupwho_$text lookupwho $text $chan
    return 0
}
proc lookupwho {nick chan} {
    putserv "WHO $nick n%na"
    set auth [yield]
    if {$auth eq ""} {
        putserv "PRIVMSG $chan :$nick is not on the network."
    } elseif {$auth eq "0"} {
        putserv "PRIVMSG $chan :$nick is not authed."
    } else {
        putserv "PRIVMSG $chan :$nick is authed as $auth"
    }

}
# ANSWER from server: End of /who - we got reply already?
proc end_of_who {from keyword text} {
    set targetnick [lindex [split $text] 1]
    if {[info commands lookupwho_$targetnick] ne ""} {
        lookupwho_$targetnick ""
        return 1
    }
    return 0
}

proc who_info {from keyword text} {
    if {[llength [set text [split $text]]] != 3} {
        return 0
    }
    set targetnick [lindex $text 1]
    set auth [lindex $text 2]
    if {[info commands lookupwho_$targetnick] ne ""} {
        lookupwho_$targetnick $auth
        return 1
        # return 1: Eggdrop will not parse it, so you can use a format you like
    }
    return 0
}

This post was edited 4 times, last on 01-08-2013, 17:44 by thommey
Advanced options for this topic:

Ignore this topic (Do not list this topic in the "unread topics" search. You are currently not ignoring this topic.)
Hide this topic (Hidden topics are not displayed in the topics list. This topic is currently not hidden.)
Go to forum

Unclassified NewsBoard 1.5.3-d | © 2003-4 by Yves Goergen