Tcl Library Source Code

Check-in [441a5da4ea]
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki

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

Overview
Comment: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
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | hypnotoad
Files: files | file ages | folders
SHA3-256: 441a5da4eae6ec6a4a057e02c4169cc899a55d6c7067944a3d53885965c35394
User & Date: hypnotoad 2020-01-28 20:09:39.674
Context
2020-01-28
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
19:48
New version of nettool which allows for a central text-based pool of tcp ports check-in: ed69e9893c user: hypnotoad tags: hypnotoad
Changes
Unified Diff Ignore Whitespace Patch
Changes to modules/nettool/build/locateport.tcl.
︙︙
51
52
53
54
55
56
57




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
83
84



85
86
87
88
89
90
91

    for {} {$i <= $end} {incr i} {
      if {[port_busy $i]} continue
      return $i
    }
  }
  error "Could not locate a port"
}





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 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


      dict set ::nettool::used_ports $port $info
    }
    close $fin
  }
  set fout [open $filename w]
  set ports [lsort -integer [dict keys $::nettool::used_ports]]
  foreach port $ports {



    puts $fout [list $port [dict get $::nettool::used_ports $port]]
  }
  close $fout
  catch {file delete $filename.lock}
}

###








>
>
>
>













>







>
>







>
>
>








51
52
53
54
55
56
57
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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

    for {} {$i <= $end} {incr i} {
      if {[port_busy $i]} continue
      return $i
    }
  }
  error "Could not locate a port"
}

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
      # Ignore entries more than a week old
      if {[dict exists $info mtime] && ($now-[dict get $info mtime]) > 604800} continue
      dict set ::nettool::used_ports $port $info
    }
    close $fin
  }
  set fout [open $filename w]
  set ports [lsort -integer [dict keys $::nettool::used_ports]]
  foreach port $ports {
    if {[dict get $::nettool::used_ports $port pid]==$mypid} {
      dict set ::nettool::used_ports $port mtime $now
    }
    puts $fout [list $port [dict get $::nettool::used_ports $port]]
  }
  close $fout
  catch {file delete $filename.lock}
}

###
︙︙
104
105
106
107
108
109
110















111
112
113
114
115
116
117

  foreach {start end} $::nettool::blocks {
    if { $port >= $start && $port <= $end } {
      return 0
    }
  }
  return 1
}
















###
# topic: b5407b084aa09f9efa4f58a337af6186418fddf2
###
proc ::nettool::release_port {port {protocol tcp}} {
  dict set ::nettool::used_ports $port mtime [clock seconds]
  dict set ::nettool::used_ports $port pid   0








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142

  foreach {start end} $::nettool::blocks {
    if { $port >= $start && $port <= $end } {
      return 0
    }
  }
  return 1
}

# Called when a process is closing
proc ::nettool::release_all {} {
  set mypid [pid]
  set now [clock seconds]
  dict for {port info} $::nettool::used_ports {
    if {[dict exists $info pid] && [dict get $info pid]==$mypid} {
      dict set ::nettool::used_ports $port pid 0
      dict set ::nettool::used_ports $port mtime $now
    }
  }
  if {[info exists ::nettool::syncfile]} {
    ::nettool::_sync_db $::nettool::syncfile
  }
}

###
# topic: b5407b084aa09f9efa4f58a337af6186418fddf2
###
proc ::nettool::release_port {port {protocol tcp}} {
  dict set ::nettool::used_ports $port mtime [clock seconds]
  dict set ::nettool::used_ports $port pid   0
︙︙
Changes to modules/nettool/nettool.tcl.
︙︙
976
977
978
979
980
981
982




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
1008
1009



1010
1011
1012
1013
1014
1015
1016

    for {} {$i <= $end} {incr i} {
      if {[port_busy $i]} continue
      return $i
    }
  }
  error "Could not locate a port"
}





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 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


      dict set ::nettool::used_ports $port $info
    }
    close $fin
  }
  set fout [open $filename w]
  set ports [lsort -integer [dict keys $::nettool::used_ports]]
  foreach port $ports {



    puts $fout [list $port [dict get $::nettool::used_ports $port]]
  }
  close $fout
  catch {file delete $filename.lock}
}

###








>
>
>
>













>







>
>







>
>
>








