command 'allports' to list open ports

2023-09-05 17:50:11 +02:00
parent 8145df86a0
commit ed0d881a2d
1 changed files with 17 additions and 0 deletions
--- a/tcl/startup/ports.tcl
+++ b/tcl/startup/ports.tcl
@ -0,0 +1,17 @@
+proc allports {} {
+  set result [list]
+  set pattern {([0-9a-zA_Z.-]*:[0-9]+)$}
+  foreach obj [obj_list items] {
+    set port [silent none $obj hostport]
+    if {[regexp $pattern $port -> port]} {
+      lappend result $port
+    } else {
+      if {[regexp ".* $pattern" [silent 0 $obj creationCmd] -> port]} {
+        lappend result $port
+      }
+    }
+  }
+  return $result
+}
+
+publishLazy allports spy