#!/usr/bin/tclsh
#
#    Copyright (C) 2010 Alexandros Stergiakis <alsterg@gmail.com>
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU Affero General Public License as
#    published by the Free Software Foundation, either version 3 of the
#    License, or (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU Affero General Public License for more details.
#
#    You should have received a copy of the GNU Affero General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

#//#
# A shell to start a session with a local MikroConf Server.
#
# This should be started, just like bash, from an external program like login, telnetd, sshd.
#
# Note: We don't recognize any espace sequense, because shell
# is normally called from another interface like telnet or ssh, that have
# their own escape sequences.
#//#

package require Tcl 8.5
package require unix 0.5
package require Tclx 8.4
package require comm 4.6.1 ;# Tcllib
package require cmdline 1.3.1 ;# Tcllib

set ESC "\033"

# Time to wait (in secs) for the user's terminal to respond to commands.
set TERM_TIMEOUT 4

# Time to wait (in secs) for for the MikroConf server to respond to commands.
set SERVER_TIMEOUT 15

# Interval to wait (in ms) between two consecutive transmittions of window size update commands to the server.
set RESIZE_DELAY 2000

set KNOWN_CONNECTION_TYPES [list console vty]

set resize_pending 0 ;# '1' indicates that a SIGWINCH has been received within $RESIZE_DELAY

# Find the current window dimentions of the remote terminal screen.
#
# @assume Dependency on the output of the 'resize' busybox applet.
# @error
proc winsize {} {
    global ROWS_DEFAULT COLS_DEFAULT
    
    # 'ttysize' returns 80x24 on error.
    lassign [exec ttysize] cols rows
    
    # On my minicom console session 'ttysize' gives 0x0, whereas 'resize' is able to give the right values.
    # Therefore use 'resize' as fallback.
    if {$cols == 0 || $rows == 0} {
        if {[catch {exec -ignorestderr -- resize} result]} {
            puts stderr "Window size autoprobing failed"
            return [list 80 24]  
        }
        
        regexp {^COLUMNS=([0-9]*);LINES=([0-9]*);.*$} $result -> cols rows
        if {$cols eq "" || $rows eq "" || $cols == 0 || $rows == 0} {
            # Finally, if all the above failed, use defaults (80x24).
            puts stderr "Window size autoprobing failed"
            return [list 80 24]  
        }
    }
    
    return [list $cols $rows]
}

# Called when SIGUSR1 arrives. It resets the terminal screen without breaking the connection
# with the server.
proc reset {} {
    global fifoIn fifoOut
    if {[catch {exec reset} result]} {
        puts stderr "Failed to reset terminal: $result"
    }
    rawInput
    fconfigure $fifoIn -blocking 1 -buffering none -translation binary
    fconfigure $fifoOut -blocking 0 -buffering none -translation binary
}

# Called either explicitly, or when SIGUSR2 arrives.
# Sends a resize command to the server to update the window size for this session.
# It is invoked either by the Server after an explicit user request, by the reception of
# SIGUSR2 signal, or by the reception of the SIGWINCH signal which is generated
# whenever a change happens in the window dimention of the remote terminal.
# Note: We cannot implement this in MikroConf server, because the server is attached to its own terminal.
#           For the same reason stty and other similar tools cannot be executed on the Server either.
proc resize {} {
    global resize_pending
    set resize_pending 0

    lassign [winsize] cols rows
    
    if {[catch {
        send_command resize $COLS $ROWS ;# no return value
    } result]} {
       puts stderr "Error: $result"
    }
}

# Send a resize command to the server to update the window size for this session.
# When using a terminal emulator and resize its window, multiple consequtive
# SIGWINCH signals are generated with very little time difference. This can
# overload the server. Thus we rate limit the commands for window resize sent
# by this procedure.
proc sigwinch {} {
    global RESIZE_DELAY resize_pending
    if {$resize_pending} {
        return
    } else {
        resize
    }
    set resize_pending 1
    after $RESIZE_DELAY resize
}

# Configure stdin & stdout for no buffering, stdin for raw input, and hide entered characters
proc rawInput {} {
    fconfigure stdin -buffering none -blocking 0 -translation auto
    fconfigure stdout -buffering none -blocking 1 -translation crlf
    fconfigure stderr -buffering none -blocking 1 -translation crlf
    if {[catch {exec stty raw -echo} result]} {
        puts stderr "Failed to set terminal options: $result"
    }
}

