#
# Copyright (c) 2022-2024 Andrea Biscuola <a@abiscuola.com>
# Copyright (c) 2023 Omar Polo <op@omarpolo.com>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#

namespace eval irctk {
	namespace export extmsg killconnection findnetwork partch \
	    ischanrd quitserver getnetwork connect save privatechan \
	    writemsg init pingserver onexit reconnect

	namespace ensemble create

	variable nextid
	variable servers
	variable newservers
}

proc ::irctk::init {} {
	variable nextid
	variable servers
	variable newservers

	set nextid 0

	# Dictionary with all the servers we are connected to
	set servers [dict create]

	#
	# Diff dictionary used when we change the configuration.
	# for a connection.
	#
	set newservers [dict create]

	#
	# Automatically connect to all the saved networks
	#
	set cfgdir "$::cfgdir/auto"
	foreach net [glob -nocomplain -directory $cfgdir *] {
		if {![catch {set sfd [::open $net/connect.conf r]} errstr]} {
			set cfg [gets $sfd]
			set network [lindex $cfg 0]
			set nick [lindex $cfg 1]
			set name [lindex $cfg 2]
			set pass [lindex $cfg 3]
			set cmd [lindex $cfg 4]
			set user [lindex $cfg 5]

			connect $network "$user" $nick $name "$pass" "$cmd"

			if {[catch {close $sfd} errstr]} {
				log console "::irctk::init: $errstr"
			}
		} else {
			log console "::irctk::init: $errstr"
		}
	}
}

proc ::irctk::onexit {} {
	variable servers

	dict for {ch server} $servers {
		fileevent $ch readable {}

		irc quit $ch {} $::defaultquit

		if {[catch {close $ch} errstr]} {
			log console "::irctk::onexit: $errstr"
		}
	}
}

proc ::irctk::genid {} {
	variable nextid

	incr nextid
}

proc ::irctk::autojoin {fd} {
	variable servers

	set channels {}

	foreach ch  [dict get $servers $fd autojoin] {
		switch -regexp $ch {
			server {}
			default {lappend channels $ch}
		}
	}

	if {[llength $channels] > 0} {irc join $fd {} [join $channels ","]}
}

proc ::irctk::connect {network user nick name pass cmd {oldch none}} {
	variable servers
	variable fd

	set cfgdir "$::cfgdir/auto"
	set date [clock format [clock seconds] -format %H:%M:%S]

	#
	# Try to connect to the network.
	#
	if {[catch {set fd [irc dial "$cmd" "::irctk::readmsg"]} errstr]} {
		log console "::irctk::connect: $errstr"

		gui displaymsg "$errstr" "*" -1 info $date

		return
	}

	#
	# $oldch is an existing channel for the network. It's populared
	# whenever a re-connection occurs, be it manually, or triggered
	# by an event (broken connection, the cat chewed the ethernet cable, etc.)
	#
	# We show the error that caused the connection to close, if any,
	# and move the server channel id to the new connection.
	#
	# If the connection is totally new, we create a new channel from
	# scratch.
	#
	# Either way, it's better to not keep the user without news. Nobody
	# likes to be left blind.
	#
	if {"$oldch" ne "none" && [dict exists $servers $oldch]} {
		set nid [dict get $servers $oldch channels server id]

		#
		# Switch the old channel to blocking to catch errors
		#
		fconfigure $oldch -blocking 1

		if {[catch "close $oldch" error]} {
			log console "::irctk::connect: $error"

			gui displaymsg "$error" "*" $nid info $date
		}

		dict set servers $fd channels server id $nid
	} else {
		dict set servers $fd channels server id [genid]
	}

	set sid [dict get $servers $fd channels server id]
	dict set servers $fd ok 0

	#
	# Create the channel in the GUI and start to populate the connection
	# details in the servers dictionary.
	#
	# No good if we forget things. People will get mad.
	#
	gui newservertab $fd $nick $network $sid
	gui displaymsg "Connecting to $network with \"$cmd\"" "*" \
	    $sid info $date

	#
	# We use the logged in user by default if none is passed
	#
	if {"$user" eq ""} {set user $::env(USER)}

	dict set servers $fd network $network
	dict set servers $fd user "$user"
	dict set servers $fd nick $nick
	dict set servers $fd name $name
	dict set servers $fd pass "$pass"
	dict set servers $fd cmd "$cmd"
	dict set servers $fd away 0
	dict set servers $fd connected 1
	dict set servers $fd pendingcaps 0

	#
	# Request IRCv3 capabilities list.
	#
	# "Better IRC client in the world" and all that jazz.
	#
	irc cap $fd {} ls

	#
	# Register the user for the connection.
	#
	irc register $fd {} "$user" $nick "$pass" 0 $name

	set chans ""

	#
	# If it is a reconnection, populate the dictionary with the old
	# existing details: channels list, log file channels (they will
	# be still open) and the channels list to join automatically
	# directly from the old data.
	#
	# As we are like elephants, we remember what we did. Why
	# not learn from experience?
	#
	# If it's a new connection, start afresh, joining any channel
	# present in the autojoin configurations file.
	#
	if {[dict exists $servers $oldch]} {
		set nbk [expr [dict get $servers $oldch backoff] * 2]
		if {$nbk > $::backoffmax} {set nbk $::backoffmax}

		dict set servers $fd backoff $nbk
		dict set servers $fd channels [dict get $servers $oldch channels]

		gui away [dict get $servers $oldch channels server id] 0

		dict unset servers $oldch

		dict for {ch log} [dict get $servers $fd channels] {
			if {![ischanrd $fd $ch]} {
				lappend chans $ch
			}
		}
	} else {
		if {[catch {set lfd [log open $network server]} errstr]} {
			log console "::irctk::connect: $errstr"

			set lfd -1
		}

		dict set servers $fd backoff $::backoffmin
		dict set servers $fd channels server log $lfd
		dict set servers $fd channels server readonly 0

		if {![catch {set sfd [::open $cfgdir/$network/join.conf r]} errstr]} {
			while {[gets $sfd chan] >= 0} {
				lappend chans $chan
			}

			close $sfd
		} else {
			log console "::irctk::connect: $errstr"
		}

		set params [::list $network $nick $name "$pass" "$cmd" "$user"]
		set cfgdir "$::cfgdir/auto/$network"

		if {[catch {file mkdir $cfgdir} errstr]} {
			log console "::irctk::connect: $errstr"
		}

		if {![catch {set f [::open "$cfgdir/connect.conf" w 0640]} errstr]} {
			puts $f $params

			close $f
		} else {
			log console "::irctk::connect: $errstr"
		}
	}

	dict set servers $fd autojoin $chans

	#
	# Periodic PING. IRC likes it.
	#
	after $::checkinterval "irctk pingserver $fd"

	return $fd
}

