HELP on eggping.tcl ping-reply modification

[arfer]

I guess I was thinking [clock clicks -milliseconds] would always be a huge negative integer and therefore the math would be fine. I see your point.

I have decided to revert to your idea of saving the millisecond granularity timestamp and sending [unixtime] as a dummy ctcp ping argument.

The script is now complete (I hope). I put your nick on it as a joint effort. Hope you don't mind.

Calculates the absolute difference between the ctcp request and the ctcr reply.

Tested and functions well. There are still those that block ctcp requests and I can't say for certain that this works with every single IRC client but I think it's as good as we're going to get.

Code: Select all

# ping.tcl by arfer/nml375
# requires Tcl 8.3 or later
# requires channel to permit embelished text (colour) output
# each #channelname the script is to function in requires (in the partyline) .chanset #channelname +ping
# assuming default trigger "." (period) syntax would be .ping ?target?

##### CONFIGURATION #########

set vPingTrigger "."

##### CODE ##################

proc pPingTrigger {} {
  global vPingTrigger
  return $vPingTrigger
}

set vPingVersion 1.0

setudef flag ping

bind CTCR - PING pPingCtcrReceive
bind PUB - [pPingTrigger]ping pPingPubCommand
bind RAW - 401 pPingRawOffline

proc pPingTimeout {} {
  global vPingOperation
  set schan [lindex $vPingOperation 0]
  set snick [lindex $vPingOperation 1]
  set tnick [lindex $vPingOperation 2]
  putserv "PRIVMSG $schan :\00304Error\003 (\00314$snick\003) operation timed out attempting to ping \00307$tnick\003"
  unset vPingOperation
  return 0
}

proc pPingCtcrReceive {nick uhost hand dest keyword txt} {
  global vPingOperation
  if {[info exists vPingOperation]} {
    set schan [lindex $vPingOperation 0]
    set snick [lindex $vPingOperation 1]
    set tnick [lindex $vPingOperation 2]
    set time1 [lindex $vPingOperation 3]
    if {([string equal -nocase $nick $tnick]) && ([regexp -- {^[0-9]+$} $txt])} {
      set time2 [clock clicks -milliseconds]
      set elapsed [expr {abs($time2 - $time1) / 1000.0}]
      set char [encoding convertto utf-8 \u258C]
      if {[expr {round($elapsed / 0.5)}] > 10} {set red 10} else {set red [expr {round($elapsed / 0.5)}]}
      set green [expr {10 - $red}]
      set output \00303[string repeat $char $green]\003\00304[string repeat $char $red]\003
      putserv "PRIVMSG $schan :\00310Compliance\003 (\00314$snick\003) $output $elapsed seconds from \00307$tnick\003"
      unset vPingOperation
      pPingKillutimer
    }
  }
  return 0
}

proc pPingKillutimer {} {
  foreach item [utimers] {
    if {[string equal pPingTimeout [lindex $item 1]]} {
      killutimer [lindex $item 2]
    }
  }
  return 0
}

proc pPingPubCommand {nick uhost hand channel txt} {
  global vPingOperation
  if {[channel get $channel ping]} {
    switch -- [llength [split [string trim $txt]]] {
      0 {set tnick $nick}
      1 {set tnick [string trim $txt]}
      default {
        putserv "PRIVMSG $channel :\00304Error\003 (\00314$nick\003) correct syntax is \00307!ping ?target?\003"
        return 0
      }
    }
    if {![info exists vPingOperation]} {
      if {[regexp -- {^[\x41-\x7D][-\d\x41-\x7D]*$} $tnick]} {
        set time1 [clock clicks -milliseconds]
        putquick "PRIVMSG $tnick :\001PING [unixtime]\001"
        utimer 20 pPingTimeout
        set vPingOperation [list $channel $nick $tnick $time1]
      } else {putserv "PRIVMSG $channel :\00304Error\003 (\00314$nick\003) \00307$tnick\003 is not a valid nick"}
    } else {putserv "PRIVMSG $channel :\00304Error\003 (\00314$nick\003) a ping operation is still pending, please wait"}
  }
  return 0
}

proc pPingRawOffline {from keyword txt} {
  global vPingOperation
  if {[info exists vPingOperation]} {
    set schan [lindex $vPingOperation 0]
    set snick [lindex $vPingOperation 1]
    set tnick [lindex $vPingOperation 2]
    if {[string equal -nocase $tnick [lindex [split $txt] 1]]} {
      putserv "PRIVMSG $schan :\00304Error\003 (\00314$snick\003) \00307$tnick\003 is not online"
      unset vPingOperation
      pPingKillutimer
    }
  }
  return 0
}

putlog "ping.tcl by arfer/nml375 version $vPingVersion loaded"

[nml375]

