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

   # back_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 FXForwardBackEnd -superclass RTPApplication
  
  FXForwardBackEnd instproc init {args} {
      $self next fx_forw_back_end
  
      $self init_resources
  
      puts "Args = $args"
      eval [$self options] parse_args $args;
  
      if {[$self get_option subprogram] == ""} {
          puts stderr "Must specify subprogram";
          exit;
      }
  
      $self instvar my_addr_ node_spec_ ts_pid_ ti_pid_ proc_pids_ my_port_
  
      set my_addr_ [string trim [exec hostname]];
      set habbr [lindex [split $my_addr_ .] 0];
      set my_port_ [$self get_option glurun_client_port];
  
      set server_fd_ [socket -server "$self handle_client_registration" $my_port_];
      set my_port_ [lindex [fconfigure $server_fd_ -sockname] 2];
  
      set node_spec_ all-${habbr}-clump0-clump1-clump2-clump3
      global env
      set env(GLUNIX_NODES) $node_spec_
  
      set ts_pid_ [$self StartProc [$self get_option ts_prog] -cntrl_spec [$self get_option to_cntrl]]
      set ti_pid_ [$self StartProc [$self get_option ti_prog] -cntrl_spec [$self get_option to_cntrl]]
  
      for {set p 0} {$p < [$self get_option num_nodes]} {incr p} {
          set proc_pids_($p) [$self StartProc [$self get_option proc_prog] -subprogram [$self get_option subprogram] -reg_comm_spec [$self get_option to_cntrl]];
      }
  
      $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/Back/From $self [$self get_option comm_id] $from_addr $from_port $from_ttl];
  
      set to_cntrl_spec [split [$self get_option to_cntrl] "/"]
      set to_addr [lindex $to_cntrl_spec 0];
      set to_port [lindex $to_cntrl_spec 1];
      set to_ttl [lindex $to_cntrl_spec 2];
  
      set to_cntrl_obj_ [new GraphComm/Back/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_
  
      $from_cntrl_obj_ send_misc "set_back_host [exec hostname]"
  
  }
  
  FXForwardBackEnd instproc init_resources {} {
      $self add_option num_nodes 4
      $self add_option subprogram ""
      $self add_option to_cntrl [$self GenerateNewTunnelSpec];
      $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 glurun_client_port 0
     $self add_option ts_prog /home/cs/kpatel/mash-code/production/tcl/psvp/test2/fx_tselect.tcl
     $self add_option ti_prog /home/cs/kpatel/mash-code/production/tcl/psvp/test2/fx_tinter.tcl
     $self add_option proc_prog /home/cs/kpatel/mash-code/production/tcl/psvp/test2/fx_proc.tcl
     $self add_option smash_bin /home/cs/kpatel/mash-code/production/smash
     $self add_option glurun_client /home/cs/kpatel/mash-code/production/tcl/psvp/demos/glurun-client.tcl
 
     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 -to_cntrl to_cntrl
     [$self options] register_option -num_nodes num_nodes
     [$self options] register_option -subprogram subprogram
 }
 
 FXForwardBackEnd instproc handle_client_registration {sfd addr port} {
     $self instvar client_sock_fd_;
 
     set client_sock_fd_ $sfd;
 }
 
 FXForwardBackEnd instproc StartProc {cmd args} {
     $self instvar client_sock_fd_ my_addr_ my_port_
 
     set client_sock_fd_ "";
 
     global env
     set env(TCL_LIBRARY) /home/cs/kpatel/mash-code/tcl8.0/library
     cd /home/cs/kpatel/mash-code/production
 
     set pid [eval exec glurun [$self get_option smash_bin] [$self get_option glurun_client] $my_addr_ $my_port_ $cmd $args >& /dev/null &];
 
     while {$client_sock_fd_ == ""} {
         update;
     }
 
     set client_host [gets $client_sock_fd_]
 
     $self instvar node_spec_
 
     set node_spec_ "$node_spec_-${client_host}"
     global env
     set env(GLUNIX_NODES) $node_spec_
 
     $self instvar pid_map_
 
     set pid_map_($pid) $client_sock_fd_;
 
     return $pid;
 }
 
 FXForwardBackEnd 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;
 
     set q1 228
     set q2 [expr int(rand() * 200) + 10]
     set q3 [expr int(rand() * 200) + 10]
     set q4 [expr int(rand() * 200) + 10]
 
     return "$q1.$q2.$q3.$q4/$new_port/16"
 }
 
 Class GraphComm/Back -superclass GraphComm
 
 GraphComm/Back instproc init {app id addr port ttl} {
     $self next $id $addr $port
 
     $self instvar app_
 
     set app_ $app;
 
     $self instvar dest_;
 
     set dest_ ""
 }
 
 GraphComm/Back instproc install {dest} {
     $self instvar dest_;
 
     set dest_ $dest;
 }
 
 GraphComm/Back instproc recv_trigger_command {cmd} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
 
     $dest_ send_trigger_command $cmd
 }
 
 GraphComm/Back instproc recv_misc {cmd} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
 
     $dest_ send_misc $cmd
 }
 
 GraphComm/Back instproc recv_debug {data} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
 
     $dest_ send_debug $data
 }
 
 GraphComm/Back instproc new_input {new_name} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
     $self next $new_name
 
     $dest_ create_input $new_name
 }
 
 GraphComm/Back instproc new_output {new_name} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
     $self next $new_name
 
     $dest_ create_output $new_name
 }
 
 GraphComm/Back instproc new_parameter {new_name} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
     $self next $new_name
 
     $dest_ create_parameter $new_name
 }
 
 GraphComm/Back 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/Back 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/Back 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/Back 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/Back 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/Back 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/Back 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/Back 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/Back 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/Back/From -superclass GraphComm/Back
 
 GraphComm/Back/From instproc update_input_attr_value {input_name attr_name value} {
     $self instvar dest_;
 
     if {$dest_ == ""} {
         return;
     }
 
     $self instvar app_
 
     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 fagent [new FAgent $app_ "${addr}/${port}" $tunnel_spec];
             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/Back/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}"
 }
 
 Class GraphComm/Back/To -superclass GraphComm/Back
 
 set app [new FXForwardBackEnd $argv];
 
 puts "Started"
 
 if {![info exists tk_version]} {
     vwait forever;
 }