interfaces/xmaxima/Tkmaxima/Tryftp2.tcl

   1 # -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
   2 #
   3 #       $Id: Tryftp2.tcl,v 1.2 2002-09-07 05:21:42 mikeclarkson Exp $
   4 #
   5 ###### Tryftp2.tcl ######
   6 ############################################################
   7 # Netmath       Copyright (C) 1998 William F. Schelter     #
   8 # For distribution under GNU public License.  See COPYING. #
   9 ############################################################
  10 if { "[info commands vwait]" == "vwait" && "[info commands myVwait]" == "" } {
  11     proc myVwait { x  } {uplevel 1  vwait $x }
  12 }
  13
  14 proc submitFtp { viahost host name password directory filename} {
  15     global ftpInfo
  16
  17     if  { [catch { set sock [socket $viahost 80] } ] } {
  18         set sock [socket $viahost 4080]
  19     }
  20     set ftpInfo($sock,done) 0
  21     set len [string length $ftpInfo(data)]
  22     set ftpInfo($sock,data) $ftpInfo(data)
  23
  24     # set sock [open /tmp/jim w+]
  25     fconfigure $sock -blocking 0 -translation {lf lf}
  26     # global billy ;lappend billy [list [fconfigure $sock]]
  27     puts $sock "POST /cgi-pub/wfs/submitftp HTTP/1.0"
  28     puts $sock "MIME-Version: 1.0"
  29     puts $sock "Accept: text/html"
  30     puts $sock "Accept: text/plain"
  31     puts $sock "Content-type: text/plain"
  32     puts $sock "Content-length: $len"
  33     puts $sock "Username: $name"
  34     puts $sock "Password: $password"
  35     puts $sock "Remote-host: $host"
  36     puts $sock "Remote-directory: $directory"
  37     puts $sock "Remote-filename: $filename"
  38     puts $sock ""
  39     flush $sock
  40     # puts $sock $ftpInfo(data) ; flush $sock
  41     # puts sock=$sock
  42     set ftpInfo(message) ""
  43
  44     set after_id [after 10000 "set ftpInfo($sock,done) -1"]
  45
  46     set ftpInfo($sock,datalength) $len
  47     set ftpInfo($sock,datanext) 0
  48     set ftpInfo($sock,log) "none.."
  49     # puts $sock $ftpInfo(data) ; flush $sock
  50     fileevent $sock writable "ftp2SendData $sock"
  51     fileevent $sock readable "ftp2WatchReturn $sock"
  52     myVwait ftpInfo($sock,done)
  53     set res $ftpInfo($sock,done)
  54     set ftpInfo(message) $ftpInfo($sock,log)
  55
  56     after cancel $after_id
  57
  58     # puts $ftpInfo($sock,return)
  59     ftp2Close $sock
  60     return $res
  61 }
  62
  63 proc ftp2Close { sock } {
  64     global ftpInfo
  65     close $sock
  66     foreach v  [array names ftpInfo $sock,*]  {
  67         unset ftpInfo($v)
  68     }
  69 }
  70
  71 proc ftp2WatchReturn { sock } {
  72     global ftpInfo
  73
  74     append ftpInfo($sock,return) " watching ..."
  75     set new [read $sock ]
  76     #global billy ; lappend billy [list return $new]
  77     if { [eof $sock] } {fileevent $sock readable {}}
  78     # puts "watching..new=$new" ; flush stdout
  79     append ftpInfo($sock,return) $new
  80     if { [regexp "Succeeded: (\[^\n]*)\n" $ftpInfo($sock,return) junk msg]} {
  81         set ftpInfo($sock,done) 1
  82         set ftpInfo($sock,log) $msg
  83     } elseif { [regexp "Failed: (\[^\n]*)\n" $ftpInfo($sock,return) junk msg] } {
  84         set ftpInfo($sock,done) -1
  85         set ftpInfo($sock,log) $msg
  86     }
  87     #mike FIXME: this is a wrong use of after cancel
  88     after cancel "set ftpInfo($sock,done) -1"
  89     after 3000 "set ftpInfo($sock,done) -1"
  90 }
  91 # set billy {}
  92 proc ftp2SendData { sock } {
  93     global ftpInfo
  94
  95     set dn $ftpInfo($sock,datanext)
  96     set dl $ftpInfo($sock,datalength)
  97     #global billy ; lappend billy [list $dn $dl]
  98     set ftpInfo(percent) [expr {($dn >= $dl ? 100.0 : 100.0 * $dn/$dl)}]
  99     # puts "storing data to $sock $percent %"
 100     if { $ftpInfo($sock,datanext) >= $ftpInfo($sock,datalength) } {
 101         #mike FIXME: this is a wrong use of after cancel
 102         after cancel "set ftpInfo($sock,done) -1"
 103         after 10000 "set ftpInfo($sock,done) -1"
 104         fileevent $sock writable ""
 105         # puts $sock "abcdefghijklmno"
 106         # flush $sock
 107         return
 108     }
 109     set amtToSend 4000
 110     puts -nonewline $sock [string range $ftpInfo($sock,data) $ftpInfo($sock,datanext) [expr {$ftpInfo($sock,datanext) + $amtToSend -1}]]
 111     # puts  $sock $tosend
 112     flush $sock
 113
 114     set ftpInfo($sock,datanext) [expr {$ftpInfo($sock,datanext) + $amtToSend}]
 115     #mike FIXME: this is a wrong use of after cancel
 116     after cancel "set ftpInfo($sock,done) -1"
 117     after 10000 "set ftpInfo($sock,done) -1"
 118 }
 119
 120
 121
 122 ## endsource tryftp2.tcl