#
#	tkMOO
#	~/.tkMOO-lite/plugins/gateway.tcl
#

# tkMOO-light is Copyright (c) Andrew Wilson 1994,1995,1996,1997,1998
#
#       All Rights Reserved
#
# Permission is hereby granted to use this software for private, academic
# and non-commercial use. No commercial or profitable use of this
# software may be made without the prior permission of the author.
#
# THIS SOFTWARE IS PROVIDED BY ANDREW WILSON ``AS IS'' AND ANY
# EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL ANDREW WILSON BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
# OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

# This file contains code developed by Jay Carlson.

# This plugin overrides the default connection behaviour for the client
# allowing users to pass through a MITRE-like telnet gateway before
# connecting to the desired World.  Use of the gateway option is defined
# on a per-world basis using the 'Telnet Gateway' section of the
# Preferences Editor.  The client's normal behaviour is used by default.

# For reference, here's what a sample dialog with gatekeeper.mitre.org
# looks like:

# AC                 * * * Gatekeeper Telnet Proxy * * *
#     * * * Unauthorized use of this system is a Federal offense * * *
#   
#   This system is provided for MITRE business use only.  Please remember
#   that activity on this system may be captured in audits, logs and back ups 
#   as permitted by law.
# 
# To use the telnet proxy, type "connect [host/ip-address]" at the tn-gw prompt.
# tn-gw->
# at which point we send "co home.netscape.com 80" and get:
# ACX
# and then the connection begins.

client.register gateway start

# use the .start hook to set one-time global variables for this plugin
proc gateway.start {} {
    global gateway_tngw_gateway gateway_tngw_port gateway_tngw_debug \
        env
    set gateway_tngw_gateway "gatekeeper.mitre.org"
    set gateway_tngw_port 23
    set gateway_tngw_debug 0
    catch {set gateway_tngw_debug $env(TCL_TNGW_DEBUG)}
}

preferences.register gateway {Telnet Gateway} {
    { {directive UseGateway}
        {type boolean}
        {default Off} 
        {display "Use Telnet Gateway"} }
    { {directive GatewayHost}
        {type string}
        {default ""} 
        {default_if_empty}
        {display "Gateway Host"} }
    { {directive GatewayPort}
        {type string}
        {default ""} 
        {default_if_empty}
        {display "Gateway Port"} }
}

# Override the API
rename io.connect		gateway_io.connect
rename io.connect_session	gateway_io.connect_session

# try to connect to $host $port, returning 1/0 on success/failure if
# successful then reconfigure the socket, set the fileevent handler
# and call client.client_connected to tell the rest of the client that
# you're happy.

proc io.connect_session session {
    set use [worlds.get_generic Off {} {} UseGateway]

    if { [string tolower $use] == "on" } {
        set host [db.get $session host]
        set port [db.get $session port]
        set conn ""
        catch { set conn [gateway.tngw_socket $host $port] }
        db.set $session connection $conn
        if { $conn != "" } {  
            # cuz we only have one to-the-window session, regardless
            # of other background mcp sessions or whatever...
            set current_session ""
            catch {
            set current_session [db.get current session]
            }
            if { $current_session != "" } {
                io.disconnect_session $current_session
            }
            io.set_connection $conn
            fconfigure $conn -blocking 0
            fileevent $conn readable "io.receive_session $session"
            client.client_connected_session $session
            return 0
        } {
            io.host_unreachable $host $port
            return 1
        } 
    } {
        return [gateway_io.connect_session $session]
    }
}

proc io.connect { host port } {
    global io_output

    set use [worlds.get_generic Off {} {} UseGateway]

    if { [string tolower $use] == "on" } {

        # duplicate io.connect logic, using the new socket command

        set io_output ""
        catch { set io_output [gateway.tngw_socket $host $port] }
        if { $io_output != "" } {
            fconfigure $io_output -blocking 0
            fileevent $io_output readable {io.receive}
            client.client_connected
            return 0
        } {
            io.host_unreachable $host $port
            # signal an error...
            return 1 
        }

    } {
        return [gateway_io.connect $host $port]
    }
}


proc gateway.tngw_socket {host port} {
  global gateway_tngw_gateway gateway_tngw_port

    # use default ghost/gport if no user preferences
    set ghost $gateway_tngw_gateway
    catch {
        set ghost [string tolower [worlds.get [worlds.get_current] GatewayHost]]
    }
    set gport $gateway_tngw_port
    catch {
        set gport [string tolower [worlds.get [worlds.get_current] GatewayPort]]
    }

  set f [socket $ghost $gport]
  fconfigure $f -translation crlf -buffering line
  
  gateway.tngw_log "Connected to $ghost port $gport; looking for 'To use'"

  set line ""
  while {![string match "*To use*" $line]} {
    set line [gets $f]
    gateway.tngw_log $line
  }
  
  # Suck up the blank line after the "To use..."
  set line [gets $f] 
  gateway.tngw_log "Assuming this is blank: '$line'"
  
  gateway.tngw_log "Flushing once"
  flush $f 
  gateway.tngw_log "Sending connect $host $port"
  puts -nonewline $f "connect $host $port\r"
  gateway.tngw_log "Flushing again"
  flush $f
  
  gateway.tngw_log "Looking for 'Trying ... port ...'"
  
  set line ""
  while {![string match "*Trying*port*" $line]} {
    set line [gets $f]
    gateway.tngw_log $line
  }
  
  # OK, here's the gross part.  The gateway doesn't report whether it
  # actually made a successful connection before dumping us into the
  # actual remote host---but it does spew a bunch of telnet
  # negotiation codes to put back the mess it made initially.  If the 
  # next character we read is a TELNET IAC (ASCII 0xff) we assume that
  # we're actually connected and should scarf up the remaining 8
  # negotiation characters.
  
  # If we don't get the negotiation codes, we have to assume that the
  # proxy is printing something like "unknown host" or "connection
  # refused" at us, and raise it as an error.
  
  gateway.tngw_log "Looking for TELNET negotiation code"
  set first [read $f 1] 
  if {$first != "\377"} {
    gateway.tngw_log "...didn't find it."
    set problem [gets $f]
    set problem "$f$problem" 
    gateway.tngw_log "Received '$problem' as next line; closing connection."
    close $f
    error "tngw_socket: $problem"
  }
  
  gateway.tngw_log "Found negotiation; assumed connected properly; eating 8 more octets." 
  # We already ate one of the 9 known garbage characters; eat the rest.
  read $f 8
  
  # This is the way socket returns new connections, so we had better
  # as well.
  
  fconfigure $f -translation auto -buffering full
  
  gateway.tngw_log "Returning socket; tngw code done."
  return $f
}

proc gateway.tngw_log {line} {
  global gateway_tngw_debug
  
  if {$gateway_tngw_debug} { 
    puts stderr $line
  }
}