#       enparse - read RIPE database and check syntax errors
#
# Copyright (c) 1993, 1994, 1995, 1996, 1997, 1998, 1999 by RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
# $Id: enparse.pl,v 2.7 1999/10/06 16:41:08 marek Exp $
#
#	$RCSfile: enparse.pl,v $
#	$Revision: 2.7 $
#	$Author: marek $
#	$Date: 1999/10/06 16:41:08 $
#
#	ARGUMENTS:	filehandle to read from
#	RETURNS:	INTEGER object_status
#			ASSOC   object
#
#	Object status = $O_OK, $O_WARNING, $O_ERROR, $EOF, or $NOK
#		$O_OK = object read and no errors/warnings generated
#		$O_WARNING = object read, but generated warnings
#		$O_ERROR = object read, but generated errors
#		$EOF = EndOfFile reached
#		$NOK = no object found, just garbage
#
#	Object has warnings and errors included.
#
#	This routine is a modified version of enread. It will read any
#	garbage, until it finds something of the form:
#	"xxxxxxx: " (no fixed length, spaces MUST be there)
#	or
#	"*xx: "
#	and then continues to read until it finds a line that does not
#	match these patterns. It then assumes it read an object, and will
#	start doing syntax checks.

require "entype.pl";
require "syntax.pl";
require "defines.pl";
require "adderror.pl";
require "dpr.pl";
require "pgp.pl";
require "i6.pl";

