Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | New version of nettool which allows for a central text-based pool of tcp ports |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | hypnotoad |
Files: | files | file ages | folders |
SHA3-256: |
ed69e9893c22e30bc5cdf951d8b1c7c0 |
User & Date: | hypnotoad 2020-01-28 19:48:14.639 |
Context
2020-01-28
| ||
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 | |
15:58 | Added a binary encode to the uuid's random string generator to avoid embedded nulls terminating strings prematurely check-in: 08ccfd657e user: hypnotoad tags: hypnotoad | |
Changes
Changes to modules/nettool/build/build.tcl.
1 2 3 | set srcdir [file dirname [file normalize [file join [pwd] [info script]]]] set moddir [file dirname $srcdir] | | | 1 2 3 4 5 6 7 8 9 10 11 | set srcdir [file dirname [file normalize [file join [pwd] [info script]]]] set moddir [file dirname $srcdir] set version 0.5.4 set tclversion 8.5 set module [file tail $moddir] proc ::ladd {varname args} { upvar 1 $varname var if ![info exists var] { set var {} |
︙ | ︙ |
Changes to modules/nettool/build/core.tcl.
1 2 3 4 5 6 7 8 | # @mdgen OWNER: generic.tcl # @mdgen OWNER: available_ports.tcl # @mdgen OWNER: locateport.tcl # @mdgen OWNER: platform_unix_linux.tcl # @mdgen OWNER: platform_unix_macosx.tcl # @mdgen OWNER: platform_unix.tcl # @mdgen OWNER: platform_windows.tcl | < < < | < < | < < < < < < < < | < < < | < < < < | | | | | | < < < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | # @mdgen OWNER: generic.tcl # @mdgen OWNER: available_ports.tcl # @mdgen OWNER: locateport.tcl # @mdgen OWNER: platform_unix_linux.tcl # @mdgen OWNER: platform_unix_macosx.tcl # @mdgen OWNER: platform_unix.tcl # @mdgen OWNER: platform_windows.tcl package require platform # Uses the "ip" package from tcllib package require ip set here [file dirname [file normalize [info script]]] ::namespace eval ::nettool {} proc ::nettool::cat filename { set fin [open $filename r] set dat [read $fin] close $fin return $dat } set genus [lindex [split [::platform::generic] -] 0] dict set ::nettool::platform tcl_os $::tcl_platform(os) dict set ::nettool::platform odie_class $::tcl_platform(platform) dict set ::nettool::platform odie_genus $genus dict set ::nettool::platform odie_target [::platform::generic] dict set ::nettool::platform odie_species [::platform::identify] |
︙ | ︙ |
Changes to modules/nettool/build/locateport.tcl.
︙ | ︙ | |||
8 9 10 11 12 13 14 | if { $end <= $startingport } continue if { $start > $startingport } { set i $start } else { set i $startingport } for {} {$i <= $end} {incr i} { | | | > > > > | > | > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | > > | | > > > > | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 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 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | if { $end <= $startingport } continue if { $start > $startingport } { set i $start } else { set i $startingport } for {} {$i <= $end} {incr i} { if {[port_busy $i]} continue if {[catch {socket -server NOOP $i} chan]} { dict set ::nettool::used_ports $port mtime [clock seconds] dict set ::nettool::used_ports $port pid 1 continue } close $chan claim_port $i return $i } } error "Could not locate a port" } ### # topic: 3286fdbd0a3fdebbb26414475754bcf3dea67b0f ### proc ::nettool::claim_port {port {protocol tcp}} { dict set ::nettool::used_ports $port mtime [clock seconds] dict set ::nettool::used_ports $port pid [pid] if {[info exists ::nettool::syncfile]} { ::nettool::_sync_db $::nettool::syncfile } } ### # topic: 1d1f8a65a9aef8765c9b4f2b0ee0ebaf42e99d46 ### proc ::nettool::find_port startingport { foreach {start end} $::nettool::blocks { if { $end <= $startingport } continue if { $start > $startingport } { set i $start } else { set i $startingport } 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} } ### # topic: ded1c51260e009effb1f77044f8d0dec3d030b91 ### proc ::nettool::port_busy port { if {[info exists ::nettool::syncfile] && [file exists $::nettool::syncfile]} { ::nettool::_sync_db $::nettool::syncfile } ### # Check our private list of used ports ### if {[dict exists $::nettool::used_ports $port pid] && [dict get $::nettool::used_ports $port pid] > 0} { return 1 } 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 if {[info exists ::nettool::syncfile]} { ::nettool::_sync_db $::nettool::syncfile } } if {![info exists ::nettool::used_ports]} { set ::nettool::used_ports {} } |
Changes to modules/nettool/nettool.tcl.
1 2 3 4 5 6 | ### # Amalgamated package for nettool # Do not edit directly, tweak the source in src/ and rerun # build.tcl ### package require Tcl 8.5 | | | < < < | < < | < < < < < < < < | < < < | < < < < | | | | | | < < < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | ### # Amalgamated package for nettool # Do not edit directly, tweak the source in src/ and rerun # build.tcl ### package require Tcl 8.5 package provide nettool 0.5.4 namespace eval ::nettool {} set ::nettool::version 0.5.4 ### # START: core.tcl ### # @mdgen OWNER: generic.tcl # @mdgen OWNER: available_ports.tcl # @mdgen OWNER: locateport.tcl # @mdgen OWNER: platform_unix_linux.tcl # @mdgen OWNER: platform_unix_macosx.tcl # @mdgen OWNER: platform_unix.tcl # @mdgen OWNER: platform_windows.tcl package require platform # Uses the "ip" package from tcllib package require ip set here [file dirname [file normalize [info script]]] ::namespace eval ::nettool {} proc ::nettool::cat filename { set fin [open $filename r] set dat [read $fin] close $fin return $dat } set genus [lindex [split [::platform::generic] -] 0] dict set ::nettool::platform tcl_os $::tcl_platform(os) dict set ::nettool::platform odie_class $::tcl_platform(platform) dict set ::nettool::platform odie_genus $genus dict set ::nettool::platform odie_target [::platform::generic] dict set ::nettool::platform odie_species [::platform::identify] |
︙ | ︙ | |||
959 960 961 962 963 964 965 | if { $end <= $startingport } continue if { $start > $startingport } { set i $start } else { set i $startingport } for {} {$i <= $end} {incr i} { | | | > > > > | > | > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | > > | | > > > > | 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 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 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 | if { $end <= $startingport } continue if { $start > $startingport } { set i $start } else { set i $startingport } for {} {$i <= $end} {incr i} { if {[port_busy $i]} continue if {[catch {socket -server NOOP $i} chan]} { dict set ::nettool::used_ports $port mtime [clock seconds] dict set ::nettool::used_ports $port pid 1 continue } close $chan claim_port $i return $i } } error "Could not locate a port" } ### # topic: 3286fdbd0a3fdebbb26414475754bcf3dea67b0f ### proc ::nettool::claim_port {port {protocol tcp}} { dict set ::nettool::used_ports $port mtime [clock seconds] dict set ::nettool::used_ports $port pid [pid] if {[info exists ::nettool::syncfile]} { ::nettool::_sync_db $::nettool::syncfile } } ### # topic: 1d1f8a65a9aef8765c9b4f2b0ee0ebaf42e99d46 ### proc ::nettool::find_port startingport { foreach {start end} $::nettool::blocks { if { $end <= $startingport } continue if { $start > $startingport } { set i $start } else { set i $startingport } 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} } ### # topic: ded1c51260e009effb1f77044f8d0dec3d030b91 ### proc ::nettool::port_busy port { if {[info exists ::nettool::syncfile] && [file exists $::nettool::syncfile]} { ::nettool::_sync_db $::nettool::syncfile } ### # Check our private list of used ports ### if {[dict exists $::nettool::used_ports $port pid] && [dict get $::nettool::used_ports $port pid] > 0} { return 1 } 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 if {[info exists ::nettool::syncfile]} { ::nettool::_sync_db $::nettool::syncfile } } if {![info exists ::nettool::used_ports]} { set ::nettool::used_ports {} } ### # END: locateport.tcl ### ### # START: platform_unix.tcl ### |
︙ | ︙ |
Changes to modules/nettool/nettool.test.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | source [file join \ [file dirname [file dirname [file join [pwd] [info script]]]] \ devtools testutilities.tcl] package require tcltest testsNeedTcl 8.5 testsNeedTcltest 1.0 testing { useLocal nettool.tcl nettool } # Test known busy ports foreach port { 80 3020 21 7794 | > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | source [file join \ [file dirname [file dirname [file join [pwd] [info script]]]] \ devtools testutilities.tcl] package require tcltest testsNeedTcl 8.5 testsNeedTcltest 1.0 testing { useLocal nettool.tcl nettool } set ::nettool::syncfile [file join [file dirname [file join [pwd] [info script]]] sync.txt] if {[file exists $::nettool::syncfile]} { file delete $::nettool::syncfile } # Seed the syncfile with data as if there was a process in paralleld set fout [open $::nettool::syncfile w] puts $fout [list 8805 [dict create pid 1 mtime [expr [clock seconds]-1800]]] puts $fout [list 8806 [dict create pid 1 mtime [expr [clock seconds]-900]]] puts $fout [list 8807 [dict create pid 1 mtime [expr [clock seconds]-900]]] close $fout # Test known busy ports foreach port { 80 3020 21 7794 |
︙ | ︙ | |||
47 48 49 50 51 52 53 | 7792 7793 {End of block} 7793 7795 {Start of new block} } { ::nettool::claim_port $port ::tcltest::test port-claim-0001 \ "Test that port busy returns true after $port is claimed" \ [list ::nettool::port_busy $port] 1 | | | | | > > > > > > | 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 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 | 7792 7793 {End of block} 7793 7795 {Start of new block} } { ::nettool::claim_port $port ::tcltest::test port-claim-0001 \ "Test that port busy returns true after $port is claimed" \ [list ::nettool::port_busy $port] 1 # Test that claiming a port makes it busy ::tcltest::test port-find-0002 \ "Test that port find returns the next port in unclaimed block starting at $port following claim" \ [list ::nettool::find_port $port] $nextport } set port 7790 ::nettool::claim_port $port ::tcltest::test port-claim-0002 \ "Test that port busy returns true after $port is claimed" \ [list ::nettool::port_busy $port] 1 ::nettool::release_port $port ::tcltest::test port-claim-0003 \ "Test that port busy returns false after $port is release" \ [list ::nettool::port_busy $port] 0 # Test that claiming a port makes it busy ::tcltest::test port-find-0004 \ "Test that port find returns the next port in released block starting at $port following claim" \ [list ::nettool::find_port 7790] 7790 foreach {port nextport comment} { 7790 7791 {Start of block} 7791 7792 {...} 7792 7793 {End of block} 7793 7795 {Start of new block} } { ::nettool::release_port $port } # Test that claiming a port makes it busy ::tcltest::test port-allocate-0004 \ "Test allocate port returns the address of an unclaimed spot and claims it" \ [list ::nettool::allocate_port 7790] 7790 ::tcltest::test port-allocate-0005 \ "Test allocate port returns the next address of an claimed spot and claims it" \ [list ::nettool::allocate_port 7790] 7791 ::tcltest::test port-allocate-0006 \ "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 |
Changes to modules/nettool/pkgIndex.tcl.
1 2 3 4 | if {![package vsatisfies [package provide Tcl] 8.5]} {return} # Backward compatible alias package ifneeded nettool::available_ports 0.1 {package require nettool ; package provide nettool::available_ports 0.1} | | | 1 2 3 4 5 6 | if {![package vsatisfies [package provide Tcl] 8.5]} {return} # Backward compatible alias package ifneeded nettool::available_ports 0.1 {package require nettool ; package provide nettool::available_ports 0.1} package ifneeded nettool 0.5.4 [list source [file join $dir nettool.tcl]] |