#!/usr/bin/env tclsh8.6
#
# search.tcl: search through the IRCTk irc logs
#
# Commands:
#
# SEARCH regexp
#	Search for log lines of a channel, matching the given
#	regular expression
#
# To install in the default directory:
#
#	# make install
#
# To install on a different prefix (i.e. your homedir)
#
#	$PREFIX=${HOME} make install
#
# As an example, to search all the records for 2023/08/29, type
# in a messagebox:
#
#	//search ^2023-08-29
#

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

set name "Search"
set version 1.0.0
set protoversion 1.0
set logpath $::env(HOME)/irc/logs

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"]]
}

#
# Simply read a line from stdin
#
while {[gets stdin line] >= 0} {
	#
	# 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 "$::name: Incompatible protocol version"

				exit 1
			} else {
				ack $id

				handshake

				filter irc
				filter search

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

			flush stderr
		} irc {
			set network [lindex $msg 8]
			set channel [lindex $msg 9]
			set search [lindex $msg 12]

			#
			# Open the log channel file
			#
			if {[catch {set fd [open "$logpath/$network/$channel"]} errstr]} {
				writemsg $network $channel-search-error \
				    PRIVMSG $errstr

				flush stdout

				continue
			}

			#
			# Test if the regexp is ok. If not, report an
			# error for it.
			#
			if {[catch {regexp $search "abcde"} errstr]} {
				writemsg $network $channel-search-error \
				    PRIVMSG $errstr
			} else {
				#
				# Grep through the logs and send the lines that
				# matches.
				#
				while {[gets $fd entry] >= 0} {
					if {![regexp $search $entry]} {continue}

					writemsg $network $channel-search \
					    PRIVMSG $entry
				}
			}

			close $fd
		}
	}

	flush stdout
}
