#
# pop3.tcl
#
# No, I'm not kidding. a POP3 server written in Eggdrop Tcl. Lets you
# retrieve notes from the bot. I don't know what I was drinking, smoking,
# snorting, or shooting up, but here it is.
#
# The code is a little ugly, but it does what it's supposed to.
#
# Works with fetchmail, anyway.
#
# --
# Jack Cuervo <jack.hax@zerokarma.homeunix.org>
#
# Thanks to Davin for help testing.
#

set popStateInfo() ""
set popHostInfo() ""
set popUserInfo() ""
set popEraseQueue() ""

proc pop:putlog {stuff} {
	putloglev 2 * $stuff
}

proc pop:putdcc {idx stuff} {
	foreach line [split $stuff "\n"] {
		putdcc $idx "$line\r"
	}
}

proc pop:connInfo {idx} {
	global popHostInfo popUserInfo
	set str ""

	if {$popUserInfo($idx) != ""} {
		lappend str "$popUserInfo($idx)"
	}

	lappend str "\[$popHostInfo($idx)\]"

	return [join $str ""]
}

proc pop:kill {idx} {
	global popStateInfo popHostInfo popUserInfo popEraseQueue

	pop:putlog "POP: [pop:connInfo $idx] disconnected."

	if {[valididx $idx]} {
		killdcc $idx
	}

	foreach deadNote [lsort -decreasing $popEraseQueue($idx)] {
		pop:putlog "POP: $popUserInfo($idx): Erasing deleted note $deadNote."
		erasenotes $popUserInfo($idx) $deadNote
	}

	foreach v {popStateInfo popHostInfo popUserInfo popEraseQueue} {
		array unset $v $idx
	}
}

proc pop:setState {idx state} {
	global popStateInfo
	set popStateInfo($idx) $state
}


proc pop:noteBoxSize {idx} {
	global popUserInfo

	set numNotes [notes $popUserInfo($idx)]
	set size 0

	for {set i 1} {$i <= $numNotes} {incr i} {
		set thisNote [pop:getNote $idx $i]
		set size [expr $size + [string length [lrange $thisNote 2 end]]]
	}

	return $size
}

proc pop:getNote {idx number} {
	global popUserInfo
	return [lindex [notes $popUserInfo($idx) $number] 0]
}

proc pop:sendNote {idx data} {
	global popUserInfo botnet-nick

	if {[set thisNote [pop:getNote $idx $data]] == "0"} {
		pop:putdcc $idx "-ERR No such message."
		return
	}

	set noteSender [lindex $thisNote 0]
	set thisNote [lindex $thisNote 2]

	if {[string first "@" $noteSender] == -1} {
		set noteSender "${noteSender}\@${botnet-nick}"
	}

	pop:putdcc $idx "+OK
From: $noteSender
To: $popUserInfo($idx)\@${botnet-nick}

$thisNote

."

	return
}

proc pop:command {idx data} {
	if {$data == ""} {
		pop:kill $idx
		return
	}

	set command [lindex $data 0]
	set validCommand 0

	foreach popCommand [info commands popCommands:*] {
		set popCommand [string range $popCommand [expr [string first ":" $popCommand] + 1] end]

		if {$popCommand == $command} {
			incr validCommand
			break
		}
	}

	if {! $validCommand} {
		pop:putlog "[pop:connInfo $idx] Bad command: $command"
		pop:putdcc $idx "-ERR \"$command\"? Go read the fucking RFC."
		return
	}

	pop:putlog "POP: [pop:connInfo $idx] $command"

	if {[popCommands:$command $idx [lrange $data 1 end]] == -1} {
		pop:putlog "[pop:connInfo $idx] Needs to authenticate before $command."
		pop:putdcc $idx "-ERR Log the fuck in first, dipshit."

		return
	}
}

proc pop:greet {idx} {
	foreach conn [dcclist SOCKET] {
		if {[lindex $conn 0] == $idx} {
			global popHostInfo popUserInfo
			set popHostInfo($idx) [lindex $conn 2]
			set popUserInfo($idx) ""

			pop:putlog "Connect to POP from [pop:connInfo $idx]"
			break
		}
	}

	pop:putdcc $idx "+OK Eggdrop pop3 server: idx=$idx"

	pop:setState $idx 0

	control $idx pop:command
}

