Overview | Index by: file name |
procedure name |
procedure call |
annotation
session.tcl
(annotations | original source)
#
# 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/>.
#
#//#
# Create, manage, query and terminate user and background sessions.
#//#
package require comm 4.6.1 ;# Tcllib
namespace eval session {
namespace export close_session \
current_session \
user_sessions \
bg_sessions \
Session \
set_current_session \
is_user_session \
is_bg_session \
close_all_user_sessions \
close_all_bg_sessions \
listen_for_connections \
create_bg_session \
get_sessionId
# The following variables store threadIds
variable conSessions {} ;# List of active local console user session IDs
variable vtySessions {} ;# List of active remote (VTY) user session IDs
variable bgSessions {} ;# List of active background sessions IDs
# Connection ID => Session ID
variable CID2SID
array set CID2SID {}
################################
# Connection Control
################################
proc new_message {id} {
variable CID2SID
if {[gets $id buffer] == -1} {
if {[eof $id]} {
close_session $::session::CID2SID($id) "Connection was lost with shell \"$id\""
return
}
return ;# fblocked probably
}
log::Debug "Received command from \"$id\":" $buffer
if {[catch {
switch -exact -- [lindex $buffer 0] {
register { ;# "register" pid username type cols rows
lassign [lrange $buffer 1 end] pid username type cols rows
if {$type ne "console" && [llength $::session::vtySessions] >= [tsv::get conf SOFT_MAX_SESSIONS]} {
log::Warning -error "Limit reached for concurrent remote sessions"
}
if {$type eq "console" && [llength $::session::conSessions] >= 1} {
log::Warning -error "Only one console session is allows at any time"
}
set pid [lindex $buffer 1]
set fifos [::session::register_new_fifos $pid]
# Schedule create_user_session for execution at an idle time, so that we first return
# (sending the response back), and then create_user_session is executed.
after idle [list ::session::create_user_session $pid $id $fifos $username $type $cols $rows]
log::Debug "Shell" $pid "Sending response: " $fifos
puts $id $fifos
}
ping {
puts $id pong
}
resize { ;# "resize" $COLS $ROWS
set sid $::session::CID2SID($id)
tsv::set $sid COLUMNS [lindex $buffer 1]
tsv::set $sid ROWS [lindex $buffer 2]
# No need to wait for the following. If there is a failure, we can do nothing about it.
thread::send -async $sid ::pty::ptyresize
thread::send -async $sid [list ::cli::handleAction RedrawLine]
}
default {
log::Warning -error "Unknown command:" $buffer
}
}
} errMsg]} {
# Send to the other party the error, so it can print it on the terminal.
puts $id $errMsg
if {[info exists CID2SID($id)]} {
close_session $CID2SID($id) $errMsg
} else {
close $id
}
}
}
proc new_connection {con} {
log::Info "New connection with ID: $con"
chan event $con readable [list ::session::new_message $con]
fconfigure $con -blocking 0 -buffering line
}
if {0} {# Not working.
proc listen_for_connections {} {
Global SERVER_PORT
log::Debug "Opening control socket: $SERVER_PORT"
set fd [unix_sockets::listen $SERVER_PORT ::session::new_connection]
fconfigure $fd -blocking 0 -buffering line
}
}
# Monitor for incoming control commands.
# We generate some errors, but mostly we let the errors generated by the procedures used herein
# to propagate back to the caller (a shell or watchdog).
#
# @error
proc listen_for_connections {} {
Global SERVER_PORT
log::Debug "Opening control socket"
::comm::comm config -port $SERVER_PORT -listen 1 -silent 0
:::comm::comm hook incoming {
log::Debug "Incomming connection from ${addr}:${remport}"
}
:::comm::comm hook eval {
set buffer [lindex $buffer 0] ;# Because the command comes like this: {{command}}
log::Debug "Received command:" $buffer
switch -exact -- [lindex $buffer 0] {
register { ;# "register" pid username type cols rows
lassign [lrange $buffer 1 end] pid username type cols rows
if {$type ne "console" && [llength $::session::vtySessions] >= [tsv::get conf SOFT_MAX_SESSIONS]} {
log::Warning -error "Limit reached for concurrent remote sessions"
}
if {$type eq "console" && [llength $::session::conSessions] >= 1} {
log::Warning -error "Only one console session is allows at any time"
}
set pid [lindex $buffer 1]
set fifos [::session::register_new_fifos $pid]
# Schedule create_user_session for execution at an idle time, so that we first return
# (sending the response back), and then create_user_session is executed.
after idle [list ::session::create_user_session $pid $id $fifos $username $type $cols $rows]
log::Debug "Shell" $pid "Sending response: " $fifos
return $fifos
}
ping {
return pong
}
resize { ;# "resize" $COLS $ROWS
set sid $::session::CID2SID($id)
tsv::set $sid COLUMNS [lindex $buffer 1]
tsv::set $sid ROWS [lindex $buffer 2]
# No need to wait for the following. If there is a failure, we can do nothing about it.
thread::send -async $sid ::pty::ptyresize
thread::send -async $sid [list ::cli::handleAction RedrawLine]
return
}
default {
log::Warning -error "Unknown command:" $buffer
}
}
}
:::comm::comm hook lost {
return [close_session $::session::CID2SID($id) $reason]
}
}
################################
# Session creation
################################
# Assign a new pair of FIFOs for a new connection request for a User session.
#
# @param pid The pid of the requesting shell
# @return A pair of assigned fifos to communicate with the shell.
# @error
proc register_new_fifos {pid} {
Global FIFO_DIR
log::Debug "Shell" $pid "Registering new FIFO pair"
set fifoInFile [file join $FIFO_DIR in${pid}]
set fifoOutFile [file join $FIFO_DIR out${pid}]
catch { file delete $fifoInFile $fifoOutFile }
log::Debug "Shell" $pid "Creating FIFO files"
if {! [file exists $fifoInFile]} { ;# Just in case
if {[catch {
exec mkfifo -m 622 $fifoInFile ;# Shell has to write its stdin to this fifo
} errMsg errStack]} {
log::Error -error -stack $errStack "Could not create input FIFO: " $errMsg
}
}
if {! [file exists $fifoOutFile]} { ;# Just in case
if {[catch {
exec mkfifo -m 644 $fifoOutFile ;# Shell has to read its stdout from this fifo
} errMsg errStack]} {
catch { file delete $fifoInFile }
log::Error -error -stack $errStack "Could not create output FIFO: " $errMsg
}
}
return [list $fifoInFile $fifoOutFile]
}
# Establish a connection with a shell and set up a new user session
#
# @assume authmode 'user authmode and confmode 'entry' exist. They should be created by 'base' module.
#
# @param pid The pid of the requesting shell.
# @param cid The connection Id as returned by ::comm::comm self.
# @param fifos A tuple: {input_fifo output_fifo} assigned to the shell.
# @param type The type of user session. Supported types: "console" "vty"
# @param username The name of the user connected to this session.
# @param COLS Reported number of supported columns in the user terminal.
# @param ROWS Reported number of supported rows in the user terminal.
# @return The session Id of the newly created user session.
# @error
proc create_user_session {pid cid fifos username type COLS ROWS} {
Global COLS_MAX COLS_MIN ROWS_MAX ROWS_MIN SESSION_TIMEOUT BASE_DIR FLOW_DEF MONITOR_DEF ANSI_DEF
variable vtySessions
variable conSessions
variable CID2SID
log::Info "New user session request for \"$username\" (pid: $pid) (interpreter: $cid)"
lassign $fifos fifoInFile fifoOutFile
if {[catch {
::helper::timeout $SESSION_TIMEOUT {
log::Debug "Shell" $pid "Opening $fifoInFile channel for reading"
set fifoIn [open $fifoInFile r] ;# can block.
fconfigure $fifoIn -blocking 0 -buffering none -translation binary
log::Debug "Shell" $pid "Opening $fifoOutFile channel for writing"
set fifoOut [open $fifoOutFile w] ;# can block.
fconfigure $fifoOut -blocking 1 -buffering none -translation binary
log::Debug "Shell" $pid "Opening $fifoOutFile channel for writing second time"
set fifoOut2 [open $fifoOutFile w] ;# will not block.
fconfigure $fifoOut2 -blocking 1 -buffering none -translation binary
}
# Note: We have the following checks after FIFOs have been opened, so that we can print on the output FIFO
# in order to provide feedback to the user.
# Check for ROWS/COLS out of bounds
if {! [string is integer $COLS] || $COLS > $COLS_MAX || $COLS < $COLS_MIN} {
puts $fifoOut "The provided number of supported screen columns is either too large or too small." ;# Blocks
log::Error -error "Shell" $pid "Number of columns out of bounds"
}
if {! [string is integer $ROWS] || $ROWS > $ROWS_MAX || $ROWS < $ROWS_MIN} {
puts $fifoOut "The provided number of supported screen rows is either too large or too small." ;# Blocks
log::Error -error "Shell" $pid "Number of rows out of bounds"
}
} errMsg errStack]} {
# Either timeout or error. Do clean-up
catch {close $fifoIn}
catch {close $fifoOut}
catch {close $fifoOut2}
catch { file delete $fifoInFile $fifoOutFile }
log::Error -error -stack $errStack "Shell" $pid "Failed to establish shell connection" $errMsg
}
# Creating new working thread.
set sid [thread::create]
thread::send $sid "set ptid [thread::id]"
# Opening pipe to proxy Stdin.
pipe pipe_r pipe_w
fconfigure $pipe_r -blocking 0 -buffering none -translation binary
fconfigure $pipe_w -blocking 0 -buffering none -translation binary
# Transfer I/O to the thread
thread::transfer $sid $pipe_r
thread::transfer $sid $fifoOut
# Establishing Stdin proxy.
set ::session::special_$sid 0 ;# needed by ::session::proxy
fileevent $fifoIn readable [list ::session::proxy $sid $fifoIn $pipe_w]
# All state information for a session is confined within a unique shared memory array,
# this allows for easy access from both the Session and the Master threads.
# USERNAME : The unix account name for the user using the MikroConf shell and connected
# to this session.
# AUTHROOT : The AUTHMODE to use as the tree of all authentication modes, meaning that
# the user cannot go on any of its ancestor AUTHMODEs with 'disable'.
# This is the mode the user (or background) session enters to upon creation.
# Must be set to something. No empty list.
# CONFROOT : The CONFMODE to use as the tree of all configuration modes, meaning that
# the user cannot go on any of its ancestor CONFMODEs with 'exit'.
# This is the mode the user (or background) session enters to upon creation.
# Must be set to something. No empty list.
# POLICY : If set then this policy is enforced in all authentication modes, otherwise a session
# that depends on the current AUTHMODE is enforced (or if not specified, the 'default'
# policy is used).
# SHELL_PID : The pid of the connecting shell
# SHELL_CID : The connection id for this shell
# USER : Flag to indicate that it is a user session (or not)
# STDIN_W : The write part of the pipe where user input from the Master to the Session is redirected to.
# STDIN_R : The channel that corresponds to the stdin FIFO. This is listened upon by Master and
# redirected to Session. We need this Stdin redirection, in order for the Master to "see"
# when the user presses the Ctlr ^ + x combination, to act accordingly. This is necessary
# because if the Session event loop is blocked (e.g. from a user script in Slave), then
# only master can sense this key combination and restart the blocked session.
# FIFOINFILE : The full path for the fifo action as stdin
# FIFOOUTFILE : The full path for the fifo action as stdout
# STDIN : The channel where Session will listen for User input. This is the the read part of the
# redirection pipe.
# STDOUT : The channel that corresponds to the stdout FIFO
# STDOUT2 : A second channel that corresponds to the same STDOUT FIFO. It is used by
# Master to send async messages for this session, regardless of the state of the transfered
# I/O to the Session interpreter. It is necessary because ::thread package allows us only to
# transfer I/O to other threads, but not share. On the other hand we cannot send the logs for
# printing of the event loop of the Slave, because Slave is allowed to block, and these messages
# will not be printed asynchronously. In fact, sending the printing job to the Slave event loop, is
# what we do when user asks for synchronous delivery of log/debug messages.
# CREATED : Time this connection was established
# ROWS : The number of rows supported by the terminal as reported by the MikroConf Shell
# COLUMNS : The number of columns supported by the terminal as reported by the MikroConf Shell
# INLINE : Reflects the state of the in-line scription functionality. Enabled/Disabled. It also
# specifies the desired default setting (upon user login).
# TRYCONNECT : Assume that unknown single-words commands are hostnames, and attempt to
# connect to them via telnet.
# FLOW : If set, flow control is enabled for text printed on the console. If it does not fit in a screen-full,
# printing is paused and user can control the flow. Flow control is always dissabled for event
# sessions.
# MONITOR : Whether to print logs and debug messages on the terminal. If set, such messages are printed.
# Otherwise they can only be views by inspecting the logs.
# LAG : Time in ms to delay after a command is executed (any command or procedure). This safeguards
# against accidental DoS attacks from the command line, by executing a script that consumes all the CPU.
# Bare in mind that some commands internally execute other commands, hence the overal lag
# is accumulated. For example "for" executes one time its first argument, and on every iteration
# its second and third (which can in turn consist of many subcommands).
# ANSI : Enable ANSI escape codes for colors, bold, underline, blinking etc..
tsv::set $sid USERNAME $username
tsv::set $sid AUTHROOT {user}
tsv::set $sid CONFROOT {entry}
tsv::set $sid POLICY {}
tsv::set $sid SHELL_PID $pid
tsv::set $sid SHELL_CID $cid
tsv::set $sid USER 1
tsv::set $sid STDIN_W $pipe_w
tsv::set $sid STDIN_R $fifoIn
tsv::set $sid FIFOINFILE $fifoInFile
tsv::set $sid FIFOOUTFILE $fifoOutFile
tsv::set $sid STDIN $pipe_r
tsv::set $sid STDOUT $fifoOut
tsv::set $sid STDOUT2 $fifoOut2
tsv::set $sid CREATED [clock seconds]
tsv::set $sid ROWS $ROWS
tsv::set $sid COLUMNS $COLS
tsv::set $sid INLINE 0 ;# Disabled for user sessions by default.
tsv::set $sid TRYCONNECT 1
tsv::set $sid FLOW $FLOW_DEF
tsv::set $sid ANSI $ANSI_DEF
tsv::set $sid MONITOR $MONITOR_DEF
tsv::set $sid LAG 2
common_state $sid ;# Remaining variables
# We use for Session Id the thread Id or the thread responsible for this session
# thread.tcl can return an error
if {[catch {
thread::send $sid [list source [file join $BASE_DIR thread.tcl]]
} errMsg errStack]} {
# Any SLAVE interp, fileevents, and open descriptors will die automatically.
catch {close $pipe_w}
catch {close $fifoIn}
catch {close $fifoOut2}
catch { file delete $fifoInFile $fifoOutFile }
thread::release $sid
tsv::unset $sid
log::Critical -error -stack $errStack "Shell" $pid "User session failed to start: " $errMsg
}
# Set initial root AUTHMODE and CONFMODE
sysconf authmode $sid init
sysconf confmode $sid init
set CID2SID($cid) $sid
switch -exact -- $type {
console { lappend conSessions $sid }
vty { lappend vtySessions $sid }
default { error "Unsupported session type: $type" }
}
# Print User Banner
Global USER_BANNER
thread::send -async $sid [list puts -nonewline [? [lempty $USER_BANNER] "" "${USER_BANNER}\n"]]
# Generated after a new user session has started.
# Handy for printing a welcome message, logs, past connections, and other information.
#
# @param The session ID.
# @param The unix account name of the just logged-in user.
# @param The session type
event generate USER_SESSION STARTED [list $sid $username $type]
# Since this is a user session, load the command line interface.
# We didn't include this in thread.tcl, because we want thread.tcl to be session-type neutral.
thread::send $sid [list source [file join $BASE_DIR cli.tcl]]
log::Debug "New user session created with session id \"$sid\" of type \"$type\""
return $sid
}
# Create a background session, which is event-driver and not user-driver.
#
# @assume authmode 'priv' and confmode 'global' exist. They should be created by 'base' module.
#
# @param username A symbolic name to distinguize this particular background session. By convention \
it should be in capitals, so that no user account can have the same name (unix user accounts can only \
have low case letters).
# @param authmode The authmode to enter to, and the relative root of authmodes to set. Default is "priv"
# @param confmode The confmode to enter to, and the relative root of confmodes to set. Default is "global"
# @return The session Id of the newly created user session.
proc create_bg_session {username {authmode {priv}} {confmode {global}}} {
Global DEV_DIR DEFAULT_ROWS DEFAULT_COLS BASE_DIR PROC_DIR
variable bgSessions
log::Debug "New Background session request for \"$username\""
# Note: Until after setup_state is called, don't use 'log' or anything that uses our version of 'puts'
# /dev/zero does not activate the readable handler when input is requested with 'read <chan>' as
# opposed to 'read <chan> <num>', whereas /dev/null always terminates the handler with an EOF.
set fdin [open [file join $DEV_DIR zero] r]
fconfigure $fdin -blocking 0 -buffering line -translation binary
# Note: We don't write output to a file, which we can monitor, because the user can generate
# meaningless output that will be captured by this file and consume resources unecessarily.
# Since the Event session is not interactive, output should not occur there at first place. Any
# important information should be logged instead.
set fdout [open [file join $DEV_DIR null] w]
fconfigure $fdout -blocking 0 -buffering full -translation binary
set sid [thread::create]
thread::send $sid "set ptid [thread::id]"
# Note: No limit for the number of parallel background sessions
tsv::set $sid USERNAME $username
tsv::set $sid AUTHROOT $authmode
tsv::set $sid CONFROOT $confmode
tsv::set $sid POLICY {bg} ;# special policy for event sessions
tsv::set $sid USER 0
tsv::set $sid FIFOINFILE [file join $DEV_DIR zero]
tsv::set $sid FIFOOUTFILE [file join $DEV_DIR null]
tsv::set $sid STDIN $fdin
tsv::set $sid STDOUT $fdout
tsv::set $sid CREATED [clock seconds]
tsv::set $sid ROWS $DEFAULT_ROWS
tsv::set $sid COLUMNS $DEFAULT_COLS
tsv::set $sid INLINE 1 ;# This is necessary in order for registered procedures to be evaluated.
tsv::set $sid TRYCONNECT 0
tsv::set $sid FLOW 0
tsv::set $sid MONITOR 0
tsv::set $sid LAG 0 ;# No lag for background sessions.
tsv::set $sid ANSI 0
common_state $sid ;# Remaining variables
# Transfer I/O to the thread
thread::transfer $sid $fdin
thread::transfer $sid $fdout
# We use for Session Id the thread Id or the thread responsible for this session
# thread.tcl can return an error
if {[catch {
thread::send $sid [list source [file join $BASE_DIR thread.tcl]]
} rerrMsg errStack]} {
# Any SLAVE interp, fileevents, and open descriptors will die automatically.
catch {close $fdin}
catch {close $fdout}
thread::release $sid
tsv::unset $sid
log::Emergency -error -stack $errStack "Background session failed to start (session Id: $sid): " $rerrMsg
}
# Set initial root AUTHMODE and CONFMODE
sysconf authmode $sid init
sysconf confmode $sid init
lappend bgSessions $sid
# Note: We don't load cli.tcl in background sessions, as there is no user interaction.
log::Debug "New background session created with session id: $sid"
# Generated after a new background session has started.
# This is helpful for executing session start-up actions for event sessions.
#
# @param The session ID.
event generate BACKGROUND_SESSION STARTED $sid
return $sid
}
# Set up a number of shared variables common for both 'user' and 'background' session types.
#
# @param sid Session id
proc common_state {sid} {
Global PROMPT_DEF LOGTHREAS_DEF HISTORY_DEF SYNCH_DEF
# SID : The Session ID. We use this unique identification of a session for multiple purposes:
# * It is the thread Id of the Session thread.
# * The name of the Slave interpreter.
# * The shared memory area reserved for a particular session.
# * To identify the session as a whole.
# SLAVE : The name a slave interpreter to handle evaluation of in-line Tcl. We use the same name as the Thread (or session) id
# CONFMODE: The name for the current configuration mode the session is currently in.
# CONFSTRING: Prompt to indicate the current CONFMODE; e.g (conf), (rip), (ospf)
# CONFSTORE: A place to store information regarding the current confmode. e.g. store the interface name when in interface configuration mode.
# AUTHMODE: The name for the current authentication mode the session is currently in.
# AUTHSTRING: Prompt to indicate the current CONFMODE; e.g >, #
# HISTORY: The history buffer where previous commands are stored in a list format.
# HISTORY_SIZE: Max number of entries maintained in the history buffer.
# HISTORY_LEVEL: Where browsing the history with UP/DOWN keys, store the reletive position within the history that we are.
# zero coresponds to no browsing at all (the currently edited command). The number increases to show the first in the past, second etc.
# HISTORY_ENTRIES: Number of entries stored in the history buffer at any moment. This increases with every unique command entered until it reaches the size of history buffer.
# HIST_SUBSTITUTIONS : Whether to enable history substitutions: !! !n !prefix ^old^new
# COMMANDS: The Tcl commands present on the slave at the time of its creation. This list includes the ALIASES below.
# ALIASES: The Tcl commands on the slave that are aliases at the time of its creation.
# HIDDEN: The Tcl commands on the slave that are hidden at the time of its creation.
# PROMPT: How the system prompt should look like. The following elements are supported:
# %% : The percent character
# %u : The name of the user logged-in
# %h : Local host name
# %d : Local domain name
# %p : The AUTHMODE character, such as > for userlevel and # for privileged level
# %c : The CONFMODE string, such as "(conf)" or "(rip)"
# %s : Space character
# %t : Tab character
# %n : New line
# %D : Present date in %d/%m/%Y format
# %T : Present time in %H:%M format
# %M : The machine (hardware) type (uname)
# %R : OS release (uname)
# %N : OS name (uname)
# %V : OS version (uname)
# %U : Uptime in <days>D<hours>H format(sysinfo)
# %L : Load average in <1min>,<5min>,<15min> format (sysinfo)
# %P : Percentage of free RAM (sysinfo)
# %W : Percentage of free swap (sysinfo)
# %E : The list of users currently logged-on in the system, in <user1> <user2> ... format (who)
# %S : The number of user sessions currenly active in the system (who)
# Any other character except for space and tabs is copied literally to the prompt
# SYNCH : If set, logs and debug messages are sent synchronously on the terminal screen;
# otherwise they are sent asynchronously. No logs/messages are sent to background sessions.
# OUTBUF_SIZE : When SYNCH is set, this is the number of last logs to remember, to be printed
# after the prompt becomes available again.
# BUSY : Boolean to indicate whether the prompt is available, or a command is under execution.
# Used in conjuction with SYNCH above to buffer incomming messages.
# LOGTHREAS : Log threashold per session. If not specified the LOGTHREAS default session
# is used instead. Messages with an equal or higher severity than that specified in this
# variable will be printed on the terminal. If set to 8, then no messages will be printed at all.
# TERM : Boolean. Indicates (if set) that the thread/session is in the process of terminating. No commands
# are executed.
tsv::set $sid SID $sid
tsv::set $sid SLAVE $sid
tsv::set $sid CONFMODE {}
tsv::set $sid CONFSTRING {}
tsv::set $sid CONFSTORE {}
tsv::set $sid AUTHMODE {}
tsv::set $sid AUTHSTRING {}
tsv::set $sid HISTORY {}
tsv::set $sid HISTORY_SIZE $HISTORY_DEF
tsv::set $sid HISTORY_LEVEL 0
tsv::set $sid HISTORY_ENTRIES 0
tsv::set $sid HIST_SUBSTITUTIONS 1 ;# (@magic-number)
tsv::set $sid COMMANDS {}
tsv::set $sid ALIASES {}
tsv::set $sid HIDDEN {}
tsv::set $sid PROMPT $PROMPT_DEF
tsv::set $sid SYNCH $SYNCH_DEF
tsv::set $sid OUTBUF_SIZE 100 ;# (@magic-number)
tsv::set $sid BUSY 0
tsv::set $sid LOGTHREAS $LOGTHREAS_DEF
tsv::set $sid TERM 0
}
# Get list of sids of user sessions
#
# @return The sid of all the user sessions in a list
proc user_sessions {} {
variable vtySessions
variable conSessions
return [concat $vtySessions $conSessions]
}
# Get list of sids of background sessions
#
# @return The sid of all the user sessions in a list
proc bg_sessions {} {
variable bgSessions
return $bgSessions
}
# Checks if a session is a user session or not.
#
# @param sid The sid to check if is an user session.
# @return The sid of all the user sessions in a list
proc is_user_session {sid} {
variable vtySessions
variable conSessions
if {$sid in [concat $vtySessions $conSessions]} {
return 1
}
return 0
}
# Checks if a session is an background session or not.
#
# @param sid The sid to check if is an background session.
# @return The sid of all the user sessions in a list
proc is_bg_session {sid} {
variable bgSessions
if {$sid in $bgSessions} {
return 1
}
return 0
}
# Kill shell.
#
# @param shell_pid Shell's PID.
proc kill_shell {shell_pid} {
catch {
kill SIGTERM $shell_pid
kill SIGKILL $shell_pid
}
}
# Proxy input from channel $from to channel $to, while inspecting forwarded data and taking actions
# as necessary. This key sequences are recognized:
# Ctrl ^ + x : Terminate any currently executed command.
# Ctrl ^ + s : Resize terminal screen to correspond to the real terminal dimentions, if it is not does automatically.
# Ctrl ^ + r : Reset terminal screen. Useful if screen is distorded due to output etc.
#
# If connection in either $from or $to is lost, the session $sid is closed automatically.
#
# @param sid Session Id.
# @param from Channel to redirect input from.
# @param to Channel to redirect output to.
proc proxy {sid from to} {
if {[eof $from]} {
fileevent $from readable {}
close_session $sid "Connection with user was lost"
return
}
set data [read $from]
if {[set ::session::special_$sid]} {
switch -exact -- [string index $data 0] {
\u0078 { ;# Ctrl + ^ and then 'x'
# This key sequense should break any executed command. The cases where a command can block are:
# 1. In PTY isloated sessions with "ptyexec" (pty.tcl) like for commands: ping, traceroute, more, ...
# 2. When waiting for user input with procedure "ask" (thread.tcl).
# 3. When a command handler has blocked (due to normal execution or in runaway state),
# and the "blocks" (helper.tcl) procedure has been used to make it non-blocking. Example of this
# kind of block is waiting for a network connection to be establish, or waiting on a blocking read.
# 4. When the event loop of the Session is occupied executing something or is in a runaway state
# (e.g. due to user action in Slave, such as a endless loop) (session.tcl). This case includes also
# registered event handlers executing in Events Session.
# 5. When the event loop of the Session is in a blocked blocked (e.g. due to user action in Slave,
# such as a blocking read). This case is currenly not dealt with anywhere. Any idea how? XXX
# This case includes also registered event handlers executing in Events Session.
# 6. Serving a 'bgexec' invocation.
# Case 1:
thread::send -async $sid ::pty::ptykill
# Case 6:
set ::bgexec_status 1
# Case 3:
::helper::break_event $sid
# Case 4:
Session $sid BUSY
if {$BUSY} {
# We schedule a job in the current thread to cancel the currently executing event in $sid.
# At the same time we send to $sid 's event loop an event to cancel the previously scheduled job.
# If the job is canceled, then it means that the event loop of $sid is free, so the user's Ctrl + ^ + x is
# not for this type of blocking. If however the job is not cancelled, then it is executed, forcing $sid
# to cancel the currently executing event.
set job [after 200 [list thread::cancel $sid "\nbreak sequence pressed"]] ;# (@magic-number)
thread::send -async $sid [list thread::send -async [thread::id] [list after cancel $job]]
}
# Case 2:
# Enforced in proc ask.
# For this reason we let this key sequence to propagate.
}
\u0073 { ;# Ctrl + ^ and then 's'
# Resize $sid terminal
# It has to go via Shell, because the shell only can query the terminal window dimentions.
Session $sid SHELL_PID
kill SIGUSR2 $SHELL_PID
}
\u0072 { ;# Ctrl + ^ and then 'r'
# Reset terminal
# It has to go via Shell, because the shell only can execute the 'reset' command to reset its tty.
Session $sid SHELL_PID
kill SIGUSR1 $SHELL_PID
}
}
set ::session::special_$sid 0
}
switch -exact -- [string index $data 0] {
\u001e { ;# Ctrl + ^ (Enter special mode)
set ::session::special_$sid 1
}
}
if {[eof $to]} {
fileevent $from readable {}
# Probably child has died, or closed standard I/O
close_session $sid "Connection with session was lost"
return
}
puts -nonewline $to $data
}
# Terminate a session and release memory
#
# @param sid Session id
# @param reason The reason for Session termination.
proc close_session {sid {reason "Unspecified"}} {
log::Info "Closing session $sid" "Reason: $reason"
Session $sid USER
Session -rw $sid TERM
set TERM 1
if {$USER} {
Session $sid STDIN_R
fileevent $STDIN_R readable {}
}
::helper::break_event $sid
thread::send $sid ::pty::ptykill
# Wait for some time for the Session thread to clean-up stat that we cannot clean-up hear.
# This can block because the event loop might be blocked in Session interp or Slave interp.
if {[catch {
Thread::bgsend $sid cleanup -timeout 2000 ;# (@magic-number)
} errMsg errStack]} {
log::Error "Failed to properly clean-up session $sid: $errMsg"
}
# Warning: Do not release it again here, misteriously it doesn't get released at all then!
if {$USER} {
Session $sid FIFOINFILE FIFOOUTFILE SHELL_PID SHELL_CID STDOUT2
variable CID2SID
unset CID2SID($SHELL_CID)
catch {close $STDOUT2} ;# The rest get closed in the child thread, where they have been transfered
#close $SHELL_CID
:::comm::comm shutdown $SHELL_CID
catch { file delete $FIFOINFILE $FIFOOUTFILE }
variable vtySessions
variable conSessions
if {$sid in $vtySessions} { lremove vtySessions $sid }
if {$sid in $conSessions} { lremove conSessions $sid }
unset ::session::special_$sid
after 1000 ::session::kill_shell $SHELL_PID ;# (@magic-number)
} else {
variable bgSessions
lremove bgSessions $sid
}
tsv::unset $sid
log::Debug "Session $sid closed"
}
# Close all user sessions
proc close_all_user_sessions {} {
variable vtySessions
variable conSessions
foreach sid [concat $vtySessions $conSessions] {
close_session $sid "Closing all user sessions"
}
}
# Close all background sessions
proc close_all_bg_sessions {} {
variable bgSessions
foreach sid $bgSessions {
close_session $sid "Closing all background sessions"
}
}
# Finds the session Id of the session on behalf of the caller procedure.
# Since the entry point into Master for every MikroConf command execution is
# "::sysconf::execute", and this entry point uses the sid variable to store the
# sessionId, we can retrieve the value of sid from within this procedure.
#
# @assume The entry point is ::sysconf::execute and its second argument is the session id.
#
# @return The session id
# @error
proc get_sessionId {} {
# Although "sysconf execute" is executed as an esemble, in the execution stack it appears as ::sysconf::execute
set entrypoint [info level 1]
if {[lindex $entrypoint 0] eq {::sysconf::execute}} {
return [lindex $entrypoint 1]
}
log::Error -error "This command can only be invoked from within a MikroConf module operating on behalf of a user session"
}
} ;# End of namespace
Overview | Index by: file name |
procedure name |
procedure call |
annotation
File generated 2010-03-13 at 22:28.