# Configure stdin & stdout for line buffering, stdin for cooked input, and show entered characters
proc lineInput {} {
    fconfigure stdin -buffering line -blocking 1 -translation auto
    fconfigure stdout -buffering line -blocking 1 -translation auto
    fconfigure stderr -buffering line -blocking 1 -translation auto
    if {[catch {exec stty -raw echo} result]} {
        puts stderr "Failed to set terminal options: $result"
    }
}

# Returns the current cursor position.
#
# @return The current cursor position
# @error
proc curpos {} {
    global fifoIn TERM_TIMEOUT
    
    fileevent stdin readable {}
    fconfigure stdin -blocking 1 ;# We need blocking here
    
    set resp {}
    if {[catch {
        signal trap SIGALRM {error "Timeout waiting"}
        alarm $TERM_TIMEOUT
        puts -nonewline stdout "\033\[6n"
        while {1} {
            append resp [read stdin 1]
        }
    } errMsg]} {
        # Either timeout or an error while evaluating the script.
        signal ignore SIGALRM ;# For the case of error
        error "failed to find cursor position: $errMsg"
    }
    signal ignore SIGALRM
   
    set resp [string range $resp 2 end-1]
    lassign [split $resp ";"] rows cols
    return [list $cols $rows]
}
trace add execution curpos leave restore_stdin

# Execution trace to restore redirection of stdin to FIFO, and other stdin settings.
proc restore_stdin {args} {
    rawInput
    fileevent stdin readable [list stdin2fifoin $fifoIn]
}

# Callback proc to monitor stdin and pass data on to fifoin
# fifoin is the stdin of the server for this session.
#
# @param fifo The input fifo
proc stdin2fifoin {fifo} {
    global app
    
    if {[eof stdin]} {
        puts stderr "Received termination signal from user's terminal."
        quit
    }
    if {[eof $fifo]} {
        puts stderr "Error: Connection from Shell to Server was lost."
        quit
    }
    set data [read stdin]

    if {[catch {
        puts -nonewline $fifo $data
    } result]} {
        puts stderr "Error: While writing to fifo: $result"
        quit
    }
}

# Callback proc to monitor fifoout and pass data on to stdout
# fifoin is the stdout of the server for this session.
#
# @param fifo The output fifo
proc fifoout2stdout {fifo} {
    if {[eof $fifo]} {
        puts stderr "Error: Connection from Server to Shell was lost."
        quit
    }
    
    if {[catch {
        puts -nonewline stdout [read $fifo]
    } result]} {
        puts stderr "Error: While writing to stdout: $result"
        quit
    }
}

if {0} {
    
proc send_command {args} {
    global cid SERVER_TIMEOUT SERVER_PORT

    debuglog "Debug: Sending command to server: $args"
    
    if {[catch {
        signal trap SIGALRM {error "Timeout waiting"}
        alarm $SERVER_TIMEOUT
        puts $cid $args
        flush $cid
        if {[gets $cid resp] == -1} { ;# EOF
            close $cid
            error "EOF while waiting for server response"
        }
    } errMsg]} {
        quit $errMsg
    }
    signal ignore SIGALRM

    debuglog "Debug: Response from server received: $resp"
    
    return $resp
}

}

::comm::comm hook eval {error "Execution in the context of the shell is not permitted"}

# Send a command to MikroConf server and receive the responce.
# Handle the situation where the server doesn't responce.
#
# @param args The command to send.
# @return The responce message from the server.
# @error
proc send_command {args} {
    global SERVER_TIMEOUT SERVER_PORT

    debuglog "Debug: Sending command to server ($SERVER_PORT) : $args"

    if {[catch {
        signal trap SIGALRM {error "Timeout waiting"}
        alarm $SERVER_TIMEOUT
        set resp [::comm::comm send $SERVER_PORT $args]
    } result]} {
        puts stderr "Timeout waiting: $result"
        quit
    }
    signal ignore SIGALRM

    debuglog "Debug: Response from server received: $resp"

    return $resp
}

