Tcl Library Source Code

Check-in [0adb77c50b]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Ticket [eb0b15d598] - ftp - Extended debug narrative for the state machine operation to help investigation of the problem
Timelines: family | ancestors | descendants | both | ftp-bug-eb0b15d598
Files: files | file ages | folders
SHA1: 0adb77c50b3c8ac8063b787ba775d8d9f625248c
User & Date: andreask 2014-01-29 21:11:29
Context
2014-02-12
05:53
Updated to release 1.16 check-in: e891598c4c user: aku tags: ftp-bug-eb0b15d598
2014-01-29
21:11
Ticket [eb0b15d598] - ftp - Extended debug narrative for the state machine operation to help investigation of the problem check-in: 0adb77c50b user: andreask tags: ftp-bug-eb0b15d598
19:29
Ticket [f58015fbd0]: ftp - DisplayMsg - Removed bogus use of ::errorInfo. Simplified the code a bit. check-in: 3b14767f50 user: andreask tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/ftp/ftp.tcl.

114
115
116
117
118
119
120



121
122
123
124
125
126
127
...
140
141
142
143
144
145
146

147
148
149
150


151
152
153
154
155


156
157
158
159
160
161
162
163

164
165
166
167
168
169
170
...
231
232
233
234
235
236
237


238
239
240
241
242
243
244
...
304
305
306
307
308
309
310


311
312
313

314
315
316
317
318
319
320
321
322
323
324
325
326

327
328
329
330
331
332


333
334
335
336
337
338
339
...
780
781
782
783
784
785
786

787
788
789
790
791
792
793
....
1030
1031
1032
1033
1034
1035
1036


1037
1038


1039


1040
1041
1042
1043
1044
1045
1046
....
1057
1058
1059
1060
1061
1062
1063


1064
1065
1066
1067
1068
1069


1070
1071
1072
1073
1074
1075
1076
....
1133
1134
1135
1136
1137
1138
1139

1140


1141
1142
1143
1144
1145
1146
1147
....
1154
1155
1156
1157
1158
1159
1160


1161
1162
1163
1164
1165
1166
1167
1168
1169
1170


1171


1172
1173
1174
1175
1176

1177
1178
1179
1180
1181
1182


1183
1184


1185
1186
1187


1188
1189
1190
1191
1192
1193
1194
....
2779
2780
2781
2782
2783
2784
2785




