Tcl Library Source Code

Check-in [faca2007b6]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Added an API call to set the sync file in nettool
Timelines: family | ancestors | descendants | both | hypnotoad
Files: files | file ages | folders
SHA3-256: faca2007b6d89ca5f8b05cc72237d0b78755a53df11b6562e22294b34c702db0
User & Date: hypnotoad 2020-01-28 21:15:07
Context
2020-01-28
22:25
Added a coroutine guard for file locking in nettool check-in: 9b67fcc749 user: hypnotoad tags: hypnotoad
21:15
Added an API call to set the sync file in nettool check-in: faca2007b6 user: hypnotoad tags: hypnotoad
20:09
Nettool: Added an instruction for data to be ignored after a week, and provided a mechanism for a process to release all ports it claimed check-in: 441a5da4ea user: hypnotoad tags: hypnotoad
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/nettool/build/locateport.tcl.

58
59
60
61
62
63
64

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
...
140
141
142
143
144
145
146





147
148
149
150
proc ::nettool::_die {filename} {
}


proc ::nettool::_sync_db {filename} {
  set mypid [pid]

  if {[file exists $filename]} {
    for {set x 0} {$x < 30} {incr x} {
      if {![file exists $filename.lock]} break
      set pid [string trim [cat $filename.lock]]
      if {$pid==$mypid} break
      after 250
    }
    set fout [open $filename.lock w]
    puts $fout $mypid
    close $fout
    set now [clock seconds]
    set fin [open $filename r]
    while {[gets $fin line]>=0} {
      lassign $line port info
      # Ignore file entries attributed to my process id
      if {[dict exists $info pid] && [dict get $info pid] == $mypid} continue
      # Ignore attempts to update usage on ports I have allocated
      if {[dict exists $::nettool::used_ports $port pid] && [dict get $::nettool::used_ports $port pid] == $mypid} continue
................................................................................
proc ::nettool::release_port {port {protocol tcp}} {
  dict set ::nettool::used_ports $port mtime [clock seconds]
  dict set ::nettool::used_ports $port pid   0
  if {[info exists ::nettool::syncfile]} {
    ::nettool::_sync_db $::nettool::syncfile
  }
}






if {![info exists ::nettool::used_ports]} {
  set ::nettool::used_ports {}
}






>










<







 







>
>
>
>
>




58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

76
77
78
79
80
81
82
...
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
proc ::nettool::_die {filename} {
}


proc ::nettool::_sync_db {filename} {
  set mypid [pid]
  set now [clock seconds]
  if {[file exists $filename]} {
    for {set x 0} {$x < 30} {incr x} {
      if {![file exists $filename.lock]} break
      set pid [string trim [cat $filename.lock]]
      if {$pid==$mypid} break
      after 250
    }
    set fout [open $filename.lock w]
    puts $fout $mypid
    close $fout

    set fin [open $filename r]
    while {[gets $fin line]>=0} {
      lassign $line port info
      # Ignore file entries attributed to my process id
      if {[dict exists $info pid] && [dict get $info pid] == $mypid} continue
      # Ignore attempts to update usage on ports I have allocated
      if {[dict exists $::nettool::used_ports $port pid] && [dict get $::nettool::used_ports $port pid] == $mypid} continue
................................................................................
proc ::nettool::release_port {port {protocol tcp}} {
  dict set ::nettool::used_ports $port mtime [clock seconds]
  dict set ::nettool::used_ports $port pid   0
  if {[info exists ::nettool::syncfile]} {
    ::nettool::_sync_db $::nettool::syncfile
  }
}

proc ::nettool::set_sync_file {filename} {
  file mkdir [file dirname $filename]
  set ::nettool::syncfile $filename
}

if {![info exists ::nettool::used_ports]} {
  set ::nettool::used_ports {}
}

Changes to modules/nettool/nettool.tcl.

983
984
985
986
987
988
989

990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
....
1065
1066
1067
1068
1069
1070
1071





1072
1073
1074
1075
1076
1077
1078
proc ::nettool::_die {filename} {
}


proc ::nettool::_sync_db {filename} {
  set mypid [pid]

  if {[file exists $filename]} {
    for {set x 0} {$x < 30} {incr x} {
      if {![file exists $filename.lock]} break
      set pid [string trim [cat $filename.lock]]
      if {$pid==$mypid} break
      after 250
    }
    set fout [open $filename.lock w]
    puts $fout $mypid
    close $fout
    set now [clock seconds]
    set fin [open $filename r]
    while {[gets $fin line]>=0} {
      lassign $line port info
      # Ignore file entries attributed to my process id
      if {[dict exists $info pid] && [dict get $info pid] == $mypid} continue
      # Ignore attempts to update usage on ports I have allocated
      if {[dict exists $::nettool::used_ports $port pid] && [dict get $::nettool::used_ports $port pid] == $mypid} continue
................................................................................
proc ::nettool::release_port {port {protocol tcp}} {
  dict set ::nettool::used_ports $port mtime [clock seconds]
  dict set ::nettool::used_ports $port pid   0
  if {[info exists ::nettool::syncfile]} {
    ::nettool::_sync_db $::nettool::syncfile
  }
}






if {![info exists ::nettool::used_ports]} {
  set ::nettool::used_ports {}
}

###
# END: locateport.tcl






>










<







 







>
>
>
>
>







983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000

1001
1002
1003
1004
1005
1006
1007
....
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
proc ::nettool::_die {filename} {
}


proc ::nettool::_sync_db {filename} {
  set mypid [pid]
  set now [clock seconds]
  if {[file exists $filename]} {
    for {set x 0} {$x < 30} {incr x} {
      if {![file exists $filename.lock]} break
      set pid [string trim [cat $filename.lock]]
      if {$pid==$mypid} break
      after 250
    }
    set fout [open $filename.lock w]
    puts $fout $mypid
    close $fout

    set fin [open $filename r]
    while {[gets $fin line]>=0} {
      lassign $line port info
      # Ignore file entries attributed to my process id
      if {[dict exists $info pid] && [dict get $info pid] == $mypid} continue
      # Ignore attempts to update usage on ports I have allocated
      if {[dict exists $::nettool::used_ports $port pid] && [dict get $::nettool::used_ports $port pid] == $mypid} continue
................................................................................
proc ::nettool::release_port {port {protocol tcp}} {
  dict set ::nettool::used_ports $port mtime [clock seconds]
  dict set ::nettool::used_ports $port pid   0
  if {[info exists ::nettool::syncfile]} {
    ::nettool::_sync_db $::nettool::syncfile
  }
}

proc ::nettool::set_sync_file {filename} {
  file mkdir [file dirname $filename]
  set ::nettool::syncfile $filename
}

if {![info exists ::nettool::used_ports]} {
  set ::nettool::used_ports {}
}

###
# END: locateport.tcl