While working on a kind of scheme for a file/directory syncronisation tool, I needed to identify a machine (computer) on the base of a flexible pattern using the MAC- or IP-Address or a hostname pattern.

Because of only needing this scheme on MS Windows I used the network API from [TWAPI].

The source below is optimized for tcl 8.5 and needs to get changed for tcl 8.4 usage.

About the package machine interface:

   1. '''machine macaddresses''' - returns the requestable MAC-Addresses of the known network interfaces/adapters
   1. '''machine ipaddresses''' - returns the requestable IP-Addresses of the known network interfaces/adapters
   1. '''machine hostnames''' - returns the requestable hostnames, based on the requestable IP-Addresses
   1. '''machine identify''' ''pattern'' - returns 1, if the machine is identified by the given pattern, or otherwise 0
   1. '''machine reset''' - resets the internal cache for MAC-, IP-Addresses, hostnames and queried identifications

The pattern styles:

   * MAC address glob-like pattern, like:
     AA-BB-CC-DD-EE-FF,
     AA:BB:CC:DD:EE:FF,
     A?:*:C?:D*:*:*F
 
   * IP address glob-like or logical-AND-mask pattern, like:
     192.68.0.2,
     192.&255.&255.&255,
     192.&92.0.&4,
     192.*.*.*,
     192.?8.0.?

   * hostname glob pattern, like:
     DummyHostname,
     D*Host*,
     D[au]mmyHost?me

If it makes sense to use patterns on a MAC-address was beyond the scope.

----

