Check-in [f0e00464c6]
Overview
SHA1:f0e00464c66a28e1dac0ed6e83cb6e98e3f23b18
Date: 2016-09-13 20:35:19
User: rkeene
Comment:A few changes to tclircd more usable
Timelines: family | ancestors | descendants | both | trunk
Downloads: Tarball | ZIP archive
Other Links: files | file ages | folders | manifest
Tags And Properties
Context
2016-09-15
03:13
[658b5cfcc1] Added additional NICK syntax support (user: rkeene, tags: trunk)
2016-09-13
20:35
[f0e00464c6] A few changes to tclircd more usable (user: rkeene, tags: trunk)
20:34
[84ca00fb7b] Added tclircd-0.1a.tar.gz (sha1: adbd16a5d187f6e1b3c4c0c663920d6151061626) (user: rkeene, tags: trunk)
Changes

Modified ircd.tcl from [2540825ff6] to [1144d83de8].

   152    152   		    -> channel topic]} \
   153    153   	{
   154    154   	    handleClientTopic $fd $channel $topic
   155    155   	} elseif {[regexp -nocase {^LIST *(.*)$} $line -> channel]} {
   156    156   	    handleClientList $fd $channel
   157    157   	} elseif {[regexp -nocase {^WHOIS +(.+)$} $line -> nick]} {
   158    158   	    handleClientWhois $fd $nick
          159  +	} elseif {[regexp -nocase {^WHO *$} $line ->]} {
          160  +	    handleClientWho $fd ""
   159    161   	} elseif {[regexp -nocase {^WHO +([^ ]+) *(.*)$} $line -> channel _]} {
   160    162   	    handleClientWho $fd $channel
   161    163   	} elseif {[regexp -nocase {^MODE +([^ ]+) *(.*)$} $line -> target rest]} {
   162    164   	    handleClientMode $fd $target $rest
   163    165   	} elseif {[regexp -nocase {^USERHOST +(.+)$} $line -> nicks]} {
   164    166   	    handleClientUserhost $fd $nicks
   165    167   	} elseif {[regexp -nocase {^RELOAD +(.+)$} $line -> password]} {
................................................................................
   279    281       set channels [clientChannels $fd]
   280    282       foreach channel $channels {
   281    283   	userMessage $channel $fd $msg
   282    284       }
   283    285   }
   284    286   
   285    287   proc allChannels {} {
   286         -    array names ::channelInfo
          288  +    set retval [array names ::channelInfo]
          289  +
          290  +    # Remove this hidden channel from the list
          291  +    set removeIdx [lsearch -exact $retval "#[config reloadpasswd]"]
          292  +    if {$removeIdx != -1} {
          293  +        set retval [lreplace $retval $removeIdx $removeIdx]
          294  +    }
          295  +
          296  +    return $retval
   287    297   }
   288    298   
   289    299   # Note that this does not scale well if there are many
   290    300   # channels. For now data structures are designed to make
   291    301   # the code little. The solution is to duplicate this information
   292    302   # into the client state, so that every client have an associated
   293    303   # list of channels.