proc ::irctk::pingserver {chan} {
	variable servers

	irc ping $chan {} [::info hostname]

	dict set servers $chan pong [after $::timeout "irctk reconnect $chan"]
}

proc ::irctk::reconnect {chan} {
	variable servers
	variable newservers

	if {[dict exists $servers $chan connected]} {
		if {![dict get $servers $chan connected]} {return}
	}

	#
	# Remove outstanding PING and PONG events, if any.
	# We can leave the server alone until we re-connect.
	#
	if {[dict exists $servers $chan pong]} {
		after cancel [dict get $servers $chan pong]
	}

	after cancel "irctk pingserver $chan"

	#
	# Pick up backoff and retry details from the connection
	# configurations dictionary.
	#
	set network [dict get $servers $chan network]
	set retry [dict get $servers $chan backoff]
	set sid [dict get $servers $chan channels server id]

	#
	# Use the details in the newserver dictionary if they exists
	# for the network we are re-connecting to. This happens
	# when the user changed the connection details from the
	# GUI. With a reconnection, we "commit" the details in the
	# runtime.
	#
	# If not, just, pick-up the existing ones. We will start to
	# knock on the server to open the door after a while.
	#
	if {![dict exists $newservers network $network]} {
		set nick [dict get $servers $chan nick]
		set user [dict get $servers $chan user]
		set name [dict get $servers $chan name]
		set pass [dict get $servers $chan pass]
		set cmd [dict get $servers $chan cmd]
	} else {
		set nick [dict get $newservers network $network nick]
		set user [dict get $newservers network $network user]
		set name [dict get $newservers network $network name]
		set pass [dict get $newservers network $network pass]
		set cmd [dict get $newservers network $network cmd]

		dict unset newservers network $network
	}

	set date [clock format [clock seconds] -format %H:%M:%S]

	gui displaymsg "Disconnected, retry connecting in [expr $retry / 1000] seconds" "*" \
	    $sid info $date

	dict set servers $chan connected 0

	#
	# Setup the connection command, we launch it after the $retry
	# time. This uses an exponential back-off when the connection
	# attempts fails. We want to be kind to the people running the
	# server.
	#
	# We do not want to be banned, right? RIGHT???!?
	#
	dict set servers $chan retry [after $retry "irctk connect \
	    \"$network\" \"$user\" \"$nick\" \"$name\" \"$pass\" \"$cmd\" $chan"]
}

#
# Die connection, die!
#
proc ::irctk::killconnection {id} {
	set chan [findnetwork $id]
	if {[llength $chan] == 0} {return}

	reconnect $chan
}

proc hascap {caps cap} {
	expr {[lsearch -nocase -bisect $caps $cap] != -1}
}

