home *** CD-ROM | disk | FTP | other *** search
/ Practical Programming in Tcl & Tk (4th Edition) / TCLBOOK4.BIN / pc / exsource.old / 19_8.tcl < prev    next >
Text File  |  2003-04-15  |  1KB  |  49 lines
  1. #
  2. # Example 19-8
  3. # The Safesock security policy.
  4. #
  5.  
  6. # The index is a host name, and the
  7. # value is a list of port specifications, which can be
  8. # an exact port number
  9. # a lower bound on port number: N-
  10. # a range of port numbers, inclusive: N-M
  11. array set safesock {
  12.     sage.eng                3000-4000
  13.     www.sun.com                80
  14.     webcache.eng                {80 8080}
  15.     bisque.eng                {80 1025-}
  16. }
  17. proc Safesock_PolicyInit {slave} {
  18.     interp alias $slave socket {} SafesockAlias $slave
  19. }
  20. proc SafesockAlias {slave host port} {
  21.     global safesock
  22.     if ![info exists safesock($host)] {
  23.         error "unknown host: $host"
  24.     }
  25.  
  26.     foreach portspec $safesock($host) {
  27.         set low [set high ""]
  28.         if {[regexp {^([0-9]+)-([0-9]*)$} $portspec x low high]} {
  29.             if {($low <= $port && $high == "") ||
  30.                     ($low <= $port && $high >= $port)} {
  31.                 set good $port
  32.                 break
  33.             }
  34.         } elseif {$port == $portspec} {
  35.             set good $port
  36.         }
  37.     }
  38.  
  39.     if [info exists good] {
  40.         set sock [interp invokehidden $slave socket $host $good]
  41.         interp invokehidden $slave fconfigure $sock \
  42.             -blocking 0
  43.         return $sock
  44.     }
  45.     error "bad port: $port"
  46. }
  47.  
  48.  
  49.