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