Eeek!
Looks nice now, the remaining abs() is overkill, or could cause a huge delay in the event of a "wraparound", that is, when we reach the end of our 32bit signed integer and we go from 2147483647 to -2147483648 (or in the case of 64bit signed integers, even larger ranges).

The best approach would be to trim the timestamp using the modulus operator (%), and then do the same to the difference. This will give us a limited range, but we'll always have a positive value, and it's bound to be correct within the range.

I'll post a sample below, the value for the modulus operation was chosen to be the number of microseconds in a day:

Code: Select all

set $mod 3600000
#First we start with two arbitrary values that won't cause an overflow:
% set then 1242353145
% set now [expr $then +1342]
1242354487
% set _then [expr $then % $mod]
353145
% set _now [expr $now % $mod]
354487
% expr ($_now - $_then) % $mod
1342
#Yay, we got 1342, which is the differential we started with, works sofar... now lets try a "borderline value"..

% set then [expr $mod - 200]
3599800
% set now [expr $then +1342]
3601142
% set _then [expr $then % $mod]
3599800
% set _now [expr $now % $mod]
1142
% expr $_now - $_then
-3598658
% expr ($_now - $_then) % 3600000
1342
#Once again, we got 1342 in the end. Here you can also see the issue of these "borderline values", as we get a huge negative value. Simply using abs() on this would tell us it took one day for the ping reply to come back...

Oh, and btw, thnx for the credits.

[VinceDalnet]

arfer: im getting the following error on your new codes

Tcl error [pingreply]: can't read "chan": no such variable

[nml375]

I can't find a singe proc named "pingreply" in arfer's script. Could it be possible your old script is still loaded?

[VinceDalnet]

sorry it was this code that i gotten the errors...

Code: Select all

bind CTCR - PING pPingCtcrReceive
bind PUB - .ping pPingPubCommand
bind RAW - 401 pPingRawOffline

proc pPingTimeout {} {
  global vPingOperation
  set schan [lindex $vPingOperation 0]
  set snick [lindex $vPingOperation 1]
  set tnick [lindex $vPingOperation 2]
  putserv "PRIVMSG $schan :\00304Error\003 (\00314$snick\003) operation timed out attempting to ping \00307$tnick\003"
  unset vPingOperation
  return 0
}

proc pPingCtcrReceive {nick uhost hand dest keyword txt} {
  global vPingOperation
  if {[info exists vPingOperation]} {
    set schan [lindex $vPingOperation 0]
    set snick [lindex $vPingOperation 1]
    set tnick [lindex $vPingOperation 2]
    if {([string equal -nocase $nick $tnick]) && ([regexp -- {^[0-9]+$} $txt])} {
      set seconds [expr {abs((abs([clock clicks -milliseconds]) - $txt) / 1000.0)}]
      set char [encoding convertto utf-8 \u258C]
      if {[expr {round($seconds / 0.5)}] > 10} {set red 10} else {set red [expr {round($seconds / 0.5)}]}
      set green [expr {10 - $red}]
      set output \00303[string repeat $char $green]\003\00304[string repeat $char $red]\003
      putserv "PRIVMSG $schan :\00310Compliance\003 (\00314$snick\003) $output $seconds seconds from \00307$tnick\003"
      unset vPingOperation
      pPingKillutimer
    }
  }
  return 0
}

proc pPingKillutimer {} {
  foreach item [utimers] {
    if {[string equal pPingTimeout [lindex $item 1]]} {
      killutimer [lindex $item 2]
    }
  }
  return 0
}

proc pPingPubCommand {nick uhost hand channel txt} {
  global vPingOperation
  switch -- [llength [split [string trim $txt]]] {
    0 {set tnick $nick}
    1 {set tnick [string trim $txt]}
    default {
      putserv "PRIVMSG $channel :\00304Error\003 (\00314$nick\003) correct syntax is \00307!ping ?target?\003"
      return 0
    }
  }
  if {![info exists vPingOperation]} {
    if {[regexp -- {^[\x41-\x7D][-\d\x41-\x7D]*$} $tnick]} {
      set vPingOperation [list $channel $nick $tnick]
      putserv "PRIVMSG $tnick :\001PING [expr {abs([clock clicks -milliseconds])}]\001"
      utimer 20 pPingTimeout
    } else {putserv "PRIVMSG $channel :\00304Error\003 (\00314$nick\003) \00307$tnick\003 is not a valid nick"}
  } else {putserv "PRIVMSG $channel :\00304Error\003 (\00314$nick\003) a ping operation is still pending, please wait"}
  return 0
}

proc pPingRawOffline {from keyword txt} {
  global vPingOperation
  if {[info exists vPingOperation]} {
    set schan [lindex $vPingOperation 0]
    set snick [lindex $vPingOperation 1]
    set tnick [lindex $vPingOperation 2]
    if {[string equal -nocase $tnick [lindex [split $txt] 1]]} {
      putserv "PRIVMSG $schan :\00304Error\003 (\00314$snick\003) \00307$tnick\003 is not online"
      unset vPingOperation
      pPingKillutimer
    }
  }
  return 0
} 

