migration: T3161: move XorpConfigParser to vyatta-cfg-system

The scripts:
vyatta_net_name
vyatta_interface_rescan
still require XorpConfigParser; all other uses have been rewritten, or
obviated. In order to retire the package vyatta-config-migrate in favor
of keeping migration scripts in vyos-1x, we need to move this module
into vyatta-cfg-system for use by the above mentioned scripts.

2 files changed, 622 insertions, 0 deletions

diff --git a/Makefile.am b/Makefile.am
index 1e377aef..c5f7dfac 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -5,6 +5,7 @@ checkparamsonrebootdir = $(bindir)/sudo-users/check-params-on-reboot.d
 initddir = /etc/init.d
 modprobedir = /etc/modprobe.d
 modprobe_DATA = etc/modprobe.d/no-copybreak.conf
+share_perl5dir = $(datadir)/perl5
 
 bin_SCRIPTS =
 sbin_SCRIPTS =
@@ -61,6 +62,9 @@ sbin_SCRIPTS += scripts/vyos-persistpath
 sbin_PROGRAMS = src/valid_address
 sbin_PROGRAMS += src/local_ip
 
+share_perl5_DATA =
+share_perl5_DATA += scripts/XorpConfigParser.pm
+
 src_valid_address = src/valid_address.c
 src_local_ip = src/local_ip.c
 
