5.2. TCL module

5.2.1. Description

This module has an embedded TCL interpreter, and offers several facilities based on TCL language.

TCL and multi-threaded applications: TCL has known problems with multi-thread for years, and authors does not seem to be willing to fix them. That, for example, prevents logging TCL errors correctly, since channels are not thread-safe, for example.

Some of the problems:

  • closing files in threads (note: and in wzdftpd, files are always closed in the same thread they were opened ...)

  • Changing channels does not seem very reliable ...

  • How to log TCL parsing errors etc ? (the author must admit he is no TCL master ...)

If you are a TCL coder with some skills in C and know how to fix these problems, please contact us.

The main feature is to add a protocol for hooks, it means that instead of giving the path to an executable (or script) in a cscript directive or in a custom site command, you can use a TCL script with direct access to server internals

TCL is provided as a module, keeping main server from adding many useless dependancies.

Standard channels are redirected to internal functions in wzdftpd: messages sent to stderr are logged in the file "tclerr.log", located in the directory specified in the logdir directive of the config file.

5.2.2. Installation

Just add the line

module = /path/to/libwzd_tcl.so
in your config file.

You must ensure that the tcl shared library (for ex libtcl8.4.so, or tcl8.4.dll) is accessible (in the PATH or in the same directory), or module loading will fail.

5.2.3. Available TCL commands and variables

5.2.4. A complete example

The following example will teach you how to create a tcl script that is called after each file upload, and checks if zip files are valid by calling an external application (not provided here).


##for wzdftpd community
##simple .zip checker
##
##
##Put in wzd.cfg under 'cscript'
##cscript = POSTUPLOAD tcl:c:/wzdftpd/scripts/zip_check.tcl %username %usergroup {%filepath}
##
##
##set path to unzip.exe
set binary(UNZIP)  "./scripts/unzip.exe"
##
##
##main proc
proc zip_check {} {
  global binary wzd_args

  regsub -all -- {\"} $wzd_args {} wzd_args
  set user [lindex [split $wzd_args] 0]
  set group [lindex [split $wzd_args] 1]
  if {[string match -nocase *.zip [lindex $wzd_args 2]]} {
    catch {exec $binary(UNZIP) -qqt [lindex $wzd_args 2]} zipped
    if {$zipped != ""} {
      catch {file rename -force -- [lindex $wzd_args 2] [lindex $wzd_args 2].bad}
      send_message "+----------------------------------------------------"
      send_message "$user\($group\) uploaded BAD zip file '[file tail [lindex $wzd_args 2]]'."
      send_message "+----------------------------------------------------"
    } else {
      send_message "+----------------------------------------------------"
      send_message "$user\($group\) uploaded GOOD zip file '[file tail [lindex $wzd_args 2]]'."
      send_message "+----------------------------------------------------"
    }
  }
}

zip_check