Tcl Library Source Code

Artifact c8b913b0136fb922075e8d674af8b3492e62eacf6b8f6a7920c05a5c92ea802f:

Attachment "nettool.diff" to ticket [9a21637273] added by anonymous 2018-01-23 04:50:57. (unpublished)

---

diff -ru tcllib-1.18/modules/nettool/platform_unix_linux.tcl tcllib-1.18.new/modules/nettool/platform_unix_linux.tcl
--- tcllib-1.18/modules/nettool/platform_unix_linux.tcl	2016-02-04 08:02:32.000000000 +0300
+++ tcllib-1.18.new/modules/nettool/platform_unix_linux.tcl	2018-01-23 07:32:43.505109274 +0300
@@ -1,6 +1,24 @@
 ::namespace eval ::nettool {}
 
 ###
+# topic: 825cd25953c2cc896a96006b7f454e00
+# title: Return pairings of MAC numbers to IP addresses on the local network
+# description: Under Linux, we read the arp table from /proc/net/arp
+# ###
+proc ::nettool::arp_table {} {
+  set result {}
+  set fd [open /proc/net/arp]
+  set dat [read $fd]
+  close $fd
+  foreach line [lrange [split $dat \n] 1 end-1] {
+    set ip [lindex $line 0]
+    set macid [lindex $line 3]
+    lappend result $macid $ip
+  }
+  return $result
+}
+
+###
 # topic: 92ebbfa155883ad41c37d3f843392be4
 # title: Return list of broadcast addresses for local networks
 ###
@@ -8,8 +26,8 @@
   set result {}
   lappend result 127.0.0.1
   foreach {iface info} [dump] {
-    if {[dict exists $info ipv4 Bcast:]} {
-      lappend result [dict get $info ipv4 Bcast:]
+    if {[dict exists $info ipv4 brd]} {
+      lappend result [dict get $info ipv4 brd]
     }
   }
   return [lsort -unique -dictionary $result]
@@ -92,38 +110,45 @@
 # description: Dump interfaces
 ###
 proc ::nettool::dump {} {
-  set data [exec ifconfig]
+  set data [exec ip address show]
   set iface {}
   set result {}
   foreach line [split $data \n] {
     if {[string index $line 0] in {" " "\t"} } {
       # Indented line appends the prior iface
-      switch [lindex $line 0] {
+      switch -glob -- [lindex $line 0] {
         inet {
-          foreach tuple [lrange $line 1 end] {
-	    set idx [string first : $tuple]
-            set field [string trim [string range $tuple 0 $idx]]
-            set value [string trim [string range $tuple $idx+1 end]]
-            dict set result $iface ipv4 [string trim $field] [string trim $value]
+          lassign [split [lindex $line 1]/32 /] addr prefix
+          set ipv4dict [dict create addr $addr prefix $prefix]
+          foreach {field value} [lrange $line 2 end] {
+            dict set ipv4dict [string trim $field] [string trim $value]
+          }
+          if {![dict exists $result $iface ipv4 scope] || \
+                [dict get $result $iface ipv4 scope] ne "global"} {
+            dict set result $iface ipv4 $ipv4dict
           }
         }
         inet6 {
-          dict set result $iface ipv6 addr: [lindex $line 2]
-          foreach tuple [lrange $line 3 end] {
-	    set idx [string first : $tuple]
-            set field [string trim [string range $tuple 0 $idx]]
-            set value [string trim [string range $tuple $idx+1 end]]
-            dict set result $iface ipv6 [string trim $field] [string trim $value]
+          lassign [split [lindex $line 1]/128 /] addr prefix
+          set ipv6dict [dict create addr $addr prefix $prefix]
+          foreach {field value} [lrange $line 2 end] {
+            dict set ipv6dict [string trim $field] [string trim $value]
+          }
+          if {![dict exists $result $iface ipv6 scope] || \
+                [dict get $result $iface ipv6 scope] ne "global"} {
+            dict set result $iface ipv6 $ipv6dict
           }
 	}
+        link/* {
+            set ether [lindex $line 1]
+            if {$ether ne ""} {
+                dict set result $iface ether $ether
+            }
+        }
       }
     } else {
       # Non-intended line - new iface
-      set iface [lindex $line 0]
-      set idx [lsearch $line HWaddr]
-      if {$idx >= 0 } {
-        dict set result $iface ether: [lindex $line $idx+1]
-      }
+      set iface [string trim [lindex $line 1] :]
     }
   }
   return $result
@@ -136,12 +161,11 @@
 proc ::nettool::ip_list {} {
   set result {}
   foreach {iface info} [dump] {
-    if {[dict exists $info ipv4 addr:]} {
-      lappend result [dict get $info ipv4 addr:]
+    if {[dict exists $info ipv4 addr]} {
+      lappend result [dict get $info ipv4 addr]
     }
   }
-  ldelete result 127.0.0.1
-  return $result
+  return [lsearch -all -inline -not -exact $result 127.0.0.1]
 }
 
 ###
@@ -151,11 +175,11 @@
 proc ::nettool::mac_list {} {
   set result {}
   foreach {iface info} [dump] {
-    if {[dict exists $info ether:]} {
-      lappend result [dict get $info ether:]
+    if {[dict exists $info ether]} {
+      lappend result [dict get $info ether]
     }
   }
-  return $result
+  return [lsearch -all -inline -not -exact $result 00:00:00:00:00:00]
 }
 
 ###
@@ -163,13 +187,14 @@
 ###
 proc ::nettool::network_list {} {
   foreach {iface info} [dump] {
-    if {![dict exists $info ipv4 addr:]} continue
-    if {![dict exists $info ipv4 Mask:]} continue
-    #set mask [::ip::maskToInt $netmask]
-    set addr [dict get $info ipv4 addr:]
-    set mask [dict get $info ipv4 Mask:]
+    if {![dict exists $info ipv4 addr]} continue
+    if {![dict exists $info ipv4 prefix]} continue
+    set addr [dict get $info ipv4 addr]
+    set prefix [dict get $info ipv4 prefix]
+    set mask [::ip::toInteger [::ip::lengthToMask $prefix]]
     set addri [::ip::toInteger $addr]
-    lappend result [ip::nativeToPrefix [list [expr {$addri & $mask}] $mask] -ipv4]    
+    lappend result [ip::nativeToPrefix [list [expr {$addri & $mask}] $mask] -ipv4]
+    #lappend result $addr/$prefix
   }
   return $result
 }
Only in tcllib-1.18.new/modules/nettool: .platform_unix_linux.tcl.swp