perfsonar development work

Author: zurawski
Date: 2008-05-22 09:04:50 -0400 (Thu, 22 May 2008)
New Revision: 350

Modified:
   trunk/nmwg/doc/dLS/gLS/examples/graph.dot
   trunk/nmwg/doc/dLS/gLS/examples/ipTree.pl
   trunk/nmwg/doc/dLS/gLS/images/graph.png
   trunk/nmwg/doc/dLS/gLS/images/graph2.png
Log:
Bugfix to the perl summarization code.

-jason



Modified: trunk/nmwg/doc/dLS/gLS/examples/graph.dot
===================================================================
--- trunk/nmwg/doc/dLS/gLS/examples/graph.dot   2008-05-20 21:30:12 UTC (rev 
349)
+++ trunk/nmwg/doc/dLS/gLS/examples/graph.dot   2008-05-22 13:04:50 UTC (rev 
350)
@@ -1,35 +1,37 @@
 digraph g {
-       "128.0.0.0/9";
+       "128.4.133.163/32"[ color=crimson, style=filled ];
+       "128.175.13.74/32"[ color=crimson, style=filled ];
        "128.4.131.23/32"[ color=crimson, style=filled ];
-       "128.4.133.163/32"[ color=crimson, style=filled ];
+       "Root"[ color=yellow, style=filled ];
+       "128.175.13.64/27";
+       "128.4.0.0/16";
+       "128.4.40.0/27";
+       "128.0.0.0/8";
+       "128.4.40.17/32"[ color=crimson, style=filled ];
+       "128.4.40.12/32"[ color=crimson, style=filled ];
+       "128.4.133.167/32"[ color=crimson, style=filled ];
+       "128.4.128.0/21";
        "128.175.13.92/32"[ color=crimson, style=filled ];
-       "128.4.40.0/28";
-       "128.4.128.0/17";
-       "0.0.0.0/0";
-       "128.4.40.17/32"[ color=crimson, style=filled ];
        "128.4.133.164/30";
-       "128.4.40.12/32"[ color=crimson, style=filled ];
-       "128.128.0.0/9";
        "128.4.133.164/32"[ color=crimson, style=filled ];
-       "128.4.133.167/32"[ color=crimson, style=filled ];
-       "128.4.132.0/22";
-       "128.4.0.0/17";
-       "128.175.13.74/32"[ color=crimson, style=filled ];
+       "128.4.133.160/29";
+       "128.4.40.8/29";
        "128.4.40.10/32"[ color=crimson, style=filled ];
-       "128.0.0.0/9" -> "128.4.0.0/17";
-       "128.0.0.0/9" -> "128.4.128.0/17";
-       "128.4.40.0/28" -> "128.4.40.10/32";
-       "128.4.40.0/28" -> "128.4.40.12/32";
-       "128.4.128.0/17" -> "128.4.132.0/22";
-       "128.4.128.0/17" -> "128.4.131.23/32";
-       "0.0.0.0/0" -> "128.0.0.0/9";
-       "0.0.0.0/0" -> "128.128.0.0/9";
+       "Root" -> "128.0.0.0/8";
+       "128.175.13.64/27" -> "128.175.13.92/32";
+       "128.175.13.64/27" -> "128.175.13.74/32";
+       "128.4.0.0/16" -> "128.4.40.0/27";
+       "128.4.0.0/16" -> "128.4.128.0/21";
+       "128.4.40.0/27" -> "128.4.40.8/29";
+       "128.4.40.0/27" -> "128.4.40.17/32";
+       "128.0.0.0/8" -> "128.175.13.64/27";
+       "128.0.0.0/8" -> "128.4.0.0/16";
+       "128.4.128.0/21" -> "128.4.131.23/32";
+       "128.4.128.0/21" -> "128.4.133.160/29";
+       "128.4.133.164/30" -> "128.4.133.167/32";
        "128.4.133.164/30" -> "128.4.133.164/32";
-       "128.4.133.164/30" -> "128.4.133.167/32";
-       "128.128.0.0/9" -> "128.175.13.74/32";
-       "128.128.0.0/9" -> "128.175.13.92/32";
-       "128.4.132.0/22" -> "128.4.133.163/32";
-       "128.4.132.0/22" -> "128.4.133.164/30";
-       "128.4.0.0/17" -> "128.4.40.0/28";
-       "128.4.0.0/17" -> "128.4.40.17/32";
+       "128.4.133.160/29" -> "128.4.133.164/30";
+       "128.4.133.160/29" -> "128.4.133.163/32";
+       "128.4.40.8/29" -> "128.4.40.10/32";
+       "128.4.40.8/29" -> "128.4.40.12/32";
 }

