Open Mash Cross Reference
mash/tcl/psvp/fx_forward/front_end.tcl

   # front_end.tcl --
   #
   #       FIXME: This file needs a description here.
   #
   # Copyright (c) 1999-2002 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:
  #
  # A. Redistributions of source code must retain the above copyright notice,
  #    this list of conditions and the following disclaimer.
  # B. 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.
  # C. Neither the names of the copyright holders nor the names of its
  #    contributors may be used to endorse or promote products derived from this
  #    software without specific prior written permission.
  #
  # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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.
  
  import RTPApplication
  import GraphComm
  import FAgent
  
  Class FXForwardFrontEnd -superclass RTPApplication
  
  FXForwardFrontEnd instproc init {args} {
      $self next fx_forw_front_end
  
      $self init_resources
  
      puts "Args = $args"
      eval [$self options] parse_args $args;
  
      $self instvar service_al_;
  
      set service_al_ [new AnnounceListenManager/AS/Service/FrontEnd $self [$self get_option as_spec] [$self get_option as_bw] [$self get_option serv_inst]];
  
  
      $self instvar from_cntrl_obj_
      $self instvar to_cntrl_obj_
  
      set from_cntrl_spec [split [$self get_option from_cntrl] "/"]
      set from_addr [lindex $from_cntrl_spec 0];
      set from_port [lindex $from_cntrl_spec 1];
      set from_ttl [lindex $from_cntrl_spec 2];
  
      set from_cntrl_obj_ [new GraphComm/Front/From $self [$self get_option comm_id] $from_addr $from_port $from_ttl];
  
      set to_cntrl_spec [split [$self GenerateNewTunnelSpec]/16 "/"]
      set to_addr [lindex $to_cntrl_spec 0];
      set to_port [lindex $to_cntrl_spec 1];
      set to_ttl [lindex $to_cntrl_spec 2];
  
      $self instvar back_host_;
      set back_host_ ""
  
      set to_cntrl_obj_ [new GraphComm/Front/To $self [$self get_option comm_id] $to_addr $to_port $to_ttl];
  
      $from_cntrl_obj_ install $to_cntrl_obj_
      $to_cntrl_obj_ install $from_cntrl_obj_
  
      $self instvar back_end_starter_conn_
  
      set back_end_starter_conn_ [socket [$self get_option back_end_starter_addr] [$self get_option back_end_starter_port]];
  
      puts $back_end_starter_conn_ "start -num_nodes [$self get_option num_nodes] -subprogram [$self get_option subprogram] -from_cntrl ${to_addr}/${to_port} "
      flush $back_end_starter_conn_
      puts "here"
  
  }
  
  FXForwardFrontEnd instproc back_host {} {
      $self instvar back_host_;
  
      return $back_host_;
  }
  
  FXForwardFrontEnd instproc set_back_host {host} {
      $self instvar back_host_;
  
      set back_host_ $host;
  }
  
  FXForwardFrontEnd instproc init_resources {} {
      $self add_option num_nodes 4
      $self add_option subprogram ""
      $self add_option from_cntrl 224.3.2.1/22334/16
      $self add_option as_spec 224.4.5.24/50000/16
     $self add_option as_bw 20000
     $self add_option serv_inst temp_fx_app
     $self add_option network ip
     $self add_option mtu 1024
     $self add_option defaultTTL 32
     $self add_option sessionType rtpv2
     $self add_option maxVideoSessionBW 30000000
     $self add_option back_end_starter_addr u4
     $self add_option back_end_starter_port 20004
 
     set hname [exec hostname];
     set pid [pid];
 
     $self add_option comm_id ${hname}.${pid};
 
     [$self options] register_option -from_cntrl from_cntrl
     [$self options] register_option -num_nodes num_nodes
     [$self options] register_option -subprogram subprogram
     [$self options] register_option -cntrl_spec from_cntrl
     [$self options] register_option -as_spec as_spec
     [$self options] register_option -as_bw as_bw
     [$self options] register_option -serv_inst serv_inst
     [$self options] register_option -megactrl as_spec
     [$self options] register_option -back_end_addr back_end_starter_addr
     [$self options] register_option -back_end_port back_end_starter_port
 
 }
 
 FXForwardFrontEnd instproc exit {} {
     $self instvar back_end_starter_conn_
 
     close $back_end_starter_conn_
     puts "Need to cleanup and exit!"
 }
 
 FXForwardFrontEnd instproc GenerateNewTunnelSpec {} {
     $self instvar used_ports_;
 
     set new_port [expr (int(rand() * 10000)*2) + 5000];
     while {[info exists used_ports_($new_port)]} {
         set new_port [expr (int(rand() * 10000)*2) + 5000];
     }
     set used_ports_($new_port) 1;
     return "[exec hostname]/$new_port"
 }
 
 
 Class GraphComm/Front -superclass GraphComm
 
 GraphComm/Front instproc init {app id addr port ttl} {
     $self next $id $addr $port
 
     $self instvar app_
 
     set app_ $app;
 
     $self instvar dest_;
 
     set dest_ ""
 }
 
 GraphComm/Front instproc install {dest} {
     $self instvar dest_;
 
     set dest_ $dest;
 }
 
 GraphComm/Front instproc recv_trigger_command {cmd} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
 
     $dest_ send_trigger_command $cmd
 }
 
 GraphComm/Front instproc recv_misc {cmd} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
 
     $dest_ send_misc $cmd
 }
 
 GraphComm/Front instproc recv_debug {data} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
 
     $dest_ send_debug $data
 }
 
 GraphComm/Front instproc new_input {new_name} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
     $self next $new_name
 
     $dest_ create_input $new_name
 }
 
 GraphComm/Front instproc new_output {new_name} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
     $self next $new_name
 
     $dest_ create_output $new_name
 }
 
 GraphComm/Front instproc new_parameter {new_name} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
     $self next $new_name
 
     $dest_ create_parameter $new_name
 }
 
 GraphComm/Front instproc new_input_attribute {input_name attr_name} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
     $self next $input_name $attr_name
 
     $dest_ create_input_attr $input_name $attr_name
 }
 
 GraphComm/Front instproc new_output_attribute {output_name attr_name} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
     $self next $output_name $attr_name
 
     $dest_ create_output_attr $output_name $attr_name
 }
 
 GraphComm/Front instproc new_parameter_attribute {parameter_name attr_name} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
     $self next $parameter_name $attr_name
 
     $dest_ create_parameter_attr $parameter_name $attr_name
 }
 
 GraphComm/Front instproc update_input_attr_value {input_name attr_name value} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
     $self next $input_name $attr_name $value
 
     $dest_ set_input_attr $input_name $attr_name $value
 }
 
 GraphComm/Front instproc update_output_attr_value {output_name attr_name value} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
     $self next $output_name $attr_name $value
 
     $dest_ set_output_attr $output_name $attr_name $value
 }
 
 GraphComm/Front instproc update_parameter_attr_value {parameter_name attr_name value} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
     $self next $parameter_name $attr_name $value
 
     $dest_ set_parameter_attr $parameter_name $attr_name $value
 }
 
 GraphComm/Front instproc set_input_attr {input_name attr_name value} {
     $self create_input $input_name
     $self create_input_attr $input_name $attr_name
     $self next $input_name $attr_name $value
 }
 
 GraphComm/Front instproc set_output_attr {output_name attr_name value} {
     $self create_output $output_name
     $self create_output_attr $output_name $attr_name
     $self next $output_name $attr_name $value
 }
 
 GraphComm/Front instproc set_parameter_attr {parameter_name attr_name value} {
     $self create_parameter $parameter_name
     $self create_parameter_attr $parameter_name $attr_name
     $self next $parameter_name $attr_name $value
 }
 
 Class GraphComm/Front/From -superclass GraphComm/Front
 
 GraphComm/Front/From instproc update_input_attr_value {input_name attr_name value} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
 
     $self instvar app_
 
     if {[$app_ back_host] == ""} {
         return;
     }
 
     if {$attr_name == "spec"} {
         set split_spec [split $value "/"];
         set addr [lindex $split_spec 0];
         set port [lindex $split_spec 1];
         set srcid [lindex $split_spec 2];
 
         $self instvar tunnels_
         if {[info exists tunnels_($addr,$port)]} {
             set fagent $tunnels_($addr,$port);
             set tunnel_spec $tunnel_specs_($addr,$port);
         } else {
             set tunnel_spec [$app_ GenerateNewTunnelSpec];
             set tunnel_port [lindex [split $tunnel_spec "/"] 1]
             set fagent [new FAgent $app_ "${addr}/${port}" [$app_ back_host]/$tunnel_port];
             set tunnels_($addr,$port) $fagent;
             set tunnel_specs_($addr,$port) $tunnel_spec;
         }
         if {$srcid != "*"} {
             $fagent install_src_callback $srcid "$self complete_input_setup $srcid $fagent $input_name $tunnel_spec"
             return;
         } else {
             set value "${tunnel_spec}/*";
         }
     }
     $self next $input_name $attr_name $value;
 }
 
 GraphComm/Front/From instproc complete_input_setup {srcid fagent input_name tunnel_spec} {
     set new_id [$fagent translate_srcid $srcid];
 
     $self instvar dest_;
 
     $dest_ set_input_attr $input_name spec "${tunnel_spec}/${new_id}"
 }
 
 GraphComm/Front/From instproc update_output_attr_value {output_name attr_name value} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
 
     $self instvar app_
 
     if {$attr_name == "spec"} {
         $self instvar out_tunnels_
         $self instvar out_tunnel_specs_
 
         if {[info exists out_tunnels_($value)]} {
             set fagent $out_tunnels_($value);
             set tunnel_spec $out_tunnel_specs_($value);
         } else {
             set tunnel_spec [$app_ GenerateNewTunnelSpec];
             set fagent [new FAgent $app_ $tunnel_spec $value];
             set out_tunnels_($value) $fagent;
             set out_tunnel_specs_($value) $tunnel_spec;
         }
         set value $tunnel_spec
     }
     $self next $output_name $attr_name $value;
 }
 
 
 Class GraphComm/Front/To -superclass GraphComm/Front
 
 GraphComm/Front/To instproc recv_misc {cmd} {
     if {[lindex $cmd 0] == "set_back_host"} {
         $self instvar app_;
 
         $app_ set_back_host [lindex $cmd 1];
     } else {
         $self next $cmd;
     }
 }
 
 import AnnounceListenManager/AS/Service
 
 Class AnnounceListenManager/AS/Service/FrontEnd -superclass AnnounceListenManager/AS/Service
 
 AnnounceListenManager/AS/Service/FrontEnd instproc unregister { atype aspec addr srv_name srv_inst msg } {
         $self instvar agentbytype_ srv_inst_ agenttab_
 
         # If we are alive and a client with a different SID died --
         # no need to check.
         if { $atype != "client" || $srv_inst != $srv_inst_ } {
                 return
         }
         foreach aspec $agentbytype_(client) {
                 set sid [lindex $agenttab_($aspec) 4]
                 if { $sid == $srv_inst_ } {
                         # Still have a client
                         return
                 }
         }
         # No clients with our SID, exit
 
         puts stderr "no more clients -- exiting"
 
         $self instvar agent_
 
         $agent_ exit;
 }
 
 AnnounceListenManager/AS/Service/FrontEnd instproc service_name {} {
     return "FXForwardFrontEnd"
 }
 
 AnnounceListenManager/AS/Service/FrontEnd instproc send_announcement {} {
     puts "FrontEnd sending announcement"
     $self next
 }
 
 AnnounceListenManager/AS/Service/FrontEnd instproc recv_mesg {args} {
 
     puts "FrontEnd recv_mesg: $args"
     eval $self next $args
 }
 
 set app [new FXForwardFrontEnd $argv];
 
 puts "Started"
 
 if {![info exists tk_version]} {
     vwait forever;
 }