# CETK epic4 FServe 0.9
# http://www.epicsol.org/~crazyed/cetk.fserve
#
# Required (epic4 dist).
load commandqueues
#
unload cetk.fserve
package cetk.fserve
@ fserve.serial = 0 + getserial(hook + 1)
assign fserve.version CETK FServe 0.0 for epic4 w/ xdcc/cdcc/omen triggers
#
# This won't work with epic4 1.0.1 and it won't work _entirely_ for
# anything below 1.1.11.
#
# It also requires these shell commands:
#   rm mv find sort file md5sum test join cut sed.
#

#
# This is the simplest way to get this going:
#
#  /fserve.serve * * *
#
# This will turn on all available server types and serve
# all tags to all channels.  You only need do this once.
#
#  /fserve.addpath [tag] [dir] [mask] // [tag-description]
#
# This will make a new tag and serve all files matching [mask] in
# [dir]. Any number of dirs can be added with additional fserve.addpath
# commands or by using masks. The tags don't need to be unique, however
# if they aren't unique, then the two directories will appear to be
# unified.
#
# You can serve just some files in a directory by specifying any number
# of [masks] at the end of the addpath command before the double slash. If
# a file matches any mask, then the file appears in the find and list
# requests, but are not filtered from the stat and send requests, so
# technically, it is possible to serve hidden files.
#
# Configuration Examples.  This is what I have in my .epicrc:
#
# fserve.serve xdcc * *
# fserve.serve omen *mp3*,*book* mm,text
# fserve.addpath code ~/bin/ *tcp* *proxy* *port*
# fserve.addpath epicstuff ~/.epic/ cetk.* // This script is served from here.
# fserve.addpath epicstuff ~/epic/ * // More Epic scripts and sources.
# fserve.addpath mm {/home/*/*{dl,mp3}/,/mnt/*{,/}cd{rom,}/} // Multimedia.
# fserve.addpath pub /pub * // /pub
#
# Queueing:
#
# There are two layers of queueing.  The first is traditional where only one
# dcc send is open at once.  When the current one finishes, it allows the next
# one to start.  This queueing system relies on an external command queueing
# system.  This makes it possible to provide each user with at least one
# transfer asap, but makes it difficult to add queue status commands and such.
# Another side effect of this underlying queueing method is that requests will
# be addressed in a vaguely random order, rather than the sequential order that
# omen users are used to.  In addition, there is nothing to limit the maximum
# number of queued requests.
#
# The second queueing system is in effect after the first one is passed and the
# transfer starts.  It relies on the epic "dcc hold" feature, where if a dcc is
# "held", the transfer will stop sending data until it is "unheld".  This
# queueing system leaves just one dcc unheld at any one time.  When one dcc
# finishes, the next dcc is unheld.  The next dcc to be unheld is the one with
# the least remaining data in the transfer.  The purpose of this is to clear
# off as many dccs as possible as quickly as possible.  This queueing method
# does have problems.  Some clients will automatically close dccs that they
# perceive to be not transfering data, and this normally covers these held
# dccs.  For this reason, the feature has been turned off by default.  If you
# wish to turn it on again, you should put "set fserve.maxusersends 0" in your
# ~/.epicrc.
#
# There is no feature in this script that permits file list dccs to have an
# explicitly higher priority, however, the first dcc will always receive the
# highest priority, and that nearly always includes the file list dcc.
#
# Before each dcc is initiated, the userhost of the requesting nick is compared
# with the current userhost of that nick.  This means that if someone requests
# a file, then disconnects, then another user uses the same nick, they will not
# receive the send request, but the request will be silently discarded instead.
# The userhost of the dcc will then become the feature that distinguishes each
# user for the purpose of controlling both of these queueing mechanisms.
#
# Security notes:
#   * It should not be possible to escape the directory structure you set
#     up unless you have a file system link pointing outside of it.
#   * /exec is used.  It is designed to be secure, but that can't be
#     guaranteed.  Where possible, -direct has been used to pre-empt any
#     potential shell expansion exploits.  Where -direct cannot be used,
#     no input from the network is fed to the /exec.
#   * One last remaining worry is that the find shell command has an
#     -exec flag. The script prevents external use of this flag, but there
#     may be ways around this that I don't yet know about.
#   * Any difference between these security notes and reality should be
#     reported to the current maintainer.
#   * It is possible to abuse the client via the chat interface by
#     flooding it.
#
# Other notes:
#   * Server types are xdcc (which does cdcc) and omen, but I cheated
#     with omen by giving it @find and @[nick] and making it return
#     xdcc commands instead of real omen commands.
#
# Remaining issues:
#   * Omen SLOTS ctcps aren't used in this script.  It may not be added.
#     If you want it, it should be fairly easy to script.
#   * The queueing system needs to be tuned and given extra features.
#   * The omen script can be configured to give greater priority to opped and
#     voiced users on a channel.  The theory is that since servers get opped or
#     voiced, the catch cry "serve and you shall receive" comes true.  This
#     script gives equal priority to everybody, but it may be "fixed" in
#     future.
#

