Open Mash Cross Reference
mash/tcl/indiva/imgr/imgr-httpd.tcl

   import Httpd
   import IMgrHTML
   Class IMgrHttpd -superclass Httpd
   
   IMgrHttpd instproc init { mgr root port } {
       $self set imgroot_ "[$self get_option webroot]/images"
       $self set show_edges_ 0
       $self next $root $port ""
       $self set mgr_ $mgr
      $self set h_ [new IMgrHTML]
      $self set mimetype_() "text/html"
  }
  
  
  IMgrHttpd instproc respond { sock } {
      $self instvar config_ urlcache_
      upvar #0 Httpd$sock data
      #puts [array get data]
  
      regsub {(^http://[^/]+)?} $data(url) {} url
      if {[info exists urlcache_($url)]} {
          set mypath $urlcache_($url)
      } else {
          set mypath [$self url2file $config_(root) $url]
          # There is no default file in Indiva.
          #if {[file isdirectory $mypath]} {
          #    append mypath / $config_(default)
          #}
          set urlcache_($url) $mypath
      }
      if {[string length $mypath] == 0} {
          $self error $sock 400
      } elseif {![file readable $mypath]} {
          $self exec $sock $mypath
      } else {
          $self instvar mgr_
          if {![$mgr_ exists $mypath]} {
              $self exec $sock $mypath
          } else {
              $self output $sock [$self mob2html $sock $mypath]
          }
      }
  }
  
  IMgrHttpd instproc exec { sock command } {
      upvar #0 Httpd$sock data
      set command [lindex [split $command /] end]
      if [catch {eval $self $command $sock}] {
          global errorInfo
          puts $errorInfo
          $self error $sock 400
          return
      }
  }
  
  IMgrHttpd instproc services {sock} {
      upvar #0 Httpd$sock data
      
      $self instvar mgr_ h_
      set drivers [$mgr_ array names services_]
  
      set result "<h2>Services in Indiva</h2>"
  
      append result "<p><table class=flow cellspacing=0 cellpadding=2 width=100%>"
      foreach d $drivers {
          set list [split $d ,]
          append result "<tr>"
          append result "<td class=flowkey valign=top align=right>[short_name [lindex $list 0]]</td>"
          append result "<td class=flowkey valign=top align=right>[short_name [lindex $list 1]]</td>"
          append result "<td class=flowkey valign=top align=right>[short_name [lindex $list 2]]</td>"
          append result "<td>[[$mgr_ set ascp_($d)] service_location]</td></tr>"
      }
      append result "</table></p>"
  
      set result [$h_ html [$h_ head  [$h_ body $result] ] ]
  
      $self output $sock $result
  }
  
  
  IMgrHttpd instproc servents {sock} {
      upvar #0 Httpd$sock data
      
      $self instvar mgr_ h_
      set drivers [$mgr_ array names servents_]
  
      set result "<h2>Servents</h2>"
  
      append result "<p><table class=flow cellspacing=0 cellpadding=2 width=100%>"
      foreach d $drivers {
          append result "<tr>"
          append result "<td class=flowkey>$d</td>"
          append result "<td>[$mgr_ set servents_($d)]</td></tr>"
      }
      append result "</table></p>"
  
      set result [$h_ html [$h_ head  [$h_ body $result] ] ]
  
      $self output $sock $result
 }
 
 IMgrHttpd instproc flow {sock} {
     upvar #0 Httpd$sock data
     
 #   foreach {key value} [split $data(query) =&] {
 #       puts "$key is $value"
 #   }
 
     $self instvar mgr_
     set flows [$mgr_ flow ls]
 
     set result "<h2>Flows</h2>"
 
     foreach flow $flows {
         append result "<p><table class=flow cellspacing=0 cellpadding=2 width=100%>"
         foreach {key value} $flow {
             if {$key != "Flow Segments"} {
                 append result "<tr><td class=flowkey valign=top align=right><b>$key</b></td>"
                 append result "<td class=flowvalue>[short_name $value]</td></tr>"
             } else {
                 append result "<tr><td class=flowkey valign=top align=right><b>$key</b></td>"
                 append result "<td><table class=flowvalue cellpadding=3 cellspacing=0 width=100%>"
                 set from [lindex [lindex $value 0] 0]
                 set name [short_name $from]
                 append result "<tr><td class=flowsegment><a href=$name>$name</a></td></tr>\n"
                 foreach {from to service} $value {
                     append result "<td class=flowsegment>&nbsp;&nbsp;&nbsp;"
                     append result "<img src=http://www.bmrc.berkeley.edu/~weitsang/indiva/images/downarrow.gif align=middle>"
                     append result "&nbsp;<small><i><font color=#666699>$service</font></small></i></td></tr>"
                     set name [short_name $to]
                     append result "<td class=flowsegment><a href=$name>$name</a></td></tr>"
                 }
                 append result "</table></td>"
             }
         }
         append result "</table></p>"
     }
     $self instvar h_
     set result [$h_ html [$h_ head  [$h_ body $result] ] ]
 
     $self output $sock $result
 }
 
 
 
 IMgrHttpd instproc output {sock msg} {
     upvar #0 Httpd$sock data
 
     puts $sock "HTTP/1.$data(version) 200 Data follows"
     puts $sock "Date: [$self date [clock seconds]]"
     puts $sock "Last-Modified: [$self date [clock seconds]]"
     puts $sock "Content-Type: text/html"
     puts $sock "Content-Length: [string length $msg]"
 
     set close [expr {$data(left) == 0}]
 
     if {$close} {
         puts $sock "Connection close:"
     } elseif {$data(version) == 0 && [info exists data(mime,connection)]} {
         if {$data(mime,connection) == "Keep-Alive"} {
             set close 0
             puts $sock "Connection: Keep-Alive"
         }
     }
     puts $sock ""
     if {$data(proto) != "HEAD"} {
         fconfigure $sock -translation binary
         puts $sock $msg
         flush $sock
         $self sockdone $sock $close
     } else {
         $self sockdone $sock $close
     }
 }
 
 
 IMgrHttpd instproc flow2html { sock mob } {
 }
 
 # print information about $mob
 IMgrHttpd instproc mob2html { sock mob } {
     upvar #0 Httpd$sock data
     $self instvar mgr_
 
 
     # print name of $mob, with links to parent directories.
     set dirs [file split [short_name $mob]]
     set href "/"
     set name "<a href=/>/</a>"
     foreach dir [lrange $dirs 1 end] {
         if {$href != "/"} {
             append href /
             append name /
         }
         append href $dir
         append name "<a href=$href>$dir</a>"
     }
 
     set result "<h2>$name</h2>"
 
     # print attributes about $mob.
     set attributes [$mgr_ info $mob]
     if {$attributes != ""} {
         append result "<h3>Attributes</h3>"
         append result "<p>"
         append result "<table class=attr cellspacing=0 cellpadding=3>"
         foreach {key value} $attributes {
             append result "<tr><td class=attrkey><b>$key</b></td>"
             if {$value == ""} { set value "&nbsp;"}
             append result "<td class=attrvalue>$value</td></tr>"
         }
         append result "</table>"
         append result "</p>"
     }
 
     # Show interconnection in graph.
     $self instvar show_edges_
     if {$show_edges_} {
         append result "<h3>Outgoing Edges</h3>"
         append result "<p>"
         append result "<table cellpadding=4>"
         set graph [$mgr_ set mob_graph_]
         set node [$graph get_node $mob]
         foreach n [$graph get_out_neighbors $mob] {
             set name [short_name $n]
             append result "<tr><td align=right bgcolor=#eeeeff><a href=$name>$name</a></td>"
             set e [$graph get_edge $mob $n]
             append result "<td align=left bgcolor=#eeeeee>[$e cost]</td></tr>"
         }
         append result "</table>"
         append result "</p>"
 
         append result "<h3>Incoming Edges</h3>"
         append result "<p>"
         append result "<table cellpadding=4>"
         set node [$graph get_node $mob]
         foreach n [$graph get_in_neighbors $mob] {
             set name [short_name $n]
             append result "<tr><td align=right bgcolor=#eeeeff><a href=$name>$name</a></td>"
             set e [$graph get_edge $n $mob]
             append result "<td align=left bgcolor=#eeeeee>[$e cost]</td></tr>"
         }
         append result "</table>"
         append result "</p>"
     }
 
     if {[$mgr_ isdir $mob]} {
         set content [exec ls $mob]
 
         # find a list of all keys
         set keys ""
         foreach c $content {
             foreach {key value} [$mgr_ info $mob/$c] {
                 lappend keys $key
                 set values($c,$key) $value
             }
         }
         set keys [lsort -unique $keys]
 
         # print the content of the directory.
         if {$content != ""} {
             append result "<h3>Content</h3>"
             append result "<p>"
             append result "<table class=content width=100% cellspacing=0 cellpadding=3>"
             append result "\n<tr>"
             append result "<td class=conthead><b>name</b></td>"
             foreach key $keys {
                 append result "<td class=conthead><b>$key</b></td>"
             }
             append result "<td class=conthead>&nbsp;</td>"
             append result "</tr>\n"
 
             foreach c $content {
                 set type [$mgr_ info $mob/$c -class]
                 if {$type != ""} {
                     $self instvar imgroot_
                     set img "<img align=middle src=$imgroot_/$type.gif>&nbsp;&nbsp;"
                 } else {
                     set img ""
                 }
                 append result "<tr><td class=\"contvalue\" nobr><nobr>$img<a href=\"$c\">$c</a></nobr></td>"
                 foreach key $keys {
                     if [info exists values($c,$key)] {
                         append result "<td class=\"contvalue\" nobr><nobr>$values($c,$key)</nobr></td>"
                     } else {
                         append result "<td class=\"contvalue\" nobr><b>&nbsp;</b></td>"
                     }
                 }
                 append result "<td class=contvalue width=100%>&nbsp;</td>"
                 append result "</tr>"
             }
             append result "</table>"
             append result "</p>"
         }
     }
 
     append result "
 
             </body>
         </html>"
 
     $self instvar h_
     set result [$h_ html [$h_ head "<base href=http://$data(mime,host)$data(url)/>"] [$h_ body $result]]
     return $result
 }