####################################################
# by wiebe @ QuakeNet
#
####################################################

# enforce +x bans, bind mode
# check bans (both internal and channel)
# rnban other script

setudef flag whox
setudef int whox-delay


####################################################
# whox:help:msg
####################################################
bind msgm fvlomn|fvlomn "help auth" whox:help:msgm
proc whox:help:msgm { n u h t } {
  if {[matchattr $h bkZ]} { return 0 }
  lappend o "auth: usage auth"
  lappend o "auth: attempts to auth you on Q account. only for global +A accounts."
  if {[info procs cnotice] == ""} { foreach l $o { puthelp "NOTICE $n :$l" }
  } else { foreach l $o { cnotice $n $l puthelp "auth: " } }
  putcmdlog "($n!$u) !$h! help auth"
  return 1
}


####################################################
# whox:msg
####################################################
bind msg -|- auth whox:msg
proc whox:msg { n u h t } {
  if {[matchattr $h bkZ]} { return 0 }
  if {![onchan $n] || [onchansplit $n]} { return 0 }
  set a [whox:get $n a]; if {$a != 0 && $a == ""} { return 0 }
  set f "n%tnfar,123"; puthelp "WHO $n $f"
}


####################################################
# whox:raw
####################################################
bind raw -|- "354" whox:raw
proc whox:raw { s n t } {
  if {$n != 354} { return 0 }
  set q "nfar"; set o ""; set t [lrange [split $t] 1 end]; set n ""; set a ""; set f ""; set x 1
  if {[lindex $t 0] != 123} { return 0 }
  if {[string match *c* $q]} { lappend o [lindex $t $x]; incr x }
  if {[string match *u* $q]} { incr x }
  if {[string match *i* $q]} { lappend o [lindex $t $x]; incr x }
  if {[string match *h* $q]} { incr x }
  if {[string match *s* $q]} { lappend o [lindex $t $x]; incr x }
  if {[string match *n* $q]} { set n [lindex $t $x]; incr x }
  if {[string match *f* $q]} { set f [lindex $t $x]; lappend o $f; incr x }
  if {[string match *d* $q]} { lappend o [lindex $t $x]; incr x }
  if {[string match *l* $q]} { lappend o [lindex $t $x]; incr x }
  if {[string match *a* $q]} { set a [lindex $t $x]; lappend o $a; incr x }
  if {[string match *r* $q]} { lappend o [string range [join [lrange $t $x end]] 1 end] }
  if {![onchan $n]} { return 0 }
  global whoxdb
  set m [string tolower $n]; set o [join $o]
  if {![info exists whoxdb($m)]} { set whoxdb($m) "" }
  whox:sethand $n $a $f
  if {[string equal -nocase $whoxdb($m) $o]} { return 0 }
  set whoxdb($m) $o
  # forward realname to other script to deal with rnbans
  return 0
}


####################################################
# whox:sethand
####################################################
proc whox:sethand { n a f } {
  if {[info procs sethand] == ""} { return 0 }

  set u [split [getchanhost $n] @]; set h [lindex $u 1]; set u [whox:strip [lindex $u 0]]
  if {$a == ""} { set a 0 }
  set b [whox:get $n a]
  if {$b == ""} { set b 0 }
  set x [nick2hand $n]; set y [finduser $n!$u@$a.users.quakenet.org]; set z "oper"

# add unknown users?
  if {![validuser $y] && ![validuser $x] && ![validuser $a] && $a != 0} {
    adduser $a *!*@$a.users.quakenet.org; chattr $a +A
    putlog "whox: adding new user $a"
    sethand $n $a
  }

  # was unknown
  if {![validuser $x]} {
    # authed and known user
    if {$a != 0 && [validuser $y]} {
      if {![validuser $y]} { return 0 }
      if {![matchattr $y A]} { return 0 }
      if {[matchattr $y Z]} { return 0 }
      sethand $n $y; return 1
    # is not authed or not known
    } else {
      # is not oper
      if {![string match "*\\**" $f]} { return 0 }
      if {![validuser $z]} { return 0 }
      if {![matchattr $z A]} { return 0 }
      if {[matchattr $z Z]} { return 0 }
      sethand $n $z; return 1
    }
  # was oper
  } elseif {[string equal -nocase $x $z]} {
    # is not oper
    if {![string match "*\\**" $f]} { unsethand $n }
    # is not authed
    if {$a == 0} { return 0 }
    # add to hand, remove from oper
    if {![validuser $y]} { return 0 }
    if {![matchattr $y A]} { return 0 }
    if {[matchattr $y Z]} { return 0 }
    if {[string equal -nocase $x $y]} { return 0 }
    sethand $n $y; return 1
  # was known
  } elseif {[validuser $x]} {
    # authed
    if {$a != 0} {
      if {![validuser $y]} { return 0 }
      if {![matchattr $y A]} { return 0 }
      if {[matchattr $y Z]} { return 0 }
      if {[string equal -nocase $x $y]} { return 0 }
      # add to hand
      sethand $n $y; return 1
    }
  }
  return 0
}


