core/implementation/Server.tcl


@implementation Server {
 - init {} {
     $super init
     set logfile server.log
   }

 - start {} {
      if [catch {set socket \
        [socket -server [list $self handleNewConnection] $port]} err] {
        puts stderr "couldn't bind server socket at port $port ($err)"
        return
      }
      if [catch {winfo geometry .} err] {
        set forever 1
        catch {vwait forever}
      }
    }

  - stop {} {
      return [$self close]
    }

  - status {} {
      if [$self isAlive] { return up } else { return down }
    }

  - handleNewConnection {aSocket anAddress aPort} {
      fconfigure $aSocket -buffering line
      fileevent $aSocket r "$self getMessageFromSocket: $aSocket \
                                               address: $anAddress \
                                               andPort: $aPort"
    }

  - getMessageFromSocket:address:andPort: {aSocket anAddress aPort} {
      if [catch {gets $aSocket line} err] {
        catch {close $aSocket}
      }
      if [eof $aSocket] {
        catch {close $aSocket}
        return
      }
      if {$encrypted} { line decrypt }
      return [$self handleRequest: $line \
                       fromSocket: $aSocket \
                          address: $anAddress \
                          andPort: $aPort]
    }

  - handleRequest:fromSocket:address:andPort: \
      {aRequest aSocket anAddress aPort} {
      puts stderr "request:\"$aRequest\" from: $anAddress port: $aPort"
      switch -exact -- [string tolower $aRequest] {
        quit -
        exit -
        default { catch {close $aSocket} }
      }
    }

  - logfile: aFileName {
      set logfile $aFileName
    }

  - logfile {} {
      return $logfile
    }

  - send:to: {msg sock} {
      if {$encrypted} {
        msg encrypt
      }
      puts $sock $msg
      flush $sock
    }
}