although the latest code still didnt produce any good result,... in fact it doesnt ping anyone... even if i already .chanset #chan +ping

[nml375]

Now I'm even more confused...
There still is no proc in there named "pingreply". Further, arfer's script does not test whether the channel is set +ping or not..

Do you get any error messages logged, or any other information from your bot?

Be advised that the version you posted still suffers from the issue of negative integers (causing mIRC and other clients to ignore the ping request), and is one of the older ones posted here...

Edit: Reading your post again, and I believe I misunderstood you alittle.
The script you posted is the one you do not use anymore, and you are currently using the last one posted by arfer?
(and yes, I admit that one does care for the +ping channel setting)

[arfer]

My last effort does test if the channel is +ping but it isnt responsible for the errors that VinceDalnet is experiencing.

Code: Select all

if {[channel get $channel ping]} {
# code
}

VinceDalnet repasted a prior version. Check my last post under this thread.

VinceDalnet, unload everything previously loaded, source my last version and restart your bot (not rehash). As nml375 suggested, there is no pingreply proc/command in my script.

Not sure I understand the modulus code. Aren't there way more than 3600000 microseconds in a day?

I get an immediate and correct resonse from a public command tclsh script using the values you suggested might take a long time to evaluate, as follows :-



Unless you are infering that at some point in time the return value from [clock clicks -milliseconds] changes from one of these extremes to the other.

[VinceDalnet]

works perfectly now! thanks alot to both of you...


pls add it in egghelp tcl archive so everybody will use it.

[arfer]

OK, I see that is exactly what you are infering and will occur at some point in time.

I still don't get the math though. Please bare with me because I'd like to incorporate this if it is the correct thing to do.

Maybe I'm reading it wrong.

Let me suggest an arbitrary scenario and you explain where I'm misunderstanding. I will use your $mod value of 3600000 (milliseconds per hour I assume you meant).

Say, my two [clock clicks -milliseconds] (once for the CTCP and again for the CTCR) cross over this 32 bit boundary and are 5.2 seconds (5200 milliseconds) apart.

Say, the first CTCP [clock clicks -milliseconds] returns 2147483481.

After 167 milliseconds it would cross the boundary and wrap to -2147483648 and after a further 5033 milliseconds (5200 total) the CTCR [clock clicks -milliseconds] would return -2147478615.

2147483481 % 3600000 = 1883481
-2147478615 % 3600000 = 1721385

(1883481 - 1721385) % 3600000 = 162096

I just don't get how this equates to the 5.2 seconds.

[speechles]

Code: Select all

<speechles> .tcl set now [clock seconds]
<sp33chy> Tcl: 1236481292
<speechles> .tcl set then [expr {$now - 500000000}]
<sp33chy> Tcl: 736481292
<speechles> .tcl set little_endian [expr {($now - $then) % 3600000}]
<sp33chy> Tcl: 3200000
<speechles> .tcl set big_endian [expr {($now - $then)/3600000}]
<sp33chy> Tcl: 138
<speechles> .tcl set total_ping "${big_endian}.${little_endian} seconds"
<sp33chy> Tcl: 138.3200000 seconds

You can use the endian method to store larger values without losing original signs, both modulus and division can do that. The big endian in this case is your seconds, the little endian is your remainder.

[nml375]

Hmm.. think I'm forgetting something.

Ah yes, the modulus value has to be of the same power as the base of the timestamp wraparound, in this case, base2. Using a slightly larger value, 2 to the power of 24 (16'777'216), will make this work.

Code: Select all

% set t1 [expr 2147483481 % 16777216]
16777049
% set t2 [expr -2147478615 % 16777216]
5033
%  expr ($t2 - $t1) % 16777216
5200

Basically, the point of this arithmetic is to remove negative numbers by shrinking the numbers to a smaller, unsigned, space. This is best viewed as binary numbers in 2-complement, where the most significant byte (MSB) determines sign (1 = negative, 0 = positive). If we simply cut off the MSB and then 0-pad to the proper length again, we end up with a positive value.
As long as we are dealing with relative values where the difference is lower than the size of our smaller numbers, we will end up with a valid result.

Code: Select all

 011101 #1+4+8+16: 29
+000110 #2+4: 6
=100011 #-32 +1 + 2: -29

#Lets use mod16
011101 => 001101: 13
100011 => 000011: 3

#Lets get the difference, I could do this in binary aswell, but I'm lazy..
3 - 13 => -10: 110110

#Now again, use mod16
110110 => 000110: 2 + 4: 6

[nml375]

Speech,
Sorry, but I fail to see how that relates to this math issue?