####################################################
# whox:part
####################################################
bind raw -|- "PART" whox:part
proc whox:part { s r t } {
  if {![string equal -nocase $r "PART"]} { return 0 }
  set s [split $s !@]; set t [split $t]; set n [lindex $s 0]; set c [lindex $t 0]
  if {![isbotnick $n] && ![validchan $c]} { return 0 }
  whox:unset $n $c
  return 0
}


####################################################
# whox:kick
####################################################
bind kick -|- * whox:kick
proc whox:kick { n u h c t m } { whox:unset $t $c }


####################################################
# whox:sign
####################################################
bind sign -|- * whox:sign; bind splt -|- * whox:sign
proc whox:sign { n u h c {m ""} } {
  if {[string equal -nocase $m "registered"]} { return 0 }
  if {[string equal -nocase $m "host change"]} { return 0 }
  whox:unset $n $c 1
}


####################################################
# whox:unset
####################################################
proc whox:unset { n c {q 0} } {
  global whoxdb
  if {[isbotnick $n]} {
    if {[validchan $c]} {
      foreach n [chanlist $c] {
        set n [string tolower $n]
        if {![info exists whoxdb($n)]} { continue }
        if {[whox:comchan $n $c]} { continue }
        unset whoxdb($n)
      }
    } else { foreach n [array names whoxdb] { if {![onchan $n] || [onchansplit $n]} { unset whoxdb($n) } } }
  } else {
    set n [string tolower $n]
    if {![info exists whoxdb($n)]} { return 0 }
    if {[info procs whowas:set] != ""} {
      set w "far"; set v ""; foreach e [split $w ""] { lappend v "$e=[whox:get $n $e]" }
      set v [join $v]; if {$v != ""} { whowas:set $n whox $v $c; whowas:set $n whox $v }
    }
    if {$q == 0 && [whox:comchan $n $c]} { return 0 }
    unset whoxdb($n)
  }
}


####################################################
# whox:nick
####################################################
bind nick -|- * whox:nick
proc whox:nick { n u h c m } {
  global whoxdb
  if {[string equal -nocase $n $m]} { return 0 }
  set n [string tolower $n]; set m [string tolower $m]
  if {![info exists whoxdb($n)]} { return 0 }
  set whoxdb($m) $whoxdb($n)
  unset whoxdb($n)
}


####################################################
# whox:time
####################################################
bind time -|- "* * * * *" whox:time
proc whox:time { n h d m y } {
  set n [clock seconds]; set f "%tnfar,123"; set o ""
  foreach c [channels] {
    if {![botonchan $c]} { continue }
    if {![channel get $c whox]} { continue }
    set d [channel get $c whox-delay]
    if {$d < 1} { set d 2; channel set $c whox-delay $d }
    if {[expr round(fmod($n / 60,$d))] > 0} { continue }
    if {[llength [chanlist $c]] > 800} { continue }
    if {[expr [string length [join $o ,]] + [string length $c]] > 480} {
      putserv "WHO [join $o ,] $f";  set o ""
    }
    lappend o $c
  }
  if {$o != ""} { putserv "WHO [join $o ,] $f" }
}


####################################################
# whox:get
####################################################
proc whox:get { n f } {
  set q "far"; set o ""; set x 0
  global whoxdb
  set n [string tolower $n]; set f [string tolower $f]
  if {![info exists whoxdb($n)]} { return "" }
  set t [split $whoxdb($n)]
  if {$f == "all"} { return [join $t] }
  if {[string match *c* $q]} { if {$f == "c"} { return [lindex $t $x] } ; incr x }
  if {[string match *i* $q]} { if {$f == "i"} { return [lindex $t $x] } ; incr x }
  if {[string match *s* $q]} { if {$f == "s"} { return [lindex $t $x] } ; incr x }
  if {[string match *f* $q]} { if {$f == "f"} { return [lindex $t $x] } ; incr x }
  if {[string match *d* $q]} { if {$f == "d"} { return [lindex $t $x] } ; incr x }
  if {[string match *l* $q]} { if {$f == "l"} { return [lindex $t $x] } ; incr x }
  if {[string match *a* $q]} { if {$f == "a"} { return [lindex $t $x] } ; incr x }
  if {[string match *r* $q]} { if {$f == "r"} { return [join [lrange $t $x end]]} }
  return ""
}


####################################################
# whox:comchan
####################################################
proc whox:comchan { n c } {
  foreach d [channels] {
    if {[botonchan $d] && [onchan $n $d] && ![onchansplit $n $d] && ![string equal -nocase $d $c]} { return 1 }
  }
  return 0
}


####################################################
# whox:strip
####################################################
proc whox:strip { m } {
  if {${::strict-host} == 0 && ![string match ?*!~@?* $m]} { set m [string map [list !~ !] $m] }
  return $m
}


set userflagdb(whox) {
  "whox.tcl: global A=allow access based on Q account"
}


set scriptdb(whox) {
  "gathers info from whox (extended who), account, realname, flags."
}