2786
2787
2788
2789
2790
2791
2792
....
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
# Handle timeouts
# 
# Arguments:
#  -
#
proc ::ftp::Timeout {s} {
    upvar ::ftp::ftp$s ftp




    after cancel $ftp(Wait)
    set ftp(state.control) 1

    DisplayMsg "" "Timeout of control connection after $ftp(Timeout) sec.!" error
    Command $ftp(Command) timeout
    return
................................................................................
# 
# Arguments:
#  -		
#

proc ::ftp::WaitOrTimeout {s} {
    upvar ::ftp::ftp$s ftp


    set retvar 1

    if { ![string length $ftp(Command)] && [info exists ftp(state.control)] } {



        set ftp(Wait) [after [expr {$ftp(Timeout) * 1000}] [list [namespace current]::Timeout $s]]

        vwait ::ftp::ftp${s}(state.control)
        set retvar $ftp(state.control)


    }

    if {$ftp(Error) != ""} {
        set errmsg $ftp(Error)
        set ftp(Error) ""
        DisplayMsg $s $errmsg error
    }


    return $retvar
}

#############################################################################
#
# WaitComplete --
#
................................................................................
#			the socket channel identifier.

proc ::ftp::StateHandler {s {sock ""}} {
    upvar ::ftp::ftp$s ftp
    variable DEBUG 
    variable VERBOSE



    # disable fileevent on control socket, enable it at the and of the state machine
    # fileevent $ftp(CtrlSock) readable {}
		
    # there is no socket (and no channel to get) if called from a procedure

    set rc "   "
    set msgtext {}
................................................................................
            if {![string equal $ftp(State) "quit_sent"]} {
		set ftp(Error) "Service not available!"
	    }
            CloseDataConn $s
            WaitComplete $s 0
	    Command $ftp(Command) terminated
            catch {unset ftp(State)}


            return
        } else {
	    # Fix SF bug #466746: Incomplete line, do nothing.

	    return	   
	}
    } 
	
    if { $DEBUG } {
        DisplayMsg $s "-> rc=\"$rc\"\n-> msgtext=\"$msgtext\"\n-> state=\"$ftp(State)\""
    }

    # In asynchronous mode, should we move on to the next state?
    set nextState 0
	
    # system status replay
    if { [string equal $rc "211"] } {

        return
    }

    # use only the first digit 
    regexp -- "^\[0-9\]?" $rc rc
	


    switch -exact -- $ftp(State) {
        user { 
            switch -exact -- $rc {
                2 {
                    PutsCtrlSock $s "USER $ftp(User)"
                    set ftp(State) passwd
		    Command $ftp(Command) user
................................................................................
                }
            }
        }
        put_close {
            switch -exact -- $rc {
		1 {
		    # Keep going

		    return
		}
                2 {
                    set complete_with 1
		    set nextState 1
		    Command $ftp(Command) put $ftp(RemoteFilename)
                }
................................................................................
            }
        }
	default {
	    error "Unknown state \"$ftp(State)\""
	}
    }



    # finish waiting 
    if { [info exists complete_with] } {


        WaitComplete $s $complete_with


    }

    # display control channel message
    if { [info exists buffer] } {
        if { $VERBOSE } {
            foreach line [split $buffer \n] {
                DisplayMsg $s "C: $line" control
................................................................................
    }

    # If operating asynchronously, commence next state
    if {$nextState && [info exists ftp(NextState)] && [llength $ftp(NextState)]} {
	# Pop the head of the NextState queue
	set ftp(State) [lindex $ftp(NextState) 0]
	set ftp(NextState) [lreplace $ftp(NextState) 0 0]


	StateHandler $s
    }

    # enable fileevent on control socket again
    #fileevent $ftp(CtrlSock) readable [list ::ftp::StateHandler $ftp(CtrlSock)]



}

#############################################################################
#
# Type --
#
# REPRESENTATION TYPE - Sets the file transfer type to ascii or binary.
................................................................................
# Arguments:
# dir - 		directory to list 
# 
# Returns:
# sorted list of files or {} if listing fails

proc ::ftp::NList {s { dir ""}} {

    upvar ::ftp::ftp$s ftp



    if { ![info exists ftp(State)] } {
        if { ![string is digit -strict $s] } {
            DisplayMsg $s "Bad connection name \"$s\"" error
        } else {
            DisplayMsg $s "Not connected!" error
        }
................................................................................
    } else {
        set ftp(Dir) " $dir"
    }

    # save current type and force ascii mode
    set old_type $ftp(Type)
    if { $ftp(Type) != "ascii" } {


	if {[string length $ftp(Command)]} {
	    set ftp(NextState) [list nlist_$ftp(Mode) type_change list_last]
	    set ftp(type:changeto) $old_type
	    Type $s ascii
	    return {}
	}
        Type $s ascii
    }

    set ftp(State) nlist_$ftp(Mode)


    StateHandler $s



    # wait for synchronization
    set rc [WaitOrTimeout $s]

    # restore old type

    if { [Type $s] != $old_type } {
        Type $s $old_type
    }

    unset ftp(Dir)
    if { $rc } {


	return [lsort [split [string trim $ftp(List) \n] \n]]
    } else {


        CloseDataConn $s
        return {}
    }


}

#############################################################################
#
# List --
#
# LIST - This command causes a list to be sent from the server
................................................................................
# addr -		the address, in network address notation, 
#			of the client's host,
# port -		the client's port number

proc ::ftp::InitDataConn {s sock addr port} {
    upvar ::ftp::ftp$s ftp
    variable VERBOSE





    # If the new channel is accepted, the dummy channel will be closed

    catch {close $ftp(DummySock); unset ftp(DummySock)}

    set ftp(state.data) 0

................................................................................
        }
	default {
	    error "Unknown state \"$ftp(State)\""
	}
    }

    if { $VERBOSE } {
        DisplayMsg $s "D: Connection from $addr:$port" data
    }
    return
}

#############################################################################
#
# OpenActiveConn --






>
>
>







 







>




>
>





>
>








>







 







>
>







 







>
>



>





|







>





|
>
>







 







>







 







>
>


>
>