proc ::irctk::readmsg {chan} {
	variable servers

	set rmsg [irc receive $chan]
	if {$rmsg == -1} {
		if {[eof $chan]} {
			fileevent $chan readable {}

			reconnect $chan
		}

		return
	}

	#
	# Every time we receive a message, we reset the back-off to the
	# default. It's a confirmation that the connection is alive.
	#
	dict set servers $chan backoff $::backoffmin

	# if the time capability tag exists, use it in place of the original date
	if {[dict exists $rmsg tags time]} {
		dict set rmsg date [parsetime [dict get $rmsg tags time]]
	}

	#
	# Populate a bunch of additional details for the received message.
	#
	dict set rmsg datestr [clock format [dict get $rmsg date] -format %H:%M:%S]
	dict set rmsg timestamp [dict get $rmsg date]
	dict set rmsg cid ""
	dict set rmsg channel ""
	dict set rmsg level ""
	dict set rmsg type irc
	dict set rmsg network [dict get $servers $chan network]

	set channel [lindex [dict get $rmsg args] 0]
	if {[dict exists $servers $chan channels $channel]} {
		dict set rmsg cid [dict get $servers $chan channels $channel id]
		dict set rmsg channel $channel
	}

	set sfd [dict get $servers $chan channels server log]

	if {[dict get $servers $chan away]} {
		dict set rmsg status "away"
	} else {
		dict set rmsg status "here"
	}

	#
	# Process the received command.
	#
	# The heart and soul of our ability to read things.
	#
	switch -regexp [dict get $rmsg command] {
		cap {
			set recmd [lindex [dict get $rmsg args] 1]

			switch -nocase -regexp -- $recmd {
				ls {
					# XXX: we should support CAP LS 302 with
					# multiple lines of response eventually
					# and also caps with arguments.

					set caps [lrange [dict get $rmsg args] 2 end]
					set caps [string trimleft "$caps" :]
					set caps [lsort -nocase $caps]
					dict set $servers $chan caps $caps

					set p [dict get $servers $chan pendingcaps]

					if {[hascap $caps server-time]} {
						irc cap $chan {} server-time
						incr p
					}

					dict set servers $chan pendingcaps $p
					if {$p == 0} {
						irc cap $chan {} end
					}
				} ack|nak {
					set n [dict get $servers $chan pendingcaps]
					dict set servers $chan pendingcaps [incr n -1]
					if {$n == 0} {
						irc cap $chan {} end
					}
				}
			}
		} privmsg|notice {
			privmsg $chan
		} join {
			joinch $chan
		} ping {
			irc pong $chan {} [::join [dict get $rmsg args] " "]
		} pong {
			if {[dict exists $servers $chan pong]} {
				after cancel [dict get $servers $chan pong]
			}

			after $::checkinterval "irctk pingserver $chan"
		} error {
			gui displaymsg [::join [dict get $rmsg args]] \
			    * [dict get $servers $chan channels server id] info \
			    [dict get $rmsg datestr]

			log write [dict get $servers $chan channels server log] \
			    * [::join [dict get $rmsg args] " "] [dict get $rmsg date]

			return
		} mode {
			managemode $chan
		} nick {
			managenick $chan
		} topic {
			managetopic $chan
		} part {
			managepart $chan
		} kick {
			managekick $chan
		} quit {
			manageuserquit $chan
		} [0-9]{3} {
			numericresp $chan
		}
	}

	if {![dict exists $rmsg user]} {
		dict set rmsg nick ""
	} elseif {![dict exists $rmsg nick]} {
		dict set rmsg nick [dict get $rmsg user]
	}

	if {"[focus]" eq ""} {
		dict set rmsg focus false
	} else {
		dict set rmsg focus true
	}

	#
	# Send the command to the extensions subsystem, so other
	# programs may do their magic with our data.
	#
	exts writemsg $rmsg

	return $rmsg
}

proc ::irctk::parsetime {date} {
	# remove the milliseconds
	regexp {^([^.,]*)[.,](\d+)Z} $date -> dt milli

	return [clock scan $dt -format "%Y-%m-%dT%H:%M:%S" -timezone :UTC]
}

proc ::irctk::managepart {chan} {
	variable servers
	upvar rmsg msg

	set channel [lindex [dict get $msg args] 0]
	if {![dict exists $servers $chan channels $channel]} {return}

	set lfd [dict get $servers $chan channels $channel log]
	set cid [dict get $servers $chan channels $channel id]
	set nick [dict get $msg nick]
	set mynick [dict get $servers $chan nick]
	set network [dict get $servers $chan network]
	set date [dict get $msg datestr]

	#
	# Who's parting? The user or somebody else?
	#
	if {$nick eq $mynick} {
		partch $chan $channel
	} else {
		gui removeuser $cid $nick
		gui displaymsg "$nick has left" "*" $cid info $date

		log write $lfd "*" "$nick has left" [dict get $msg date]
	}
}

proc ::irctk::managemode {chan} {
	variable servers
	upvar rmsg msg

	#
	# A user may receive superpowers. We need to show it in the channel
	# GUI.
	#

	set channel [lindex [dict get $msg args] 0]
	if {![dict exists $servers $chan channels $channel]} {
		set cid [dict get $servers $chan channels server id]
	} else {
		set cid [dict get $servers $chan channels $channel id]
	}

	set nick [lindex [split [lindex [dict get $msg args] 2] "!"] 0]
	set mode [lindex [dict get $msg args] 1]
	set network [dict get $servers $chan network]
	set date [dict get $msg datestr]

	gui setmode $cid $nick $mode

	gui displaymsg "$nick modes changed to $mode" "*" $cid info $date
}