#
# Settings.  Change as desired.
#
# maxsends is the number of omen style "slots".
# maxusers is the maximum number of users that can be sent to at a time.
# maxusersends is the maximum number of dcc sends open to any one user at a time.
#
# These settings may not make sense until you consider the dcc streaming system
# which will place all but the smallest dcc to a user on hold, meaning that
# each user will always have up to one active dcc at any one time, in effect.
#
# Setting maxusersends to 1 will turn this streaming behaviour off.
#
assign fserve.set.maxqueue 0
assign fserve.set.maxsends 0
assign fserve.set.maxusers 0
assign fserve.set.maxusersends 0

# Supporting functions.
#
alias cdexec (args) {
	@ :owd = W
	cd $shift(args)
	exec $args
	cd $owd
}

# List maintenance commands.
#
# A tag is a synonym for a directory.
#
alias fserve.addpath (tag,path,masks) {
	@ :tp = encode($tag $path)
	@ :desc = afterw(// $masks)
	@ :time = isnumber(b10 $desc) ? shift(desc) : 0
	@ :cmasks = :fmasks = beforew(// $masks //)
	fe cmasks mask {@ mask = ischannel($mask) ? mask : []}
	fe fmasks mask {@ mask = ischannel($mask) ? [] : mask}
	fe (cmasks fmasks desc time) ar {
		@ fserve[tp][$tp][$ar] = [$($ar)]
	}
}
#
alias fserve.delpath (mask) {
	foreach fserve[tp] tp {
		if (decode($tp) =~ mask) {
			purge fserve.tp.$tp
		}
	}
}

# Basic infrastructure.
#
# Find:  Find the files matching [mask] under the relevant paths [tags]
#        and message them to [nick] preceded by [prefix].
#
alias fserve.find (me,nick,tagm,pftag,mask) {
	@ :oxd = xdebug(dword)
	xdebug dword
	@ :tagm = split(, $tagm)
	@ :cmd = shift(mask)
	@ :prefix = shift(mask)
	@ :lprefix = shift(mask)
	@ :fprefix = shift(mask)
	@ :hprefix = shift(mask)
	@ :count = 0
	fe mask mask {
		@ :type = mask =~ [*/*] ? [-ipath] : [-iname]
		@ :star = 0 > index(?* $mask) ? [*] : []
		@ sar(gr/\\/\\\\/mask)
		@ sar(gr/"/\\"/mask)
		@ mask = [$type "$star$mask$star"]
	}
	foreach fserve.tp tp {
		@ :pid = [fsfind_$rand(1000000)]
		@ :path = decode($tp)
		@ :tag = shift(path)
		@ :path = globi($path)
		@ :masks = fserve[tp][$tp][fmasks]
		@ :or = []
		unless (rmatch($tag $tagm)) {continue}
		fe path path {@ path = ["$path"]}
		fe masks masks {
			@ masks = [$or -iname $masks]
			@ or = [-o]
		}
		@ fserve[pids][$pid][lprefix] = [$lprefix $tag]
		@ fserve[pids][$pid][hprefix] = [$cmd $nick $hprefix]
		exec -window -direct -name $pid -end {purge fserve[pids][$0]} -line {
			if (:hprefix = fserve[pids][$0][hprefix]) {
				@ fserve[pids][$0][hprefix] = []
				if (nick =~ [=*]) {
					$hprefix
				} else {
					q1cmd 30 9 $hprefix
				}
			}
			if ([$2] =~ [=*]) {
				$1-
			} elsif (10 >= ++fserve[pids][$0][count]) {
				q1cmd 1 9 $1-
			} else {
				exec -close %$0
				q1cmd 1 9 $1-2 Too many matches.  Refine search or request list with this command:  $fserve[pids][$0][lprefix]
				unless ([$2] =~ [=*]) {q1cmd 5 9 wait}
			}
		} find $path -type f \( $masks \) $mask ! -type d -printf "$pid $cmd $nick $prefix $tag/%P\\n"
	}
	xdebug $oxd
}
#
# List:  Find all files under all [tags], add [prefix], zip the lists and send to [nick].
#
alias fserve.list (me,nick,tagm,pftag,args) {
	@ :sn = servernum()
	@ :tmp = [/tmp/]
	@ :tagm = split(, $tagm)
	@ :ftime = strftime(%F)
	@ :cmd = shift(args)
	@ :prefix = shift(args)
	@ :lprefix = shift(args)
	@ :fprefix = shift(args)
	@ :hprefix = shift(args)
	@ :matches = 0
	@ :userhost = userhost()
	@ :tags = []
	foreach fserve.tp tp {
		@ :path = decode($tp)
		@ :tag = shift(path)
		@ :path = globi($path)
		@ :fn = [$tmp/$me-${ftime}-${tag}-${pftag}.txt]
		if (!rmatch("$tag" $args)) {
			continue
		} elsif (!rmatch("$tag" $tagm)) {
			continue
		}
		if (0 < fsize("$fn") || 0 < fsize("" $fn)) {
			push :oldfiles $fn
			continue
		} else {
			push :newfiles $fn
		}
		@ :masks = fserve[tp][$tp][fmasks]
		@ :or = []
		fe masks mask {
			@ mask = [$or -iname '$mask']
			@ or = [-o]
		}
		exec -window -direct -name fslist_$fn sh
		exec -in %fslist_$fn find $path \\\( $masks \\\) ! -type d -printf '%p:$prefix $tag/%P\\t# %5kk \\n' >> $fn~1
		exec -in %fslist_$fn find $path \\\( $masks \\\) ! -type d -print | file -k -L -f - | sed -e 's/: */: /' >> $fn~2
	}
	fe ($uniq($oldfiles)) fn {
		if (nick =~ [=*]) {
			fserve.dcc $userhost send $nick $fn
		} else {
			scmd $sn q1cmd 1 97,98,99 fserve.dcc $userhost send $nick $fn
			scmd $sn q1cmd 1 97,98,99 wait
		}
	}
	fe ($uniq($newfiles)) fn {
		@ :enc = encode($userhost send $nick $fn)
		if (nick =~ [=*]) {
			wait %fslist_$fn -cmd \{fserve.dcc \$decode\($enc\)\}
		} else {
			wait %fslist_$fn -cmd \{scmd $sn q1cmd 1 97,98,99 fserve.dcc \$decode\($enc\)\}
			wait %fslist_$fn -cmd \{scmd $sn q1cmd 1 97,98,99 wait\}
		}
		exec -in %fslist_$fn sort -u $fn~1 > $fn~ && mv $fn~ $fn~1
		exec -in %fslist_$fn sort -u $fn~2 > $fn~ && mv $fn~ $fn~2
		exec -in %fslist_$fn join -t: $fn~1 $fn~2 | cut -f2- -d: > $fn
		exec -in %fslist_$fn rm $fn~1 $fn~2
		exec -in %fslist_$fn test -s $fn || rm $fn
		exec -in %fslist_$fn exit
	}
	if (uniq($newfiles $oldfiles)) {
		@ :msg = uniq($newfiles $oldfiles)
		fe msg msg {
			@ :msg = after(-1 / $msg)
		}
		@ :msg = [Queued the following file lists to you: $msg]
		if (nick =~ [=*]) {
			$cmd $nick $msg
		} else {
			scmd $sn q1cmd 5 9 $cmd $nick $msg
		}
	} else {
		@ :msg = [Please request my lists \('$lprefix *'\) or perform a search \('$fprefix [mask]'\).  For help, try '$hprefix'.  \[$fserve.version\]]
		if (nick =~ [=*]) {
			$cmd $nick $msg
		} else {
			scmd $sn q1cmd 5 9 $cmd $nick $msg
		}
		foreach fserve.tp tp {
			@ :path = decode($tp)
			@ :tag = shift(path)
			if (!rmatch("$tag" $tagm)) {
				continue
			} elsif (nick =~ [=*]) {
				$cmd $nick $lprefix $tag : $fserve[tp][$tp][desc]
			} else {
				scmd $sn q1cmd 5 9 $cmd $nick $lprefix $tag : $fserve[tp][$tp][desc]
			}
		}
	}
}
#
# Sendto:  Decode [file] given into the tag/path which find (above)
#          encoded, and then dcc the file to [nick].
#
# flag & 1 == files for this user should not be sent concurrently.
# flag & 2 == use of a priority slot is permitted.
#
alias fserve.send (flag,nick,cmd,file) {
	@ :tags = before(/ $file/)
	@ :file = after(/ $file)
	@ :matches = 0
	@ :uh = userhost()
	@ :oew = xdebug(extractw)
	xdebug extractw
	if (flag & 1) {
		@ fserve.unisends = uniq($uh $fserve.unisends)
	} else {
		@ fserve.unisends = remw($uh $fserve.unisends)
	}
	if (flag & 2) {
		@ fserve.priority = uniq($uh $fserve.priority)
	} else {
		@ fserve.priority = remw($uh $fserve.priority)
	}
	foreach fserve.tp tp {
		@ :path = decode($tp)
		@ :tag = shift(path)
		fe ($globi($path)) path {
			if (tag != tags) {
				continue
			} elsif (rmatch("$file" ../* */../*)) {
				# Please don't break out of our directory.
				continue
			} elsif (0 >= fexist("$path/$file") && 0 >= fexist("" $path/$file)) {
				continue
			}
			@ :queued = [97 98 99]
			fe queued queued {@ :queued = qcmd[$servernum()][$queued]}
			fe ($queued) foo {@ :queued += foo =~ [fserve.dcc $uh send $nick *]}
			if (++queued > fserve.set.maxqueue && fserve.set.maxqueue) {
				q1cmd 5 9 notice $nick Your maximum of $fserve.set.maxqueue queued files has been reached.
			} else {
				@ :msg = [$tags/$file has been queued.  \[$fserve.version\]]
				q1cmd 1 97,98,99 fserve.dcc $uh send $nick "$path/$file"
				q1cmd 5 9 notice $nick For a total of $queued file/s, $msg
			}
			@ :matches++
		}
	}
	unless (matches) {
		q1cmd 10 9 notice $nick No such file.  A valid filename has at least one slash, may have spaces, is case sensitive and is not a number.  Please try again.
	}
	xdebug $oew
}
#
# fileinfo: send output of md5sum/file/etc of [file] to [nick].
#
# The idea is that the user can cut'n'paste lines directly back to us
# so we don't include file stats etc which might confuse the situation.
#
# flag info is the same for fserve.send.
#
alias fserve.stat (flag,nick,file) {
	@ :cmd = shift(file)
	@ :tags = before(/ $file/)
	@ :file = after(/ $file)
	@ :matches = 0
	foreach fserve.tp tp {
		@ :path = decode($tp)
		@ :tag = shift(path)
		fe ($globi($path)) path {
			if (tag != tags) {
				continue
			} elsif (rmatch("$file" ../* */../*)) {
				# Please don't break out of our directory.
				continue
			} elsif (0 >= fexist("$path/$file") && 0 >= fexist("" $path/$file)) {
				continue
			}
			q1cmd 5 9 cdexec $path -window -direct -line \{$cmd $nick \$decode\($encode($file)\): \$*\} file -k -b -- "$file"
			q1cmd 5 9 cdexec $path -window -direct -line \{$cmd $nick md5: \$0 size: \$fsize\("\$sar\(, ,$path/,\$1-\)"\) \$1-\} md5sum -- "$file"
			@ :matches++
		}
	}
	if (matches) {
		q1cmd 5 9 $cmd $nick $matches matches for $tags/${file}.  Stats follow.  \[$fserve.version\]
	} else {
		q1cmd 5 9 $cmd $nick No such file $tags/$file
	}
}
#
# Block the exit messages without having to turn notify_on_termination off.
#
fe (fslist_% fsfind_% fsfile fsfind) foo {
	on ^exec_exit "$foo *"
}
#
# DCC: Substitute for "dcc $1-".
#
# The purpose is to set the userhost of the DCC to $0 and to queue
# the request if _any_ limit is reached.
#
# The queueing order is not preserved, but it will try not to punish
# people for things they can't control. People with no transfers get
# highest priority and people at their limits get lowest.
#
# The DCC will also be discarded if the userhost of the current nick
# doesn't match $0. A userhost request will be made if the user and the
# fserve aren't on a common channel to obtain this information.
#
# flag info is the same for fserve.send.
#
# The qcmd queues are like this:
#   97 is for people with no open dccs and are blocked for other reasons.
#   98 is for people with some, and have been blocked for other reasons.
#   99 is for people who have used up all their allowed slots.
#
alias fserve.dcc (args) {
	@ :userhost = shift(args)
	@ :index = chr($jot($ascii(az)))
	@ :usermask = index($index $userhost) ? [*@]##after(@ $userhost) : userhost
	@ :usermask = common($dccctl(typematch send) / $dccctl(userhostmatch $usermask))
	@ :userhosts = dccctl(typematch send)
	fe userhosts foo {
		@ foo = dccctl(get $foo userhost)
		@ foo = index($index $foo) ? [*@]##after(@ $foo) : foo
	}
	@ :fail0 = 0 < #usermask && 0 <= findw("$userhost" $fserve.unisends)
	@ :fail1 = 0 < fserve.set.maxusersends && fserve.set.maxusersends <= #usermask
	@ :fail2 = 0 < fserve.set.maxsends && fserve.set.maxsends <= #userhosts
	@ :fail3 = 0 < fserve.set.maxusers && fserve.set.maxusers <= #uniq($userhosts)
	if ([send] != word(0 $args)) {
		@ fserve.userhost = userhost
		dcc $args
		@ fserve.userhost = [ ]
	} elsif (fail0 || fail1) {
		timer.ue 10 q1cmd 1 99,98,97 fserve.dcc $userhost $args
	} elsif (fail2 || fail3) {
		if (rmatch($userhost $userhosts)) {
			timer.ue 10 q1cmd 1 98,97,99 fserve.dcc $userhost $args
		} else {
			timer.ue 10 q1cmd 1 97,98,99 fserve.dcc $userhost $args
		}
	} else {
		qcmd fserve.dccs $userhost dcc $args
		userhost $word(1 $args) -cmd {
			@ :cmd = qcmd(fserve.dccs)
			@ fserve.userhost = shift(cmd)
			if ([$3@$4] == fserve.userhost) {
				$cmd
			} else {
				echo Discarded $cmd
			}
			@ fserve.userhost = [ ]
		}
	}
}
eval on #-dcc_offer $fserve.serial * {
	@ :ref = dccctl(locked)
	if (#ref != 1) {
	} elsif (#fserve.userhost < 1) {
		echo no userhost given
	} elsif (#fserve.userhost > 1) {
		echo userhost with spaces given
	} elsif (fserve.userhost !~ [*@*]) {
		echo invalid userhost given: $fserve.userhost
	} elsif (fserve.userhost != dccctl(get $ref userhost)) {
		@ dccctl(set $ref userhost $fserve.userhost)
	}
	if (0 && [$1] == [chat]) {
		^on -dcc_connect "$0 chat *" {
			^msg =$0 Experimental chat interface.
			^msg =$0 This is still being developed.
			^msg =$0 Please use the /xdcc interface.
		}
		^on -dcc_chat "$0" fserve.chatif \$*
		^on -dcc_lost "$0-1" {
			^on dcc_connect -"$0 chat *"
			^on dcc_chat -"$0"
			^on dcc_lost -"$0-1"
		}
	}
}

#
# The chat interface handler.
#
alias fserve.chatif {
	shook ctcp =$0 $N XDCC $1-
	while (:cmd = qcmd()) {$cmd}
}

# This is where the rubber meets the road.  The infrastructure
# above is bound to protocol commands here.
#
# The fserve.serve protocols are modeled on certain other fserves.
#
alias fserve.serve (type,args) {
	@ :matches = 0
	if (#args < 2) {
		echo Requires: [typemask] [chanmask] [tagmask]
	} else {
		foreach -fserve.serve fn {
			if (fn =~ type) {
				@ matches++
				fserve.serve.$fn $args
			}
		}
		echo $matches trigger sets loaded.
	}
}
#
alias fserve.serve.xdcc (dest,tags,args) {
	stack push alias on.t
	^alias on.t {on $*;on $sar(g/XDCC/CDCC/$*)}
	@ :dest = split(, $dest)
	^on.t -ctcp "% \\[$dest\\] XDCC *" \
		@ :tags = [$tags]\;{
		@ :nick = servernick() =~ [* *] ? N : servernick()
		@ :tome = nick =~ [=*] || [$0] =~ [=*] || nick == servernick()
		@ :send = [/ctcp $nick XDCC send]
		@ :list = [/ctcp $nick XDCC list]
		@ :find = [/ctcp $nick XDCC find]
		@ :help = [/ctcp $nick XDCC help]
		switch ($3) {
		(chat) {
			q1cmd 5 9 fserve.dcc $userhost() chat $0
		}
		(find) {
			fserve.find $nick $0 $tags XDCC notice "$send" "$list" "$find" "$help" $4-
		}
		(list) {
			fserve.list $nick $0 $tags XDCC notice "$send" "$list" "$find" "$help" $4-
		}
		(send) {
			if (tome) {fserve.send 1 $0 notice $4-}
		}
		(sndm) {
			if (tome) {fserve.send 0 $0 notice $4-}
		}
		(stat) {
			if (tome) {fserve.stat 0 $0 notice $4-}
		}
		(*) () {
			if (!tome) {
				break
			} elsif (!rmatch("$3" "" help)) {
				q1cmd 5 9 notice $0 No such function: $3-
			}
			q1cmd 5 9 notice $0 XDCC commands: CHAT FIND LIST SEND SNDM STAT
			q1cmd 5 9 notice $0 XDCC CHAT              # Unrestricted interface.  (same commands)
			q1cmd 5 9 notice $0 XDCC FIND [pattern]    # Return files matching all patterns.
			q1cmd 5 9 notice $0 XDCC LIST [pattern]    # Send file lists for all matching tags.
			q1cmd 5 9 notice $0 XDCC SEND [file]       # Queue a served file for send.
			q1cmd 5 9 notice $0 XDCC SNDM [file]       # Send multiple requests concurrently.
			q1cmd 5 9 notice $0 XDCC STAT [file]       # Info about a served file.
		}
		}
	}
	stack pop alias on.t
}
#
alias fserve.serve.omen (dest,tags,args) {
	stack push alias on.t
	^alias on.t {on $*;on $sar(g/public_other/public/$*)}
	@ :dest = split(, $dest)
	^on.t #-public_other $fserve.serial "% \\[$dest\\] @find *" \
			@ :tags = [$tags]\;{
		@ :nick = servernick() ? servernick() : [$1]
		fserve.find $nick $0 $tags OMEN notice "!$nick" "@$nick" "@find" "/ctcp $nick XDCC help" $3-
	}
	^on.t #-public_other $fserve.serial '% \\\\[$dest\\\\] @\$servernick()' shook public_other \$* 
	^on.t #-public_other $fserve.serial '% \\\\[$dest\\\\] @\$servernick() *' \
			@ :tags = [$tags]\;{
		@ :nick = servernick() ? servernick() : [$1]
		fserve.list $nick $0 $tags OMEN notice "!$nick" "@$nick" "@find" "/ctcp $nick XDCC help" $3-
	}
	^on.t #-public_other $fserve.serial '% \\\\[$dest\\\\] !\$servernick() *' {fserve.send 1 $0 notice $3-}
	stack pop alias on.t
}

# DCC streamliner. Call at appropriate intervals to re-evaluate the SEND hold
# modes. The policy is to have one send to any given IP unheld at any one time,
# leaving just one download per user. The one chosen is the one that has the
# smallest remaining data and therefore completes fastest.
#
# This is valuable at so many levels: It is good as a dynamic queueing system;
# It doesn't require either client to remain connected to the irc server; It is
# resume friendly since resuming a failed transfer will automatically bring it
# back to the front of the queue; It has a zero turnaround time between sends;
# It is a good "backup" queueing system for those that manage to get past the
# userhost based restrictions; And most importantly, it doesn't belt your
# uplink since the VJ header compression buffers aren't being flushed, and for
# other reasons.
#
# The assumption for the bandwidth concerns is that we don't have an excessive
# number of users being uploaded to. If this happens we end up with too many
# active sends and the same basic problem. To solve this problem, it may be
# best to place all sends on hold for a short while periodically. I may change
# this to unhold only a certain number of users with the oldest transfers at
# some point, although I dislike this idea because then it will be necessary to
# check that all those users aren't Damn Slow.
#
# The assumption for the performance concerns is that we don't have way too
# many dcc sends going, period. If this happens, not only does it take us ever
# increasing times to walk the list, but epics select call processing time will
# increase beyond our control. There's not much to be done about this except to
# cap the number of transfers. 100 to 1000 transfers would probably be a
# (barely) comfortable maximum.
#
alias dcc.stream {
	^local refs.
	^local rems.
	@ :refs = dccctl(typematch SEND)
	fe ($refs) ref {
		@ :eref = dccctl(get $ref remaddr)
		@ :eref = encode($shift(eref))
		@ :rem = dccctl(get $ref filesize) - dccctl(get $ref sentbytes)
		if (!#eref || 0>=rem) {
			@ dccctl(set $ref held 0)
		} elsif (32 & ~dccctl(get $ref flags)) {
			@ dccctl(set $ref held 0)
		} elsif (rems[$eref] <= 0 || rem < rems[$eref]) {
			fe ($refs[$eref]) oref {
				@ dccctl(set $oref held 1)
			}
			@ dccctl(set $ref held 0)
			@ refs[$eref] = ref
			@ rems[$eref] = rem
		} else {
			@ dccctl(set $ref held 1)
		}
	}
}
eval on #-dcc_connect $fserve.serial * dcc.stream
eval on #-dcc_lost $fserve.serial * dcc.stream

#
# These stop and start all open DCCs without closing their connections.  This
# is useful if your bandwidth is being clobbered by DCC and you need time to
# fix it.  Note that /dcc.stream is called periodically in other places in this
# script, which will undo these hold modes for all outgoing file sends.
#
# /dcc.hold
# /dcc.unhold
#
# You can specify a wildcard mask which will be matched against the specified
# variables of all dccs.
#
stack push alias alias.tt
alias alias.tt (mode,val,pref dwords 1,args) {
	@ sar(gr/\${pref}/$pref/args)
	@ sar(gr/\${mode}/$mode/args)
	@ sar(gr/\${val}/$val/args)
	alias $args
}
fe ("" held 1 un held 0) pref mode val {
	alias.tt $mode $val "$pref" dcc.${pref}hold (args default *) {
		@ :matches = :fixes = 0
		@ :hdr = [type user userhost remaddr description filename othername]
		if (#args) {
			fe ($dccctl(ref)) ref {
				@ :refs = hdr
				fe refs refs {
					@ refs = dccctl(get $ref $refs)
				}
				if (refs =~ args) {
					@ :fixes += !dccctl(set $ref ${mode} ${val})
					@ :matches++
				}
			}
			echo $fixes/$matches matching DCCs ${pref}${mode}
		} else {
			echo Please specify a mask matching: $hdr
		}
	}
}
stack pop alias alias.tt