diff --git a/scripts/XorpConfigParser.pm b/scripts/XorpConfigParser.pm
new file mode 100644
index 00000000..3a4035f8
--- /dev/null
+++ b/scripts/XorpConfigParser.pm
@@ -0,0 +1,618 @@
+# Perl module for parsing config files.
+
+use lib "/opt/vyatta/share/perl5/";
+
+package XorpConfigParser;
+
+use strict;
+my %data;
+
+my %fields = ( _data => \%data );
+
+sub new {
+    my $that  = shift;
+    my $class = ref($that) || $that;
+    my $self  = { %fields, };
+
+    bless $self, $class;
+    return $self;
+}
+
+#
+# This method is used to copy nodes whose names begin with a particular string
+# from one array to another.
+#
+# Parameters:
+#
+# $from		Reference to the source array
+# $to		Reference to the destination array
+# $name		The string with which the beginning of the node names will be matched
+#
+sub copy_node {
+    my ( $self, $from, $to, $name ) = @_;
+    if ( !defined($from) || !defined($to) || !defined($name) ) {
+        return;
+    }
+
+    foreach my $node (@$from) {
+        my $stringNodeNameHere = $node->{'name'};
+        if ( $stringNodeNameHere =~ /^$name.*/ ) {
+            foreach my $nodeCheck (@$to) {
+                my $stringCheck = $nodeCheck->{'name'};
+                if ( $name eq $stringCheck ) {
+                    $nodeCheck->{'value'}    = $node->{'value'};
+                    $nodeCheck->{'children'} = $node->{'children'};
+                    $nodeCheck->{'comment'}  = $node->{'comment'};
+                    $nodeCheck->{'disable'}  = $node->{'disable'};
+                    return;
+                }
+            }
+            push( @$to, $node );
+        }
+    }
+}
+
+#
+# This method is used to create duplicate copies of multinodes with the name
+# specified, and to return the new copies in a new array.
+#
+#  $nodes	A reference to an array of multinodes
+#  $name	The name of the multinodes to copy into the new array
+#
+sub copy_multis {
+    my ( $self, $nodes, $name ) = @_;
+
+    return if ( !defined($nodes) || !defined($name) );
+
+    my @multis;
+
+    foreach my $node (@$nodes) {
+        my $stringNodeNameHere = $node->{'name'};
+        if ( $stringNodeNameHere =~ /$name\s(\S+)/ ) {
+            my $stringNameHere = $1;
+            my %multi          = (
+                'name'     => $stringNameHere,
+                'comment'  => $node->{'comment'},
+                'value'    => $node->{'value'},
+                'disable'  => $node->{'disable'},
+                'children' => $node->{'children'}
+            );
+            push( @multis, \%multi );
+        }
+    }
+
+    return @multis;
+}
+
+#
+# This method is used to comment out a particular child.
+#
+#  $children	A reference to an array of children
+#  $name	The name of the child to comment out
+#  $comment	The comment string that will be included inside the comment
+#
+sub comment_out_child {
+    my ( $self, $children, $name, $comment ) = @_;
+    if ( !defined($children) || !defined($name) ) {
+        return;
+    }
+
+    for ( my $i = 0 ; $i < @$children ; $i++ ) {
+        my $stringNodeNameHere = @$children[$i]->{'name'};
+        if ( $name eq $stringNodeNameHere ) {
+            $self->comment_out_node( @$children[$i] );
+            if ( defined($comment) ) {
+                @$children[$i]->{'comment_out'} = $comment;
+            }
+        }
+    }
+}
+
+#
+# This method is used to comment out a particular node.
+#
+#  $node	A reference to the node to comment out
+#
+sub comment_out_node {
+    my ( $self, $node ) = @_;
+    if ( !defined($node) ) {
+        return;
+    }
+
+    $node->{'comment_out'} = "1";
+}
+
+#
+# This method is used to create a node with the path specified.  The method
+# will create parent nodes as necessary.
+#
+#  $path	A reference to the array containing the path segments
+#
+sub create_node {
+    my ( $self, $path ) = @_;
+
+    my $hash = \%data;
+  SEGMENT:
+    foreach my $segment (@$path) {
+        my $children = $hash->{'children'};
+
+        unless ($children) {
+            my @new_children;
+            $hash->{'children'} = \@new_children;
+            $children = \@new_children;
+        }
+
+        foreach my $child (@$children) {
+            my $name = $child->{'name'};
+            next unless $name;
+
+            if ( $name eq $segment ) {
+                $hash = $child;		# record insertion point
+                next SEGMENT;
+            }
+        }
+
+        my %new_hash = ( 'name' => $segment );
+
+	if ($hash != \%data) {
+	    # insertion in subtree
+	    push @$children, \%new_hash;
+	} else {
+	    # special case for insertion at top put new before version comment
+	    my @comments;
+	    while (my $child = pop @$children) {
+		if ($child->{'comment'}) {
+		    unshift @comments, $child;
+		} else {
+		    push @$children, $child;
+		    last;
+		}
+	    }
+
+	    push @$children, \%new_hash;
+	    push @$children, @comments;
+	}
+        $hash = \%new_hash;
+    }
+    return $hash;
+}
+
+#
+# This method is used to delete a child node with the name specified from an array of child nodes.
+#
+#  $children	A reference to the array of child nodes
+#  $name	The name of the child node to delete
+#
+sub delete_child {
+    my ( $self, $children, $name ) = @_;
+    return if ( !defined($children) || !defined($name) );
+
+    for ( my $i = 0 ; $i < @$children ; $i++ ) {
+        my $stringNodeNameHere = @$children[$i]->{'name'};
+        if ( $name eq $stringNodeNameHere ) {
+            @$children[$i] = undef;
+        }
+    }
+}
+
+#
+# This method is used to return a reference to the child node
+# with the name specified.
+#
+#  $children	A reference to an array containing the child nodes.
+#  $name	The name of the child node reference to which will be returned.
+#
+# If the child node with the name specified is not found,
+# then 'undef' is returned.
+#
+sub find_child {
+    my ( $self, $children, $name ) = @_;
+    return if ( !defined($children) || !defined($name) );
+
+    foreach my $child (@$children) {
+        return $child if ( $name eq $child->{'name'} );
+    }
+    return;
+}
+
+# $ref: reference to the node to be used as the starting point.
+# the same as node_exists() except that the starting point is the specified
+# node (instead of root).
+sub node_exists_with_ref {
+    my ( $self, $ref, $path ) = @_;
+    my @parr = split / /, $path;
+    if ( defined( $self->get_node_with_ref( $ref, \@parr ) ) ) {
+        return 1;
+    }
+    return 0;
+}
+
+# $path: a space-delimited string representing the path to a node.
+#        e.g., 'interfaces ethernet eth0'. note that the path
+#        is relative from the root level.
+# returns 1 if the specified node exists. otherwise returns 0.
+sub node_exists {
+    my ( $self, $path ) = @_;
+    my @parr = split / /, $path;
+
+    return $self->get_node( \@parr );
+}
+
+# $ref: reference to the node to be used as the starting point.
+# the same as get_node() except that the starting point is the specified
+# node (instead of root).
+sub get_node_with_ref {
+    my ( $self, $ref, $path ) = @_;
+    my $hash = $ref;
+
+  SEGMENT:
+    foreach my $segment (@$path) {
+        my $children = $hash->{'children'};
+        return unless $children;
+
+        foreach my $child (@$children) {
+            next unless ( $child->{'name'} eq $segment );
+
+            $hash = $child;
+            next SEGMENT;
+        }
+
+        # No children matched segment
+        return;
+    }
+
+    return $hash;
+}
+
+#
+# This method is used to return a reference to the hash
+# of the node with the path specified.
+#
+#  $path - reference to an array containing the path segments of the node.
+#
+# If the path is invalid, then undef is returned.
+sub get_node {
+    my ( $self, $path ) = @_;
+
+    return $self->get_node_with_ref( $self->{_data}, $path );
+}
+
+#
+# Move a subtree from one place to another in hierarchy
+# Assumes both $from and $to exist
+# Returns undef if no match
+sub move_child {
+    my ( $self, $from, $to, $name ) = @_;
+    my $source = $from->{'children'};
+    return unless $source;
+
+    for ( my $i = 0 ; $i < @$source ; $i++ ) {
+        my $match = @$source[$i];
+        next unless $match->{'name'} eq $name;
+        splice @$source, $i, 1;    # remove old list
+
+        my $children = $to->{'children'};
+        unless ($children) {
+            my @new_children;
+            $to->{'children'} = \@new_children;
+            $children = \@new_children;
+        }
+
+        push @$children, $match;
+        return $match;
+    }
+
+    return;
+}
+
+#
+# This method is used to insert a comment at a particular path.
+#
+#  $path	A reference to an array containing the path segments to the
+#               node for which the comment is to be inserted.  The comment
+#               will appear above the node.
+#
+# If the node with the path specified does not exist, a node with empty name
+# will be created for the comment.
+#
+sub push_comment {
+    my ( $self, $path, $comment ) = @_;
+
+    my $hash = \%data;
+    foreach my $segment (@$path) {
+        my $children = $hash->{'children'};
+        if ( !defined($children) ) {
+            my @children;
+            $hash->{'children'} = \@children;
+            $children = \@children;
+        }
+
+        my $child_found = 0;
+        foreach my $child (@$children) {
+            if ( $child->{'name'} eq $segment ) {
+                $child_found = 1;
+                $hash        = $child;
+                last;
+            }
+        }
+
+        if ( $child_found == 0 ) {
+            my %new_hash = ( 'name' => $segment );
+            push( @$children, \%new_hash );
+            $hash = \%new_hash;
+        }
+    }
+
+    my %new_comment = ( 'comment' => $comment );
+    my $childrenPush = $hash->{'children'};
+    if ( !defined($childrenPush) ) {
+        my @new_children;
+        $hash->{'children'} = \@new_children;
+        $childrenPush = \@new_children;
+    }
+    push( @$childrenPush, \%new_comment );
+}
+
+#
+# This method is used to set the value of a particular node
+#
+#  $path	A reference to an array containing the path segments to the node
+#  $value	String of the value to set
+#
+sub set_value {
+    my ( $self, $path, $value ) = @_;
+
+    my $hash = $self->create_node($path);
+    if ( defined($hash) ) {
+        $hash->{'value'} = $value;
+    }
+}
+
+#
+# This method is used to set the value of a particular node
+#
+#  $path	A reference to an array containing the path segments to the node
+#  $value	String of the value to set
+#
+sub set_disable {
+    my ( $self, $path ) = @_;
+    my $hash = $self->create_node($path);
+    if ( defined($hash) ) {
+        $hash->{'disable'} = 'true';
+    }
+}
+
+#
+# This method is used to generate the output of the node tree in the XORP config
+# file format.  The output is printed out to currently selected standard out.
+#
+#  $depth	Number of indents, used when this method calls itself
+#               recursively, should be 0 when used.
+#  $hash	A reference to the parent node, should be the roor node when
+#               used.
+#
+sub output {
+    my ( $self, $depth, $hash ) = @_;
+
+    $hash = $self->{_data} unless $hash;
+
+    my $comment = $hash->{'comment'};
+    print '/*' . $comment . "*/\n"
+      if $comment;
+
+    my $children = $hash->{'children'};
+    foreach my $child (@$children) {
+        next unless $child;
+        my $name = $child->{'name'};
+
+        my $comment_out = $child->{'comment_out'};
+        if ($comment_out) {
+            print "\n";
+            print "/*   --- $comment_out ---   */\n"
+              if ( $comment_out ne "1" );
+            print
+"/*   --- CONFIGURATION COMMENTED OUT DURING MIGRATION BELOW ---\n";
+        }
+
+        print "    " x $depth;
+        my $value = $child->{'value'};
+        if ($value) {
+            print "$name $value";
+            print "\n";
+        }
+        else {
+            my $print_brackets = 0;
+            my $children       = $child->{'children'};
+            if ( defined($children) && @$children > 0 ) {
+                $print_brackets = 1;
+            }
+            elsif ( defined($name) && !( $name =~ /\s/ ) ) {
+                $print_brackets = 1;
+            }
+
+            if ($name) {
+                print "$name";
+                if ($print_brackets) {
+                    print " {";
+                }
+                print "\n";
+            }
+
+            $self->output( $depth + 1, $child );
+            if ($print_brackets) {
+                print "    " x $depth;
+                print "}\n";
+            }
+        }
+
+        print
+"     --- CONFIGURATION COMMENTED OUT DURING MIGRATION ABOVE ---  */\n\n"
+          if ($comment_out);
+    }
+}
+
+#
+# This method is used to parse the XORP config file specified into the internal tree
+# structure that the methods above process and manipulate.
+#
+#  $file	String of the filename to parse
+#
+sub parse {
+    my ( $self, $file ) = @_;
+
+    %data = ();
+
+    open my $in, '<', $file
+      or die "Error!  Unable to open file \"$file\".  $!";
+
+    my $contents = "";
+    while (<$in>) {
+        $contents .= $_;
+    }
+    close $in;
+
+    my @array_contents = split( '', $contents );
+
+    #	print scalar(@array_contents) . "\n";
+
+    my $length_contents = @array_contents;
+    my $colon           = 0;
+    my $colon_quote     = 0;
+    my $in_quote        = 0;
+    my $name            = '';
+    my $value           = undef;
+    my $disable         = undef;
+    my @path;
+    my %tree;
+
+    for ( my $i = 0 ; $i < $length_contents ; ) {
+        my $c     = $array_contents[$i];
+        my $cNext = $array_contents[ $i + 1 ];
+
+        if ( $colon == 1 ) {
+            my $value_end = 0;
+            if ( $c eq '"' ) {
+                $value .= $c;
+                if ( $colon_quote == 1 ) {
+                    $value_end = 1;
+                }
+                else {
+                    $colon_quote = 1;
+                }
+            }
+            elsif ( $c eq '\\' && $cNext eq '"' ) {
+                $value .= '\\"';
+                $i++;
+            }
+            elsif ( defined($value) ) {
+                if ( ( length($value) > 0 ) || ( !( $c =~ /\s/ ) ) ) {
+                    $value .= $c;
+                }
+            }
+
+            if ( $colon_quote == 0
+                && ( $cNext eq '}' || $cNext eq ';' || $cNext =~ /\s/ ) )
+            {
+                $value_end = 1;
+            }
+            $i++;
+
+            if ( $value_end == 1 ) {
+                if ( length($value) > 0 ) {
+
+                    #					print "Path is: \"@path\"    Value is: $value\n";
+                    $self->set_value( \@path, $value );
+                    $value = undef;
+                }
+                pop(@path);
+                $colon_quote = 0;
+                $colon       = 0;
+            }
+            next;
+        }
+
+        # ! $colon
+        # check for quotes
+        if ( $c eq '"' ) {
+            if ($in_quote) {
+                $in_quote = 0;
+            }
+            else {
+                $in_quote = 1;
+            }
+            $name .= '"';
+            $i++;
+            next;
+        }
+        elsif ( $c eq '\\' && $cNext eq '"' ) {
+            $name .= '\\"';
+            $i += 2;
+            next;
+        }
+
+	if ( !$in_quote && $c eq '!' && $cNext eq ' ') {
+	    $disable = 'true';
+	    $i += 2;
+	}
+        elsif ( !$in_quote && $c eq '/' && $cNext eq '*' ) {
+            my $comment_text = '';
+            my $comment_end = index( $contents, '*/', $i + 2 );
+            if ( $comment_end == -1 ) {
+                $comment_text = substr( $contents, $i + 2 );
+            }
+            else {
+                $comment_text =
+                  substr( $contents, $i + 2, $comment_end - $i - 2 );
+                $i = $comment_end + 2;
+            }
+
+            #			print 'Comment is: "' . $comment_text . "\"\n";
+            $self->push_comment( \@path, $comment_text );
+        }
+        elsif (( !$in_quote && $c eq '{' )
+            || ( $c eq ':' && !( $name =~ /\s/ ) )
+            || $c eq "\n" )
+        {
+            $name =~ s/^\s+|\s$//g;
+
+            if ( length($name) > 0 ) {
+                push( @path, $name );
+
+		if (defined $disable && $disable eq 'true') {
+                $self->set_disable(\@path);
+                $disable = undef;
+            }
+
+                #				print "Path is: \"@path\"    Name is: \"$name\"\n";
+                $self->set_value( \@path, $value );
+                $name = '';
+
+                if ( $c eq "\n" ) {
+                    pop(@path);
+                }
+                if ( $c eq ':' ) {
+                    $colon = 1;
+                }
+            }
+
+            $i++;
+        }
+        elsif ( !$in_quote && $c eq '}' ) {
+            pop(@path);
+            $name = '';
+            $disable = undef;
+            $i++;
+        }
+        elsif ( !$in_quote && $c eq ';' ) {
+            $i++;
+        }
+        else {
+            if ( ( length($name) > 0 ) || ( !( $c =~ /\s/ ) ) ) {
+                $name .= $c;
+            }
+            $i++;
+        }
+    }
+}
+
+1;