Modified: trunk/nmwg/doc/dLS/gLS/examples/ipTree.pl
===================================================================
--- trunk/nmwg/doc/dLS/gLS/examples/ipTree.pl   2008-05-20 21:30:12 UTC (rev 
349)
+++ trunk/nmwg/doc/dLS/gLS/examples/ipTree.pl   2008-05-22 13:04:50 UTC (rev 
350)
@@ -38,14 +38,15 @@
 # IP Trie Data Structure (similar to Net::Patricia)
 my $tr = Net::IPTrie->new( version => 4 );
 
-# I need to be able to do my own manipulations
+# I need to be able to do my own manipulations (e.g. IPTrie is not really
+# that great...)
 my %tree = ();
 
 # Ensure that each child only has one parent (IPTrie data structure
 # uses a strange internal representation).
 my %claim = ();
 
-# starting list of IPs [UDel addresses from all over the domain]
+# starting list of IPs
 
 my @map = ("128.175.13.92",
            "128.175.13.74",
@@ -68,17 +69,22 @@
 #           "80.15.11.2",
 #           "80.15.11.3");
 
+#my @map = ("64.57.25.15",
+#           "64.57.27.4",
+#           "64.57.27.138",
+#           "128.4.12.12",
+#           "128.4.13.1",
+#           "160.135.1.1",
+#           "207.75.165.151",
+#           "207.72.226.18",
+#           "206.72.224.1");
+
 my $vote = 
getCDIRSummaries(\@map);
 $tr = 
makePatriciaTrie(\@map,
 $vote, $tr);
-manipulatePatriciaTrie($tr);
+manipulatePatriciaTrie(\@map,
 $tr);
 genGraph(\%tree);
-my $final = listMinDoms();
+listMinDoms();
 
-print "Min Dominators:\n\n";
-foreach my $f (@{$final}) {
-  print $f , "\n";
-}
-
 exit(1);
 
 =head2 getCDIRSummaries($map)
@@ -92,30 +98,17 @@
 sub getCDIRSummaries {
   my($map) = @_;
   
-  # We can get ALL applicable CIDR summaries for each (in order of least to
-  # greatest).
-
-  my %vote = ();
+  my %tally = ();
   foreach my $host (@{$map}) {
     my @list = Net::CIDR::addr2cidr($host);
     foreach my $range (@list) {
-      $vote{$range}++ if defined $vote{$range};
-      $vote{$range} = 1 if not defined $vote{$range};
-    }
-  }
+ 
+      # we want to ingore the wildcard addresses...
+      next if $range =~ m/^0\./;    
 
-  # organize the votes into popularity groups
-
-  my %tally = ();
-  foreach my $range (sort keys %vote) {
-    if(defined $tally{$vote{$range}}) {
-      push @{$tally{$vote{$range}}}, $range;
+      $tally{$range}++ if defined $tally{$range};
+      $tally{$range} = 1 if not defined $tally{$range};
     }
-    else {
-      my @temp = ();
-      push @temp, $range;
-      $tally{$vote{$range}} = 
\@temp;
-    }  
   }
   
   return \%tally;
@@ -131,7 +124,7 @@
 =cut
 
 sub makePatriciaTrie {
-  my($map, $votes, $tr) = @_;
+  my($map, $tally, $tr) = @_;
   
   # Start to make the IPTrie data structure.  First we add in all
   # of the 'base' addresses
@@ -140,24 +133,37 @@
     $tr->add( address => $host, prefix => "32" );
   }
 
-  # Now we add in the summaries.  We should try to find the 
-  # dominators in each 'vote' group first.  This will ensure
-  # we are closer to a minimal set
+  # Now we add in the summaries.
 
-  foreach my $t (keys %{$votes}) {
-    my @total = ();
-    foreach my $addr (@{$votes->{$t}}) {
-      @total = Net::CIDR::cidradd($addr, @total);
-    }
-    foreach my $t2 (@total) {
-      my @parts = split(/\//,$t2);
-      $tr->add( address => $parts[0], prefix => $parts[1] );
-    }
+  foreach my $t (sort keys %{$tally}) {
+    my @parts = split(/\//,$t);
+    $tr->add( address => $parts[0], prefix => $parts[1] );
   } 
 
   return $tr;
 }
 
+=head2 extract($parent, $node, $status, $side)
+
+This aux function recursively walks the nodes of the IPTrie structure
+and creates a more usefriendly tree that we will use for manipulation
+and final display.
+
+=cut
+
+sub extract {
+  my($parent, $node, $status, $side) = @_;
+  my $me = "";
+  $me = $node->[3]."/".$node->[5] if defined $node->[3] and defined 
$node->[5];
+  if($me and $side and (not $claim{$me})) {
+    push @{$tree{$parent}{"C"}}, $me;
+    $claim{$me} = 1;
+  }
+  $status = extract($parent, $node->[1], $status, "L") if $node->[1] and 
(not $status->{"L"});
+  $status = extract($parent, $node->[2], $status, "R") if $node->[2] and 
(not $status->{"R"});
+  return $status;  
+}
+
 =head2 manipulatePatriciaTrie($tr)
 
 Given the IPTrie structure, we need to manually manipulate the nodes into
@@ -166,12 +172,19 @@
 =cut
 
 sub manipulatePatriciaTrie {
-  my($tr) = @_;
+  my($map, $tr) = @_;
   
   my $list = ();
   my $code = sub { push @$list, shift @_; };
   my $count = $tr->traverse( code => $code );
 
+  # hacky root pointer (gives us unification if the whild card [0.*]
+  # was really needed)
+  
+  my @temp = ();
+  $tree{"Root"}{"C"} = 
\@temp;
+  $tree{"Root"}{"U"} = "NULL";
+
   # we need to go backwards when looking at the IPTrie print out, this is 
   # is really to be sure children aren't all claimed by the root (the 
internal
   # structure is a little strange) so this ensures we hit the root last.
@@ -196,102 +209,79 @@
     extract($me, $node, \%status, "");
   }
 
-  # link all the parent information
+  # link all the parent information for each node and child
+  
   foreach my $item (keys %tree) {
     foreach my $c (@{$tree{$item}{"C"}}) {
       $tree{$c}{"U"} = $item if $c and $item;
     }  
   }
 
-  # No we get to do some manual mainpulation of the tree we just created, 
-  # there are two cases we should watch out for:
-  #
-  # 1) Node with only one child, child has children
-  # 2) Node with only one child, child is a terminal
-  #
-  # Based on these two cases we will search the tree searching for 
-  # candidates.  When we find one, be sure to move all the 'pointers'
-  # around, and mark the node for deletion
 
-  my @delete = ();
-  foreach my $item (keys %tree) {
-    if($#{$tree{$item}{"C"}} == 0 and $#{$tree{$tree{$item}{"C"}->[0]}{"C"}} 
>= -1) {
-      my @size = ($#{$tree{$item}{"C"}}, 
$#{$tree{$tree{$item}{"C"}->[0]}{"C"}});
-
-      # we either look at the node and child, or node and parent as the
-      # candidates for replacement.
-      my @items = ();
-      if($size[1] == -1) {
-        @items = ($tree{$item}{"U"}, $item);
+  # First step: Start at the leaves and walk toward the root.
+  # - Every time we see a node with a sinle child, collapse it into the 
parent
+  #   (we are pruning the tree)
+  
+  foreach my $host (@{$map}) {
+    my $current = $host."/32";
+    while($current) {
+      my $delete = "";
+      if($#{$tree{$tree{$current}{"U"}}{"C"}} == 0 and 
+         not($current =~ m/\/32$/) and 
+         $#{$tree{$current}{"C"}} == 0) {
+        $delete = $current;
+        foreach my $child (@{$tree{$current}{"C"}}) {
+          $tree{$child}{"U"} = $tree{$current}{"U"};
+        }
+        $tree{$tree{$current}{"U"}}{"C"} = $tree{$current}{"C"};
+        delete $tree{$delete}{"C"};
       }
-      else {
-        @items = ($item, $tree{$item}{"C"}->[0]); 
-      }
+      $current = $tree{$current}{"U"};
+      delete $tree{$delete} if $delete;
+    }
+  }  
 
-      # We are assuming this will give us the most dominant
-      # node (and that there will only be one).  
-      my @total = ();
-      @total = Net::CIDR::cidradd($items[0], @total);
-      @total = Net::CIDR::cidradd($items[1], @total);
+  # Second step: Start at the leaves and walk toward the root.
+  # - Every time we see a single child node, collapse it into the child (this
+  #   is the opposite of what we just did, but this handles branching much
+  #   better, this is also a form of pruning).
 
-      # move the children 
-      if($size[1] == -1) {
-        push @{$tree{$items[0]}{"C"}}, @{$tree{$items[1]}{"C"}};    
+  foreach my $host (@{$map}) {
+    my $current = $host."/32";
+    while($current) {
+      my $delete = "";
+      if($#{$tree{$current}{"C"}} == 0) {
+        $delete = $current;
+        foreach my $child (@{$tree{$delete}{"C"}}) {
+          $tree{$child}{"U"} = $tree{$delete}{"U"};
+          push @{$tree{$tree{$delete}{"U"}}{"C"}}, $child;  
+        }
+       
         my $counter = 0;
-        foreach my $c (@{$tree{$items[0]}{"C"}}) {
-          if($c eq $items[1]) {
-            splice(@{$tree{$items[0]}{"C"}}, $counter, 1);
-            last;
+        foreach my $child (@{$tree{$tree{$delete}{"U"}}{"C"}}) {
+          if($child eq $current) {
+            my $remove = 
splice(@{$tree{$tree{$delete}{"U"}}{"C"}},$counter,1);
           }
           $counter++;
         }
       }
-      else {
-        $tree{$items[0]}{"C"} = $tree{$items[1]}{"C"};
-      }
-
-      # mark the node for deletion
-      push @delete, $items[1];        
- 
-      # Re-map the children (if any) to the new parent
-      foreach my $c (@{$tree{$items[0]}{"C"}}) {
-        $tree{$c}{"U"} = $items[0] if $c and $items[0];
-      }  
+      $current = $tree{$current}{"U"};
+      delete $tree{$delete} if $delete;
     }
-  }
+  }  
 
-  # Get rid of dead nodes identified above (perl doesn't like you deleting 
from
-  # and 'in use' data structure so deleting needs to be done out of the
-  # above loop)
+  # finally link the tree(s) to the root pointer
   
-  foreach my $d (@delete) {
-    delete $tree{$d};
+  foreach my $node (keys %tree) {
+    unless($tree{$node}{"U"}) {
+      $tree{$node}{"U"} = "Root";
+      push @{$tree{"Root"}{"C"}}, $node;
+    }
   }
 
   return;
 }
 
-=head2 extract($parent, $node, $status, $side)
-
-This aux function recursively walks the nodes of the IPTrie structure
-and creates a more usefriendly tree that we will use for manipulation
-and final display.
-
-=cut
-
-sub extract {
-  my($parent, $node, $status, $side) = @_;
-  my $me = "";
-  $me = $node->[3]."/".$node->[5] if defined $node->[3] and defined 
$node->[5];
-  if($me and $side and (not $claim{$me})) {
-    push @{$tree{$parent}{"C"}}, $me;
-    $claim{$me} = 1;
-  }
-  $status = extract($parent, $node->[1], $status, "L") if $node->[1] and 
(not $status->{"L"});
-  $status = extract($parent, $node->[2], $status, "R") if $node->[2] and 
(not $status->{"R"});
-  return $status;  
-}
-
 =head2 genGraph
 
 Outputs the contents of the tree structure into a "Graphviz" formated
@@ -306,18 +296,27 @@
 
   foreach my $item (keys %tree) {
     next unless $item;
-    my @array = ();
-    @array =split(/\//, $item);
+    if($item =~ m/\/\d+$/) {
+      my @array = ();
+      @array =split(/\//, $item);
     
-    # color the terminal elements so we know they are not dominators
-    if($array[1] eq "32") {
-      print DOT "\t\"" , $item , "\"[ color=crimson, style=filled ];\n";
+      # color the terminal elements so we know they are not dominators
+      if($array[1] eq "32") {
+        print DOT "\t\"" , $item , "\"[ color=crimson, style=filled ];\n";
+      }
+      else {
+        print DOT "\t\"" , $item , "\";\n";
+      }
     }
     else {
-      print DOT "\t\"" , $item , "\";\n";
+      # this is the root...
+
+      print DOT "\t\"" , $item , "\"[ color=yellow, style=filled ];\n";
     }
   }
 
+  # output the linkings
+
   foreach my $item (keys %tree) {
     next unless $item;
     foreach my $c (@{$tree{$item}{"C"}}) {
@@ -347,14 +346,12 @@
   # First locate the root in the tree
 
   my @expand = ();
-  foreach my $node (keys %tree) {
-    unless($tree{$node}{"U"}) {
+  foreach my $node (sort keys %tree) {
+    if($node and $tree{$node}{"U"} eq "Root") {
       # add the root the 'expand' list so we can
       # examine it (and it's children, etc.) then
       # exit
-  
       push @expand, $node;
-      last;
     }
   }
 
@@ -370,6 +367,7 @@
   while($expand[$counter]) {
     my $minDomFlag = 0;
     my $expandFlag = 0;
+
     foreach my $child (sort @{$tree{$expand[$counter]}{"C"}}) {
       my @array = split(/\//, $child);
 
@@ -400,7 +398,12 @@
     $counter++;
   }
 
-  return 
\@minDoms;
+  print "Min Dominators:\n\n";
+  foreach my $f (@minDoms) {
+    print $f , "\n";
+  }
+
+  return;
 }
 
 __END__

Modified: trunk/nmwg/doc/dLS/gLS/images/graph.png
===================================================================
(Binary files differ)

Modified: trunk/nmwg/doc/dLS/gLS/images/graph2.png
===================================================================
(Binary files differ)