proc ::irctk::managekick {chan} {
	variable servers
	upvar rmsg msg

	set network [dict get $servers $chan network]
	set mynick [dict get $servers $chan nick]
	set nick [dict get $msg nick]

	set channel [lindex [dict get $msg args] 0]
	if {![dict exists $servers $chan channels $channel]} {return}

	set lfd [dict get $servers $chan channels $channel log]
	set nid [dict get $servers $chan channels server id]
	set cid [dict get $servers $chan channels $channel id]

	set kickeduser [lindex [dict get $msg args] 1]
	set date [dict get $msg datestr]

	#
	# We were kicked. give the sad news to the irctk user.
	#
	# Otherwise, somebody else got bad luck. We show the news
	# anyway.
	#
	if {"$kickeduser" eq "$mynick"} {
		set lfd [dict get $servers $chan channels server log]

		set text [string trimleft [::join [lreplace \
		    [dict get $msg args] 0 1] " "] ":"]

		log write $lfd "*" "You were kicked from $channel by $nick,\
		    reason: $text" [dict get $msg date]

		gui displaymsg "You were kicked from $channel by $nick,\
		    reason: $text" "*" $nid info $date

		partch $chan $channel
	} else {
		set text [string trimleft [::join [lreplace \
		    [dict get $msg args] 0 1] " "] ":"]

		log write $lfd "*" "$nick kicked $kickeduser from $channel,\
		    reason: $text" [dict get $msg date]

		gui removeuser $nid $kickeduser
		gui displaymsg "$nick kicked $kickeduser from $channel,\
		    reason: $text" "*" $cid info $date
	}
}

#
# Running from the authorities. We got nothing to hide, right?
#
# If we changed our nick, we need to change it in all the places
# where it's stored. Also, we need to change it in all the places
# in the GUI where we show it. Better to hide our crimes.
#
# if it's somebody else, we just show a message in the main channel
# and change it's nick in every list of every channel we might be in
# together.
#
proc ::irctk::managenick {chan} {
	variable servers
	upvar rmsg msg

	set mynick [dict get $servers $chan nick]
	set nick [dict get $msg nick]
	set newnick [string trimleft [lindex [dict get $msg args] 0] ":"]
	set network [dict get $servers $chan network]
	set nid [dict get $servers $chan channels server id]
	set date [dict get $msg datestr]

	gui updateuser $nid $nick $newnick
	gui displaymsg "$nick is now known as $newnick" "*" \
	    $nid info $date

	if {"$mynick" eq "$nick"} {
		dict set servers $chan nick $newnick

		set network [dict get $servers $chan network]
		set name [dict get $servers $chan name]
		set pass [dict get $servers $chan pass]
		set cmd [dict get $servers $chan cmd]
		set user [dict get $servers $chan user]
		set params [::list $network $newnick $name "$pass" "$cmd" "$user"]
		set cfgdir "$::cfgdir/auto/$network"

		if {[catch {file mkdir $cfgdir} errstr]} {
			log console "::irctk::managenick $errstr"
		}

		if {![catch {set f [::open "$cfgdir/connect.conf" w 0640]} errstr]} {
			puts $f $params

			close $f
		} else {
			log console "::irctk::managenick $errstr"

			gui displaymsg $errstr * -1 info $date
		}
	}
}

#
# Ach, what are we doing? Leaving?
#
# No, not us! Somebody else, get rid of the body from all of our channels and
# show that they are gone.
#
proc ::irctk::manageuserquit {chan} {
	variable servers
	upvar rmsg msg

	set nick [dict get $msg nick]
	set text [string trimleft [::join [dict get $msg args] " "] ":"]
	set network [dict get $servers $chan network]
	set date [dict get $msg datestr]

	dict for {ch log} [dict get $servers $chan channels] {
		if {"$ch" eq "server" || [ischanrd $chan $ch]} {continue}

		set lfd [dict get $servers $chan channels $ch log]

		set cid [dict get $servers $chan channels $ch id]
		if {[gui removeuser $cid $nick]} {
			log write $lfd "*" "$nick has quit: $text" [dict get $msg date]

			gui displaymsg "$nick has quit: $text" "*" $cid info $date
		}
	}
}

#
# People like to change the conspiracy theories on top of the channels.
#
# We believe them and we show them.
#
proc ::irctk::managetopic {chan} {
	variable servers
	upvar rmsg msg

	set topic [string trimleft [::join [lreplace [dict get $msg args] 0 0] " "] ":"]
	set channel [lindex [dict get $msg args] 0]
	set cid [dict get $servers $chan channels $channel id]
	set lfd [dict get $servers $chan channels $channel log]
	set network [dict get $servers $chan network]
	set nick [dict get $msg nick]
	set date [dict get $msg datestr]

	gui displaytopic $cid $date $topic
	gui displaymsg "$nick changed the channel topic to \"$topic\"" \
	    "*" $cid info $date

	log write $lfd "*" "$nick changed the channel topic to \"$topic\"" \
	    [dict get $msg date]
}

