core/implementation/HttpServer.tcl


@implementation HttpServer {
  - init {} {
      $super init
      set port 80
      set encrypted 0
      set root web
      set logfile HttpServer.log
    }

  - root: aRootDirectory {
      set root $aRootDirectory
    }

  - root {} {
      return $root
    }

  - handleRequest:fromSocket:address:andPort: {
      aRequest aSocket anAddress aPort
    } {
      set msg "$anAddress:$aPort -> "
      append msg $aRequest
      @log $logfile $msg

      set request [lindex [split $aRequest] 0]

      if {![string compare [string toupper $request] GET]} {
        set page [lreplace $aRequest 0 0]
        set page [lreplace $page end end]
        set mode [lindex [split $aRequest] end]

        #- removing heading /
        if [regexp {^[/]+([^$]+)$} $page -> page] {}

        return [$self sendPage: $page \
                      toSocket: $aSocket \
                    forAddress: $anAddress \
                       andPort: $aPort]
      }
      catch {
        puts $aSocket \
          "<HTML><BODY BGCOLOR=WHITE><FONT COLOR=RED>Error</FONT></BODY></HTML>"
        close $aSocket
      }
      return
    }

  - sendPage:toSocket:forAddress:andPort: {
      aPage aSocket anAddress aPort
    } {
      if {"$aPage" == "/"} {
        set aPage [file join $root index.html]
      } elseif [file exists [file join $root $aPage]] {
        set aPage [file join $root $aPage]
      }
      if [file owned $aPage] {
        if [catch {
          set f [open $aPage r]
          switch [file extension $aPage] {
            default { 
              fconfigure $f -translation binary 
              fconfigure $aSocket -translation binary 
            }
          }
          puts $aSocket [read $f]
          close $f
          close $aSocket
        } err] {
          @log $logfile "$err"
        } else {
          return
        }
      }
      catch {close $aSocket}
      return
    }
}