Open Mash Cross Reference
mash/tcl/srmv2/bt-srmv2.tcl

   # bt-srmv2.tcl --
   #
   #       FIXME: This file needs a description here.
   #
   # Copyright (c) 1998-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.
  
  Class BulkTransfer -superclass { Application }
  
  BulkTransfer instproc init { ab logfile peakrate {dirname ""}} {
          $self next bulk_transfer
          $self configure
          $self init-net $ab $logfile $peakrate
          $self instvar receiver_ pending_
  
          set pending_ ""
          if {$dirname != ""} {
                  foreach filename [glob "$dirname/*.tcl"] {
                          $self read-file $filename
                  }
                  set receiver_ 0
          } else {
  #               puts "Receiver"
                  set receiver_ 1
          }
  }
  
  BulkTransfer instproc configure {  } {
          $self instvar options_ blksz_ cwd_ root_
  
          set cwd_ [string trimright [pwd] "/"]
  
          set config [new Configuration]
          $self set options_ $config
  
          set root_ "/var/tmp/mftp/"
          set blksz_ 1000
  }
  
  BulkTransfer instproc init-net { ab logfile rate } {
          $self instvar srmv2_ options_
  
          set ab [$options_ parse_args $ab]
          set srmv2_(manager) [new SRMv2_Manager/Text $ab]
          set srmv2_(session) [$srmv2_(manager) set session_]
          $srmv2_(session) log-file $logfile
          $srmv2_(session) peak-rate $rate
          $srmv2_(session) c1_ 2.0
          $srmv2_(session) c2_ 0.0
  
          $srmv2_(session) set-manager $srmv2_(manager)
          $srmv2_(manager) session $srmv2_(session)
          $srmv2_(session) start-announce
          $srmv2_(manager) application $self
  }
  
  BulkTransfer instproc select-file { } {
  #       set f [Dialog transient FileDialog]
  #       return $f
          return "/usr/home/mccanne/suchi/srmv2/mash/tcl/srmv2/session-srmv2.tcl"
  }
  
  # Application simply hands SRMv2 a humungous file.
  BulkTransfer instproc read-file { filename } {
          $self instvar srmv2_ blksz_ cwd_
          $self instvar cid_ flen_ ss_
  
          set source [$srmv2_(session) local-source]
          set comps [split $filename "/"]
          set cid 0
          for {set i 0} {$i < [llength $comps]} {incr i} {
                  set cid [$source calloc $cid [lindex $comps $i]]
          }
  #       puts "read-file $filename"
          if {$filename != ""} {
                  set ss 0
                 set flen [file size $filename]
                 set cid_($filename) $cid
                 set flen_($filename) $flen
                 set ss_($filename) $ss
                 $self enqueue $filename $ss 0 [expr $flen -1]
                 incr ss
         }
 }
 
 BulkTransfer instproc enqueue {aduname seqno ss es} {
         $self instvar pending_ srmv2_ cid_
         set qlen [llength $pending_]
         set aduname [string trimleft $aduname "/"]
         set idx [lsearch -exact $pending_ "$aduname,$seqno,$ss,$es"]
         if {$idx < 0} {
 #               puts "Enqueue $aduname $seqno $ss $es"
                 set pending_ [lappend pending_ "$aduname,$seqno,$ss,$es"]
         }
         # If the pending queue is empty, wake up the
         # SRMv2 session to set a timer, and call us back.
         if {$qlen == 0} {
 #               puts "\n @@@ req-send aduname $aduname \n"
                 $srmv2_(session) req-send $cid_($aduname) $seqno $ss $es
         }
 }
 
 # This application ignores 'seqno'
 BulkTransfer instproc handle {nm seqno blk} {
         $self instvar root_
         if {$nm == "/map"} {
                 return
         }
 #       puts "$nm ::"
         set filename "$root_/$nm"
         set index [string last "/" $filename]
         set dir [string range $filename 0 [expr $index-1]]
         set fname [string range $filename [expr $index+1] end]
         exec mkdir -p $dir
         set fd [open $filename w]
         puts -nonewline $fd $blk
         close $fd
 }
 
 BulkTransfer instproc reada { nm seqno } {
         # This application ignores 'seqno'
         $self instvar receiver_ pending_ cid_ flen_ ss_ srmv2_
         if {$nm == "/map"} {
                 return
         }
         if {$receiver_ == 0} {
                 set nm [string trimleft $nm /]
                 set idx [lsearch -glob $pending_ "$nm,*"]
                 set request ""
                 if {$idx >= 0} {
                         set request [lindex $pending_ $idx]
                         set pending_ [lreplace $pending_ $idx $idx]
                 }
                 # If there is a next ADU in the pending queue,
                 # schedule it for transmission.
                 if {[llength $pending_] > 0} {
                         set nxt [split [lindex $pending_ 0] ","]
                         set filename [string trimleft [lindex $nxt 0] /]
                         set seqno [lindex $nxt 1]
                         set ss [lindex $nxt 2]
                         set es [lindex $nxt 3]
                         if {$filename != ""} {
 #                               puts "\n **** ($nm) req-send aduname $filename $ss-$es\n"
                                 $srmv2_(session) req-send $cid_($filename) $seqno \
                                                 $ss $es
                         }
                 }
                 set filename "[pwd]/$nm"
                 set index [string last "/" $filename]
                 set dir [string range $filename 0 [expr $index-1]]
                 set fname [string range $filename [expr $index+1] end]
                 set fd [open $filename r]
                 set data [read $fd]
                 close $fd
                 return $data
         } else {
                 return ""
         }
 }
 
 
 BulkTransfer instproc recover { nm start end } {
         # This example simply ignore 'start' and 'end'
         # ADU sequence numbers.
         if [string match *Remote*.tcl $nm] {
                 return 0
         } else {
                 return 1
         }
 }