#
# Message in a bottle!
#
# All the crap down there is to find where a message goes, if we are mentioned
# and if somebody was talking or thinking (/ME).
#
# If a privmsg or a notice doesn't have a target that we know, and those are not
# direct messages to us (private communications), show them in the main
# channel for the network.
#
proc ::irctk::privmsg {chan} {
	variable servers
	upvar rmsg msg

	set lfd [dict get $servers $chan channels server log]
	set id [dict get $servers $chan channels server id]
	set target [lindex [dict get $msg args] 0]

	dict set msg args [lreplace [dict get $msg args] 0 0]
	dict set msg level info

	if {![dict exists $msg nick]} {dict set msg nick "*"}

	if {$target eq "AUTH" || $target eq "*"} {
		gui displaymsg [::join [dict get $msg args] " "] \
		    "*" $id info [dict get $msg date]

		log write $lfd "*" [join [dict get $msg args] " "] [dict get $msg date]

	} else {
		if {$target eq [dict get $servers $chan nick]} {
			privatechan $chan [dict get $msg nick]

			set dest [dict get $msg nick]
		} else {
			set dest $target
		}

		if {![dict exists $servers $chan channels $target]} {
			privatechan $chan $target nofocus
		}

		if {":ACTION" eq [lindex [dict get $msg args] 0]} {
			dict set msg args [lreplace [dict get $msg args] \
			    0 0 [dict get $msg nick]]
			dict set msg nick "*"
		}

		set level message

		set text [::join [dict get $msg args] " "]
		if {[string index $text 0] eq ":"} {
			set text [string replace $text 0 0]
		}

		set nicklen [string length [dict get $servers $chan nick]]
		set nickpos [string first [dict get $servers $chan nick] $text]
		set beforech [string index $text [expr {$nickpos - 1}]]
		set afterch  [string index $text [expr {$nickpos + $nicklen}]]

		if {$target eq [dict get $servers $chan nick]} {
			set level mention
		} elseif {$nickpos != -1 && \
		    ![string is alnum -strict $beforech] && \
		    ![string is alnum -strict $afterch]} {
			set level mention
		}

		set lfd [dict get $servers $chan channels $dest log]

		if {"$dest" eq "server"} {
			set id [dict get $servers $chan channels server id]
		} else {
			set id [dict get $servers $chan channels $dest id]
		}

		dict set msg channel $dest
		dict set msg cid $id
		dict set msg level $level

		gui displaymsg "$text" [dict get $msg nick] $id $level \
		    [dict get $msg datestr]

		log write $lfd [dict get $msg nick] $text [dict get $msg date]
	}
}

proc ::irctk::privatechan {chan nick {mode focus}} {
	variable servers

	#
	# Secrets!
	#
	if {![dict exists $servers $chan channels $nick]} {
		if {[catch {set fd [log open [dict get $servers $chan network] $nick]} errstr]} {
			log console "::irctk::privatechan: $errstr"

			set lfd -1
		}

		dict set servers $chan channels $nick log $fd
		dict set servers $chan channels $nick id [genid]
		dict set servers $chan channels $nick readonly 0
	}

	set parent [dict get $servers $chan channels server id]
	set id [dict get $servers $chan channels $nick id]

	gui newprivatetab $chan [dict get $servers $chan nick] \
	    $parent $id $nick [dict get $servers $chan network] $mode
}