======
 package provide machine 1.0;

 package require twapi;

 namespace eval ::machine {
     variable macAddresses;
     variable ipAddresses;
     variable hostnames;
     variable cache;

     
     # returns the currently known MAC addresses
     # belonging to network adapters with such a MAC address
     #
     proc macaddresses {} {
         variable macAddresses;

         if {[llength $macAddresses] == 0} {
             # loop over the known network interface indices
             #
             set macAddresses    [list];

             foreach netifIndex [twapi::get_netif_indices] {
                 # query the network interface/adapter information
                 #
                 set netifInfo   [twapi::get_netif_info $netifIndex \
                     -adapterdescription -physicaladdress -ipaddresses \
                 ];

                 if {[string length [dict get $netifInfo -physicaladdress]] > 0} {
                     lappend macAddresses [dict get $netifInfo -physicaladdress];
                 }
             }
         }

         return $macAddresses;
     }

     # returns the currently known IP addresses
     # belonging to network adapters with such a MAC address
     #
     proc ipaddresses {} {
         variable ipAddresses;

         if {[llength $ipAddresses] == 0} {
             # loop over the known network interface indices
             #
             set ipAddresses [list];

             foreach netifIndex [twapi::get_netif_indices] {
                 # query the network interface/adapter information
                 #
                 set netifInfo   [twapi::get_netif_info $netifIndex \
                     -adapterdescription -physicaladdress -ipaddresses \
                 ];

                 if {[string length [dict get $netifInfo -physicaladdress]] > 0} {
                     lappend ipAddresses [lindex [dict get $netifInfo -ipaddresses] 0 0];
                 }
             }
         }

         return $ipAddresses;
     }

     # returns the currently known hostnames retrieved from
     # the IP addresses belonging to network adapters with such a MAC address
     #
     proc hostnames {} {
         variable hostnames;

         if {[llength $hostnames] == 0} {
             # loop over the requestable IP addresses
             #
             set hostnames   [list];

             foreach ipAddress [ipaddresses] {
                 # translate the IP address into a hostname
                 #
                 lappend hostnames [twapi::address_to_hostname $ipAddress];
             }
         }

         return $hostnames;
     }

     proc IsMacAddress {pattern testConditionsVar} {
         upvar 1 $testConditionsVar testConditions;

         # split the given MAC address pattern into its parts
         #
         set patternParts    [split $pattern "-"];
         set testConditions  [list];

         if {[llength $patternParts] != 6} {
             set patternParts   [split $pattern ":"];

             if {[llength $patternParts] != 6} {
                 return 0;
             }
         }

         # loop over the parts and test each MAC address part for being a valid
         # part pattern to store generated if conditions per part pattern to be 
         # used in the MatchMacAddress procedure
         #
         set temp    [list];

         foreach patternPart $patternParts {
             if {[string is xdigit -strict $patternPart] == 0} {
                 # part could be a glob-style pattern
                 #
                 if {([string length $patternPart] < 1) ||
                     ([string length $patternPart] > 2) ||
                     ([regexp -- {^(([[:xdigit:]]|\?){2}|(\*[[:xdigit:]])|([[:xdigit:]]\*)|\*)$} $patternPart] == 0)} {
                     return 0;
                 }

                 lappend temp [format {[string match -nocase {%s} $part] == 0} $patternPart];
             } else {
                 # part could be a 2-Byte hexadecimal value
                 #
                 if {0x$patternPart > 0xFF} {
                     return 0;
                 }

                 lappend temp [format {0x$part == 0x%s} $patternPart];
             }
         }

         set testConditions  $temp;

         return 1;
     }

     proc IsIpAddress {pattern testConditionsVar} {
         upvar 1 $testConditionsVar testConditions;

         # split the given IP address pattern into its parts
         #
         set patternParts    [split $pattern "."];
         set testConditions  [list];

         if {[llength $patternParts] != 4} {
             return 0;
         }

         # loop over the parts and test each IP address part for being a valid
         # part pattern to store generated if conditions per part pattern to be 
         # used in the MatchIpAddress procedure
         #
         set temp    [list];

         foreach patternPart $patternParts {
             if {[string first "&" $patternPart] == -1} {
                 if {[string is integer -strict $patternPart] == 0} {
                     # part could be a glob style pattern
                     #
                     if {[regexp -- {^((2(\?{2}|\*))|(1?(\?{2}|\*))|(\d?(\?|\*))|(\*?\?{1,2}\*?)|(\?{3}|\*))$} $patternPart] == 0} {
                         return 0;
                     }

                     lappend temp [format \
                         {[string match -nocase {%s} $part] == 0} \
                         $patternPart \
                     ];
                 } else {
                     # part could be an integer between 0 and 255
                     #
                     if {($patternPart < 0) || ($patternPart > 255)} {
                         return 0;
                     }

                     lappend temp [format {$part != %s} $patternPart];
                 }
             } elseif {([string first "&" $patternPart] == 0) &&
                       ([string is integer -strict $patternPart] == 1)} {
                 # part could be a logical-AND-mask pattern
                 #
                 set patternPart    [string range $patternPart 1 end];

                 if {($patternPart < 0) || ($patternPart > 255)} {
                     return 0;
                 }

                 lappend temp [format {(%s & $part) != $part} $patternPart];
             } else {
                 return 0;
             }
         }

         set testConditions  $temp;

         return 1;
     }

     proc MatchMacAddress {macAddress testConditions} {
         foreach splitChar {"-" ":"} {
             set parts   [split $macAddress $splitChar];

             if {[llength $parts] == 6} {
                 return [MatchAddress $parts $testConditions];
             }
         }

         return 0;
     }

     proc MatchIpAddress {ipAddress testConditions} {
         set parts   [split $ipAddress "."];

         if {[llength $parts] != 4} {
             return 0;
         }

         return [MatchAddress $parts $testConditions];
     }

     proc MatchAddress {address testConditions} {
         foreach part $address testCondition $testConditions {
             if $testCondition {
                 return 0;
             }
         }

         return 1;
     }

     # identifies the machine using one of the following patterns:
     #
     #   1. MAC address glob-like pattern, like:
     #       AA-BB-CC-DD-EE-FF,
     #       AA:BB:CC:DD:EE:FF,
     #       A?:*:C?:D*:*:*F
     #
     #   2. IP address glob-like or logical-AND-mask pattern, like:
     #       192.68.0.2,
     #       192.&255.&255.&255,
     #       192.&92.0.&4,
     #       192.*.*.*,
     #       192.?8.0.?
     #
     #   3. hostname glob pattern, like:
     #       DummyHostname,
     #       D*Host*,
     #       D[au]mmyHost?me
     #
     # all calls are cached using the given pattern and its result
     #
     proc identify {pattern} {
         variable cache;

         if {[info exists cache($pattern)] == 1} {
             return $cache($pattern);
         }

         set testConditions  [list];

         if {[IsMacAddress $pattern testConditions] == 1} {
             foreach macAddress [macaddresses] {
                 if {[MatchMacAddress $macAddress $testConditions] == 1} {
                     return [set cache($pattern) 1];
                 }
             }
         } elseif {[IsIpAddress $pattern testConditions] == 1} {
             foreach ipAddress [ipaddresses] {
                 if {[MatchIpAddress $ipAddress $testConditions] == 1} {
                     return [set cache($pattern) 1];
                 }
             }
         } else {
             foreach hostname [hostnames] {
                 if {[string match -nocase $pattern $hostname] == 1} {
                     return [set cache($pattern) 1];
                 }
             }
         }

         return [set cache($pattern) 0];
     }

     # resets the internal cache for identification,
     # MAC and IP addresses and hostnames
     #
     proc reset {} {
         variable macAddresses;
         variable ipAddresses;
         variable hostnames;
         variable cache;

         set macAddresses    [list];
         set ipAddresses     [list];
         set hostnames       [list];

         array unset cache;
         array set cache [list];

         return;
     }

     reset;

     namespace export -clear {[a-z]*};
     namespace ensemble create ::machine;
 };
======

<<categories>> Windows