Overview | Index by: file name | procedure name | procedure call | annotation
base-1.0.tm (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/>.
#

#//#
# The "base" module provides generic commands, such as "exit" and "reload", as well as commands pertaining terminal/console configuration and authentication.
#//#

module provide base 1.0

namespace eval ::module::base {
namespace import ::helper::* ::module::api::*
namespace export dlist_procedures dlist_avail_procs dlist_all_procs auth_username_callback

proc check {} {
    foreach feature [list \
                     CONFIG_ASH \
                     CONFIG_FEATURE_SH_IS_ASH \
                     CONFIG_UPTIME \
                     CONFIG_KILL \
                     CONFIG_VI \
                     \
                     CONFIG_LOGIN \
                     CONFIG_INIT \
                     CONFIG_FEATURE_USE_INITTAB \
                     CONFIG_FEATURE_KILL_REMOVED] {
        if {! [::helper::busybox_has $feature]} { ;# Can return error.
            error "Busybox doesn't have support for $feature."
        }
    }
    
    # No busybox config variable for 'reboot' applet', so we check presense in the filesystem.
    if {[lempty [auto_execok reboot]]} {
        error "Could not find busybox applet \"reboot\""
    }
}

proc description {} {
    return "Generic MikroConf services"
}

proc version {} {
    # Version info for 'base' is printed in 'ShVersion' command.
}

proc constructor {} {
    log::Info "Loading \"base\" module: [description]"
    
    Global ETC_DIR
    variable INIT_FILE [file join $ETC_DIR inittab]
    
    check

    # Store the original values, because they might change later.
    Global HISTORY_DEF FLOW_DEF SYNCH_DEF PROMPT_DEF ANSI_DEF
    variable history_def $HISTORY_DEF
    variable flow_def $FLOW_DEF
    variable synch_def $SYNCH_DEF
    variable prompt_def $PROMPT_DEF
    variable ansi_def $ANSI_DEF
    
    reset

    # Finally load Command Specs
    sysconf loadspecs "modules/base/base.specs"
}

proc destructor {} {
    # First unload Command Specs
    sysconf remove "base"
    
    reset
}

proc reset {} {    
    Global PRIV ADMIN ADMIN_PASS USER CONSOLE_USER ETC_DIR SHELL_BIN NO_SHELL MC_SHELL CON_SHELL
    file delete [glob -nocomplain -type f -- [file join $ETC_DIR passwd]+]
    file delete [glob -nocomplain -type f -- [file join $ETC_DIR shadow]+]
    file delete [glob -nocomplain -type f -- [file join $ETC_DIR group]+]
    fileutil::writeFile [file join $ETC_DIR passwd] ""
    fileutil::writeFile [file join $ETC_DIR shadow] ""
    fileutil::writeFile [file join $ETC_DIR group] ""
    
    auth adduser root $NO_SHELL
    auth makeroot root
    
    if {! [lempty $ADMIN] && ! [lempty $ADMIN_PASS] } {
        auth adduser $ADMIN $SHELL_BIN $ADMIN_PASS
        auth makeroot $ADMIN
    }
    
    auth adduser $PRIV $NO_SHELL
    auth adduser $USER $NO_SHELL
    auth adduser $CONSOLE_USER $CON_SHELL
    auth makeroot $CONSOLE_USER

    # Mapping from user name to password (possibly encrypted).
    variable user_accounts
    array set user_accounts {}
    
    # Set to the encrypted password string. Empty if not enable password is set.
    variable enable_pass {}

    variable console_login 0
    variable console_pass {}

    inittab_reset
    
    # Restore default terminal settings
    Global -rw HISTORY_DEF FLOW_DEF SYNCH_DEF PROMPT_DEF ANSI_DEF
    variable history_def
    variable flow_def
    variable synch_def
    variable prompt_def
    variable ansi_def
    set HISTORY_DEF $history_def
    set FLOW_DEF $flow_def
    set SYNCH_DEF $synch_def
    set PROMPT_DEF $prompt_def
    set ANSI_DEF $ansi_def
    
    # Reset all banners to empty string.
    Global -rw USER_BANNER PRIV_BANNER
    set USER_BANNER ""
    set PRIV_BANNER ""
    variable banner_motd ""
    variable banner_login ""
}

################
# Exported Procedures
################

# Register callback procs to be called when renaming an interface.
proc auth_username_callback {name} {
    variable auth_username_callbacks
    lappend auth_username_callbacks $name
}

################
# Command Handlers
################

command Exit {cmdline argstart sid out no arguments args} {
    sysconf confmode $sid exit
    return
}

command End {cmdline argstart sid out no arguments args} {
    sysconf confmode $sid init
    return
}

command Terminate {cmdline argstart sid out no arguments args} {
    Session $sid USERNAME
    exit 0 "User \"$USERNAME\" requested termination from session $sid"
}

command ConfTerminal {cmdline argstart sid out no arguments args} {
    sysconf confmode $sid set "global"
    return
}

# @todo Print uclibc version
command ShVersion {cmdline argstart sid out no arguments args} {
    global tcl_platform
    Global OSINFO_FILE MCINFO_1LINER VERSION PROC_DIR
    
    set osinfo [::fileutil::cat $OSINFO_FILE]
    set kernel [::fileutil::cat [file join $PROC_DIR "version"]] ;# Note: More info than 'uname'
    set busybox [lindex [split [exec busybox --help] "\n"] 0] ;# Get the first line of output
    set uptime [exec uptime]
    set bootpar [::fileutil::cat [file join $PROC_DIR "cmdline"]]
    set platform [array get tcl_platform]
    set modules [::module::loaded]
    set memory [dict remove [sysinfo] "uptime" "loads"]
    set tcl "[info patchlevel] [info library]"
    
    puts $osinfo
    
    puts "MikroConf: $MCINFO_1LINER"
    puts "Loaded modules: $modules"
    puts "Busybox: $busybox"
    puts "Tcl: $tcl"
    puts "Platform: $platform"
    puts "Memory: $memory"
    puts -nonewline $out "Kernel: $kernel"
    puts -nonewline $out "Boot Param: $bootpar"
    puts "Uptime: $uptime"
    
    puts "Module info:"
    foreach mod $modules {
        puts "Module ${mod}-[::module::version $mod]: [::module::${mod}::description]"
        set v [::module::${mod}::version]
        if {! [lempty $v]} {
            puts $v
        }
    }
    return
}

command ShMikroConfModules {cmdline argstart sid out no arguments args} {
    set loaded [module loaded]
    puts "Available MikroConf Modules. Loaded marked with '*'"
    foreach {file name ver} [module available] {
        if {$name in $loaded} {
            puts -nonewline { * }
        } else {
            puts -nonewline {   }
        }
        puts "$name-$ver"
    }
}

# @todo Save reason somewhere so that we can display after reboot as the reason for last reboot.
command Reload {cmdline argstart sid out no arguments args} {
    Session $sid USERNAME
    
    if {[dict exists $arguments MESSAGE]} {
        set msg [dict get $arguments MESSAGE]
    } else {
        set msg "User request"
    }
    
    if {[dict exists $arguments modules]} {
        module reloadall
    } elseif {[dict exists $arguments warm]} {
        # We rely in init to re-run MikroConf.
        exit 0 "User \"$USERNAME\" requested termination from session $sid"
    } else {
        exec reboot
        exit 0 "User \"$USERNAME\" requested a cold reboot from session $sid; reason: $msg"
    }
    return
}

################################
# Authentication
################################

# @todo Provide busybox feedback for password strength.
# @assume A password prefix of '$1$' indicates MD5 encryption of provided password.
# @bug Start asking for usernames after this command is issued.
command Username {cmdline argstart sid out no arguments args} {
    Global ADMIN USER PRIV CONSOLE_USER VTY_USER MC_SHELL
    variable auth_username_callbacks
    variable user_accounts
    
    set user [dict get $arguments USERNAME]
    if {! [auth name_is_ok $user]} {
        ferror "invalid username string" [getpos USERNAME]
    }
    
    if {$user in "root $ADMIN $USER $CONSOLE_USER $VTY_USER $PRIV"} {
        ferror "username is reserved" [getpos USERNAME]
    }
    
    if {$no} {
        if {$user ni [array names user_accounts]} {
            ferror "unknown username" [getpos USERNAME]
        }
        auth deluser $user
        unset user_accounts($user)
        
        # When the last Username is removed, then switch to Password-only login.
        if {[lempty [array names user_accounts]]} {
            foreach cb $auth_username_callbacks {
                $cb false
            }
            
            auth unlock $CONSOLE_USER
            
            inittab_reset
        }
        return
    }

    set pass [dict get $arguments PASSWORD]

    # Cases for PASSWORD:
    # 1. It is provided on the command line as cleartext, that should be encrypted before stored in config.
    # 2. The command is executed on system boot and PASSWORD is provided already encrypted.
    # Note: A user could also provide a pre-computed MD5 checksum for enable password
    # on the command line. In which case the supplied password must begin with '$1$'.
    
    if {[string match {$1$*} $pass]} {
        # Case 2.
        auth adduser $user $MC_SHELL ;# error propagates
        auth passwd $user $pass -nocrypt ;# error propagates
    } else {
        # Case 1.
        if {! [auth pass_is_ok $pass]} {
            ferror "invalid password string" [getpos PASSWORD]
        }
        set pass [auth adduser $user $MC_SHELL $pass] ;# error propagates
    }

    set user_accounts($user) $pass
    
    # With the first entry, switch to Username/Password login.
    if {[llength [array names user_accounts]] == 1} {
        foreach cb $auth_username_callbacks {
            $cb true
        }
        
        auth lock $CONSOLE_USER
        
        inittab_reset
    }
    
    return
}

proc print_Username {} {
    variable user_accounts
    
    set result {}
    foreach user [array names user_accounts] {
        append result "username $user password {$user_accounts($user)}\n"
    }
    
    if {! [lempty $result]} {
        set result "#\n# Local User Accounts:\n${result}\n"
    }
    
    return $result
}

# @interactive
command Enable {cmdline argstart sid out no arguments args} {
    Global PRIV PRIV_BANNER
    variable enable_pass
    
    if {[sysconf authmode $sid get] eq "priv"} {
        error "already in priviledged mode"
    }
    if {[lempty $enable_pass] || [auth login $PRIV]} {
        sysconf authmode $sid set "priv"
        log::Info "User raised to priviledged level in session $sid"
    } else {
        error "authentication failed"
    }
    
    # Print Privilege Banner
    # We cannot use 'puts' or 'return' because the interpreter it would print is dead now.
    thread::send -async $sid [list puts -nonewline [? [lempty $PRIV_BANNER] "" "${PRIV_BANNER}\n"]]
    
    return
}

command Disable {cmdline argstart sid out no arguments args} {
    sysconf authmode $sid set "user"
    return
}

# @todo Provide busybox feedback for password strength.
# @assume A password prefix of '$1$' indicates MD5 encryption of password.
command EnablePassword {cmdline argstart sid out no arguments args} {
    Global PRIV
    variable enable_pass
    
    if {$no} {
        set enable_pass {}
        auth lock $PRIV
        return
    }
    
    set pass [dict get $arguments PASSWORD]

    if {[string match {$1$*} $pass]} {
        auth passwd $PRIV $pass -nocrypt ;# error propagates
        set enable_pass $pass
    } else {
        if {! [auth pass_is_ok $pass]} {
            ferror "invalid password string" [getpos PASSWORD]
        }
        set enable_pass [auth passwd $PRIV $pass] ;# error propagates
    }
    return
}

proc print_EnablePassword {} {
    variable enable_pass
    if {! [lempty $enable_pass]} {
        return "enable password {$enable_pass}\n"
    }
    return
}

################################
# System Configuration
################################

command ShXml {cmdline argstart sid out no arguments args} {
    return [sysconf print]
}

command ShRunning {cmdline argstart sid out no arguments args} {
    return [sysconf runningConf]
}

command ShStartup {cmdline argstart sid out no arguments args} {
    return [sysconf startupConf]
}

command Write {cmdline argstart sid out no arguments args} {
    sysconf saveConf
    return
}

# @todo Security considerations: Implement virtual chroot within *_DIR for each url type.
command Copy {cmdline argstart sid out no arguments args} {
    lassign $arguments src sval dst dval
    
    if {$src eq "startup-config" && $dst eq "running-config"} {
        module resetall
        sysconf loadConf
        return
    }
    if {$src eq "running-config" && $dst eq "startup-config"} {
        sysconf saveConf
        return
    }

    switch -exact -- $src {
        "startup-config" {
            Global STARTUP_CONFIG_FILE
            set sval $STARTUP_CONFIG_FILE
        }
        "running-config" {
            set sval [::fileutil::tempfile]
            fileutil::writeFile $sval [runningConf]
        }
        "URL" {
            # Leave sval as it is.
        }
    }
    
    switch -exact -- $dst {
        "startup-config" {
            Global STARTUP_CONFIG_FILE
            file copy -force -- $sval $STARTUP_CONFIG_FILE
        }
        "running-config" {
            module resetall
            sysconf loadConf [::fileutil::cat $sval]
            catch { file delete -force -- $sval }
        }
        "URL" {
            file copy -force -- $sval $dval
        }
    }
    return
}

command EraseStartup {cmdline argstart sid out no arguments args} {
    Global STARTUP_CONFIG_FILE
    file delete -force -- $STARTUP_CONFIG_FILE
    return
}

command EraseRunning {cmdline argstart sid out no arguments args} {
    module resetall
    foreach p [procedures getlist] {
        procedures unregister $p
    }
    return
}

################################
# Terminal
################################

# @limit The setting is discarted when window size changes as reported by shell.
# @diff Use of this instead of "terminal length" & "terminal width".
command TermWindow {cmdline argstart sid out no arguments args} {
    Session -rw $sid ROWS COLUMNS
    
    if {$no} {
        Global DEFAULT_ROWS DEFAULT_COLS
        set ROWS $DEFAULT_ROWS
        set COLUMNS $DEFAULT_COLS
    } else {
        set ROWS [dict get $arguments ROWS]
        set COLUMNS [dict get $arguments COLUMNS]
    }
    
    seval [list ::cli::handleAction RedrawScreen]
    return
}

command TermAnsi {cmdline argstart sid out no arguments args} {
    Session -rw $sid ANSI
    if {$no} {
        set ANSI 0
    } else {
        set ANSI 1
    }
    return
}

command TermAnsi_config {cmdline argstart sid out no arguments args} {
    Global -rw ANSI_DEF
    if {$no} {
        set ANSI_DEF 0
    } else {
        set ANSI_DEF 1
    }
    return
}

proc print_TermAnsi_config {} {
    Global ANSI_DEF
    variable ansi_def
    if {$ansi_def ne $ANSI_DEF} {
        if {$ANSI_DEF} {
            return "terminal advanced-ansi\n"
        } else {
            return "no terminal advanced-ansi\n"
        }
    }
    return
}

command TermPrompt {cmdline argstart sid out no arguments args} {
    Session -rw $sid PROMPT
    if {$no} {
        Global PROMPT_DEF
        set PROMPT $PROMPT_DEF
    } else {
        set PROMPT [dict get $arguments PROMPT]
    }
    return
}

command TermPrompt_config {cmdline argstart sid out no arguments args} {
    Global -rw PROMPT_DEF
    if {$no} {
            variable prompt_def
            set PROMPT_DEF $prompt_def
    } else {
            set PROMPT_DEF [dict get $arguments PROMPT]
    }
    return
}

proc print_TermPrompt_config {} {
    Global PROMPT_DEF
    variable prompt_def
    if {$prompt_def ne $PROMPT_DEF} {
        return "terminal prompt $PROMPT_DEF\n"
    }
    return
}

command TermHistory {cmdline argstart sid out no arguments args} {
    Session -rw $sid HISTORY HISTORY_SIZE HISTORY_ENTRIES
    set size [dict get $arguments SIZE]
    if {! [string is integer $size] || $size < 0 || $size > 256} { ;# (@magic-number)
        ferror "must be a number in the range range 0..256" [getpos SIZE]
    }
    set HISTORY_SIZE $size
    if {$HISTORY_ENTRIES > $size} {
        set HISTORY_ENTRIES $size
        incr size -1 ;# because "lrange {1 2 3} end-0 end" gives "3".
        set HISTORY [lrange $HISTORY end-$size end] 
    }
    return
}

command TermHistory_config {cmdline argstart sid out no arguments args} {
    Global -rw HISTORY_DEF
    set size [dict get $arguments SIZE]
    if {! [string is integer $size] || $size < 0 || $size > 256} { ;# (@magic-number)
        ferror "must be a number in the range range 0..256" [getpos SIZE]
    }
    set HISTORY_DEF $size
    return
}

proc print_TermHistory_config {} {
    Global HISTORY_DEF
    variable history_def
    if {$history_def ne $HISTORY_DEF} {
        return "terminal history $HISTORY_DEF\n"
    }
    return
}

# @diff Use of this instead of "terminal length 0"
command TermFlow {cmdline argstart sid out no arguments args} {
    Session -rw $sid FLOW
    if {$no} {
            set FLOW 0
    } else {
            set FLOW 1
    }
    return
}

# @diff Use of this instead of "terminal length 0"
command TermFlow_config {cmdline argstart sid out no arguments args} {
    Global -rw FLOW_DEF
    if {$no} {
            set FLOW_DEF 0
    } else {
            set FLOW_DEF 1
    }
    return
}

proc print_TermFlow_config {} {
    Global FLOW_DEF
    variable flow_def
    if {$flow_def ne $FLOW_DEF} {
        if {$FLOW_DEF} {
            return "terminal flow-control\n"
        } else {
            return "no terminal flow-control\n"
        }
    }
    return
}

command TermSynch {cmdline argstart sid out no arguments args} {
    Session -rw $sid SYNCH
    if {$no} {
            set SYNCH 0
    } else {
            set SYNCH 1
    }
    return
}

command TermSynch_config {cmdline argstart sid out no arguments args} {
    Global -rw SYNCH_DEF
    if {$no} {
            set SYNCH_DEF 0
    } else {
            set SYNCH_DEF 1
    }
    return
}

proc print_TermSynch_config {} {
    Global SYNCH_DEF
    variable synch_def
    if {$synch_def ne $SYNCH_DEF} {
        if {$SYNCH_DEF} {
            return "terminal synchronous\n"
        } else {
            return "no terminal synchronous\n"
        }
    }
    return
}

command ShHistory {cmdline argstart sid out no arguments args} {
    Session $sid HISTORY
    return [join [lreverse $HISTORY] "\n"]
}

################################
# Procedures
################################

command RegProc {cmdline argstart sid out no arguments args} {
    set name [dict get $arguments NAME]
    if {$no} {
        procedures unregister $name
    } else {
        procedures register $sid $name
    }
    return
}

proc dlist_procedures {sid args} {
    procedures getlist
}

proc dlist_avail_procs {sid args} {
    Session $sid SLAVE
    seval [list $SLAVE invokehidden info procs]
}

proc dlist_all_procs {sid args} {
    ::struct::set union [dlist_procedures $sid] [dlist_avail_procs $sid]
}

command ShProcedures {cmdline argstart sid out no arguments args} {
    if {[dict exists $arguments NAME]} {
        set name [dict get $arguments NAME]
        lassign [procedures getproc $name] arg body ;# checks it exists.
        puts "proc $name {$args} {$body}"
    } else {
        foreach name [procedures getlist] {
            lassign [procedures getproc $name] args body
            puts "proc $name {$args} {$body}\n"
        }
    }
    return
}

proc print_RegProc {} {
    set result {}
    foreach name [procedures getlist] {
        lassign [procedures getproc $name] args body
        append result "proc $name {$args} {$body}\n"
        append result "register procedure $name\n\n"
    }

    if {! [lempty $result]} {
        set result "#\n# List of user defined procedures:\n${result}\n"
    }
    
    return $result
}

################################
# Scripting
################################

command Scripting {cmdline argstart sid out no arguments args} {
    if {$no} {
            # We don't allow to deactivate scripting on an Events Session.
            # After all that is what it is all about, to evaluate scripts (event handlers).
            Global EVENT
            if {$sid eq $EVENT} {
                    error "scripting cannot be deactivated in this session"
            }
            seval [list ::policy::scripting off]
    } else {
            seval [list ::policy::scripting on]
    }
    return
}

################################
# Console Configuration
################################

proc inittab_reset {} {
    variable console_login
    variable user_accounts
    variable INIT_FILE
    
    if {$console_login} {
        if {! [lempty [array names user_accounts]]} {
            fileutil::writeFile $INIT_FILE \
{::sysinit:/etc/init.d/mikroconf start
::shutdown:/sbin/halt
tts/0::askfirst:/bin/login
ttyS0::askfirst:/bin/login
tty1::askfirst:/bin/login
}
        } else {
            fileutil::writeFile $INIT_FILE \
{::sysinit:/etc/init.d/mikroconf start
::shutdown:/sbin/halt
tts/0::askfirst:/bin/login console
ttyS0::askfirst:/bin/login console
tty1::askfirst:/bin/login console
}
        }
    } else {
        Global CON_SHELL
        fileutil::writeFile $INIT_FILE \
"::sysinit:/etc/init.d/mikroconf start
::shutdown:/sbin/halt
tts/0::askfirst:$CON_SHELL
ttyS0::askfirst:$CON_SHELL
tty1::askfirst:$CON_SHELL
"
    }
    
    kill SIGHUP 1 ;# init
}

command LineConsole {cmdline argstart sid out no arguments args} {
    set num [dict get $arguments "0"]
    if {$num != 0} {
        ferror "invalid conlose port number" [getpos "0"]
    }
    unset num ;# We don't use it
    
    sysconf confmode $sid set "console"
    return
}

command ConsoleLogin {cmdline argstart sid out no arguments args} {
    variable console_login
    
    if {$no} {
        set console_login 0
    } else {
        set console_login 1
    }
    inittab_reset
    return
}
    
# @bug sending SIGHUP to init in order to reread inittab will cause current MikroConf session to terminate and ask user to re-login.
command ConsolePassword {cmdline argstart sid out no arguments args} {
    Global CONSOLE_USER
    variable console_pass
    variable user_accounts
    
    if {$no} {
        set console_pass {}
        auth lock $CONSOLE_USER
        return
    }
    
    set pass [dict get $arguments PASSWORD]

    if {[string match {$1$*} $pass]} {
        auth passwd $CONSOLE_USER $pass -nocrypt ;# error propagates
    } else {
        if {! [auth pass_is_ok $pass]} {
            ferror "invalid password string" [getpos PASSWORD]
        }
        set pass [auth passwd $CONSOLE_USER $pass]
        
        # Be careful not to unlock CONSOLE_USER if Usernames are used.
        if {[lempty [array list user_accounts]]} {
            auth unlock $CONSOLE_USER
        } else {
            auth lock $CONSOLE_USER
        }
    }
    
    set console_pass $pass
    return
}

proc print_LineConsole {} {
    variable console_login
    variable console_pass
    
    set result {}
    
    if {$console_login || ! [lempty $console_pass]} {
        append result "#\n# Console Settings:\n"
        append result "line console 0\n"
    
        if {$console_login} {
            append result "\tlogin\n"
        }
        if {! [lempty $console_pass]} {
            append result "\tpassword {$console_pass}\n"
        }
        
        append result "  exit\n\n"
    }
        
    return $result
}

################################
# System Banners
################################

command BannerMotd {cmdline argstart sid out no arguments args} {
    Global ETC_DIR
    variable banner_login
    variable banner_motd
    
    if {$no} {
        set banner_motd ""
    } else {
        set banner_motd [dict get $arguments TEXT]
    }
    
    fileutil::writeFile [file join $ETC_DIR issue] "[? [lempty $banner_motd] "" ${banner_motd}\n][? [lempty $banner_login] "" ${banner_login}\n]"
    return
}

proc print_BannerMotd {} {
    variable banner_motd
    
    if {! [lempty $banner_motd]} {
        return "banner motd {$banner_motd}\n"
    }
    return
}

command BannerLogin {cmdline argstart sid out no arguments args} {
    Global ETC_DIR
    variable banner_motd
    variable banner_login
    
    if {$no} {
        set banner_login ""
    } else {
        set banner_login [dict get $arguments TEXT]
    }
    
    fileutil::writeFile [file join $ETC_DIR issue] "[? [lempty $banner_motd] "" ${banner_motd}\n][? [lempty $banner_login] "" ${banner_login}\n]"
    return
}

proc print_BannerLogin {} {
    variable banner_login
    
    if {! [lempty $banner_login]} {
        return "banner login {$banner_login}\n"
    }
    return
}

command BannerUser {cmdline argstart sid out no arguments args} {
    Global -rw USER_BANNER
    
    if {$no} {
        set USER_BANNER ""
    } else {
        set USER_BANNER [dict get $arguments TEXT]
    }
    return
}

proc print_BannerUser {} {
    Global USER_BANNER
    if {! [lempty $USER_BANNER]} {
        return "banner user {$USER_BANNER}\n"
    }
    return
}

command BannerPrivilege {cmdline argstart sid out no arguments args} {
    Global -rw PRIV_BANNER
    
    if {$no} {
        set PRIV_BANNER ""
    } else {
        set PRIV_BANNER [dict get $arguments TEXT]
    }
    return
}

proc print_BannerPrivilege {} {
    Global PRIV_BANNER
    if {! [lempty $PRIV_BANNER]} {
        return "banner privilege {$PRIV_BANNER}\n"
    }
    return
}

################################
# Generic Utilities
################################

# @interactive
command Escape {cmdline argstart sid out no arguments args} {
    Global BASE_DIR
    # We need to execute our own script in order to set the right
    # terminal settings (stty), change current path, etc..
    ptyexec -root -- sh [file join $BASE_DIR escape.sh]
    return
}

# @interactive
command EditStartup {cmdline argstart sid out no arguments args} {
    set tempfile [::fileutil::tempfile]
    # tempfiles will be deleted automatically by other means.
    
    Global STARTUP_CONFIG_FILE
    file copy -force -- $STARTUP_CONFIG_FILE $tempfile
    ptyexec vi $tempfile
    file copy -force -- $tempfile $STARTUP_CONFIG_FILE
    return
}

# @interactive
command EditRunning {cmdline argstart sid out no arguments args} {
    set tempfile [::fileutil::tempfile]
    # tempfiles will be deleted automatically by other means.
    
    fileutil::writeFile $tempfile [sysconf runningConf]
    ptyexec vi $tempfile
    module resetall
    sysconf loadConf [::fileutil::cat $tempfile]
    return
}

# @interactive
command EditProc {cmdline argstart sid out no arguments args} {
    set tempfile [::fileutil::tempfile]
    # tempfiles will be deleted automatically by other means.
    
    Session $sid SLAVE
    set registered [dlist_procedures $sid]
    set available [dlist_avail_procs $sid]
    set name [dict get $arguments NAME]
    
    if {$name in $registered} {
        lassign [procedures getproc $name] arg body ;# checks it exists.
        fileutil::writeFile $tempfile "proc $name {$arg} {$body}"
        ptyexec vi $tempfile
        seval [list $SLAVE invokehidden source $tempfile]
        procedures register $sid $name ;# update
    } elseif {$name in $available} {
        set arg [seval [list $SLAVE invokehidden info args $name]]
        set body [seval [list $SLAVE invokehidden info body $name]]
        fileutil::writeFile $tempfile "proc $name {$arg} {$body}"
        ptyexec vi $tempfile
        seval [list $SLAVE invokehidden source $tempfile]
    } else {
        fileutil::writeFile $tempfile "proc $name {args} {\n}"
        ptyexec vi $tempfile
        seval [list $SLAVE invokehidden source $tempfile]        
    }
    return
}

} ;# End of Namespace

Overview | Index by: file name | procedure name | procedure call | annotation
File generated 2010-03-13 at 22:28.