proc pop:read {idx data} {
	if {$data == ""} {
		pop:kill $idx
	}
}

proc popCommands:USER {idx data} {
	global popUserInfo
	set popUserInfo($idx) [lindex $data 0]

	pop:setState $idx 1

	pop:putdcc $idx "+OK Send password"
}

proc popCommands:PASS {idx data} {
	global popUserInfo popStateInfo popEraseQueue

	set pw [lindex $data 0]

	if {$popStateInfo($idx) == 0} {
		pop:putlog "POP: [pop:connInfo $idx] sent PASS before USER"
		pop:putdcc $idx "-ERR Send username first"
		return
	}

	if {! [passwdok $popUserInfo($idx) $pw]} {
		pop:putlog "POP: Bad username/password from [pop:connInfo $idx]"
		pop:putdcc $idx "-ERR Login failed, you lying sack of shit"

		return
	}

	pop:putlog "POP: [pop:connInfo $idx] logged in."
	pop:putdcc $idx "+OK Aw, fuck, it's YOU."

	pop:setState $idx 2

	set popEraseQueue($idx) ""

	return
}

proc popCommands:UIDL {idx data} {
	global popUserInfo

	pop:putdcc $idx "+OK Damn it"

	if {$data == ""} {
		for {set i 1} {$i <= [notes $popUserInfo($idx)]} {incr i} {
			pop:putdcc $idx "$i [encrypt $popUserInfo($idx) "[notes $popUserInfo($idx) $i]"]"
		}
	} else {
		pop:putdcc $idx "$i [encrypt $popUserInfo($idx) "[notes $popUserInfo($idx) $data]"]"
	}

	pop:putdcc $idx "."
}

proc popCommands:QUIT {idx data} {
	pop:putdcc $idx "+OK Get bent."
	pop:kill $idx
}

proc popCommands:LIST {idx data} {
	global popUserInfo popStateInfo

	if {$popStateInfo($idx) != 2} {
		return -1
	}


	if {$data == ""} {
		set numNotes [notes $popUserInfo($idx)]

		pop:putdcc $idx "+OK $numNotes [pop:noteBoxSize $idx]"

		for {set i 1} {$i <= $numNotes} {incr i} {
			pop:putdcc $idx "$i [string length [pop:getNote $idx $i]]"
		}

		pop:putdcc $idx "."
	} else {
		pop:putdcc $idx "+OK $data [string length [pop:getNote $idx $data]]"
	}
}

proc popCommands:LAST {idx data} {
	pop:putdcc $idx "+OK 0"
}

proc popCommands:RETR {idx data} {
	global popStateInfo popUserInfo

	if {$popStateInfo($idx) != 2} {
		return -1
	}

	#set thisNote [lindex [notes $popUserInfo($idx) $data] 0]
	pop:sendNote $idx $data
}

proc popCommands:TOP {idx data} {
	global popStateInfo popUserInfo

	if {$popStateInfo($idx) != 2} {
		return -1
	}

	pop:sendNote $idx $data
}

proc popCommands:CAPA {idx data} {
	pop:putdcc $idx "+OK
TOP
USER
UIDL
."
	return
}

proc popCommands:STAT {idx data} {
	global popStateInfo popUserInfo

	if {$popStateInfo($idx) != 2} {
		return -1
	}

	pop:putdcc $idx "+OK [notes $popUserInfo($idx)]"
}

proc popCommands:DELE {idx data} {
	#
	# Fun: we can't actually erase the notes right away, because the
	# index of the note will change -- e.g., if you have three notes,
	# 1 2 3, and you delete 2, you then have two notes -- 1 and 2.
	# 3 got demoted. So we just queue the deletions.
	#
	global popStateInfo popUserInfo popEraseQueue

	if {$popStateInfo($idx) != 2} {
		return -1
	}

	lappend popEraseQueue($idx) $data

	pop:putdcc $idx "+OK Message gangraped by monkeys."
}

set statsock [listen 1030 script pop:greet pub]

pop:putlog "POP: Loaded."