Class ::ftpd::Session (public)

 ::nx::Class ::ftpd::Session[i]

Defined in

Testcases:
No testcase defined.
Source code:
namespace eval ::ftpd {}
::nsf::object::alloc ::nx::Class ::ftpd::Session {}
::ftpd::Session protected method AUTH option {
            if {$option eq "TLS"} {
                :reply "534 not accepting TLS"
                #:reply "234 not yet done"
            } else {
                :reply "504 unrecognized security mechanism $option"
            }
        }
::ftpd::Session protected method CDUP args {
            :CWD ..
        }
::ftpd::Session protected method CWD directory {
            #
            # Check if path is absolute or relative
            #
            if {[string match "/*" $directory]} {
                set newdir ${:rootdir}$directory
            } else {
                set newdir ${:currentdir}/$directory
            }

            #
            # Normalize the path and check validity
            #
            set newdir [file normalize $newdir]
            :log debug "currentdir <${:currentdir}> rootdir <${:rootdir}> newdir <$newdir>"

            if {[string length $newdir] < [string length ${:rootdir}]
                || ![file readable $newdir]
                || ![file isdirectory $newdir]
            } {
                :reply "550 cannot change to directory $directory"
            } else {
                set :currentdir $newdir
                :reply "250 Okay."
            }
        }
::ftpd::Session protected method EPRT arg {
            # This method depends on "ns_connchan opensocket", which
            # is not implemented yet.
            if {![regexp {^[|]([^|]+)[|]([^|]+)[|]([^|]+)[|]$} $arg . proto host port]} {
                :reply "501 Bad Argument"
                :log warning "EPRT -> bad arg"
            } else {
                :log debug "EPRT: call open to host <$host> port <$port>"
                #set :data [ns_connchan opensocket $host $port]
                :log debug "EPRT: listen on fresh port $port DONE"
                :reply "200 Command OK"
            }
        }
::ftpd::Session protected method EPSV args {
            # RFC2428: entering extended passive mode. It accepts an
            # optional argument.  When the EPSV command is issued with
            # no argument, the server will choose the network protocol
            # for the data connection based on the protocol used for
            # the control connection.
            set dict [ns_connchan listen -bind ${:host} 0 [list [self] listen_data]]
            #:log debug "EPSV $dict"
            :reply "229 Entering Extended Passive Mode (|||[dict get $dict port]|)"
            set :listen [dict get $dict channel]
        }
::ftpd::Session protected method FEAT args {
            :reply "211-Extensions:"
            :reply " UTF8"
            :reply " LANG EN"
            #:reply " AUTH TLS"
            :reply " MDTM"
            :reply " MLST size*;type*;perm*;create*;modify*;"
            :reply "211 End"
        }
::ftpd::Session protected method LIST arg {
            :require_data $arg {
                :reply "150 Opening ASCII mode data connection for /bin/ls."
                :write_data -plain [:file dir list $arg]
                :close_data
                :reply "226 Transfer complete."
            }
        }
::ftpd::Session protected method MDTM filename {
            if {[:file exists $filename]} {
                :reply "213 [:file lastmodified $filename]"
            } else {
                :reply "550 File not found"
            }
        }
::ftpd::Session protected method MLSD arg {
            :require_data $arg {
                :reply "150 Opening ASCII mode data connection for /bin/ls."
                :write_data -plain [:file dir mlst $arg]
                :close_data
                :reply "226 Transfer complete."
            }
        }
::ftpd::Session protected method NLST arg {
            :require_data $arg {
                :reply "150 Opening ASCII mode data connection for NLST."
                :write_data -plain [:file dir name $arg]
                :close_data
                :reply "226 Transfer complete."
            }
        }
::ftpd::Session protected method OPTS arg {
            :log warning "opts $arg acknowledged, but ignored"
            :reply "200 Ok"
        }
::ftpd::Session protected method PASS pass {
            :reply "230 User ${:user} logged in.  Access restrictions apply."
        }
::ftpd::Session protected method PASV args {
            # Old style passive mode, just for IPv4. New clients should
            # use EPSV. However, PASV is still used by many clients.
            set dict [ns_connchan listen -bind ${:host} 0 [list [self] listen_data]]
            set port [dict get $dict port]
            :reply "227 Entering Passive Mode ([string map {. ,} [dict get $dict address]],[expr {$port/256}],[expr {$port%256}])"
            set :listen [dict get $dict channel]
        }
::ftpd::Session protected method PWD pass {
            :reply "257 \"[string range ${:currentdir} [string length ${:rootdir}] end]/\""
        }
::ftpd::Session protected method QUIT args {
            :reply "221 Goodbye."
            :destroy
        }
::ftpd::Session protected method RETR arg {
            :require_data $arg {
                set filename $arg
                if {[:file exists $filename]} {
                    :reply "150 Opening data connection for returning data."
                    set F [:file open $filename r]; set data [read $F]; close $F
                    :write_data $data
                    :reply "226 Transfer complete."
                } else {
                    :reply "550 File not found."
                }
                :close_data
            }
        }
