core/implementation/RemoteInvocationServer.tcl


@implementation RemoteInvocationServer {
 - init {} {
     $super init
     set logfile RemoteInvocationServer.log
     set pool [AutoReleasePool new]
     set commands(permit) [set commands(deny) {}]
   }

 - handleRequest:fromSocket:address:andPort: \
     {aRequest aSocket anAddress aPort} {
      switch -regexp -- [string tolower $aRequest] {
        {^@rmi } {
          set cmd [join [lrange [split $aRequest] 1 end]]
          set err [$self executeCommand: $cmd \
                             fromSocket: $aSocket \
                                address: $anAddress \
                                andPort: $aPort]
          $self send: $err to: $aSocket
        }
        default {
          $self send: "unknown request" to: $aSocket
        }
      }
    }

  - executeCommand:fromSocket:address:andPort: \
      {aCommand aSocket anAddress aPort} {

      set result "command not allowed"

      set msg "$anAddress:$aPort -> "
      append msg $aCommand
      @log $logfile $msg

      foreach cmd $commands(deny) {
        if [regexp $cmd $aCommand] {
          return $result
        }
      }
      foreach cmd $commands(permit) {
        if [regexp $cmd $aCommand] {
          catch {eval $aCommand} result
          return $result
        }
      } 
      return $result
    }

  - dealloc {} {
      $pool release
      return [$super dealloc]
    }

  - permit: aCommand {
      if {![commands(permit) contains: $aCommand]} {
        lappend commands(permit) $aCommand
      }
    }

  - deny: aCommand {
      if {![commands(deny) contains: $aCommand]} {
        lappend commands(deny) $aCommand
      }
    }

  - permittedCommands {} {
      return $commands(permit)
    }

  - permittedCommands: permittedCommands {
      set commands(permit) $permittedCommands
    }

  - deniedCommands {} {
      return $commands(deny)
    }

  - deniedCommands: deniedCommands {
      set commands(deny) $deniedCommands
    }
}