#!/usr/bin/env tclsh8.6
#
# identify.tcl: automatically identify with NickServ. Useful for those
# networks  that doesn't recognize PASS
#
# To install in the default directory:
#
#	# make install
#
# To install on a different prefix (i.e. your homedir)
#
#	$PREFIX=${HOME} make install
#
# The extension, first QUERY the NickServ bot, creating a channel
# in IRCTk and after that, sends an "identify" command to it.
#

#
# uuid package from Tcllib:
#
# https://core.tcl-lang.org/tcllib
#
package require uuid

#
# Timeouts.
#
# Networks doesn't react immediately, so wait a bit between
# receiving the PASS and sending a QUERY (queryms).
#
# Once the channel is established, we send the identify
# message, after "identifyms".
#
set queryms 3000
set identifyms 6000

set name "Identify"
set version 1.0.0
set protoversion 1.0

proc newid {} {
	uuid::uuid generate
}

#
# Commands for various message formats as mandated by the IRCTk
# protocol specification:
#
#	https://lab.abiscuola.org/irctk/doc/trunk/www/wiki/extensions.wiki
#

proc handshake {} {
	puts [encoding convertto utf-8 [format "%s\thandshake\t1.0\t%s\t%s\r" \
	    [::newid] $::name $::version]]
}

proc ack {id {msg "ok"}} {
	puts [encoding convertto utf-8 [format "%s\tack\t%s\r" $id $msg]]
}

proc nack {id {msg "ko"}} {
	puts [encoding convertto utf-8 [format "%s\tnack\t%s\r" $id $msg]]
}

proc filter {type} {
	puts [encoding convertto utf-8 [format "%s\tfilter\t%s\r" \
	    [::newid] $type]]
}

proc writemsg {net chan cmd line} {
	puts [encoding convertto utf-8 [format \
	    "\tirc\t\t\t\t\t\t\t%s\t%s\t\t%s\t%s\r" \
	    "$net" "$chan" "$cmd" "$line"]]
}

proc readline {} {
	# Get a new line
	set line ""
	if {[gets stdin line] < 0} {
		if {[eof stdin]} {set ::rvalue 0}

		return
	}

	#
	# Remember that the messages are exchanged as UTF-8
	#
	set msg [split [encoding convertfrom utf-8 $line] "\t"]

	switch -exact -- [lindex $msg 1] {
		handshake {
			set id [lindex $msg 0]

			#
			# Run the handshake. The protocol is retro-compatible,
			# so we check if the version in our extension is too new
			# for the version of IRCTk we are running.
			#
			if {[lindex $msg 2] < $::protoversion} {
				nack $id "$extname: Incompatible protocol version"

				set ::rvalue 1
			} else {
				ack $id

				handshake

				filter irc
				filter pass

				flush stdout
			}
		} nack {
			#
			# Log the reason why we were refused a request
			#
			puts stderr "[lindex $msg 2]"

			flush stderr
		} irc {
			set net [lindex $msg 8]
			set chan [lindex $msg 9]
			set pass [lindex $msg 12]

			#
			# Wait a bit, before sending the QUERY command.
			#
			after $::queryms "writemsg \"$net\" \"$chan\" query NickServ"

			#
			# Once we are sure enough, send the identify
			# command to NickServ
			#
			after $::identifyms "writemsg \"$net\" NickServ identify \"$pass\""
		}
	}
}

fileevent stdin readable readline

vwait rvalue

exit $rvalue