::ftpd::Session protected method SIZE filename {
            if {[:file exists $filename]} {
                :reply "215 [:file size $filename]"
            } else {
                :reply "550 File not found."
            }
        }
::ftpd::Session protected method SYST args {
            :reply "215 [string toupper $::tcl_platform(platform)] Type: ${:type}"
        }
::ftpd::Session protected method TYPE kind {
            set :type $kind
            :reply "200 Type set to $kind"
        }
::ftpd::Session protected method USER name {
            set :user $name
            :reply "331 Password required for $name"
        }
::ftpd::Session public method close_data {} {
            if {[info exists :data]} {
                :log debug "closing data channel ${:data}"
                ns_connchan close ${:data}
                unset :data
            }
        }
::ftpd::Session protected method destroy {} {
            :log debug "session stopping"
            if {[ns_connchan exists ${:channel}]} {
                ns_connchan close ${:channel}
            }
            next
        }
::ftpd::Session protected method {file dir} {type arg} {
            set files [:file glob $arg]
            set result ""
            foreach file $files {
                append result [:file format $type $file] \n
            }
            return $result
        }
::ftpd::Session protected method {file exists} filename {
            return [file exists ${:currentdir}/$filename]
        }
::ftpd::Session protected method {file format date} seconds {
            set currentTime [clock seconds]
            set oldTime [clock scan "6 months ago" -base $currentTime]
            if {$seconds <= $oldTime} {
                set time [clock format $seconds -format "%Y"]
            } else {
                set time [clock format $seconds -format "%H:%M"]
            }
            set day [string trimleft [clock format $seconds -format "%d"] 0]
            set month [clock format $seconds -format "%b"]
            return [format "%3s %2s %5s" $month $day $time]
        }