[arfer]

Thanks again!

Final version

Code: Select all

# ping.tcl by arfer/nml375
# requires Tcl 8.4 or later
# requires channel to permit embelished text (colour) output
# each #channelname the script is to function in requires (in the partyline) .chanset #channelname +ping
# assuming default trigger "." (period) syntax would be .ping ?target?


##### CHANGELOG #############

# 1.0 07/03/09 beta
# 1.1 08/03/09 changed abs() math to modulus math to interpret integer wraparound

##### CONFIGURATION #########

set vPingTrigger "."

##### CODE ##################

proc pPingTrigger {} {
  global vPingTrigger
  return $vPingTrigger
}

set vPingVersion 1.1

setudef flag ping

bind CTCR - PING pPingCtcrReceive
bind PUB - [pPingTrigger]ping pPingPubCommand
bind RAW - 401 pPingRawOffline

proc pPingTimeout {} {
  global vPingOperation
  set schan [lindex $vPingOperation 0]
  set snick [lindex $vPingOperation 1]
  set tnick [lindex $vPingOperation 2]
  putserv "PRIVMSG $schan :\00304Error\003 (\00314$snick\003) operation timed out attempting to ping \00307$tnick\003"
  unset vPingOperation
  return 0
}

proc pPingCtcrReceive {nick uhost hand dest keyword txt} {
  global vPingOperation
  if {[info exists vPingOperation]} {
    set schan [lindex $vPingOperation 0]
    set snick [lindex $vPingOperation 1]
    set tnick [lindex $vPingOperation 2]
    set time1 [lindex $vPingOperation 3]
    if {([string equal -nocase $nick $tnick]) && ([regexp -- {^[0-9]+$} $txt])} {
      set time2 [expr {[clock clicks -milliseconds] % 16777216}]
      set elapsed [expr {(($time2 - $time1) % 16777216) / 1000.0}]
      set char [encoding convertto utf-8 \u258C]
      if {[expr {round($elapsed / 0.5)}] > 10} {set red 10} else {set red [expr {round($elapsed / 0.5)}]}
      set green [expr {10 - $red}]
      set output \00303[string repeat $char $green]\003\00304[string repeat $char $red]\003
      putserv "PRIVMSG $schan :\00310Compliance\003 (\00314$snick\003) $output $elapsed seconds from \00307$tnick\003"
      unset vPingOperation
      pPingKillutimer
    }
  }
  return 0
}

proc pPingKillutimer {} {
  foreach item [utimers] {
    if {[string equal pPingTimeout [lindex $item 1]]} {
      killutimer [lindex $item 2]
    }
  }
  return 0
}

proc pPingPubCommand {nick uhost hand channel txt} {
  global vPingOperation
  if {[channel get $channel ping]} {
    switch -- [llength [split [string trim $txt]]] {
      0 {set tnick $nick}
      1 {set tnick [string trim $txt]}
      default {
        putserv "PRIVMSG $channel :\00304Error\003 (\00314$nick\003) correct syntax is \00307!ping ?target?\003"
        return 0
      }
    }
    if {![info exists vPingOperation]} {
      if {[regexp -- {^[\x41-\x7D][-\d\x41-\x7D]*$} $tnick]} {
        set time1 [expr {[clock clicks -milliseconds] % 16777216}]
        putquick "PRIVMSG $tnick :\001PING [unixtime]\001"
        utimer 20 pPingTimeout
        set vPingOperation [list $channel $nick $tnick $time1]
      } else {putserv "PRIVMSG $channel :\00304Error\003 (\00314$nick\003) \00307$tnick\003 is not a valid nick"}
    } else {putserv "PRIVMSG $channel :\00304Error\003 (\00314$nick\003) a ping operation is still pending, please wait"}
  }
  return 0
}

proc pPingRawOffline {from keyword txt} {
  global vPingOperation
  if {[info exists vPingOperation]} {
    set schan [lindex $vPingOperation 0]
    set snick [lindex $vPingOperation 1]
    set tnick [lindex $vPingOperation 2]
    if {[string equal -nocase $tnick [lindex [split $txt] 1]]} {
      putserv "PRIVMSG $schan :\00304Error\003 (\00314$snick\003) \00307$tnick\003 is not online"
      unset vPingOperation
      pPingKillutimer
    }
  }
  return 0
}

putlog "ping.tcl by arfer/nml375 version $vPingVersion loaded"

[nml375]

Your welcome,
always fun with overworked mathematical exercises, especially when one have to explain and motivate the arithmetic
(Yes, I'm a geek, and I'm proud of it

Code/math looks flawless now.

[VinceDalnet]

pls do something about this so the script doesnt look silly...


[02:20:22] <+ ASucAL> !ping me
[02:20:24] <@ Voltron> Error(ASucAL) me is not online


thanks in advance