................................................................................
   418    428   	serverClientMsg $fd 319 "$nick :[join $chans]"
   419    429       }
   420    430       serverClientMsg $fd 312 "$nick [config hostname] :[config hostname]"
   421    431       serverClientMsg $fd 318 "$nick :End of /WHOIS list."
   422    432   }
   423    433   
   424    434   proc handleClientWho {fd channel} {
   425         -    foreach {topic userlist usermode} [channelInfoOrReturn $fd $channel] break
   426         -    foreach userfd $userlist mode $usermode {
   427         -	serverClientMsg $fd 352 "$channel ~[clientUser $userfd] [clientHost $userfd] [config hostname] $mode[clientNick $userfd] H :0 [clientRealName $userfd]"
          435  +    if {$channel eq ""} {
          436  +        foreach {nick userfd} [array get ::nickToFd] {
          437  +            serverClientMsg $fd 352 "## ~[clientUser $userfd] [clientHost $userfd] [config hostname] [clientNick $userfd] H :0 [clientRealName $userfd]"
          438  +        }
          439  +    } else {
          440  +        foreach {topic userlist usermode} [channelInfoOrReturn $fd $channel] break
          441  +        foreach userfd $userlist mode $usermode {
          442  +            serverClientMsg $fd 352 "$channel ~[clientUser $userfd] [clientHost $userfd] [config hostname] $mode[clientNick $userfd] H :0 [clientRealName $userfd]"
          443  +        }
   428    444       }
   429    445       serverClientMsg $fd 315 "$channel :End of /WHO list."
   430    446   }
   431    447   
   432    448   # This is a work in progress. Support for OP/DEOP is implemented.
   433    449   proc handleClientMode {fd target rest} {
   434    450       set argv {}
................................................................................
   471    487   	append res "$nick=+~[clientUser $nickfd]@[clientHost $nickfd] "
   472    488       }
   473    489       serverClientMsg $fd 302 ":[string trim $res]"
   474    490   }
   475    491   
   476    492   proc handleClientReload {fd password} {
   477    493       if {$password eq [config reloadpasswd]} {
   478         -	source [info script]
          494  +	uplevel #0 [list source [info script]]
   479    495       }
   480    496   }
   481    497   
   482    498   proc sendTopicMessage {fd channel} {
   483    499       foreach {topic userlist usermode} [channelInfo $channel] break
   484    500       if {$topic ne {}} {
   485    501   	serverClientMsg $fd 332 "$channel :$topic"
................................................................................
   495    511       foreach fd $userlist mode $usermode {
   496    512   	append users "$mode[clientNick $fd] "
   497    513       }
   498    514       set users [string range $users 0 end-1]
   499    515       serverClientMsg $fd 353 "= $channel :$users"
   500    516       serverClientMsg $fd 366 "$channel :End of /NAMES list."
   501    517   }
          518  +
          519  +proc handleLocalCommand {fd ofd} {
          520  +	if {$fd ne ""} {
          521  +		gets $fd line
          522  +
          523  +		if {[eof $fd] && $line eq ""} {
          524  +			# Do not check for input any more once we get EOF
          525  +			fileevent $fd readable ""
          526  +
          527  +			return
          528  +		}
          529  +
          530  +		if {$line eq ""} {
          531  +			return
          532  +		}
          533  +
          534  +		set cmd ""
          535  +		catch {
          536  +			set cmd [lindex $line 0]
          537  +		}
          538  +
          539  +		switch -- $cmd {
          540  +			"reloadpasswd" {
          541  +				puts $ofd "Reload password is: [config reloadpasswd]"
          542  +			}
          543  +			"reload" {
          544  +				handleClientReload "" [config reloadpasswd]
          545  +				puts $ofd "Done"
          546  +			}
          547  +			"exit" {
          548  +				exit
          549  +			}
          550  +			default {
          551  +				puts $ofd "Unknown command"
          552  +			}
          553  +		}
          554  +	}
          555  +
          556  +	puts -nonewline $ofd "> "
          557  +	flush $ofd
          558  +}
   502    559   
   503    560   # Initialization
   504    561   proc init {} {
   505    562       set ::initialized 1
          563  +
          564  +    config reloadpasswd [exec openssl rand -hex 20]
          565  +
          566  +    if {[config debugchannel]} {
          567  +	handleLocalCommand "" stdout
          568  +        fileevent stdin readable [list handleLocalCommand stdin stdout]
          569  +    }
          570  +
   506    571       socket -server handleNewConnection [config tcpport]
          572  +
   507    573       vwait forever
   508    574   }
   509    575   
   510         -config hostname localhost
          576  +config hostname rkeene.org
   511    577   config tcpport 6667
   512         -config defchan #tclircd
   513    578   config version "TclIRCD-0.1a"
   514         -config reloadpasswd "sfkjsdlf939393"
   515         -config debugchannel 0 ; # Warning, don't change it if you don't know well.
   516         -config debugmessages 1
          579  +config debugchannel 0
          580  +config debugmessages 0
          581  +
          582  +if {[lsearch -exact $argv "-debug"] != -1} {
          583  +	config debugchannel 1
          584  +	config debugmessages 1
          585  +}
   517    586   
   518         -# Initialize only if it is not a 'reaload'.
          587  +# Initialize only if it is not a 'reload'.
   519    588   if {![info exists ::initialized]} {
   520    589       init
   521    590   }