::ftpd::Session protected method {file format list} file {
            file stat $file stat
            if {$::tcl_platform(platform) eq "unix"} {
                set user [file attributes $file -owner]
                set group [file attributes $file -group]
            } else {
                set user owner
                set group
            }
            return [format "%s %3d %8s %8s %11s %s %s"  [:file format permissions [file type $file$stat(mode)]  $stat(nlink)  $user  $group  $stat(size)  [:file format date $stat(mtime)]  [file tail $file]]
        }
::ftpd::Session protected method {file format mlst} file {
            #  MLST size*;type*;perm*;create*;modify*;
            set perm ""
            file stat $file stat

            if {[file isdirectory $file]} {
                # maybe distinguish between dir/cdir/pdir rfc3659 7.5.1
                set type dir
                if {[file readable $file]} {append perm "l"}
                if {[file executable $file]} {append perm "e"}
                if {[file writable $file]} {append perm "cdm"}

            } else {
                set type file
                if {[file readable $file]} {append perm "r"}
                if {[file writable $file]} {append perm "fwd"}
            }
            set ctime [clock format $stat(ctime) -format "%Y%m%d%H%M%S"]
            set mtime [clock format $stat(mtime) -format "%Y%m%d%H%M%S"]
            append result  "Size=[file size $file];"  "Type=$type;"  "Perm=$perm;"  "Create=$ctime;"  "Modify=$mtime;"  " " [file tail $file]
            return $result
        }
::ftpd::Session protected method {file format name} file {
            return [file tail $file]
        }
::ftpd::Session protected method {file format permissions} {type mode} {
            if {$type eq "file"} {
                set permissions "-"
            } else {
                set permissions [string index $type 0]
            }
            foreach j [split [format %03o [expr {$mode & 0777}]] {}] {
                append permissions [dict get ${:permission_bits} $j]
            }
            return $permissions
        }
::ftpd::Session protected method {file glob} pattern {
            # Some clients send a "-a" or a "-l", Skip it.
            regexp {^-[al]\s*(.*)$} $pattern . pattern
            if {$pattern eq ""} {
                set pattern "*"
            }
            return [lsort [glob -directory ${:currentdir}/ -nocomplain -- $pattern]]
        }
::ftpd::Session protected method {file lastmodified} filename {
            return [clock format [file mtime ${:currentdir}/$filename] -format "%Y%m%d%H%M%S"]
        }
::ftpd::Session protected method {file open} {filename mode} {
            return [open ${:currentdir}/$filename $mode]
        }
::ftpd::Session protected method {file size} filename {
            # minimal implementation, should return different results based on TYPE"
            return [file size ${:currentdir}/$filename]
        }
::ftpd::Session protected method init {} {
            :log debug "session starting"
            ns_connchan callback ${:channel} [list [self] read_handler] rex
            :reply "220- NaviServer FTP access. Access is available as anonymous."
            :reply "220 NaviServer FTP server [ns_info patchlevel] ready."
            next
        }
::ftpd::Session public method listen_data channel {
            ns_connchan close ${:listen}
            unset :listen
            :log debug "listen_data sets :data <$channel>"
            set :data $channel
            :log debug "have delayed cmds [info exists :delayed_cmds]"
            if {[info exists :delayed_cmds]} {
                foreach {lambda arg} ${:delayed_cmds} {
                    apply $lambda $arg
                }
                unset :delayed_cmds
            }
        }
::ftpd::Session public method read_handler condition {
            set bytes [encoding convertfrom utf-8 [ns_connchan read ${:channel}]]
            set rlen [string length $bytes]
            #:log debug "read_handler: ${:channel} $rlen <[string trim $bytes]>"
            set result 0
            if {0 && $rlen == 0} {
                :log debug "client has closed connection"
            } else {
                #
                # Some clients send multiple lines/commands in one transmission
                #
                foreach line [split [string trim $bytes] \n] {
                    set line [string trim $line]
                    :log debug "${:channel} <<< $line"
                    if {$line eq ""} continue
                    if {[regexp {^([A-Za-z]+)\s?(.*)$} $line . cmd arg]} {
                        set cmd [string toupper $cmd]
                        if {[:info lookup method $cmd] ne ""} {
                            :$cmd $arg
                            set result 1
                        } else {
                            :log warning "502 Requested action <$cmd> not taken"
                            :reply "502 Requested action <$cmd> not taken"
                        }
                    } else {
                        :log warning "line <$line> does not look like a valid command"
                    }
                }
            }
            return $result
        }
::ftpd::Session protected method reply msg {
            :log debug "${:channel} >>> $msg"
            ns_connchan write ${:channel} "$msg\r\n"
        }
::ftpd::Session protected method require_data {arg cmd} {
            if {![info exists :data]} {
                :log notice ":data is not jet available, retry when connect from client finished"
                lappend :delayed_cmds [list arg $cmd$arg
            } else {
                apply [list arg $cmd$arg
            }
        }
::ftpd::Session protected method write_data {-plain:switch data} {
            if {$plain} {
                set prevType ${:type}
                set :type L8
            }
            if {${:type} eq "I"} {
                ns_connchan write ${:data} $data
            } else {
                :log debug "DATA\n$data"
                ns_connchan write ${:data} [encoding convertto utf-8 [string map [list \n \r\n] $data]]
            }
            if {$plain} {
                set :type $prevType
            }
        }
::nsf::relation::set ::ftpd::Session superclass ::ftpd::Infrastructure


::nx::slotObj -container slot ::ftpd::Session

::nsf::object::alloc ::nx::VariableSlot ::ftpd::Session::slot::host {set :accessor none
   set :configurable true
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::ftpd::Session
   set :incremental 0
   set :manager ::ftpd::Session::slot::host
   set :methodname host
   set :multiplicity 1..1
   set :name host
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}


::nsf::object::alloc ::nx::VariableSlot ::ftpd::Session::slot::permission_bits {set :accessor none
   set :configurable false
   set :convert false
   set :default {0 --- 1 --x 2 -w- 3 -wx 4 r-- 5 r-x 6 rw- 7 rwx}
   set :defaultmethods {}
   set :disposition alias
   set :domain ::ftpd::Session
   set :incremental 0
   set :manager ::ftpd::Session::slot::permission_bits
   set :methodname permission_bits
   set :multiplicity 1..1
   set :name permission_bits
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

::nsf::object::alloc ::nx::VariableSlot ::ftpd::Session::slot::data {set :accessor none
   set :configurable false
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::ftpd::Session
   set :incremental 0
   set :manager ::ftpd::Session::slot::data
   set :methodname data
   set :multiplicity 1..1
   set :name data
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

::nsf::object::alloc ::nx::VariableSlot ::ftpd::Session::slot::currentdir {set :accessor none
   set :configurable true
   set :convert false
   set :default {[file normalize [ns_server pagedir]/]}
   set :defaultmethods {}
   set :disposition alias
   set :domain ::ftpd::Session
   set :incremental 0
   set :manager ::ftpd::Session::slot::currentdir
   set :methodname currentdir
   set :multiplicity 1..1
   set :name currentdir
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nsf::object::alloc ::nx::VariableSlot ::ftpd::Session::slot::listen {set :accessor none
   set :configurable false
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::ftpd::Session
   set :incremental 0
   set :manager ::ftpd::Session::slot::listen
   set :methodname listen
   set :multiplicity 1..1
   set :name listen
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

::nsf::object::alloc ::nx::VariableSlot ::ftpd::Session::slot::channel {set :accessor none
   set :configurable true
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::ftpd::Session
   set :incremental 0
   set :manager ::ftpd::Session::slot::channel
   set :methodname channel
   set :multiplicity 1..1
   set :name channel
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

::nsf::object::alloc ::nx::VariableSlot ::ftpd::Session::slot::type {set :accessor none
   set :configurable false
   set :convert false
   set :default L8
   set :defaultmethods {}
   set :disposition alias
   set :domain ::ftpd::Session
   set :incremental 0
   set :manager ::ftpd::Session::slot::type
   set :methodname type
   set :multiplicity 1..1
   set :name type
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

::nsf::object::alloc ::nx::VariableSlot ::ftpd::Session::slot::rootdir {set :accessor none
   set :configurable true
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::ftpd::Session
   set :incremental 0
   set :manager ::ftpd::Session::slot::rootdir
   set :methodname rootdir
   set :multiplicity 1..1
   set :name rootdir
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}
XQL Not present:
Generic, PostgreSQL, Oracle
[ hide source ] | [ make this the default ]
Show another procedure: