ui-network.tcl

rtpmon-1.0a7.tar.gz for UNIX like

#
# Copyright (c) 1996 The Regents of the University of California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose, without fee, and without written agreement
# is hereby granted, provided that the above copyright notice and the
# following two paragraphs appear in all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
# OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE
# UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
#
# $Id: ui-network.tcl,v 1.2 1997/01/11 20:25:20 aswan Exp $


proc warn s {
    puts stderr "rtpmon: $s"
}

proc init-network {} {
    global mon
    
    set dst [split [resource defaultHostSpec] /]
    set n [llength $dst]

    if { $n < 2 } {
	warn "must specify both address and port in the form addr/port"
	exit 1
    }

    set addr [lindex $dst 0]
    set port [lindex $dst 1]
    if { ![string match \[0-9\]* $port] || $port >= 65536 } {
	warn "illegal port '$port'"
	exit 1
    }
    set port [expr ($port & ~1) + 1]
	     
    set net [new network ip]
    if { $net == "" } {
	warn "error creating network"
	exit 1
    }
    $net open $addr $port 1

    set mon [new monitor]
    if { $mon == "" } {
	warn "error creating monitor"
	exit 1
    }
    $mon net $net

    # crypt stuff?
}