976
977
978
979
980
981
982
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
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026

    for {} {$i <= $end} {incr i} {
      if {[port_busy $i]} continue
      return $i
    }
  }
  error "Could not locate a port"
}

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
      # Ignore entries more than a week old
      if {[dict exists $info mtime] && ($now-[dict get $info mtime]) > 604800} continue
      dict set ::nettool::used_ports $port $info
    }
    close $fin
  }
  set fout [open $filename w]
  set ports [lsort -integer [dict keys $::nettool::used_ports]]
  foreach port $ports {
    if {[dict get $::nettool::used_ports $port pid]==$mypid} {
      dict set ::nettool::used_ports $port mtime $now
    }
    puts $fout [list $port [dict get $::nettool::used_ports $port]]
  }
  close $fout
  catch {file delete $filename.lock}
}

###
︙︙
1029
1030
1031
1032
1033
1034
1035















1036
1037
1038
1039
1040
1041
1042

  foreach {start end} $::nettool::blocks {
    if { $port >= $start && $port <= $end } {
      return 0
    }
  }
  return 1
}
















###
# topic: b5407b084aa09f9efa4f58a337af6186418fddf2
###
proc ::nettool::release_port {port {protocol tcp}} {
  dict set ::nettool::used_ports $port mtime [clock seconds]
  dict set ::nettool::used_ports $port pid   0








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067

  foreach {start end} $::nettool::blocks {
    if { $port >= $start && $port <= $end } {
      return 0
    }
  }
  return 1
}

# Called when a process is closing
proc ::nettool::release_all {} {
  set mypid [pid]
  set now [clock seconds]
  dict for {port info} $::nettool::used_ports {
    if {[dict exists $info pid] && [dict get $info pid]==$mypid} {
      dict set ::nettool::used_ports $port pid 0
      dict set ::nettool::used_ports $port mtime $now
    }
  }
  if {[info exists ::nettool::syncfile]} {
    ::nettool::_sync_db $::nettool::syncfile
  }
}

###
# topic: b5407b084aa09f9efa4f58a337af6186418fddf2
###
proc ::nettool::release_port {port {protocol tcp}} {
  dict set ::nettool::used_ports $port mtime [clock seconds]
  dict set ::nettool::used_ports $port pid   0
︙︙
Changes to modules/nettool/nettool.test.
︙︙
108
109
110
111
112
113
114








































115
116
117
118
119

    "Test allocate port returns the next address of an claimed spot and claims it" \
    [list ::nettool::allocate_port 8805] 8808

# This should skip 7993 and 7994 because we seeded those in the txt file
::tcltest::test port-allocate-0007 \
    "Test allocate port returns the next address of an claimed spot and claims it" \
    [list ::nettool::allocate_port 8805] 8809









































catch {file delete $::nettool::syncfile}

testsuiteCleanup
return








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159

    "Test allocate port returns the next address of an claimed spot and claims it" \
    [list ::nettool::allocate_port 8805] 8808

# This should skip 7993 and 7994 because we seeded those in the txt file
::tcltest::test port-allocate-0007 \
    "Test allocate port returns the next address of an claimed spot and claims it" \
    [list ::nettool::allocate_port 8805] 8809

# Read the sync file
set mypid [pid]
set ports_open_count 0
set fin [open $::nettool::syncfile r]
while {[gets $fin line] >= 0} {
  lassign $line port info
  if {![dict exists $info pid]} continue
  if {[dict get $info pid]==$mypid} {
    incr ports_open_count
  }
}

close $fin

::tcltest::test port-open-0001 \
    "Count the number of open ports for this pid in the share file" \
    [list set ports_open_count] 4


::nettool::release_all

# Read the sync file
set mypid [pid]
set ports_open_count 0
set fin [open $::nettool::syncfile r]
while {[gets $fin line] >= 0} {
  lassign $line port info
  if {![dict exists $info pid]} continue
  if {[dict get $info pid]==$mypid} {
    incr ports_open_count
  }
}

close $fin

::tcltest::test port-open-0002 \
    "Count the number of open ports for this pid in the share file" \
    [list set ports_open_count] 0


catch {file delete $::nettool::syncfile}

testsuiteCleanup
return
This page was generated in about 0.012s by Fossil 2.27 [a6d506ecc4] 2025-07-09 13:52:53