# Called instead of 'exit' to restore proper terminal settings.
# When 'msg' param is set, we assume we have an erroneous exit condition.
proc quit {{msg ""}} {
    global ESC fifoIn fifoOut fifoInFile fifoOutFile
    if {$msg ne ""} {
        puts stderr "Error: $msg\r"
    }
    debuglog "Debug: Exitting.."
    catch { close $fifoIn; close $fifoOut }
    catch {file delete $fifoInFile $fifoOutFile}
    exec reset
    exec clear
    lineInput
    puts ""
    if {$msg ne ""} {
        exit 1
    }
    exit 0
}

# Print welcome message
proc welcome {} {
    global ESC COLS
    
    debuglog "Debug: Shell started at [clock format [clock seconds]], with Process id:[pid]"
    
    #puts -nonewline "${ESC}c" ;# Clear screen (does not always work, better combine with 'reset', 'clear')
    puts "${ESC}\[30;47m"
    puts [format {%-*s} $COLS "        MikroConf Shell"]
    puts -nonewline [format {%-*s} $COLS "        Copyright 2010 Alexandros Stergiakis <alsterg@gmail.com>"]
    puts "${ESC}\[0m\n"
}

#################
# Main
#################

set options "
    {s.arg {50004}              {Port the server is listening at}}
    {d                          {Print debugging messages}}
    {t.arg {vty}                {Provide connection type string: $KNOWN_CONNECTION_TYPES}}
"

if {[catch {
    array set params [::cmdline::getoptions argv $options "\[options]"]
} errMsg]} {
    puts stderr $errMsg
    exit 1
}

set SERVER_PORT $params(s)
set CONNECTION_TYPE $params(t)

if {$CONNECTION_TYPE ni $KNOWN_CONNECTION_TYPES} {
    puts stderr "Unknown connection type"
    exit 1
}

# Set-up logging
if {$params(d)} {
    proc debuglog {msg} {puts stderr $msg}
} else {
    proc debuglog {msg} {}
}

lassign [winsize] COLS ROWS

# Connect
#set cid [unix_sockets::connect $SERVER_PORT]
#fconfigure $cid -blocking 1 -buffering line

if {[catch {
    set resp [send_command register [pid] [exec whoami] $CONNECTION_TYPE $COLS $ROWS]
} result]} {
   puts stderr $result
   exit 1
}

welcome

debuglog "Debug: Reguest Accepted. Assigned FIFOs: $resp"
lassign $resp fifoInFile fifoOutFile

# Open session

debuglog "Debug: Setting raw input and output"
rawInput

debuglog "Debug: Opening $fifoInFile channel for writing (stdin->fifoin)"

if {[catch {
    signal trap SIGALRM {error "Timeout waiting"}
    alarm $SERVER_TIMEOUT
    set fifoIn [open $fifoInFile w]
} errMsg]} {
    quit "Timeout trying to connect to assigned Input FIFO: $errMsg"
}
signal ignore SIGALRM

fconfigure $fifoIn -blocking 1 -buffering none -translation binary

debuglog "Debug: Opening $fifoOutFile channel for reading (fifoout->stdout)"

if {[catch {
    signal trap SIGALRM {error "Timeout waiting"}
    alarm $SERVER_TIMEOUT
    set fifoOut [open $fifoOutFile r]
} errMsg]} {
    quit "Timeout trying to connect to assigned Output FIFO: $errMsg"
}
signal ignore SIGALRM

fconfigure $fifoOut -blocking 0 -buffering none -translation binary

debuglog "Debug: Registering I/O handlers"
fileevent stdin readable [list stdin2fifoin $fifoIn]
fileevent $fifoOut readable [list fifoout2stdout $fifoOut]

debuglog "Debug: Registering Signal handlers"

signal ignore SIGINT ;# Ctrl-C
signal ignore SIGABRT ;# Ctrl-\ 
signal ignore SIGTSTP ;# Ctrl-Z
signal unblock {SIGHUP QUIT TERM}
signal trap {SIGHUP QUIT TERM} {
    quit "Received signal to terminate"
}

signal trap SIGUSR1 reset
signal trap SIGUSR2 resize
signal trap SIGWINCH sigwinch

debuglog "Debug: Connected"

set __forever__ 0
vwait __forever__