sub readsomething {
    local($file)=@_;

    local($inentry)=$EOF;
    local(%entry)=();
    local($tag)="&&"; # this one needs to be initialized
    local(@lines)=();
    local(@continuedlines)=();
    
    local($newtag);

    &dpr("\n");

    while (<$file>) {
        
        #
        # read the password in global var
                
        if (/^\s*password\s*\:\s*(\S.*)$/i) {
           
           $PASSWORD=$1;
           $PASSWORD=~ s/\s*$//;
           
#           &dpr("password found: ", $PASSWORD, "\n");
           
           next;
           
        }
        
        s/\s/ /g;
        s/ +$//;
        
        #
        # skip error & warning attributes
                
        next if (/^ *(\*?ue|\*?uw|WARNING|\*ERROR\*) *\:/i);
        
        
	if (s/^ *(\*?[$VALIDATTRCHAR]+) *\: *//o) {
	   
	   $newtag=$1;
	   $newtag=~ s/^\*//;
	   $newtag=~ tr/A-Z/a-z/;
	   
	   s/ *$//;
	   
#
# no need for this special case for merging consecutive lines with same
# tags because lines with same tags are merged to the same $entry{$tag}
# in any case later on //snabb 980924
#
#	   if (($tag eq $newtag) || ($tag eq $ATTL{$newtag}) || ($tag eq $ATTR{$newtag})) {
#	      
#	      if (s/ *\\$//) {
#	         @continuedlines=($_);
#	      }
#	      elsif ($_) {
#	      
#	         push(@lines, $_);
#	      
#	      }
#	      else {
#	         push(@lines,"") if ($lines[$#lines]);
#	      }
#	       
#	   }
#	   else {
	      
              if ($entry{$tag}) {
                 $entry{$tag}=join("\n",$entry{$tag},@lines) if (scalar(@lines));
              }
              else {
                 $entry{$tag}=join("\n",@lines) if (scalar(@lines));
              }

	      # @lines are now saved in $entry, so lets clear it up to prevent
	      # joining them with @continuedlines (bug ID 1998-38)
	      # //snabb 980924
	      @lines = ();
               
              $tag=$ATTR{$newtag};
                
              # we have an unknown attribute 
              
              $tag=$newtag if (!$tag);
              
              if (s/ *\\$//) {
	         @continuedlines=($_);
	      }
              elsif ($_) {
                 
	         @lines=($_);

	      }
	      else {
	         @lines=("");
	      }
                
#	   }
	       
           $inentry=$O_OK;
           
           if (@continuedlines) {
	   
	      while (($_=<$file>) && (s/\s*\\\s*$//)) {
	       
	          s/\s/ /g;
                  s/^ +//;
               
	          push(@continuedlines, $_) if ($_);
	       
	      }
	   
	      s/\s/ /g;
              s/^ +//;
              s/ +$//;
	   
	      if ($_) {
	         push(@lines, join(" ", @continuedlines, $_));
	      } 
	      else {
	         push(@lines, join(" ", @continuedlines));
	      }
              
              $lines[$#lines]=~ s/^ //;

              pop(@lines) if (($#lines>0) && (!$lines[$#lines]) && (!$lines[$#lines-1]));
	   
	      @continuedlines=();
	   
           }
	

	   next;
	
	}
        
        # skip comments

        next if (/^ *#/);
	
	# read further if we didn't find any object yet
	
        next if ($inentry==$EOF);
	
	# nothing useful found, end of object
	
	last;

    }
    
    if ($inentry==$O_OK) {
       
       if ($entry{$tag}) {
          $entry{$tag}=join("\n",$entry{$tag},@lines) if (scalar(@lines));
       }
       else {
          $entry{$tag}=join("\n",@lines) if (scalar(@lines));
       }
       
       #
       # delete warning/error attributes
       #
       # this is convenient for people who find errors
       # and resubmit the object
       
       delete($entry{"uw"});
       delete($entry{"ue"});
       
       # try to find a new object if we only found 
       # error/warning attributes
       
       return &enparse($file) if (!%entry);
       
       return ($inentry, %entry) if (%entry);
       
    }
    
    return $EOF;
    
}


sub checkobject	{
    local(*object, $type) = @_;

    local($rtcode)=$O_OK;
    local(%knownfield) = ();
    local(%mandfield) = ();
    local(%multfield) = ();
    local(%knownfield) = ();
    local(%usefield) = ();
    local($i);

    &dpr("called with \%object = " . join("*", %object) . "\$type = $type\n");
    
    foreach $i ((split(/\s+/, $OBJATSQ{$type}),"ud","uo","uw","ue")) {
	$knownfield{$i}=1;
    }

    foreach $i (split(/\s+/, $OBJMAND{$type})) {
	$mandfield{$i} = 1;
    }

    foreach $i (split(/\s+/, $OBJMULT{$type})) {
	$multfield{$i} = 1;
    }

    foreach $i (keys %object) {
	$usefield{$i} = 1;
    }

# Warn about obsoleted atttibutes and skip them

    foreach (split(/\s+/, $OBS{$type})) {
	if ($object{$_}) {
	    &addwarning(*object,
			"attribute \"$ATTL{$_}\" has been obsoleted,".
			" value removed from object");
	    delete $object{$_};
	    delete $usefield{$_};
	    $rtcode=$O_WARNING if ($rtcode!=$O_ERROR);
	}
    }

#Go through all the attributes in this object

    foreach $i (keys %usefield) {
	
	if (!$knownfield{$i}) {
	    if ($ATTL{$i}) {
		&adderror(*object,
			  "attribute \"$ATTL{$i}\" unknown ".
			  "in $ATTL{$type} object");
	    } else {
		&adderror(*object,
			  "attribute \"$i\" unknown in $ATTL{$type} object");
	    }
	    $rtcode = $O_ERROR;
	    next;
	}

	undef $mandfield{$i} unless $object{$i} eq "";
	
	if ($object{$i}=~ /^\s*$/) {
	
	   delete $object{$i};
	   
	   &addwarning(*object,
	    	       "removed empty attribute: \"$ATTL{$i}\"");
	    	       
           $rtcode=$O_WARNING if ($rtcode!=$O_ERROR);
	
	}
	
	if ($object{$i}=~ /\n/) {
	    
	    if ($multfield{$i}) {
	       
	       if (($object{$i}=~ s/^\n+//) || ($object{$i}=~ s/\n+$//)) {
	          
	          &addwarning(*object,
	    	              "removed empty line(s) in attribute: \"$ATTL{$i}\"");
	    	  
	    	  $rtcode=$O_WARNING if ($rtcode!=$O_ERROR);
	       
	       }
	       
	    }
	    else {

		&adderror(*object,
			  "multiple lines not allowed for: \"$ATTL{$i}\"");
		$rtcode = $O_ERROR;

	    }

	}

    }

# Complain about missing or incomplete mandatory fields

    foreach $i (keys %mandfield) {
	if ($mandfield{$i}) {
	    if (defined($object{$i}) && ($object{$i} =~ /^\n*$/)) {
		&adderror(*object,
			  "mandatory field \"$ATTL{$i}\" must have a value");
	    } else {
		&adderror(*object,
			  "mandatory field \"$ATTL{$i}\" missing");
	    }
	    $rtcode = $O_ERROR;
	}
    }
    
#    &dpr("returned \$rtcode = $rtcode\n");
    
    return $rtcode;
    
}

sub enparse {
    local($file) = @_;

    local(%entry);
    local($rtcode);
    local($stat,$type);
	
#    &dpr("reading something\n");

    ($stat, %entry)=&readsomething($file);

    &dpr("\%entry = " . join("*", %entry) . "\n");
    
    return $EOF if ($stat==$EOF);

    $type=&entype(%entry);
    
    # Now start the syntax checking
    #
    # we first do some checks that are always needed
    # even when we delete objects
    
    $rtcode=&requiredsyntaxcheck(*entry, $type);
    
    # &dpr("\%entry = " . join("*", %entry) . "\n");
#   &dpr("left requiredsyntaxcheck($rtcode)\n");
    
    #
    # do all other checks 
    
    if ((!defined($entry{"ud"})) && ($rtcode!=$O_ERROR)) {
       
       &dpr("checking object format\n");
       
       local($code)=&checkobject(*entry, $type);
       
       # print STDERR %entry, "\n";
       
#       &dpr("enparse - left checkobject($code)\n");
       
       $rtcode=$code if (($code==$O_ERROR) || (($code==$O_WARNING) && ($rtcode!=$O_ERROR)));
       
       if ($rtcode!=$O_ERROR) {
       
          &dpr("checking object syntax\n");
	  
	  $code=&checksyntax(*entry);
	  
	  # print STDERR %entry, "\n";
	  
#	  &dpr("left checksyntax($code)\n");
	  
	  $rtcode=$code if (($code==$O_ERROR) || (($code==$O_WARNING) && ($rtcode!=$O_ERROR)));
       
       }
       
    }
    
    if ($type eq "kc" && $rtcode != $O_ERROR) {
       print STDERR "enparse - adding the generated fields in a certificate object \n" if ($opt_V);

       genPGPkc(*entry, $type) == $O_ERROR
	   and $rtcode = $O_ERROR;
    }

    if ($type eq "i6" && $rtcode != $O_ERROR) {
       print STDERR "enparse - adding the generated fields in an inet6num object \n" if ($opt_V);

       geni6st(*entry, $type) == $O_ERROR
	   and $rtcode = $O_ERROR;
    }

    # print STDERR %entry, "\n";
    &dpr("Exiting enparse.\nExit code: $rtcode\nType: $type\nEntry:",
	 %entry,"\n");
    
    return ($rtcode, $type, %entry);
    
}

1;
