interfaces/xmaxima/Tkmaxima/Getdata1.tcl

   1 ############################################################
   2 # Getdata1.tcl                                             #
   3 # Copyright (C) 1998 William F. Schelter                   #
   4 # For distribution under GNU public License.  See COPYING. #
   5 #                                                          #
   6 #     Time-stamp: "2021-04-04 10:23:33 villate"            #
   7 ############################################################
   8 #-----------------------------------------------------------------
   9 #
  10 # readAllData --  read data from CHANNEL.
  11 #  Options: -tovar variable    (store in this global variable)
  12 #           -mimeheader store in alist the mime values
  13 #                   and oset $sock contentlength if
  14 #           -tochannel  (store in channel)
  15 #           -timeout   (for non action)
  16 #           -translation  (for the sock)
  17 #           -chunksize   size to do for each read between updating %
  18 #           -command    a call back run on each chunk
  19 # If -command is not specified, wait and return the result code.
  20 # Value of -1 means a timeout, and value of >1 means success.
  21 # If  command is specified, call command each time data is read,
  22 # with 1 argument appended, the result code.
  23 # allowing no more than TIMEOUT millisconds between reads.
  24 #  We set up local variables for the $CHANNEL
  25 #        result
  26 #        bytesread  (after the header if one specified)
  27 #        mimeheader (extracted)
  28 #        length     (0 if not provied by mime header)
  29 # COMMAND can access
  30 # to examine the data read so far.
  31 #
  32 #  Results:  1 on success, and -1 if it fails or times out.
  33 #
  34 #  Side Effects: CHANNEL will be closed and the global variable VAR will
  35 #  be set..
  36 #
  37 #----------------------------------------------------------------
  38 #
  39 proc readAllData { sock args } {
  40     global readAllData [oarray $sock] maxima_priv
  41
  42     array set [oarray $sock] {
  43         timeout 5000
  44         command ""
  45         tochannel ""
  46         translation binary
  47         chunksize 2024
  48         mimeheader ""
  49         tovar ""
  50         result ""
  51         done 0
  52         usecache 0
  53         percent 0
  54         bytesread 0
  55         headervalue ""
  56         contentlength -1
  57     }
  58     oset $sock begin [clock clicks]
  59     foreach { key val } $args {
  60         #puts " oset $sock [string range $key 1 end] $val"
  61         oset $sock [string range $key 1 end] $val
  62
  63     }
  64     #puts "locals:[array get [oarray $sock]]"
  65     # puts "args=$args"
  66     if { "[oget $sock translation]" != "" } {
  67         fconfigure $sock -translation [oget $sock translation]
  68     }
  69     fconfigure $sock -blocking 0
  70
  71     catch {
  72         $maxima_priv(cStatusWindow).scale \
  73             config -variable [oloc $sock percent]
  74     }
  75     lappend [oloc $sock after] [after [oget $sock timeout] "oset $sock done -1"]
  76     if { "[oget $sock mimeheader]" != "" } {
  77         fileevent  $sock readable "readMimeHeader $sock"
  78     } else {
  79         fileevent  $sock readable "readAllData1 $sock"
  80     }
  81
  82     if { "[oget $sock command]" == "" } {
  83         oset $sock docommand 0
  84         return [wrWaitRead $sock]
  85     } else {
  86         oset $sock docommand 1
  87         # the command will do things and maybe caller will vwait..
  88         return ""
  89     }
  90 }
  91 #
  92 #-----------------------------------------------------------------
  93 #
  94 # readMimeHeader --  read from SOCK until end of mime header.
  95 #  this is done as a fileevent.  Store result in $sock local HEADERVALUE.
  96 #
  97 #  Results: none
  98 #
  99 #  Side Effects:  data read, and the mime header decoded and stored.
 100 #
 101 #----------------------------------------------------------------
 102 #
 103 proc readMimeHeader { sock } {
 104     global [oarray $sock]
 105     set result ""
 106     set ans ""
 107     while { 1 } {
 108         set n [gets $sock line]
 109         if { $n < 0 } {
 110             if { [eof $sock] } {
 111                 oset $sock done -1
 112                 close $sock
 113                 return
 114             }
 115             append [oloc $sock result] $result\n
 116             break
 117         }
 118         if { $n <=1 && ($n==0 || "$line" == "\r") }  {
 119             # we are done the header
 120
 121             append [oloc $sock result] $result\n
 122             regsub -all "\r"  [oget $sock result] "" result
 123             set lis [split $result \n]
 124             foreach v $lis {
 125                 if { [regexp "^(\[^:]*):\[ \t]*(.*)\$" $v junk key val] } {
 126                     lappend ans  [string tolower $key] $val
 127                 }
 128             }
 129             oset $sock headervalue $ans
 130             oset $sock contentlength [assoc content-length $ans -1]
 131             if { [oget $sock usecache] } {
 132                 set result [tryCache [oget $sock cachename] $ans]
 133                 if { "$result" != "" } {
 134                     oset $sock bytesread [string length $result]
 135                     wrFinishRead $sock
 136                     return
 137                 }
 138             }
 139             oset $sock percent 0
 140             oset $sock bytesread 0
 141             oset $sock result ""
 142             #puts "mimeheader = <$ans>"
 143             #puts "switching to readAllData1 $sock, [eof $sock]"
 144             fileevent $sock readable "readAllData1 $sock"
 145             #puts "doing     readAllData1 $sock"
 146             return
 147         }
 148         append result "$line\n"
 149     }
 150 }
 151
 152 proc readAllData1 { sock } {
 153     #puts "readAllData1 $sock" ; flush stdout
 154     global maxima_priv [oarray $sock]
 155
 156     makeLocal $sock timeout tovar tochannel docommand chunksize after contentlength begin
 157
 158     upvar #0 [oloc $sock bytesread] bytesread
 159     #puts "readAllData1 $sock, bytes=$bytesread" ; flush stdout
 160     if { [catch {
 161         foreach v $after {after cancel $v}
 162         while { 1 } {
 163             if { "$tochannel" != "" } {
 164                 if { [eof $sock] } {
 165                     wrFinishRead $sock
 166                     return finished
 167                 } else {
 168                     set amt [expr { $contentlength >= 0 ? ($chunksize < $contentlength - $bytesread ? $chunksize : ($contentlength -$bytesread)) : $chunksize } ]
 169                     set chunksize $amt
 170                     set n [fcopy $sock $tochannel -size $chunksize]
 171                 }
 172             } else {
 173                 set res [read $sock $chunksize]
 174                 set n [string length $res]
 175                 append [oloc $sock result] $res
 176             }
 177             incr bytesread $n
 178             if { $n == 0 } {
 179                 if { [eof $sock] } {
 180                     wrFinishRead $sock
 181                     return finished
 182                 }
 183             }
 184             set maxima_priv(load_rate) "[expr {round ($bytesread * ($maxima_priv(clicks_per_second)*1.0 / ([clock clicks] - $begin)))}] bytes/sec"
 185
 186             if { $contentlength > 0 } {
 187                 oset $sock percent \
 188                     [expr {$bytesread * 100.0 / $contentlength }]
 189
 190             }
 191
 192             if { $docommand } {
 193                 catch { uplevel "#0"  [oget $sock command] }
 194             }
 195             # puts "percent=[oget $sock percent],bytes=[oget $sock bytesread]"
 196
 197             if { $contentlength >= 0 &&  $bytesread >= $contentlength } {
 198                 wrFinishRead $sock
 199                 return finished
 200             }
 201             if { $n <= $chunksize } { break    }
 202
 203         }
 204     } errmsg   ] } {
 205         if { "$errmsg" == "finished" } {
 206             return
 207         } else {
 208             global errorInfo ; error [concat [mc "error:"] "$errmsg , $errorInfo"]
 209         }
 210     }
 211     lappend [oloc $sock after] \
 212         [after $timeout "oset $sock done -1"]
 213 }
 214 #
 215 #-----------------------------------------------------------------
 216 #
 217 # wrFinishRead --  run at the EOF.  It will run the COMMAND one last
 218 # time and look after setting the global variables with the result,
 219 # closing the channel(s).
 220 #
 221 #  Results:  the $sock variable 'done', 1 for success, -1 for failure.
 222 #
 223 #  Side Effects: many!
 224 #
 225 #----------------------------------------------------------------
 226 #
 227 proc wrFinishRead { sock } {
 228     makeLocal $sock mimeheader contentlength tovar tochannel headervalue \
 229         bytesread docommand
 230     #puts "entering wrFinishRead" ; flush stdout
 231
 232     if { "$mimeheader" != "" } {
 233         uplevel "#0" set $mimeheader \[oget $sock headervalue\]
 234     }
 235     if { "$tovar" != "" } {
 236         uplevel "#0" set $tovar \[oget $sock result\]
 237     } else {
 238         catch { close $tochannel }
 239     }
 240     if { $contentlength < 0 || $bytesread >= $contentlength } {
 241         oset $sock done 1
 242     } else {
 243         oset $sock done -1
 244     }
 245     catch { close $sock }
 246     if { $docommand } {
 247         catch { uplevel "#0"  [oget $sock command]  }
 248     }
 249     set res [oget $sock done]
 250     #puts "wrFinishRead, tovar=$tovar,tochannel=$tochannel,res=$res,bytesread=$bytesread"
 251     clearLocal $sock
 252     oset $sock done $res
 253     return $res
 254 }
 255
 256 proc wrWaitRead { sock } {
 257     #puts "entering wrWaitRead"
 258     global [oarray $sock]
 259     if { [oget $sock done] == 0 } {
 260         myVwait [oloc $sock done]
 261     }
 262     #vwait [oloc $sock done]
 263     set res [oget $sock done]
 264     return $res
 265 }
 266
 267 proc testit { addr usecommand args } {
 268     if { [regexp {//([^/]+)(/.*)$} $addr junk server path] } {
 269         set sock [socket $server 80]
 270         #puts "server=$server"
 271         # fconfigure $sock -translation binary
 272         #puts "GET $path HTTP/1.0\n"
 273         puts $sock "GET $path HTTP/1.0\nMIME-Version: 1.0\nAccept: text/html\n\nhi there" ;
 274         flush $sock
 275         proc _joe { sock } {
 276             makeLocal $sock percent contentlength bytesread
 277             puts "percent=$percent,contentlength=$contentlength,bytesread=$bytesread"
 278         }
 279         if { $usecommand } {
 280             eval readAllData $sock -command  [list "_joe $sock"] $args
 281             wrWaitRead $sock
 282         } else {
 283             eval readAllData $sock $args
 284         }
 285         catch { close $sock }
 286     }
 287 }
 288 #
 289 #-----------------------------------------------------------------
 290 #
 291 # tryGetCache --  look up PATH (eg http://maxima.sourceforge.net:80/...)
 292 # in the cache, and if you find success and a matching ETAG,
 293 # then return the data in the file
 294 #
 295 #  Results:  The cached data in FILE or ""
 296 #
 297 #  Side Effects: Will remove the file if the current etag differs.
 298 #
 299 #----------------------------------------------------------------
 300 #
 301 proc tryGetCache { path alist } {
 302     global ws_Cache maxima_priv
 303     set tem [ws_Cache($path)]
 304     if { "$tem" != "" } {
 305         set filename [file join $maxima_priv(cachedir) [lindex $tem 1]]
 306         set etag [assoc etag $alist]
 307         if { "$etag" != "" } {
 308             if {  "[lindex $tem 0]" == "$etag" }  {
 309                 if { ! [catch {
 310                     set fi [open $filename  r]
 311                 }] } {
 312                     fconfigure $fi -translation binary
 313                     set result [read $fi]
 314                     close $fi
 315                     return $result
 316                 }
 317             } else {
 318                 # cache out of date.
 319                 if { [file exists $filename] } {
 320                     file delete $filename
 321                     return ""
 322                 }
 323             }
 324
 325         }
 326     }
 327 }
 328
 329 proc saveInCache { path etag  result} {
 330     global ws_Cache maxima_priv
 331     set cachedir $maxima_priv(cachedir)
 332     # todo add a catch
 333     set type [lindex [split [file tail $path] .] 1]
 334     set count 0
 335     while [ file exists [set tem [file join $cachedir $count$etag.$type]]] {
 336         incr count
 337     }
 338     set fi [open $tem w]
 339     #puts "writing $tem"
 340     fconfigure $fi -translation binary
 341     puts -nonewline $fi $result
 342     close $fi
 343     set ws_Cache($path) [list $etag [file tail $tem]]
 344     set fi [open [cacheName index.dat] a]
 345     puts $fi "[list [list $path]] {$ws_Cache($path)}"
 346     close $fi
 347 }
 348
 349 proc cleanCache { } {
 350     global ws_Cache
 351     catch {
 352         foreach v [glob [cacheName *]] {
 353             catch { file delete $v }
 354         }
 355     }
 356     catch { unset ws_Cache }
 357 }
 358
 359 proc cacheName { name } {
 360     global maxima_priv
 361     return [ file join $maxima_priv(cachedir) $name]
 362 }
 363 #
 364 #-----------------------------------------------------------------
 365 #
 366 # readAndSyncCache --  read the cache index.dat
 367 # and remove duplicates removing files, and if necessary save
 368 # the file out.   Normally this would be done at start up.
 369 #
 370 #  Results:
 371 #
 372 #  Side Effects:
 373 #
 374 #----------------------------------------------------------------
 375 #
 376 proc readAndSyncCache { } {
 377     global maxima_priv ws_Cache
 378     if { [catch {  set fi [open [cacheName index.dat] r] } ] } {
 379         return
 380     }
 381     set all [read $fi]
 382     #puts "all=$all"
 383     set lis [split $all \n]
 384     #puts "lis=$lis"
 385     set doWrite 0
 386     foreach v $lis {
 387         set key [lindex $v 0]
 388         set val [lindex $v 1]
 389         if { "$v" == ""} { continue}
 390         if { [info exists  ws_Cache($key)] } {
 391             set doWrite 1
 392             catch {file delete [cacheName [lindex $ws_Cache($key) 1] ] }
 393         }
 394         if { "$val" != "badvalue" } {
 395             set ws_Cache($key) $val
 396         }
 397     }
 398     close $fi
 399     if {  $doWrite}  {
 400         set fi [open [cacheName index.dat] w]
 401         puts [concat [mc "writing"] "[cacheName index.dat]"]
 402         foreach { key val } [array get ws_Cache *]  {
 403             puts  $fi "[list [list $key]] {$val}"
 404         }
 405         close $fi
 406     }
 407 }