# 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
        }
    }