xrl.tcl v2.32 by jer@usa.com

[eggman]

How can I add a catcher so <nick@anotherircnet> http://example.com/index.html is caught?

Maybe <*> http://example.com/index.html where * is a wildcard or any text between the initial < >'s

Code: Select all

#!/bin/sh
# \
exec tclsh "$0" "$@"
package require http 2.2
;###############################################################################
set xrl(version) "xrl.tcl v2.32 by jer@usa.com" ;# updated: 2007.02.14
;###############################################################################
;# * command-line:
;#   * $ ./xrl.tcl 'http://www.icaughtyouadeliciousbass.com/'
;# * console:
;#   * $ ./xrl.tcl
;#   * http://www.dontbejealousthativebeenchattingonlinewithbabesallday.com/
;# * eggdrop:
;#   * .chanset #channel +xrl +unxrl +logallurls
;#   * /msg #channel http://www.icaughtyouadeliciousbass.com/
;#   * /msg bot http://www.icaughtyouadeliciousbass.com/
;###############################################################################
set xrl(antiflags) "bdkqr|dkqr" ;# user flags to ignore for eggdrop use
set xrl(msgmflags) "o|o" ;# user flags required for message eggdrop use
set xrl(pubmflags) "-|-" ;# user flags required for channel eggdrop use
set xrl(length) 40 ;# minimum url length to trigger channel eggdrop use
set xrl(delay) 30 ;# minimum seconds to wait before another eggdrop use
set xrl(last) 408 ;# internal variable, stores time of last eggdrop use
;###############################################################################
proc xrl {url} {
 if {[info exists url] && [string length $url]} {
  if {[regexp {http://xrl\.us/\w+} $url]} {
   set http [::http::geturl $url -timeout 9000]
   upvar #0 $http state ; array set meta $state(meta)
   ::http::cleanup $http ; return $meta(Location)
  } else {
   set http [::http::geturl "http://metamark.net/add" \
     -query [::http::formatQuery "long_url" $url] -timeout 9000]
   set data [split [::http::data $http] \n] ; ::http::cleanup $http
   for {set index [llength $data]} {$index >= 0} {incr index -1} {
    if {[regexp {href="http://xrl\.us/\w+"} [lindex $data $index] url]} {
     return [string map { {href=} "" \" "" } $url]
 }}}}
 return ""
}
;###############################################################################
;# tclsh command-line/console procedure
;###############################################################################
if {[info exists argc]} {
 if {$argc} {
  foreach arg [lrange $argv 0 end] {puts [xrl $arg]}
 } else {
  puts "$xrl(version)"
  puts "usage: $argv0 http://bullfrog.webhop.net/"
  puts "enter url(s), one per line, press ctrl+c to cancel:"
  while {[gets stdin line]} {puts [xrl [string trim $line]]}
 }
 exit
}
;###############################################################################
;# eggdrop channel message procedure
;###############################################################################
proc pubm:xrl {nick host user chan text} { global xrl
 if {([channel get $chan xrl] || [channel get $chan unxrl]) && \
     [expr [unixtime] - $xrl(delay)] > $xrl(last) && \
     ![matchattr $user $xrl(antiflags)]} {
  foreach word [split $text] {
   if {([channel get $chan xrl] && \
        [string length $word] >= $xrl(length) && \
        [regexp {^(f|ht)tp(s|)://} $word] && \
        ![regexp {://([^/:]*:([^/]*@|\d+(/|$))|.*/\.)} $word]) || \
       ([channel get $chan unxrl] && \
        [regexp {http://xrl.us/\w+} $word])} {
    set xrl(last) [unixtime]
    set newurl [xrl $word]
    if {[string length $newurl]} {
     puthelp "PRIVMSG $chan :<$nick> $newurl"
    }
    putlog "<$nick:$chan> $word <-> $newurl"
    break
 }}}
 if {[channel get $chan logallurls]} {
  foreach word [split $text] {
   if {[string match "*://*" $word]} {
    putlog "<$nick:$chan> $word"
 }}}
 return 0
}
bind pubm $xrl(pubmflags) {*://*} pubm:xrl
;###############################################################################
;# eggdrop private message procedure
;###############################################################################
proc msgm:xrl {nick host user text} { global xrl
 if {![matchattr $user $xrl(antiflags)] && \
     [expr [unixtime] - $xrl(delay)] > $xrl(last) && \
     [string match "*://*" [lindex [split $text] 0]] && \
     [llength [split $text]] == 1} {
  set xrl(last) [unixtime]
  set newurl [xrl $text]
  if {[string length $newurl]} {
   puthelp "PRIVMSG $nick :\1ACTION $newurl\1"
   putlog "<$nick> $text <-> $newurl"
 }}
 return 0
}
bind msgm $xrl(msgmflags) {*://*} msgm:xrl
;###############################################################################
;# eggdrop chanset flags
;###############################################################################
setudef flag xrl
setudef flag unxrl
setudef flag logallurls
;###############################################################################
putlog "loaded: $xrl(version)" ;# eggdrop log message
;###############################################################################

[eggman]

actually its "<relaynick> (chatnick@chatnet) http://www.website.com/blablabla"

[speechles]

actually its "<relaynick> (chatnick@chatnet) http://www.website.com/blablabla"

I'm guessing your relay script and xrl script are run on the same bot, otherwise it would work. You will need to edit your relay script and add this into it after it gives pub text output.

Code: Select all

putserv "privmsg $chan :<$nick@$network> $text"
pubm:xrl $nick foo $hand $chan $text

The above is merely an example. The bottom line of code will invoke xrl. This is how you would need to do it on a single bot relay/xrl. Of course that channel must be +xrl as well. This is common sense.

To get the $hand variable to contain the handle of the nickname relayed may not be possible... You may need to change the check shown below:

Code: Select all

 if {([channel get $chan xrl] || [channel get $chan unxrl]) && \
     [expr [unixtime] - $xrl(delay)] > $xrl(last) && \
     ![matchattr $user $xrl(antiflags)]} { 

To look like this:

Code: Select all

 if {([channel get $chan xrl] || [channel get $chan unxrl]) && \
     [expr [unixtime] - $xrl(delay)] > $xrl(last)} { 

Then you won't need the $hand variable and can craft the invocation like the way it is below:

Code: Select all

pubm:xrl $nick foo bar $chan $text

This way we only need to pass the nickname, channel and text to the procedure. The other 2 variables $uhost and $handle aren't required since they aren't used. Hence they are invoked as "foo" and "bar" basically just used to fill the space with something so the other arguments passed line up correctly.