Tcl Library Source Code

Check-in [3ee985049d]
Login

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

Overview
Comment:Updating a bit in httpd's implementation that used to rely on access to a private variable. Added a binary encode around the grab of raw random data on unix to prevent Tcl from trying to interpret the string.
Timelines: family | ancestors | descendants | both | hypnotoad
Files: files | file ages | folders
SHA3-256:3ee985049d0543ecfa9f0934db54fb28ba7613dbfc48a0f85b832b769d4d6616
User & Date: hypnotoad 2018-07-13 19:01:23
Context
2018-07-18
15:03
Updates to the clay module check-in: 7ee3399c6e user: hypnotoad tags: hypnotoad
2018-07-13
19:01
Updating a bit in httpd's implementation that used to rely on access to a private variable. Added a binary encode around the grab of raw random data on unix to prevent Tcl from trying to interpret the string. check-in: 3ee985049d user: hypnotoad tags: hypnotoad
16:54
Removed dedicated variables for clay's delegation and mixinmap. (They are now sub-elements of the clay dict). Refactored the practcl clay implementation to provide a better mapping of old function calls. This new practcl version now runs old practcl projects unmodified. check-in: 0745c57cca user: hypnotoad tags: hypnotoad
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/httpd/build/server.tcl.

209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
    if {$class eq {}} {
      set class ::httpd::plugin.$slot
    }
    if {[info command $class] eq {}} {
      error "Class $class for plugin $slot does not exist"
    }
    my clay mixinmap $slot $class
    my variable mixinmap

    ###
    # Perform action on load
    ###
    set script [$class clay search plugin/ load]
    eval $script








|







209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
    if {$class eq {}} {
      set class ::httpd::plugin.$slot
    }
    if {[info command $class] eq {}} {
      error "Class $class for plugin $slot does not exist"
    }
    my clay mixinmap $slot $class
    set mixinmap [my clay get mixin/]

    ###
    # Perform action on load
    ###
    set script [$class clay search plugin/ load]
    eval $script

Changes to modules/httpd/httpd.tcl.

919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
    if {$class eq {}} {
      set class ::httpd::plugin.$slot
    }
    if {[info command $class] eq {}} {
      error "Class $class for plugin $slot does not exist"
    }
    my clay mixinmap $slot $class
    my variable mixinmap

    ###
    # Perform action on load
    ###
    set script [$class clay search plugin/ load]
    eval $script








|







919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
    if {$class eq {}} {
      set class ::httpd::plugin.$slot
    }
    if {[info command $class] eq {}} {
      error "Class $class for plugin $slot does not exist"
    }
    my clay mixinmap $slot $class
    set mixinmap [my clay get mixin/]

    ###
    # Perform action on load
    ###
    set script [$class clay search plugin/ load]
    eval $script

Changes to modules/uuid/uuid.tcl.

44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
  lappend machinfo [array get ::tcl_platform]

  ###
  # If we have /dev/urandom just stream 128 bits from that
  ###
  if {[file exists /dev/urandom]} {
    set fin [open /dev/urandom r]
    set machinfo [read $fin 128]
    close $fin
  } elseif {[catch {package require nettool}]} {
    # More spatial information -- better than hostname.
    # bug 1150714: opening a server socket may raise a warning messagebox
    #   with WinXP firewall, using ipconfig will return all IP addresses
    #   including ipv6 ones if available. ipconfig is OK on win98+
    if {[string equal $::tcl_platform(platform) "windows"]} {







|







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
  lappend machinfo [array get ::tcl_platform]

  ###
  # If we have /dev/urandom just stream 128 bits from that
  ###
  if {[file exists /dev/urandom]} {
    set fin [open /dev/urandom r]
    set machinfo [binary encode base64 [read $fin 128]]
    close $fin
  } elseif {[catch {package require nettool}]} {
    # More spatial information -- better than hostname.
    # bug 1150714: opening a server socket may raise a warning messagebox
    #   with WinXP firewall, using ipconfig will return all IP addresses
    #   including ipv6 ones if available. ipconfig is OK on win98+
    if {[string equal $::tcl_platform(platform) "windows"]} {