test/send-one-bundle.tcl
changeset 0 2b3e5ec03512
equal deleted inserted replaced
-1:000000000000 0:2b3e5ec03512
       
     1 #
       
     2 #    Copyright 2004-2006 Intel Corporation
       
     3 # 
       
     4 #    Licensed under the Apache License, Version 2.0 (the "License");
       
     5 #    you may not use this file except in compliance with the License.
       
     6 #    You may obtain a copy of the License at
       
     7 # 
       
     8 #        http://www.apache.org/licenses/LICENSE-2.0
       
     9 # 
       
    10 #    Unless required by applicable law or agreed to in writing, software
       
    11 #    distributed under the License is distributed on an "AS IS" BASIS,
       
    12 #    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
       
    13 #    See the License for the specific language governing permissions and
       
    14 #    limitations under the License.
       
    15 #
       
    16 
       
    17 test::name send-one-bundle
       
    18 net::default_num_nodes 2
       
    19 
       
    20 dtn::config
       
    21 
       
    22 set clayer tcp
       
    23 set length 5000
       
    24 
       
    25 set link_vars {hexdump prevhop_hdr segment_length  \
       
    26         test_read_delay test_write_delay test_read_limit test_write_limit}
       
    27 array set link_opts {}
       
    28 
       
    29 foreach {var val} $opt(opts) {
       
    30     if {$var == "-cl" || $var == "cl"} {
       
    31 	set clayer $val
       
    32     } elseif {$var == "-length" || $var == "length"} {
       
    33         set length $val
       
    34     } else {
       
    35         set found 0
       
    36         foreach link_var $link_vars {
       
    37             if {$var == "-$link_var"} {
       
    38                 set link_opts($link_var) $val
       
    39                 set found 1
       
    40                 break
       
    41             }
       
    42         }
       
    43 
       
    44         if {$found} { continue }
       
    45         
       
    46         testlog error "ERROR: unrecognized test option '$var'"
       
    47         exit 1
       
    48     }
       
    49 }
       
    50 
       
    51 testlog "Configuring $clayer interfaces / links"
       
    52 dtn::config_interface $clayer
       
    53 
       
    54 set linkopts ""
       
    55 foreach {var val} [array get link_opts] {
       
    56     append linkopts "$var=$val "
       
    57 }
       
    58     
       
    59 dtn::config_linear_topology ALWAYSON $clayer true $linkopts
       
    60 
       
    61 test::script {
       
    62     testlog "Running dtnds"
       
    63     dtn::run_dtnd *
       
    64 
       
    65     testlog "Waiting for dtnds to start up"
       
    66     dtn::wait_for_dtnd *
       
    67     
       
    68     set last_node [expr [net::num_nodes] - 1]
       
    69     set source    [dtn::tell_dtnd $last_node {route local_eid}]
       
    70     set dest      dtn://host-0/test
       
    71     
       
    72     dtn::tell_dtnd 0 tcl_registration $dest
       
    73     
       
    74     testlog "Sending bundle"
       
    75     set timestamp [dtn::tell_dtnd $last_node sendbundle $source $dest length=$length]
       
    76     
       
    77     testlog "Waiting for bundle arrival"
       
    78     dtn::wait_for_bundle 0 "$source,$timestamp" 30
       
    79 
       
    80     testlog "Checking bundle data"
       
    81     dtn::check_bundle_data 0 "$source,$timestamp" \
       
    82 	    is_admin 0 source $source dest $dest
       
    83     
       
    84     testlog "Doing sanity check on stats"
       
    85     for {set i 0} {$i <= $last_node} {incr i} {
       
    86 	dtn::wait_for_bundle_stats $i {0 pending}
       
    87 	dtn::wait_for_bundle_stats $i {0 expired}
       
    88 	dtn::wait_for_bundle_stats $i {1 received}
       
    89     }
       
    90     
       
    91     dtn::wait_for_bundle_stats 0 {1 delivered}
       
    92     
       
    93     for {set i 1} {$i <= $last_node} {incr i} {
       
    94 	set outgoing_link $clayer-link:$i-[expr $i - 1]
       
    95 	dtn::wait_for_bundle_stats $i {1 transmitted}
       
    96 	dtn::wait_for_link_stat $i $outgoing_link 1 bundles_transmitted
       
    97 	dtn::wait_for_link_stat $i $outgoing_link 0 bundles_queued
       
    98 	dtn::wait_for_link_stat $i $outgoing_link 0 bytes_queued
       
    99     }
       
   100 	
       
   101     testlog "Test success!"
       
   102 }
       
   103 
       
   104 test::exit_script {
       
   105     testlog "Stopping all dtnds"
       
   106     dtn::stop_dtnd *
       
   107 }