#
# Prople come and go. But sometimes we come and go, too.
#
# If we decide to enter a nice room, we prepare the field with the
# GUI and everything else. We also make the user a courtesy to
# remember the channel for the next time.
#
# If somebody else is coming in, show a message announcing the
# new entry and add the user to the channel users list.
#
proc ::irctk::joinch {chan} {
	variable servers
	upvar rmsg msg

	set network [dict get $servers $chan network]
	set channel [string trimleft [lindex [dict get $msg args] 0] ":"]
	set date [dict get $msg datestr]

	if {![dict exists $servers $chan channels $channel]} {
		if {[catch {set fd [log open [dict get $servers $chan network] $channel]} errstr]} {
			log console "::irctk::joinch: $errstr"

			set fd -1
		}

		dict set servers $chan channels $channel log $fd
		dict set servers $chan channels $channel id [genid]
		dict set servers $chan channels $channel readonly 0
		dict set servers $chan channels $channel names 0

		if {![catch {set fd [open $::cfgdir/auto/$network/join.conf w 0640]} errstr]} {
			dict for {ch log} [dict get $servers $chan channels] {
				if {[regexp {^[&#!+]} $ch]} {
					puts $fd $ch
				}
			}

			close $fd
		} else {
			log console "::irctk::joinch: $errstr"
		}

		set parent [dict get $servers $chan channels server id]
		set id [dict get $servers $chan channels $channel id]

		gui newchanneltab $chan [dict get $servers $chan nick] \
		    $parent $id $channel $network
	} else {
		set fd [dict get $servers $chan channels $channel log]
		set nick [dict get $servers $chan nick]
		set parent [dict get $servers $chan channels server id]
		set id [dict get $servers $chan channels $channel id]

		if {"$nick" eq "[dict get $msg nick]"} {
			gui newchanneltab $chan $nick $parent \
			    $id $channel $network
		}

		gui adduser [dict get $servers $chan channels $channel id] \
		    [dict get $msg nick]
		gui displaymsg "[dict get $msg nick] has joined" "*" \
		    [dict get $servers $chan channels $channel id] info $date

		log write $fd "*" "[dict get $msg nick] has joined" \
		    [dict get $msg date]
	}
}

proc ::irctk::findchan {network {channel ""}} {
	variable servers

	dict for {chan net} $servers {
		if {![dict exists $net network]} {
			continue
		}

		if {[dict get $net network] ne $network} {
			continue
		} elseif {"$channel" eq "[dict get $net network]"} {
			return $chan
		} elseif {"$channel" eq ""} {
			return $chan
		}

		if {[dict exists $net channels $channel]} {
			return $chan
		}
	}

	return {}
}

proc ::irctk::getnetwork {network} {
	set cfgpath "$::cfgdir/auto/$network/connect.conf"

	if {![catch {set sfd [::open $cfgpath r]} errstr]} {
		set cfg [gets $sfd]

		close $sfd

		return $cfg
	} else {
		log console "::irctk::getnetwork: $errstr"

		return -1
	}
}

#
# Close the door when you leave. This is also for us.
#
# If we leave a channel, close the GUI, the logs and say bye to our
# friends.
#
proc ::irctk::partch {chan channel} {
	variable servers

	if {![dict exists $servers $chan channels $channel]} {return}

	if {![ischanrd $chan $channel]} {
		set fd [dict get $servers $chan channels $channel log]
		if {[catch {log close $fd} errstr]} {
			log console "::irctk::partch: $errstr"
		}
	}

	gui closechannel [dict get $servers $chan channels $channel id]

	dict unset servers $chan channels $channel

	if {![regexp ^\[&\#!\+\] $channel]} {return}

	set network [dict get $servers $chan network]

	if {![catch {set fd [open $::cfgdir/auto/$network/join.conf w 0640]} errstr]} {
		foreach {ch log} [dict get $servers $chan channels] {
			if {[regexp {^[&#!+]} $ch]} {
				puts $fd $ch
			}
		}
	} else {
		log console "::irctk::partch: $errstr"
	}

	close $fd
}

proc ::irctk::channame {chan id} {
	variable servers

	if {$chan ne ""} {
		dict for {ch channel} [dict get $servers $chan channels] {
			if {[dict get $channel id] == $id} {return $ch}
		}
	} else {
		dict for {ch server} $servers {
			dict for {ch server} $::irctk::servers {
				dict for {chname channel} [dict get $server channels] {
					if {$id eq [dict get $channel id]} {
						return $chname
					}
				}
			}
		}
	}

	return {}
}

proc ::irctk::writemsg {chan id tags text {loop 0}} {
	variable servers

	set emsg [dict create]

	# What? We do not know the channel we are trying to send to?
	set channel [channame $chan $id]
	if {[llength $channel] == 0} {return}

	set lfd [dict get $servers $chan channels $channel log]
	set nick [dict get $servers $chan nick]
	set network [dict get $servers $chan network]

	set tstamp [clock seconds]
	set date [clock format $tstamp -format %H:%M:%S]

	#
	# Some data preparation
	#
	dict set emsg type irc
	dict set emsg timestamp $tstamp
	dict set emsg cid $id
	dict set emsg user [dict get $servers $chan nick]
	dict set emsg level message
	dict set emsg nick [dict get $servers $chan nick]
	dict set emsg tags $tags

	#
	# Are we actively using the application?
	#
	if {"[focus]" eq ""} {
		dict set emsg focus false
	} else {
		dict set emsg focus true
	}

	#
	# Are we busy or not?
	#
	if {[dict get $servers $chan away]} {
		dict set emsg status away
	} else {
		dict set emsg status here
	}

	dict set emsg network [dict get $servers $chan network]
	dict set emsg channel $channel

	#
	# Convenience: If we don't explicitly digit the slash,
	# it means we just want to send a message to the
	# channel we are vieweing in the GUI.
	#
	if {[string index $text 0] ne "/"} {
		dict set emsg command privmsg
		dict set emsg args $text

		switch -exact -- [irc privmsg $chan {} $channel $text] {
			-2 {
				gui displaymsg "message too long" * $id none $date

				return
			} -1 {
				gui displaymsg "can not send message" * $id none $date

				return
			} default {
				gui displaymsg $text $nick $id none $date

				log write $lfd $nick $text $tstamp

				exts writemsg $emsg

				return
			}
		}
	}

	set args [split [string trimleft $text "/"] " "]
	set cmd [string tolower [lindex $args 0]]
	set args [lreplace $args 0 0]

	dict set emsg command $cmd
	dict set emsg args [join $args " "]

	#
	# Bad boy, trying to kill my computer!
	#
	if {$loop == 0} {exts writemsg $emsg}

	#
	# Double-slash ("//"), indicates that we want to involve only
	# one or more extensions. No need to send the message to
	# the server.
	#
	if {[string range $text 0 1] eq "//"} {return}

	#
	# Ok, what command are we choosing from the menu?
	#
	# If the command is not in the menu, we send it, as-is, to
	# the server. The other side may know what to do.
	#
	switch -exact $cmd {
		query {
			if {[llength $args] < 1} {return}

			privatechan $chan [lindex $args 0]

			return
		} topic {
			set args [linsert $args 0 $channel]
			set args [lreplace $args 1 1 :[lindex $args 1]]
		} part {
			set args [linsert $args 0 $channel]
			set args [lreplace $args 1 1 :[lindex $args 1]]
		} kick {
			set args [linsert $args 0 $channel]
			set args [lreplace $args 2 2 :[lindex $args 2]]
		} who {
			if {[llength $args] == 0} {
				set args [linsert $args 0 $channel]
				set args [lreplace $args 1 1 :[lindex $args 1]]
			}
		} me {
			set cmd privmsg

			prepareme $nick $id $channel
		} quit {
			switch -exact -- [irc quit $chan {} [::join $args " "]] {
				-2 {
					gui displaymsg "message too long" \
					    * $id none $date
				} -1 {
					gui displaymsg "can not send message" \
					    * $id none $date
				}
			}

			return
		} quiet {
			gui quiet

			return
		} chatmode {
			gui showmode

			return
		} away {
			if {[llength $args] > 0} {
				set args [lreplace $args 0 0 \
				    :[lindex $args 0]]
			}
		} dnd {
			if {[llength $args] > 0} {
				set args [lreplace $args 0 0 \
				    :[lindex $args 0]]
			}

			donotdisturb [::concat $args]

			return
		} switch {
			if {[llength $args] == 0} {return}

			set channel [lindex $args 0]

			if {![dict exists $servers $chan channels $channel]} {return}
			gui changech [dict get $servers $chan channels \
			    $channel id]

			return
		} raise {
			gui raisewin

			return
		}
	}

	switch -exact -- [irc send $chan $tags $cmd [::join $args " "]] {
		-2 {
			gui displaymsg "message too long" * $id none $date
		} -1 {
			gui displaymsg "can not send message" * $id none $date
		}
	}
}

proc ::irctk::donotdisturb {{text ""}} {
	variable servers

	dict for {ch server} $servers {
		irc send $ch {} AWAY $text
	}
}

#
# /ME is one of those weird things requiring non-printable characters.
# Why? I have no idea.
#
proc ::irctk::prepareme {nick id channel} {
	upvar args margs

	set text [::join $margs " "]
	set margs [linsert $margs 0 $channel :[format %c 1]ACTION]
	set margs [lreplace $margs end end [lindex $margs end][format %c 1]]
	set date [clock format [clock seconds] -format %H:%M:%S]

	gui displaymsg "$nick $text" "*" $id message $date
}

proc ::irctk::findnetwork {id} {
	variable servers

	dict for {chan net} $servers {
		if {![dict exists $net channels]} {continue}

		if {[dict get $net channels server id] eq $id} {
			return $chan
		}
	}

	return {}
}

#
# Save for the next time.
#
proc ::irctk::save {network user nick name pass cmd} {
	variable servers
	variable newservers

	dict set newservers network $network name $name
	dict set newservers network $network nick $nick
	dict set newservers network $network pass "$pass"
	dict set newservers network $network user "$user"
	dict set newservers network $network cmd "$cmd"

	set params [::list $network $nick $name "$pass" "$cmd" "$user"]

	set cfgdir "$::cfgdir/auto/$network"

	if {[catch {file mkdir $cfgdir} errstr]} {
		log console "::irctk::save: $errstr"
	}

	if {![catch {set f [::open "$cfgdir/connect.conf" w 0640]} errstr]} {
		puts $f $params

		close $f
	} else {
		log console "::irctk::save: $errstr"
	}
}

#
# Adieu!
#
# We decided we don't like the server's company anymore.
# Kill everything and forget all the details, forever.
#
proc ::irctk::quitserver {chan} {
	variable servers

	if {![dict exists $servers $chan]} {return}

	set network [dict get $servers $chan network]
	if {[dict exists $servers $chan pong]} {
		after cancel [dict get $servers $chan pong]
	}

	if {[dict exists $servers $chan retry]} {
		after cancel [dict get $servers $chan retry]
	}

	after cancel "irctk pingserver $chan"

	dict for {channel lfile} [dict get $servers $chan channels] {
		if {![ischanrd $chan $channel]} {
			if {[catch {log close [dict get $lfile log]} errstr]} {
				log console "::irctk::quitserver: $errstr"
			}
		}
	}

	if {[catch {file delete -force "$::cfgdir/auto/$network"} errstr]} {
		log console "$errstr"
	}

	gui closechannel [dict get $servers $chan channels server id]

	dict unset servers $chan

	#
	# Switch the pipe to blocking mode to catch errors
	#
	fconfigure $chan -blocking 1

	if {[catch {close $chan} errstr]} {
		log console "$errstr"
	}
}

proc ::irctk::setok {chan} {
	variable servers

	dict set servers $chan ok 1
}

#
# The server likes to answer with numbers, sometimes.
#
# Try to get some sense of them. Refer to the RFC1459 for more
# details.
#
proc ::irctk::numericresp {chan} {
	variable servers
	upvar rmsg msg

	set date [dict get $msg datestr]

	switch -regexp [dict get $msg command] {
		001 {
			set id [dict get $servers $chan channels server id]

			set givennick [lindex [dict get $msg args] 0]
			set nick [dict get $servers $chan nick]
			set network [dict get $servers $chan network]
			set user [dict get $servers $chan user]
			set name [dict get $servers $chan name]
			set pass [dict get $servers $chan pass]
			set cmd [dict get $servers $chan cmd]

			if {"$givennick" ne $nick} {
				save $network "$user" $nick $name "$pass" "$cmd"

				dict set servers $chan nick $givennick
			}

			gui updateuser $id $nick "$givennick"

			gui displaymsg [join [dict get $msg args] " "]  "*" \
			    $id info $date

			autojoin $chan

			after 8000 "::irctk::setok $chan"
		} 00[2-4] {
			set id [dict get $servers $chan channels server id]

			gui displaymsg [join [dict get $msg args] " "]  "*" \
			    $id info $date
		} 005 {
			set id [dict get $servers $chan channels server id]

			gui displaymsg [join [dict get $msg args] " "]  "*" \
			    $id info $date

			foreach arg [lreplace [dict get $msg args] 0 0] {
				#
				# The last argument in the message is
				# just a comment.
				#
				# It means we are done processing.
				#
				if {[string index $arg 0] eq ":"} {break}

				#
				# Features are in the form PARAM=VALUE
				#
				set feat [split $arg "="]
				set fname [lindex $feat 0]

				#
				# If a feature name has a "-" in front, we
				# must remove it.
				#
				if {[string index $fname 0] eq "-"} {
					set fname [string trimleft $fname "-"]
					dict remove servers $chan features $fname
					continue
				}

				set values {}

				#
				# A feature may have multiple values, those
				# are separated by a comma.
				#
				foreach val [split [lindex $feat 1] ","] {
					lappend values $val
				}

				dict set servers $chan features $fname values $values
			}
		} 305 {
			dict set servers $chan away 0

			gui displaymsg [join [dict get $msg args] " "] "*" \
			    -1 info $date
			gui away [dict get $servers $chan channels server id] 0
		} 306 {
			dict set servers $chan away 1

			gui displaymsg [join [dict get $msg args] " "] "*" \
			    -1 info $date
			gui away [dict get $servers $chan channels server id] 1
		} 332 {
			set ch [lindex [dict get $msg args] 1]
			set id [dict get $servers $chan channels $ch id]
			set topic [::string trimleft [::join [lreplace \
			    [dict get $msg args] 0 1] " "] ":"]

			gui displaytopic $id $date "$topic"
		} 331 {
			set ch [lindex [dict get $msg args] 1]
			set id [dict get $servers $chan channels $ch id]

			gui displaytopic $id $date $ch "No topic set"
		} 353 {
			set channel [lindex [dict get $msg args] 2]
			set nid [dict get $servers $chan channels server id]

			if {[dict exists $servers $chan channels $channel id]} {
				set id [dict get $servers $chan channels $channel id]
				set users [lreplace [dict get $msg args] 0 2]
				set users [lreplace $users 0 0 [string trimleft \
				    [lindex $users 0] ":"]]

				if {[dict get $servers $chan channels $channel \
				    names] == 0} {
					dict set servers $chan channels \
					    $channel names 1
					gui clearusers $id
				}

				foreach user $users {
					gui adduser $id $user
				}
			} else {
				gui displaymsg [join [dict get $msg args] \
				    " "] "*" -1 info $date
			}
		} 366 {
			set channel [lindex [dict get $msg args] 1]

			if {[dict exists $servers $chan channels $channel]} {
				dict set servers $chan channels $channel names 0
			}
		} 328 {
		} 333 {
			if {[dict get $servers $chan ok]} {
				gui displaymsg [join [dict get $msg args] \
				    " "] "*" -1 info $date
			}
		} default {
			set sid [dict get $servers $chan channels server id]

			if {[dict get $servers $chan ok]} {
				gui displaymsg [join [dict get $msg args] \
				    " "] "*" -1 info $date
			} else {
				gui displaymsg [join [dict get $msg args] \
				    " "] "*" $sid info $date
			}
		}
	}
}

proc ::irctk::ischanrd {chan channel} {
	variable servers

	if {"$channel" eq "[dict get $servers $chan network]"} {
		return 0
	}

	if {[dict exists $servers $chan channels $channel readonly]} {
		return [dict get $servers $chan channels $channel readonly]
	}

	return 0
}

#
# Extensions like to talk, fair enough, we gave them the ability.
#
# We take an incoming message, and inject it in the writing flow.
# If an extension sends a message for a channel that does not
# exists, we create a "read only" one.
#
# Useful to just show the information coming from the extension
# itself. We can kill and close it like any other, but we are not
# allowed to write messages on it from the GUI.
#
proc ::irctk::extmsg {msg} {
	variable servers

	if {[dict get $msg type] ne "irc"} {return}

	if {[dict get $msg network] eq "" || [dict get $msg channel] eq ""} {
		return
	}

	set channel [dict get $msg channel]
	set network [dict get $msg network]
	set msgstr [join [dict get $msg args] " "]
	set ch [findchan $network $channel]

	if {[llength $ch] == 0} {
		set ch [findchan $network]
		if {[llength $ch] == 0} {return}

		set id [genid]
		set parent [dict get $servers $ch channels server id]
		set date [clock format [clock seconds] -format %H:%M:%S]

		dict set servers $ch channels $channel id $id
		dict set servers $ch channels $channel readonly 1

		gui newreadtab $parent $id $channel $network
		gui displaymsg $msgstr * $id message $date
	} else {
		if {[ischanrd $ch $channel]} {
			set id [dict get $servers $ch channels $channel id]
			set date [clock format [clock seconds] -format %H:%M:%S]

			gui displaymsg $msgstr * $id message $date
		} else {
			if {[dict get $msg command] ne "privmsg"} {
				set msgstr "/[dict get $msg command] $msgstr"
			}

			if {"$network" eq "$channel"} {
				set id [dict get $servers $ch channels server id]
			} else {
				set id [dict get $servers $ch channels $channel id]
			}

			writemsg $ch $id [dict get $msg tags] "$msgstr" \
			    [dict get $msg loop]
		}
	}
}
