00001 # TKE - Advanced Programmer's Editor
00002 # Copyright (C) 2014-2019 Trevor Williams (phase1geo@gmail.com)
00003 #
00004 # This program is free software; you can redistribute it and/or modify
00005 # it under the terms of the GNU General Public License as published by
00006 # the Free Software Foundation; either version 2 of the License, or
00007 # (at your option) any later version.
00008 #
00009 # This program is distributed in the hope that it will be useful,
00010 # but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
00012 # GNU General Public License for more details.
00013 #
00014 # You should have received a copy of the GNU General Public License along
00015 # with this program; if not, write to the Free Software Foundation, Inc.,
00016 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
00017
00018 ######################################################################
00019 # Name: sftp_wrapper.tcl
00020 # Author: Trevor Williams (phase1geo@gmail.com)
00021 # Date: 10/19/2016
00022 # Brief: Wrapper around the SFTP code from filerunner to allow it to
00023 # work without modification.
00024 ######################################################################
00025
00026 ######################################################################
00027 # This procedure is called by the sftp.tcl procedures. We will ignore
00028 # their parameters.
00029 proc ::frputs {args} {
00030 return
00031 set m {}
00032 foreach ar $args {
00033 if {[string index $ar end] == " " } {
00034 set m [set m][string range $ar 0 end-1]
00035 } elseif { ! [catch "uplevel \"info exists $ar\" " ro] && $ro } {
00036 set m "[set m]$ar=[uplevel "set $ar"]< "
00037 } else {
00038 set m "[set m]$ar=<unset> "
00039 }
00040 }
00041 regsub -all {\n} $m {\\n} m
00042 regsub -all {\r} $m {\\r} m
00043 regsub -all {\t} $m {\\t} m
00044 puts "frputs: [set m]"
00045 flush stdout
00046 }
00047
00048 ######################################################################
00049 # This procedure is used by the sftp code.
00050 proc ::Log {str} {
00051 # puts "Log: $str"
00052 }
00053
00054 ######################################################################
00055 # This procedure is used by the sftp code.
00056 proc ::LogStatusOnly {str} {
00057 if {[::tke_development]} {
00058 puts "LogStatusOnly: $str"
00059 }
00060 }
00061
00062 ######################################################################
00063 # This procedure is used by the ftp_control code.
00064 proc ::LogSilent {str} {
00065 # puts "LogSilent: $str"
00066 }
00067
00068 ######################################################################
00069 # Required by ftp_control.
00070 proc PopWarn { warn } {
00071
00072 logger::log $warn
00073
00074 }
00075
00076 ######################################################################
00077 # Required by sftp
00078 proc ::_ {s {p1 ""} {p2 ""} {p3 ""} {p4 ""}} {
00079
00080 return [::msgcat::mc $s $p1 $p2 $p3 $p4]
00081
00082 }
00083
00084 ######################################################################
00085 # Required by sftp.
00086 proc ::smart_dialog {win parent title lines args} {
00087
00088 set ans [tk_messageBox -parent .ftp -title $title -message [lindex $lines 2] -detail [lindex $lines 1] -default yes -type yesno]
00089
00090 return [expr {($ans eq "yes") ? 1 : 2}]
00091
00092 }
00093
00094 ######################################################################
00095 # Returns the current time in milliseconds. Required by ftp_control.tcl
00096 proc ClockMilliSeconds {} {
00097
00098 return [clock milliseconds]
00099
00100 }
00101
00102 set ::glob(debug) 0
00103 set ::glob(tmpdir) $::tke_home
00104 set ::glob(ftp,debug) 0
00105 set ::glob(os) [expr {($::tcl_platform(platform) eq "unix") ? "Unix" : "Windows"}]
00106 set ::glob(abortcmd) 0
00107 set ::config(ftp,timeout) 60
00108 set ::config(ftp,cache,maxentries) 0 ;# Effectively turn off caching
00109 set ::ftp(cache) [list]
00110
00111 # Load the sftp code base only if we have Expect
00112 if {![catch { package require Expect }]} {
00113 source [file join $tke_dir lib remote sftp.tcl]
00114 }
00115
00116 # Load the FTP and FTP control files
00117 source [file join $tke_dir lib remote ftp.tcl]
00118 source [file join $tke_dir lib remote ftp_control.tcl]
00119
