#!/bin/sh
# the exec restarts using tclsh which in turn ignores
# the command because of this backslash: \
exec mash-VERSION "$0" -name bin/hm -- "$@"

#
# Copyright (c) 1993-1996 The Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#	This product includes software developed by the University of
#	California, Berkeley and the Network Research Group at
#	Lawrence Berkeley Laboratory.
# 4. Neither the name of the University nor of the Laboratory may be used
#    to endorse or promote products derived from this software without
#    specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# @(#) $Header: /usr/src/mash/repository/mash/mash-1/head.tcl,v 1.3 1997/08/15 07:23:36 mccanne Exp $ (LBL)
#
proc option args {
	global _db
	if { [lindex $args 0] == "add" } {
		set o [split [lindex $args 1] .]
		set cls [lindex $o 0]
		set resource [lindex $o 1]
		set value [lindex $args 2]
		set pri [lindex $args 3]
		if { $pri == "" } {
			set pri 80
		}
		if [info exists _db($cls,$resource,pri)] {
			set oldpri $_db($cls,$resource,pri)
		} else {
			set oldpri -1
		}
		if { $oldpri > $pri } {
			return
		}
		set _db($cls,$resource,val) $value
		set _db($cls,$resource,pri) $pri
	} elseif { [lindex $args 0] == "get" } {
		set resource [lindex $args 2]
		set cls [lindex $args 3]
		if [info exists _db($cls,$resource,val)] {
			return $_db($cls,$resource,val)
		} else {
			return ""
		}
	} elseif { [lindex $args 0] == "clear" } {
		unset _db
	}
}
Class Log
Log proc name s {
	Log set name_ $s
}
Log proc warn s {
	Log instvar name_
	puts stderr "$name_: $s"
}
Log proc fatal s {
	Log warn $s
	exit 1
}
Class Application
Application public init name {
	$self next
	$self instvar name_ class_
	set name_ $name
	$self add_option appname $name
	Log set name_ $name
	set class_ [string toupper [string index $name_ 0]][string \
		range $name_ 1 end]
	catch "tk appname $name"
	Application set instance_ $self
}
Application proc instance {} {
	return [Application set instance_]
}
Application proc name {} {
	return [[Application instance] set name_]
}
Application proc class {} {
	return [[Application instance] set class_]
}
Application proc toplevel w {
	Application instvar visual_ colormap_
	if [info exists visual_] {
		toplevel $w -class [Application class] \
			-visual $visual_ -colormap $colormap_
	} else {
		toplevel $w -class [Application class]
	}
}
global font
set font(helvetica10) {
	normal--*-100-75-75-*-*-*-*
	normal--10-*-*-*-*-*-*-*
	normal--11-*-*-*-*-*-*-*
	normal--*-100-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica12) {
	normal--*-120-75-75-*-*-*-*
	normal--12-*-*-*-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-120-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(times14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
Application instproc search_font { foundry style weight points slant } {
	global font tcl_version tcl_platform
 	if {$tcl_version >= 8} {
 		if {$slant == "r"} {
 			set slant ""
 		} elseif {$slant == "o"} {
 			set slant "italic"
 		}
		if {$weight == "medium"} {
			set weight ""
		}
 		return "$style -$points $weight $slant"
 	}
	foreach f $font($style$points) {
		set fname -$foundry-$style-$weight-$slant-$f
		if [havefont $fname] {
			return $fname
		}
	}
	$self instvar name_
	puts stderr "$name_: can't find $weight $fname font (using fixed)"
	if ![havefont fixed] {
		puts stderr "$name_: can't find fixed font"
		exit 1
	}
	return fixed
}
Application public init_local {} {
	$self instvar name_
	set f ~/.$name_.tcl
	if [file exists $f] {
		uplevel #0 "source $f"
	}
	set script [$self resource startupScript]
	if { $script != "" } {
		uplevel #0 "source $script"
	}
}
Application instproc user_hook {} {
}
Object instproc options {} {
	$self instvar options_
	if ![info exists options_] {
		Object instvar options_
		if ![info exists options_] {
			set options_ [new Configuration]
			global tcl_platform
			if {"$tcl_platform(platform)"=="windows"} {
				$options_ add_default \
					background SystemButtonFace
				$options_ add_default \
					infoHighlightColor SystemHighlightText
			}
		}
	}
	$options_ add_default appname mash
	return $options_
}
Object instproc optionsFrom o {
	$self set options_ $o
}
Class instproc configuration a {
 	$self instvar options_
	if ![info exists options_] {
		set options_ [new Configuration]
	}
	foreach { option value } $a {
		$options_ add_default $option $value
	}
}
Object instproc get_option r {
	set v [[$self options] get_option $r]
	if { $v != "" } {
		return $v
	}
	set cl [$self info class]
	foreach cl "$cl [$cl info heritage]" {
		$cl instvar options_
		if [info exists options_] {
			set v [$options_ get_option $r]
			if { $v != "" } {
				return $v
			}
		}
	}
	return ""
}
Object instproc resource r {
	return [$self get_option $r]
}
Object instproc add_option { r v } {
	return [[$self options] add_option $r $v]
}
Object instproc add_default { r v } {
	return [[$self options] add_default $r $v]
}
Object instproc yesno r {
	set v [$self get_option $r]
	if [string match \[0-9\]* $v] {
		return $v
	}
	if [string match \[tT\]* $v] {
		return 1
	}
	return 0
}
Object instproc debug s {
	if [$self yesno debug] {
		Log warn $s
	}
}
Object instproc warn s {
	Log warn $s
}
Object instproc fatal s {
	Log fatal $s
}
Class Configuration
Configuration public get_option r {
	$self instvar table_ default_
	if [info exists table_($r)] {
		return $table_($r)
	}
	if [info exists default_($r)] {
		return $default_($r)
	}
	return ""
}
Configuration public add_option { r v } {
	$self instvar table_
	set table_($r) $v
}
Configuration public add_default { r v } {
	$self set default_($r) $v
}
Configuration public register_option  { flag option args } {
	$self instvar arg_option_ usage_
	set arg_option_($flag) $option
	set usage_($flag) $args
}
Configuration public register_boolean_option  { flag option args } {
	$self instvar arg_bool_ arg_bool_val_
	set arg_bool_($flag) $option
	if { $args == "" } {
		set args 1
	}
	set arg_bool_val_($flag) $args
}
Configuration public register_list_option {flag option args} {
	$self instvar arg_list_option_
	set arg_list_option_($flag) $option
	set usage_($flag) $args
}
Configuration private is_arg argv {
	if { $argv != "" } {
		return [string match -* [lindex $argv 0]]
	}
	return 0
}
Configuration instproc parse_args argv {
	$self instvar arg_resource_ bool_resource_ 
	$self instvar arg_option_ arg_bool_ arg_bool_val_ arg_list_option_
	if { [info exists arg_resource_] || [info exists bool_resource_] } {
		puts stderr "your application class needs to be fixed"
		exit 1
	}
	while 1 {
		if ![$self is_arg $argv] {
			break
		}
		set arg [lindex $argv 0]
		set argv [lrange $argv 1 end]
		set val [lindex $argv 0]
		if { $arg == "-help" } {
			$self usage
			exit
		}
		if { $arg == "-X" } {
			set L [split $val =]
			if { [llength $L] != 2 } {
				puts stderr "malformed -X argument"
				exit 1
			}
			$self add_option [lindex $L 0] [lindex $L 1]
			set argv [lrange $argv 1 end]
			continue
		}
		if [info exists arg_option_($arg)] {
			$self add_option $arg_option_($arg) $val
			set argv [lrange $argv 1 end]
			continue
		}
		if [info exists arg_bool_($arg)] {
			$self add_option $arg_bool_($arg) $arg_bool_val_($arg)
			continue
		}
		if [info exists arg_list_option_($arg)] {
			set o $arg_list_option_($arg)
			set l [$self get_option $o]
			lappend l $val
			$self add_option $o $l
			set argv [lrange $argv 1 end]
			continue
		}
		$self usage
		$self fatal "unknown command option: $arg"
	}
	return $argv
}
Configuration public usage {} {
	set display_args_on_single_line 0
	if { $display_args_on_single_line } {
		puts "usage: [Application name] [join [$self arg_info]]"
	} else {
		puts "usage: [Application name]" 
		foreach arg [$self arg_info] {
			puts $arg
		}
	}
}
Configuration private arg_info {} {
	$self instvar arg_option_ arg_bool_ usage_
	foreach arg [array names arg_option_] {
		set r $arg_option_($arg)
		set d [$self get_option $r]
		if { $d != "" || $usage_($arg) != "required"} {
			lappend opt "\[$arg $r ($d)\]"
		} else {
			lappend req "$arg $r"
		}
	}
	foreach arg [array names arg_bool_] {
		set r $arg_bool_($arg)
		set d [$self get_option $r]
		if { $d != "" } {
		        lappend opt "\[$arg ($d)\]"
		} else {
			lappend opt "\[$arg\]"
		}
	}
	if [info exists opt] {
		if [info exists req] {
			return [concat $opt $req]
		} else {
			return $opt
		}
	} else {
		if [info exists req] {
			return $req
		} else {
			return ""
		}
	}
}
Configuration public load_preferences suffixList {
	set mash [glob ~]/.mash
	if [file isdirectory $mash] {
		$self load_file $mash/prefs
		foreach suffix $suffixList {
			$self load_file $mash/prefs-$suffix
		}
	}
}
Configuration private load_file fname {
	if ![file readable $fname] {
		return
	}
	set f [open $fname r]
	set count 0
	while 1 {
		incr count
		if [eof $f] {
			close $f
			return
		}
		set line [string trim [gets $f]]
		if { $line == {} || [string index $line 0]=="#" } {
			continue
		}
		set colon [string first ":" $line]
		if { $colon==-1 } {
			puts stderr "Invalid line $count in $fname:\
					Must be of the form \"key: value\""
			continue
		}
		set option [string trim [string range $line 0 [expr $colon-1]]]
		set value [string trim [string range $line \
				[expr $colon+1] end]]
		$self add_option $option $value
	}
}
Class Timer
Class Timer/Periodic -superclass Timer
Class Timer/Adaptive -superclass Timer
Class Timer/Adaptive/ConstBW -superclass Timer/Adaptive
Timer public init {} {
	$self next 
	$self randomize 0
	$self set randwt_ 1.0
}
Timer public destroy {} {
	$self cancel
	$self next
}
Timer public randomize { {yesno 1} {randwt {}} } {
	if { $randwt!={} } {
		$self set randwt_ $randwt
	}
	if {$yesno=="yes"} {set yesno 1} elseif {$yesno=="no"} {set yesno 0}
	$self set randomize_ $yesno
}
Timer private sched { t } {
	$self msched $t
}
Timer public msched { t } {
	$self instvar id_ randomize_ randwt_
	if [info exists id_] {
		puts stderr "warning: $self ([$self info class]):\
				overlapping timers"
	}
	if $randomize_ {
		set r [expr [random]/double(0x7fffffff)-0.5]
		set t [expr $t+$t*$r*$randwt_]
	}
	set t [expr int($t+0.5)]
	set id_ [after $t "$self do_timeout"]
}
Timer private do_timeout {} {
	$self instvar id_
	if ![info exists id_] {
		puts stderr "warning: $self ($class) no timer id_"
	} else {
		unset id_
	}
	$self timeout
}
Timer public is_sched { } {
	$self instvar id_
	return [info exists id_]
}
Timer public cancel {} {
	$self instvar id_
	if [info exists id_] {
		after cancel $id_
		unset id_
	}
}
Timer/Periodic public init { {period 5000} } {
	$self next
	$self set period_ $period
}
Timer/Periodic public start { {period {}} } {
	$self instvar period_
	if { $period!={} } { set period_ $period }
	if [$self is_sched] { $self cancel }
	$self msched $period_
}
Timer/Periodic instproc do_timeout {} {
	$self instvar period_
	$self next
	$self msched $period_
}
Timer/Adaptive public init { {interval 5000} } {
	$self next
	$self set interval_ $interval
}
Timer/Adaptive public start {} {
	$self instvar interval_
	if [$self is_sched] { $self cancel }
	set interval_ [$self adapt $interval_]
	$self msched [expr int($interval_+0.5)]
}
Timer/Adaptive public do_timeout {} {
	$self instvar interval_
	$self next
	set interval_ [$self adapt $interval_]
	$self msched [expr int($interval_+0.5)]
}
Timer/Adaptive private adapt {interval} {
	return $interval
}
Timer/Adaptive/ConstBW public init { bw {thresh {}} {size_gain {}} } {
	$self instvar size_gain_ avgsize_ nsrcs_ bw_ thresh_ interval_
	if { $size_gain!={} } {
		set size_gain_ $size_gain
	} else {
		set size_gain_ 0.125
	}
	set avgsize_ 28
	set nsrcs_ 0
	set bw_ $bw
	if { $thresh!={} } {
		set thresh_ 500
	} else {
		set thresh_ $thresh
	}
	$self next $thresh_
}
Timer/Adaptive/ConstBW public threshold { {thresh {}} } {
    $self instvar thresh_
    if {$thresh=={}} {
	return $thresh_
    } else {
	set thresh_ $thresh
    }
}
Timer/Adaptive/ConstBW public sample_size { size } {
	$self instvar avgsize_ size_gain_
	set avgsize_ [expr $avgsize_ + $size_gain_ * ($size + 28 - $avgsize_)]
}
Timer/Adaptive/ConstBW public update_nsrcs { nsrcs } {
	$self set nsrcs_ $nsrcs
}
Timer/Adaptive/ConstBW public nsrcs { nsrcs } {
	return [$self set nsrcs_]
}
Timer/Adaptive/ConstBW public incr_nsrcs { {incr 1} } {
        $self instvar nsrcs_
        incr nsrcs_ $incr
}
Timer/Adaptive/ConstBW private adapt {interval} {
	$self instvar avgsize_ bw_ nsrcs_ thresh_
	set t [expr 1000 * ($nsrcs_ * $avgsize_ * 8) / $bw_]
	if { $t < $thresh_ } {
		return $thresh_
	} else {
		return $t
	}
}
Class AddressBlock -configuration {
	defaultTTL 1
	maxbw -1
}
Class AddressBlock/RTP -superclass AddressBlock
Class AddressBlock/Simple -superclass AddressBlock
AddressBlock instproc init spec {
	$self next
	$self set nchan_ 0
	foreach s [split $spec ,] {
		set err [$self parse $s]
		if { $err != "" } {
			$self fatal $err
		}
	}
}
AddressBlock instproc data-port p {
	return [expr $p &~ 1]
}
AddressBlock instproc ctrl-port p {
	return [expr [$self data-port $p] + 1]
}
AddressBlock instproc addr {{k 0}} {
	return [$self set addr_($k)]
}
AddressBlock instproc sport {{k 0}} {
	return [$self set sport_($k)]
}
AddressBlock instproc rport {{k 0}} {
	return [$self set rport_($k)]
}
AddressBlock instproc ttl {{k 0}} {
	return [$self set ttl_($k)]
}
AddressBlock instproc nchan {} {
	return [$self set nchan_]
}
AddressBlock instproc parse s {
	set dst [split $s /]
	set n [llength $dst]
	if { $n < 2 } {
		return "must specify both address and port in the form addr/port"
	}
	set addr [lindex $dst 0]
	set ports [split [lindex $dst 1] :]
	set sport [lindex $ports 0]
	if { [llength $ports] == 1 } {
		set rport $sport
	} else {
		set rport [lindex $ports 1]
	}
	set firstchar [string index $addr 0]
	if [string match \[a-zA-Z\] $firstchar] {
		set s [gethostbyname $addr]
		if { $s == "" } {
			return "cannot lookup host name: $addr"
		}
		set addr $s
	}
	foreach port "$sport $rport" {
		if { ![string match \[0-9\]* $port] || $port >= 65536 } {
			$self fatal "illegal port '$port'"
		}
	}
	set ttl [$self get_option defaultTTL]
	set cnt 1
	if { $n >= 3 } {
		set fmt [lindex $dst 2]
		if { $n >= 4 } {
			set ttl [lindex $dst 3]
			if { $n > 4 } {
				set cnt [lindex $dst 4]
				if { ![string match \[0-9\]* $cnt] ||
				     $cnt >= 20 } {
					return "$dst: bad layered addr count"
					exit 1
				}
				if { $n > 5 } {
					return "$dst: malformed address"
				}
			}
		}
	}
	if { $ttl < 0 || $ttl > 255 } {
		return "$dst: invalid ttl ($ttl)"
	}
	set oct [split $addr .]
	set base [lindex $oct 0].[lindex $oct 1].[lindex $oct 2]
	set off [lindex $oct 3]
	$self instvar addr_ sport_ rport_ ttl_ nchan_
	set i 0
	while { $i < $cnt } {
		set sp [$self data-port $sport]
		set rp [$self data-port $rport]
		set addr_($nchan_) $base.$off
		set sport_($nchan_) $sp
		set rport_($nchan_) $rp
		set ttl_($nchan_) $ttl
		if [in_multicast $addr] {
			incr off
		}
		incr sport 2
		incr rport 2
		incr i
		incr nchan_
	}
	if { [info exists fmt] && $fmt != "" && $fmt != "1" } {
		$self add_option videoFormat $fmt
		$self add_option audioFormat $fmt
	}	
	if [info exists confid] {
		$self add_option confid $confid
	}	
	if [info exists ttl] {
		$self add_option defaultTTL $ttl
	}
	$self bandwidth_heuristic
}
AddressBlock instproc bandwidth_heuristic {} {
	$self instvar nchan_ addr_ ttl_ maxbw_
	set i 0
	while { $i < $nchan_ } {
		set maxbw [$self get_option maxbw]
		if { $maxbw <= 0 } {
			set ttl $ttl_($i)
			if { $ttl <= 16 || ![in_multicast $addr_($i)] } {
				set maxbw 3072000
			} elseif { $ttl <= 64 } {
				set maxbw 1024000
			} elseif  { $ttl <= 128 } {
				set maxbw 128000
			} elseif { $ttl <= 192 } {
				set maxbw 53000
			} else {
				set maxbw 32000
			}
		}
		set maxbw_($i) $maxbw
		incr i
	}
}
AddressBlock/Simple instproc data-port p {
	return $p
}
AddressBlock/RTP instproc data-port p {
	return [expr $p &~ 1]
}
set rlm_param(alpha) 4
set rlm_param(alpha) 2
set rlm_param(beta) 0.75
set rlm_param(init-tj) 1.5
set rlm_param(init-tj) 10
set rlm_param(init-tj) 5
set rlm_param(init-td) 5
set rlm_param(init-td-var) 2
set rlm_param(max) 600
set rlm_param(max) 60
set rlm_param(g1) 0.25
set rlm_param(g2) 0.25
Class MMG
MMG instproc init { levels } {
	$self next
	$self instvar debug_ env_ maxlevel_
	set debug_ 0
	set env_ [lindex [split [$self info class] /] 1]
	set maxlevel_ $levels
	global rlm_debug_flag
	if [info exists rlm_debug_flag] {
		set debug_ $rlm_debug_flag
	}
	$self instvar TD TDVAR state_ subscription_
	global rlm_param
	set TD $rlm_param(init-td)
	set TDVAR $rlm_param(init-td-var)
	set state_ /S
	$self instvar layer_ layers_
	set i 1
	while { $i <= $maxlevel_ } {
		set layer_($i) [$self create-layer [expr $i - 1]]
		lappend layers_ $layer_($i)
		incr i
	}
	set subscription_ 0
	$self add-layer
	set state_ /S
	$self set_TJ_timer
}
MMG instproc set-state s {
	$self instvar state_
	set old $state_
	set state_ $s
	$self debug "FSM: $old -> $s"
}
MMG instproc drop-layer {} {
	$self dumpLevel
	$self instvar subscription_ layer_
	set n $subscription_
	if { $n > 0 } {
		$self debug "DRP-LAYER $n"
		$layer_($n) leave-group 
		incr n -1
		set subscription_ $n
	}
	$self dumpLevel
}
MMG instproc add-layer {} {
	$self dumpLevel
	$self instvar maxlevel_ subscription_ layer_
	set n $subscription_
	if { $n < $maxlevel_ } {
		$self debug "ADD-LAYER"
		incr n
		set subscription_ $n
		$layer_($n) join-group
	}
	$self dumpLevel
}
MMG instproc current_layer_getting_packets {} {
	$self instvar subscription_ layer_ TD
	set n $subscription_
	if { $n == 0 } {
		return 0
	}
	set l $layer_($subscription_)
	$self debug "npkts [$l npkts]"
	if [$l getting-pkts] {
		return 1
	}
	set delta [expr [$self now] - [$l last-add]]
	if { $delta > $TD } {
		set TD [expr 1.2 * $delta]
	}
	return 0
}
MMG instproc mmg_loss {} {
	$self instvar layers_
	set loss 0
	foreach l $layers_ {
		incr loss [$l nlost]
	}
	return $loss
}
MMG instproc mmg_pkts {} {
	$self instvar layers_
	set npkts 0
	foreach l $layers_ {
		incr npkts [$l npkts]
	}
	return $npkts
}
MMG instproc check-equilibrium {} {
	global rlm_param
	$self instvar subscription_ maxlevel_ layer_
	set n [expr $subscription_ + 1]
	if { $n >= $maxlevel_ || [$layer_($n) timer] >= $rlm_param(max) } {
		set eq 1
	} else {
		set eq 0
	}
	$self debug "EQ $eq"
}
MMG instproc backoff-one { n alpha } {
	$self debug "BACKOFF $n by $alpha"
	$self instvar layer_
	$layer_($n) backoff $alpha
}
MMG instproc backoff n {
	$self debug "BACKOFF $n"
	global rlm_param
	$self instvar maxlevel_ layer_
	set alpha $rlm_param(alpha)
	set L $layer_($n)
	$L backoff $alpha
	incr n
	while { $n <= $maxlevel_ } {
		$layer_($n) peg-backoff $L
		incr n
	}
	$self check-equilibrium
}
MMG instproc highest_level_pending {} {
	$self instvar maxlevel_
	set m ""
	set n 0
	incr n
	while { $n <= $maxlevel_ } {
		if [$self level_pending $n] {
			set m $n
		}
		incr n
	}
	return $m
}
MMG instproc rlm_update_D  D {
	global rlm_param
	$self instvar TD TDVAR
	set v [expr abs($D - $TD)]
	set TD [expr $TD * (1 - $rlm_param(g1)) \
				+ $rlm_param(g1) * $D]
	set TDVAR [expr $TDVAR * (1 - $rlm_param(g2)) \
		       + $rlm_param(g2) * $v]
}
MMG instproc exceed_loss_thresh {} {
	$self instvar h_npkts h_nlost
	set npkts [expr [$self mmg_pkts] - $h_npkts]
	if { $npkts >= 10 } {
		set nloss [expr [$self mmg_loss] - $h_nlost]
		set loss [expr double($nloss) / ($nloss + $npkts)]
		$self debug "H-THRESH $nloss $npkts $loss"
		if { $loss > 0.25 } {
			return 1
		}
	}
	return 0
}
MMG instproc enter_M {} {
	$self set-state /M
	$self set_TD_timer_wait
	$self instvar h_npkts h_nlost
	set h_npkts [$self mmg_pkts]
	set h_nlost [$self mmg_loss]
}
MMG instproc enter_D {} {
	$self set-state /D
	$self set_TD_timer_conservative
}
MMG instproc enter_H {} {
	$self set_TD_timer_conservative
	$self set-state /H
}
MMG instproc log-loss {} {
	$self debug "LOSS [$self mmg_loss]"
	$self instvar state_ subscription_ pending_ts_
	if { $state_ == "/M" } {
		if [$self exceed_loss_thresh] {
			$self cancel_timer TD
			$self drop-layer
			$self check-equilibrium
			$self enter_D
		}
		return
	}
	if { $state_ == "/S" } {
		$self cancel_timer TD
		set n [$self highest_level_pending]
		if { $n != "" } {
			$self backoff $n
			if { $n == $subscription_ } {
				set ts $pending_ts_($subscription_)
				$self rlm_update_D [expr [$self now] - $ts]
				$self drop-layer
				$self check-equilibrium
				$self enter_D
				return
			}
			if { $n == [expr $subscription_ + 1] } {
				$self cancel_timer TJ
				$self set_TJ_timer
			}
		}
		if [$self our_level_recently_added] {
			$self enter_M
			return
		}
		$self enter_H
		return
	}
	if { $state_ == "/H" || $state_ == "/D" } {
		return
	}
	puts stderr "rlm state machine botched"
	exit -1
}
MMG instproc relax_TJ {} {
	$self instvar subscription_ layer_
	if { $subscription_ > 0 } {
		$layer_($subscription_) relax
		$self check-equilibrium
	}
}
MMG instproc trigger_TD {} {
	$self instvar state_
	if { $state_ == "/H" } {
		$self enter_M
		return
	}
	if { $state_ == "/D" || $state_ == "/M" } {
		$self set-state /S
		$self set_TD_timer_conservative
		return
	}
	if { $state_ == "/S" } {
		$self relax_TJ
		$self set_TD_timer_conservative
		return
	}
	puts stderr "trigger_TD: rlm state machine botched $state)"
	exit -1
}
MMG instproc set_TJ_timer {} {
	global rlm_param
	$self instvar subscription_ layer_
	set n [expr $subscription_ + 1]
	if ![info exists layer_($n)] {
		return
	}
	set I [$layer_($n) timer]
	set d [expr $I / 2.0 + [trunc_exponential $I]]
	$self debug "TJ $d"
	$self set_timer TJ $d
}
MMG instproc set_TD_timer_conservative {} {
	$self instvar TD TDVAR
	set delay [expr $TD + 1.5 * $TDVAR]
	$self set_timer TD $delay
}
MMG instproc set_TD_timer_wait {} {
	$self instvar TD TDVAR
	$self instvar subscription_
	set k [expr $subscription_ / 2. + 1.5]
	$self set_timer TD [expr $TD + $k * $TDVAR]
}
MMG instproc is-recent { ts } {
	$self instvar TD TDVAR
	set ts [expr $ts + ($TD + 2 * $TDVAR)]
	if { $ts > [$self now] } {
		return 1
	}
	return 0
}
MMG instproc level_pending n {
	$self instvar pending_ts_
	if { [info exists pending_ts_($n)] && \
		 [$self is-recent $pending_ts_($n)] } {
		return 1
	}
	return 0
}
MMG instproc level_recently_joined n {
	$self instvar join_ts_
	if { [info exists join_ts_($n)] && \
		 [$self is-recent $join_ts_($n)] } {
		return 1
	}
	return 0
}
MMG instproc pending_inferior_jexps {} {
	set n 0
	$self instvar subscription_
	while { $n <= $subscription_ } { 
		if [$self level_recently_joined $n] {
			return 1
		}
		incr n
	}
	$self debug "NO-PEND-INF"
	return 0
}
MMG instproc trigger_TJ {} {
	$self debug "trigger-TJ"
	$self instvar state_ ctrl_ subscription_
	if { ($state_ == "/S" && ![$self pending_inferior_jexps] && \
		  [$self current_layer_getting_packets])  } {
		$self add-layer
		$self check-equilibrium
		set msg "add $subscription_"
		$ctrl_ send $msg
		$self local-join
	}
	$self set_TJ_timer
}
MMG instproc our_level_recently_added {} {
	$self instvar subscription_ layer_
	return [$self is-recent [$layer_($subscription_) last-add]]
}
MMG instproc recv-ctrl msg {
	$self instvar join_ts_ pending_ts_ subscription_
	$self debug "X-JOIN $msg"
	set what [lindex $msg 0]
	if { $what != "add" } {
		return
	}
	set level [lindex $msg 1]
	set join_ts_($level) [$self now]
	if { $level > $subscription_ } {
		set pending_ts_($level) [$self now]
	}
}
MMG instproc local-join {} {
	$self instvar subscription_ pending_ts_ join_ts_
	set join_ts_($subscription_) [$self now]
	set pending_ts_($subscription_) [$self now]
}
MMG instproc debug { msg } {
	$self instvar debug_ subscription_ state_
	if {$debug_} {
		puts stderr "[gettimeofday] layer $subscription_ $state_ $msg"
	}
}
MMG instproc dumpLevel {} {
}
Class Layer
Layer instproc init { mmg } {
	$self next
	$self instvar mmg_ TJ npkts_
	global rlm_param
	set mmg_ $mmg
	set TJ $rlm_param(init-tj)
	set npkts_ 0
}
Layer instproc relax {} {
	global rlm_param
	$self instvar TJ
	set TJ [expr $TJ * $rlm_param(beta)]
	if { $TJ <= $rlm_param(init-tj) } {
		set TJ $rlm_param(init-tj)
	}
}
Layer instproc backoff alpha {
	global rlm_param
	$self instvar TJ
	set TJ [expr $TJ * $alpha]
	if { $TJ >= $rlm_param(max) } {
		set TJ $rlm_param(max)
	}
}
Layer instproc peg-backoff L {
	$self instvar TJ
	set t [$L set TJ]    
	if { $t >= $TJ } {
		set TJ $t
	}
}
Layer instproc timer {} {
	$self instvar TJ
	return $TJ
}
Layer instproc last-add {} {
	$self instvar add_time_
	return $add_time_
}
Layer instproc join-group {} {
	$self instvar npkts_ add_time_ mmg_
	set npkts_ [$self npkts]
	set add_time_ [$mmg_ now]
}
Layer instproc leave-group {} {
}
Layer instproc getting-pkts {} {
	$self instvar npkts_
	return [expr [$self npkts] != $npkts_]
}
set rlm_debug_flag 1
Class Layer/mash -superclass Layer
Layer/mash instproc init {mmg net n} {
	$self next $mmg
	$self instvar net_ l_ n_
	set net_ $net
	set n_ $n
	set l_ [$net_ set net_($n)]
}
Layer/mash instproc join-group {} {
	$self instvar mmg_ net_
	set level [expr [$mmg_ set subscription_] - 1]
	$net_ set-subscription-level $level
	$self next
}
Layer/mash instproc leave-group {} {
	$self instvar mmg_ net_
	set level [expr [$mmg_ set subscription_] - 1]
	$net_ set-subscription-level $level
	$self next
}
Layer/mash instproc nlost {} {
	$self instvar l_
	return [$l_ nlost]
}
Layer/mash instproc npkts {} {
	$self instvar l_ n_
	return [$l_ npkts $n_]
}
Class MMG/mash -superclass MMG
MMG/mash instproc init {net caddr} {
	$self instvar net_
	set net_ $net
	$self next [$net set nchan_]
	proc ctrl$self {args} { puts "ctrl: $args" }
	$self set ctrl_ ctrl$self
}
MMG/mash instproc create-layer {layerNo} {
	$self instvar net_
	return [new Layer/mash $self $net_ $layerNo]
}
MMG/mash instproc now {} {
	return [gettimeofday]
}
MMG/mash instproc set_timer {which delay} {
	$self instvar timers_
	if [info exists timers_($which)] {
		puts "timer botched ($which)"
		exit 1
	}
	set delay [expr int($delay * 1000)]
	set timers_($which) [after $delay "$self trigger_timer $which"]
}
MMG/mash instproc trigger_timer {which} {
	$self instvar timers_
	unset timers_($which)
	$self trigger_$which
}
MMG/mash instproc cancel_timer {which} {
	$self instvar ns_ timers_
	if [info exists timers_($which)] {
		after cancel $timers_($which)
		unset timers_($which)
	}
}
MMG/mash instproc debug { msg } {
	$self instvar debug_
	if {!$debug_} { return }
	$self instvar subscription_ state_
	set time [format %.05f [$self now]]
	puts stderr "$time layer $subscription_ $state_ $msg"
}
proc uniform01 {} {
    return [expr double(([random] % 10000000) + 1) / 1e7]
}
proc uniform { a b } {
	return [expr ($b - $a) * [uniform01] + $a]
}
proc exponential mean {
	return [expr - $mean * log([uniform01])]
}
proc trunc_exponential lambda {
	while 1 {
		set u [exponential $lambda]
		if { $u < [expr 4 * $lambda] } {
			return $u
		}
	}
}
Class Network/IP -superclass Network
Network/IP instproc init args {
	puts stderr "Network/IP called... change to Network"
	eval $self next $args
}
Network instproc port args {
	eval $self sport $args
}
proc in_multicast addr {
	return [expr ([lindex [split $addr .] 0] & 0xf0) == 0xe0]
}
Class NetworkLayer
Class NetworkManager
NetworkManager instproc graphics-init n {
	if {$n == 1 || [winfo exists .l]} { return }
	$self instvar nchan_
	set nchan_ $n
	toplevel .l
	set k 0
	while { $k < $nchan_ } {
		radiobutton .l.b$k -command "$self set-subscription-level $k" \
			-text "Level $k" \
			-variable nLayers -value $k
		pack .l.b$k
		incr k
	}
	wm withdraw .l
	bind . <l> { 
		if [winfo ismapped .l] {
			wm withdraw .l
		} else {
			wm deiconify .l
		}
	}
}
NetworkManager instproc set-subscription-level n {
	$self instvar agent_ nchan_ session_ net_
	$agent_ set_maxchannel $n
	$session_ set loopbackLayer_ [expr $n + 1]
	set i 0
	while { $i <= $n } {
		$net_($i) enable
		incr i
	}
	while { $i < $nchan_ } {
		$net_($i) disable
		incr i
	}
	global nLayers
	set nLayers $n
}
NetworkLayer instproc init { session addr sport rport ttl channel } {
	$self next
	$self instvar session_ addr_ port_ ttl_ dn_ cn_ channel_ active_
	set addr_ $addr
	set sport_ $sport
	set rport_ $rport
	set session_ $session
	set ttl_ $ttl
	set channel_ $channel
	set dn_ [new Network]
	$dn_ open $addr_ $sport_ $rport_ $ttl_
	set cn_ [new Network]
	$cn_ open $addr_ [expr $sport_ + 1] [expr $rport + 1] $ttl_
	$cn_ loopback 1
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
	set active_ 0
	$dn_ drop-membership
	$cn_ drop-membership
	$self set tloss_ 0
}
NetworkLayer instproc destroy {} {
	$self instvar dn_ cn_
	delete $dn_
	delete $cn_
	$self next
}
NetworkLayer instproc data-net {} {
	return [$self set dn_]
}
NetworkLayer instproc ctrl-net {} {
	return [$self set cn_]
}
NetworkLayer instproc enable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
}
NetworkLayer instproc disable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net "" $channel_
	$session_ ctrl-net "" $channel_
}
NetworkLayer instproc enable {} {
	$self instvar active_ dn_ cn_ session_ channel_
	if !$active_ {
		set active_ 1
		$dn_ add-membership
		$cn_ add-membership
		$session_ data-net $dn_ $channel_
		$session_ ctrl-net $cn_ $channel_
	}
}
NetworkLayer instproc disable {} {
	$self instvar dn_ cn_ active_ session_ channel_
	if $active_ {
		set active_ 0
		$dn_ drop-membership
		$cn_ drop-membership
	}
}
NetworkLayer instproc notify-loss {src} {
	$self instvar loss_ tloss_
	if ![info exists loss_($src)] {
		set loss_($src) 0
	}
	set nloss [$src missing]
	incr tloss_ [expr $nloss - $loss_($src)]
	set loss_($src) $nloss
}
NetworkLayer instproc nlost {} {
	$self instvar tloss_
	return $tloss_
}
NetworkLayer instproc npkts {n} {
	$self instvar agent_
	set npkts 0
	foreach s [$agent_ set sources_] {
		set l [lindex [$s set layers_] $n]
		incr npkts [$l set np_]
	}
	return $npkts
}
NetworkLayer instproc crypt { dc cc } {
	$self instvar dn_ cn_
	$dn_ crypt $dc
	$cn_ crypt $cc
}
NetworkManager instproc init { ab session agent } {
	$self next
	$self instvar session_ agent_ encrypt_ key_ fmt_
	set session_ $session
	set agent_ $agent
	set encrypt_ 0
	set key_ ""
        set fmt_ ""
	$self allocate $ab $session
}
NetworkManager instproc allocate { ab session } {
	$self instvar nchan_ net_ mmg_
	if [info exists nchan_] {
		set oldnchan $nchan_
	} else {
		set oldnchan 0
	}
	set nchan_ 0
	while { $nchan_ < [$ab nchan] } {
		set addr [$ab addr $nchan_]
		set sport [$ab sport $nchan_]
		set rport [$ab rport $nchan_]
		set ttl [$ab ttl $nchan_]
		if [info exists net_($nchan_)] {
			delete $net_($nchan_)
		}
		set net_($nchan_) [new NetworkLayer $session $addr \
					$sport $rport $ttl $nchan_]
		$self instvar agent_
		$net_($nchan_) set agent_ $agent_
		incr nchan_
	}
	set n $nchan_
	while {$n < $oldnchan} {
		if [info exists net_($n)] {
			delete $net_($n)
		}
		incr n
	}
	if [info exists mmg_] {
		delete $mmg_
	}
	$self set-subscription-level 0
	if {$nchan_ == 1} { return }
	if [$self yesno useLayersWindow] {
		$self graphics-init $nchan_
	}
	if [$self get_option useRLM] {
		set caddr ""
		set mmg_ [new MMG/mash $self $caddr]
	}
}
NetworkManager instproc nchan {} {
	return [$self set nchan_]
}
NetworkManager instproc reset ab {
	$self instvar session_
	$self allocate $ab $session_
}
NetworkManager instproc data-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) data-net]
}
NetworkManager instproc ctrl-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) ctrl-net]
}
NetworkManager public loopback enable {
	$self instvar nchan_ net_
	set i 0
	while { $i < $nchan_ } {
		set net $net_($i)
		set dn [$net data-net]
		set cn [$net ctrl-net]
		$dn loopback $enable
		$cn loopback $enable
		incr i
	}
}
NetworkManager instproc install-key key {
	return [$self set_key $key]
}
NetworkManager instproc crypt_all { dc cc } {
	$self instvar net_
	foreach n [array names net_] {
		$net_($n) crypt $dc $cc
	}
}
NetworkManager instproc destroy {} {
	$self instvar dc_ cc_ net_
	if [info exists dc_] {
		delete $dc_
	}
	if [info exists cc_] {
		delete $cc_
	}
	foreach dn [array names net_] {
		delete $net_($dn)
	}
	$self next
}
NetworkManager instproc usingRLM {} {
	$self instvar mmg_
	return [info exists mmg_]
}
NetworkManager instproc notify-loss {src layer} {
	$self instvar net_
	$net_($layer) notify-loss $src
}
NetworkManager instproc crypt_format { key } {
	set k [string first / $key]
	if { $k < 0 } {
		set fmt DES
	} else {
		set fmt [string range $key 0 [expr $k - 1]]
		set key [string range $key [expr $k + 1] end]
	}
	return "$fmt $key"
}
NetworkManager instproc set_key key {
	if { $key == "" } {
		$self crypt_clear
		return ""
	}
	$self instvar encrypt_ 
	set L [$self crypt_format $key]
	set fmt [lindex $L 0]
	set key [lindex $L 1]
	$self instvar key_
	set key_ $key
	$self instvar dc_ cc_ fmt_
	if { $fmt_ != $fmt } {
		if [info exists dc_] {
			delete $dc_
			unset dc_
		}
		if [info exists cc_] {
			delete $cc_
			unset cc_
		}
		set fmt_ $fmt
	}
	if ![info exists dc_] {
		set clist [Crypt/Data info subclass]
		if { [lsearch -exact $clist Crypt/Data/$fmt] < 0 } {
			return "no $fmt encryption support"
		}
		set dc_ [new Crypt/Data/$fmt]
		set cc_ [new Crypt/Control/$fmt]
	}
	if [$dc_ key $key] {
		$cc_ key $key
		$self crypt_all $dc_ $cc_
		set encrypt_ 1
		return ""
	} else {
		$self crypt_clear
		return "your key is cryptographically weak"
	}
}
NetworkManager instproc crypt_clear {} {
	$self instvar encrypt_ key_
	$self crypt_all "" ""
	set key_ ""
	set encrypt_ 0
}
AnnounceListenManager public init { spec {mtu 1500} } {
	$self next $mtu
	$self instvar data_ snet_ rnet_
	set data_ ""
	set snet_ ""
	set rnet_ ""
	if [regexp {^[0-9]*$} $spec] {
		set rnet_ [new Network]
		$rnet_ open $spec
	} else {
		set ab [new AddressBlock/Simple $spec]
		set addr  [$ab addr]
		set sport [$ab sport]
		set rport [$ab rport]
		set ttl   [$ab ttl]
		delete $ab
		set snet_ [new Network]
		if [in_multicast $addr] {
			$snet_ open $addr $sport $rport $ttl
			set rnet_ $snet_
		} else {
			if { $rport != 0 } {
				set rnet_ [new Network]
				$rnet_ open $rport
			}
			$snet_ open $addr $sport 0 1
		}
	}
	if { $snet_ != "" } {
		$snet_ loopback 1
		$self send_network $snet_
	} 
	if { $rnet_ != "" } {
		$self recv_network $rnet_
	}
}
AnnounceListenManager public destroy {} {
	$self instvar snet_ rnet_ timers_
	if { $rnet_==$snet_ } {
		delete $snet_
	} else {
		if { $snet_ != "" } {
			delete $snet_
		} 
		if { $rnet_ != "" } {
			delete $rnet_
		}
	}
	if [info exists timers_] {
		foreach t [array names timers_] {
			delete $timers_($t)
		}
	}
	$self next
}
AnnounceListenManager public timer {args} {
	$self instvar timers_
	if {[llength $args]==1} {
		set d __default_timer__
		set t [lindex $args 0]
		if {$t!={}} { $t proc timeout { } "$self send_announcement" }
	} else {
		set d [lindex $args 0]
		set t [lindex $args 1]
		if {$t!={}} { $t proc timeout { } \
				[list $self send_announcement $d] }
	}
	if [info exists timers_($d)] {
		set sched [$timers_($d) is_sched]
		delete $timers_($d)
	} else {
		set sched 0
	}
	if {$t!={}} {
		set timers_($d) $t
		if $sched {
			$t start
		}
	} else {
		catch {unset timers_($d)}
	}
	return $t
}
AnnounceListenManager public get_timer {args} {
	$self instvar timers_
	if {[llength $args]==0} {
		set d __default_timer__
	} else {
		set d [lindex $args 0]
	}
	if [info exists timers_($d)] { return $timers_($d) } else { return "" }
}
AnnounceListenManager public start {args} {
	if { [llength $args]==0 } {
		set t [$self get_timer]
	} else {
		set d [lindex $args 0]
		set t [$self get_timer $d]
	}
	if { $t=={} } {
		set t [new Timer/Periodic]
		$t randomize 1
		if [info exists d] { $self timer $d $t } else { $self timer $t}
	}
	if [info exists d] {$self send_announcement $d} \
			else {$self send_announcement}
	$t start
}
AnnounceListenManager public stop {args} {
	$self instvar timers_
	if {[llength $args]==0} {
		foreach d [array names timers_] {
			$timers_($d) cancel
		}
	} else {
		set d [lindex $args 0]
		$timers_($d) cancel
	}
}
AnnounceListenManager public recv_announcement { addr port data len } {
	puts "ALM::recv_announcement $addr/$port \[$len\]: $data"
}
AnnounceListenManager public send_announcement {args} {
	$self instvar data_
	if [llength $args==0] {
		if { $data_!={} } { $self announce $data_ }
	} else {
		$self announce [lindex $args 0]
	}
}
AnnounceListenManager public set_announcement { data } {
	$self set data_ $data
}
AnnounceListenManager public get_announcement { } {
	return [$self set data_]
}
Class AnnounceListenManager/AS -superclass AnnounceListenManager
AnnounceListenManager/AS instproc init { netspec bw atype } {
	random 0
	$self next $netspec 1024
	$self instvar atype_
	set atype_ $atype
	$self instvar agentbytype_
	set agentbytype_(srv) ""
	set agentbytype_(client) ""
	set agentbytype_(hm) ""
	set t [new Timer/Adaptive/ConstBW $bw 3000]
	$t randomize
        $self timer $t
	set o [$self options]
	$o add_default startupWait 60
	$self instvar aliveid_
	set aliveid_ [after [expr [$self get_option startupWait]*1000] "$self check_alive 1"]
}
AnnounceListenManager/AS proc version {} {
	return 2.0
}
AnnounceListenManager/AS public send_announcement {} {
	$self instvar atype_
	set o "ASCP v[$class version]"
	set n $atype_
	set o $o\n$n
	set n [$self agent_instance]
	set o $o\n$n
	set n [$self service_name]
	set o $o\n$n
	set n [$self service_location]
	set o $o\n$n
	set n [$self service_instance]
	set o $o\n$n
	set n [$self ssg_port]
	set o $o\n$n
	set n [$self agent_data]
	set o $o\n$n
	$self announce $o
	$self check_alive 0
}
AnnounceListenManager/AS instproc announce_death {} {
	$self instvar id1_ id2_ atype_
	set o "ASCP v[AnnounceListenManager/AS version]"
	set n $atype_
	set o $o\n$n
	set n [$self agent_instance]
	set o $o\n$n
	set n bye
	set o $o\n$n
	set n -
	set o $o\n$n
	set n -
	set o $o\n$n
	set n -
	set o $o\n$n
	$self announce $o
}
AnnounceListenManager/AS public agent_instance {} {
	return "[pid]@[lookup_host_name [localaddr]]"
}
AnnounceListenManager/AS public agent_data {} {
	return ""
}
AnnounceListenManager/AS public ssg_port {} {
	return "-"
}
AnnounceListenManager/AS instproc service_location {} {
	return "-"
}
AnnounceListenManager/AS instproc destroy {} {
	$self instvar aliveid_
	after cancel $aliveid_
	$self next
}
AnnounceListenManager/AS instproc recv_announcement { addr port data size } {
	$self instvar lastann_ sdp_ agentbytype_ agenttab_ atype_
        set t [$self get_timer]
	$t sample_size $size
	set o [split $data \n]
	if { [lindex $o 0] != "ASCP v[$class version]" } {
		set msg "$self ($class): received non-ASCP v[$class version] announcement from $addr."
		if { $atype_ == "hm" } {
			$self instvar agent_
			$agent_ log $msg
		} else {
			puts stderr $msg
		}
 		return
	}
	set atype [lindex $o 1]
	set aspec [lindex $o 2]
	set srv_name [lindex $o 3]
	set srv_loc [lindex $o 4]
	set srv_inst [lindex $o 5]
	set ssg_port [lindex $o 6]
	set ad [join [lrange $o 7 end] \n]
	if { $srv_name == "DEATH" } {
		set msg "Received death packet from $aspec at $addr - exiting."
		if { $srv_loc == $atype_ } {
			if { $atype_ == "hm" } {
				$self instvar agent_
				$agent_ log $msg
			} else {
				puts stderr $msg
			}
			$self announce_death
			exit 0
		}
		$self recv_msg $atype $aspec $addr DEATH $srv_loc \
			$srv_inst $ssg_port "$ad"
		return
	}
	if { $srv_name == "bye" } {
		$self delete_agent $aspec
		return
	}
	if ![info exists agenttab_($aspec)] {
		$self instvar avgdelta_
		$self register $atype $aspec $addr $srv_name $srv_inst "$ad"
	        $t incr_nsrcs
		set timeout [$self get_option startupWait]
		set avgdelta_($aspec) [expr $timeout / 8]
		lappend agentbytype_($atype) $aspec
	} else {
		set now [gettimeofday]
		set delta [expr $now - $lastann_($aspec,abs)]
		$self instvar avgdelta_
		set avgdelta_($aspec) \
				[expr 0.875*$avgdelta_($aspec)+0.125*$delta]
	}
	set agenttab_($aspec) "$addr {$ad} $atype $srv_name $srv_inst"
	set lastann_($aspec,abs) [gettimeofday]
	set lastann_($aspec,ascii) [gettimeofday ascii]
	$self recv_msg $atype $aspec $addr $srv_name $srv_loc $srv_inst \
			$ssg_port "$ad"
}
AnnounceListenManager/AS instproc advance_timers { delta } {
	$self instvar lastann_ agenttab_ avgdelta_
	set aspecs [array names agenttab_]
	foreach aspec $aspecs {
		set lastann_($aspec,abs) [expr $lastann_($aspec,abs)+$delta]
	}
}
AnnounceListenManager/AS instproc check_alive { timer } {
	$self instvar lastann_ agenttab_ avgdelta_
	set now [gettimeofday]
	set aspecs [array names agenttab_]
	foreach aspec $aspecs {
		set lastann $lastann_($aspec,abs)
		set avgdelta $avgdelta_($aspec)
		set delta [expr $now - $lastann]
		if { $delta > 8 * $avgdelta } {
			$self delete_agent $aspec
		}
	}
	$self instvar aliveid_
	if { $timer } {
		set t [expr [$self get_option startupWait]*1000]
		set aliveid_ [after $t "$self check_alive 1"]
	}
}
AnnounceListenManager/AS instproc delete_agent { aspec } {
 	$self instvar agentbytype_ agenttab_ lastann_ avgdelta_
	if ![info exists agenttab_($aspec)] {
		return 
	}
	set a $agenttab_($aspec)
	set addr [lindex $a 0]
	set ad [lindex $a 1]
	set atype [lindex $a 2]
	set srv_name [lindex $a 3]
	set srv_inst [lindex $a 4]
	unset agenttab_($aspec)
	unset lastann_($aspec,abs)
	unset lastann_($aspec,ascii)
	unset avgdelta_($aspec)
	set t $agentbytype_($atype)
	set i [lsearch -exact $t $aspec]
	set agentbytype_($atype) [lreplace $t $i $i]
	[$self get_timer] incr_nsrcs -1
	$self unregister $atype $aspec $addr $srv_name $srv_inst "$ad"
}
AnnounceListenManager/AS instproc agenttab aspec {
	$self instvar agenttab_
	if [info exists agenttab_($aspec)] {
		return $agenttab_($aspec)
	}
	return ""
}
Class AnnounceListenManager/AS/HM -superclass AnnounceListenManager/AS
AnnounceListenManager/AS/HM instproc init { agent spec bw } {
	$self next $spec $bw hm
	$self set agent_ $agent
	[$self get_timer] threshold 10000
}
AnnounceListenManager/AS/HM instproc recv_msg { atype aspec addr srv_name srv_loc srv_inst ssg_port msg } {
	$self instvar agent_
	switch $atype {
	srv {
	}
	hm {
		$self handle_hm_msg $aspec $msg $addr $srv_name $srv_inst
	}
	client {
		set load [HMAgent get_load]
		set hiload [$self get_option highLoad]
		if { [$self get_option noLoad] == "" &&  $load >= $hiload } {
			$agent_ log "HI LOAD load=$load $hiload"
		} else {
			after 2000 $self "handle_client_msg $srv_name \
				$srv_loc $srv_inst {$msg} [gettimeofday]"
		}
	}
	}
}
AnnounceListenManager/AS/HM instproc duphm { name } {
	if { [string compare $name [$self agent_instance]] < 0 } {
		$self instvar agent_
		$agent_ log "duplicate hm: $name [$self agent_instance] - exiting."
		$agent_ doexit
	}
}
AnnounceListenManager/AS/HM instproc handle_hm_msg { aspec msg addr srv_name srv_inst } {
	$self instvar agent_
	switch $srv_name {
	update {
		if { $addr == [localaddr] } {
			$self duphm $aspec
		}
	}
	launch {
		$agent_ suppress_timer $srv_inst
	}
	}
}
AnnounceListenManager/AS/HM instproc handle_client_msg { srv_name srv_loc srv_inst msg ts } {
	$self instvar agent_
	if [$agent_ pending_timer $srv_inst] {
		return
	}
	$self instvar agentbytype_ agenttab_ lastann_
	set srvlist $agentbytype_(srv)
	foreach srvspec $srvlist {
		set srv $agenttab_($srvspec)
		set inst [lindex $srv 4]
		if { $inst == $srv_inst } {
	     		set lastann $lastann_($srvspec,abs)
	     		if { $lastann < $ts - 1 } {
				$self delete_agent $srvspec
				break
			}
			return
		}
	}
	$agent_ sched_launch $srv_name $srv_loc $srv_inst $msg
}
AnnounceListenManager/AS/HM instproc register { atype aspec addr srv_name srv_inst msg } {
	$self instvar agent_
	if { $addr != [localaddr] || $atype != "srv" } {
		return
	}
	$agent_ cancel_timer $srv_inst
}
AnnounceListenManager/AS/HM instproc unregister { atype aspec addr srv_name srv_inst ad } {
	$self instvar agent_
	if { $addr != [localaddr] || $atype != "srv" } {
		return
	}
	$agent_ unregister $aspec $ad
}
AnnounceListenManager/AS/HM instproc announce_launch { srv_inst } {
	set o "ASCP v[AnnounceListenManager/AS version]"
	set n hm
	set o $o\n$n
	set n [$self agent_instance]
	set o $o\n$n
	set n launch
	set o $o\n$n
	set n -
	set o $o\n$n
	set n $srv_inst
	set o $o\n$n
	set n -
	set o $o\n$n
	$self announce $o
}
AnnounceListenManager/AS/HM instproc send_announcement {} {
	$self instvar id1_ id2_
	set o "ASCP v[AnnounceListenManager/AS version]"
	set n hm
	set o $o\n$n
	set n [$self agent_instance]
	set o $o\n$n
	set n update
	set o $o\n$n
	set n -
	set o $o\n$n
	set n -
	set o $o\n$n
	set n -
	set o $o\n$n
	$self announce $o
}
AnnounceListenManager/AS/HM instproc hmnum {} {
	return [llength [$self hmaddrs]]
}
AnnounceListenManager/AS/HM instproc hmaddrs {} {
	$self instvar agenttab_
	set aspecs [array names agenttab_]
	foreach aspec $aspecs {
		set addr [lindex $agenttab_($aspec) 0]
		set d($addr) 1
	}
	return [array names d]
}
Class RTP
Class RTP/Video -superclass RTP
Class RTP/Audio -superclass RTP
RTP private init {} {
	eval $self next
	$self instvar rtp_ptoa_
	set rtp_ptoa_(-1) ""
}
RTP/Audio set default_ptoa_(0) pcm
RTP/Audio set default_ptoa_(1) celp
RTP/Audio set default_ptoa_(2) g721
RTP/Audio set default_ptoa_(3) gsm
RTP/Audio set default_ptoa_(5) dvi
RTP/Audio set default_ptoa_(6) dvi
RTP/Audio set default_ptoa_(7) lpc
RTP/Audio set default_ptoa_(8) pcma
RTP/Audio set default_ptoa_(9) g722
RTP/Audio set default_ptoa_(10) lin16
RTP/Audio set default_ptoa_(11) lin16
RTP/Audio set default_ptoa_(14) mpa
RTP/Audio set default_ptoa_(15) g728
RTP/Video set default_ptoa_(20) ldct
RTP/Video set default_ptoa_(21) pvh
RTP/Video set default_ptoa_(22) bvc
RTP/Video set default_ptoa_(25) cellb
RTP/Video set default_ptoa_(26) jpeg
RTP/Video set default_ptoa_(27) cuseeme
RTP/Video set default_ptoa_(28) nv
RTP/Video set default_ptoa_(29) picw
RTP/Video set default_ptoa_(30) cpv
RTP/Video set default_ptoa_(31) h261
RTP/Video set default_ptoa_(32) mpeg
RTP/Video set default_ptoa_(33) mpegs
RTP/Video set default_ptoa_(127) h261v1
RTP/Video set default_ptoa_(50) sc
RTP/Audio public init args {
	$self next
	$class instvar default_ptoa_
	$self instvar rtp_ptoa_ rtp_atop_
	foreach p [array names default_ptoa_] {
		$self add_mapping $p $default_ptoa_($p)
	}
	foreach mapping [$self get_option rtpMap] {
		set l [split $mapping :]
		set pt [lindex $l 0]
		set fmt [lindex $l 1]
		$self add_mapping $pt $fmt
	}
}
RTP/Video public init args {
	$self next
	$class instvar default_ptoa_
	$self instvar rtp_ptoa_ rtp_atop_
        set rtp_ptoa_(-1) ""
	foreach p [array names default_ptoa_] {
		set rtp_ptoa_($p) $default_ptoa_($p)
		set rtp_atop_($default_ptoa_($p)) $p
	}
	foreach mapping [$self get_option rtpMap] {
		set l [split $mapping :]
		set pt [lindex $l 0]
		set fmt [lindex $l 1]
		$self add_mapping $pt $fmt
	}
	$self instvar classmap_
	set classmap_(pvh) PVH
	set classmap_(ldct) LDCT
	set classmap_(h261) H261
	set classmap_(h261v1) H261v1
	set classmap_(nv) NV
	set classmap_(cellb) CellB
	set classmap_(jpeg) JPEG
	set classmap_(sc) SC
}
RTP/Video public classmap type {
	$self instvar classmap_
	if [info exists classmap_($type)] {
		return $classmap_($type)
	}
	return "Null"
}
RTP public add_mapping {pt fmt} {
	$self instvar rtp_ptoa_ rtp_atop_
	set rtp_ptoa_($pt) $fmt
	set rtp_atop_($fmt) $pt
}
RTP public rtp_type pt {
	$self instvar rtp_ptoa_
	if [info exists rtp_ptoa_($pt)] {
		return $rtp_ptoa_($pt)
	} elseif { $pt < 0 }  {
		return ""
	} else {
		return fmt-$pt
	}
}
RTP public rtp_fmt_number fmt {
	$self instvar rtp_atop_
	if [info exists rtp_atop_($fmt)] {
		return $rtp_atop_($fmt)
	} else {
		return -1
	}
}
RTP public rtp_format src {
	$self instvar rtp_ptoa_
	return [$self rtp_type [$src format]]
}
RTP instproc cname_redundant { name cname } {
	set ni [string first @ $name]
	if { $ni < 0 } {
		return 0
	}
	set ci [string first @ $cname]
	if { $ci < 0 } {
		return 0
	}
	if { [string compare \
		[string range $name 0 $ni] \
		[string range $cname 0 $ci]] == 0 } {
		return 1
	}
	return 0
}
RTP public rtp_representation src {
	set fmt [$self rtp_format $src]
	set name [$src sdes name]
	set cname [$src sdes cname]
	set addr [$src addr]
	if { $name == "" } {
		if { $cname == "" } {
			set srcname $addr
			set srcinfo $addr/$fmt
		} else {
			set srcname $cname
			set srcinfo $addr/$fmt
		}
	} elseif [$self cname_redundant $name $cname] {
		set srcname $name
		set srcinfo $addr/$fmt
	} else {
		set srcname $name
		set srcinfo $cname/$fmt
	}
	return "{$srcname} {$srcinfo}"
}
Class SDPParser
Class SDPMedia
Class SDPTime
Class SDPMessage 
SDPParser instproc init { {ordered_syntax 1} } {
	$self next
	$self instvar nextsym_ ordered_syntax_ parse_error_
	set nextsym_(start) "v"
	set nextsym_(v) "o"
	set nextsym_(o) "s"
	set nextsym_(s) "i u e p c b t"
	set nextsym_(i) "u e p c b t"
	set nextsym_(u) "e p c b t"
	set nextsym_(e) "e p c b t"
	set nextsym_(p) "e p c b t"
	set nextsym_(c) "b t "
	set nextsym_(b) "t"
	set nextsym_(t) "t r z k a m"
	set nextsym_(r) "t z k a m"
	set nextsym_(z) "k a m"
	set nextsym_(k) "a m"
	set nextsym_(a) "a m"
	set nextsym_(m) "m i:m c:m b:m k:m a:m v"
	set nextsym_(i:m) "m c:m b:m k:m a:m v"
	set nextsym_(c:m) "m b:m k:m a:m v"
	set nextsym_(b:m) "m k:m a:m v"
	set nextsym_(k:m) "m a:m v"
	set nextsym_(a:m) "m a:m v"
	set ordered_syntax_ $ordered_syntax
	set parse_error_ ""
}
SDPParser instproc check_syntax { last cur media } {
	$self instvar nextsym_
	if ![info exists nextsym_($last)] {
		return ""
	}
	foreach s $nextsym_($last) {
		set t [split $s :]
		if { [lindex $t 0] == $cur } {
			return $s
		}
	}
	return ""
}
SDPParser instproc parse { announcement } {
	$self instvar parse_error_ ordered_syntax_
	set media ""
	set allmsgs ""
	set lasttag "start"
	set lines [split $announcement "\n"]
	set parse_error_ ""
	set lnum 0
	foreach line $lines {
		incr lnum
		if { $line=={} } continue
		set sline [split $line =]
		set tag [lindex $sline 0]
		set value [join [lrange $sline 1 end]]
		set ret [$self check_syntax $lasttag $tag $media]
		if { $ret == "" && $ordered_syntax_==1 } {
			set parse_error_ "$class: syntax error between\
					$lasttag and $tag in line $lnum."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		set lasttag $ret
		switch $tag {
		v { 
			set media ""
			set msg [new SDPMessage]
			lappend allmsgs $msg
			$msg set version_ $value
		}
		o {
			$msg set creator_ [lindex $value 0]
			$msg set createtime_ [lindex $value 1]
			$msg set modtime_  [lindex $value 2]
			$msg set nettype_ [lindex $value 3]	
			$msg set addrtype_ [lindex $value 3]
			$msg set createaddr_ [lindex $value 5]
		}
		s {	
			$msg set session_name_ $value 
		}
		i {	
			if { $media != "" } {
				$media set session_info_ $value 
			} else {
				$msg set session_info_ $value 
			}
		}
		p {
			set tmp "" 
			catch { set tmp [$msg set phonelist_] }
			lappend tmp $value
			$msg set phonelist_ $tmp
		}
		e { 
			set tmp "" 
			catch { set tmp [$msg set emaillist_] }
			lappend tmp $value
			$msg set emaillist_ $tmp
		}
		u { 
			$msg set uri_ $value
		} 
		c {
			if { $media != "" } {
				$media set nettype_ [lindex $value 0]
				$media set addrtype_ [lindex $value 1]
				$media set caddr_ [lindex $value 2]
			} else {
				$msg set nettype_ [lindex $value 0]
				$msg set addrtype_ [lindex $value 1]
				$msg set caddr_ [lindex $value 2]
			}
		}
		b {
			set bwspec [split $value :]
			if { $media != "" } {
				$media set bwmod_ [lindex $bwspec 0]
				$media set bwval_ [lindex $bwspec 1]
			} else {
				$msg set bwmod_ [lindex $bwspec 0]
				$msg set bwval_ [lindex $bwspec 1]
			}
		}
		t {
			set tdes [new SDPTime]
			$tdes set fields_(t) $value
			$tdes set starttime_ [lindex $value 0]
			$tdes set endtime_ [lindex $value 1]
			set tmp [$msg set alltimedes_]
			lappend tmp $tdes
			$msg set alltimedes_ $tmp
		}
		r {
			$tdes set fields_(r) $value
			$tdes set repeat_interval_ [lindex $value 0]
			$tdes set active_duration_ [lindex $value 1]
			$tdes set offlist_ [lrange $value 2 end]
		}
		z {
			set nval [llength $value]
			if [expr 2 * ($nval / 2) != $nval] {
				foreach m $allmsgs {
					delete $m
				}
				return ""
			}
			$self instvar zoneinfo_
			for { set n 0 } { $n < $nval } { incr n } {
				set adjtime [lindex $value $n]
				incr n
				set offset [lindex $value $n]
				lappend zoneinfo_ "$adjtime $offset"
			}
		}
		k {
			set tmp [split $value :]
			if { $media != "" } {
				$media set crypt_method_ [lindex $tmp 0]
				$media set crypt_key_ [lindex $tmp 1]
			} else {
				$msg set crypt_method_ [lindex $tmp 0]
				$msg set crypt_key_ [lindex $tmp 1]
			}
		}
		a {
			set attribute [split $value ":"]
			set attname [lindex $attribute 0]
			set attval [join [lrange $attribute 1 end] ":"]
			if { $media != "" } {
				set target $media
			} else {
				set target $msg
			}
			if [catch {$target set attributes_($attname)}] {
				$target set attributes_($attname) {}
			}
			$target set attributes_($attname) \
			    [concat [$target set attributes_($attname)] \
				 [list $attval]]
		}
		m {
			set media [new SDPMedia $msg]
			set mt [lindex $value 0]
			$media set mediatype_ $mt
			$media set port_  [lindex $value 1]
			$media set proto_ [lindex $value 2]
			$media set fmt_ [lrange $value 3 end]
			set tmp ""
			catch { set tmp [$msg set media_array_($mt)] }
			lappend tmp $media
			$msg set media_array_($mt) $media
			set tmp [$msg set allmedia_]
			lappend tmp $media
			$msg set allmedia_ $tmp
		}
		default {
			set parse_error_ "$class: error unknown modifier $tag."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		}
		set tmp [$msg set msgtext_]
		lappend tmp $line
		$msg set msgtext_ $tmp
		if { $media != "" } {
			$media set fields_($tag) $value
		} else {
			$msg set fields_($tag) $value
		}
	}
	foreach msg $allmsgs {
		set tmp [$msg set msgtext_]
		set tmp [join $tmp \n]
		append tmp \n
		$msg set msgtext_ $tmp
	}
	return $allmsgs
}
SDPParser instproc parse_error { } {
	return [$self set parse_error_]
}
SDPMessage instproc init {} {
	$self next
	$self instvar allmedia_ alltimedes_ msgtext_
	set allmedia_ ""
	set alltimedes_ ""
	set msgtext_ ""
}
SDPMessage instproc destroy {} {
	$self instvar allmedia_ alltimedes_
	foreach m $allmedia_ {
		delete $m
	}
	foreach t $alltimedes_ {
		delete $t
	}
	$self next
}
SDPMessage instproc media { media_type } {
	$self instvar media_array_
	if [info exists media_array_($media_type)] {
		return $media_array_($media_type)
	} else {
		return ""
	}
}
SDPMessage instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMessage instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMessage instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMessage instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMessage instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMessage instproc obj2str {} {
	$self instvar attributes_ alltimedes_ allmedia_
	set o "v=[$self field_value v]"
	foreach f { o s i u } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	$self instvar phonelist_ emaillist_
	if [info exists phonelist_] {
		foreach e $phonelist_ {
			set n "p=$e"
			set o $o\n$n
		}
	}
	if [info exists emaillist_] {
		foreach e $emaillist_ {
			set n "e=$e"
			set o $o\n$n
		}
	}
	foreach f { c b } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach t $alltimedes_ {
		set n [$t obj2str]
		set o $o\n$n
	}
	foreach f { z k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [$self attributes] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	foreach m $allmedia_ {
		set n [$m obj2str]
		set o $o\n$n
	}
	return $o
}
SDPMessage public unique_key {} {
    if ![$self have_field o] {
	$self warn "in SDPMessage::unique_key without o= field"
	return ""
    }
    set l [split [$self field_value o]]
    set l [lreplace $l 2 2]
    set key [join $l :]
    return $key
}
SDPMessage instproc htmlify_media { } {
    set html {}
    foreach media [$self set allmedia_] {
	append html [$media create_dynamic_html \
		[DynamicHTMLifier set html_(media)]]
    }
    return $html
}
SDPMessage instproc htmlify_times { } {
    set html {}
    foreach time [$self set alltimedes_] {
	set repeat [string tolower [$time readable_repeat]]
	if { [$time set starttime_] != 0 } {
	    append html [$time create_dynamic_html \
		    [DynamicHTMLifier set html_(time_$repeat)]]
	} else {
	    append html "Unbounded session"
	}
    }
    return $html
}
SDPMessage instproc htmlify_url { } {
    $self instvar uri_
    if [info exists uri_] {
	return "<a href=\"$uri_\">$uri_</a>"
    } else {
	return ""
    }
}
SDPMessage instproc htmlify_list { varname } {
    set list {}
    foreach elt [$self get $varname] {
	if { $list!={} } {
	    append list ", $elt"
	} else {
	    append list $elt
	}
    }
    return $list
}
SDPMessage instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPMedia instproc htmlify_mediatype { } {
    return "[$self set mediatype_]"
}
SDPMedia instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPMedia instproc init {{msg ""}} {
	$self next
	if {$msg == ""} { return }
	$self instvar attributes_ fields_
	set alist [$msg attributes]
	foreach a $alist {
		set attributes_($a) [$msg set attributes_($a)]
	}
	set vlist [$msg info vars]
	foreach f { session_info_ nettype_ addrtype_ caddr_ bwmod_ bwval_ 
		crypt_method_ crypt_key_ } {
		if { [lsearch -exact $vlist $f] >= 0 } {
			$self set $f [$msg set $f]
		}
	}
	foreach f { i c b k a } {
		if [$msg have_field $f] {
			set fields_($f) [$msg field_value $f]
		}
	}
}
SDPMedia instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMedia instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMedia instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMedia instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMedia instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMedia instproc obj2str {} {
	$self instvar attributes_
	set o "m=[$self field_value m]"
	foreach f { i c b k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [array names attributes_] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	return $o
}
SDPTime instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPTime instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPTime instproc obj2str {} {
	set o "t=[$self field_value t]"
	if [$self have_field r] {
		set n "r=[$self field_value r]"
		set o $o\n$n
	}
	return $o
}
SDPTime public get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPTime public sec_until_current { time_type } {
    set sdp_time [ntp_to_unix [$self get $time_type]]
    set current [clock seconds]
    return [expr $sdp_time - $current]
}
SDPTime public current_in_interval { start end } {
    set current [unix_to_ntp [clock seconds]]
    if { [expr $start == 0 && $end == 0] } {
	return 1
    } elseif { $start == 0 } {
	return [expr $end > $current]
    } elseif { $end == 0 } {
	return [expr $start <= $current]
    } else {
	return [expr $start <= $current && $end > $current]
    }
}
SDPTime public readable_time { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%H:%M}]
    }
}
SDPTime public readable_duration { } {
    set duration [$self get active_duration_]
    set hours [expr $duration / 3600]
    if { $hours < 24 } {
	return "$hours hour(s)"
    }
    set days [expr $hours / 24]
    if { $days < 7 } {
	return "$days day(s)"
    }
    set weeks [expr $days / 7]
    return "$weeks week(s)"
}
SDPTime public readable_date { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%B %d, %Y}]
    }
}
SDPTime public readable_day { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%a}]
    }
}
SDPTime public readable_day_full { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%A}]
    }
}
SDPTime public readable_zone { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    return [clock format $sec -format {%Z}]
}
SDPTime public readable_repeat { } {
    set interval [$self get repeat_interval_]
    if { $interval == 86400 } {
	return Daily
    } elseif { $interval == 604800 } {
	return Weekly
    } else {
	return None
    }
}
set gwstr(video) VGW
set gwstr(sdp) SDGW
set gwstr(audio) AGW
set gwstr(mediaboard) MBGW
set gwstr(mb) MBGW
set gwstr(whiteboard) MBGW
Class GWHandler
Class GWHandler/RTPGW -superclass GWHandler
Class GWHandler/VGW -superclass { GWHandler/RTPGW RTP/Video }
Class GWHandler/AGW -superclass { GWHandler/RTPGW RTP/Audio }
Class GWHandler/MBGW -superclass GWHandler
Class GWHandler/SDGW -superclass GWHandler
Class GWHandler/Mars -superclass GWHandler
Class ServiceCreator
Class ServiceCreator/MeGa -superclass ServiceCreator
Class ServiceCreator/Generic -superclass ServiceCreator
Class ServiceCreator/Mars -superclass ServiceCreator
Class GWHandler/MediaPad -superclass GWHandler
Class ServiceCreator/MediaPad -superclass ServiceCreator
ServiceCreator/MediaPad instproc create_handler {srv_inst msg} {
	$self instvar agent_
	set h [new GWHandler/MediaPad $agent_ $srv_inst "" "" ""]
	return $h
}
GWHandler/MediaPad instproc init {agent sname gspec lspec fmt} {
	$self next $agent $sname $gspec $lspec $fmt
	$self instvar serviceInst_
	set serviceInst_ $sname
}
GWHandler/MediaPad instproc execargs {} {
	$self instvar sessSpec_ serviceInst_
	return [list -servinst [list $serviceInst_]]
}
ServiceCreator instproc init { agent } {
	$self next 
	$self set agent_ $agent
}
ServiceCreator/Generic instproc create_handler { srv_inst msg } {
	$self instvar agent_
	set h [new GWHandler $agent_ $srv_inst "" "" ""]
	return $h
}
ServiceCreator/MeGa instproc init { agent } {
	$self next $agent
	$self set sdp_ [new SDPParser]
}
ServiceCreator/MeGa instproc destroy {} {
	$self instvar sdp_
	delete $sdp_
}
ServiceCreator/MeGa instproc create_handler { srv_inst msg } {
	$self instvar sdp_ agent_
	set msg [$sdp_ parse $msg]
	set gspec [$msg set caddr_]
	set media [$msg set allmedia_]
	set fmt [$media set fmt_]
	set mtype [$media set mediatype_]
	set rport [$media set port_]
	set clientaddr [$msg set createaddr_]
	set sport [$agent_ uniqport]
	if { $rport != 0 } {
		set laddr $clientaddr
	} else {
		set rport $sport
		set laddr [$agent_ pick_mcastaddr]
	}
	set s [split $gspec /]
        set gspec [lindex $s 0]/[lindex $s 1]/none/[lindex $s 2]
	set lspec $laddr/$rport:$sport/none/1
	global gwstr
	if { $mtype == "video" } {
		set lscuba [$msg have_attr localscuba]
		set h [new GWHandler/VGW $agent_ $srv_inst $gspec $lspec $fmt \
				$lscuba]
	} else {
		set s $gwstr($mtype)
		set h [new GWHandler/$s $agent_ $srv_inst $gspec $lspec $fmt]
	}
	delete $msg
	return $h
}
ServiceCreator/Mars instproc create_handler {srv_inst msg} {
	$self instvar agent_
	set h [new GWHandler/Mars $agent_ $srv_inst "" "" "" $msg]
	return $h
}
GWHandler instproc init { agent sname gspec lspec fmt } {
	$self next
	$self instvar agent_ sname_ gspec_ lspec_ link_
	set agent_ $agent
	set sname_ $sname
	set gspec_ $gspec
	set lspec_ $lspec
	set link_ 0
	set format_ null
}
GWHandler instproc exec { fname } {
	$self instvar pid_ agent_ link_ gwctrl_
	if $link_ {
		$self instvar clientctrl_ bw_ ofmt_ gspec_ rportspec_
		set s [split $gspec_ /]
		set sspec [lindex $s 0]/[lindex $s 1]/[lindex $s 3]
		set gspec_ none
		set linkargs "-megactrl $gwctrl_ -megaclient $clientctrl_ -sbw $bw_ -ofmt $ofmt_ -sspec $sspec -rport $rportspec_"
	} else {
		set linkargs "-megactrl $gwctrl_"
	}
	set execargs "[$self execargs] $linkargs"
	if { [$self get_option doFork] != "" } {
		set targ ">& /dev/null"
	} else {
		set targ ""
	}
	set path [$self get_option execPath]
	set execstr "$path/smash $fname $execargs"
	if { [catch "eval exec [list $execstr] $targ &" pid_] != 0 } {
		global errorCode
		$agent_ log "hm: error in exec of '$execstr': $errorCode"
		set pid_ -1
		return -1
	} else {
		$agent_ log "$execstr"
	}
	return 0
}
GWHandler/RTPGW instproc destroy {} {
	$self instvar agent_ cb_
	if [info exists cb_] {
		$agent_ close_cb $cb_
	}
	$self next
}
GWHandler/RTPGW instproc exec { script } {
	$self instvar agent_ cb_
	set cb_ [$agent_ open_cb $self]
	$self init_callbacks
	$self next $script
}
GWHandler/RTPGW instproc alive { info } {
	$self instvar dstspec_
	if ![info exists dstspec_] {
		set dstspec_ 1
		$self cb_init
		update
	}
}
GWHandler/RTPGW instproc init_callbacks {} {
	$self next
	$self instvar cb_
	$cb_ register alive "$self alive"
	$cb_ register activate "$self src_activate"
}
GWHandler/RTPGW instproc src_activate { info src args } {
}
GWHandler/AGW instproc cb_init {} {
	$self instvar cb_ gspec_ lspec_ format_ dstspec_
	$cb_ send cb_init
	$cb_ send cb_sessions global=$gspec_!local=$lspec_
	$cb_ send cb_set global RC 0
	$cb_ send cb_set local RC 1
	$cb_ send cb_set global txonly 1
	$cb_ send cb_set local txonly 1
	$cb_ send cb_set global ofmt $format_
	$cb_ send cb_set local ofmt $format_
}
GWHandler/VGW instproc cb_init {} {
	$self instvar cb_ gspec_ lspec_ format_ dstspec_ lscuba_
	$cb_ send cb_init
	$cb_ send cb_sessions global=$gspec_!local=$lspec_
	if { $lscuba_ == "global" } {
		$cb_ send cb_set global RC 1
	} else {
		$cb_ send cb_set global RC 0
	}
	$cb_ send cb_set local RC 1
	if { $format_ == "null" } {
		$cb_ send cb_set local txonly 1
	}
	$cb_ send cb_set global color 1
	$cb_ send cb_set local color 1
	$cb_ send cb_set global ofmt $format_
	$cb_ send cb_set local ofmt $format_
	$self instvar agent_ cb_ 
	$agent_ log "DONE [$cb_ set channel_]"
}
GWHandler instproc cb_init {} {
}
GWHandler/VGW instproc init { agent sname gspec lspec fmt lscuba } {
	$self next $agent $sname $gspec $lspec $fmt
	$self instvar format_
	set format_ [$self rtp_type $fmt]
	if  { $format_ == "" } {
		set format_ null
	}
	$self instvar lscuba_
	if { $lscuba } {
		set lscuba_ local 
	} else {
		set lscuba_ global
	}
	$self set gwname_ vgw
}
GWHandler/AGW instproc init { agent sname gspec lspec fmt } {
	$self next $agent $sname $gspec $lspec $fmt
	$self instvar format_
	set format_ [$self rtp_type $fmt]
	if  { $format_ == "" } {
		set format_ null
	}
	$self set gwname_ agw
}
GWHandler/SDGW instproc init args {
	eval $self next $args
	$self set gwname_ sdgw
}
GWHandler/MBGW instproc init args {
	eval $self next $args
	$self set gwname_ mbgw
}
GWHandler instproc execargs {} { 
	return ""
}
GWHandler/VGW instproc execargs {} {
	$self instvar cb_ sname_ lscuba_
	set chan [$cb_ set channel_]
	return "-scuba $lscuba_ -usemega $sname_ -I $chan"
}
GWHandler/AGW instproc execargs {} {
	$self instvar cb_ sname_
	set chan [$cb_ set channel_]
	return "-usemega $sname_ -I $chan"
}
GWHandler/SDGW instproc execargs {} {
	$self instvar sname_ gspec_ lspec_
	return "-usemega $sname_ -gspec $gspec_ -lspec $lspec_"
}
GWHandler/MBGW instproc execargs {} {
	$self instvar sname_ gspec_ lspec_
	return "-usemega $sname_ -gspec $gspec_ -lspec $lspec_"
}
GWHandler/Mars instproc init {agent sname gspec lspec fmt ssd} {
	$self next $agent $sname $gspec $lspec $fmt
	$self instvar ssd_ serv_inst_
	set ssd_ $ssd
	set serv_inst_ $sname
}
GWHandler/Mars instproc execargs {} {
	$self instvar ssd_ serv_inst_
	return "[list $ssd_] [list $serv_inst_]"
}
CoordinationBus set protocolId_ ""
CoordinationBus proc.invoke { } {
	$self set protocolId_ cbus/1.0
	if { [info commands mtrace]=="" } {
		proc ::mtrace { args } { }
	}
}
CoordinationBus public init { args } {
	eval [list $self] next
	$self set seqno_ 0
	$self instvar ttl_ srcid_ mediatype_ moduletype_ appname_ appinstance_\
			channel_ mode_
	foreach {key value} $args {
		if { [string index $key 0] != "-" } {
			error "invalid argument '$key'"
		}
		$self set [string range $key 1 end]_ $value
	}
	if { ![info exists ttl_]        } { set ttl_ 0 }
	if { ![info exists mediatype_]  } { set mediatype_ "*" }
	if { ![info exists moduletype_] } { set moduletype_ "*" }
	if { ![info exists appname_]    } { set appname_ "*" }
	if { ![info exists appinstance_]} { set appinstance_ [localaddr]:[pid]}
	if { ![info exists channel_]    } { set channel_ 0 }
	if { ![info exists mode_]       } { set mode_ "readwrite" }
	if { ![info exists srcid_] } {
		set srcid_ "$mediatype_/$moduletype_/$appname_/$appinstance_"
	} else {
		set tmp [split $srcid_ /]
		if { [llength $tmp] != 4 } {
			error "invalid srcid '$srcid_'"
		}
	}
	$self open $channel_ $ttl_ $mode_
}
CoordinationBus public destroy { } {
	$self close
	$self next
}
CoordinationBus public register { event method } {
	$self instvar dispatch_
	if { [llength $method] > 1 } {
		set dispatch_($event,object) [lindex $method 0]
		set dispatch_($event,method) [lindex $method 1]
	} else {
		set dispatch_($event,object) $self
		set dispatch_($event,method) [lindex $method 0]
	}
	set dispatch_($event,argcnt) [$self get_argcnt \
			$dispatch_($event,object) $dispatch_($event,method)]
	if { $dispatch_($event,argcnt) < 0 } {
		set object $dispatch_($event,object)
		unset dispatch_($event,object)
		unset dispatch_($event,method)
		unset dispatch_($event,argcnt)
		error "trying to register undefined method '$method' on object\
				$object"
	}
}
CoordinationBus public unregister { event } {
	$self instvar dispatch_
	if [info exists dispatch_($event,object)] {
		unset dispatch_($event,object)
		unset dispatch_($event,method)
		unset dispatch_($event,argcnt)
	}
}
CoordinationBus public send { args } {
	if { [string compare [lindex $args 0] "-dstid"] == 0 } {
		set dst [lindex $args 1]
		set tmp [split $dst /]
		if { [llength $tmp] != 4 } {
			error "Invalid destination: must be of the form\
					<media-type>/<module-type>/<app-name>/<app-instance>"
		}
		set args [lrange $args 2 end]
	} else {
		set dst "*/*/*/*"
	}
	$self instvar seqno_ srcid_
	if { [llength $args]==0 } {
		error "Must specify event type: \$cb send\
				[-dstid <destination>] $event_type [args...]"
	}
	set headers [list [CoordinationBus set protocolId_] $seqno_ \
			"U" $srcid_ $dst ""]
	$self transmit [concat $headers $args]
}
CoordinationBus private match_wildcards { d s } {
	if { [string compare $d $s]==0 || $d=="*" || $s=="*" } {
		return 1
	} else {
		return 0
	}
}
CoordinationBus private filter { destid } {
	$self instvar srcid_
	set s [split $srcid_ /]
	set d [split $destid /]
	if { [$self match_wildcards [lindex $d 0] [lindex $s 0]] && \
			[$self match_wildcards [lindex $d 1] [lindex $s 1]] &&\
			[$self match_wildcards [lindex $d 2] [lindex $s 2]] &&\
			[$self match_wildcards [lindex $d 3] [lindex $s 3]] } {
		return 1
	} else {
		return 0
	}
}
CoordinationBus private dispatch { packet } {
	set packet [split $packet]
	if { [llength $packet] < 7 } {
		mtrace trcCB "CB: Invalid packet: only [llength $packet]\
				elements"
		return
	}
	set protocolId [lindex $packet 0]
	set seqNo [lindex $packet 1]
	set messageType [lindex $packet 2]
	set srcId [lindex $packet 3]
	set destId [lindex $packet 4]
	set ackList [lindex $packet 5]
	set event [lindex $packet 6]
	set args [lrange $packet 7 end]
	if { $protocolId != [CoordinationBus set protocolId_] } {
		mtrace trcCB "CB: Invalid protocol id '$protocolId': must be\
				[CoordinationBus set protocolId_]"
		return
	}
	$self instvar srcid_
	if { [string compare $srcId $srcid_]==0 } {
		return
	}
	if { ![$self filter $destId] } {
		mtrace trcCB|trcVerbose "CB: filtering out packet meant for\
				'$destId'"
		return
	}
	$self instvar dispatch_
	if { ![info exists dispatch_($event,object)] } {
		mtrace trcCB|trcVerbose "CB: unknown event '$event'"
		return
	}
	if { [expr [llength $args] + 1] != $dispatch_($event,argcnt) } {
		mtrace trcCB "CB: argument mismatch: expected\
				$dispatch_($event,argcnt) arguments,\
				got [llength $args]"
		return
	}
	set info [list cb $self srcid $srcId dstid $destId event $event]
	eval [list $dispatch_($event,object)] \
			[list $dispatch_($event,method)] [list $info] $args
}
CoordinationBus private get_argcnt { object method } {
	if { [$object info procs $method] != "" } {
		return [llength [$object info args $method]]
	}
	set cls [$object info class]
	if { [$cls info instprocs $method] != "" } {
		return [llength [$cls info instargs $method]]
	}
	foreach c [$cls info heritage] {
		if { [$c info instprocs $method] != "" } {
			return [llength [$c info instargs $method]]
		}
	}
	return -1
}
Class MeGa
MeGa instproc init args {
	eval $self next $args
	$self set sdp_ [new SDPParser]
}
MeGa instproc destroy {} {
	$self instvar sdp_
	delete $sdp_
	$self next
}
MeGa proc ctrlchan { media spec } {
	set tmp [split $spec /]
	set addr [lindex $tmp 0]
	if ![in_multicast $addr] {
		return $spec
	}
	set port [lindex $tmp 1]
	switch $media {
	video {
		incr port 2
	}
	audio {
		incr port 4
	}
	mb {
		incr port 6
	}
	sdp {
		incr port 8
	}
	hm {
		incr port 10
	}
	}
	set ttl [lindex $tmp 2]
	return $addr/$port/$ttl
}
Class HMAgent -superclass Timer
HMAgent instproc init { app logfd } {
	$self next
	$self instvar maxports_ minport_ uniqport_ app_ cbchannel_ logfd_
	$self instvar creators_
	set creators_(MeGa) [new ServiceCreator/MeGa $self]
	set creators_(Generic) [new ServiceCreator/Generic $self]
	set creators_(Mars) [new ServiceCreator/Mars $self]
	set creators_(MediaPad) [new ServiceCreator/MediaPad $self]
	set cbchannel_ 3
	set app_ $app
	set logfd_ $logfd
	$self set uniqid_ 0
	$self log "Start"
	set maxports_ [$self get_option maxPorts]
	set minport_ [$self get_option minPort]
	set uniqport_ $minport_
	set megaspec [$self get_option megaCtrl]
	set bw [$self get_option megaCtrlBW]
	$self init_scripturls
	set f [$app get_option megaConfFile]
	if [file exists $f] {
	    	$self log "Reading config file $f."
		$self parse_conffile $f
	} else { 
	    	$self log "Can't find $f, no config file."
	}
	$self instvar al_
	set al_(generic) [new AnnounceListenManager/AS/HM $self $megaspec $bw]
	foreach m { audio video sdp mb } {
		set spec [MeGa ctrlchan $m $megaspec]
		set al_($m) [new AnnounceListenManager/AS/HM $self $spec $bw]
	}
	set spec [MeGa ctrlchan hm $megaspec]
	set al_(hm) [new AnnounceListenManager/AS/HM $self $spec $bw]
	if { [$self get_option loadBalance] != "" } {
		$al_(hm) start
		$self read_hmhosts
		$self init_load_check
	} elseif { [$self get_option targetNum] != "" } {
		$al_(hm) start
		$self set trgtnum_ [$app_ get_option targetNum]
		if { [$self get_option glunix] == "" } {
			$self read_hmhosts
		}
		HMAgent instproc timeout {} { $self target_check }
		$self randomize yes
		set a [$self get_option checkFactor]
		$self msched [expr $a * [$self get_option checkInterval]]
	} else {
	}
}
HMAgent instproc init_scripturls {} {
	$self instvar scripturls_
	set scripturls_ {
		http://www-mash.cs.berkeley.edu/dist/as/scripts
		http://www.cs.berkeley.edu/~elan/as/scripts
	}
}
HMAgent instproc parse_conffile { f } {
	set fd [open $f r]
	if { $fd < 0 } {
		return
	}
	$self instvar conf_ 
	while { [gets $fd line] > 0 } {
		set kw [lindex $line 0]
		switch $kw {
		link {
			$self add_option link yes
			set conf_(gwctrl) [lindex $line 1]
			set conf_(clientctrl) [lindex $line 2]
		} 
		leaf {
			set conf_(gwctrl) [lindex $line 1]
		}
		media {
			set mtype [lindex $line 1]
			set conf_($mtype,bw) [lindex $line 2]
			set conf_($mtype,ofmt) [lindex $line 3]
		}}
	}
	close $fd
}
HMAgent instproc target_check {} {
	$self instvar al_ trgtnum_
	set n [$al_(hm) hmnum]
	incr n
	set r [expr [random]/double(0x7fffffff)]
	if { $n < $trgtnum_ } {
		set p [expr double($trgtnum_ - $n) / $n]
		if { $r < $p } {
			$self spawn
		}
	} elseif { $n > $trgtnum_ } {
		set p [expr double($n - $trgtnum_) / $n]
		if { $r < $p } {
			$self doexit
			return
		}
	}
	$self msched [$self get_option checkInterval]
}
HMAgent instproc doexit {} {
	$self instvar al_
	$al_(hm) announce_death
	exit 0
}
HMAgent instproc log msg {
	$self instvar logfd_
	if { [$self get_option noLog] != "" } {
		return
	}
	if { $msg == "" } {
		puts $logfd_ ""
	} else {
		puts $logfd_ "\[[$self pid]\] [lrange [gettimeofday ascii] 1 3] $msg"
	}
	flush $logfd_
}
HMAgent instproc pid {} {
	return [pid]
}
HMAgent instproc destroy {} {
	$self instvar al_
	foreach m { audio video sdp mb hm } {
		delete $al_($m)
	}
	$self next
}
HMAgent instproc uniqport {} {
	$self instvar uniqport_ portmap_ maxports_ minport_
	incr uniqport_ 4
	set uniqport_ [expr ($uniqport_ % $maxports_) + $minport_]
        while { [info exists portmap_($uniqport_)] } {
		incr uniqport_ 4
		set uniqport_ [expr ($uniqport_ % $maxports_) + $minport_]
	}
	return $uniqport_
}
HMAgent instproc pick_mcastaddr {} {
	set r1 [expr ([random]%250)+2]
	set r2 [expr ([random]%250)+2]
	return 224.3.$r1.$r2
}
HMAgent instproc launch { srv_name srv_loc srv_inst msg } {
	if { [$self pending_launches] >= [$self get_option maxPending] } {
		$self log "BACKLOG [$self pending_launches]"
		$self cancel_timer $srv_inst
		return
	}
	set load [HMAgent get_load]
	set hiload [$self get_option highLoad]
	$self log "LAUNCH load=$load $hiload"
	if { [$self get_option noLoad] == "" &&  $load >= $hiload } {
		$self cancel_timer $srv_inst
		return
	}
	$self instvar creators_
	set creator $creators_($srv_name)
	set h [$creator create_handler $srv_inst $msg]
	$h set gwctrl_ [$self get_option megaCtrl]
	if { [$self get_option link] == "yes" } {
		$self instvar conf_
		$h set link_ 1
		$h set gwctrl_ $conf_(gwctrl)
		$h set bw_ $conf_($mtype,bw)
		$h set ofmt_ $conf_($mtype,ofmt)
		set a [split $conf_(clientctrl) /]
		if [in_multicast [lindex $a 0]] {
			$h set clientctrl_ $conf_(clientctrl)
			$h set rportspec_ 0
		} else {
			set baseport [$self uniqport]
			set addr [lindex $a 0]
		        set ports [split [lindex $a 1] :]
			set sport [lindex $ports 0]
		    	set rport [lindex $ports 1]
			if { $rport == "*" } {
			    set rport [expr $baseport + 2]
			}
			$h set clientctrl_ $addr/$sport:$rport/1
			$h set rportspec_ $baseport:$rport
		}
	}
	set script [$self get_script $srv_name $srv_loc]
	if { $script == "" || [$h exec $script] < 0} {
		delete $h
		$self cancel_timer $srv_inst
		return 0
	} else {
		lappend handlers_ $h
	}
	$self log "announce_launch $srv_inst"
	$self instvar al_
	$al_(hm) announce_launch $srv_inst
	$self set launched_($srv_inst) 1
	return 1
}
::http::formatQuery sdsds
HMAgent instproc get_script { name srv } {
	set o [split $srv :]
	$self instvar scriptfiles_
	if [info exists scriptfiles_($srv)] {
		return $scriptfiles_($srv)
	} 
	$self log "get_script $name $srv"
	switch [lindex $o 0] {
	static {
		set path [$self get_option execPath]
		set n $path/[lindex $o 1]
		if [file isfile $n] {
			set scriptfiles_($srv) $n 
			return $n
		}
		return ""
	}
	http {
		set d [$self get_option scriptDir]
		if ![file isdirectory $d] {
			file mkdir $d
		}
		$self instvar uniqid_
		set fname $d/as-$uniqid_.mash
		incr uniqid_
		set fd [open $fname w+]
		set t [::http::geturl $srv -channel $fd]
		close $fd
		set code [lindex [::http::code $t] 1]
		if { $code == "200" } {
			$self log "got script from $srv"
			set scriptfiles_($srv) $fname
			::http::reset $t
			return $fname
		} else {
			$self log "can't get script from $srv."
			::http::reset $t
			return ""
		}
	}
	urn {
		set n [lindex $o 1]
		set s [$self get_script $name static:$n] 
		if { $s != "" } {
			$self log "got $name/$srv from static:$n: $s"
			set scriptfiles_($srv) $s
			return $s 
		}
		$self instvar scripturls_
		foreach url $scripturls_ {
			set s [$self get_script $name $url/$n] 
			if { $s != "" } {
				$self log "got $name/$srv from $url: $s"
				set scriptfiles_($srv) $s
				return $s 
			}
		}
	}	
	}
	return ""
}
HMAgent instproc unregister { aspec msg } {
	$self instvar handlers_
	if ![info exists handlers_] {
		return
	}
	set i 0
	set pid [lindex [split $aspec @] 0]
	foreach h $handlers_ {
		if { [$h set pid_] == $pid } {
			delete $h
			set handlers_ [lreplace $handlers_ $i $i]
			return
		}
		incr i
	}
}
HMAgent instproc pending_timer tid { 
	$self instvar tid_
	return [info exists tid_($tid)]
}
HMAgent instproc pending_launches {} { 
	$self instvar launched_
	return [llength [array names launched_]]
}
HMAgent instproc cancel_timer tid {
	$self instvar tid_ launched_
	if [info exists launched_($tid)] {
		unset launched_($tid)
	}
	if { [info exists tid_($tid)] } {
		$self log "cancelled timer $tid"
		after cancel $tid_($tid)
		unset tid_($tid)
	}
}
HMAgent instproc sched_launch { srv_name srv_loc srv_inst msg } {
	$self instvar al_
	set numhm [$al_(hm) hmnum]
	set T [expr $numhm * 2000]
	set max [$self get_option maxWait]
	if { $T > $max } {
		set $T $max
	}
	set r [HMAgent uniform_timer $T]
	$self log "timer $srv_name $srv_inst $r"
	set tid [after $r "$self launch $srv_name $srv_loc $srv_inst {$msg}"] 
	$self instvar tid_
	set tid_($srv_inst) $tid
}
HMAgent proc exp_timer { lambda T } {
	set r [expr [random]/double(0x7fffffff)]
	set o [expr ($T/$lambda) * log((exp($lambda) - 1)*$r + 1)]
	return [expr int($o+0.5)]
}
HMAgent proc uniform_timer { T } {
	set r [expr [random]/double(0x7fffffff)]
	set o [expr $r*$T]
	return [expr int($o+0.5)]
}
HMAgent instproc suppress_timer tid {
	$self instvar tid_ launched_
	$self log "suppress timer $tid"
	if { [info exists tid_($tid)] && ![info exists launched_($tid)] } {
		after cancel $tid_($tid)
		unset tid_($tid)
	}
}
HMAgent instproc close_cb cb {
	set c [$cb set channel_]
	$self instvar chanmap_
	incr chanmap_($c) -1
	if { $chanmap_($c) <= 0 } {
		delete $cb
		unset chanmap_($c)
	}
}
HMAgent instproc open_cb { handler } {
	$self instvar cbchannel_ chanmap_
	set cb [new CoordinationBus -channel $cbchannel_]
	set chanmap_($cbchannel_) 1
	incr cbchannel_
	return $cb
}
HMAgent instproc read_hmhosts {} {
	$self instvar hmhosts_ low_ high_ app_
	set path [$app_ get_option execPath]
	set f "$path/hmhosts"
	if { $f == "" } {
		$self log "hm: warning: no host file - disabling load_check"
		return
	}
	set fd [open $f r]
	if { $fd <  0 } {
		$self log  "hm: problems opening $f"
		return
	}
	while { [gets $fd line] > 0 } {
		if { [intoa [lookup_host_addr $line]] != [localaddr] } {
			lappend hmhosts_ $line
		}
	}
	close $fd
}
HMAgent instproc init_load_check {} {
	set low_ 0
	set high_ 0
	set t [$self get_option checkInterval]
	after $t "$self load_check"
}
HMAgent instproc load_check {} {
	$self instvar app_ low_ high_ al_
	set load [$self get_load]
	set nsamples [$self get_option loadSamples]
	if { $load > [$self get_option highLoad] } {
		incr high_
		if { $high_ >= $nsamples } {
			if { [$self spawn] != 0 } {
				$self shed_load
			}
		}
	} elseif { $load < [$self get_option lowLoad] } {
		incr low_
		if { $low_ >= $nsamples } {
			set minhm [$app_ get_option minHmNum]
			set hmnum [$al_(hm) hmnum]
			incr hmnum
			if { $hmnum > $minhm } {
				$self die
				return
			}
		}
	} else {
		set low_ 0
		set high_ 0
	}
	set t [$self get_option checkInterval]
	after $t "$self load_check"
}
HMAgent proc get_load {} {
	set v [catch {open "|uptime"} fd]
	if { $v != 0 } {
	    return 0
	}
	set l [gets $fd]
	close $fd
	set n [llength $l]
	set avg [string trim [lindex $l [expr $n - 3]] ,]
	return $avg
}
HMAgent instproc spawn {} {
	$self instvar al_ hmhosts_ app_
       	set hmlist [$al_(hm) hmaddrs]
	if { [$app_ get_option glunix] != "" } {
		set tlist [eval exec "glustat -s l -l"]
	} else {
		set tlist $hmhosts_
	}
	set i [lsearch -exact $tlist [localaddr]]
	set tlist [lreplace $tlist $i $i]
	foreach h $hmlist {
		set i [lsearch -exact $tlist $h]
		set tlist [lreplace $tlist $i $i]
	}
	set n [llength $tlist]
	if { $n == 0 } {
		return 0
	}
	if { [$app_ get_option glunix] != "" } {
		set r 0
	} else {
		set r [expr [random] % $n]
	}
	set shost [lindex $tlist $r]
	$self dospawn $shost
	return 1
}
HMAgent instproc dospawn { shost } {
	$self instvar app_ al_
	set path [$app_ get_option execPath]
	set argv [$app_ get_option execArgs]
	set cmd [$app_ get_option execCmd]
	$self log "eval exec $cmd $shost $path/smash $path/hm $argv >& /dev/null &"
	if { [catch "eval exec $cmd $shost $path/smash $path/hm $argv >& /dev/null &" t] != 0 } {
		$self log "catch error: $t"
	}
}
HMAgent instproc shed_load {} {
	$self instvar handlers_
	foreach h $handlers_ {
		set pid [$h set pid_]
		set r [expr [random]/double(0x7fffffff)]
		if { $r < 0.5 } {
			$self log "exec kill -9 $pid"
			catch "eval exec kill -9 $pid"
		}
	}
}
HMAgent instproc die {} {
	$self instvar al_ dying_ app_
	set t [$app_ get_option deathInterval]
	set minwait [$app_ get_option minDeathWait]
	set r [expr ([random] % $t) + $minwait]
	set dying_ [after $r "$self really_die"]
}
HMAgent instproc really_die {} {
	$self instvar app_ al_ dying_ low_ high_
	$al_(hm) announce_death
	set minhm [$app_ get_option minHmNum]
	set hmnum [$al_(hm) hmnum]
	incr hmnum
	if { $hmnum > $minhm && \
	     [$self get_load] < [$app_ get_option lowLoad] } {
		$self log "exit 0"
     		$self doexit
	}	
	unset dying_
	set low_ 0
	set high_ 0
	$self load_check
}
HMAgent instproc recv_death {} {
	$self instvar dying_ low_ high_
	if ![info exists dying_] {
		return
	}
	after cancel $dying_
	unset dying_
	set low_ 0
	set high_ 0
	$self load_check
}
Class HMApplication -superclass Application
HMApplication public init argv {
	$self next hm
	set o [$self options]
	$self init_args $o
	$self init_resources $o
	$o parse_args $argv
	$self init_local
	if { [$self get_option doFork] != "" } {
		close stdout
		close stdin
		close stderr
		fork
		set logfd [open [$self get_option logFile] a+]
	} else {
		set logfd stdout
	}
	$self add_option execArgs $argv
	new HMAgent $self $logfd
}
HMApplication private init_args o {
	$o register_boolean_option -lb loadBalance
	$o register_boolean_option -fork doFork
	$o register_boolean_option -glunix glunix
	$o register_boolean_option -noload noLoad
	$o register_boolean_option -nolog noLog
	$o register_option -target targetNum
	$o register_option -int checkInterval
	$o register_option -path execPath
	$o register_option -log logFile
	$o register_option -rcmd execCmd
	$o register_option -conffile megaConfFile
	$o register_option -megactrl megaCtrl
	$o register_option -scriptdir scriptDir
}
HMApplication private init_resources o {
	$o add_default megaCtrl 224.4.5.24/50000/31
	$o add_default megaCtrlBW 20000
	$o add_default megaStartupWait 60
	$o add_default scriptDir /var/tmp
	$o add_default unicastOutput 1
	$o add_default lambda 5.0
	$o add_default maxWait 15000
	$o add_default maxPending 5
	$o add_default minPort 10000
	$o add_default maxPorts 10000
	$o add_default checkFactor 2
	$o add_default checkInterval 20000
	$o add_default deathInterval 10000
	$o add_default minDeathWait 60000
	$o add_default highLoad 1.00
	$o add_default lowLoad 0.05
	$o add_default noLoad yes
	$o add_default execPath [pwd]
	$o add_default execCmd "ssh -n"
	$o add_default minHmNum 1
	$o add_default loadSamples 2
	$o add_default logFile /tmp/hmlog
	$o add_default megaConfFile mega.conf
	$o add_default link no
}
new HMApplication $argv
vwait forever