>
>







 







>
>






>
>







 







>

>
>







 







>
>










>
>

>
>





>






>
>


>
>



>
>







 







>
>
>
>







 







|







114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
...
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
...
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
...
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
...
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
....
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
....
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
....
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
....
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
....
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
....
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
# Handle timeouts
# 
# Arguments:
#  -
#
proc ::ftp::Timeout {s} {
    upvar ::ftp::ftp$s ftp
    variable VERBOSE

    if {$VERBOSE} { DisplayMsg $s Waiting|Timeout! }

    after cancel $ftp(Wait)
    set ftp(state.control) 1

    DisplayMsg "" "Timeout of control connection after $ftp(Timeout) sec.!" error
    Command $ftp(Command) timeout
    return
................................................................................
# 
# Arguments:
#  -		
#

proc ::ftp::WaitOrTimeout {s} {
    upvar ::ftp::ftp$s ftp
    variable VERBOSE

    set retvar 1

    if { ![string length $ftp(Command)] && [info exists ftp(state.control)] } {

	if {$VERBOSE} { DisplayMsg $s Waiting|$ftp(Timeout)|\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\# }

        set ftp(Wait) [after [expr {$ftp(Timeout) * 1000}] [list [namespace current]::Timeout $s]]

        vwait ::ftp::ftp${s}(state.control)
        set retvar $ftp(state.control)

	if {$VERBOSE} { DisplayMsg $s Waiting|Done|\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\# }
    }

    if {$ftp(Error) != ""} {
        set errmsg $ftp(Error)
        set ftp(Error) ""
        DisplayMsg $s $errmsg error
    }

    if {$VERBOSE} { DisplayMsg $s Waiting|OK|$retvar }
    return $retvar
}

#############################################################################
#
# WaitComplete --
#
................................................................................
#			the socket channel identifier.

proc ::ftp::StateHandler {s {sock ""}} {
    upvar ::ftp::ftp$s ftp
    variable DEBUG 
    variable VERBOSE

    if {$VERBOSE} { DisplayMsg $s StateHandler/$s/$sock/================================================ }

    # disable fileevent on control socket, enable it at the and of the state machine
    # fileevent $ftp(CtrlSock) readable {}
		
    # there is no socket (and no channel to get) if called from a procedure

    set rc "   "
    set msgtext {}
................................................................................
            if {![string equal $ftp(State) "quit_sent"]} {
		set ftp(Error) "Service not available!"
	    }
            CloseDataConn $s
            WaitComplete $s 0
	    Command $ftp(Command) terminated
            catch {unset ftp(State)}

	    if {$VERBOSE} { DisplayMsg $s EOF/Control }
            return
        } else {
	    # Fix SF bug #466746: Incomplete line, do nothing.
	    if {$VERBOSE} { DisplayMsg $s Incomplete/Line }
	    return	   
	}
    } 
	
    if { $DEBUG } {
        DisplayMsg $s "-> rc=\"$rc\" -> msgtext=\"$msgtext\" -> state=\"$ftp(State)\""
    }

    # In asynchronous mode, should we move on to the next state?
    set nextState 0
	
    # system status replay
    if { [string equal $rc "211"] } {
	if {$VERBOSE} { DisplayMsg $s Ignore/211 }
        return
    }

    # use only the first digit 
    regexp -- "^\[0-9\]?" $rc rc

    if {$VERBOSE} { DisplayMsg $s StateBegin////////($ftp(State)) }

    switch -exact -- $ftp(State) {
        user { 
            switch -exact -- $rc {
                2 {
                    PutsCtrlSock $s "USER $ftp(User)"
                    set ftp(State) passwd
		    Command $ftp(Command) user
................................................................................
                }
            }
        }
        put_close {
            switch -exact -- $rc {
		1 {
		    # Keep going
		    if {$VERBOSE} { DisplayMsg $s put_close/1--continue }
		    return
		}
                2 {
                    set complete_with 1
		    set nextState 1
		    Command $ftp(Command) put $ftp(RemoteFilename)
                }
................................................................................
            }
        }
	default {
	    error "Unknown state \"$ftp(State)\""
	}
    }

    if {$VERBOSE} { DisplayMsg $s ////////StateDone }

    # finish waiting 
    if { [info exists complete_with] } {
	if {$VERBOSE} { DisplayMsg $s WaitBegin////////($complete_with) }

        WaitComplete $s $complete_with

	if {$VERBOSE} { DisplayMsg $s ////////WaitDone }
    }

    # display control channel message
    if { [info exists buffer] } {
        if { $VERBOSE } {
            foreach line [split $buffer \n] {
                DisplayMsg $s "C: $line" control
................................................................................
    }

    # If operating asynchronously, commence next state
    if {$nextState && [info exists ftp(NextState)] && [llength $ftp(NextState)]} {
	# Pop the head of the NextState queue
	set ftp(State) [lindex $ftp(NextState) 0]
	set ftp(NextState) [lreplace $ftp(NextState) 0 0]

	if {$VERBOSE} { DisplayMsg $s Recurse/StateHandler }
	StateHandler $s
    }

    # enable fileevent on control socket again
    #fileevent $ftp(CtrlSock) readable [list ::ftp::StateHandler $ftp(CtrlSock)]

    if {$VERBOSE} { DisplayMsg $s ======/HandlerDone }
    return
}

#############################################################################
#
# Type --
#
# REPRESENTATION TYPE - Sets the file transfer type to ascii or binary.
................................................................................
# Arguments:
# dir - 		directory to list 
# 
# Returns:
# sorted list of files or {} if listing fails

proc ::ftp::NList {s { dir ""}} {
    variable VERBOSE
    upvar ::ftp::ftp$s ftp

    if {$VERBOSE} { DisplayMsg $s NList($s)($dir)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ }

    if { ![info exists ftp(State)] } {
        if { ![string is digit -strict $s] } {
            DisplayMsg $s "Bad connection name \"$s\"" error
        } else {
            DisplayMsg $s "Not connected!" error
        }
................................................................................
    } else {
        set ftp(Dir) " $dir"
    }

    # save current type and force ascii mode
    set old_type $ftp(Type)
    if { $ftp(Type) != "ascii" } {
	if {$VERBOSE} { DisplayMsg $s NList/ForceAscii }

	if {[string length $ftp(Command)]} {
	    set ftp(NextState) [list nlist_$ftp(Mode) type_change list_last]
	    set ftp(type:changeto) $old_type
	    Type $s ascii
	    return {}
	}
        Type $s ascii
    }

    set ftp(State) nlist_$ftp(Mode)

    if {$VERBOSE} { DisplayMsg $s NList/Process~~~~~~~~~~~~~~~~~~~ }
    StateHandler $s

    if {$VERBOSE} { DisplayMsg $s NList/Processed~~~~~~~~~~~~~~~~~ }

    # wait for synchronization
    set rc [WaitOrTimeout $s]

    # restore old type
    if {$VERBOSE} { DisplayMsg $s NList/RestoreType~~~~~~~~~~~~~~~~~~~~~ }
    if { [Type $s] != $old_type } {
        Type $s $old_type
    }

    unset ftp(Dir)
    if { $rc } {
	if {$VERBOSE} { DisplayMsg $s NList/ReturnData~~~~~~~~~~~~~~~~~~~~~~~ }

	return [lsort [split [string trim $ftp(List) \n] \n]]
    } else {
	if {$VERBOSE} { DisplayMsg $s NList/CDC~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ }

        CloseDataConn $s
        return {}
    }

    if {$VERBOSE} { DisplayMsg $s ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~NList/Done }
}

#############################################################################
#
# List --
#
# LIST - This command causes a list to be sent from the server
................................................................................
# addr -		the address, in network address notation, 
#			of the client's host,
# port -		the client's port number

proc ::ftp::InitDataConn {s sock addr port} {
    upvar ::ftp::ftp$s ftp
    variable VERBOSE

    if { $VERBOSE } {
        DisplayMsg $s "D: New Connection from $addr:$port" data
    }

    # If the new channel is accepted, the dummy channel will be closed

    catch {close $ftp(DummySock); unset ftp(DummySock)}

    set ftp(state.data) 0

................................................................................
        }
	default {
	    error "Unknown state \"$ftp(State)\""
	}
    }

    if { $VERBOSE } {
        DisplayMsg $s "D: ... Connection from $addr:$port ... initialized" data
    }
    return
}

#############################################################################
#
# OpenActiveConn --