irc.pli

net plug source code

  SERVER_NOTICE {
   regsub {^\*\*\* Notice -- } $rest {} rest;
   regsub {^Received } $rest {} rest;
   if {[string match "*KILL message*Path:*" $rest]} {
     set irc($n,kpath) $rest;
     regsub -all {(KILL message for )|(\. From)|(Path:[^(]*)} $rest {} rest;
     regexp {^([^ ]*)(.*)$} $rest all nick more;
     set rest [format "%-9s KILLed by%s" $nick $more];
   } 
   if {[cequal $from $irc($n,server)]} {
     if {$to_me} {irc_show $n "[irc_time] $rest" server_notice 1} \
     else        {irc_show $n "[irc_time] -$arg- $rest" server_notice 1}
   } else {
     if {$to_me} {irc_show $n "[irc_time] -$from- $rest" server_notice 1} \
     else        {irc_show $n "[irc_time] -$from:$arg- $rest" server_notice 1}
   }
  }
  CLOSED       {
    puts "[irc_time] Called 'CLOSED' Handler for connect #$n !!!";
    if {$irc(reconnect)} {
      if {$irc(reconnect)<5} {set irc(reconnect) 5}
      set w $conn($n,txt);
      if {$irc($n,confirmed)} {
        set cmd "catch {destroy $w.bcancel}; [irc_reconnect_str $n 1]";
      } else { # if not really connected we can dismiss the window
        set cmd "catch {destroy .c$n}; [irc_reconnect_str $n 1]";
      }
      button $w.bcancel -cursor top_left_arrow -text Here -command \
   "after cancel [after [expr $irc(reconnect)*1000] $cmd];\
    destroy $w.bcancel;defOut $n 0 \": Cancelled!\" system"
      defOut $n 0 \
       "\n>>> Will try to reconnect in $irc(reconnect) s ...\
	\n>>> (Click " system;
      $w window create end -window $w.bcancel;
      defOut $n 0 " to cancel reconnection) " system
    }
  }
  NUMERIC {
    set nlst {}
    if {![cequal $from $irc($n,server)]} {
      lappend nlst $from;
    }
    if {![cequal $arg $N]} {
      lappend nlst $arg;
    }
    lappend nlst $cmd;
    set str "$rest\t([join $nlst])"
  }
  privmsg {
    set cmp "$from!$uhost $arg $rest"; 
    if {(!$irc(keep_dupl)) && ([cequal $cmp $irc($n,lastrecm)])} {
      puts "SKIPPED M$n $cmp"
      return;
    }
    set irc($n,lastrecm) $cmp;
    if {[regexp "\001(\[^\001\]+)\001" $rest all ctcp]} {
      # CTCPs (handle only one to avoid getting abused)
      global ircCtcp;
      if {[regexp {^ *([^ ]+)( (.*))?$} $ctcp all ctcpcmd ctcprest ctcpargs]} {
        set ctcpcmd [string toupper $ctcpcmd];
        if {[info exists ircCtcp($ctcpcmd)]} {
          eval $ircCtcp($ctcpcmd);
        }
        if {$to_me} {
	  irc_show $n "[irc_time] CTCP from $from ($uhost) : $ctcp";
        } else {
	  irc_show $n "[irc_time] CTCP from $from ($uhost) on $arg : $ctcp";
        }
        # if there was only one plain (normal) ctcp: stop here
        if {[regexp "^\001(\[^\001\]+)\001$" $rest]} return;
      }
    }
    if {$to_chan} {
      # valid channel message
      if {$to_curchan} {
        eval $ircOn(PUBLIC);
      } else {
        eval $ircOn(PUBLIC_OTHER);
      }
    } elseif {$to_me} {
      # private message to the client
      eval $ircOn(MSG);
      set irc($n,comanick) $from;
      irc_tabadd $n $from;
      if {$irc($n,away)||$irc($n,autoaway)} {
        if {$irc(away_notice)} {
          if {$irc($n,away)} {
	    irc_send $n "notice $from :is away: $irc($n,awaymsg)";
	  } else {
	    irc_send $n "notice $from :is away: [irc_aas [irc_idle $n]]";
	  }
        }
        if {$irc(beep_when_away)} IU_Beep;
      }
    } else {
      irc_show $n "### <$from!$uhost:$arg> $rest" unknown;
    }
  }
  notice {
      set cmp "$from!$uhost $arg $rest"; 
      if {$irc(show_once) && ([cequal $cmp $irc($n,lastrecn)])} {
        puts "SKIPPED N$n $cmp"
        return;
      }
      set irc($n,lastrecn) $cmp;
      if {[cequal "" $from]} {set from $irc($n,server)}
      if {([string match "*.*" $from])} {
        eval $ircOn(SERVER_NOTICE);
      } elseif {$to_chan} {
        # channel notice
	if {$to_curchan} {
	  irc_show $n "-$from- $rest" notice;
	} else {
          irc_show $n "-$from:$arg- $rest" notice;
	}
      } elseif {$to_me} {
        # notice to the client
	if {[regexp -nocase "^\001ping +(\[0-9\]+)\001$" $rest all pingv]} {
	  global clicks;
	  set delay [format %.2f [expr ($clicks-$pingv)/$irc(clicks)]];
	  irc_fshow $n "Delay for [format %9s $from] is [eval irc_cvrtsec [split $delay "."]]";
	} else {
	  irc_show $n "-$from!$uhost- $rest" notice;
	}
      } else {
	irc_show $n "### -$from!$uhost:$arg- $rest" unknown;
      }
    }
  wallops {
    irc_fshow $n "[irc_time] !$from! $rest" info;
  }
  invite {
    irc_fshow $n "[irc_time] $from ($uhost) invites you to $rest\
        \[/ij (alt-shift-j) to join]" private;
    set irc($n,autojoin) $rest;
    set irc($n,autojoinkey) "";
    update;
  }
  join {
    if {$from_me} {
       irc_fshow $n "*** You joined $rest" server;
    } else {
       regsub -all "\a(\[^ \]*)" $rest { (\1)} rest; 
       eval $ircOn(JOIN);
    }
  }
  mode {
    irc_fshow $n "[irc_time] $from mode $arg $rest" info;
  }
  part {
    set chan $arg;
    if {[cequal "" $rest]} {
      irc_fshow $n "[irc_time] $from left $chan" info;
    } else {
      irc_show $n "[irc_time] $from left $chan ($rest)" info;
    }
  }
  kick {
    set chan $arg;
    regexp {([^ ]+) :(.*)} $rest all who why;
    if {[cequal $nick [string tolower $who]]} {
      irc_show $n "[irc_time] KICKED from $chan by $from ($uhost) ($why)"\
	error;
      set irc($n,autojoin) $chan;
      set irc($n,autojoinkey) [irc_get_chan_key $chan];
    } else {
      irc_show $n "[irc_time] $who was kicked by $from ($why)" info;
    } ;
  }
  001 {
    set irc($n,server) $from;
    set irc($n,nick) $arg; irc_nickhl $n;
    irc_add_nick $n $arg;
    irc_fshow $n "[irc_time] $rest" server;
    set irc($n,confirmed) 1;
    if {$irc($n,myip)==0} {irc_set_my_ip $n}
  }
  352 {
    if {![regexp {^([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) :(.*)$} \
      $rest all    chan    login   host    server  nick    mode     info]} {
      irc_fshow $n "[irc_time] can't parse '352 $rest'" error;
    } else {
      irc_show $n "[format "%9s %-3s %s@%s (%s)" $nick $mode $login $host\
                      $info]" server 1;
    } 
  }
  305 {
      set irc($n,statusaway) "";
      set irc($n,away) 0;
      set irc($n,autoaway) 0;
  }
  306 {
      set irc($n,statusaway) "(away)";
  }
  376 { # end of motd + autoexecs handling
    irc_fshow $n "[irc_time] $rest\t($from $cmd)" server;
    update;
    if {$irc($n,login)} { # do it the first time only
      set irc($n,login) 0;
      foreach cmd $irc($n,autoexec) {
        irc_fshow $n "+++ AutoExec (arg): $cmd" system;
        IrcDo $n $cmd;
      }
      if {$irc($n,doautoexec)} {
        foreach cmd $irc(autoexec) {
          irc_fshow $n "+++ AutoExec  (rc): $cmd" system;
          IrcDo $n $cmd;
        }
      }
    }
  }
  319 {
    irc_fshow $n "*** channels $rest" server;
  }   
  311 {
    if {[regexp {^([^ ]+) +([^ ]+) ([^ ]+) ([^ ]+) :(.*)$} $rest all\
	            nick login host info name]} {
      # special 'security' handling:
      defOut $n 0 "*** $nick is $login@$host $info (" server;
      irc_combine $n [irc_highlight $n $name server] server;
      defOut $n 0 ")\n" server;
      if {[regexp $irc($n,log) server]} {
         irc_filelog "*** $nick is $login@$host $info ($name)";
      }
      set irc($n,lastreca) "";
    } else {
      irc_fshow $n "*** 311 $rest" unknown;
    }
  }
  314 {
    if {[regexp {^([^ ]+) +([^ ]+) ([^ ]+) ([^ ]+) :(.*)$} $rest all\
	            nick login host info name]} {
      irc_fshow $n "*** $nick was $login@$host $info ($name)" server;
    } else {
      irc_fshow $n "*** 314 $rest" unknown;
    }
  }
  312 {
    irc_fshow $n "*** server $rest" server ; update;
  }   
  301 {
    if {$irc(show_once) && ([cequal $rest $irc($n,lastreca)])} {
      puts "SKIPPED AWAY$n $rest"
      return;
    }
    set irc($n,lastreca) $rest;
    regexp {^([^ ]+) :(.*)$} $rest all nick msg;
    set rest "$nick is away : $msg"
    eval $ircOn(NUMERIC);
    irc_fshow $n "*** $str" server
  }
  313 {
    regexp {^([^ ]+) :(.*)$} $rest all nick msg;
    set rest "$nick $msg"
    eval $ircOn(NUMERIC);
    irc_fshow $n "*** $str" server
  }
  353 {
    irc_show $n "*** Users $rest" server 1;
  }
  404 {
    # moderated channel
    regexp {([^ :]+) *:(.*)} $rest all chan why;
    irc_fshow $n "[irc_time] Message not seen on $chan ($why)" error;
  }
  332 {
    regexp {([^: ]+) *:(.+)} $rest all arg rest;
    irc_show $n "*** Topic for $arg: $rest" server;
  }
  topic {
    irc_show $n "[irc_time] $from changed topic on $arg to $rest" info;
  }
  nick {
    if {$from_me} {
      irc_fshow $n "### You are now know as $rest (was $from)" info;
      irc_add_nick $n $rest;
      set irc($n,nick) $rest; irc_nickhl $n;
    } else {
      irc_show $n "[irc_time] $from is now known as $rest" info;
    }
  }
  kill {
    irc_show $n "[irc_time] KILLed $arg from $from ($uhost) : $rest" error;
  }
  error {
    irc_show $n "[irc_time] Error $arg $rest" error;
  }
  quit {
     irc_show $n "[irc_time] Signoff: $from ($rest)" info;
  }
  322 { # /list output : update !
    irc_fshow $n "*** $rest" server ; update ;
  }
  372 { # motd, don't update before the end...
    irc_show $n "*** $rest" server 0 0;
  }
  366 {# end of names (after join)
    update;
  }
  324 { # mode (channel)
    irc_fshow $n "*** Mode $rest" server;
  }
  367 { # bans
    if {[scan $rest "%s %s %s %d" channel ban nick ts]==4} {
      irc_fshow $n "*** Ban on $channel: $ban (by $nick [irc_cvrtTS $ts])" \
	server;
    } else {
      irc_fshow $n "*** Ban $rest" server;
    }
  }
  221 { # mode (user)
    irc_fshow $n "*** Mode $arg $rest" server;
  }
  333 {
    scan $rest "%s %s %d" channel nick ts;
    irc_fshow $n "*** $channel topic set by $nick on [irc_cvrtTS $ts]" server;
  }
  329 { # TS: channel creation date
    scan $rest "%s %d" channel ts;
    irc_fshow $n "*** $channel created [irc_cvrtTS $ts]" server;
  }
  317 { # idle (and signon (TS))
    set ret [scan $rest "%s %d %d" nick idle signon];
    switch $ret {
      2 {irc_fshow $n "*** $nick has been idle [irc_cvrtsec $idle]" server}
      3 {irc_fshow $n "*** $nick has been idle [irc_cvrtsec $idle], Signon\
                     [irc_cvrtTS $signon]" server}
      default {irc_fshow $n "*** $rest" unknown}
    }
  }
  341 {
    irc_fshow $n "[irc_time] Invited $rest" info;
  }
}

# potentially floody returns:
foreach num {211 216 215} {
  set ircOn($num) {irc_fshow $n "*** $rest" server;update}
}

foreach num {484} {
  set ircOn($num) {irc_fshow $n "[irc_time] $rest" info}
}

#NUMERICS

foreach num {401 402 406} {
  set ircOn($num) {    
    eval $ircOn(NUMERIC)
    irc_fshow $n "*** $str" server
  }
}

# ignored numerics  (end of xxx)
proc noop args {}
foreach num {315 369} {
  set ircOn($num) {noop}
}
# channel join problems
foreach num {467 471 475 405 474 473} {
  set ircOn($num) {
    eval $ircOn(NUMERIC)
    regexp {([^ :]+) *:(.*)} $rest all chan why;
    irc_fshow $n "### Can't join $chan ($why)\t([join $nlst])" error;
  }
}

foreach num {432 433 437} {
  set ircOn($num) {
    irc_fshow $n "*** $rest" error;
    if {[cequal $arg "*"]} {  
      if {$irc(auto_nick)} {
        while 1 {
	  set nn [lindex $irc(nicklist) $irc($n,autonick)];
	  if {[cequal $nn ""]} {
	    irc_fshow $n "### All auto nicks tried unsuccessfully..." system;
	    break;
	  }
	  incr irc($n,autonick);
	  if {[cequal $nn $N]} continue;
	  irc_fshow $n "### Auto nick trying with $nn" system;
          IrcDo $n "/NICK $nn";
          return;
        }
      }
      irc_fshow $n "### Please choose another nick:" error;
      CmdSet $n "/NICK ";
    }
  }
}

############# End of Incoming (server) message handling ######################


############## Log utility
proc irc_filelog {n msg} {
  global irc dotdir;
  if ![info exists irc($n,logfile)] {
    set fname [subst $irc($n,logfilename)]
    if {[cequal $fname ""]} return; # no filename, no log
    defOut $n 0 "[irc_time] Opening Logfile $fname\n" system;
    set f [set irc($n,logfile) [open $fname "a+"]];
    if {[cequal "" $irc($n,logmsgn)]} {
      set irc($n,logmsgn) 1;
    } {
      incr irc($n,logmsgn);
    }
  } else {
    incr irc($n,logmsgn);
    set f $irc($n,logfile);
  }
  seek $f 0 end;
  puts $f "[format %02d $n] [clock format [clock seconds] \
              -format {[%a %b %d %H:%M]}] $msg";
  flush $f;
}



############## DCC utility
proc n2dot n {
  set n [format "%08x" $n];
  for {set i 0} {$i<8} {incr i 2} {
    lappend res [expr 0x[string range $n $i [expr $i+1]]]
  }
  join $res .
}
proc dot2n dot {format "%u" [eval format "0x%02x%02x%02x%02x" [split $dot .]]}

proc quotesubst {str} {
 regsub -all {\\} $str {\\\\} str;
 regsub -all {([][$ ])} $str {\\\1} str;
 set str;
}

proc dcc_query {n from dcc1 dcc2 dcchost dccport dccsize} {
  global ircAlias;
  set host [n2dot $dcchost];
  irc_show $n \
    "[irc_time] DCC $dcc1 $dcc2 from $from for $host $dccport ($dccsize)" \
    system;
  switch -exact -- $dcc1 {
    "SEND" {
      irc_fshow $n "*** type /GET to get it" system;
      set ircAlias(GET) "DCC GET [quotesubst [file tail $dcc2]]\
                               $host $dccport $dccsize"
    }
    "CHAT" {
       irc_fshow $n "*** type /ACCEPT to open chat connection" system; 
       set ircAlias(ACCEPT) "DCC CONNECT [quotesubst $from] $host $dccport"
    }
  }
}

# start/stop dcc file server :
proc dcc_file_